initial checkin
authorClaus Gittinger <cg@exept.de>
Sat, 20 Jun 1998 13:22:25 +0200
changeset 688 5d925b1c32c1
parent 687 47729447d24a
child 689 1d4a311dd765
initial checkin
SystemOrganizer.st
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/SystemOrganizer.st	Sat Jun 20 13:22:25 1998 +0200
@@ -0,0 +1,88 @@
+Object subclass:#SystemOrganizer
+	instanceVariableNames:'categoryArray categories nameSpace'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'Kernel-Support'
+!
+
+
+!SystemOrganizer class methodsFor:'instance creation'!
+
+for:aNameSpace
+    "create & return a new instance of myself, to organize aNameSpace"
+
+    ^ self new nameSpace:aNameSpace
+
+    "Created: / 20.6.1998 / 12:33:52 / cg"
+! !
+
+!SystemOrganizer methodsFor:'accessing'!
+
+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.
+
+        (searchedNamespace := nameSpace) isNil ifTrue:[
+            allNames := true.
+            searchedNamespace := Smalltalk.
+        ].
+
+        searchedNamespace allBehaviorsDo:[: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
+                        ]
+                    ]
+                ]
+            ]
+        ].
+        categoryArray := categorySet asArray sort.
+    ].
+    ^ categoryArray
+
+    "
+     (SystemOrganizer for:nil) categories 
+     (SystemOrganizer for:Smalltalk) categories 
+     (SystemOrganizer for:Demos) categories 
+    "
+
+    "Modified: / 20.6.1998 / 12:40:42 / cg"
+! !
+
+!SystemOrganizer methodsFor:'private access'!
+
+nameSpace:aNameSpace
+    "set the nameSpace - nil is allowed and stands for: any"
+
+    nameSpace := aNameSpace.
+    Smalltalk addDependent:self.
+
+    "
+     (SystemOrganizer for:nil) organization
+     (SystemOrganizer for:Demos) organization
+    "
+
+    "Modified: / 20.6.1998 / 12:35:34 / cg"
+! !
+
+!SystemOrganizer class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/libbasic3/SystemOrganizer.st,v 1.1 1998-06-20 11:22:25 cg Exp $'
+! !