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

commits at source.squeak.org commits at source.squeak.org
Fri Jan 27 14:55:39 UTC 2023


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

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

Name: Morphic-mt.2081
Author: mt
Time: 27 January 2023, 3:55:35.675326 pm
UUID: 7b7a2680-c376-1245-bd89-7105ab3e8c51
Ancestors: Morphic-mt.2080

Next iteration on text filters in tree widgets. They do now look and feel more similar to filters in list widgets.

Here are the features:
- Everything revolves around the current selection. If that selection is expanded, you are already looking at the children, not your current siblings.
- TYPE something to reduce the current list of siblings (or children). Use preferences to change the #clearFilterDelay from its default 500 ms if needed.
- Hit [Backspace] to reset the filter. Selection should mostly remain stable on screen.
- Hit [CMD]+[F] to start a tree search. [CMD]+[G] to "find again" like in text fields.
- Hit [CMD]+[Dot] if the tree search takes forever...
- Hit [Arrow-left] repeatedly to collapse items and jump to parent nodes.
- Hit [SHIFT]+[Arrow-up/down] to navigate siblings only

=============== Diff against Morphic-mt.2080 ===============

Item was changed:
  StringMorph subclass: #IndentingListItemMorph
+ 	instanceVariableNames: 'indentLevel canExpand isExpanded complexContents firstChild container nextSibling icon backgroundColor filterOffsets'
+ 	classVariableNames: 'FilterBackgroundColor'
- 	instanceVariableNames: 'indentLevel isExpanded complexContents firstChild container nextSibling icon backgroundColor'
- 	classVariableNames: ''
  	poolDictionaries: ''
  	category: 'Morphic-Explorer'!
  
  !IndentingListItemMorph commentStamp: '<historical>' prior: 0!
  An IndentingListItemMorph is a StringMorph that draws itself with an optional toggle at its left, as part of the display of the SimpleHierarchicalListMorph.
  
  It will also display lines around the toggle if the #showLinesInHierarchyViews Preference is set.
  
  Instance variables:
  
  indentLevel <SmallInteger> 	the indent level, from 0 at the root and increasing by 1 at each level of the hierarchy.
  
  isExpanded <Boolean>		true if this item is expanded (showing its children)
  
  complexContents <ListItemWrapper>	an adapter wrapping my represented item that can answer its children, etc.
  	
  firstChild <IndentingListItemMorph|nil>	my first child, or nil if none
  	
  container <SimpleHierarchicalListMorph>	my container
  	
  nextSibling <IndentingListItemMorph|nil>	the next item in the linked list of siblings, or nil if none.
  
  Contributed by Bob Arning as part of the ObjectExplorer package.
  Don't blame him if it's not perfect.  We wanted to get it out for people to play with.!

