Proper chunk export of class extensions.

js/Kernel.js

@@ -1090,6 +1090,24 @@ referencedClasses: [smalltalk.Array]
 }),
 smalltalk.Behavior);
 
+smalltalk.addMethod(
+'_protocolsDo_',
+smalltalk.method({
+selector: 'protocolsDo:',
+category: 'accessing',
+fn: function (aBlock){
+var self=this;
+var methodsByCategory=nil;
+methodsByCategory=smalltalk.send(smalltalk.Dictionary, "_new", []);
+smalltalk.send(smalltalk.send(smalltalk.send(self, "_methodDictionary", []), "_values", []), "_do_", [(function(m){return smalltalk.send(smalltalk.send(methodsByCategory, "_at_ifAbsentPut_", [smalltalk.send(m, "_category", []), (function(){return smalltalk.send(smalltalk.Array, "_new", []);})]), "_add_", [m]);})]);
+smalltalk.send(smalltalk.send(self, "_protocols", []), "_do_", [(function(category){return smalltalk.send(aBlock, "_value_value_", [category, smalltalk.send(methodsByCategory, "_at_", [category])]);})]);
+return self;},
+source: unescape('protocolsDo%3A%20aBlock%0A%09%22Execute%20aBlock%20for%20each%20method%20category%20with%0A%09its%20collection%20of%20methods%20in%20the%20sort%20order%20of%20category%20name.%22%0A%0A%09%7C%20methodsByCategory%20%7C%0A%09methodsByCategory%20%3A%3D%20Dictionary%20new.%0A%09self%20methodDictionary%20values%20do%3A%20%5B%3Am%20%7C%0A%09%09%28methodsByCategory%20at%3A%20m%20category%20ifAbsentPut%3A%20%5BArray%20new%5D%29%0A%20%09%09%09add%3A%20m%5D.%20%0A%09self%20protocols%20do%3A%20%5B%3Acategory%20%7C%0A%09%09aBlock%20value%3A%20category%20value%3A%20%28methodsByCategory%20at%3A%20category%29%5D'),
+messageSends: ["new", "do:", "values", "methodDictionary", "add:", "at:ifAbsentPut:", "category", "protocols", "value:value:", "at:"],
+referencedClasses: [smalltalk.Dictionary,smalltalk.Array]
+}),
+smalltalk.Behavior);
+
 
 
 smalltalk.addClass('Class', smalltalk.Behavior, [], 'Kernel');

js/Parser.js

@@ -1465,7 +1465,7 @@ fn: function (aString, aStream){
 var self=this;
 smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.Smalltalk, "_current", []), "_classes", []), "__comma", [smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.Smalltalk, "_current", []), "_classes", []), "_collect_", [(function(each){return smalltalk.send(each, "_class", []);})])]), "_do_", [(function(each){return smalltalk.send(smalltalk.send(smalltalk.send(each, "_methodDictionary", []), "_values", []), "_do_", [(function(method){return smalltalk.send(smalltalk.send(smalltalk.send(method, "_category", []), "__eq", [smalltalk.send(unescape("*"), "__comma", [aString])]), "_ifTrue_", [(function(){return smalltalk.send(self, "_exportMethod_of_on_", [method, each, aStream]);})]);})]);})]);
 return self;},
