"{ Package: 'stx:libtool' }"
"{ NameSpace: Tools }"
BrowserList subclass:#ClassList
instanceVariableNames:'classList classNameList meta lastSelectedClasses
selectedClassNameIndices currentNamespace hidePrivateClasses
unloadedClassesColor markApplicationsHolder'
classVariableNames:''
poolDictionaries:''
category:'Interface-Browsers-New'
!
!ClassList class methodsFor:'documentation'!
documentation
"
embeddable application displaying the classes as listed by
the inputGenerator.
Provides an outputGenerator, which enumerates the classes and
their protocols (method-categories) in the selected classes.
[author:]
Claus Gittinger (cg@exept.de)
"
! !
!ClassList class methodsFor:'interface specs'!
singleClassWindowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ClassList andSelector:#singleClassWindowSpec
ClassList new openInterface:#singleClassWindowSpec
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassList'
#name: 'ClassList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 12 22 312 322)
)
#component:
#(#SpecCollection
#collection: #(
#(#LabelSpec
#label: 'ClassName'
#name: 'ClassLabel'
#layout: #(#LayoutFrame 0 0.0 0 0 0 1.0 25 0)
#translateLabel: true
#labelChannel: #classLabelHolder
#menu: #menuHolder
)
"/ #(#UISubSpecification
"/ #name: 'MetaToggleSpec'
"/ #layout: #(#LayoutFrame 0 0.0 -25 1.0 0 1.0 0 1.0)
"/ #minorKey: #metaSpec
"/ )
)
)
)
!
windowSpec
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this!! If it is corrupted,
the UIPainter may not be able to read the specification."
"
UIPainter new openOnClass:ClassList andSelector:#windowSpec
ClassList new openInterface:#windowSpec
ClassList open
"
<resource: #canvas>
^
#(#FullSpec
#name: #windowSpec
#window:
#(#WindowSpec
#label: 'ClassList'
#name: 'ClassList'
#min: #(#Point 0 0)
#max: #(#Point 1024 721)
#bounds: #(#Rectangle 16 46 316 346)
)
#component:
#(#SpecCollection
#collection: #(
#(#SequenceViewSpec
#name: 'List'
#layout: #(#LayoutFrame 0 0.0 0 0.0 0 1.0 0 1.0)
#tabable: true
#model: #selectedClassNameIndices
#menu: #menuHolder
#hasHorizontalScrollBar: true
#hasVerticalScrollBar: true
#miniScrollerHorizontal: true
#isMultiSelect: true
#valueChangeSelector: #selectionChangedByClick
#useIndex: true
#sequenceList: #classNameList
#doubleClickChannel: #doubleClickChannel
#properties:
#(#PropertyListDictionary
#dragArgument: nil
#dropArgument: nil
#canDropSelector: #canDrop:
#dropSelector: #doDrop:
)
)
)
)
)
! !
!ClassList class methodsFor:'plugIn spec'!
aspectSelectors
"This resource specification was automatically generated
by the UIPainter of ST/X."
"Do not manually edit this. If it is corrupted,
the UIPainter may not be able to read the specification."
"Return a description of exported aspects;
these can be connected to aspects of an embedding application
(if this app is embedded in a subCanvas)."
^ #(
#currentNamespace
#(#doubleClickChannel #action )
#forceGeneratorTrigger
#hidePrivateClasses
#hideUnloadedClasses
#immediateUpdate
#inGeneratorHolder
#menuHolder
#meta
#organizerMode
#outGeneratorHolder
#packageFilter
#nameSpaceFilter
#selectedClasses
#selectionChangeCondition
#showClassPackages
#slaveMode
#updateTrigger
#markApplicationsHolder
).
"Modified: / 18.8.2000 / 18:49:08 / cg"
! !
!ClassList methodsFor:'accessing'!
markApplications
"return the value of the instance variable 'markApplications' (automatically generated)"
^ self markApplicationsHolder value
"Created: / 3.11.2001 / 14:06:19 / cg"
!
markApplications:something
"set the value of the instance variable 'markApplications' (automatically generated)"
self markApplicationsHolder value:something.
"Created: / 3.11.2001 / 14:06:25 / cg"
!
unloadedClassesColor
"return the value of the instance variable 'unloadedClassesColor' (automatically generated)"
^ unloadedClassesColor
!
unloadedClassesColor:something
"set the value of the instance variable 'unloadedClassesColor' (automatically generated)"
unloadedClassesColor := something.
! !
!ClassList methodsFor:'aspects'!
classLabelHolder
^ self pseudoListLabelHolder
!
classList
classList isNil ifTrue:[
classList := ValueHolder new.
].
^ classList
"Created: / 5.2.2000 / 13:42:16 / cg"
"Modified: / 25.2.2000 / 02:21:07 / cg"
!
classNameList
classNameList isNil ifTrue:[
classNameList := ValueHolder new
].
^ classNameList
!
currentNamespace:aValueHolder
currentNamespace notNil ifTrue:[
currentNamespace removeDependent:self
].
currentNamespace := aValueHolder.
currentNamespace notNil ifTrue:[
currentNamespace isBehavior ifTrue:[self halt:'should not happen'].
currentNamespace addDependent:self
].
"Modified: / 4.2.2000 / 23:34:28 / cg"
"Created: / 5.2.2000 / 21:37:57 / cg"
!
doubleClick
self halt:'should not happen'.
!
hidePrivateClasses
hidePrivateClasses isNil ifTrue:[
hidePrivateClasses := false asValue.
hidePrivateClasses addDependent:self.
].
^ hidePrivateClasses.
"Created: / 24.2.2000 / 15:06:44 / cg"
!
hidePrivateClasses:aValueHolder
hidePrivateClasses notNil ifTrue:[
hidePrivateClasses removeDependent:self
].
hidePrivateClasses := aValueHolder.
hidePrivateClasses notNil ifTrue:[
hidePrivateClasses addDependent:self
].
"Created: / 24.2.2000 / 15:06:46 / cg"
!
markApplicationsHolder
markApplicationsHolder isNil ifTrue:[
markApplicationsHolder := true asValue.
markApplicationsHolder addDependent:self.
].
^ markApplicationsHolder.
!
markApplicationsHolder:aValueHolder
markApplicationsHolder notNil ifTrue:[
markApplicationsHolder removeDependent:self
].
markApplicationsHolder := aValueHolder.
markApplicationsHolder notNil ifTrue:[
markApplicationsHolder addDependent:self
].
"Created: / 24.2.2000 / 15:06:46 / cg"
!
meta
meta isNil ifTrue:[
meta := false asValue.
meta addDependent:self
].
^ meta
"Modified: / 31.1.2000 / 01:19:59 / cg"
"Created: / 5.2.2000 / 13:42:16 / cg"
!
meta:aValueHolder
"/ (aValueHolder == true or:[aValueHolder == false]) ifTrue:[self halt].
meta notNil ifTrue:[
meta removeDependent:self
].
meta := aValueHolder.
meta notNil ifTrue:[
meta addDependent:self
].
!
selectedClassNameIndices
selectedClassNameIndices isNil ifTrue:[
selectedClassNameIndices := #() asValue.
selectedClassNameIndices addDependent:self
].
^ selectedClassNameIndices.
"Created: / 5.2.2000 / 21:31:48 / cg"
"Modified: / 5.2.2000 / 21:43:02 / cg"
!
selectedClasses
^ self selectionHolder
!
selectedClasses:aValueHolder
^ self selectionHolder:aValueHolder
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
showClassPackages addDependent:self.
].
^ showClassPackages.
"Created: / 24.2.2000 / 15:06:44 / cg"
!
showClassPackages:aValueHolder
showClassPackages notNil ifTrue:[
showClassPackages removeDependent:self
].
showClassPackages := aValueHolder.
showClassPackages notNil ifTrue:[
showClassPackages addDependent:self
].
! !
!ClassList methodsFor:'change & update'!
classDefinitionChanged:aClassOrNil
listValid ifFalse:[^ self].
slaveMode value == true ifTrue:[
self invalidateList.
^ self.
].
self slaveMode value isNil ifTrue:[
self window shown ifFalse:[
self invalidateList.
^ self
].
].
aClassOrNil isNil ifTrue:[
self halt:'should not happen'.
].
"/ if that class is in my list ...
((self classList value ? #()) contains:[:cls | cls notNil and:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name]])
ifTrue:[
self updateListsFor:aClassOrNil.
"/ force update
self selectedClassNameIndices value:(self selectedClassNameIndices value).
((self selectedClasses value ? #()) contains:[:cls | cls notNil ifTrue:[cls theNonMetaclass name = aClassOrNil theNonMetaclass name] ifFalse:[false]])
ifTrue:[
self updateOutputGenerator
].
] ifFalse:[
self invalidateList
]
"Modified: / 29.2.2000 / 00:15:23 / cg"
!
classRemoved:aClass
|list|
list := self classList value.
list notNil ifTrue:[
(list includesIdentical:aClass) ifTrue:[
self invalidateList.
]
]
"Modified: / 25.2.2000 / 23:53:51 / cg"
!
delayedUpdate:something with:aParameter from:changedObject
|cls classes chgClass wg|
classes := self classList value ? #().
self inSlaveModeOrInvisible ifTrue:[
self invalidateList.
^ self.
].
"/ (self slaveMode value == true) ifTrue:[^ self].
"/ self slaveMode value isNil ifTrue:[
"/ self window shown ifFalse:[
"/ self invalidateList.
"/ ^ self
"/ ].
"/ ].
changedObject == slaveMode ifTrue:[
listValid ~~ true ifTrue:[
self enqueueDelayedUpdateList.
].
self enqueueDelayedClassSelectionChanged.
^ self
].
changedObject == Smalltalk ifTrue:[
something == #methodInClass ifTrue:[
^ self "no interest"
].
something == #methodInClassRemoved ifTrue:[
"/ must update the list, if the methods package is different from
"/ the classes package (to undo any has-exension highlighting)
cls := aParameter first.
self updateListsFor:cls.
^ self
].
something == #organization ifTrue:[^ self "no interest" ].
(something == #classDefinition
or:[something == #classVariables
or:[something == #newClass]]) ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
self classDefinitionChanged:aParameter.
].
^ self.
].
(something == #lastTestRunResult) ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
self updateListsFor:aParameter.
"/ self classDefinitionChanged:aParameter.
].
^ self.
].
something == #classRemove ifTrue:[
"/ update my classList and the selection
self classRemoved:aParameter.
^ self.
].
something == #classRename ifTrue:[
"/ update that class in my classList and the selection
listValid ifTrue:[
aParameter isArray ifTrue:[
cls := aParameter at:1.
self classDefinitionChanged:cls.
]
].
^ self.
].
something == #projectOrganization ifTrue:[
aParameter isNil ifTrue:[
self invalidateList.
organizerMode value == #project ifTrue:[
self enqueueDelayedUpdateOutputGenerator.
].
^ self
].
cls := aParameter at:1.
cls notNil ifTrue:[ "/ should not happen (but does occasionally)
((classes includes:cls theMetaclass)
or:[(classes includes:cls theNonMetaclass)]) ifTrue:[
self invalidateList.
organizerMode value == #project ifTrue:[
self enqueueDelayedUpdateOutputGenerator.
]
].
].
^ self
].
^ self.
].
(something == #lastTestRunResult) ifTrue:[
^ self
].
changedObject == ChangeSet ifTrue:[
wg := self windowGroup.
wg isNil ifTrue:[
changedObject removeDependent:self.
] ifFalse:[
"/ react on changes of the changeSet to recolorize items
something == #addChange: ifTrue:[
chgClass := aParameter changeClass.
chgClass notNil ifTrue:[
((classes includes:chgClass theNonMetaclass)
or:[classes includes:chgClass theMetaclass]) ifTrue:[
"/ remove all other addChange notifications ...
wg sensor
flushEventsFor:self
where:[:ev | ev isMessageSendEvent
and:[ev selector == #delayedUpdate:with:from:
and:[(ev arguments at:3) == ChangeSet]]].
self reconstructNameList.
]
]
] ifFalse:[
"/ remove all other ChangeSet notifications ...
wg sensor
flushEventsFor:self
where:[:ev | ev isMessageSendEvent
and:[ev selector == #delayedUpdate:with:from:
and:[(ev arguments at:3) == ChangeSet]]].
self reconstructNameList.
].
].
^ self
].
changedObject == self selectedClasses ifTrue:[
slaveMode value ~~ true ifTrue:[
listValid == true ifFalse:[
self updateList
].
self selectedClassesChanged.
self updateOutputGenerator.
] ifFalse:[
listValid := false.
].
^ self
].
(changedObject == meta
or:[changedObject == selectedClassNameIndices]) ifTrue:[
self selectionChanged.
^ self
].
changedObject == showClassPackages ifTrue:[
self classNameList value:nil.
self invalidateList.
^ self
].
(changedObject == hideUnloadedClasses
or:[changedObject == hidePrivateClasses
or:[changedObject == nameSpaceFilter
or:[changedObject == packageFilter]]]) ifTrue:[
self invalidateList.
^ self
].
super delayedUpdate:something with:aParameter from:changedObject
"Modified: / 13.11.2001 / 11:32:10 / cg"
!
enqueueDelayedClassSelectionChanged
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self selectedClassesChanged.
^ self.
].
self enqueueMessage:#selectedClassesChanged for:self arguments:#()
!
getSelectedClassIndicesFromClasses
"the class selection has changed;
return a collection of selection-indices"
|classes selectedClasses numSelected|
classes := self classList value.
selectedClasses := self selectedClasses value.
numSelected := selectedClasses size.
numSelected == 0 ifTrue:[
^ #()
].
numSelected == classes size ifTrue:[
"/ all selected - easy
^ (1 to:numSelected) asOrderedCollection
].
meta value ifTrue:[
classes := classes collect:[:eachClass | eachClass theMetaclass].
].
classes := selectedClasses collect:[:aSelectedClass | classes identityIndexOf:aSelectedClass.].
classes := classes select:[:idx | idx ~= 0].
^ classes
"Created: / 24.2.2000 / 19:47:52 / cg"
!
getSelectedClassesFromIndices
"the selection-index collection has changed;
return a collection of corresponding classes"
|selected classes allEntrySelected isMeta anyLost selectedClassNameIndices|
allEntrySelected := false.
classes := classList value.
isMeta := meta value.
anyLost := false.
selectedClassNameIndices := self selectedClassNameIndices value.
selectedClassNameIndices size == classes size ifTrue:[
selectedClassNameIndices size == 0 ifTrue:[^ #()].
isMeta ifTrue:[
^ classes collect:[:eachClass | eachClass theMetaclass].
].
^ classes collect:[:eachClass | eachClass theNonMetaclass].
].
selected := selectedClassNameIndices
collect:[:idx |
|cls|
cls := classes at:idx.
cls == (self class nameListEntryForALL) ifTrue:[
allEntrySelected := true.
] ifFalse:[
cls notNil ifTrue:[
isMeta ifTrue:[
cls := cls theMetaclass
] ifFalse:[
cls := cls theNonMetaclass
].
] ifFalse:[
anyLost := true
].
].
cls
].
anyLost ifTrue:[
selected := selected select:[:each | each notNil].
].
"/ allEntrySelected ifTrue:[
"/ selected := classList value select:[:cls | cls ~~ AllEntry].
"/ meta value ifTrue:[
"/ selected := selected collect:[:cls | cls theMetaclass].
"/ ] ifFalse:[
"/ selected := selected collect:[:cls | cls theNonMetaclass].
"/ ].
"/ ].
^ selected.
"Created: / 24.2.2000 / 19:43:37 / cg"
!
selectedClassesChanged
|indices selectedClassNameIndicesHolder|
self classList value size == 0 ifTrue:[
"/ this may happen during early startup,
"/ when invoked with a preset classSelection,
"/ and the classGenerator has not yet been setup
"/ to not clobber the selection, defer the update
"/ until the classList arrives ...
^ self
].
"/ lastSelectedClasses := self selectedClasses value copy.
indices := self getSelectedClassIndicesFromClasses.
selectedClassNameIndicesHolder := self selectedClassNameIndices.
selectedClassNameIndicesHolder value ~= indices ifTrue:[
"/ in slaveMode, do not update selectedClasses from indices
true "slaveMode value" ifTrue:[
selectedClassNameIndicesHolder value:indices withoutNotifying:self
] ifFalse:[
selectedClassNameIndicesHolder value:indices.
]
]
"Created: / 13.2.2000 / 22:18:10 / cg"
"Modified: / 24.2.2000 / 19:48:56 / cg"
!
selectionChanged
"the lists selection has changed. Since the list uses indices,
update the corresponding selectedClasses collection"
|selected prevSelection selectedClassesHolder|
selectedClassesHolder := self selectedClasses.
"/ lastSelectedClasses := selectedClassesHolder value copy.
selected := self getSelectedClassesFromIndices.
prevSelection := selectedClassesHolder value ? #().
"/ to allow reselect, change my valueHolder, even if the same collection
prevSelection ~= selected ifTrue:[
selectedClassesHolder value:selected.
"/ ] ifFalse:[
"/ selectedClassesHolder value:selected withoutNotifying:self
].
"/ (selectedClassesHolder value = lastSelectedClasses
"/ and:[lastSelectedClasses size == 1]) ifTrue:[
"/ "/ thats a kludge - we want to turn off the protocol selection,
"/ "/ when a class is reselected.
"/
"/ (masterApplication notNil
"/ and:[(mm := masterApplication masterApplication) notNil
"/ and:[mm respondsTo:#selectedProtocols]]) ifTrue:[
"/ mm selectedProtocols value:#()
"/ ].
"/ ].
!
selectionChangedByClick
"we are not interested in that - get another notification
via the changed valueHolder"
|selected master|
selected := self getSelectedClassesFromIndices.
(selected = lastSelectedClasses and:[selected size == 1])
ifTrue:[
"/ thats a kludge - we want to turn off the protocol selection,
"/ when a class is reselected.
masterApplication notNil ifTrue:[
master := masterApplication.
masterApplication masterApplication notNil ifTrue:[
master := masterApplication masterApplication.
].
(master respondsTo:#classReselected) ifTrue:[
master classReselected.
].
]
] ifFalse:[
lastSelectedClasses := selected copy.
]
!
update:something with:aParameter from:changedObject
|cls newMethod oldMethod idx classListValue|
self slaveMode value == true ifTrue:[
something == #methodInClass ifTrue:[ ^ self ].
something == #addChange: ifTrue:[ self invalidateList. ^ self ].
].
"/ self window sensor isNil ifTrue:[
"/ "/ not visible ...
"/ self invalidateList.
"/ ^ self
"/ ].
classListValue := classList value.
changedObject == Smalltalk ifTrue:[
something == #classComment ifTrue:[
^ self.
].
something == #methodDictionary ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
classListValue size > 0 ifTrue:[
((classListValue includesIdentical:cls theNonMetaclass)
or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
self enqueueDelayedUpdateList
]
]
].
^ self
].
something == #methodInClass ifTrue:[
cls := aParameter at:1.
cls notNil ifTrue:[
classListValue size > 0 ifTrue:[
((classListValue includesIdentical:cls theNonMetaclass)
or:[(classListValue includesIdentical:cls theMetaclass)]) ifTrue:[
newMethod := cls compiledMethodAt:(aParameter at:2).
oldMethod := aParameter at:3.
((oldMethod isNil
and:[newMethod package ~= cls package])
or:[oldMethod notNil
and:[newMethod package ~= oldMethod package]])
ifTrue:[
"/ must update the list (for the package-info)
self enqueueDelayedUpdateList
]
]
]
].
^ self
].
"/ kludge: must be careful if my inGenerator is a constant list.
"/ in that case, I have to update it
"/ (sigh - all a consequence of not #becoming the new class)
((something == #classDefinition) or:[something == #newClass]) ifTrue:[
inGeneratorHolder value isOrderedCollection ifTrue:[
idx := inGeneratorHolder value findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
idx ~~ 0 ifTrue:[
inGeneratorHolder value at:idx put:aParameter.
self updateListsFor:aParameter.
"/ self enqueueDelayedUpdateList.
]
] ifFalse:[
classListValue size > 0 ifTrue:[
idx := classListValue findFirst:[:eachClass | eachClass name = aParameter theNonMetaclass name].
idx ~~ 0 ifTrue:[
listValid ifTrue:[
self classDefinitionChanged:aParameter.
^ self.
]
]
].
].
].
].
super update:something with:aParameter from:changedObject
"Modified: / 20.11.2001 / 21:54:56 / cg"
! !
!ClassList methodsFor:'drag & drop'!
canDrop:aDropContext
|methods cls|
methods := aDropContext dropObjects collect:[:obj | obj theObject].
(methods contains:[:aMethod | aMethod isMethod not]) ifTrue:[^ false].
cls := self classAtTargetPointOf:aDropContext.
(methods contains:[:aMethod | aMethod mclass ~= cls]) ifFalse:[^ false].
^ true
!
classAtTargetPointOf:aDropContext
|p classListView lineNr cls|
p := aDropContext targetPoint.
classListView := aDropContext targetWidget.
lineNr := classListView lineAtY:p y.
lineNr isNil ifTrue:[^ nil].
cls := classList value at:lineNr.
^ cls
!
doDrop:aDropContext
|cls methods|
methods := aDropContext dropObjects collect:[:aDropObject | aDropObject theObject].
(methods contains:[:something | something isMethod not]) ifTrue:[^ self].
cls := self classAtTargetPointOf:aDropContext.
methods first mclass isMeta ifTrue:[
cls := cls theMetaclass
].
cls notNil ifTrue:[
self masterApplication moveMethods:methods toClass:cls.
].
! !
!ClassList methodsFor:'generators'!
makeGenerator
"return a generator which enumerates the method categories from the selected class;
that generator generates 2-element elements (includes the class), in order
to make the consumers only depend on one input (i.e. no need for another
classHolder in the methodList)."
^ Iterator on:[:whatToDo |
|allEntry classes cls already anyMethod packages classIsInPackage|
allEntry := self class nameListEntryForALL.
classes := self selectedClasses value ? #().
packages := packageFilter value value.
(packages notNil and:[packages includes:allEntry]) ifTrue:[packages := nil].
classes do:[:cls |
(cls notNil and:[cls ~~ allEntry]) ifTrue:[
anyMethod := false.
classIsInPackage := packages isNil or:[packages includes:cls package].
cls theNonMetaclass isJavaClass ifTrue:[
cls isMeta ifTrue:[
whatToDo value:cls theNonMetaclass value:(self class nameListEntryForStatic).
] ifFalse:[
whatToDo value:cls value:(self class nameListEntryForNonStatic).
]
] ifFalse:[
cls supportsMethodCategories ifTrue:[
already := Set new.
cls methodDictionary keysAndValuesDo:[:sel :mthd |
|cat|
cat := mthd category.
(already includes:cat) ifFalse:[
(classIsInPackage
or:[packages isNil
or:[packages includes:mthd package]])
ifTrue:[
already add:cat.
whatToDo value:cls value:cat.
]
]
].
] ifFalse:[
whatToDo value:cls value:(self class nameListEntryForNILCategory).
].
].
anyMethod ifFalse:[
"/ tell the one below, which classes are seen here,
"/ (even if no method is present)
"/ to allow him to decide if the className is to be shown in the list
whatToDo value:cls value:nil.
].
].
].
]
"Modified: / 24.2.2000 / 23:18:26 / cg"
! !
!ClassList methodsFor:'private'!
listOfClasses
|classesAlready classesOrdered generator nameSpaceFilter packageFilter allName hidePrivate
privateClassesPerClass|
allName := self class nameListEntryForALL.
nameSpaceFilter := self nameSpaceFilter value.
nameSpaceFilter notNil ifTrue:[
(nameSpaceFilter includes:allName) ifTrue:[nameSpaceFilter := nil].
].
packageFilter := self packageFilter value.
packageFilter notNil ifTrue:[
(packageFilter includes:allName) ifTrue:[packageFilter := nil].
].
inGeneratorHolder isNil ifTrue:[
"/ for standAlone testing
generator := Smalltalk allClasses.
(self hideUnloadedClasses value) ifTrue:[
generator := generator select:[:cls | cls isLoaded]
].
] ifFalse:[
generator := inGeneratorHolder value.
generator isNil ifTrue:[^ #() ].
].
classesAlready := IdentitySet new.
classesOrdered := OrderedCollection new.
hidePrivate := self hidePrivateClasses value.
privateClassesPerClass := IdentityDictionary new.
generator do:[:cls |
|owner bucket|
(hidePrivate not or:[cls isPrivate not])
ifTrue:[
(nameSpaceFilter isNil
or:[self isClass:cls shownWithNameSpaceFilter:nameSpaceFilter]) ifTrue:[
(packageFilter isNil
or:[self isClass:cls shownWithPackageFilter:packageFilter]) ifTrue:[
(classesAlready includes:cls) ifFalse:[
classesAlready add:cls.
(owner := cls owningClass) notNil ifTrue:[
bucket := privateClassesPerClass at:owner ifAbsentPut:[SortedCollection new sortBlock:[:a :b | a name < b name] ].
bucket add:cls.
] ifFalse:[
classesOrdered add:cls.
]
]
]
]
]
].
classesOrdered size == 1 ifTrue:[
self classLabelHolder value:(classesOrdered first name)
] ifFalse:[
"/ self classLabelHolder value:(classes size printString , ' classes').
sortBy value ~~ #doNotSort ifTrue:[
classesOrdered sort:[:a :b | a name < b name].
]
].
privateClassesPerClass notEmpty ifTrue:[
|stream action|
stream := WriteStream on:(Array new).
action := [:eachClass |
|bucket|
stream nextPut:eachClass.
bucket := privateClassesPerClass at:eachClass ifAbsent:nil.
bucket notNil ifTrue:[
bucket do:action.
]
].
classesOrdered do:action.
classesOrdered := stream contents.
].
"/
"/ does not work (yet)
"/ classes addFirst:AllEntry.
^ classesOrdered
"Modified: / 18.8.2000 / 20:34:10 / cg"
!
makeDependent
Smalltalk addDependent:self.
ChangeSet addDependent:self.
"Created: / 5.2.2000 / 13:42:17 / cg"
!
makeIndependent
Smalltalk removeDependent:self.
ChangeSet removeDependent:self.
!
nameListEntryFor:aClass withNameSpace:useFullName
|nm indent index owner orgMode indentString javaPackage|
aClass == (self class nameListEntryForALL) ifTrue:[ ^ aClass ].
nm := aClass nameInBrowser.
aClass isLoaded ifFalse:[
unloadedClassesColor notNil ifTrue:[
nm := nm asText emphasizeAllWith:(#color->unloadedClassesColor)
]
].
orgMode := organizerMode value.
orgMode == #hierarchy ifTrue:[
"/ always show the full name
^ nm
].
orgMode == #classHierarchy ifTrue:[
"/ always show the full name
^ nm
].
aClass isJavaClass ifTrue:[
"/ only show the last name, unless multiple packages are shown in the list
javaPackage := aClass package.
(self classList value contains:[:cls | cls package ~= javaPackage]) ifTrue:[
^ nm
].
^ aClass lastName
].
useFullName ifFalse:[
aClass isPrivate ifFalse:[
^ aClass nameWithoutNameSpacePrefix
]
].
"/ full name required if owner is not in the list
owner := aClass owningClass.
(owner isNil
or:[(self classList value includesIdentical:owner) not]) ifTrue:[
^ nm
].
"/ namespace
indent := 0.
index := 1.
[(index := nm indexOf:$: startingAt:index) ~~ 0] whileTrue:[
indent := indent + 1.
index := index + 2.
].
indent == 0 ifFalse:[
indent <= 5 ifTrue:[
indentString := #(
''
' '
' '
' '
' '
' '
) at:indent+1.
] ifFalse:[
indentString := String new:indent*2 withAll:Character space.
].
nm := indentString , '::' , aClass nameWithoutPrefix
].
^ nm
"Modified: / 24.2.2000 / 17:52:28 / cg"
!
nameListForClasses:aClassList
"only reconstruct the names - class list & selection remains
unschanged. Invoked when the organizerMode mode changes"
|orgMode namespaces showNamespaces fullNameList nameList
filteredPackages filteredNameSpaces classesInCangeSet|
showNamespaces := false.
filteredNameSpaces := nameSpaceFilter value.
(filteredNameSpaces isNil
and:[self organizerMode value ~~ #namespace]) ifTrue:[
showNamespaces := true. "/ if no filter, always show the namespace.
] ifFalse:[
(filteredNameSpaces size > 1
or:[(filteredNameSpaces size > 0)
and:[filteredNameSpaces includes:(self class nameListEntryForALL)]]) ifTrue:[
showNamespaces := true
] ifFalse:[
"/ if there are classes from multiple namespaces,
"/ show the full name
namespaces := IdentitySet new.
fullNameList := OrderedCollection new.
aClassList
do:[:cls | |nm|
nm := cls nameInBrowser.
fullNameList add:nm.
namespaces add:cls topNameSpace.
].
showNamespaces := namespaces size > 1
].
].
orgMode := organizerMode value.
filteredPackages := packageFilter value value.
classesInCangeSet := ChangeSet current changedClasses.
classesInCangeSet := classesInCangeSet collect:[:each | each theNonMetaclass].
nameList := aClassList
collect:[:cls |
|nm pkg emPkg hasExtensions isInChangeSet icon|
isInChangeSet := classesInCangeSet includes:cls theNonMetaclass.
nm := self nameListEntryFor:cls withNameSpace:showNamespaces.
isInChangeSet ifTrue:[
nm := self emphasizeForChangedCode:nm
].
pkg := cls package.
hasExtensions := cls hasExtensions.
hasExtensions ifTrue:[
emPkg := self emphasizeForDifferentPackage:'+'. "/ self emphasizeForDifferentPackage:pkg.
].
orgMode == #project ifTrue:[
(filteredPackages notNil
and:[(filteredPackages includes:cls package) not]) ifTrue:[
"/ class is in another packae;
"/ however, class is listed due to methods
"/ in the filtered package
hasExtensions ifTrue:[
nm := nm , emPkg.
] ifFalse:[
nm := nm , ' [ ' , pkg, ' ]'.
].
] ifFalse:[
"/ any methods from other packages in this class ?
hasExtensions ifTrue:[
nm := nm , (self emphasizeForDifferentPackage:'+').
].
].
] ifFalse:[
showClassPackages value == true ifTrue:[
"/ add the package;
hasExtensions ifTrue:[
nm := nm , (self emphasizeForDifferentPackage:pkg , '+').
isInChangeSet ifFalse:[
nm := self colorizeForDifferentPackage:nm
].
] ifFalse:[
nm := nm , (self colorizeGrey:(' [ ' , pkg, ' ]')).
].
] ifFalse:[
hasExtensions ifTrue:[
nm := nm , emPkg.
isInChangeSet ifFalse:[
nm := self colorizeForDifferentPackage:nm
]
].
]
].
"/ cls isVisualStartable ifTrue:[
"/ nm := LabelAndIcon icon:((SystemBrowser visualStartableClassIcon)
"/ onDevice:self window device)
"/ string:nm
"/ ].
markApplicationsHolder value== true ifTrue:[
icon := self nameListIconForClass:cls.
icon isNil ifTrue:[
icon := SystemBrowser emptyIcon
].
nm := LabelAndIcon icon:icon string:nm
].
nm
].
^ nameList
"Modified: / 5.11.2001 / 09:50:27 / cg"
!
nameListIconForClass:cls
|c|
cls isVisualStartable ifTrue:[
^ SystemBrowser startableVisualAppIcon
].
cls isStartableWithMain ifTrue:[
^ SystemBrowser startableClassIcon
].
cls isLoaded ifFalse:[
^ SystemBrowser autoloadedClassIcon
].
c := cls.
[c notNil] whileTrue:[
c == Warning ifTrue:[
^ SystemBrowser warningClassIcon
].
c == Query ifTrue:[
^ SystemBrowser queryClassIcon
].
c == Notification ifTrue:[
^ SystemBrowser notificationClassIcon
].
c == Error ifTrue:[
^ SystemBrowser errorClassIcon
].
c == GenericException ifTrue:[
^ SystemBrowser exceptionClassIcon
].
c == SimpleView ifTrue:[
^ SystemBrowser windowClassIcon
].
c == Collection ifTrue:[
^ SystemBrowser containerClassIcon
].
(c == TestCase and:[cls isAbstract not "cls ~~ TestCase"]) ifTrue:[
^ SystemBrowser testCaseClassIconFor:cls
].
c := c superclass
].
^ nil
!
reconstructNameList
"only reconstruct the names - class list & selection remains
unschanged. Invoked when the organizerMode mode changes"
|prevMode listView oldNameList newNameList sav|
self classList value isNil ifTrue:[
self updateList
].
newNameList := self nameListForClasses:(classList value ? #()).
oldNameList := self classNameList value ? #().
(newNameList
sameContentsAs: oldNameList
whenComparedWith:[:a :b | (a sameStringAndEmphasisAs: b)
and:[ a hasImage == b hasImage
and:[ a hasIcon == b hasIcon ]]]
)
ifTrue:[
"/ no need to update
] ifFalse:[
listView := builder componentAt:#List.
(listView isNil or:[listView scrolledView isNil]) ifTrue:[
"/ invoked very early during setup
self classNameList value:newNameList
] ifFalse:[
"/ avoid flicker and useless redraws
prevMode := listView scrollWhenUpdating.
listView scrollWhenUpdating:nil.
"/ this will lead to a selectionIndex change (done by the selListView);
"/ however, we dont want this here, since it recurses into
"/ a selectionChange. Therefore, temporarily disconnect the selectionIndexHolder...
[
self selectedClassNameIndices removeDependent:self.
"/ also, dont want a callback (selectionChangedByClick)
sav := listView action.
listView action:nil.
self classNameList value:newNameList.
] ensure:[
listView action:sav.
self selectedClassNameIndices addDependent:self.
listView scrollWhenUpdating:prevMode.
].
]
].
"Modified: / 31.10.2001 / 11:33:21 / cg"
!
release
super release.
currentNamespace removeDependent:self.
hidePrivateClasses removeDependent:self.
markApplicationsHolder removeDependent:self.
meta removeDependent:self.
selectedClassNameIndices removeDependent:self.
showClassPackages removeDependent:self.
"Created: / 5.2.2000 / 13:42:18 / cg"
!
updateClassesIn:aCollection
"replace any obsolete class in aCollection;
return true, if any was found"
|found meta classes|
found := false.
aCollection isSequenceable ifFalse:[
classes := aCollection copy.
aCollection removeAll.
classes do:[:cls |
|newClass|
meta := cls isMeta.
newClass := Smalltalk at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
meta ifTrue:[
newClass := newClass class
]
].
found := cls ~~ newClass.
aCollection add:newClass.
].
] ifTrue:[
aCollection keysAndValuesDo:[:idx :cls |
|newClass|
cls notNil ifTrue:[
meta := cls isMeta.
newClass := Smalltalk at:(cls theNonMetaclass name).
newClass isNil ifTrue:[
newClass := cls
] ifFalse:[
meta ifTrue:[
newClass := newClass class
]
].
found := cls ~~ newClass.
aCollection at:idx put:newClass.
]
].
].
^ found
!
updateList
|prevSelection oldList newList newSelectionIndices
forceSelectionChange selectedClassNameIndicesHolder classList|
newList := self listOfClasses.
classList := self classList.
oldList := classList value ? #().
(newList ~= oldList
or:[self classNameList value isNil and:[newList size > 0]]) ifTrue:[
prevSelection := lastSelectedClasses ? #().
prevSelection := prevSelection select:[:each | each notNil].
(newList collect:[:each | each name]) = (oldList collect:[:each | each name]) ifTrue:[
"/ no need to tell anybody
classList setValue:newList.
] ifFalse:[
classList value:newList.
].
self reconstructNameList.
(prevSelection size == 0
and:[self selectedClasses value size ~~ 0]) ifTrue:[
"/ this happens during early startup time,
"/ when the selection is already (pre-)set,
"/ and the classList is generated the first time
"/ (i.e. when opened with preset selection)
"/ do not clobber the selection in this case.
prevSelection := self selectedClasses value.
"/ simulate a change, to force selection update in listView
forceSelectionChange := true.
].
newSelectionIndices := prevSelection
collect:[:item | |cls|
cls := Smalltalk at:item theNonMetaclass name.
newList identityIndexOf:cls]
thenSelect:[:index | index ~~ 0].
selectedClassNameIndicesHolder := self selectedClassNameIndices.
((selectedClassNameIndicesHolder value size ~~ self selectedClasses value size)
or:[newSelectionIndices ~= selectedClassNameIndicesHolder value])
ifTrue:[
newSelectionIndices notEmpty ifTrue:[
"/ force change (for dependents)
"/ selectedClassNameIndicesHolder value:newSelectionIndices.
] ifFalse:[
prevSelection := self selectedClasses value.
newSelectionIndices := #().
].
selectedClassNameIndicesHolder value:newSelectionIndices.
prevSelection notNil ifTrue:[
lastSelectedClasses := prevSelection.
].
self updateOutputGenerator.
].
] ifFalse:[
"/ same classes - but name(s) could be differnet
newList size > 0 ifTrue:[
self reconstructNameList
]
].
listValid := true.
"Created: / 5.2.2000 / 13:42:18 / cg"
"Modified: / 31.10.2001 / 11:35:39 / cg"
!
updateListsFor:aClass
|classes found foundInSelection|
found := foundInSelection := false.
"/ update for a changed class in the classList
(classes := classList value) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
classList value:(classes := classes select:[:each | each notNil]).
].
].
"/ possibly in the generator
((classes := inGeneratorHolder value) isOrderedCollection
and:[classes size > 0]) ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
inGeneratorHolder value:(classes select:[:each | each notNil]).
]
].
"/ and in the selection
(classes := self selectedClasses value) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true.
foundInSelection := true.
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
self selectedClasses value:(classes select:[:each | each notNil]).
]
].
"/ and in the last selection
(classes := lastSelectedClasses) size > 0 ifTrue:[
(self updateClassesIn:classes) ifTrue:[
found := true
].
(classes includes:nil) ifTrue:[
self halt:'should not happen'.
lastSelectedClasses := (classes select:[:each | each notNil]).
]
].
found ifFalse:[
"/ could be a new class (or no-longer autolaoded one).
listValid ifTrue:[
self enqueueDelayedUpdateList.
].
listValid := false.
].
foundInSelection ifTrue:[
"/ force update of output generator
self selectedClasses
removeDependent:self;
changed;
addDependent:self.
].
"Modified: / 25.2.2000 / 23:54:19 / cg"
! !
!ClassList methodsFor:'setup'!
postBuildWith:aBuilder
|classListView|
super postBuildWith:aBuilder.
classListView := aBuilder componentAt:'List'.
classListView notNil ifTrue:[
classListView allowDrag:true.
classListView dragObjectConverter:[:obj |
|nm class idx|
nm := obj theObject asString.
idx := classNameList value indexOf:nm.
idx == 0 ifTrue:[
idx := classNameList value indexOf:nm string.
].
class := classList value at:idx.
DropObject newClass:class.
].
]
! !
!ClassList class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools_ClassList.st,v 1.2 2004-02-26 19:03:55 cg Exp $'
! !