Browse Source

- Fixed SystemAnnouncer references
- More announcements & class comments

Nicolas Petton 11 years ago
parent
commit
8570d13aef

+ 7 - 0
js/Kernel-Announcements.js

@@ -164,6 +164,7 @@ smalltalk.Announcer);
 
 
 smalltalk.addClass('SystemAnnouncer', smalltalk.Announcer, [], 'Kernel-Announcements');
+smalltalk.SystemAnnouncer.comment="My unique instance #current is the global announcer handling all Amber system-related announces"
 
 smalltalk.SystemAnnouncer.klass.iVarNames = ['current'];
 smalltalk.addMethod(
@@ -207,6 +208,7 @@ smalltalk.SystemAnnouncer.klass);
 
 
 smalltalk.addClass('SystemAnnouncement', smalltalk.Object, ['theClass'], 'Kernel-Announcements');
+smalltalk.SystemAnnouncement.comment="I am the superclass of all system announcements"
 smalltalk.addMethod(
 "_theClass",
 smalltalk.method({
@@ -242,18 +244,23 @@ smalltalk.SystemAnnouncement);
 
 
 smalltalk.addClass('ClassAdded', smalltalk.SystemAnnouncement, [], 'Kernel-Announcements');
+smalltalk.ClassAdded.comment="I am emitted when a class is added to the system.\x0aSee ClassBuilder >> #addSubclassOf:... methods"
 
 
 smalltalk.addClass('ClassCommentChanged', smalltalk.SystemAnnouncement, [], 'Kernel-Announcements');
+smalltalk.ClassCommentChanged.comment="I am emitted when the comment of a class changes. (Behavior >> #comment)"
 
 
 smalltalk.addClass('ClassDefinitionChanged', smalltalk.SystemAnnouncement, [], 'Kernel-Announcements');
+smalltalk.ClassDefinitionChanged.comment="I am emitted when the defintion of a class changes.\x0aSee ClassBuilder >> #class:instanceVariableNames:"
 
 
 smalltalk.addClass('ClassRemoved', smalltalk.SystemAnnouncement, [], 'Kernel-Announcements');
+smalltalk.ClassRemoved.comment="I am emitted when a class is removed.\x0aSee Smalltalk >> #removeClass:"
 
 
 smalltalk.addClass('ClassRenamed', smalltalk.SystemAnnouncement, [], 'Kernel-Announcements');
+smalltalk.ClassRenamed.comment="I am emitted when a class is renamed.\x0aSee ClassBuilder >> #renameClass:to:"
 
 
 smalltalk.addClass('MethodAnnouncement', smalltalk.SystemAnnouncement, ['method'], 'Kernel-Announcements');

+ 2 - 2
js/Kernel-Classes.deploy.js

@@ -112,7 +112,7 @@ smalltalk.send(self,"_basicAt_put_",["comment",aString]);
 $1=smalltalk.send((smalltalk.ClassCommentChanged || ClassCommentChanged),"_new",[]);
 smalltalk.send($1,"_theClass_",[self]);
 $2=smalltalk.send($1,"_yourself",[]);
-smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_new",[]),"_announce_",[$2]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$2]);
 return self}
 }),
 smalltalk.Behavior);
@@ -644,7 +644,7 @@ smalltalk.send(aClass,"_basicAt_put_",["iVarNames",smalltalk.send(self,"_instanc
 $2=smalltalk.send((smalltalk.ClassDefinitionChanged || ClassDefinitionChanged),"_new",[]);
 smalltalk.send($2,"_theClass_",[aClass]);
 $3=smalltalk.send($2,"_yourself",[]);
-smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_new",[]),"_announce_",[$3]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$3]);
 smalltalk.send(self,"_setupClass_",[aClass]);
 return self}
 }),

+ 6 - 6
js/Kernel-Classes.js

@@ -144,11 +144,11 @@ smalltalk.send(self,"_basicAt_put_",["comment",aString]);
 $1=smalltalk.send((smalltalk.ClassCommentChanged || ClassCommentChanged),"_new",[]);
 smalltalk.send($1,"_theClass_",[self]);
 $2=smalltalk.send($1,"_yourself",[]);
-smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_new",[]),"_announce_",[$2]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$2]);
 return self},
 args: ["aString"],
