SystemOrganizer.st
changeset 901 8fd26c5e8e8f
parent 899 7b65d6f2b0f0
child 906 862b6903fbf3
--- a/SystemOrganizer.st	Sat Feb 05 15:37:38 2000 +0100
+++ b/SystemOrganizer.st	Mon Feb 07 12:16:03 2000 +0100
@@ -1,59 +1,89 @@
 Object subclass:#SystemOrganizer
-	instanceVariableNames:'categoryArray categories nameSpace'
-	classVariableNames:''
+	instanceVariableNames:'categoryArray nameSpace'
+	classVariableNames:'AllCategories'
 	poolDictionaries:''
 	category:'Kernel-Support'
 !
 
+!SystemOrganizer class methodsFor:'documentation'!
+
+documentation
+"
+     In ST80, there is a systemOrganization, which groups classes
+     to categories.
+     All of this here is mimicri - ST/X keeps the category in the class.
+     This class simulates the ST80 behavior.
+"
+! !
 
 !SystemOrganizer class methodsFor:'instance creation'!
 
 for:aNameSpace
-    "create & return a new instance of myself, to organize aNameSpace"
+    "create & return a new instance of myself, to organize aNameSpace.
+     All of this here is mimicri - ST/X keeps the category in the class."
 
-    ^ self new nameSpace:aNameSpace
+    ^ self new nameSpace:aNameSpace.
 
-    "Created: / 20.6.1998 / 12:33:52 / cg"
+    "Modified: / 6.2.2000 / 20:25:50 / cg"
 ! !
 
 !SystemOrganizer methodsFor:'accessing'!
 
+addCategory:aCategory before:someOtherCategory
+    (categoryArray isNil
+    or:[(categoryArray includes:aCategory) not]) ifTrue:[
+        categoryArray := nil.
+        AllCategories add:aCategory.
+    ].
+
+    "Created: / 6.2.2000 / 20:42:20 / cg"
+    "Modified: / 6.2.2000 / 20:44:34 / cg"
+!
+
 categories
     "return a collection of my classes class-categories.
      If my nameSpace is nil, all classes' categories are included;
      otherwise, only the categories of that particular namespace."
 
-    |set categorySet searchedNamespace allNames|
-
-    categoryArray isNil ifTrue:[
-        categorySet := Set new.
+    |addClassAction categorySet searchedNamespace allNames|
 
-        (searchedNamespace := nameSpace) isNil ifTrue:[
-            allNames := true.
-            searchedNamespace := Smalltalk.
-        ].
+    categoryArray notNil ifTrue:[
+        ^ categoryArray
+    ].
 
-        searchedNamespace allBehaviorsDo:[:aClass |
-            |cat|
+    addClassAction := [:aClass |
+        |cat|
 
-            aClass isMeta ifFalse:[
-                (aClass isNamespace not 
-                or:[aClass == Namespace 
-                or:[aClass == Smalltalk]]) ifTrue:[
-                    (allNames or:[aClass nameSpace == nameSpace]) ifTrue:[
-                        cat := aClass category.
-                        cat isNil ifTrue:[
-                            cat := '* no category *'
-                        ].
-                        cat ~= 'obsolete' ifTrue:[
-                            categorySet add:cat
-                        ]
-                    ]
+        aClass isMeta ifFalse:[
+            (aClass isNamespace not) ifTrue:[
+                cat := aClass category.
+                cat isNil ifTrue:[
+                    cat := '* no category *'
+                ].
+                cat ~= 'obsolete' ifTrue:[
+                    categorySet add:cat
                 ]
             ]
         ].
-        categoryArray := categorySet asArray sort.
+    ].
+
+    AllCategories isNil ifTrue:[
+        categorySet := Set new.
+        Smalltalk allBehaviorsDo:addClassAction.
+        AllCategories := categorySet.
     ].
+        
+    (searchedNamespace := nameSpace) isNil ifTrue:[
+        allNames := true.
+        searchedNamespace := Smalltalk.
+    ].
+    searchedNamespace == Smalltalk ifTrue:[
+        categorySet := AllCategories.
+    ] ifFalse:[
+        categorySet := Set new.
+        searchedNamespace allBehaviorsDo:addClassAction.
+    ].
+    categoryArray := categorySet asArray sort.
     ^ categoryArray
 
     "
@@ -62,7 +92,7 @@
      (SystemOrganizer for:Demos) categories 
     "
 
-    "Modified: / 20.6.1998 / 12:40:42 / cg"
+    "Modified: / 6.2.2000 / 20:33:42 / cg"
 !
 
 categoryOfElement:aClassName
@@ -72,21 +102,38 @@
     |cls|
 
     cls := Smalltalk at:aClassName ifAbsent:nil.
-    cls notNil ifTrue:[^ cls category].
+    cls notNil ifTrue:[
+        ^ cls category
+    ].
     self error:'no such class'.
+
+    "Modified: / 6.2.2000 / 20:12:10 / cg"
 !
 
 classify:aClassName under:newCategory
     "change a classes category;
      the argument is the classes name"
 
-    |cls|
+    |cls cats|
 
     cls := Smalltalk at:aClassName ifAbsent:nil.
-    cls notNil ifTrue:[^ cls category:newCategory].
+    cls notNil ifTrue:[
+        (AllCategories includes:newCategory) ifFalse:[
+            cats := AllCategories asOrderedCollection.
+            cats add:newCategory.
+            cats sort.
+            AllCategories := cats.
+        ].
+        (categoryArray notNil and:[categoryArray includes:newCategory]) not
+        ifTrue:[
+            categoryArray := nil.
+        ].
+        ^ cls category:newCategory
+    ].
     self error:'no such class'.
 
     "Created: / 4.2.2000 / 18:30:11 / cg"
+    "Modified: / 6.2.2000 / 20:36:30 / cg"
 !
 
 listAtCategoryNamed:aCategory
@@ -128,7 +175,16 @@
     "Modified: / 20.6.1998 / 13:34:19 / cg"
 ! !
 
-!SystemOrganizer methodsFor:'private access'!
+!SystemOrganizer methodsFor:'change and update'!
+
+update:something with:anArgument from:changedObject
+    categoryArray := nil.
+
+    "Created: / 6.2.2000 / 20:08:52 / cg"
+    "Modified: / 6.2.2000 / 20:10:21 / cg"
+! !
+
+!SystemOrganizer methodsFor:'private accessing'!
 
 nameSpace:aNameSpace
     "set the nameSpace - nil is allowed and stands for: any"
@@ -147,5 +203,5 @@
 !SystemOrganizer class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/SystemOrganizer.st,v 1.4 2000-02-05 14:28:34 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/SystemOrganizer.st,v 1.5 2000-02-07 11:16:03 cg Exp $'
 ! !