--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/Tools__BrowserList.st Wed Mar 05 11:39:09 2014 +0100
@@ -0,0 +1,1914 @@
+"
+ 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 showCoverageInformation searchHandler
+ autoUpdateOnChange'
+ classVariableNames:'SynchronousUpdate Icons'
+ poolDictionaries:''
+ category:'Interface-Browsers-New'
+!
+
+Object subclass:#SearchHandler
+ instanceVariableNames:'listView listHolder listSelectionHolder searchField searchWindow
+ searchHolder'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:BrowserList
+!
+
+!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'!
+
+checkedIcon
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self checkedIcon inspect
+ ImageEditor openOnClass:self andSelector:#checkedIcon
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^ MenuPanel iconIndicationOn
+
+"/ ^Icon
+"/ constantNamed:#'Tools::HierarchicalPackageFilterList::PackageItem class checkedIcon'
+"/ ifAbsentPut:[(Depth1Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@C?<O?0??C?<O?0??C?<O?07?C?<O?0??@@@@@@b') ; colorMapFromArray:#[0 0 0 33 161 33]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
+"/?????<@C0@O@D<@30GOH8<7C38OG@<HC0@O@@?????<@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+"/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+"/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
+
+ "Created: / 06-11-2008 / 16:32:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 04-12-2011 / 15:35:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+!
+
+uncheckedIcon
+ "This resource specification was automatically generated
+ by the ImageEditor of ST/X."
+
+ "Do not manually edit this!! If it is corrupted,
+ the ImageEditor may not be able to read the specification."
+
+ "
+ self checkFrameForm inspect
+ ImageEditor openOnClass:self andSelector:#checkFrameForm
+ Icon flushCachedIcons
+ "
+
+ <resource: #image>
+
+ ^MenuPanel iconIndicationOff
+
+"/ ^Icon
+"/ constantNamed:#'Tools::HierarchicalPackageFilterList::PackageItem class checkFrameForm'
+"/ ifAbsentPut:[(Depth1Image new) width: 16; height: 16; photometric:(#palette); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'@@@@@C?<O?0??C?<O?0??C?<O?0??C?<O?0??@@@@@@b') ; colorMapFromArray:#[0 0 0 255 255 255]; mask:((Depth1Image new) width: 16; height: 16; photometric:(#blackIs0); bitsPerSample:(#[1]); samplesPerPixel:(1); bits:(ByteArray fromPackedString:'
+"/?????<@C0@O@@<@C0@O@@<@C0@O@@<@C0@O@@?????<@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+"/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+"/@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@a') ; yourself); yourself]
+
+ "Created: / 06-11-2008 / 16:32:46 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Modified: / 04-12-2011 / 15:35:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList methodsFor:'accessing'!
+
+nameFilter:something
+ nameFilter := something.
+! !
+
+!BrowserList methodsFor:'aspects'!
+
+autoUpdateOnChange
+ "automatic update of the list, when the system changes.
+ For some (slow) search lists (such as string-search), autoupdate is
+ disabled as it would otherwise make the browser unusable.
+ Those lists need an explicit menu-update action."
+
+ ^ autoUpdateOnChange ? true.
+
+ "Modified: / 24-02-2000 / 23:57:13 / cg"
+ "Created: / 15-05-2012 / 11:16:07 / cg"
+!
+
+autoUpdateOnChange: aBoolean
+ "automatic update of the list, when the system changes.
+ For some (slow) search lists (such as string-search), autoupdate is
+ disabled as it would otherwise make the browser unusable.
+ Those lists need an explicit menu-update action."
+
+ autoUpdateOnChange := aBoolean
+
+ "Modified: / 24-02-2000 / 23:57:13 / cg"
+ "Created: / 15-05-2012 / 11:17:18 / cg"
+!
+
+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 perform:#showAllClassesInNameSpaceOrganisation ifNotUnderstood:nil.
+ ].
+ holder notNil ifTrue:[
+ 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: / 04-07-2011 / 21:49:10 / 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
+ ].
+!
+
+showCoverageInformation
+ showCoverageInformation isNil ifTrue:[
+ showCoverageInformation := false asValue.
+ showCoverageInformation addDependent:self.
+ ].
+ ^ showCoverageInformation.
+
+ "Created: / 27-04-2010 / 16:13:16 / cg"
+!
+
+showCoverageInformation:aValueHolder
+ showCoverageInformation notNil ifTrue:[
+ showCoverageInformation removeDependent:self
+ ].
+ showCoverageInformation := aValueHolder.
+ showCoverageInformation notNil ifTrue:[
+ showCoverageInformation addDependent:self
+ ].
+
+ "Created: / 27-04-2010 / 16:13:20 / cg"
+!
+
+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'!
+
+applicationIsActive
+ "true if I am the active view"
+
+ |wg activeView|
+
+ (wg := self windowGroup) isNil ifTrue:[ ^ true ]. "/ I am being initialized
+ self device isNil ifTrue:[ ^ true ]. "/ I am being initialized
+
+ (activeView := self device activeView) isNil ifTrue:[ "Transcript showCR:'nil active'." ^ false ].
+"/Transcript showCR:'active view: ',(activeView printString).
+"/Transcript showCR:'active wg: ',(activeView windowGroup printString).
+"/Transcript showCR:'my wg: ',wg printString.
+ ^ activeView windowGroup == wg
+!
+
+delayedUpdate:something with:aParameter from:changedObject
+
+ "/ if any of my subclasses want those, they should look for them.
+ changedObject == environment 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: / 05-02-2000 / 13:42:06 / cg"
+ "Modified: / 18-08-2000 / 14:19:24 / cg"
+ "Modified (format): / 25-02-2014 / 10:02:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+enqueueDelayedUpdateList
+ listValid := false.
+
+ (NewSystemBrowser synchronousUpdate == true
+ or:[ immediateUpdate value == true ])
+ ifTrue:[
+ self updateList.
+ ^ self.
+ ].
+
+ (self applicationIsActive) ifTrue:[
+ self enqueueMessage:#updateList for:self arguments:#()
+ ] ifFalse:[
+ self enqueueMessage:#updateListInBackground for:self arguments:#()
+ ].
+
+ "Modified: / 05-06-2012 / 23:38:18 / cg"
+!
+
+enqueueDelayedUpdateOutputGenerator
+ (NewSystemBrowser synchronousUpdate == true
+ or:[ immediateUpdate value == true ])
+ ifTrue:[
+ self updateOutputGenerator.
+ ^ self.
+ ].
+ "/ listValid := false.
+ self enqueueMessage:#updateOutputGenerator for:self arguments:#()
+!
+
+environmentChanged
+ super environmentChanged.
+ self updateList.
+
+ "Created: / 24-02-2014 / 10:20:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+
+ changedObject == environmentHolder ifTrue:[
+ self environmentChanged.
+ ^ self.
+ ].
+
+ (NewSystemBrowser synchronousUpdate == true
+ or:[ immediateUpdate value == true ])
+ ifTrue:[
+ self delayedUpdate:something with:aParameter from:changedObject.
+ ^ self.
+ ].
+
+"/ changedObject == selectionHolder ifTrue:[
+"/ listValid ifFalse:[
+"/ self inSlaveMode ifTrue:[
+"/ ^ self
+"/ ]
+"/ ]
+"/ ].
+
+ changedObject == inGeneratorHolder ifTrue:[
+ listValid := false.
+ "/ if not already shown, avoid the processing until shown
+ "/ cg: does not work (for whatever reason) - try implementors...
+ true "self window shown" ifFalse:[
+ ^ self
+ ].
+ ].
+ self enqueueDelayedUpdate:something with:aParameter from:changedObject.
+
+ "Created: / 05-02-2000 / 13:42:07 / cg"
+ "Modified: / 13-11-2001 / 11:30:19 / cg"
+ "Modified: / 25-02-2014 / 09:05:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateListInBackground
+ self executeInBackground:[self updateList]
+! !
+
+!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:[
+ environment 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:[
+ true "self window shown" ifFalse:[
+ "/ self enqueueDelayedUpdateList - will be done anyway, when shown
+ ] 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
+!
+
+breakPointedIcon
+ "answer an icon to mark breakPointed methods"
+ <resource: #obsolete>
+
+ ^ self lineBreakPointedIcon
+
+ "Modified: / 05-03-2014 / 10:29:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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 at:name ifAbsentPut:[
+ |icn fh h|
+
+ icn := (SystemBrowser perform:fetchSelector) onDevice:device.
+ icn clearMaskedPixels.
+
+ h := icn height.
+ h > (fh := SelectionInListView defaultFont heightOn:device) ifTrue:[
+ icn := icn magnifiedBy:(fh / h)
+ ].
+ icn onDevice:device
+ ]
+!
+
+fileImageIcon
+ "answer an icon to mark file-image spec methods"
+
+ ^ self fetchIcon:#fileImage selector:#fileImageIcon
+!
+
+fullBreakPointedIcon
+ "answer an icon to mark breakPointed methods"
+
+ ^ self fetchIcon:#fullBreakPointedIcon selector:#fullBreakPointedIcon
+
+ "Created: / 05-03-2014 / 10:18:43 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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
+!
+
+lineBreakPointedIcon
+ "answer an icon to mark breakPointed methods"
+
+ ^ self fetchIcon:#lineBreakPointedIcon selector:#lineBreakPointedIcon
+
+ "Created: / 05-03-2014 / 10:18:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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"
+ <resource: #obsolete>
+
+ ^ self fullBreakPointedIcon
+
+ "Modified: / 05-03-2014 / 10:29:26 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+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:'initialize-release'!
+
+initialize
+ listValid := false.
+ super initialize.
+!
+
+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"
+! !
+
+!BrowserList methodsFor:'misc'!
+
+invalidateList
+ listValid := false.
+ slaveMode value ~~ true ifTrue:[
+ self enqueueDelayedUpdateList.
+ ]
+! !
+
+!BrowserList methodsFor:'private'!
+
+browserNameList
+ self subclassResponsibility
+!
+
+classesToProcessForClasses:classes withVisibility:visibility
+ "for methodCategory and methodList, depending on the setting
+ of visibility (allButObject, includeAllSupers or class only),
+ return a combined hull set of classes for a given set."
+
+ |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
+
+ "Modified (comment): / 06-07-2011 / 11:21:16 / cg"
+!
+
+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"
+!
+
+executeInBackground:aBlock
+ "used to update when I do not have the focus (i.e. being iconified or non-active).
+ Run aBlock at suerBackgroundPrio, but go back to normal prio, if I get the focus"
+
+ |activeProcess watcher done|
+
+ activeProcess := Processor activeProcess.
+
+ done := false.
+
+ watcher :=
+ [
+ |wg|
+
+ [done] whileFalse:[
+ Delay waitForSeconds:0.2.
+ self applicationIsActive ifTrue:[
+ activeProcess priority:(Processor userSchedulingPriority).
+ done := true.
+ ].
+ ].
+ ] fork.
+
+ [
+ activeProcess withUserBackgroundPriorityDo:aBlock
+ ] ensure:[
+ done := true.
+ watcher terminate
+ ].
+!
+
+inSlaveMode
+ ^ (self slaveMode value == true)
+!
+
+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].
+ (packageFilter includes:self class nameListEntryForChanged) 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"
+!
+
+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:'queries'!
+
+supportsSearch
+
+ ^true
+
+ "Created: / 27-07-2011 / 20:31:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList methodsFor:'setup'!
+
+autoSelect:aBoolean
+ autoSelect := aBoolean.
+!
+
+commonPostBuild
+ |list|
+
+ self inSlaveMode ifFalse:[
+ "/ listValid ifFalse:[self enqueueDelayedUpdateList "updateList"].
+ listValid := false.
+ ] ifTrue:[
+ listValid := false.
+ "/ self enqueueDelayedUpdateList.
+ "/ self invalidateList
+ ].
+
+ self makeDependent.
+
+ list := builder componentAt:#List.
+ list notNil ifTrue:[
+ list selectConditionBlock:[:item | self selectionChangeAllowed].
+ list ignoreReselect:false.
+ ].
+
+ UserPreferences current useInPlaceSearchInBrowserLists ifTrue:[
+ self supportsSearch ifTrue:[
+ list notNil ifTrue:[
+ searchHandler := SearchHandler for: list
+ ] ifFalse:[
+ self breakPoint: #jv info: 'Should support search but list is nil. Wrong spec?'
+ ].
+ ]
+ ]
+
+ "Modified: / 28-07-2011 / 09:39:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+commonPostOpen
+ super commonPostOpen.
+ listValid ifFalse:[
+ "/ self enqueueDelayedUpdateList.
+ ].
+! !
+
+!BrowserList::SearchHandler class methodsFor:'instance creation'!
+
+for: aView
+
+ ^self new initializeFor: aView.
+
+ "Created: / 27-07-2011 / 20:30:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList::SearchHandler methodsFor:'event handling'!
+
+keyPress:key x:x y:y view:aView
+ <resource: #keyboard (#Escape #Accept #Return #CursorUp #CursorDown)>
+
+ | v |
+
+ aView == listView ifTrue:[
+
+ "Forward the event to the view under pointer.
+ Therefore, the seach is started only iff the
+ pointer points to the list. Based on experience,
+ this improves usability because: does not require
+ to click in the list to focus it (which may change
+ the selection)"
+ (v := aView windowGroup pointerView) ~~ aView ifTrue:[
+ v notNil ifTrue:[
+ aView windowGroup focusView: v.
+ v sensor keyPress:key x:x y:y view:v.
+ ^self.
+ ].
+ ].
+
+ searchWindow isNil ifTrue:[
+ key isCharacter ifTrue:[
+ searchHolder setValue: key asString.
+ self startSearch
+ ]
+ ] ifFalse:[
+ key == #Escape ifTrue:[self stopSearch].
+ key == #Accept ifTrue:[self stopSearch].
+ key == #Return ifTrue:[self stopSearch].
+ ]
+ ].
+
+ aView == searchField ifTrue:[
+ key == #Escape ifTrue:[self stopSearch].
+ key == #Accept ifTrue:[self stopSearch].
+ key == #Return ifTrue:[self stopSearch].
+ (key == #CursorUp or:[key == #CursorDown]) ifTrue:[
+ listView sensor setCtrlDown: false.
+ listView sensor setShiftDown: false.
+ listView keyPress:key x:x y:y
+ ].
+
+ ]
+
+ "Created: / 27-07-2011 / 20:39:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList::SearchHandler methodsFor:'event handling-queries'!
+
+handlesKeyPress:key inView:aView
+ <resource: #keyboard (#Escape #Accept #Return #CursorUp #CursorDown)>
+
+ aView == listView ifTrue:[
+ key isCharacter ifTrue:[
+ ^true
+ ]
+ ].
+ aView == searchField ifTrue:[
+ (#(#Escape #Accept #Return #CursorUp #CursorDown) includes: key) ifTrue:[
+ ^true
+ ]
+ ].
+ ^false
+
+ "Created: / 27-07-2011 / 20:39:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList::SearchHandler methodsFor:'initialization'!
+
+initializeFor: aView
+
+ aView isScrollWrapper ifTrue:[
+ listView := aView scrolledView
+ ] ifFalse:[
+ listView := aView.
+ ].
+ listView delegate: self.
+ searchHolder := ValueHolder with: nil.
+ searchHolder onChangeSend: #updateList to: self.
+
+ "Created: / 27-07-2011 / 20:32:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList::SearchHandler methodsFor:'private'!
+
+absoluteLeftOfListView
+
+ | absoluteLeft view |
+ absoluteLeft := 1.
+ view := listView.
+ [ view notNil ] whileTrue:
+ [absoluteLeft := absoluteLeft + view left - 2.
+ view := view superView].
+ ^absoluteLeft
+
+ "Created: / 08-08-2009 / 22:30:07 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 27-07-2011 / 21:54:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+absoluteTopOfListView
+
+ | absoluteTop view |
+ absoluteTop := 1.
+ view := listView.
+ [ view notNil ] whileTrue:
+ [absoluteTop := absoluteTop + view top - 1.
+ view := view superView].
+ ^absoluteTop
+
+ "Created: / 08-08-2009 / 22:30:16 / Jan Vrany <vranyj1@fel.cvut.cz>"
+ "Created: / 27-07-2011 / 21:54:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+filter
+
+ | pattern |
+ pattern := StringPattern fromString: searchHolder value.
+
+ ^[:entry :relax|
+ pattern match: entry asString trimSeparators relax: relax
+ ]
+
+ "Created: / 27-07-2011 / 22:18:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+hideSearchWindow
+
+ searchWindow
+ ifNotNil:[
+ searchWindow destroy.
+ searchWindow := nil.
+ searchField := nil.
+ ]
+
+ "Created: / 27-07-2011 / 21:38:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+restoreList
+
+ self updateSelection.
+ listView listHolder: listHolder.
+ listSelectionHolder notNil ifTrue:[
+ listView model: listSelectionHolder.
+ ].
+ listSelectionHolder changed: #value
+
+ "Created: / 27-07-2011 / 22:14:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+saveList
+
+ listHolder := listView listHolder.
+ listSelectionHolder := listView model.
+
+ "Created: / 27-07-2011 / 22:14:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+showSearchWindow
+
+ searchWindow := StandardSystemView new
+ bePopUpView;
+ beSlave;
+ origin:(self absoluteLeftOfListView + 5" - optionsView textStartLeft")
+ @ (self absoluteTopOfListView + listView height + 1 + 5)
+ extent:(listView width + 0"((optionsView textStartLeft) * 2)") @ (listView font height * 1.5) ceiling.
+
+ searchField := (EditField
+ origin: 0.0@0.0
+ corner: 1.0@1.0
+ in: searchWindow)
+ model: searchHolder;
+ immediateAccept: true;
+ delegate: self;
+ yourself.
+
+ searchWindow openModal.
+
+ "Created: / 27-07-2011 / 21:37:33 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+startSearch
+
+ self saveList.
+ self updateList.
+ self showSearchWindow.
+
+ "Created: / 27-07-2011 / 21:37:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+stopSearch
+
+ self hideSearchWindow.
+ self restoreList.
+
+ "Created: / 27-07-2011 / 21:37:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateList
+
+ | filter filteredList |
+ filter := self filter.
+
+ filteredList := listHolder value select:[:each|filter value: each value: 1].
+ filteredList isEmpty ifTrue:[
+ filteredList := listHolder value select:[:each|filter value: each value: 2].
+ filteredList isEmpty ifTrue:[
+ filteredList := listHolder value select:[:each|filter value: each value: 3].
+ ]].
+
+
+ listView listHolder == listHolder ifTrue:[
+ listView listHolder: (ValueHolder with: filteredList)
+ ] ifFalse:[
+ listView listHolder value: filteredList.
+ ].
+ listView model == listSelectionHolder ifTrue:[
+ listView model: ValueHolder new.
+ listView model onChangeSend: #updateSelection to: self.
+ ].
+ filteredList size == 1 ifTrue:[
+ listView selection: 1
+ ]
+
+ "Created: / 27-07-2011 / 22:18:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+updateSelection
+
+ | sel |
+
+ listSelectionHolder isNil ifTrue:[^self].
+
+ sel := listView selection.
+ sel notNil ifTrue:[
+ sel isInteger ifTrue:[
+ sel := listHolder identityIndexOf: (listView list at: sel)
+ ] ifFalse:[
+ sel := sel collect:[:each|listHolder value identityIndexOf: (listView list at: each)]
+ ].
+ ] ifFalse:[
+ listView multipleSelectOk ifTrue:[
+ sel := #()
+ ]
+ ].
+ listView useIndex ifFalse:[
+ sel isInteger ifTrue:[
+ sel := listHolder value at: sel
+ ] ifFalse:[
+ sel := sel collect:[:each|listHolder value at: each].
+ ]
+ ].
+
+
+ listSelectionHolder value: sel.
+
+ "Created: / 02-08-2011 / 09:08:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!BrowserList class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BrowserList.st,v 1.64 2014-03-05 10:39:09 vrany Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libtool/Tools__BrowserList.st,v 1.64 2014-03-05 10:39:09 vrany Exp $'
+! !
+