-source: "comment: aString\x0a    self basicAt: 'comment' put: aString.\x0a    SystemAnnouncer new\x0a    \x09announce: (ClassCommentChanged new\x0a        \x09theClass: self;\x0a            yourself)",
-messageSends: ["basicAt:put:", "announce:", "theClass:", "new", "yourself"],
+source: "comment: aString\x0a    self basicAt: 'comment' put: aString.\x0a    SystemAnnouncer current\x0a    \x09announce: (ClassCommentChanged new\x0a        \x09theClass: self;\x0a            yourself)",
+messageSends: ["basicAt:put:", "announce:", "theClass:", "new", "yourself", "current"],
 referencedClasses: ["ClassCommentChanged", "SystemAnnouncer"]
 }),
 smalltalk.Behavior);
@@ -869,12 +869,12 @@ smalltalk.send(aClass,"_basicAt_put_",["iVarNames",smalltalk.send(self,"_instanc
 $2=smalltalk.send((smalltalk.ClassDefinitionChanged || ClassDefinitionChanged),"_new",[]);
 smalltalk.send($2,"_theClass_",[aClass]);
 $3=smalltalk.send($2,"_yourself",[]);
-smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_new",[]),"_announce_",[$3]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$3]);
 smalltalk.send(self,"_setupClass_",[aClass]);
 return self},
 args: ["aClass", "aString"],
-source: "class: aClass instanceVariableNames: aString\x0a\x09aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].\x0a\x09aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).\x0a    \x0a    SystemAnnouncer new\x0a    \x09announce: (ClassDefinitionChanged new\x0a        \x09theClass: aClass;\x0a            yourself).\x0a    \x0a\x09self setupClass: aClass",
-messageSends: ["ifFalse:", "error:", ",", "name", "isMetaclass", "basicAt:put:", "instanceVariableNamesFor:", "announce:", "theClass:", "new", "yourself", "setupClass:"],
+source: "class: aClass instanceVariableNames: aString\x0a\x09aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].\x0a\x09aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).\x0a    \x0a    SystemAnnouncer current\x0a    \x09announce: (ClassDefinitionChanged new\x0a        \x09theClass: aClass;\x0a            yourself).\x0a    \x0a\x09self setupClass: aClass",
+messageSends: ["ifFalse:", "error:", ",", "name", "isMetaclass", "basicAt:put:", "instanceVariableNamesFor:", "announce:", "theClass:", "new", "yourself", "current", "setupClass:"],
 referencedClasses: ["ClassDefinitionChanged", "SystemAnnouncer"]
 }),
 smalltalk.ClassBuilder);

+ 19 - 12
js/Kernel-Objects.deploy.js

@@ -2986,18 +2986,25 @@ smalltalk.addMethod(
 "_removeClass_",
 smalltalk.method({
 selector: "removeClass:",
-fn: function (aClass) {
-    var self = this;
-    var $1;
-    $1 = smalltalk.send(aClass, "_isMetaclass", []);
-    if (smalltalk.assert($1)) {
-        smalltalk.send(self, "_error_", [smalltalk.send(smalltalk.send(aClass, "_asString", []), "__comma", [" is a Metaclass and cannot be removed!"])]);
-    }
-    smalltalk.send(smalltalk.send(smalltalk.send(aClass, "_methodDictionary", []), "_values", []), "_do_", [function (each) {return smalltalk.send(aClass, "_removeCompiledMethod_", [each]);}]);
-    smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(aClass, "_class", []), "_methodDictionary", []), "_values", []), "_do_", [function (each) {return smalltalk.send(smalltalk.send(aClass, "_class", []), "_removeCompiledMethod_", [each]);}]);
-    smalltalk.send(self, "_basicDelete_", [smalltalk.send(aClass, "_name", [])]);
-    return self;
-}
+fn: function (aClass){
+var self=this;
+var $1,$2,$3;
+$1=smalltalk.send(aClass,"_isMetaclass",[]);
+if(smalltalk.assert($1)){
+smalltalk.send(self,"_error_",[smalltalk.send(smalltalk.send(aClass,"_asString",[]),"__comma",[" is a Metaclass and cannot be removed!"])]);
+};
+smalltalk.send(smalltalk.send(smalltalk.send(aClass,"_methodDictionary",[]),"_values",[]),"_do_",[(function(each){
+return smalltalk.send(aClass,"_removeCompiledMethod_",[each]);
+})]);
+smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(aClass,"_class",[]),"_methodDictionary",[]),"_values",[]),"_do_",[(function(each){
+return smalltalk.send(smalltalk.send(aClass,"_class",[]),"_removeCompiledMethod_",[each]);
+})]);
+smalltalk.send(self,"_basicDelete_",[smalltalk.send(aClass,"_name",[])]);
+$2=smalltalk.send((smalltalk.ClassRemoved || ClassRemoved),"_new",[]);
+smalltalk.send($2,"_theClass_",[aClass]);
+$3=smalltalk.send($2,"_yourself",[]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$3]);
+return self}
 }),
 smalltalk.Smalltalk);
 

