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"
!

categoryOfElement:aClassName
    "return a classes category;
     the argument is the classes name"

    |cls|

    cls := Smalltalk at:aClassName ifAbsent:nil.
    cls notNil ifTrue:[^ cls category].
    self error:'no such class'.
!

classify:aClassName under:newCategory
    "change a classes category;
     the argument is the classes name"

    |cls|

    cls := Smalltalk at:aClassName ifAbsent:nil.
    cls notNil ifTrue:[^ cls category:newCategory].
    self error:'no such class'.

    "Created: / 4.2.2000 / 18:30:11 / cg"
!

listAtCategoryNamed:aCategory
    "return a collection of classes in aCategory."

    |set classSet searchedNamespace allNames|

    classSet := IdentitySet 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 = aCategory ifTrue:[
                        classSet add:aClass name
                    ]
                ]
            ]
        ]
    ].
    ^ classSet asArray sort.

    "
     (SystemOrganizer for:nil) listAtCategoryNamed:'Collections-Abstract' 
     (SystemOrganizer for:Smalltalk) listAtCategoryNamed:'Collections-Abstract' 
     (SystemOrganizer for:Demos) listAtCategoryNamed:'Collections-Abstract' 
    "

    "Modified: / 20.6.1998 / 13:34:19 / 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.4 2000-02-05 14:28:34 cg Exp $'
! !