"
COPYRIGHT (c) 2004 by 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:libtool' }"
"{ NameSpace: Tools }"
NavigatorModel subclass:#BrowserList
instanceVariableNames:'menuHolder inGeneratorHolder outGeneratorHolder
selectionChangeCondition immediateUpdate doubleClickChannel
filter updateTrigger forceGeneratorTrigger hideUnloadedClasses
showClassPackages selectionHolder packageFilter nameSpaceFilter
organizerMode slaveMode listValid pseudoListLabelHolder icons
sortBy autoSelect showAllClassesInNameSpaceOrganisation
nameFilter'
classVariableNames:'SynchronousUpdate Icons'
poolDictionaries:''
category:'Interface-Browsers-New'
!
!BrowserList class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2004 by 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
"
embeddable application displaying the class-categories.
Provides an outputGenerator, which enumerates the classes in
the selected categories.
[author:]
Claus Gittinger (cg@exept.de)
[instance variables:]
can someone please write a few words here...
menuHolder
inGeneratorHolder
outGeneratorHolder
selectionChangeCondition
immediateUpdate
doubleClickChannel
filter a filterblock by the one who embedds this
updateTrigger
forceGeneratorTrigger
hideUnloadedClasses
showClassPackages
selectionHolder
packageFilter
nameSpaceFilter
organizerMode
slaveMode
listValid
pseudoListLabelHolder
icons
sortBy
autoSelect
showAllClassesInNameSpaceOrganisation
nameFilter a string or glob pattern (from the user, if a GUI for that is present)
"
! !
!BrowserList class methodsFor:'image specs'!
nameSpaceIcon
^ SystemBrowser nameSpaceIcon
!
packageIcon
^ SystemBrowser packageIcon
!
padLockBlueMiniIcon
^ SystemBrowser padLockBlueMiniIcon
!
padLockGrayMiniIcon
^ SystemBrowser padLockGrayMiniIcon
!
padLockGreenMiniIcon
^ SystemBrowser padLockGreenMiniIcon
!
padLockRedMiniIcon
^ SystemBrowser padLockRedMiniIcon
!
programImageIcon
^ SystemBrowser programImageIcon
!
protectedMethod
^ self padLockRedMiniIcon
!
redLockIcon
^ SystemBrowser redLockIcon
! !
!BrowserList methodsFor:'accessing'!
nameFilter:something
nameFilter := something.
! !
!BrowserList methodsFor:'aspects'!
defaultSlaveModeValue
^ nil.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
doubleClickChannel
doubleClickChannel isNil ifTrue:[
doubleClickChannel := TriggerValue new.
].
^ doubleClickChannel.
"Modified: / 31.1.2000 / 00:42:44 / cg"
"Created: / 5.2.2000 / 22:38:32 / cg"
!
doubleClickChannel:aChannel
doubleClickChannel := aChannel
!
filter:aValueHolder
filter notNil ifTrue:[
filter removeDependent:self
].
filter := aValueHolder.
filter notNil ifTrue:[
filter addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 5.2.2000 / 13:42:12 / cg"
!
forceGeneratorTrigger
forceGeneratorTrigger isNil ifTrue:[
forceGeneratorTrigger := TriggerValue new.
forceGeneratorTrigger addDependent:self.
].
^ forceGeneratorTrigger.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 02:46:40 / cg"
!
forceGeneratorTrigger:aTriggerValue
forceGeneratorTrigger notNil ifTrue:[
forceGeneratorTrigger removeDependent:self
].
forceGeneratorTrigger := aTriggerValue.
forceGeneratorTrigger notNil ifTrue:[
forceGeneratorTrigger addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 02:46:52 / cg"
!
hideUnloadedClasses
hideUnloadedClasses isNil ifTrue:[
hideUnloadedClasses := false asValue.
hideUnloadedClasses addDependent:self.
].
^ hideUnloadedClasses.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 17:36:30 / cg"
!
hideUnloadedClasses:aValueHolder
hideUnloadedClasses notNil ifTrue:[
hideUnloadedClasses removeDependent:self
].
hideUnloadedClasses := aValueHolder.
hideUnloadedClasses notNil ifTrue:[
hideUnloadedClasses addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 17:46:36 / cg"
!
menuHolder
^ menuHolder
"Created: / 5.2.2000 / 13:42:06 / cg"
!
menuHolder:aValueHolder
menuHolder := aValueHolder.
"Created: / 5.2.2000 / 13:42:06 / cg"
!
nameSpaceFilter
nameSpaceFilter isNil ifTrue:[
nameSpaceFilter := ValueHolder new.
nameSpaceFilter addDependent:self.
].
^ nameSpaceFilter.
"Modified: / 24.2.2000 / 23:57:13 / cg"
"Created: / 18.8.2000 / 14:18:56 / cg"
!
nameSpaceFilter:aValueHolder
nameSpaceFilter notNil ifTrue:[
nameSpaceFilter removeDependent:self
].
nameSpaceFilter := aValueHolder.
nameSpaceFilter notNil ifTrue:[
nameSpaceFilter addDependent:self
].
"Modified: / 24.2.2000 / 23:56:22 / cg"
"Created: / 18.8.2000 / 14:19:06 / cg"
!
organizerMode
organizerMode isNil ifTrue:[
organizerMode := OrganizerCanvas organizerModeCategory asValue.
organizerMode addDependent:self.
].
^ organizerMode
"Modified: / 31.1.2000 / 00:51:06 / cg"
"Created: / 25.2.2000 / 22:36:15 / cg"
!
organizerMode:aValueHolder
organizerMode notNil ifTrue:[
organizerMode removeDependent:self
].
organizerMode := aValueHolder.
organizerMode notNil ifTrue:[
organizerMode addDependent:self
].
"Modified: / 4.2.2000 / 23:34:28 / cg"
"Created: / 25.2.2000 / 22:36:28 / cg"
!
packageFilter
packageFilter isNil ifTrue:[
packageFilter := ValueHolder new.
packageFilter addDependent:self.
"/ debug-check only
"/ packageFilter onChangeEvaluate:[packageFilter value isValueModel ifTrue:[self halt:'debug halt']].
].
^ packageFilter.
"Modified: / 18.8.2000 / 19:26:36 / cg"
!
packageFilter:aValueHolder
packageFilter notNil ifTrue:[
packageFilter removeDependent:self
].
packageFilter := aValueHolder.
packageFilter notNil ifTrue:[
packageFilter addDependent:self.
"/ debug-check only
"/ packageFilter onChangeEvaluate:[packageFilter value isValueModel ifTrue:[self halt:'debug halt']].
].
"Modified: / 18.8.2000 / 19:26:40 / cg"
!
pseudoListLabelHolder
pseudoListLabelHolder isNil ifTrue:[
pseudoListLabelHolder := '' asValue.
].
^ pseudoListLabelHolder
!
selectionChangeCondition:aBlockOrValueHolder
selectionChangeCondition := aBlockOrValueHolder
!
selectionHolder
selectionHolder isNil ifTrue:[
selectionHolder := ValueHolder new.
selectionHolder addDependent:self
].
^ selectionHolder.
!
selectionHolder:aValueHolder
|prevSelection|
prevSelection := selectionHolder value ? #().
selectionHolder notNil ifTrue:[
selectionHolder removeDependent:self
].
selectionHolder := aValueHolder.
selectionHolder notNil ifTrue:[
selectionHolder addDependent:self
].
(selectionHolder value ? #()) ~= prevSelection ifTrue:[
"/ update
self update:#value with:nil from:selectionHolder
].
!
showAllClassesInNameSpaceOrganisation
^[
|holder|
showAllClassesInNameSpaceOrganisation notNil ifTrue:[
holder := showAllClassesInNameSpaceOrganisation
] ifFalse:[
masterApplication notNil ifTrue:[
holder := masterApplication showAllClassesInNameSpaceOrganisation.
holder addDependent:self.
] ifFalse:[
showAllClassesInNameSpaceOrganisation isNil ifTrue:[
showAllClassesInNameSpaceOrganisation := false asValue.
showAllClassesInNameSpaceOrganisation addDependent:self.
].
holder := showAllClassesInNameSpaceOrganisation.
].
].
holder value
].
"Created: / 05-03-2007 / 16:47:03 / cg"
"Modified: / 06-03-2007 / 12:28:03 / cg"
!
showAllClassesInNameSpaceOrganisation:aValueHolder
showAllClassesInNameSpaceOrganisation notNil ifTrue:[
showAllClassesInNameSpaceOrganisation removeDependent:self
].
showAllClassesInNameSpaceOrganisation := aValueHolder.
showAllClassesInNameSpaceOrganisation notNil ifTrue:[
showAllClassesInNameSpaceOrganisation addDependent:self
].
"Created: / 05-03-2007 / 16:47:13 / cg"
!
showClassPackages
showClassPackages isNil ifTrue:[
showClassPackages := false asValue.
showClassPackages addDependent:self.
].
^ showClassPackages.
"Modified: / 18.2.2000 / 02:02:52 / cg"
"Created: / 18.2.2000 / 17:36:30 / cg"
!
showClassPackages:aValueHolder
showClassPackages notNil ifTrue:[
showClassPackages removeDependent:self
].
showClassPackages := aValueHolder.
showClassPackages notNil ifTrue:[
showClassPackages addDependent:self
].
!
slaveMode
slaveMode isNil ifTrue:[
slaveMode := self defaultSlaveModeValue asValue.
slaveMode addDependent:self.
].
^ slaveMode.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
slaveMode:aValueHolder
|prev|
slaveMode notNil ifTrue:[
slaveMode removeDependent:self.
prev := slaveMode value.
].
slaveMode := aValueHolder.
slaveMode notNil ifTrue:[
slaveMode addDependent:self
].
prev ~~ slaveMode value ifTrue:[
(prev isNil and:[slaveMode value]) ifFalse:[
self update:#value with:nil from:slaveMode.
]
].
!
sortBy
sortBy isNil ifTrue:[
sortBy := nil asValue.
sortBy addDependent:self.
].
^ sortBy.
"Created: / 25.2.2000 / 22:36:40 / cg"
!
sortBy:aValueHolder
|prev|
prev := sortBy value.
sortBy notNil ifTrue:[
sortBy removeDependent:self
].
sortBy := aValueHolder.
sortBy notNil ifTrue:[
sortBy addDependent:self
].
prev ~~ sortBy value ifTrue:[
self update:#value with:nil from:sortBy.
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 5.2.2000 / 13:42:12 / cg"
!
updateTrigger
updateTrigger isNil ifTrue:[
updateTrigger := TriggerValue new.
updateTrigger addDependent:self.
].
^ updateTrigger.
"Created: / 18.2.2000 / 01:59:58 / cg"
"Modified: / 18.2.2000 / 02:02:52 / cg"
!
updateTrigger:aTriggerValue
updateTrigger notNil ifTrue:[
updateTrigger removeDependent:self
].
updateTrigger := aTriggerValue.
updateTrigger notNil ifTrue:[
updateTrigger addDependent:self
].
"Modified: / 4.2.2000 / 23:29:30 / cg"
"Created: / 18.2.2000 / 02:03:15 / cg"
! !
!BrowserList methodsFor:'change & update'!
delayedUpdate:something with:aParameter from:changedObject
"/ if any of my subclasses want those, they should look for them.
changedObject == Smalltalk ifTrue:[
(something == #Language or:[something == #LanguageTerritory]) ifTrue:[
^ self
].
something == #organization ifTrue:[
^ self
].
something == #classDefinition ifTrue:[
^ self
].
something == #classVariables ifTrue:[
^ self
].
something == #methodTrap ifTrue:[
^ self
].
something == #methodInClassRemoved ifTrue:[
^ self.
].
something == #methodDictionary ifTrue:[
^ self
].
something == #newClass ifTrue:[
^ self
].
].
changedObject == slaveMode ifTrue:[
slaveMode value ~~ true ifTrue:[
listValid ~~ true ifTrue:[
self updateList.
].
self updateOutputGenerator.
].
^ self.
].
changedObject == selectionHolder ifTrue:[
listValid ifFalse:[
self updateList.
].
^ self selectionChanged
].
changedObject == forceGeneratorTrigger ifTrue:[
self updateOutputGenerator.
^ self.
].
changedObject == hideUnloadedClasses ifTrue:[
self invalidateList.
slaveMode value ~~ true ifTrue:[
self updateOutputGenerator.
].
^ self.
].
changedObject == updateTrigger ifTrue:[
self enqueueDelayedUpdateList.
^ self
].
changedObject == inGeneratorHolder ifTrue:[
self invalidateList.
^ self
].
"/ changedObject == outGeneratorHolder ifTrue:[
"/ self enqueueDelayedUpdateList.
"/ ^ self
"/ ].
changedObject == packageFilter ifTrue:[
self invalidateList.
^ self
].
changedObject == nameSpaceFilter ifTrue:[
self invalidateList.
^ self
].
changedObject == organizerMode ifTrue:[
^ self
].
self invalidateList.
^ self
"Created: / 5.2.2000 / 13:42:06 / cg"
"Modified: / 18.8.2000 / 14:19:24 / cg"
!
enqueueDelayedUpdate:something with:aParameter from:changedObject
"support for delayed updates - to be invoked from a concrete classes
#update:with:from: method.
This will enqueue a delayed update, and resend #delayedUpdate:with:from:
whenever the receiver is handling events.
Especially useful, if many updates arrive at high frequency, to avoid
multiple redraws."
^ self
enqueueMessage:#delayedUpdate:with:from:
for:self
arguments:(Array
with:something
with:aParameter
with:changedObject).
!
enqueueDelayedUpdateList
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self updateList.
^ self.
].
self enqueueMessage:#updateList for:self arguments:#()
!
enqueueDelayedUpdateOutputGenerator
slaveMode value == true ifTrue:[
self halt:'should not be invoked'
].
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self updateOutputGenerator.
^ self.
].
"/ listValid := false.
self enqueueMessage:#updateOutputGenerator for:self arguments:#()
!
forceReselect
|selectionHolder prevSelection|
selectionHolder := self selectionHolder.
prevSelection := selectionHolder value.
selectionHolder class == ValueHolder ifTrue:[
selectionHolder changed:#value with:prevSelection.
] ifFalse:[
selectionHolder setValue:nil.
selectionHolder value:prevSelection.
]
!
forceSelectionClear
self selectionHolder setValue:nil
!
forceUpdateList
"/ |listView|
"/
"/ listView := builder componentAt:#List.
"/ listView notNil ifTrue:[
"/ listView list:#()
"/ ].
self updateList
!
immediateUpdate:aBooleanOrBooleanHolder
immediateUpdate := aBooleanOrBooleanHolder
"Created: / 13.2.2000 / 22:26:06 / cg"
"Modified: / 13.2.2000 / 22:28:09 / cg"
!
prioDelayedUpdate:something with:aParameter from:changedObject
Processor activeProcess withLowerPriorityDo:[
self delayedUpdate:something with:aParameter from:changedObject
]
!
selectionChangeAllowed
selectionChangeCondition isNil ifTrue:[^ true].
selectionChangeCondition isBlock ifTrue:[
selectionChangeCondition numArgs == 1 ifTrue:[
^ selectionChangeCondition value:self
]
].
^ selectionChangeCondition value
!
selectionChanged
slaveMode value ~~ true ifTrue:[
self enqueueDelayedUpdateOutputGenerator
"/ self updateOutputGenerator.
]
"Modified: / 4.2.2000 / 15:49:23 / cg"
"Created: / 5.2.2000 / 13:42:07 / cg"
!
selectionChangedByClick
"Created: / 25.2.2000 / 21:19:25 / cg"
!
syncDelayedUpdateList
|sensor|
sensor := self window sensor.
sensor isNil ifTrue:[
^ self
].
"/
"/ if an update is in the queue, process it.
"/
(sensor
hasEvent:#updateList
for:self
withArguments:#()
) ifTrue:[
sensor flushEventsFor:self withType:#updateList.
self updateList.
^ self
].
!
update:something with:aParameter from:changedObject
(NewSystemBrowser synchronousUpdate == true
or:[ immediateUpdate value == true ])
ifTrue:[
self delayedUpdate:something with:aParameter from:changedObject.
^ self.
].
"/ (changedObject == ChangeSet)
"/ ifTrue:[
"/ self delayedUpdate:something with:aParameter from:changedObject.
"/ ^ self.
"/ ].
"/ changedObject == selectionHolder ifTrue:[
"/ listValid ifFalse:[
"/ self slaveMode value ifTrue:[
"/ ^ self
"/ ]
"/ ]
"/ ].
changedObject == inGeneratorHolder ifTrue:[
listValid := false.
].
self enqueueDelayedUpdate:something with:aParameter from:changedObject.
"Created: / 5.2.2000 / 13:42:07 / cg"
"Modified: / 13.11.2001 / 11:30:19 / cg"
! !
!BrowserList methodsFor:'drag & drop'!
canDrop: aDropContext
^ self canDropContext: aDropContext
"Created: / 03-07-2007 / 15:59:06 / cg"
!
doDrop: aDropContext
^ self doDropContext: aDropContext
"Created: / 03-07-2007 / 15:59:33 / cg"
!
dropClassFiles:files
files do:[:fn |
(Dialog confirm:(resources string:'FileIn %1 ?' with:fn baseName allBold)) ifTrue:[
Smalltalk fileIn:fn logged:true.
]
].
"Created: / 17-10-2006 / 18:24:36 / cg"
!
objectsAreClassFiles:objects
(objects conform:[:anObject | anObject isFilename]) ifTrue:[
|files|
files := objects.
^ files conform:[:aFilename | aFilename exists
and:[ aFilename suffix = 'st'
and:[ aFilename isRegularFile ]]]
].
^ false
"Created: / 17-10-2006 / 18:25:40 / cg"
! !
!BrowserList methodsFor:'generators'!
inGeneratorHolder
^ inGeneratorHolder
"Created: / 5.2.2000 / 13:42:07 / cg"
!
inGeneratorHolder:aConditionBlockHolder
|prevHolder|
(prevHolder := inGeneratorHolder) notNil ifTrue:[
inGeneratorHolder removeDependent:self
].
inGeneratorHolder := aConditionBlockHolder.
inGeneratorHolder notNil ifTrue:[
inGeneratorHolder addDependent:self
].
(prevHolder notNil or:[inGeneratorHolder notNil]) ifTrue:[
(prevHolder value isNil and:[ inGeneratorHolder value isEmptyOrNil])
ifFalse:[
self update:#value with:nil from:inGeneratorHolder
].
].
"Modified: / 12-03-2007 / 11:31:23 / cg"
!
makeGenerator
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:07 / cg"
!
outGeneratorHolder
outGeneratorHolder isNil ifTrue:[
outGeneratorHolder := ValueHolder new
].
^ outGeneratorHolder
"Modified: / 4.2.2000 / 17:17:16 / cg"
"Created: / 5.2.2000 / 13:42:07 / cg"
!
outGeneratorHolder:aConditionBlockHolder
outGeneratorHolder := aConditionBlockHolder.
"Created: / 5.2.2000 / 13:42:08 / cg"
!
updateOutputGenerator
"create a generator which enumerates my elements,
and place it into the outputGenerator holder"
self outGeneratorHolder value: self makeGenerator.
"Modified: / 4.2.2000 / 17:16:34 / cg"
"Created: / 5.2.2000 / 13:42:08 / cg"
! !
!BrowserList methodsFor:'icons'!
abstractMethodIcon
"answer an icon to mark abstract methods"
^ self fetchIcon:#abstractMethod selector:#abstractMethodIcon
!
canvasIcon
"answer an icon to mark canvas spec methods"
^ self fetchIcon:#canvas selector:#canvasIcon
!
deprecatedMethodIcon
^ self fetchIcon:#deprecatedMethodIcon selector:#deprecatedMethodIcon
!
fetchIcon:name selector:fetchSelector
"answer an icon to mark methods"
icons isNil ifTrue:[icons := IdentityDictionary new].
Icons isNil ifTrue:[Icons := IdentityDictionary new].
^ icons at:name ifAbsentPut:[
|fh icn h|
(icn := Icons at:name ifAbsent:nil) isNil ifTrue: [
Icons at:name put:(icn := (SystemBrowser perform:fetchSelector) onDevice:Display).
icn clearMaskedPixels.
].
h := icn height.
h > (fh := SelectionInListView defaultFont heightOn:device) ifTrue:[
icn := icn magnifiedBy:(fh / h)
].
icn onDevice:device
]
"
Icons := nil
Icon flushCachedIcons
"
!
fileImageIcon
"answer an icon to mark file-image spec methods"
^ self fetchIcon:#fileImage selector:#fileImageIcon
!
helpIcon
"answer an icon to mark help spec methods"
^ self fetchIcon:#help selector:#helpIcon
!
hierarchicalListIcon
"answer an icon to mark hierarchicalList spec methods"
^ self fetchIcon:#hierarchicalList selector:#hierarchicalListIcon
!
ignoredMethodIcon
"answer an icon to mark ignored methods"
^ self fetchIcon:#ignoredMethod selector:#ignoredMethodIcon
!
imageIcon
"answer an icon to mark image spec methods"
^ self fetchIcon:#image selector:#imageIcon
!
instrumentationIcon
"answer an icon to mark instrumented methods"
"/ ^ self fetchIcon:#watch selector:#watchIcon
^ self fetchIcon:#instrumentation selector:#instrumentationIcon
!
menuIcon
"answer an icon to mark menu spec methods"
^ self fetchIcon:#menu selector:#menuIcon
!
methodEmptyInheritedIcon
^ self fetchIcon:#methodEmptyInherited selector:#methodEmptyInheritedIcon
!
methodInheritedFromAboveAndRedefinedBelowIcon
^ self fetchIcon:#methodInheritedFromAboveAndRedefinedBelow selector:#methodInheritedFromAboveAndRedefinedBelowIcon
!
methodInheritedFromAboveIcon
^ self fetchIcon:#methodInheritedFromAbove selector:#methodInheritedFromAboveIcon
!
methodIsSubclassResponsibilityAndRedefinedBelowIcon
^ self fetchIcon:#methodIsSubclassResponsibilityAndRedefinedBelowIcon selector:#methodIsSubclassResponsibilityAndRedefinedBelowIcon
!
methodIsSubclassResponsibilityIcon
^ self fetchIcon:#methodIsSubclassResponsibilityIcon selector:#methodIsSubclassResponsibilityIcon
!
methodRedefinedBelowIcon
^ self fetchIcon:#methodRedefinedBelow selector:#methodRedefinedBelowIcon
!
privateMethodIcon
"answer an icon to mark private methods"
^ self fetchIcon:#privateMethod selector:#privateMethodIcon
!
programImageIcon
"answer an icon to mark image spec methods"
^ self fetchIcon:#programImage selector:#programImageIcon
!
programMenuIcon
"answer an icon to mark program generated menu methods"
^ self fetchIcon:#programMenu selector:#programMenuIcon
!
protectedMethodIcon
"answer an icon to mark protected methods"
^ self fetchIcon:#protectedMethod selector:#protectedMethodIcon
!
stopIcon
"answer an icon to mark breakPointed methods"
^ self fetchIcon:#stop selector:#stopIcon
!
tabListIcon
"answer an icon to mark tabList spec methods"
^ self fetchIcon:#tabList selector:#tabListIcon
!
tableColumnsIcon
"answer an icon to mark tableColumns spec methods"
^ self fetchIcon:#tableColumns selector:#tableColumnsIcon
!
timeIcon
"answer an icon to mark timed methods"
^ self fetchIcon:#time selector:#timeIcon
!
traceIcon
"answer an icon to mark traced methods"
"/ ^ self fetchIcon:#watch selector:#watchIcon
^ self fetchIcon:#trace selector:#traceIcon
! !
!BrowserList methodsFor:'misc'!
invalidateList
listValid := false.
slaveMode value ~~ true ifTrue:[
self enqueueDelayedUpdateList.
]
! !
!BrowserList methodsFor:'private'!
browserNameList
self subclassResponsibility
!
classesToProcessForClasses:classes withVisibility:visibility
|classesToProcess classesToProcessInOrder|
visibility isNil ifTrue:[^classes].
visibility == #class ifTrue:[^classes].
classesToProcess := IdentitySet new.
classesToProcessInOrder := OrderedCollection new.
classes notNil ifTrue:[
classes do:[:eachClass |
|withAllSupers|
withAllSupers := eachClass withAllSuperclasses.
visibility == #allButObject ifTrue:[
eachClass isMeta ifTrue:[
withAllSupers removeAllFoundIn:(Object class withAllSuperclasses)
] ifFalse:[
withAllSupers remove:Object ifAbsent:nil
]
].
withAllSupers do:[:each |
(classesToProcess includes:each) ifFalse:[
classesToProcess add:each.
classesToProcessInOrder add:each.
]
]
].
].
^ classesToProcessInOrder
!
colorize:aString with:emphasis
^ aString asText emphasisAllAdd:emphasis
"Created: / 27-04-2010 / 15:36:34 / cg"
!
colorizeForChangedCode:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
"Created: / 31.10.2001 / 10:17:56 / cg"
!
colorizeForChangedCodeInSmallTeam:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForChangedCodeInSmallTeam)
"Created: / 10-11-2006 / 16:53:53 / cg"
!
colorizeForDifferentPackage:someString
^ someString asText emphasisAllAdd:(UserPreferences current emphasisForDifferentPackage)
!
colorizeForInstrumentedFullyCoveredCode:someString
^ self colorize:someString with:(UserPreferences current emphasisForInstrumentedFullyCoveredCode)
"Created: / 27-04-2010 / 13:01:24 / cg"
"Modified: / 27-04-2010 / 15:36:49 / cg"
!
colorizeForInstrumentedNeverCalledCode:someString
^ self colorize:someString with:(UserPreferences current emphasisForInstrumentedNeverCalledCode)
"Created: / 27-04-2010 / 12:59:56 / cg"
"Modified: / 27-04-2010 / 15:37:02 / cg"
!
colorizeForInstrumentedPartiallyCoveredCode:someString
^ self colorize:someString with:(UserPreferences current emphasisForInstrumentedPartiallyCoveredCode)
"Created: / 27-04-2010 / 13:01:31 / cg"
"Modified: / 27-04-2010 / 15:37:06 / cg"
!
colorizeGrey:someString
^ someString asText emphasisAllAdd:(#color->Color darkGrey)
!
emphasizeForChangedCode:someString
^ self colorizeForChangedCode:someString
"Modified: / 31.10.2001 / 10:18:57 / cg"
!
emphasizeForDifferentPackage:someString
^ self colorizeForDifferentPackage:(' [' , (' ' , someString , ' ') "allItalic" , ']')
"Modified: / 31.10.2001 / 10:13:35 / cg"
!
inSlaveModeOrInvisible
(self slaveMode value == true) ifTrue:[^ true].
"/ self slaveMode value isNil ifTrue:[
"/ self window shown ifFalse:[
"/ ^ true
"/ ].
"/ ].
^ false
!
isClass:aClass shownWithNameSpaceFilter:nameSpaceFilter
|nsName|
nameSpaceFilter isNil ifTrue:[^ true].
nsName := aClass topNameSpace name.
(nameSpaceFilter includes:nsName) ifTrue:[^ true].
(nameSpaceFilter contains:[:ns | nsName startsWith:(ns , '::')]) ifTrue:[^ true].
^ false
!
isClass:aClass shownWithPackageFilter:packageFilter
|classPackage|
packageFilter isNil ifTrue:[^ true].
classPackage := aClass package.
(packageFilter includes:classPackage) ifTrue:[^ true].
aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
|mthdPackage|
mthdPackage := mthd package.
mthdPackage ~~ classPackage ifTrue:[
(packageFilter includes:mthdPackage) ifTrue:[^ true].
].
].
^ false
"Modified: / 11-08-2006 / 15:15:28 / cg"
!
makeDependent
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:08 / cg"
!
makeIndependent
self subclassResponsibility
"Created: / 5.2.2000 / 13:42:08 / cg"
!
release
self makeIndependent.
super release.
filter removeDependent:self.
forceGeneratorTrigger removeDependent:self.
hideUnloadedClasses removeDependent:self.
inGeneratorHolder removeDependent:self.
nameSpaceFilter removeDependent:self.
organizerMode removeDependent:self.
packageFilter removeDependent:self.
selectionHolder removeDependent:self.
showClassPackages removeDependent:self.
slaveMode removeDependent:self.
sortBy removeDependent:self.
updateTrigger removeDependent:self.
"Created: / 5.2.2000 / 13:42:09 / cg"
"Modified: / 13.2.2000 / 23:32:23 / cg"
!
releaseAsSubCanvas
self makeIndependent.
super releaseAsSubCanvas.
"Created: / 13.2.2000 / 23:11:29 / cg"
"Modified: / 13.2.2000 / 23:32:29 / cg"
!
updateList
self subclassResponsibility.
!
updateListFor:newList
"update the browsers list in a way which avoids scrolls
and flicker; returns true, if the newList is the same."
|"oldListSize newListSize" sameContents sameStrings oldEntry browserNameList
"firstDifferentFromBeginning firstDifferentFromEnd" listView prevMode sav|
browserNameList := self browserNameList value.
sameContents := sameStrings := (newList size == browserNameList size).
sameContents ifTrue:[
newList with:browserNameList do:[:newLine :oldLine |
sameStrings ifTrue:[
sameStrings := ((newLine ? '') = (oldLine ? '')).
].
sameContents ifTrue:[
((newLine ? '') sameStringAndEmphasisAs:(oldLine ? '')) ifFalse:[
sameContents := false
]
].
]
].
listView := builder componentAt:#List.
listView isNil ifTrue:[
"/ called early during setup ...
browserNameList contents:newList.
^ sameContents.
].
sameContents ifTrue:[
^ sameContents
].
sameStrings ifTrue:[
newList keysAndValuesDo:[:lineNr :line |
oldEntry := browserNameList at:lineNr.
(oldEntry sameStringAndEmphasisAs:line) ifFalse:[
browserNameList at:lineNr put:line.
]
].
^ sameContents
].
listView := listView scrolledView.
listView isNil ifTrue:[^ false].
prevMode := listView scrollWhenUpdating.
listView scrollWhenUpdating:nil.
[
"/ dont want to be called if selection is changed by selListView
sav := listView action.
listView action:nil.
browserNameList contents:newList.
] ensure:[
listView action:sav.
].
listView scrollWhenUpdating:prevMode.
^ sameContents.
"/ oldListSize := browserNameList size.
"/ newListSize := newList size.
"/ newListSize == 0 ifTrue:[
"/ oldListSize == 0 ifTrue:[
"/ ^ true "/ same
"/ ].
"/ browserNameList removeAll.
"/ ^ false "/ not same
"/ ].
"/
"/ oldListSize == 0 ifTrue:[
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/
"/ (newListSize between:(oldListSize-1) and:(oldListSize+1)) ifTrue:[
"/ "/ individually exchange changed lines, to avoid flicker.
"/ "/ the old code was: self browserNameList value:newList
"/ "/ but if only a single method is changed (or an instrumentation icon changes),
"/ "/ this results in avoidable flicker.
"/
"/ newListSize > oldListSize ifTrue:[
"/ "/ an entry seems to be added
"/ "/ try to find it.
"/ firstDifferentFromBeginning := 1.
"/
"/ [firstDifferentFromBeginning <= oldListSize
"/ and:[(newList at:firstDifferentFromBeginning) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromBeginning)]]
"/ whileTrue:[
"/ firstDifferentFromBeginning := firstDifferentFromBeginning + 1.
"/ ].
"/ firstDifferentFromEnd := newListSize.
"/ [firstDifferentFromEnd >= 1
"/ and:[(newList at:firstDifferentFromEnd) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromEnd-1)]]
"/ whileTrue:[
"/ firstDifferentFromEnd := firstDifferentFromEnd - 1.
"/ ].
"/ (firstDifferentFromEnd - firstDifferentFromBeginning) > (newList size // 10) ifTrue:[
"/ "/ too many differences - exchange the list en-bloque
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/ "/ entries from firstDifferentFromBeginning to firstDifferentFromEnd in newList are different
"/
"/ (firstDifferentFromEnd - firstDifferentFromBeginning + 1 "number of different items") == (newListSize - oldListSize) ifTrue:[
"/ "/ for now, only handle single-added-item case
"/ firstDifferentFromEnd ~~ firstDifferentFromBeginning ifTrue:[
"/ self halt
"/ ].
"/
"/ "/ item at firstDifferentFromBeginning has been inserted.
"/ browserNameList add:(newList at:firstDifferentFromBeginning) beforeIndex:firstDifferentFromEnd.
"/ ^ false "/ not the same
"/ ].
"/ ] ifFalse:[
"/ newListSize < oldListSize ifTrue:[
"/ "/ an entry seems to be removed
"/ "/ try to find it.
"/ firstDifferentFromBeginning := 1.
"/
"/ [firstDifferentFromBeginning <= newListSize
"/ and:[(newList at:firstDifferentFromBeginning) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromBeginning)]]
"/ whileTrue:[
"/ firstDifferentFromBeginning := firstDifferentFromBeginning + 1.
"/ ].
"/ firstDifferentFromEnd := newListSize.
"/ [firstDifferentFromEnd >= 1
"/ and:[(newList at:firstDifferentFromEnd) sameStringAndEmphasisAs: (browserNameList at:firstDifferentFromEnd+1)]]
"/ whileTrue:[
"/ firstDifferentFromEnd := firstDifferentFromEnd - 1.
"/ ].
"/ (firstDifferentFromEnd - firstDifferentFromBeginning) > (newList size // 10) ifTrue:[
"/ "/ too many differences - exchange the list en-bloque
"/ browserNameList contents:newList.
"/ ^ false. "/ not same
"/ ].
"/ "/ entries from firstDifferentFromBeginning to firstDifferentFromEnd in newList are different
"/
"/ (firstDifferentFromBeginning - firstDifferentFromEnd) == (oldListSize - newListSize) ifTrue:[
"/ "/ for now, only handle single-removed-item case
"/ firstDifferentFromEnd ~~ (firstDifferentFromBeginning-1) ifTrue:[self halt].
"/
"/ "/ item at firstDifferentFromBeginning has been removed.
"/ browserNameList removeFromIndex:firstDifferentFromBeginning toIndex:firstDifferentFromBeginning.
"/ ^ false "/ not the same
"/ ].
"/ ]
"/ ].
"/
"/ sameContents := true.
"/ newList keysAndValuesDo:[:lineNr :line |
"/ lineNr > browserNameList size ifTrue:[
"/ browserNameList add:line.
"/ sameContents := false.
"/ ] ifFalse:[
"/ oldEntry := browserNameList at:lineNr.
"/ (oldEntry ~= line
"/ or:[(oldEntry sameStringAndEmphasisAs:line) not]) ifTrue:[
"/ browserNameList at:lineNr put:line.
"/ sameContents := false.
"/ ]
"/ ]
"/ ].
"/ newList size < browserNameList size ifTrue:[
"/ browserNameList removeFromIndex:(newList size + 1) toIndex:(browserNameList size).
"/ sameContents := false.
"/ ].
"/ ^ sameContents
"/ ].
"/
"/ browserNameList contents:newList.
"/ ^ false "/ not the same
! !
!BrowserList methodsFor:'setup'!
autoSelect:aBoolean
autoSelect := aBoolean.
!
commonPostBuild
|list|
self slaveMode value == true ifFalse:[
self updateList.
] ifTrue:[
self invalidateList
].
self makeDependent.
list := builder componentAt:#List.
list notNil ifTrue:[
list selectConditionBlock:[:item | self selectionChangeAllowed].
list ignoreReselect:false.
].
! !
!BrowserList class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.28 2011-02-10 21:53:19 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.28 2011-02-10 21:53:19 cg Exp $'
! !