[squeak-dev] The Trunk: ToolBuilder-Morphic-mt.330.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jan 27 14:56:06 UTC 2023


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 at vDelta corner: 0 at 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.!



More information about the Squeak-dev mailing list