-source: unescape('%0AexportCategoryExtensions%3A%20aString%20on%3A%20aStream%0A%09Smalltalk%20current%20classes%2C%20%28Smalltalk%20current%20classes%20collect%3A%20%5B%3Aeach%20%7C%20each%20class%5D%29%20do%3A%20%5B%3Aeach%20%7C%0A%09%09each%20methodDictionary%20values%20do%3A%20%5B%3Amethod%20%7C%0A%09%09%09method%20category%20%3D%20%28%27*%27%2C%20aString%29%20ifTrue%3A%20%5B%0A%09%09%09%09self%20exportMethod%3A%20method%20of%3A%20each%20on%3A%20aStream%5D%5D%5D'),
+source: unescape('exportCategoryExtensions%3A%20aString%20on%3A%20aStream%0A%09Smalltalk%20current%20classes%2C%20%28Smalltalk%20current%20classes%20collect%3A%20%5B%3Aeach%20%7C%20each%20class%5D%29%20do%3A%20%5B%3Aeach%20%7C%0A%09%09each%20methodDictionary%20values%20do%3A%20%5B%3Amethod%20%7C%0A%09%09%09method%20category%20%3D%20%28%27*%27%2C%20aString%29%20ifTrue%3A%20%5B%0A%09%09%09%09self%20exportMethod%3A%20method%20of%3A%20each%20on%3A%20aStream%5D%5D%5D'),
 messageSends: ["do:", unescape("%2C"), "classes", "current", "collect:", "class", "values", "methodDictionary", "ifTrue:", unescape("%3D"), "category", "exportMethod:of:on:"],
 referencedClasses: [smalltalk.Smalltalk]
 }),
@@ -1515,14 +1515,11 @@ selector: 'exportMethodsOf:on:',
 category: 'not yet classified',
 fn: function (aClass, aStream){
 var self=this;
-var methodsByCategory=nil;
-methodsByCategory=smalltalk.send(smalltalk.Dictionary, "_new", []);
-smalltalk.send(smalltalk.send(smalltalk.send(aClass, "_methodDictionary", []), "_values", []), "_do_", [(function(m){return smalltalk.send(smalltalk.send(methodsByCategory, "_at_ifAbsentPut_", [smalltalk.send(m, "_category", []), (function(){return smalltalk.send(smalltalk.Array, "_new", []);})]), "_add_", [m]);})]);
-smalltalk.send(smalltalk.send(aClass, "_protocols", []), "_do_", [(function(category){(function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(unescape("%21"), "__comma", [smalltalk.send(self, "_classNameFor_", [aClass])])]);return smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(unescape("%20methodsFor%3A%20%27"), "__comma", [category]), "__comma", [unescape("%27%21")])]);})(aStream);smalltalk.send(smalltalk.send(methodsByCategory, "_at_", [category]), "_do_", [(function(each){return smalltalk.send(self, "_exportMethod_of_on_", [each, aClass, aStream]);})]);return (function($rec){smalltalk.send($rec, "_nextPutAll_", [unescape("%20%21")]);smalltalk.send($rec, "_lf", []);return smalltalk.send($rec, "_lf", []);})(aStream);})]);
+smalltalk.send(aClass, "_protocolsDo_", [(function(category, methods){return smalltalk.send(smalltalk.send(category, "_match_", [unescape("%5E%5C*")]), "_ifFalse_", [(function(){return smalltalk.send(self, "_exportMethods_category_of_on_", [methods, category, aClass, aStream]);})]);})]);
 return self;},
