--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools_BrowserList.st Thu Feb 26 19:57:02 2004 +0100
@@ -0,0 +1,1215 @@
+"{ Package: 'stx:libtool' }"
+
+"{ NameSpace: Tools }"
+
+NewSystemBrowser::NavigatorModel subclass:#BrowserList
+ instanceVariableNames:'menuHolder inGeneratorHolder outGeneratorHolder
+ selectionChangeCondition immediateUpdate doubleClickChannel
+ filter updateTrigger forceGeneratorTrigger hideUnloadedClasses
+ showClassPackages selectionHolder packageFilter nameSpaceFilter
+ organizerMode slaveMode listValid pseudoListLabelHolder icons
+ sortBy'
+ classVariableNames:'SynchronousUpdate Icons'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+!BrowserList class methodsFor:'documentation'!
+
+documentation
+"
+ embeddable application displaying the class-categories.
+ Provides an outputGenerator, which enumerates the classes in
+ the selected categories.
+
+ [author:]
+ Claus Gittinger (cg@exept.de)
+"
+! !
+
+!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:'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 := #category 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
+ ].
+
+
+!
+
+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 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 withPriority:7 do:[
+ 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:'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 isNil and:[inGeneratorHolder isNil]) ifFalse:[
+ (prevHolder value isNil
+ and:[
+ (inGeneratorHolder value isNil
+ or:[inGeneratorHolder value isArray
+ and:[inGeneratorHolder value size == 0]])])
+ ifFalse:[
+ self update:#value with:nil from:inGeneratorHolder
+ ].
+ ].
+!
+
+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
+
+!
+
+fetchIcon:name selector:fetchSelector
+ "answer an icon to mark breakPointed 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
+
+!
+
+imageIcon
+ "answer an icon to mark image spec methods"
+
+ ^ self fetchIcon:#image selector:#imageIcon
+!
+
+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
+!
+
+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.
+ ]
+!
+
+resources
+ |master|
+
+ (master := self masterApplication) notNil ifTrue:[^ master resources].
+ ^ super resources
+! !
+
+!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
+!
+
+colorizeForChangedCode:someString
+ ^ someString asText emphasisAllAdd:(UserPreferences current emphasisForChangedCode)
+
+ "Created: / 31.10.2001 / 10:17:56 / cg"
+!
+
+colorizeForDifferentPackage:someString
+ ^ someString asText emphasisAllAdd:(UserPreferences current emphasisForDifferentPackage)
+!
+
+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
+ packageFilter isNil ifTrue:[^ true].
+ (packageFilter includes:aClass package) ifTrue:[^ true].
+
+ aClass instAndClassSelectorsAndMethodsDo:[:sel :mthd |
+ (packageFilter includes:mthd package) ifTrue:[^ true].
+ ].
+ ^ false
+!
+
+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:[self halt. ^ self].
+ 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'!
+
+commonPostBuildWith:aBuilder
+ |list|
+
+ self slaveMode value == true ifFalse:[
+ self updateList.
+ ] ifTrue:[
+ self invalidateList
+ ].
+
+ self makeDependent.
+
+ list := aBuilder componentAt:#List.
+ list notNil ifTrue:[
+ list selectConditionBlock:[:item | self selectionChangeAllowed].
+ list ignoreReselect:false.
+ ].
+
+ "Modified: / 13.11.2001 / 10:27:49 / cg"
+!
+
+postBuildAsSubcanvasWith:aBuilder
+ self commonPostBuildWith:aBuilder.
+ super postBuildAsSubcanvasWith:aBuilder.
+!
+
+postBuildWith:aBuilder
+ self commonPostBuildWith:aBuilder.
+ super postBuildWith:aBuilder.
+
+ "Modified: / 4.2.2000 / 22:59:45 / cg"
+ "Created: / 5.2.2000 / 13:42:09 / cg"
+! !
+
+!BrowserList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools_BrowserList.st,v 1.1 2004-02-26 18:54:59 cg Exp $'
+! !