Item was added:
+ ----- Method: IndentingListItemMorph class>>applyUserInterfaceTheme (in category 'preferences') -----
+ applyUserInterfaceTheme
+ 
+ 	FilterBackgroundColor := (UserInterfaceTheme current get: #hoverSelectionModifier for: #PluggableListMorph)
+ 		ifNil: [ Color white darker alpha: 0.3 ]
+ 		ifNotNil: [:modifier | modifier value: ((UserInterfaceTheme current get: #color for: #ScrollPane)
+ 			ifNil: [ Color white ]) ].!

Item was added:
+ ----- Method: IndentingListItemMorph class>>initialize (in category 'class initialization') -----
+ initialize
+ 
+ 	FilterBackgroundColor := (Color gray: 0.85) alpha: 0.5.!

Item was added:
+ ----- Method: IndentingListItemMorph class>>themePriority (in category 'preferences') -----
+ themePriority
+ 
+ 	^ 65!

Item was added:
+ ----- Method: IndentingListItemMorph class>>themeProperties (in category 'preferences') -----
+ themeProperties
+ 
+ 	^ {
+ 		{ #backgroundFilterColor. 'Styling'. 'Background color for filter matches.' }.
+ 	}!

Item was changed:
  ----- Method: IndentingListItemMorph>>applyFilter: (in category 'filtering') -----
  applyFilter: filter
  
+ 	(self matches: filter in: complexContents)
+ 		ifTrue: [backgroundColor := FilterBackgroundColor. ^ true]
+ 		ifFalse: [self hideByFilter. ^ false].!
- 	self
- 		applyFilter: filter
- 		depthOffset: self indentLevel.!

Item was removed:
- ----- Method: IndentingListItemMorph>>applyFilter:depthOffset: (in category 'filtering') -----
- applyFilter: filter depthOffset: offset
- 
- 	| selfMatch childMatch |
- 	self isExpanded ifTrue: [self toggleExpandedState].
- 	
- 	selfMatch := self matches: filter.
- 	childMatch := self matchesAnyChild: filter depthOffset: offset.
- 	
- 	selfMatch | childMatch ifFalse: [^ self hide].
- 	
- 	selfMatch ifTrue: [
- 		self backgroundColor: ((Color gray: 0.85) alpha: 0.5)].
- 	childMatch ifTrue: [
- 		self toggleExpandedState.
- 		self childrenDo: [:child | child applyFilter: filter depthOffset: offset]].!

Item was added:
+ ----- Method: IndentingListItemMorph>>applyUserInterfaceTheme (in category 'updating') -----
+ applyUserInterfaceTheme
+ 
+ 	filterOffsets := nil.!

Item was changed:
  ----- Method: IndentingListItemMorph>>canExpand (in category 'testing') -----
  canExpand
  
+ 	^ canExpand ifNil: [canExpand := complexContents hasContents]!
- 	^complexContents hasContents!

Item was changed:
  ----- Method: IndentingListItemMorph>>children (in category 'accessing') -----
  children
+ 
+ 	^ Array streamContents: [:stream |
+ 		self childrenDo: [:each | stream add: each]]!
- 	| children |
- 	children := OrderedCollection new.
- 	self childrenDo: [:each | children add: each].
- 	^children!

Item was added:
+ ----- Method: IndentingListItemMorph>>drawFilterOn:in: (in category 'drawing') -----
+ drawFilterOn: aCanvas in: drawBounds
+ 	"Draw filter matches if any. Based on LazyListMorph >> #displayFilterOn:for:in:font:."
+ 	
+ 	| fillStyle fillHeight leading columnOffsets o cw |
+ 	filterOffsets ifEmpty: [^ self].
+ 	
+ 	fillHeight := font lineGridForMorphs.
+ 	fillStyle := container filterColor isColor
+ 		ifTrue: [SolidFillStyle color: container filterColor]
+ 		ifFalse: [container filterColor].
+ 	fillStyle isGradientFill ifTrue: [
+ 		fillStyle origin: drawBounds topLeft.
+ 		fillStyle direction: 0@ fillHeight].
+ 	
+ 	leading := font lineGapSliceForMorphs.
+ 	
+ 	columnOffsets := (container columns isNil or: [container columns size = 1])
+ 		ifTrue: [
+ 			o := drawBounds left.
+ 			icon ifNotNil: [o := o + icon width + 2 px].
+ 			{ o }]
+ 		ifFalse: [
+ 			 (0 to: container columns size - 1) collect: [ :column |
+ 				column = 0
+ 					ifTrue: [o := drawBounds left]
+ 					ifFalse: [
+ 						cw := self widthOfColumn: column.
+ 						column = 1
+ 							ifTrue: [ "Reduce width by indentation present in first column only"
+ 								cw := cw - (drawBounds left - self left) + self hMargin].
+ 						column + 1 = self class iconColumnIndex ifTrue: [
+ 							icon ifNotNil: [o := o + icon width + 2 px]].
+ 						o := o + cw + 5 px]] ].
+ 	
+ 	filterOffsets do: [:offset |
+ 		| highlightRectangle |
+ 		highlightRectangle := (((columnOffsets at: offset third) + offset first first) @ drawBounds top
+ 			corner: ((columnOffsets at: offset third) + offset first last) @ (drawBounds top + fillHeight)).
+ 		aCanvas
+ 			frameAndFillRoundRect: (highlightRectangle outsetBy: 1 at 0)
+ 			radius: 3 px
+ 			fillStyle: fillStyle
+ 			borderWidth: 1 px
+ 			borderColor: fillStyle asColor twiceDarker.
+ 		aCanvas
+ 			drawString: offset second
+ 			in: (highlightRectangle origin + (0 @ leading) corner: highlightRectangle corner)
+ 			font: font
+ 			color: container filterTextColor].!

Item was changed:
  ----- Method: IndentingListItemMorph>>drawLabelInColumnsOn:in: (in category 'drawing') -----
  drawLabelInColumnsOn: aCanvas in: drawBounds
  	"Draw the receiver appearing in multiple columns. Use TAB character to move between columns."
  		
+ 	| columnScanner columnLeft columnRect columnData updateFilter |
- 	| columnScanner columnLeft columnRect columnData |
  	self assert: [container columns size > 1].
+ 
  	columnScanner := ReadStream on: contents asString.
+ 	
+ 	"Update filter matches"
+ 	updateFilter := backgroundColor notNil and: [filterOffsets isNil].
+ 	filterOffsets ifNil: [filterOffsets := OrderedCollection new].
+ 
+ 	1 to: container columns size do: [ :column |
- 	container columns withIndexDo: [ :widthSpec :column |
  		| columnWidth |
  		"Compute first/next column offset."
  		column = 1
  			ifTrue: [columnLeft := drawBounds left]
  			ifFalse: [columnLeft := columnRect right + 5 px].
  		"Draw icon."
  		column = self class iconColumnIndex ifTrue: [
  			icon ifNotNil: [
  				aCanvas
  					translucentImage: icon
  					at: columnLeft @ (self top + (self height - icon height // 2)).
+ 				columnLeft := columnLeft + icon width + 2 px]].
- 				columnLeft := columnLeft + icon width + 2]].
  		"Compute drawing bounds for label portion."
  		columnWidth := self widthOfColumn: column.
  		column = 1 ifTrue: [ "Reduce width by indentation present in first column only"
  			columnWidth := columnWidth - (drawBounds left - self left) + self hMargin].
  		columnRect := columnLeft @ drawBounds top extent: columnWidth @ drawBounds height.
  		columnData := columnScanner upTo: Character tab.
  		"Draw label portion."
  		columnData ifNotEmpty: [
+ 			aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse.
+ 			updateFilter ifTrue: [
+ 				(column = 1 or: [PluggableTreeMorph filterByLabelsOnly not])
+ 					ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: column)]] ] ].
- 			aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse] ].
  
  	"Handle trailing TAB issue in string representation."
  	columnScanner upToEnd ifNotEmpty: [:rest |
  		columnRect := columnLeft + (self fontToUse widthOfString: columnData) @ drawBounds top extent: columnRect extent.
+ 		columnData := String tab, rest.
+ 		aCanvas drawString: columnData in: columnRect font: self fontToUse color: self colorToUse.
+ 		updateFilter ifTrue: [
+ 			"column > 1" PluggableTreeMorph filterByLabelsOnly not 
+ 				ifTrue: [filterOffsets addAll: (self getFilterOffsetsFor: columnData column: container columns size)]] ].!
- 		aCanvas drawString: String tab, rest in: columnRect font: self fontToUse color: self colorToUse].!

