Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.330.mcz
==================== Summary ====================
Name: ToolBuilder-Morphic-mt.330 Author: mt Time: 27 January 2023, 3:56:04.931326 pm UUID: cec84c71-a0f0-5c49-907b-e40e3d2d0ba6 Ancestors: ToolBuilder-Morphic-mt.329
Complement Morphic-mt.2081
=============== Diff against ToolBuilder-Morphic-mt.329 ===============
Item was changed: SimpleHierarchicalListMorph subclass: #PluggableTreeMorph + instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector findText findQueue' - instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector' classVariableNames: 'FilterByLabelsOnly MaximumSearchDepth' poolDictionaries: '' category: 'ToolBuilder-Morphic'!
!PluggableTreeMorph commentStamp: 'ar 2/12/2005 04:38' prior: 0! A pluggable tree morph.!
Item was added: + ----- Method: PluggableTreeMorph class>>clearFilterDelay (in category 'preferences') ----- + clearFilterDelay + + ^ PluggableListMorph clearFilterDelay!
Item was removed: - ----- Method: PluggableTreeMorph class>>maximumSearchDepth (in category 'preferences') ----- - maximumSearchDepth - <preference: 'Maximum tree search depth' - category: 'scrolling' - description: 'When using the Filterable Lists option, this specifies the maximum depth that will be searched below the current selection in of the hierarchy.' - type: #Number> - ^ MaximumSearchDepth ifNil: [ 1 ]!
Item was removed: - ----- Method: PluggableTreeMorph class>>maximumSearchDepth: (in category 'preferences') ----- - maximumSearchDepth: anInteger - MaximumSearchDepth := anInteger.!
Item was changed: ----- Method: PluggableTreeMorph>>basicKeyPressed: (in category 'event handling') ----- basicKeyPressed: aChar
+ self currentEvent commandKeyPressed ifTrue: [ + aChar = $f ifTrue: [^ self find]. + aChar = $g ifTrue: [^ self findAgain]]. + + aChar asciiValue >= 32 ifTrue: [ + self treeFilterAppend: aChar].! - aChar asciiValue >= 32 ifFalse: [^ false]. - self updateLastKeystrokes: aChar. - - model okToChange ifFalse: [^ false]. - - PluggableListMorph filterableLists - ifTrue: [self triggerFilterTree] - ifFalse: [self selectNextMorphByFilter]. - - ^ true!
Item was added: + ----- Method: PluggableTreeMorph>>filterTerm (in category 'filtering') ----- + filterTerm + ^ lastKeystrokes ifNil: ['']!
Item was added: + ----- Method: PluggableTreeMorph>>filterTerm: (in category 'filtering') ----- + filterTerm: aString + + lastKeystrokes = aString ifTrue: [^ self]. + lastKeystrokes := aString. + + self filterTreeNow.!
Item was changed: ----- Method: PluggableTreeMorph>>filterTree (in category 'filtering') ----- filterTree + + | currentParent firstMatch | + "Update the filter, try to keep selection stable." + self fixateSelectionDuring: [self filterTreeNow]. + "Now update selection and scroll position as needed." + self hoveredMorph: nil. + currentParent := self selectedParentMorph. + firstMatch := currentParent + ifNil: [self roots detect: [:ea | ea visible]] + ifNotNil: [:pm | pm firstVisibleChild]. + self selectedMorph visible ifFalse: [ + "Select the first match only if current selection does not match anymore." + self setSelectedMorph: firstMatch. + self scrollSelectionAndExtraIntoView. + "Keep parent visible to provide context information. Ensure visibility of current selection." + self scrollSelectionParentIntoView: currentParent].! - self hasFilter ifFalse: - [ self removeFilter. - ^ self ]. - self indicateFiltered. - "Clean up the tree." - (self selectedMorph - ifNil: [ self roots ] - ifNotNil: - [ : m | {m} ]) do: - [ : item | | filteredItems | - item applyFilter: lastKeystrokes. - item visible ifFalse: - [ "Do not hide the item where the filter is based on." - item show. - item isExpanded ifFalse: [ item toggleExpandedState ] ]. - filteredItems := self filteredItems. - "If configured as a navigation tool, advance the selection." - (PluggableTreeMorph maximumSearchDepth = 1 and: [ PluggableTreeMorph filterByLabelsOnly not ]) ifTrue: - [ |toBeExpanded| - (filteredItems notEmpty and: [ selectedMorph ~= filteredItems last ]) ifTrue: - [ self setSelectedMorph: - (toBeExpanded := selectedMorph - ifNil: [ filteredItems first ] - ifNotNil: [ filteredItems after: selectedMorph ]). - toBeExpanded isExpanded ifFalse: [ toBeExpanded toggleExpandedState ] ] ] ]. - self adjustSubmorphPositions!
Item was added: + ----- Method: PluggableTreeMorph>>filterTreeNow (in category 'filtering') ----- + filterTreeNow + + | any | + self hasFilter ifFalse: [^ self removeFilter]. + + "Show all current items again before filtering them out." + scroller submorphsDo: [:m | m removeFilter]. + + "Filter the children of the current parent. Do not filter the parent." + any := false. + self selectedParentMorph + ifNil: [self roots do: [:each | + (each applyFilter: lastKeystrokes) ifTrue: [any := true]]] + ifNotNil: [:pm | pm childrenDo: [:each | + (each applyFilter: lastKeystrokes) ifTrue: [any := true]]]. + + any ifFalse: [ + "Remove the last character and try filtering again." + lastKeystrokes := lastKeystrokes allButLast: 1. + ^ self filterTreeNow]. + + self adjustSubmorphPositions!
Item was added: + ----- Method: PluggableTreeMorph>>filterableTree (in category 'filtering') ----- + filterableTree + + ^ (self valueOfProperty: #filterableTree ifAbsent: [false]) or: [PluggableListMorph filterableLists]!
Item was added: + ----- Method: PluggableTreeMorph>>filterableTree: (in category 'filtering') ----- + filterableTree: aBoolean + + ^ self setProperty: #filterableTree toValue: aBoolean!
Item was added: + ----- Method: PluggableTreeMorph>>find (in category 'searching') ----- + find + "Prompt the user for a string to search for breadth first in the tree." + + | path | + self setSearchFromSelection. + + path := self selectedPath. + + (Project uiManager request: ('{1} -> ...\Find what to select in subtree?' translated withCRs format: {(path collect: [:ea | ea itemName]) joinSeparatedBy: ' -> '}) initialAnswer: findText) + ifEmpty: [^ self] + ifNotEmpty: [:reply | + findText := reply. + findQueue := OrderedCollection withAll: (path last contents collect: [:nextItem | path copyWith: nextItem]). + self findAgainNow].!
Item was added: + ----- Method: PluggableTreeMorph>>findAgain (in category 'searching') ----- + findAgain + "Jump to next result. Breadth-first search." + + self setSearchFromSelection. + self findAgainNow.!
Item was added: + ----- Method: PluggableTreeMorph>>findAgainNow (in category 'searching') ----- + findAgainNow + + | currentPath | + (findQueue isNil or: [findQueue isEmpty]) ifTrue: [^ self flash]. + + self flag: #todo. "mt: Ask model about breadth-first or depth-first, indicate search progress in UI, allow find-again-backwards, ..." + + Cursor wait showWhile: [ + [findQueue notEmpty] whileTrue: [ + | currentItem | + currentPath := findQueue removeFirst. + currentItem := currentPath last. + currentItem hasContents ifTrue: [ + findQueue addAll: (currentItem contents collect: [:nextItem | currentPath copyWith: nextItem])]. + + (self matches: findText in: currentItem) ifTrue: [ + "Match!! Stop search for now." + self selectPath: (currentPath collect: [:ea | ea item]). + "Revert a side-effect from #selectPath:." + self selectedMorph isExpanded ifTrue: [ + self toggleExpandedState: self selectedMorph]. + "Mimic filter function to highlight (and filter) search results." + lastKeystrokes := findText. + self filterTree. + self scrollSelectionAndExtraIntoView. + ^ self]]]. + + self inform: 'Nothing found.' translated.!
Item was added: + ----- Method: PluggableTreeMorph>>fixateSelectionDuring: (in category 'selection') ----- + fixateSelectionDuring: aBlock + + | vDelta | + selectedMorph ifNil: [aBlock value. ^ self]. + + vDelta := ((selectedMorph localPointToGlobal: selectedMorph topLeft) + - (scroller localPointToGlobal: scroller topLeft)) y. + + aBlock value. + + selectedMorph visible ifTrue: [ + self scrollToBottom. + self scrollToShow: (selectedMorph bounds outsetBy: (0@vDelta corner: 0@0))].!
Item was changed: ----- Method: PluggableTreeMorph>>hasFilter (in category 'filtering') ----- hasFilter + ^ self filterTerm notEmpty! - ^ lastKeystrokes isEmptyOrNil not!
Item was changed: ----- Method: PluggableTreeMorph>>indicateUnfiltered (in category 'filtering') ----- + indicateUnfiltered! - indicateUnfiltered - self color: (self userInterfaceTheme color ifNil: [Color white]). - scroller submorphsDo: [:m | - m visible: true; backgroundColor: nil]. - self adjustSubmorphPositions.!
Item was changed: ----- Method: PluggableTreeMorph>>keyStroke: (in category 'event handling') ----- keyStroke: event
+ (super keyStroke: event) ifFalse: [ + "Assume that super did not handle the event." + self basicKeyPressed: event keyCharacter].! - ^ (super keyStroke: event) - ifTrue: [true] - ifFalse: [self basicKeyPressed: event keyCharacter].!
Item was added: + ----- Method: PluggableTreeMorph>>matches:in: (in category 'searching') ----- + matches: pattern in: wrapper + + ^ ((PluggableTreeMorph filterByLabelsOnly + ifTrue: [ wrapper itemName ] + ifFalse: [ wrapper asStringOrText ]) + findString: findText + startingAt: 1 + caseSensitive: false) > 0!
Item was changed: ----- Method: PluggableTreeMorph>>removeFilter (in category 'filtering') ----- removeFilter + "Remove the current filter. Keep the current selection stable unless it is expanded and needs more space for its children." + + self fixateSelectionDuring: [ + self filterTerm: String empty. + scroller submorphsDo: [:m | m removeFilter]. + self adjustSubmorphPositions]. + + "Try to show all children again for the current selection." + self scrollSelectionAndChildrenIntoView. + self scrollSelectionAndExtraIntoView.! - lastKeystrokes := String empty. - self indicateUnfiltered.!
Item was changed: ----- Method: PluggableTreeMorph>>selectNextMorphByFilter (in category 'filtering') ----- + selectNextMorphByFilter + + self flag: #todo. "mt: Like simple navigation for lists when filterable-lists is disabled."! - selectNextMorphByFilter!
Item was added: + ----- Method: PluggableTreeMorph>>selectedPath (in category 'selection') ----- + selectedPath + "Answers the current path without asking the model." + + | current path | + current := self selectedMorph. + path := OrderedCollection new. + [current notNil] whileTrue: [ + path add: current. + current := self parentMorphOf: current]. + ^ (path size to: 1 by: -1) collect: [:ea | + (path at: ea) complexContents]!
Item was added: + ----- Method: PluggableTreeMorph>>setSearchFromSelection (in category 'searching') ----- + setSearchFromSelection + + self hasFilter + ifTrue: [findText := lastKeystrokes] + ifFalse: [self selectedMorph + ifNil: [findText := ''] + ifNotNil: [:m | findText := m complexContents itemName]].!
Item was added: + ----- Method: PluggableTreeMorph>>toggleExpandedState: (in category 'keyboard navigation') ----- + toggleExpandedState: aMorph + + aMorph toggleExpandedState. + " (self hasFilter and: [aMorph isExpanded not and: [aMorph canExpand]]) + ifTrue: [aMorph expandFiltered -- useful at all?] + ifFalse: [aMorph toggleExpandedState]. + " self adjustSubmorphPositions. + + aMorph isExpanded + ifTrue: [self scrollSelectionAndChildrenIntoView] + ifFalse: [self scrollSelectionAndExtraIntoView].!
Item was added: + ----- Method: PluggableTreeMorph>>treeFilterAppend: (in category 'filtering') ----- + treeFilterAppend: aChar + + | milliseconds slowKeyStroke | + model okToChange ifFalse: [^ self]. + + milliseconds := Time millisecondClockValue. + slowKeyStroke := (Time + milliseconds: milliseconds + since: lastKeystrokeTime) > self class clearFilterDelay. + lastKeystrokeTime := milliseconds. + + slowKeyStroke + ifTrue: [lastKeystrokes := aChar asLowercase asString] + ifFalse: [lastKeystrokes := lastKeystrokes , aChar asLowercase asString.]. + + self filterableTree + ifTrue: [ + "For expanded selections, we assume that the user is already looking at the children." + self selectedMorph isExpanded + ifTrue: [self setSelectedMorph: self selectedMorph firstChild]. + self filterTree] + ifFalse: [self selectNextMorphByFilter].!
Item was added: + ----- Method: PluggableTreeMorph>>treeFilterSet: (in category 'filtering') ----- + treeFilterSet: aString + "Set the filter term and select the first match." + + self filterTerm: aString. + self setSelectedMorph: self filteredItems first.!
Item was removed: - ----- Method: PluggableTreeMorph>>triggerFilterTree (in category 'filtering') ----- - triggerFilterTree - - self removeAlarm: #filterTree. - self addAlarm: #filterTree after: 300.!
packages@lists.squeakfoundation.org