ClassOrganizer.st
changeset 593 e154dad9f21a
parent 592 19591d2ed857
child 631 7f4f308742df
--- a/ClassOrganizer.st	Thu Jun 19 18:24:41 1997 +0200
+++ b/ClassOrganizer.st	Fri Jun 20 18:56:00 1997 +0200
@@ -11,7 +11,8 @@
 "
 
 Object subclass:#ClassOrganizer
-	instanceVariableNames:'globalComment categoryArray categoryStops elementArray class'
+	instanceVariableNames:'globalComment categoryArray categoryStops elementArray class
+		categories'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Support'
@@ -48,6 +49,21 @@
     Notice, that instances of ClassOrganizer are NOT used in the current ST/X
     system; all of this is pure compatibility mimicri.
 
+
+    This is an additional goody class; therefore:
+
+    THIS SOFTWARE IS PROVIDED BY THE CONTRIBUTOR ``AS IS'' AND
+    ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
+    IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
+    ARE DISCLAIMED.  IN NO EVENT SHALL THE CONTRIBUTOR BE LIABLE
+    FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+    DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
+    OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
+    HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
+    LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
+    OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+    SUCH DAMAGE.
+
     [author:]
         Claus Gittinger
 "
@@ -161,6 +177,36 @@
             changeFromString:'( ''category1'' #foo1 #foo2 foo3)
                               ( ''category2'' #bar1 #bar2)'
     "
+!
+
+classify:aSelector under:aCategory
+    "change the category of the method stored under aSelector
+     to aCategory."
+
+    |m list|
+
+    class isNil ifTrue:[
+        "/ sigh used without a class ...
+        categories isNil ifTrue:[
+            categories := Dictionary new.
+        ].
+        list := categories at:aCategory ifAbsent:nil.
+        list isNil ifTrue:[
+            list := OrderedCollection new.
+            categories at:aCategory put:list.
+        ].
+        list add:aSelector.
+        ^ self.
+    ].
+
+    m := class compiledMethodAt:aSelector.
+    m notNil ifTrue:[
+        m category:aCategory
+    ].
+    class changed:#organization
+
+    "Created: 20.6.1997 / 18:01:18 / cg"
+    "Modified: 20.6.1997 / 18:09:37 / cg"
 ! !
 
 !ClassOrganizer methodsFor:'printing & storing'!
@@ -168,16 +214,20 @@
 printOn:aStream
     |coll|
 
-    coll := IdentityDictionary new.
-    class methodDictionary keysAndValuesDo:[:sel :mthd |
-        |cat list|
+    class notNil ifTrue:[
+        coll := IdentityDictionary new.
+        class methodDictionary keysAndValuesDo:[:sel :mthd |
+            |cat list|
 
-        cat := mthd category.
-        list := coll at:cat ifAbsent:[].
-        list isNil ifTrue:[
-            coll at:cat put:(list := OrderedCollection new).
+            cat := mthd category.
+            list := coll at:cat ifAbsent:[].
+            list isNil ifTrue:[
+                coll at:cat put:(list := OrderedCollection new).
+            ].
+            list add:sel
         ].
-        list add:sel
+    ] ifFalse:[
+        coll := categories
     ].
     coll keysAndValuesDo:[:category :list |
         aStream nextPut:$(.
@@ -193,6 +243,8 @@
     "
      Number organization printString
     "
+
+    "Modified: 20.6.1997 / 18:08:15 / cg"
 ! !
 
 !ClassOrganizer methodsFor:'private access'!
@@ -206,5 +258,5 @@
 !ClassOrganizer class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.10 1997-06-19 16:24:41 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.11 1997-06-20 16:56:00 cg Exp $'
 ! !