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

commits at source.squeak.org commits at source.squeak.org
Thu Feb 23 14:12:28 UTC 2023


Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk:
http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.335.mcz

==================== Summary ====================

Name: ToolBuilder-Morphic-mt.335
Author: mt
Time: 23 February 2023, 3:12:28.597976 pm
UUID: 19b45f10-c2e0-aa42-9cf9-4cde199d101f
Ancestors: ToolBuilder-Morphic-mt.334

Some updates for our tree widgets:
- filter modes (type-in): #siblings (default), #visible, #all
- search modes (CMD+F/G): #breadthFirst (default), #depthFirst
- [backspace] can be used to abort filtering and toggle prior selection (like in lists); [return] will also reset the filter but keep the current selection
- select last item when clicking past the last (like in lists)
- selection updates: if models omit to communicate the current (i.e., to-be-expanded) path for the current selection, try to fetch that selected path automatically and then try again to set the selection
- some bugfixes regarding empty selections and filter updates
- new model-changed operations:
  > model changed: #labelOf: (i.e., getLabelSelector) ... to refresh all labels
  > model changed: #expandAllNodesRequested with: ... to expand everything behind a specific node (or all roots)
  > model changed: #expandNodeRequested with: ... to expand one level behind a specific node

! Be aware that the #all type-in filter assumes that there are no recursive model structures. That's why the default #filterMode in the ObjectExplorer is still #siblings. !

=============== Diff against ToolBuilder-Morphic-mt.334 ===============

Item was changed:
  ----- Method: MorphicToolBuilder>>buildPluggableTree: (in category 'widgets required') -----
  buildPluggableTree: aSpec
  	| widget |
  	widget := self treeClass new.
  	self register: widget id: aSpec name.
  
  	widget getLabelSelector: aSpec label.
  	widget getIconSelector: aSpec icon.
  
  	widget model: aSpec model.
  	widget nodeClass: aSpec nodeClass.
  
  	widget getRootsSelector: aSpec roots.
  	widget getChildrenSelector: aSpec getChildren.
  	widget hasChildrenSelector: aSpec hasChildren.
+ 	
+ 	widget filterMode: aSpec filterMode.
+ 	widget searchMode: aSpec searchMode.
  
- 	widget getSelectedSelector: aSpec getSelected.
- 	widget setSelectedSelector: aSpec setSelected.
  	widget getSelectedPathSelector: aSpec getSelectedPath.
  	widget setSelectedPathSelector: aSpec setSelectedPath.