Item was changed:
  ----- Method: IndentingListItemMorph>>drawLabelOn:in: (in category 'drawing') -----
  drawLabelOn: aCanvas in: drawBounds
  	
  	| labelBounds |
  	icon
  		ifNil: [labelBounds := drawBounds]
  		ifNotNil: [
  			aCanvas
  				translucentImage: icon
  				at: drawBounds left @ (self top + (self height - icon height // 2)).
+ 			labelBounds := drawBounds left: drawBounds left + icon width + 2 px].
- 			labelBounds := drawBounds left: drawBounds left + icon width + 2].
  		
  	aCanvas
  		drawString: contents asString "i.e., the label"
  		in: labelBounds
  		font: self fontToUse
+ 		color: self colorToUse.
+ 		
+ 	"Update filter matches"
+ 	(backgroundColor notNil and: [filterOffsets isNil])
+ 		ifTrue: [filterOffsets := self getFilterOffsetsFor: contents asString].
+ 	filterOffsets ifNil: [filterOffsets := #()].
+ !
- 		color: self colorToUse.!

Item was changed:
  ----- Method: IndentingListItemMorph>>drawOn: (in category 'drawing') -----
  drawOn: aCanvas
  	
  	| tRect sRect |
  	self backgroundColor ifNotNil: [:c |
  		aCanvas fillRectangle: self innerBounds color: c].
  
  	tRect := self toggleRectangle.	
  	self drawToggleOn: aCanvas in: tRect.
  
  	sRect := bounds withLeft: tRect right + self hMargin.
  	sRect := sRect top: sRect top + sRect bottom - self fontToUse height // 2.	
  	
  	(container columns isNil or: [(contents asString indexOf: Character tab) = 0])
  		ifTrue: [self drawLabelOn: aCanvas in: sRect]
+ 		ifFalse: [self drawLabelInColumnsOn: aCanvas in: sRect].
+ 		
+ 	self drawFilterOn: aCanvas in: (bounds withLeft: tRect right + self hMargin).!
- 		ifFalse: [self drawLabelInColumnsOn: aCanvas in: sRect].!

Item was added:
+ ----- Method: IndentingListItemMorph>>expandFiltered (in category 'container protocol') -----
+ expandFiltered
+ 
+ 	| filter any |
+ 	self expand.
+ 	
+ 	filter := container filterTerm.
+ 	any := false.
+ 	self childrenDo: [:each | (each applyFilter: filter) ifTrue: [any := true]].
+ 	any ifFalse: [self childrenDo: [:each | each removeFilter]].!

Item was added:
+ ----- Method: IndentingListItemMorph>>getFilterOffsetsFor: (in category 'filtering') -----
+ getFilterOffsetsFor: item
+ 
+ 	^ self getFilterOffsetsFor: item column: 1!

Item was added:
+ ----- Method: IndentingListItemMorph>>getFilterOffsetsFor:column: (in category 'filtering') -----
+ getFilterOffsetsFor: item column: column
+ 	"Calculate matching character indexes for the current filter term."
+ 	
+ 	| filter offsets currentIndex sub |
+ 	filter := container filterTerm.
+ 	filter ifEmpty: [^ Array empty].
+ 
+ 	offsets := OrderedCollection new.
+ 	
+ 	currentIndex := 1.
+ 	[currentIndex > 0] whileTrue: [
+ 		currentIndex := item findString: filter startingAt: currentIndex caseSensitive: false.
+ 		currentIndex > 0 ifTrue: [ | left width |
+ 			left := font widthOfString: item from: 1 to: currentIndex-1.
+ 			sub := item copyFrom: currentIndex to: currentIndex + filter size - 1.
+ 			width := font widthOfString: sub.
+ 			offsets addLast: {(left to: left + width). sub. column}.
+ 			currentIndex := currentIndex + 1] ].
+ 	^ offsets!

Item was added:
+ ----- Method: IndentingListItemMorph>>hideByFilter (in category 'filtering') -----
+ hideByFilter
+ 
+ 	self extension visible: false.
+ 	backgroundColor := nil.
+ 	self childrenDo: [:ea | ea hideByFilter].!

Item was added:
+ ----- Method: IndentingListItemMorph>>isFilterMatch (in category 'testing') -----
+ isFilterMatch
+ 
+ 	^ self visible and: [self backgroundColor notNil]!

Item was added:
+ ----- Method: IndentingListItemMorph>>lastChild (in category 'accessing') -----
+ lastChild
+ 
+ 	| item |
+ 	self childrenDo: [:child | item := child].
+ 	^ item!

Item was added:
+ ----- Method: IndentingListItemMorph>>lastVisibleChild (in category 'accessing') -----
+ lastVisibleChild
+ 
+ 	| item |
+ 	self childrenDo: [:child | child visible ifTrue: [item := child]].
+ 	^ item!

Item was removed:
- ----- Method: IndentingListItemMorph>>matches: (in category 'filtering') -----
- matches: pattern
- 
- 	^ self matches: pattern in: complexContents!

Item was changed:
  ----- Method: IndentingListItemMorph>>matches:in: (in category 'filtering') -----
+ matches: pattern in: wrapper 
- matches: pattern in: model 
  	^ ((PluggableTreeMorph filterByLabelsOnly
+ 		ifTrue: [ wrapper itemName ]
+ 		ifFalse: [ contents ])
- 		ifTrue: [ model itemName ]
- 		ifFalse: [ self getLabelFor: model ])
  			findString: pattern
  			startingAt: 1
  			caseSensitive: false) > 0!

Item was removed:
- ----- Method: IndentingListItemMorph>>matchesAnyChild:depthOffset: (in category 'filtering') -----
- matchesAnyChild: pattern depthOffset: offset
- 
- 	| maxDepth next current |
- 	maxDepth := PluggableTreeMorph maximumSearchDepth - self indentLevel + offset.
- 	maxDepth <= 0 ifTrue: [^ false].
- 	
- 	next := (self getChildren collect: [:obj | 1 -> obj]) asOrderedCollection.
- 	[next notEmpty] whileTrue: [
- 		current := next removeFirst.
- 		
- 		(self matches: pattern in: current value)
- 			ifTrue: [^ true].
- 		
- 		current key < maxDepth ifTrue: [
- 			next addAll: ((self getChildrenFor: current value) collect: [:obj | (current key + 1) -> obj])].
- 		].
- 	
- 	^ false!

Item was added:
+ ----- Method: IndentingListItemMorph>>removeFilter (in category 'filtering') -----
+ removeFilter
+ 
+ 	self extension visible: true.
+ 
+ 	backgroundColor := nil.
+ 	filterOffsets := nil.!

Item was changed:
  ----- Method: IndentingListItemMorph>>toggleRectangle (in category 'private') -----
  toggleRectangle
  
  	| h indent |
  	h := bounds height.
+ 	indent := 12 px.
- 	indent := (12 * RealEstateAgent scaleFactor) rounded.
  	^(bounds left + self hMargin + (indent * indentLevel)) @ bounds top extent: indent at h!

Item was changed:
  ----- Method: IndentingListItemMorph>>update: (in category 'updating') -----
  update: aspect
  	"See ListItemWrapper and subclasses for possible change aspects."
  	
  	aspect = #contents ifTrue: [
+ 		canExpand := nil.
  		self isExpanded ifTrue: [self toggleExpandedState].
  		self canExpand ifTrue: [self toggleExpandedState].
  		container adjustSubmorphPositions].
  		
  	super update: aspect.!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph class>>wrappedNavigation (in category 'preferences') -----
  wrappedNavigation
  	<preference: 'Wrapped Tree Navigation'
  		category: 'Morphic'
  		description: 'When enabled, use of the arrow keys at the top or bottom of a hierarchical list will wrap to the opposite side of the list.'
  		type: #Boolean>
