--- 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 $'
! !