+ 	widget getSelectedSelector: aSpec getSelected.
+ 	widget setSelectedSelector: aSpec setSelected.
  
  	widget setSelectedParentSelector: aSpec setSelectedParent.
  
  	widget getHelpSelector: aSpec help.
  	widget getMenuSelector: aSpec menu.
  
  	widget keystrokeActionSelector: aSpec keyPress.
  	widget autoDeselect: aSpec autoDeselect.
  	widget doubleClickSelector: aSpec doubleClick.
  	
  	widget dropItemSelector: aSpec dropItem.
  	widget wantsDropSelector: aSpec dropAccept.
  	widget dragItemSelector: aSpec dragItem.
  	widget dragStartedSelector: aSpec dragStarted.
  	widget dragTypeSelector: aSpec dragType.
  	
  	widget columns: aSpec columns.
  	
  	"Override default scroll bar policies if needed. Widget will use preference values otherwise."
  	aSpec hScrollBarPolicy ifNotNil: [:policy |
  		policy caseOf: {
  			[#always] -> [widget alwaysShowHScrollBar].
  			[#never] -> [widget hideHScrollBarIndefinitely].
  			[#whenNeeded] -> [widget showHScrollBarOnlyWhenNeeded]. } ].
  	aSpec vScrollBarPolicy ifNotNil: [:policy |
  		policy caseOf: {
  			[#always] -> [widget alwaysShowVScrollBar].
  			[#never] -> [widget hideVScrollBarIndefinitely].
  			[#whenNeeded] -> [widget showVScrollBarOnlyWhenNeeded]. } ].	
  	
  	self setFrame: aSpec frame in: widget.
  	self setLayoutHintsFor: widget spec: aSpec.
  	
  	parent ifNotNil:[self add: widget to: parent].
  "	panes ifNotNil:[
  		aSpec roots ifNotNil:[panes add: aSpec roots].
  	].	"
  	^widget!

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 filterColumnIndex filterMode searchMode priorSelection'
+ 	classVariableNames: ''
- 	instanceVariableNames: 'rootWrappers selectedWrapper getRootsSelector getChildrenSelector hasChildrenSelector getLabelSelector getIconSelector getSelectedPathSelector setSelectedPathSelector setSelectedParentSelector getHelpSelector dropItemSelector wantsDropSelector dragItemSelector dragTypeSelector nodeClass lastKeystrokeTime lastKeystrokes dragStartedSelector doubleClickSelector findText findQueue filterColumnIndex'
- 	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>>checkFilterMode: (in category 'filtering') -----
+ checkFilterMode: aSymbol
+ 
+ 	aSymbol == #siblings ifTrue: [^ self].
+ 	aSymbol == #visible ifTrue: [^ self].
+ 	aSymbol == #all ifTrue: [^ self].
+ 	
+ 	Error signal: 'Invalid value for filter mode. Use #siblings, #visible, or #all.'.!

Item was added:
+ ----- Method: PluggableTreeMorph>>checkSearchMode: (in category 'searching') -----
+ checkSearchMode: aSymbol
+ 
+ 	aSymbol == #breadthFirst ifTrue: [^ self].
+ 	aSymbol == #depthFirst ifTrue: [^ self].
+ 	
+ 	Error signal: 'Invalid value for search mode. Use #breadthFirst or #depthFirst.'.!

Item was added:
+ ----- Method: PluggableTreeMorph>>collapseAllButSelection (in category 'filtering') -----
+ collapseAllButSelection
+ 	"If the filterMode is set to #all, filtering will expand (and collapse) nodes. Thus, it is can be useful to collapse all nodes again but show the current selection to get an overview again when removing the filter."
+ 	
+ 	| selectedPath |
+ 	self fixateSelectionDuring: [
+ 		selectedPath := self selectedPath.
+ 		selectedMorph := nil. "Avoid selection update via #collapseAll. See #noteRemovalOfAll:."
+ 		self collapseAll.
+ 		self selectedPath: selectedPath].!

Item was added:
+ ----- Method: PluggableTreeMorph>>currentSelectionItem: (in category 'selection') -----
+ currentSelectionItem: itemOrNil
+ 	"Variation of #selection: to ensure identity check for model data. See #updateSelection."
+ 		
+ 	| i |
+ 	itemOrNil ifNil: [^ self selectionIndex: 0].
+ 	i := scroller submorphs findFirst: [:m | m complexContents item == itemOrNil].
+ 	self selectionIndex: i!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterMode (in category 'accessing') -----
+ filterMode
+ 
+ 	^ filterMode ifNil: [filterMode := #siblings]!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterMode: (in category 'accessing') -----
+ filterMode: aSymbol
+ 	"#siblings, #visible, #all"
+ 
+ 	self checkFilterMode: aSymbol.
+ 	filterMode := aSymbol.!

Item was changed:
  ----- Method: PluggableTreeMorph>>filterTerm: (in category 'filtering') -----
  filterTerm: aString
  
  	lastKeystrokes = aString ifTrue: [^ self].
  	lastKeystrokes := aString.
  	
+ 	self hasFilter
+ 		ifTrue: [self filterTree]
+ 		ifFalse: [self removeFilter].!
- 	self filterTreeNow.!

Item was changed:
  ----- Method: PluggableTreeMorph>>filterTree (in category 'filtering') -----
  filterTree
  
  	| currentParent firstMatch |
+ 	self filterMode = #siblings ifTrue: [
+ 		"For expanded selections, we assume that the user is already looking at the children. This is beneficial for the ObjectExplorer and a useful heuristic in general."
+ 		self selectedMorph ifNotNil: [:focus |
+ 			focus isExpanded ifTrue: [self setSelectedMorph: focus firstChild]]].
+ 	
  	"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
+ 		ifNil: [self scrollToTop]
+ 		ifNotNil: [:focus |
+ 			focus 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 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].!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterTreeButSelection (in category 'filtering') -----
+ filterTreeButSelection
+ 	"Similar to #collapseAllButSelection. Apply the filter but make sure the current selection stays unchanged."
+ 	
+ 	| selectedPath |
+ 	self fixateSelectionDuring: [
+ 		selectedPath := self selectedPath.
+ 		selectedMorph := nil. "Avoid selection update via #collapseAll. See #noteRemovalOfAll:."
+ 		self filterTree.
+ 		self selectedPath: selectedPath].!

Item was changed:
  ----- 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].
  	
+ 	(self filterMode caseOf: {
+ 		[#siblings]		-> [self filterTreeNowSiblings "default"].
+ 		[#visible]		-> [self filterTreeNowVisible].
+ 		[#all]			-> [self filterTreeNowAll] })	
+ 			ifFalse: [ "Remove the last character and try filtering again."
+ 				lastKeystrokes := lastKeystrokes allButLast: 1.
+ 				^ self filterTreeNow].
- 	"Filter the children of the current parent. Do not filter the parent."
- 	any := false.
- 	self selectedParentMorph
- 		ifNil: [self roots do: [:each |
- 				each collapse. "Avoid inadvertent walk-down. See #treeFilterAppend:."
- 				(each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]]
- 		ifNotNil: [:pm | pm childrenDo: [:each |
- 				each collapse. "Avoid inadvertent walk-down. See #treeFilterAppend:."
- 				(each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]].
- 	
- 	any ifFalse: [
- 		"Remove the last character and try filtering again."
- 		lastKeystrokes := lastKeystrokes allButLast: 1.
- 		^ self filterTreeNow].
  
+ 	self adjustSubmorphPositions.!
- 	self adjustSubmorphPositions!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterTreeNowAll (in category 'filtering') -----
+ filterTreeNowAll
+ 	"Apply the current filter term to all nodes. Expand collapsed nodes if needed."
+ 
+ 	| any |
+ 	any := false.
+ 	self roots do: [:each | 
+ 		(each applyRecursiveFilter: lastKeystrokes column: filterColumnIndex allowExpand: true)
+ 			ifTrue: [any := true]].
+ 	^ any!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterTreeNowSiblings (in category 'filtering') -----
+ filterTreeNowSiblings
+ 	"Filter the children of the current parent. Do not filter the parent."
+ 
+ 	| any |
+ 	any := false.
+ 
+ 	self selectedParentMorph
+ 		ifNil: [self roots do: [:each |
+ 				each collapse. "Avoid inadvertent walk-down. See #filterTree."
+ 				(each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]]
+ 		ifNotNil: [:pm | pm childrenDo: [:each |
+ 				each collapse. "Avoid inadvertent walk-down. See #filterTree."
+ 				(each applyFilter: lastKeystrokes column: filterColumnIndex) ifTrue: [any := true]]].
+ 	
+ 	^ any!

Item was added:
+ ----- Method: PluggableTreeMorph>>filterTreeNowVisible (in category 'filtering') -----
+ filterTreeNowVisible
+ 	"Apply the current filter term to all (potentially) visible (or expanded) nodes. Do not change any isExpanded state."
+ 	
+ 	| any |
+ 	any := false.
+ 	self roots do: [:each | 
+ 		(each applyRecursiveFilter: lastKeystrokes column: filterColumnIndex allowExpand: false)
+ 			ifTrue: [any := true]].
+ 	^ any!

Item was changed:
  ----- 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 selectedPathWrappers ifNotEmpty: [:p | p allButLast].
- 	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 := path
+ 				ifEmpty: [self roots collect: [:ea | {ea complexContents}] as: OrderedCollection]
+ 				ifNotEmpty: [path last contents collect: [:nextItem | path copyWith: nextItem] as: OrderedCollection].
- 			findQueue := OrderedCollection withAll: (path last contents collect: [:nextItem | path copyWith: nextItem]).
  			self findAgainNow].!

Item was changed:
  ----- 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: [
+ 		(self searchMode caseOf: {
+ 			[#breadthFirst] -> [self findAgainNowBreadthFirst].
+ 			[#depthFirst] -> [self findAgainNowDepthFirst] })
+ 				ifNotNil: [:currentPath |
+ 					"Search used model data. View might already be outdated.
+ 					Collapse parent now to get up-to-date children."
+ 					self selectedMorph ifNotNil: [:focus | 
+ 						focus isExpanded ifTrue: [
+ 							self toggleExpandedState: self selectedMorph]].
+ 					"Match!! Stop search for now. Select the match."
+ 					self selectedPathWrappers: currentPath.
+ 					self selectedMorph ifNil: [
+ 						^ self inform: 'Could not find path. View up to date?' translated].
+ 					"Mimic filter function to highlight (and filter) search results."
+ 					lastKeystrokes := findText.
+ 					self filterTree.
+ 					self scrollSelectionAndExtraIntoView.
+ 					^ self]].
- 		[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: [
- 				"Search used model data. View might already be outdated.
- 				Collapse parent now to get up-to-date children."
- 				self selectedMorph isExpanded ifTrue: [
- 					self toggleExpandedState: self selectedMorph].
- 				"Match!! Stop search for now. Select the match."
- 				self selectPath: (currentPath collect: [:ea | ea item]).
- 				self selectedMorph ifNil: [
- 					^ self inform: 'Could not find path. View up to date?' translated].
- 				"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>>findAgainNowBreadthFirst (in category 'searching') -----
+ findAgainNowBreadthFirst
+ 
+ 	[findQueue notEmpty] whileTrue: [
+ 		| currentItem currentPath |
+ 		currentPath := findQueue removeFirst.
+ 		currentItem := currentPath last.
+ 		currentItem hasContents ifTrue: [
+ 			findQueue addAll: (currentItem contents collect: [:nextItem | currentPath copyWith: nextItem])].
+ 		(self matches: findText in: currentItem) ifTrue: [^ currentPath]].
+ 	
+ 	^ nil!

Item was added:
+ ----- Method: PluggableTreeMorph>>findAgainNowDepthFirst (in category 'searching') -----
+ findAgainNowDepthFirst
+ 
+ 	[findQueue notEmpty] whileTrue: [
+ 		| currentItem currentPath |
+ 		currentPath := findQueue removeFirst.
+ 		currentItem := currentPath last.
+ 		currentItem hasContents ifTrue: [
+ 			findQueue addAllFirst: (currentItem contents collect: [:nextItem | currentPath copyWith: nextItem])].
+ 		(self matches: findText in: currentItem) ifTrue: [^ currentPath]].
+ 	
+ 	^ nil!

Item was changed:
  ----- 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 notNil and: [selectedMorph visible]) ifTrue: [
- 	selectedMorph visible ifTrue: [
  		self scrollToBottom.
  		self scrollToShow: (selectedMorph bounds outsetBy: (0 at vDelta corner: 0 at 0))].!

Item was removed:
- ----- Method: PluggableTreeMorph>>getCurrentSelectionItem (in category 'selection') -----
- getCurrentSelectionItem
- 	"Our models are supposed to return real objects, not wrappers. See PluggableTreeItemNode."
- 	
- 	| selectedObject |
- 	selectedObject := self getSelectedSelector
- 		ifNil: [^ nil]
- 		ifNotNil: [:symbol | model perform: symbol].
- 	^ scroller submorphs
- 		detect: [:each | each complexContents item == selectedObject]
- 		ifFound: [:each | each complexContents]
- 		ifNone: [nil]!

Item was changed:
  ----- Method: PluggableTreeMorph>>highlightNoColumn (in category 'filtering') -----
  highlightNoColumn
+ 	"Reset the filter including any column-specific focus."
+ 	
- 
  	filterColumnIndex := nil.
+ 	self hasFilter ifTrue: [self removeFilter].!
- 	self removeFilter.!

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. Note that we must not check for #hasFilter here but in the sender if needed; see #filterTreeNow."
- 	"Remove the current filter. Keep the current selection stable unless it is expanded and needs more space for its children."
  
+ 	lastKeystrokes := String empty.
- 	self fixateSelectionDuring: [
- 		self filterTerm: String empty.
- 		scroller submorphsDo: [:m | m removeFilter].
- 		self adjustSubmorphPositions].
  
+ 	self filterMode = #all
+ 		ifTrue: [
+ 			scroller submorphsDo: [:m | m removeFilter].
+ 			self collapseAllButSelection]
+ 		ifFalse: [
+ 			self fixateSelectionDuring: [
+ 				scroller submorphsDo: [:m | m removeFilter].
+ 				self adjustSubmorphPositions]].
+ 
  	"Try to show all children again for the current selection."
  	self scrollSelectionAndChildrenIntoView.
  	self scrollSelectionAndExtraIntoView.!

Item was added:
+ ----- Method: PluggableTreeMorph>>searchMode (in category 'accessing') -----
+ searchMode
+ 
+ 	^ searchMode ifNil: [searchMode := #breadthFirst]!

Item was added:
+ ----- Method: PluggableTreeMorph>>searchMode: (in category 'accessing') -----
+ searchMode: aSymbol
+ 	"#breadthFirst, #depthFirst"
+ 
+ 	self checkSearchMode: aSymbol.
+ 	searchMode := aSymbol.!

Item was changed:
  ----- Method: PluggableTreeMorph>>selectPath: (in category 'selection') -----
  selectPath: path
+ 	"Select the given path. Do not tell the model. Just update the view."
  
+ 	| newSelection |
+ 	path ifNil: [^ self].
+ 	path ifEmpty: [^ self selectedMorph: nil].
+ 	scroller hasSubmorphs ifFalse: [^ self].
+ 
+ 	newSelection := self selectPath: path in: scroller firstSubmorph.
+ 	self adjustSubmorphPositions. "First adjust, then select to keep selection visible."
+ 	self selectedMorph: newSelection.!
- 	self
- 		selectPath: path
- 		in: (scroller submorphs at: 1 ifAbsent: [^self]).!

Item was changed:
  ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'selection') -----
  selectPath: path in: listItem
+ 	"Private. Use #selectPath:."
+ 
- 	path ifNil: [^self].
- 	path isEmpty ifTrue: [^self setSelectedMorph: nil].
  	listItem withSiblingsDo: [:each | 
+ 		each complexContents item = path first ifTrue: [
+ 			each extension visible: true. "Ensure visibility in case of a filter."
- 		(each complexContents item = path first) ifTrue: [
- 			each isExpanded ifFalse: [
- 				each toggleExpandedState.
- 				self adjustSubmorphPositions.
- 			].
- 			each changed.
  			path size = 1 ifTrue: [
+ 				"Complete match. Finished."
+ 				^ each].
+ 			each isExpanded ifFalse: [
+ 				each toggleExpandedState].
+ 			^ each firstChild ifNotNil: [:firstChild |
+ 				"Partial match. Go on..."
+ 				self selectPath: path allButFirst in: firstChild]]].
+ 	^ nil!
- 				^self setSelectedMorph: each
- 			].
- 			each firstChild ifNil: [^self setSelectedMorph: nil].
- 			^self selectPath: path allButFirst in: each firstChild
- 		].
- 	].
- 	^self setSelectedMorph: nil
- 
- !

Item was changed:
  ----- Method: PluggableTreeMorph>>selectedPath (in category 'selection') -----
  selectedPath
- 	"Answers the current path without asking the model."
  	
+ 	^ self selectedPathWrappers collect: [:ea | ea item]!
- 	| 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>>selectedPath: (in category 'selection') -----
+ selectedPath: path
+ 	"For consistency with #selectedMorph:."
+ 	
+ 	self selectPath: path.!

Item was added:
+ ----- Method: PluggableTreeMorph>>selectedPathWrappers (in category 'selection') -----
+ selectedPathWrappers
+ 	"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>>selectedPathWrappers: (in category 'selection') -----
+ selectedPathWrappers: pathWrappers
+ 	
+ 	self selectedPath: (pathWrappers collect: [:ea | ea item]).!

Item was changed:
  ----- Method: PluggableTreeMorph>>setSelectedPath: (in category 'selection') -----
  setSelectedPath: aMorph
+ 	"Tell the model about the currently selected path. The view is already up-to-date."
  
  	| items wrapperPath |
  	setSelectedPathSelector ifNotNil:
  		[wrapperPath := selectedWrapper 
  			ifNil: [#()]
  			ifNotNil: [
  				wrapperPath := {selectedWrapper} asOrderedCollection.
  				[wrapperPath last parent notNil] whileTrue:
  					[wrapperPath addLast: wrapperPath last parent].
  				wrapperPath].
  		items := wrapperPath collect: [:w | w item].
  		model
  			perform: setSelectedPathSelector
  			with: items].
  			
  !

Item was changed:
  ----- Method: PluggableTreeMorph>>specialKeyPressed: (in category 'event handling') -----
  specialKeyPressed: asciiValue
  
  	(super specialKeyPressed: asciiValue)
  		ifTrue: [^ true].
  
  	asciiValue = Character tab asciiValue ifTrue: [
  		self highlightNextColumn.
  		^ true].
  
  	(#(8 13) includes: asciiValue) ifTrue: [
+ 		"backspace key or return key" 
- 		"backspace key" 
  		self highlightNoColumn. "i.e., remove filter"
+ 		priorSelection ifNotNil: [:prior |
+ 			priorSelection := self selectedPath.
+ 			asciiValue = 8 ifTrue: [ "backspace key -> revert selection"
+ 				self selectedPath: prior.
+ 				self setSelectedMorph: self selectedMorph]].
  		^ true].
  
  	^ false!

Item was changed:
  ----- Method: PluggableTreeMorph>>toggleExpandedState: (in category 'keyboard navigation') -----
  toggleExpandedState: aMorph
  
  	aMorph toggleExpandedState.
+ 	self adjustSubmorphPositions.
- "	(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 changed:
  ----- 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
+ 		ifFalse: [lastKeystrokes := lastKeystrokes , aChar asLowercase asString.]
+ 		ifTrue: [lastKeystrokes := aChar asLowercase asString.
+ 			priorSelection := self selectedPath].
- 		ifTrue: [lastKeystrokes := aChar asLowercase asString]
- 		ifFalse: [lastKeystrokes := lastKeystrokes , aChar asLowercase asString.].
  		
  	self filterableTree
+ 		ifTrue: [self filterTree]
- 		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 changed:
  ----- Method: PluggableTreeMorph>>update: (in category 'updating') -----
  update: what
  	what ifNil:[^self].
  	what == getRootsSelector ifTrue:[
  		self wrapRoots: (model perform: getRootsSelector).
  		^ self].
  	
  	what == getSelectedPathSelector ifTrue:[
+ 		self updateSelectedPath.
- 		self selectPath: self getSelectedPath.
  		^ self].
+ 	
+ 	what == getLabelSelector ifTrue: [
+ 		self updateAllLabels.
+ 		^ self].
  		
  	what == #expandRootsRequested ifTrue: [
  		self expandRoots.
  		^ self].
  	
  	super update: what.
  !

Item was changed:
  ----- Method: PluggableTreeMorph>>update:with: (in category 'updating') -----
  update: what with: anObject
  
  	super update: what with: anObject.
  	
  	what == #objectChanged ifTrue: [
+ 		^ self updateFromChangedObject: anObject].
+ 	what == #expandAllNodesRequested ifTrue: [ 
+ 		"EX: model changed: #expandAllNodesRequested with: #classChildren:."
+ 		"EX: model changed: #expandAllNodesRequested with: {#classChildren:. Morph}."
+ 		| scope item |
+ 		scope := anObject isArray ifTrue: [anObject first] ifFalse: [anObject].
+ 		item := anObject isArray ifTrue: [anObject second].
+ 		getChildrenSelector == scope ifTrue: [
+ 			item
+ 				ifNil: [self roots do: [:ea | self expandAll: ea]]
+ 				ifNotNil: [self expandAll: (scroller submorphs detect: [:ea | ea complexContents item == item])].
+ 			self adjustSubmorphPositions.
+ 			^ self]].
+ 	what == #expandNodeRequested ifTrue: [
+ 		"EX: model changed: #expandNodeRequested with: {#classChildren:. Morph}."
+ 		| scope item |
+ 		scope := anObject first.
+ 		item := anObject second.
+ 		getChildrenSelector == scope ifTrue: [
+ 			scroller submorphs
+ 				detect: [:ea | ea complexContents item == item]
+ 				ifFound: [:morph | (morph canExpand and: [morph isExpanded not])
+ 					ifTrue: [self toggleExpandedState: morph]].
+ 			^ self]].!
- 		self updateFromChangedObject: anObject].!

Item was added:
+ ----- Method: PluggableTreeMorph>>updateAllLabels (in category 'updating') -----
+ updateAllLabels
+ 
+ 	scroller submorphs do: [:ea | ea contents: ea getLabel].
+ 	"self adjustSubmorphPositions. --- not required"!

Item was added:
+ ----- Method: PluggableTreeMorph>>updateSelectedPath (in category 'updating') -----
+ updateSelectedPath
+ 	"Fetch selected path from the model. Also tell the model about the new selection. There is no need that the model notifies about both kinds of selection changes, either one (path or item) is enough."
+ 	
+ 	self selectedPath: self getSelectedPath.
+ 	self setSelectedMorph: self selectedMorph.!

Item was added:
+ ----- Method: PluggableTreeMorph>>updateSelection (in category 'updating') -----
+ updateSelection
+ 	"Overwritten to try to fetch the current path if the selection cannot be found. Also, in case of a filter, ensure that the selection is always visible."
+ 	
+ 	| item |
+ 	self currentSelectionItem: (item := self getCurrentSelectionItem).
+ 	item ifNotNil: [
+ 		self selectedMorph
+ 			ifNil: [self updateSelectedPath]
+ 			ifNotNil: [:focus | focus visible ifFalse: [
+ 				self selectedPath: self selectedPath]]]!

Item was changed:
  ----- Method: PluggableTreeMorph>>wrapRoots: (in category 'updating') -----
  wrapRoots: someObjects
  
  	rootWrappers := someObjects collect: [:item|
  		self nodeClass with: item model: self].
+ 	self list: rootWrappers.
+ 	self hasFilter ifTrue: [
+ 		self filterMode = #siblings
+ 			ifTrue: [self removeFilter "bc. it depends on the current selection"]
+ 			ifFalse: [self filterTreeButSelection]].!
- 	self list: rootWrappers.!



More information about the Squeak-dev mailing list