+ 22 - 15
js/Kernel-Objects.js

@@ -4116,22 +4116,29 @@ smalltalk.addMethod(
 smalltalk.method({
 selector: "removeClass:",
 category: 'classes',
-fn: function (aClass) {
-    var self = this;
-    var $1;
-    $1 = smalltalk.send(aClass, "_isMetaclass", []);
-    if (smalltalk.assert($1)) {
-        smalltalk.send(self, "_error_", [smalltalk.send(smalltalk.send(aClass, "_asString", []), "__comma", [" is a Metaclass and cannot be removed!"])]);
-    }
-    smalltalk.send(smalltalk.send(smalltalk.send(aClass, "_methodDictionary", []), "_values", []), "_do_", [function (each) {return smalltalk.send(aClass, "_removeCompiledMethod_", [each]);}]);
-    smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(aClass, "_class", []), "_methodDictionary", []), "_values", []), "_do_", [function (each) {return smalltalk.send(smalltalk.send(aClass, "_class", []), "_removeCompiledMethod_", [each]);}]);
-    smalltalk.send(self, "_basicDelete_", [smalltalk.send(aClass, "_name", [])]);
-    return self;
-},
+fn: function (aClass){
+var self=this;
+var $1,$2,$3;
+$1=smalltalk.send(aClass,"_isMetaclass",[]);
+if(smalltalk.assert($1)){
+smalltalk.send(self,"_error_",[smalltalk.send(smalltalk.send(aClass,"_asString",[]),"__comma",[" is a Metaclass and cannot be removed!"])]);
+};
+smalltalk.send(smalltalk.send(smalltalk.send(aClass,"_methodDictionary",[]),"_values",[]),"_do_",[(function(each){
+return smalltalk.send(aClass,"_removeCompiledMethod_",[each]);
+})]);
+smalltalk.send(smalltalk.send(smalltalk.send(smalltalk.send(aClass,"_class",[]),"_methodDictionary",[]),"_values",[]),"_do_",[(function(each){
+return smalltalk.send(smalltalk.send(aClass,"_class",[]),"_removeCompiledMethod_",[each]);
+})]);
+smalltalk.send(self,"_basicDelete_",[smalltalk.send(aClass,"_name",[])]);
+$2=smalltalk.send((smalltalk.ClassRemoved || ClassRemoved),"_new",[]);
+smalltalk.send($2,"_theClass_",[aClass]);
+$3=smalltalk.send($2,"_yourself",[]);
+smalltalk.send(smalltalk.send((smalltalk.SystemAnnouncer || SystemAnnouncer),"_current",[]),"_announce_",[$3]);
+return self},
 args: ["aClass"],
-source: "removeClass: aClass\x0a\x09aClass isMetaclass ifTrue: [self error: aClass asString, ' is a Metaclass and cannot be removed!'].\x0a\x09aClass methodDictionary values do: [:each |\x0a\x09\x09aClass removeCompiledMethod: each].\x0a\x09aClass class methodDictionary values do: [:each |\x0a\x09\x09aClass class removeCompiledMethod: each].\x0a\x09self basicDelete: aClass name",
-messageSends: ["ifTrue:", "error:", ",", "asString", "isMetaclass", "do:", "removeCompiledMethod:", "values", "methodDictionary", "class", "basicDelete:", "name"],
-referencedClasses: []
+source: "removeClass: aClass\x0a\x09aClass isMetaclass ifTrue: [self error: aClass asString, ' is a Metaclass and cannot be removed!'].\x0a    \x0a\x09aClass methodDictionary values do: [:each |\x0a\x09\x09aClass removeCompiledMethod: each].\x0a        \x0a\x09aClass class methodDictionary values do: [:each |\x0a\x09\x09aClass class removeCompiledMethod: each].\x0a        \x0a\x09self basicDelete: aClass name.\x0a    \x0a    SystemAnnouncer current\x0a    \x09announce: (ClassRemoved new\x0a        \x09theClass: aClass;\x0a            yourself)",
+messageSends: ["ifTrue:", "error:", ",", "asString", "isMetaclass", "do:", "removeCompiledMethod:", "values", "methodDictionary", "class", "basicDelete:", "name", "announce:", "theClass:", "new", "yourself", "current"],
+referencedClasses: ["ClassRemoved", "SystemAnnouncer"]
 }),
 smalltalk.Smalltalk);
 