-source: unescape('exportMethodsOf%3A%20aClass%20on%3A%20aStream%0A%0A%20%20%20%20%7C%20methodsByCategory%20%7C%0A%20%20%20%20methodsByCategory%20%3A%3D%20Dictionary%20new.%0A%20%20%20%20aClass%20methodDictionary%20values%20do%3A%20%5B%3Am%20%7C%0A%09%28methodsByCategory%20at%3A%20m%20category%20ifAbsentPut%3A%20%5BArray%20new%5D%29%0A%20%09%09add%3A%20m%5D.%20%0A%20%20%20%20aClass%20protocols%20do%3A%20%5B%3Acategory%20%7C%20%20%20%20%20%20%20%0A%09aStream%0A%09%09nextPutAll%3A%20%27%21%27%2C%20%28self%20classNameFor%3A%20aClass%29%3B%0A%09%09nextPutAll%3A%20%27%20methodsFor%3A%20%27%27%27%2C%20category%2C%20%27%27%27%21%27.%0A%20%20%20%20%09%28methodsByCategory%20at%3A%20category%29%20do%3A%20%5B%3Aeach%20%7C%0A%09%09self%20exportMethod%3A%20each%20of%3A%20aClass%20on%3A%20aStream%5D.%0A%09aStream%20nextPutAll%3A%20%27%20%21%27%3B%20lf%3B%20lf%5D'),
-messageSends: ["new", "do:", "values", "methodDictionary", "add:", "at:ifAbsentPut:", "category", "protocols", "nextPutAll:", unescape("%2C"), "classNameFor:", "at:", "exportMethod:of:on:", "lf"],
-referencedClasses: [smalltalk.Dictionary,smalltalk.Array]
+source: unescape('exportMethodsOf%3A%20aClass%20on%3A%20aStream%0A%0A%20%20%20aClass%20protocolsDo%3A%20%5B%3Acategory%20%3Amethods%20%7C%0A%09%28category%20match%3A%20%27%5E%5C*%27%29%20ifFalse%3A%20%5B%20%0A%09%09self%0A%09%09%09exportMethods%3A%20methods%0A%09%09%09category%3A%20category%0A%09%09%09of%3A%20aClass%0A%09%09%09on%3A%20aStream%5D%5D'),
+messageSends: ["protocolsDo:", "ifFalse:", "match:", "exportMethods:category:of:on:"],
+referencedClasses: []
 }),
 smalltalk.ChunkExporter);
 
@@ -1571,5 +1568,37 @@ referencedClasses: []
 }),
 smalltalk.ChunkExporter);
 
+smalltalk.addMethod(
+'_exportCategoryExtensions_on_',
+smalltalk.method({
+selector: 'exportCategoryExtensions:on:',
+category: 'not yet classified',
+fn: function (aString, aStream){
+var self=this;
+smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.Smalltalk, "_current", []), "_classes", []), "__comma", [smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.Smalltalk, "_current", []), "_classes", []), "_collect_", [(function(each){return smalltalk.send(each, "_class", []);})])]), "_do_", [(function(each){return smalltalk.send(each, "_protocolsDo_", [(function(category, methods){return smalltalk.send(smalltalk.send(category, "__eq", [smalltalk.send(unescape("*"), "__comma", [aString])]), "_ifTrue_", [(function(){return smalltalk.send(self, "_exportMethods_category_of_on_", [methods, category, each, aStream]);})]);})]);})]);
+return self;},
+source: unescape('exportCategoryExtensions%3A%20aString%20on%3A%20aStream%0A%09%22We%20need%20to%20override%20this%20one%20too%20since%20we%20need%20to%20group%0A%09all%20methods%20in%20a%20given%20protocol%20under%20a%20leading%20methodsFor%3A%20chunk%0A%09for%20that%20class.%22%0A%0A%09Smalltalk%20current%20classes%2C%20%28Smalltalk%20current%20classes%20collect%3A%20%5B%3Aeach%20%7C%20each%20class%5D%29%20do%3A%20%5B%3Aeach%20%7C%0A%09%09each%20protocolsDo%3A%20%5B%3Acategory%20%3Amethods%20%7C%0A%09%09%09category%20%3D%20%28%27*%27%2C%20aString%29%20ifTrue%3A%20%5B%0A%09%09%09%09self%20exportMethods%3A%20methods%20category%3A%20category%20of%3A%20each%20on%3A%20aStream%5D%5D%5D'),
+messageSends: ["do:", unescape("%2C"), "classes", "current", "collect:", "class", "protocolsDo:", "ifTrue:", unescape("%3D"), "exportMethods:category:of:on:"],
+referencedClasses: [smalltalk.Smalltalk]
+}),
+smalltalk.ChunkExporter);
+
+smalltalk.addMethod(
+'_exportMethods_category_of_on_',
+smalltalk.method({
+selector: 'exportMethods:category:of:on:',
+category: 'not yet classified',
+fn: function (methods, category, aClass, aStream){
+var self=this;
+(function($rec){smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(unescape("%21"), "__comma", [smalltalk.send(self, "_classNameFor_", [aClass])])]);return smalltalk.send($rec, "_nextPutAll_", [smalltalk.send(smalltalk.send(unescape("%20methodsFor%3A%20%27"), "__comma", [category]), "__comma", [unescape("%27%21")])]);})(aStream);
+smalltalk.send(methods, "_do_", [(function(each){return smalltalk.send(self, "_exportMethod_of_on_", [each, aClass, aStream]);})]);
+(function($rec){smalltalk.send($rec, "_nextPutAll_", [unescape("%20%21")]);smalltalk.send($rec, "_lf", []);return smalltalk.send($rec, "_lf", []);})(aStream);
+return self;},
+source: unescape('exportMethods%3A%20methods%20category%3A%20category%20of%3A%20aClass%20on%3A%20aStream%0A%0A%09aStream%0A%09%09nextPutAll%3A%20%27%21%27%2C%20%28self%20classNameFor%3A%20aClass%29%3B%0A%09%09nextPutAll%3A%20%27%20methodsFor%3A%20%27%27%27%2C%20category%2C%20%27%27%27%21%27.%0A%20%20%20%20%09methods%20do%3A%20%5B%3Aeach%20%7C%0A%09%09self%20exportMethod%3A%20each%20of%3A%20aClass%20on%3A%20aStream%5D.%0A%09aStream%20nextPutAll%3A%20%27%20%21%27%3B%20lf%3B%20lf'),
+messageSends: ["nextPutAll:", unescape("%2C"), "classNameFor:", "do:", "exportMethod:of:on:", "lf"],
+referencedClasses: []
+}),
+smalltalk.ChunkExporter);
+
 
 