+ 	^ WrappedNavigation ifNil: [ true ]!
- 	^ WrappedNavigation ifNil: [ false ]!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>arrowKey: (in category 'keyboard navigation') -----
  arrowKey: asciiValue
  	"Handle a keyboard navigation character. Answer true if handled, false if not."
+ 	| keyEvent min max oldSelection nextSelection howManyItemsShowing keyHandled |
- 	| keyEvent max oldSelection nextSelection howManyItemsShowing keyHandled |
  	keyHandled := false.
  	keyEvent := asciiValue.
  	max := self maximumSelection.
+ 	min := self minimumSelection.
  	nextSelection := oldSelection := self getSelectionIndex.
       keyEvent = 31 ifTrue:["down"
  		self currentEvent shiftPressed ifTrue: [
  			self selectedMorph nextVisibleSibling
+ 				ifNil: ["TODO: wrappedNavigation" ^ true]
- 				ifNil: [^ true]
  				ifNotNil: [:m | self setSelectedMorph: m. ^ true]].
  		keyHandled := true.
  		nextSelection :=oldSelection + 1.
+ 		nextSelection > max ifTrue: [nextSelection := (self class wrappedNavigation ifTrue: [min] ifFalse: [^ true])]].
- 		nextSelection > max ifTrue: [nextSelection := (self class wrappedNavigation ifTrue: [1] ifFalse: [^ true])]].
       keyEvent = 30 ifTrue:["up"
  		self currentEvent shiftPressed ifTrue: [
  			self selectedMorph previousVisibleSibling
+ 				ifNil: ["TODO: wrappedNaviagtion" ^ true]
- 				ifNil: [^ true]
  				ifNotNil: [:m | self setSelectedMorph: m. ^ true]].
  		keyHandled := true.
  		nextSelection := oldSelection - 1.
+ 		nextSelection < min ifTrue: [nextSelection := self class wrappedNavigation ifTrue: [max] ifFalse: [^ true]]].
- 		nextSelection < 1 ifTrue: [nextSelection := self class wrappedNavigation ifTrue: [max] ifFalse: [^ true]]].
       keyEvent = 1  ifTrue: ["home"
  		keyHandled := true.
+ 		nextSelection := min].
- 		nextSelection := 1].
       keyEvent = 4  ifTrue: ["end"
  		keyHandled := true.
  		nextSelection := max].
  	howManyItemsShowing := self numSelectionsInView.
        keyEvent = 11 ifTrue: ["page up"
  		keyHandled := true.
+ 		nextSelection := min max: oldSelection - howManyItemsShowing].
- 		nextSelection := 1 max: oldSelection - howManyItemsShowing].
       keyEvent = 12  ifTrue: ["page down"
  		keyHandled := true.
  		nextSelection := oldSelection + howManyItemsShowing min: max].
  
  	(nextSelection ~= oldSelection or: [ keyHandled and: [ self class wrappedNavigation not ]]) ifTrue: [
  		self setSelectionIndex: nextSelection.
  		^ true].
  	
  	keyEvent = 29 ifTrue:["right"
  		selectedMorph ifNotNil:[
  			(selectedMorph canExpand and:[selectedMorph isExpanded not])
  				ifTrue:[self toggleExpandedState: selectedMorph]
  				ifFalse:[self setSelectionIndex: self getSelectionIndex+1].
  		].
  		^true].
  	keyEvent = 28 ifTrue:["left"
  		selectedMorph ifNotNil:[
  			(selectedMorph isExpanded)
  				ifTrue:[self toggleExpandedState: selectedMorph]
  				ifFalse:[
  					self selectedParentMorph
  						ifNil: [self setSelectionIndex: (self getSelectionIndex-1 max: 1)]
  						ifNotNil: [:pm | self setSelectedMorph: pm]]
  		].
  		^true].
  	^false!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>maximumSelection (in category 'selection') -----
  maximumSelection
  
