ClassOrganizer.st
changeset 27 d24c4aec6d07
parent 20 dbeb4f20377e
child 33 f3e3547869dc
--- a/ClassOrganizer.st	Tue Apr 11 17:28:58 1995 +0200
+++ b/ClassOrganizer.st	Tue May 02 01:02:29 1995 +0200
@@ -10,14 +10,14 @@
  hereby transferred.
 "
 
-Object subclass:#ClassOrganization
-	 instanceVariableNames:'class'
+Object subclass:#ClassOrganizer
+	 instanceVariableNames:'globalComment categoryArray categoryStops elementArray class'
 	 classVariableNames:''
 	 poolDictionaries:''
-	 category:'System-Support'
+	 category:'Kernel-Support'
 !
 
-!ClassOrganization class methodsFor:'documentation'!
+!ClassOrganizer class methodsFor:'documentation'!
 
 copyright
 "
@@ -35,7 +35,7 @@
 
 version
 "
-$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.1 1995-02-22 01:15:44 claus Exp $
+$Header: /cvs/stx/stx/libbasic3/ClassOrganizer.st,v 1.2 1995-05-01 23:02:15 claus Exp $
 "
 !
 
@@ -44,15 +44,20 @@
     in contrast to other smalltalks, ST/X does not keep the
     method <-> category associations in the class (as organization),
     but instead keeps the category as an instance variable of method.
-    This may change in future versions.
 
     For compatibility with (fileOut-) files which include a class organization
-    message, aClass organization returns an instance of this class, which
+    message, 'aClass organization' returns an instance of this class, which
     implements the category change functionality.
+    Also, some PD code seems to use & define methods for ClassOrganizers - having this
+    (somewhat dummy) around helps to fileIn that code.
+
+    Notice, that instances of ClassOrganizer are not used in the current ST/X
+    system; all is pure mimicri.
+    This may change in future versions.
 "
 ! !
 
-!ClassOrganization class methodsFor:'instance creation'!
+!ClassOrganizer class methodsFor:'instance creation'!
 
 for:aClass
     "create & return a new instance of myself, to organize aClass"
@@ -60,7 +65,95 @@
     ^ self new class:aClass
 ! !
 
-!ClassOrganization  methodsFor:'private access'!
+!ClassOrganizer  methodsFor:'accessing'!
+
+classComment
+    ^ class comment
+
+    "
+     Number organization classComment  
+    "
+!
+
+categoryOfElement:aSelectorSymbol
+    |m|
+
+    m := class compiledMethodAt:aSelectorSymbol.
+    m isNil ifTrue:[^ nil].
+    ^ m category
+
+    "
+     Number organization categoryOfElement:#foo. 
+     Object organization categoryOfElement:#==   
+    "
+!
+
+listAtCategoryNamed:aCategorySymbol
+    "return a collection of selectors whose methods are categorized
+     as aCategorySymbol"
+
+    |list|
+
+    list := OrderedCollection new.
+    class methodArray with:class selectorArray do:[:m :s |
+	m category == aCategorySymbol ifTrue:[list add:s]
+    ].
+    ^ list asArray
+
+    "
+     SmallInteger organization listAtCategoryNamed:#arithmetic 
+    "
+!
+
+categories
+    "return a collection of categorySymbols"
+
+    |set|
+
+    set := IdentitySet new.
+    class methodArray do:[:m |
+	set add:m category
+    ].
+    ^ set asArray
+
+    "
+     SmallInteger organization categories 
+    "
+! !
+
+!ClassOrganizer methodsFor:'printing & storing'!
+
+printOn:aStream
+    |coll|
+
+    coll := IdentityDictionary new.
+    class methodArray with:class selectorArray do:[:m :s |
+	|cat list|
+
+	cat := m category.
+	list := coll at:cat ifAbsent:[].
+	list isNil ifTrue:[
+	    coll at:cat put:(list := OrderedCollection new).
+	].
+	list add:s
+    ].
+    coll keysAndValuesDo:[:category :list |
+	aStream nextPut:$(.
+	aStream nextPutAll:category asString storeString.
+	list do:[:selector |
+	    aStream space.
+	    selector storeOn:aStream
+	].
+	aStream nextPut:$).
+	aStream cr
+    ]
+
+    "
+     Number organization printString
+    "
+! !
+
+!ClassOrganizer methodsFor:'private access'!
 
 class:aClass
     "set the class"
@@ -68,7 +161,7 @@
     class := aClass
 ! !
 
-!ClassOrganization methodsFor:'changing'!
+!ClassOrganizer methodsFor:'changing'!
 
 changeFromString:organizationString
     "take category<->selector associations from aString, and change
@@ -103,4 +196,3 @@
 					      ( ''category2'' #bar1 #bar2)'
     "
 ! !
-