st/Canvas.st

@@ -74,13 +74,6 @@ Object subclass: #HTMLCanvas
 	instanceVariableNames: 'root'
 	category: 'Canvas'!
 
-!HTMLCanvas methodsFor: '*JQuery'!
-
-appendToJQuery: aJQuery
-    aJQuery appendElement: root element
-
-! !
-
 !HTMLCanvas methodsFor: 'accessing'!
 
 root: aTagBrush
@@ -518,18 +511,23 @@ canvas: aCanvas
 		yourself
 ! !
 
-
+!Object methodsFor: '*Canvas'!
 
 appendToBrush: aTagBrush
     aTagBrush append: self asString
 
-!
+! !
+
+!BlockClosure methodsFor: '*Canvas'!
 
 appendToBrush: aTagBrush
     aTagBrush appendBlock: self
-!
+! !
+
+!String methodsFor: '*Canvas'!
 
 appendToBrush: aTagBrush
     aTagBrush appendString: self
 
-!
+! !
+

st/IDE.st

@@ -1377,7 +1377,7 @@ search: aString
 		open
 ! !
 
-
+!Object methodsFor: '*IDE'!
 
 inspect
 	Inspector new 
@@ -1396,7 +1396,9 @@ inspectOn: anInspector
 		setVariables: variables
 	
 	
-!
+! !
+
+!Date methodsFor: '*IDE'!
 
 inspectOn: anInspector
 	| variables |
@@ -1414,7 +1416,9 @@ inspectOn: anInspector
 		setVariables: variables
 	
 	
-!
+! !
+
+!Collection methodsFor: '*IDE'!
 
 inspectOn: anInspector
 	| variables |
@@ -1425,7 +1429,9 @@ inspectOn: anInspector
 	anInspector 
 		setLabel: self printString;
 		setVariables: variables
-!
+! !
+
+!String methodsFor: '*IDE'!
 
 inspectOn: anInspector
 	| label |
@@ -1434,7 +1440,9 @@ inspectOn: anInspector
 		ifTrue: [label := (self printString copyFrom: 1 to: 30), '...''']
 		ifFalse: [label := self printString]. 
 	anInspector setLabel: label
-!
+! !
+
+!Dictionary methodsFor: '*IDE'!
 
 inspectOn: anInspector
 	| variables |