+ 	scroller submorphs size to: 1 by: -1 do: [:index |
+ 		(scroller submorphs at: index) visible ifTrue: [^ index]].
+ 	^ 1!
- 	^ scroller submorphs size
- !

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>minimumSelection (in category 'selection') -----
  minimumSelection
+ 
+ 	1 to: scroller submorphs size do: [:index |
+ 		(scroller submorphs at: index) visible ifTrue: [^ index]].
  	^ 1!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>scrollSelectionAndChildrenIntoView (in category 'selection') -----
+ scrollSelectionAndChildrenIntoView
+ 	"Make sure to show the current selection and as many children as possible."
+ 	
+ 	self selectedMorph
+ 		ifNil: [self scrollToTop]
+ 		ifNotNil: [:m |
+ 			m isExpanded ifTrue: [self scrollToShow: m lastVisibleChild bounds].
+ 			self scrollSelectionIntoView].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>scrollSelectionAndExtraIntoView (in category 'selection') -----
+ scrollSelectionAndExtraIntoView
+ 	"Make sure to show the current selection and some of the previous and next items."
+ 	
+ 	| numExtraItemsToShow |
+ 	numExtraItemsToShow := 2.
+ 	self selectedMorph
+ 		ifNil: [self scrollToTop]
+ 		ifNotNil: [:m |
+ 			self scrollToShow: (m bounds outsetBy: (0@ (m height * numExtraItemsToShow))).
+ 			self scrollSelectionIntoView].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>scrollSelectionIntoView (in category 'selection') -----
+ scrollSelectionIntoView
+ 
+ 	self selectedMorph
+ 		ifNil: [self scrollToTop]
+ 		ifNotNil: [:m | self scrollToShow: m bounds].!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>scrollSelectionParentIntoView (in category 'selection') -----
+ scrollSelectionParentIntoView
+ 	"Try to make current selection's parent visible. Yet, ensure that the selection stays visible."
+ 	
+ 	self scrollSelectionParentIntoView: self selectedParentMorph.!

