Better protocols for ClassBuilder methods

js/Kernel-Classes.js

@@ -1146,7 +1146,7 @@ smalltalk.addMethod(
 "_addSubclassOf_named_instanceVariableNames_package_",
 smalltalk.method({
 selector: "addSubclassOf:named:instanceVariableNames:package:",
-category: 'private',
+category: 'class definition',
 fn: function (aClass,aString,aCollection,packageName){
 var self=this;
 var theClass;
@@ -1288,7 +1288,7 @@ smalltalk.addMethod(
 "_class_instanceVariableNames_",
 smalltalk.method({
 selector: "class:instanceVariableNames:",
-category: 'api',
+category: 'class definition',
 fn: function (aClass,aString){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
var $1,$2;
@@ -1310,7 +1310,7 @@ smalltalk.addMethod(
 "_copyClass_named_",
 smalltalk.method({
 selector: "copyClass:named:",
-category: 'private',
+category: 'copying',
 fn: function (aClass,aString){
 var self=this;
 var newClass;
@@ -1331,7 +1331,7 @@ smalltalk.addMethod(
 "_copyClass_to_",
 smalltalk.method({
 selector: "copyClass:to:",
-category: 'private',
+category: 'copying',
 fn: function (aClass,anotherClass){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
_st(anotherClass)._comment_(_st(aClass)._comment());
@@ -1355,7 +1355,7 @@ smalltalk.addMethod(
 "_installMethod_forClass_category_",
 smalltalk.method({
 selector: "installMethod:forClass:category:",
-category: 'api',
+category: 'method definition',
 fn: function (aCompiledMethod,aBehavior,aString){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
var $1;
@@ -1376,7 +1376,7 @@ smalltalk.addMethod(
 "_instanceVariableNamesFor_",
 smalltalk.method({
 selector: "instanceVariableNamesFor:",
-category: 'private',
+category: 'accessing',
 fn: function (aString){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
var $1;
@@ -1396,7 +1396,7 @@ smalltalk.addMethod(
 "_migrateClass_superclass_",
 smalltalk.method({
 selector: "migrateClass:superclass:",
-category: 'private',
+category: 'class migration',
 fn: function (aClass,anotherClass){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
_st(console)._log_(_st(aClass)._name());
@@ -1413,7 +1413,7 @@ smalltalk.addMethod(
 "_migrateClassNamed_superclass_instanceVariableNames_package_",
 smalltalk.method({
 selector: "migrateClassNamed:superclass:instanceVariableNames:package:",
-category: 'private',
+category: 'class migration',
 fn: function (aString,aClass,aCollection,packageName){
 var self=this;
 var oldClass,newClass,tmp;
@@ -1470,7 +1470,7 @@ smalltalk.addMethod(
 "_renameClass_to_",
 smalltalk.method({
 selector: "renameClass:to:",
-category: 'api',
+category: 'class migration',
 fn: function (aClass,aString){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
var $1,$2;
@@ -1491,7 +1491,7 @@ smalltalk.addMethod(
 "_setupClass_",
 smalltalk.method({
 selector: "setupClass:",
-category: 'api',
+category: 'public',
 fn: function (aClass){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
smalltalk.init(aClass);;
@@ -1507,7 +1507,7 @@ smalltalk.addMethod(
 "_superclass_subclass_",
 smalltalk.method({
 selector: "superclass:subclass:",
-category: 'api',
+category: 'class definition',
 fn: function (aClass,aString){
 var self=this;
 return smalltalk.withContext(function($ctx1) { 
var $1;
@@ -1525,7 +1525,7 @@ smalltalk.addMethod(
 "_superclass_subclass_instanceVariableNames_package_",
 smalltalk.method({
 selector: "superclass:subclass:instanceVariableNames:package:",
-category: 'api',
+category: 'class definition',
 fn: function (aClass,aString,aString2,aString3){
 var self=this;
 var newClass;

st/Kernel-Classes.st

@@ -394,38 +394,44 @@ ClassBuilder is responsible for compiling new classes or modifying existing clas
 
 Rather than using ClassBuilder directly to compile a class, use `Class >> subclass:instanceVariableNames:package:`.!
 
-!ClassBuilder methodsFor: 'api'!
+!ClassBuilder methodsFor: 'accessing'!
 
-class: aClass instanceVariableNames: aString
-	self basicClass: aClass instanceVariableNames: aString.
-    self setupClass: aClass.
+instanceVariableNamesFor: aString
+	^(aString tokenize: ' ') reject: [ :each | each isEmpty ]
+! !
+
+!ClassBuilder methodsFor: 'class definition'!
+
+addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
+    | theClass |
     
-    SystemAnnouncer current
-    	announce: (ClassDefinitionChanged new
-        	theClass: aClass;
-            yourself)
-!
+    theClass := Smalltalk current at: aString.
+    
+   	theClass ifNotNil: [ 
+    	theClass superclass == aClass ifFalse: [
+    		^ self 
+        		migrateClassNamed: aString 
+           	 	superclass: aClass 
+           	 	instanceVariableNames: aCollection 
+            	package: packageName ] ].
 
-installMethod: aCompiledMethod forClass: aBehavior category: aString
-	aCompiledMethod category: aString.
-	aBehavior addCompiledMethod: aCompiledMethod.
-    self setupClass: aBehavior.
-	^aCompiledMethod
+	^ self 
+    	basicAddSubclassOf: aClass 
+        named: aString 
+        instanceVariableNames: aCollection 
+        package: packageName
 !
 
-renameClass: aClass to: aString
-	self basicRenameClass: aClass to: aString.
+class: aClass instanceVariableNames: aString
+	self basicClass: aClass instanceVariableNames: aString.
+    self setupClass: aClass.
     
     SystemAnnouncer current
-    	announce: (ClassRenamed new
+    	announce: (ClassDefinitionChanged new
         	theClass: aClass;
             yourself)
 !
 
-setupClass: aClass
-	<smalltalk.init(aClass);>
-!
-
 superclass: aClass subclass: aString
 	^self superclass: aClass subclass: aString instanceVariableNames: '' package: nil
 !
@@ -446,64 +452,60 @@ superclass: aClass subclass: aString instanceVariableNames: aString2 package: aS
 	^newClass
 ! !
 
-!ClassBuilder methodsFor: 'private'!
+!ClassBuilder methodsFor: 'class migration'!
 
-addSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
-    | theClass |
+migrateClass: aClass superclass: anotherClass
+	console log: aClass name.
+	self 
+    	migrateClassNamed: aClass name
+        superclass: anotherClass
+        instanceVariableNames: aClass instanceVariableNames
+        package: aClass package name
+!
+
+migrateClassNamed: aString superclass: aClass instanceVariableNames: aCollection package: packageName
+	| oldClass newClass tmp |
     
-    theClass := Smalltalk current at: aString.
+    tmp := 'new*', aString.
+    oldClass := Smalltalk current at: aString.
     
-   	theClass ifNotNil: [ 
-    	theClass superclass == aClass ifFalse: [
-    		^ self 
-        		migrateClassNamed: aString 
-           	 	superclass: aClass 
-           	 	instanceVariableNames: aCollection 
-            	package: packageName ] ].
-
-	^ self 
-    	basicAddSubclassOf: aClass 
-        named: aString 
-        instanceVariableNames: aCollection 
-        package: packageName
-!
+    newClass := self 
+		addSubclassOf: aClass
+		named: tmp
+		instanceVariableNames: aCollection
+		package: packageName.
 
-basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
-	<
-		smalltalk.addClass(aString, aClass, aCollection, packageName);
-		return smalltalk[aString]
-	>
-!
+	self basicSwapClassNames: oldClass with: newClass.
 
-basicClass: aClass instanceVariableNames: aString
-	self basicClass: aClass instanceVariables: (self instanceVariableNamesFor: aString)
-!
+	[ self copyClass: oldClass to: newClass ]
+		on: Error
+		do: [ :exception |
+			self
+            	basicSwapClassNames: oldClass with: newClass;
+            	basicRemoveClass: newClass.
+            exception signal ].
 
-basicClass: aClass instanceVariables: aCollection
+	self
+		rawRenameClass: oldClass to: tmp;
+        rawRenameClass: newClass to: aString.
 
-	aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
-	aClass basicAt: 'iVarNames' put: aCollection
-!
+	oldClass subclasses do: [ :each |
+    	self migrateClass: each superclass: newClass ].
 
-basicRemoveClass: aClass
-	<smalltalk.removeClass(aClass)>
+    self basicRemoveClass: oldClass.
+	^newClass
 !
 
-basicRenameClass: aClass to: aString
-	<
-		smalltalk[aString] = aClass;
-		delete smalltalk[aClass.className];
-		aClass.className = aString;
-	>
-!
+renameClass: aClass to: aString
+	self basicRenameClass: aClass to: aString.
+    
+    SystemAnnouncer current
+    	announce: (ClassRenamed new
+        	theClass: aClass;
+            yourself)
+! !
 
-basicSwapClassNames: aClass with: anotherClass
-	<
-		var tmp = aClass.className;
-		aClass.className = anotherClass.className;
-        anotherClass.className = tmp;
-	>
-!
+!ClassBuilder methodsFor: 'copying'!
 
 copyClass: aClass named: aString
 	| newClass |
@@ -532,52 +534,54 @@ copyClass: aClass to: anotherClass
 		Compiler new install: each source forClass: anotherClass class category: each category ].
 
 	self setupClass: anotherClass
-!
+! !
 
-instanceVariableNamesFor: aString
-	^(aString tokenize: ' ') reject: [ :each | each isEmpty ]
-!
+!ClassBuilder methodsFor: 'method definition'!
 
-migrateClass: aClass superclass: anotherClass
-	console log: aClass name.
-	self 
-    	migrateClassNamed: aClass name
-        superclass: anotherClass
-        instanceVariableNames: aClass instanceVariableNames
-        package: aClass package name
+installMethod: aCompiledMethod forClass: aBehavior category: aString
+	aCompiledMethod category: aString.
+	aBehavior addCompiledMethod: aCompiledMethod.
+    self setupClass: aBehavior.
+	^aCompiledMethod
+! !
+
+!ClassBuilder methodsFor: 'private'!
+
+basicAddSubclassOf: aClass named: aString instanceVariableNames: aCollection package: packageName
+	<
+		smalltalk.addClass(aString, aClass, aCollection, packageName);
+		return smalltalk[aString]
+	>
 !
 
-migrateClassNamed: aString superclass: aClass instanceVariableNames: aCollection package: packageName
-	| oldClass newClass tmp |
-    
-    tmp := 'new*', aString.
-    oldClass := Smalltalk current at: aString.
-    
-    newClass := self 
-		addSubclassOf: aClass
-		named: tmp
-		instanceVariableNames: aCollection
-		package: packageName.
+basicClass: aClass instanceVariableNames: aString
+	self basicClass: aClass instanceVariables: (self instanceVariableNamesFor: aString)
+!
 
-	self basicSwapClassNames: oldClass with: newClass.
+basicClass: aClass instanceVariables: aCollection
 
-	[ self copyClass: oldClass to: newClass ]
-		on: Error
-		do: [ :exception |
-			self
-            	basicSwapClassNames: oldClass with: newClass;
-            	basicRemoveClass: newClass.
-            exception signal ].
+	aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
+	aClass basicAt: 'iVarNames' put: aCollection
+!
 
-	self
-		rawRenameClass: oldClass to: tmp;
-        rawRenameClass: newClass to: aString.
+basicRemoveClass: aClass
+	<smalltalk.removeClass(aClass)>
+!
 
-	oldClass subclasses do: [ :each |
-    	self migrateClass: each superclass: newClass ].
+basicRenameClass: aClass to: aString
+	<
+		smalltalk[aString] = aClass;
+		delete smalltalk[aClass.className];
+		aClass.className = aString;
+	>
+!
 
-    self basicRemoveClass: oldClass.
-	^newClass
+basicSwapClassNames: aClass with: anotherClass
+	<
+		var tmp = aClass.className;
+		aClass.className = anotherClass.className;
+        anotherClass.className = tmp;
+	>
 !
 
 rawRenameClass: aClass to: aString
@@ -586,6 +590,12 @@ rawRenameClass: aClass to: aString
 	>
 ! !
 
+!ClassBuilder methodsFor: 'public'!
+
+setupClass: aClass
+	<smalltalk.init(aClass);>
+! !
+
 Object subclass: #ClassCategoryReader
 	instanceVariableNames: 'class category'
 	package: 'Kernel-Classes'!