@@ -1446,4 +1454,5 @@ inspectOn: anInspector
 	anInspector 
 		setLabel: self printString;
 		setVariables: variables
-!
+! !
+

st/JQuery.st

@@ -321,7 +321,7 @@ url: aString
 
 ! !
 
-
+!BlockClosure methodsFor: '*JQuery'!
 
 appendToJQuery: aJQuery
 	| canvas |
@@ -329,7 +329,9 @@ appendToJQuery: aJQuery
 	self value: canvas.
 	aJQuery append: canvas
 
-!
+! !
+
+!String methodsFor: '*JQuery'!
 
 asJQuery
     ^JQuery fromString: self
@@ -339,9 +341,12 @@ asJQuery
 appendToJQuery: aJQuery
     {'aJQuery._appendElement_(String(self))'}
 
-!
+! !
+
+!HTMLCanvas methodsFor: '*JQuery'!
 
 appendToJQuery: aJQuery
     aJQuery appendElement: root element
 
-!
+! !
+

st/Kernel.st

@@ -2,34 +2,6 @@ nil subclass: #Object
 	instanceVariableNames: ''
 	category: 'Kernel'!
 
-!Object methodsFor: '*Canvas'!
-
-appendToBrush: aTagBrush
-    aTagBrush append: self asString
-
-! !
-
-!Object methodsFor: '*IDE'!
-
-inspect
-	Inspector new 
-		inspect: self;
-		open
-!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	self class instanceVariableNames do: [:each |
-		variables at: each put: (self instVarAt: each)].
-	anInspector 
-		setLabel: self printString;
-		setVariables: variables
-	
-	
-! !
-
 !Object methodsFor: 'accessing'!
 
 yourself
@@ -444,6 +416,19 @@ protocols
 	    (protocols includes: each category) ifFalse: [
 		protocols add: each category]].
     ^protocols sort
+!
+
+protocolsDo: aBlock
+	"Execute aBlock for each method category with
+	its collection of methods in the sort order of category name."
+
+	| methodsByCategory |
+	methodsByCategory := Dictionary new.
+	self methodDictionary values do: [:m |
+		(methodsByCategory at: m category ifAbsentPut: [Array new])
+ 			add: m]. 
+	self protocols do: [:category |
+		aBlock value: category value: (methodsByCategory at: category)]
 ! !
 
 !Behavior methodsFor: 'instance creation'!
@@ -753,22 +738,6 @@ Object subclass: #BlockClosure
 	instanceVariableNames: ''
 	category: 'Kernel'!
 
-!BlockClosure methodsFor: '*Canvas'!
-
-appendToBrush: aTagBrush
-    aTagBrush appendBlock: self
-! !
-
-!BlockClosure methodsFor: '*JQuery'!
-
-appendToJQuery: aJQuery
-	| canvas |
-	canvas := HTMLCanvas new.
-	self value: canvas.
-	aJQuery append: canvas
-
-! !
-
 !BlockClosure methodsFor: 'accessing'!
 
 compiledSource
@@ -910,26 +879,6 @@ Object subclass: #Date
 !Date commentStamp!
 The Date class is used to work with dates and times.!
 
-!Date methodsFor: '*IDE'!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	variables at: '#year' put: self year.
-	variables at: '#month' put: self month.
-	variables at: '#day' put: self day.
-	variables at: '#hours' put: self hours.
-	variables at: '#minutes' put: self minutes.
-	variables at: '#seconds' put: self seconds.
-	variables at: '#milliseconds' put: self milliseconds.
-	anInspector 
-		setLabel: self printString;
-		setVariables: variables
-	
-	
-! !
-
 !Date methodsFor: 'accessing'!
 
 year
@@ -1189,19 +1138,6 @@ Object subclass: #Collection
 	instanceVariableNames: ''
 	category: 'Kernel'!
 