+ 18 - 0
st/Kernel-Announcements.st

@@ -62,6 +62,8 @@ on: aClass do: aBlock
 Announcer subclass: #SystemAnnouncer
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!SystemAnnouncer commentStamp!
+My unique instance #current is the global announcer handling all Amber system-related announces!
 
 SystemAnnouncer class instanceVariableNames: 'current'!
 
@@ -80,6 +82,8 @@ new
 Object subclass: #SystemAnnouncement
 	instanceVariableNames: 'theClass'
 	package: 'Kernel-Announcements'!
+!SystemAnnouncement commentStamp!
+I am the superclass of all system announcements!
 
 !SystemAnnouncement methodsFor: 'accessing'!
 
@@ -94,22 +98,36 @@ theClass: aClass
 SystemAnnouncement subclass: #ClassAdded
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!ClassAdded commentStamp!
+I am emitted when a class is added to the system.
+See ClassBuilder >> #addSubclassOf:... methods!
 
 SystemAnnouncement subclass: #ClassCommentChanged
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!ClassCommentChanged commentStamp!
+I am emitted when the comment of a class changes. (Behavior >> #comment)!
 
 SystemAnnouncement subclass: #ClassDefinitionChanged
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!ClassDefinitionChanged commentStamp!
+I am emitted when the defintion of a class changes.
+See ClassBuilder >> #class:instanceVariableNames:!
 
 SystemAnnouncement subclass: #ClassRemoved
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!ClassRemoved commentStamp!
+I am emitted when a class is removed.
+See Smalltalk >> #removeClass:!
 
 SystemAnnouncement subclass: #ClassRenamed
 	instanceVariableNames: ''
 	package: 'Kernel-Announcements'!
+!ClassRenamed commentStamp!
+I am emitted when a class is renamed.
+See ClassBuilder >> #renameClass:to:!
 
 SystemAnnouncement subclass: #MethodAnnouncement
 	instanceVariableNames: 'method'

+ 2 - 2
st/Kernel-Classes.st

@@ -35,7 +35,7 @@ comment
 
 comment: aString
     self basicAt: 'comment' put: aString.
-    SystemAnnouncer new
+    SystemAnnouncer current
     	announce: (ClassCommentChanged new
         	theClass: self;
             yourself)
@@ -299,7 +299,7 @@ class: aClass instanceVariableNames: aString
 	aClass isMetaclass ifFalse: [self error: aClass name, ' is not a metaclass'].
 	aClass basicAt: 'iVarNames' put: (self instanceVariableNamesFor: aString).
     
-    SystemAnnouncer new
+    SystemAnnouncer current
     	announce: (ClassDefinitionChanged new
         	theClass: aClass;
             yourself).

+ 9 - 1
st/Kernel-Objects.st

@@ -1417,11 +1417,19 @@ send: aSelector to: anObject arguments: aCollection
 
 removeClass: aClass
 	aClass isMetaclass ifTrue: [self error: aClass asString, ' is a Metaclass and cannot be removed!!'].
+    
 	aClass methodDictionary values do: [:each |
 		aClass removeCompiledMethod: each].
+        
 	aClass class methodDictionary values do: [:each |
 		aClass class removeCompiledMethod: each].
-	self basicDelete: aClass name
+        
+	self basicDelete: aClass name.
+    
+    SystemAnnouncer current
+    	announce: (ClassRemoved new
+        	theClass: aClass;
+            yourself)
 ! !
 
 !Smalltalk methodsFor: 'packages'!