Item was added:
+ ----- Method: SimpleHierarchicalListMorph>>scrollSelectionParentIntoView: (in category 'selection') -----
+ scrollSelectionParentIntoView: parentOrNil
+ 	"Try to make current selection's parent visible. Yet, ensure that the selection stays visible."
+ 	
+ 	parentOrNil ifNotNil: [:pm | self scrollToShow: pm bounds].
+ 	self scrollSelectionIntoView.!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>selectedMorph: (in category 'selection') -----
  selectedMorph: aMorph
  
  	self unhighlightSelection.
  	selectedMorph := aMorph.
+ 	self highlightSelection.
+ 	
+ 	self scrollSelectionIntoView.!
- 	self highlightSelection!

Item was changed:
  ----- Method: SimpleHierarchicalListMorph>>selectionIndex: (in category 'selection') -----
  selectionIndex: idx
  	"Called internally to select the index-th item."
+ 
+ 	| index |
- 	| theMorph index |
  	idx ifNil: [^ self].
  	index := idx min: scroller submorphs size max: 0.
+ 	self selectedMorph: (index = 0 ifFalse: [scroller submorphs at: index]).!
- 	(theMorph := index = 0 ifTrue: [nil] ifFalse: [scroller submorphs at: index])
- 		ifNotNil: [self scrollToShow: theMorph bounds].
- 	self selectedMorph: theMorph!



More information about the Squeak-dev mailing list