-!Collection methodsFor: '*IDE'!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	self withIndexDo: [:each :i |
-		variables at: i put: each].
-	anInspector 
-		setLabel: self printString;
-		setVariables: variables
-! !
-
 !Collection methodsFor: 'accessing'!
 
 size
@@ -1508,36 +1444,6 @@ SequenceableCollection subclass: #String
 	instanceVariableNames: ''
 	category: 'Kernel'!
 
-!String methodsFor: '*Canvas'!
-
-appendToBrush: aTagBrush
-    aTagBrush appendString: self
-
-! !
-
-!String methodsFor: '*IDE'!
-
-inspectOn: anInspector
-	| label |
-	super inspectOn: anInspector.
-	self printString size > 30 
-		ifTrue: [label := (self printString copyFrom: 1 to: 30), '...''']
-		ifFalse: [label := self printString]. 
-	anInspector setLabel: label
-! !
-
-!String methodsFor: '*JQuery'!
-
-asJQuery
-    ^JQuery fromString: self
-
-!
-
-appendToJQuery: aJQuery
-    {'aJQuery._appendElement_(String(self))'}
-
-! !
-
 !String methodsFor: 'accessing'!
 
 size
@@ -1993,20 +1899,6 @@ Collection subclass: #Dictionary
 	instanceVariableNames: 'keys'
 	category: 'Kernel'!
 
-!Dictionary methodsFor: '*IDE'!
-
-inspectOn: anInspector
-	| variables |
-	variables := Dictionary new.
-	variables at: '#self' put: self.
-	variables at: '#keys' put: self keys.
-	self keysAndValuesDo: [:key :value |
-		variables at: key put: value].
-	anInspector 
-		setLabel: self printString;
-		setVariables: variables
-! !
-
 !Dictionary methodsFor: 'accessing'!
 
 size

st/Parser.st

@@ -937,7 +937,6 @@ exportMethod: aMethod of: aClass on: aStream
 		nextPutAll: ');';lf;lf
 !
 
-
 exportCategoryExtensions: aString on: aStream
 	Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
 		each methodDictionary values do: [:method |
@@ -980,18 +979,13 @@ exportMethod: aMethod of: aClass on: aStream
 
 exportMethodsOf: aClass on: aStream
 
-    | methodsByCategory |
-    methodsByCategory := Dictionary new.
-    aClass methodDictionary values do: [:m |
-	(methodsByCategory at: m category ifAbsentPut: [Array new])
- 		add: m]. 
-    aClass protocols do: [:category |       
-	aStream
-		nextPutAll: '!!', (self classNameFor: aClass);
-		nextPutAll: ' methodsFor: ''', category, '''!!'.
-    	(methodsByCategory at: category) do: [:each |
-		self exportMethod: each of: aClass on: aStream].
-	aStream nextPutAll: ' !!'; lf; lf]
+   aClass protocolsDo: [:category :methods |
+	(category match: '^\*') ifFalse: [ 
+		self
+			exportMethods: methods
+			category: category
+			of: aClass
+			on: aStream]]
 !
 
 exportMetaDefinitionOf: aClass on: aStream
@@ -1021,5 +1015,26 @@ chunkEscape: aString
 
 	^aString replace: '!!' with: '!!!!'
 
+!
+
+exportCategoryExtensions: aString on: aStream
+	"We need to override this one too since we need to group
+	all methods in a given protocol under a leading methodsFor: chunk
+	for that class."
+
+	Smalltalk current classes, (Smalltalk current classes collect: [:each | each class]) do: [:each |
+		each protocolsDo: [:category :methods |
+			category = ('*', aString) ifTrue: [
+				self exportMethods: methods category: category of: each on: aStream]]]
+!
+
+exportMethods: methods category: category of: aClass on: aStream
+
+	aStream
+		nextPutAll: '!!', (self classNameFor: aClass);
+		nextPutAll: ' methodsFor: ''', category, '''!!'.
+    	methods do: [:each |
+		self exportMethod: each of: aClass on: aStream].
+	aStream nextPutAll: ' !!'; lf; lf
 ! !