#DOCUMENTATION by cg
class: SourceCodeManagerUtilities
comment/format in: #askForExistingRevision:title:class:manager:module:package:fileName:
"{ Encoding: utf8 }"
"
COPYRIGHT (c) 1998 eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic3' }"
"{ NameSpace: Smalltalk }"
Object subclass:#SystemOrganizer
instanceVariableNames:'categoryArray nameSpace'
classVariableNames:'AllCategories CachedOrganizerForSmalltalk'
poolDictionaries:''
category:'Kernel-Support'
!
!SystemOrganizer class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 1998 eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
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:aNameSpaceOrNil
"create & return a new instance of myself, to organize aNameSpace.
All of this here is mimicri - ST/X keeps the category in the class."
(aNameSpaceOrNil isNil or:[aNameSpaceOrNil == Smalltalk]) ifTrue:[
CachedOrganizerForSmalltalk isNil ifTrue:[
CachedOrganizerForSmalltalk := self new nameSpace:aNameSpaceOrNil.
].
^ CachedOrganizerForSmalltalk
].
^ self new nameSpace:aNameSpaceOrNil.
"Modified: / 21.8.2001 / 15:22:20 / 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."
|addClassAction categorySet searchedNamespace allNames|
categoryArray notNil ifTrue:[
^ categoryArray
].
addClassAction := [:aClass |
|cat|
aClass isMeta ifFalse:[
aClass isNameSpace ifFalse:[
cat := aClass category ? '* no category *'.
cat ~= 'obsolete' ifTrue:[
categorySet add:cat
]
]
].
].
AllCategories isNil ifTrue:[
categorySet := Set new.
Smalltalk allClassesDo:addClassAction.
AllCategories := categorySet.
].
(searchedNamespace := nameSpace) isNil ifTrue:[
searchedNamespace := Smalltalk.
].
allNames := (searchedNamespace == Smalltalk).
searchedNamespace == Smalltalk ifTrue:[
categorySet := AllCategories.
] ifFalse:[
categorySet := Set new.
searchedNamespace allClassesDo:addClassAction.
].
categoryArray := categorySet asArray sort.
^ categoryArray
"
(SystemOrganizer for:nil) categories
(SystemOrganizer for:Smalltalk) categories
(SystemOrganizer for:Demos) categories
"
"Modified: / 21-08-2001 / 15:24:10 / cg"
"Modified: / 03-03-2019 / 22:31:26 / Claus Gittinger"
!
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'.
"Modified: / 6.2.2000 / 20:12:10 / cg"
!
classify:aClassName under:newCategory
"change a classes category;
the argument is the classes name"
|cls cats|
cls := Smalltalk at:aClassName ifAbsent:nil.
cls notNil ifTrue:[
(AllCategories includes:newCategory) ifFalse:[
cats := AllCategories asOrderedCollection.
cats add:newCategory.
cats sort.
AllCategories := cats.
].
(categoryArray notNil and:[categoryArray includes:newCategory])
ifFalse:[
categoryArray := nil.
].
cls category:newCategory.
^ self
].
self error:'no such class'.
"Created: / 4.2.2000 / 18:30:11 / cg"
"Modified: / 6.2.2000 / 20:36:30 / cg"
!
environment
^Smalltalk
!
listAtCategoryNamed:aCategory
"return a collection of classes in aCategory."
|classSet searchedNamespace allNames|
classSet := IdentitySet new.
(searchedNamespace := nameSpace) isNil ifTrue:[
searchedNamespace := Smalltalk.
].
"/ hack to enable ported tools (RefactoryBrowser) to see all classes
allNames := (searchedNamespace == Smalltalk).
searchedNamespace allClassesDo:[:aClass |
|cat|
aClass isMeta ifFalse:[
aClass isRealNameSpace ifFalse:[
(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: / 10-11-2006 / 17:12:56 / cg"
! !
!SystemOrganizer methodsFor:'change & update'!
update:something with:anArgument from:changedObject
"/ flush cached categories ...
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"
nameSpace := aNameSpace ? Smalltalk.
nameSpace addDependent:self.
nameSpace ~~ Smalltalk ifTrue:[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$'
!
version_CVS
^ '$Header$'
! !