Packages February 2023

packages@lists.squeakfoundation.org

1 participants
79 discussions

The Trunk: Graphics-nice.540.mcz
by commits＠source.squeak.org 27 Feb '23

27 Feb '23

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.540.mcz ==================== Summary ==================== Name: Graphics-nice.540 Author: nice Time: 27 February 2023, 11:08:20.503071 pm UUID: 3ed34a8a-0e5a-9044-a70b-de82186f7a48 Ancestors: Graphics-nice.539 Fix load of interlaced PNG again : we must use rule 31 (Form paintAlpha) which does the right thing: - use destinationPixel when sourcePixel is zero - else use sourcePixel This is because the default constant sourceAlpha used for blending is 255, and rule 31 perform this pseudo code for each A,R,G,B channel: (sourceChannel * sourceAlpha) + (destinationChannel * (255 - sourceAlpha)) / 255 which is = sourceChannel. =============== Diff against Graphics-nice.539 =============== Item was changed: ----- Method: PNGReadWriter>>copyPixelsRGB:at:by: (in category 'pixel copies') ----- copyPixelsRGB: y at: startX by: incX "Handle interlaced RGB color mode (colorType = 2)" | i pixel tempForm tempBits xx loopsToDo | tempForm := Form extent: width@1 depth: 32. tempBits := tempForm bits. pixel := LargePositiveInteger new: 4. pixel at: 4 put: 16rFF. loopsToDo := width - startX + incX - 1 // incX. bitsPerChannel = 8 ifTrue: [i := (startX // incX * 3) + 1. xx := startX+1. 1 to: loopsToDo do: [ :j | pixel at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+1); at: 1 put: (thisScanline at: i+2). tempBits at: xx put: pixel normalize. i := i + 3. xx := xx + incX]. transparentPixelValue ifNotNil: [startX to: width-1 by: incX do: [ :x | (tempBits at: x+1) = transparentPixelValue ifTrue: [ tempBits at: x+1 put: 0]]]] ifFalse: [i := (startX // incX * 6) + 1. xx := startX+1. 1 to: loopsToDo do: [ :j | (transparentPixelValue == nil or: [(1 to: 6) anySatisfy: [:k | (transparentPixelValue digitAt: k) ~= (thisScanline at: i + 6 - k)]]) ifTrue: [pixel at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+2); at: 1 put: (thisScanline at: i+4). tempBits at: xx put: pixel normalize.] ifFalse: [tempBits at: xx put: 0]. i := i + 6. xx := xx + incX]]. + tempForm displayOn: form at: 0@y rule: Form paintAlpha - tempForm displayOn: form at: 0@y rule: Form blendAlphaUnscaled ! Item was changed: ----- Method: PNGReadWriter>>copyPixelsRGBA:at:by: (in category 'pixel copies') ----- copyPixelsRGBA: y at: startX by: incX "Handle interlaced RGBA color modes (colorType = 6)" | i pixel tempForm tempBits | tempForm := Form extent: width@1 depth: 32. tempBits := tempForm bits. pixel := LargePositiveInteger new: 4. bitsPerChannel = 8 ifTrue: [ i := (startX // incX << 2) + 1. startX to: width-1 by: incX do: [ :x | pixel at: 4 put: (thisScanline at: i+3); at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+1); at: 1 put: (thisScanline at: i+2). tempBits at: x+1 put: pixel normalize. i := i + 4. ] ] ifFalse: [ i := (startX // incX << 3) +1. startX to: width-1 by: incX do: [ :x | pixel at: 4 put: (thisScanline at: i+6); at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+2); at: 1 put: (thisScanline at: i+4). tempBits at: x+1 put: pixel normalize. i := i + 8. ]. ]. + tempForm displayOn: form at: 0@y rule: Form paintAlpha. - tempForm displayOn: form at: 0@y rule: Form blendAlphaScaled. !

1 0

The Trunk: GraphicsTests-nice.62.mcz
by commits＠source.squeak.org 27 Feb '23

27 Feb '23

Nicolas Cellier uploaded a new version of GraphicsTests to project The Trunk: http://source.squeak.org/trunk/GraphicsTests-nice.62.mcz ==================== Summary ==================== Name: GraphicsTests-nice.62 Author: nice Time: 27 February 2023, 5:05:11.232119 pm UUID: 1490c410-0f9a-a749-a2e2-d8b5539d582f Ancestors: GraphicsTests-mt.60 Fix testAllAlphasRgbMul The BitBlt primitive for rgbMul rule has been fixed so as to round to nearest paint. The test must reflect this. =============== Diff against GraphicsTests-mt.60 =============== Item was changed: ----- Method: BitBltTest>>testAllAlphasRgbMul (in category 'tests') ----- testAllAlphasRgbMul "self run: #testAllAlphasRgbMul" | sourceForm destForm blt correctAlphas | <timeout: 10> correctAlphas := 0. 0 to: 255 do: [:sourceAlpha | sourceForm := Form extent: 1 @ 1 depth: 32. sourceForm bits at: 1 put: sourceAlpha << 24 + (33 << 16) + (25 << 8) + 27. 0 to: 255 do: [:destAlpha | destForm := Form extent: 1 @ 1 depth: 32. destForm bits at: 1 put: destAlpha << 24 + (255 << 16) + (255 << 8) + 255. blt := BitBlt new. blt sourceForm: sourceForm. blt sourceOrigin: 0 @ 0. blt setDestForm: destForm. blt destOrigin: 0 @ 0. blt combinationRule: 37. "rgbMul" blt copyBits. correctAlphas := correctAlphas + + (((blt destForm bits at: 1) digitAt: 4) = (((destAlpha) * (sourceAlpha) / 255) rounded) - + (((blt destForm bits at: 1) digitAt: 4) = ((destAlpha+1) * (sourceAlpha+1)- 1 // 256) ifTrue: [1] ifFalse: [0]) ]]. self assert: 65536 equals: correctAlphas!

1 0

The Trunk: Graphics-nice.539.mcz
by commits＠source.squeak.org 27 Feb '23

27 Feb '23

Nicolas Cellier uploaded a new version of Graphics to project The Trunk: http://source.squeak.org/trunk/Graphics-nice.539.mcz ==================== Summary ==================== Name: Graphics-nice.539 Author: nice Time: 27 February 2023, 4:07:26.40556 pm UUID: 5cf207ee-4818-a040-8f22-7f5dff8773d2 Ancestors: Graphics-mt.538 Fix loading of interlaced PNG images with color and alpha Form over was used in https://source.squeak.org/trunk/Graphics-nice.292.diff so as to correctly handle (cheap) transparency in RGB images. Unfortunately, this cannot work with interlaced images, because we overwrite parts of the image that were already downloaded in previous chunks. Concerning interlaced RGBA images, the bug was different and dating from origins (at least from 2004). The rule Form paintAlpha does not use the alpha channel of the image, but rather a constant alpha channel. We replace these erroneous BitBlt rules with Form blendAlphaScaled. =============== Diff against Graphics-mt.538 =============== Item was changed: ----- Method: PNGReadWriter>>copyPixelsRGB:at:by: (in category 'pixel copies') ----- copyPixelsRGB: y at: startX by: incX "Handle interlaced RGB color mode (colorType = 2)" | i pixel tempForm tempBits xx loopsToDo | tempForm := Form extent: width@1 depth: 32. tempBits := tempForm bits. pixel := LargePositiveInteger new: 4. pixel at: 4 put: 16rFF. loopsToDo := width - startX + incX - 1 // incX. bitsPerChannel = 8 ifTrue: [i := (startX // incX * 3) + 1. xx := startX+1. 1 to: loopsToDo do: [ :j | pixel at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+1); at: 1 put: (thisScanline at: i+2). tempBits at: xx put: pixel normalize. i := i + 3. xx := xx + incX]. transparentPixelValue ifNotNil: [startX to: width-1 by: incX do: [ :x | (tempBits at: x+1) = transparentPixelValue ifTrue: [ tempBits at: x+1 put: 0]]]] ifFalse: [i := (startX // incX * 6) + 1. xx := startX+1. 1 to: loopsToDo do: [ :j | (transparentPixelValue == nil or: [(1 to: 6) anySatisfy: [:k | (transparentPixelValue digitAt: k) ~= (thisScanline at: i + 6 - k)]]) ifTrue: [pixel at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+2); at: 1 put: (thisScanline at: i+4). tempBits at: xx put: pixel normalize.] ifFalse: [tempBits at: xx put: 0]. i := i + 6. xx := xx + incX]]. + tempForm displayOn: form at: 0@y rule: Form blendAlphaUnscaled - tempForm displayOn: form at: 0@y rule: Form over. ! Item was changed: ----- Method: PNGReadWriter>>copyPixelsRGBA:at:by: (in category 'pixel copies') ----- copyPixelsRGBA: y at: startX by: incX "Handle interlaced RGBA color modes (colorType = 6)" | i pixel tempForm tempBits | tempForm := Form extent: width@1 depth: 32. tempBits := tempForm bits. pixel := LargePositiveInteger new: 4. bitsPerChannel = 8 ifTrue: [ i := (startX // incX << 2) + 1. startX to: width-1 by: incX do: [ :x | pixel at: 4 put: (thisScanline at: i+3); at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+1); at: 1 put: (thisScanline at: i+2). tempBits at: x+1 put: pixel normalize. i := i + 4. ] ] ifFalse: [ i := (startX // incX << 3) +1. startX to: width-1 by: incX do: [ :x | pixel at: 4 put: (thisScanline at: i+6); at: 3 put: (thisScanline at: i); at: 2 put: (thisScanline at: i+2); at: 1 put: (thisScanline at: i+4). tempBits at: x+1 put: pixel normalize. i := i + 8. ]. ]. + tempForm displayOn: form at: 0@y rule: Form blendAlphaScaled. - tempForm displayOn: form at: 0@y rule: Form paintAlpha. !

1 0

The Trunk: Tools-mt.1191.mcz
by commits＠source.squeak.org 27 Feb '23

27 Feb '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1191.mcz ==================== Summary ==================== Name: Tools-mt.1191 Author: mt Time: 27 February 2023, 3:34:31.568644 pm UUID: b6ead586-b005-7143-ac17-513acd0404a4 Ancestors: Tools-mt.1190 Fixes shortcut inconsistency in single-category browsers. Now it matches the popup menu again. =============== Diff against Tools-mt.1190 =============== Item was changed: ----- Method: Browser>>systemCatSingletonKey:from: (in category 'initialize-release') ----- systemCatSingletonKey: aChar from: aView + ^ self systemCatListKey: aChar from: aView! - ^ self messageListKey: aChar from: aView! Item was removed: - ----- Method: HierarchyBrowser>>systemCatSingletonKey:from: (in category 'menu messages') ----- - systemCatSingletonKey: aChar from: aView - "This appears to be obsolete now that the hierarchybrowser has not category view" - ^ self systemCatListKey: aChar from: aView!

1 0

The Treated Inbox: fromCamelCaseBugFix-rpb.2.mcz
by commits＠source.squeak.org 24 Feb '23

24 Feb '23

Marcel Taeumel uploaded a new version of fromCamelCaseBugFix to project The Treated Inbox: http://source.squeak.org/treated/fromCamelCaseBugFix-rpb.2.mcz ==================== Summary ==================== Name: fromCamelCaseBugFix-rpb.2 Author: rpb Time: 23 February 2023, 5:30:54.911688 pm UUID: d2c3cefb-be54-457d-bb50-9e522c3de213 Ancestors: fromCamelCaseBugFix-rpb.1 This code fixes a bug in fromCameCase. The old code would do: 'AnExampleString' fromCamelCase -> ' anExampleString'. The leading space should not be there. The problem occurs when the leading character is capitalized. ==================== Snapshot ==================== SystemOrganization addCategory: #fromCamelCaseBugFix! ----- Method: SequenceableCollection>>asSpaceInterleavedString (in category '*fromCamelCaseBugFix') ----- asSpaceInterleavedString "Convert to a string with a space between items. Assumes Elements are strings." | stream | stream := WriteStream on: (String new: 100). self do: [:each | stream nextPutAll: each; space]. self size > 0 ifTrue: [stream skip: -1]. "remove trailing space" ^stream contents.! ----- Method: String>>fromCamelCase (in category '*fromCamelCaseBugFix') ----- fromCamelCase "convert 'anExampleString' to 'an example string'" ^self findFeatures asSpaceInterleavedString! ----- Method: String>>fromCamelCaseBugFixComment (in category '*fromCamelCaseBugFix') ----- fromCamelCaseBugFixComment " The new code fixes a bug in fromCameCase. The old code would do: 'AnExampleString' fromCamelCase -> ' anExampleString'. The leading space should not be there. The problem occurs when the leading character is capitalized. "!

1 0

The Trunk: EToys-mt.493.mcz
by commits＠source.squeak.org 24 Feb '23

24 Feb '23

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.493.mcz ==================== Summary ==================== Name: EToys-mt.493 Author: mt Time: 24 February 2023, 10:57:32.196067 am UUID: 026f5e7f-48a8-df46-9d7f-dd63f4acf991 Ancestors: EToys-mt.492 Merges a fix from Ralph (rpb): "This code fixes a bug in fromCameCase. The old code would do: 'AnExampleString' fromCamelCase -> ' anExampleString'. The leading space should not be there. The problem occurs when the leading character is capitalized." =============== Diff against EToys-mt.492 =============== Item was changed: ----- Method: String>>fromCamelCase (in category '*Etoys-Squeakland-converting') ----- fromCamelCase "convert 'anExampleString' to 'an example string'" + ^self findFeatures joinSeparatedBy: String space! - | upper nextWord start | - upper := ($A to: $Z) asCharacterSet. - nextWord := self indexOfAnyOf: upper. - nextWord = 0 ifTrue: [^self]. - start := 1. - - ^String streamContents: [:strm | - [ - strm nextPutAll: (self copyFrom: start to: nextWord-1). - strm space; nextPut: (self at: nextWord) asLowercase. - start := nextWord+1. - nextWord := self indexOfAnyOf: upper startingAt: start. - nextWord = 0 - ] whileFalse. - strm nextPutAll: (self copyFrom: start to: self size). - ].!

1 0

The Trunk: Morphic-mt.2093.mcz
by commits＠source.squeak.org 23 Feb '23

23 Feb '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2093.mcz ==================== Summary ==================== Name: Morphic-mt.2093 Author: mt Time: 23 February 2023, 3:22:39.829976 pm UUID: 16263c0a-3cc5-cb4c-8cf3-53eda4c76b4e Ancestors: Morphic-mt.2092 Tree widgets: when collapsing a node via mouse-click, do not select that parent unless there was actually a prior selection (in that collapsed sub-tree). =============== Diff against Morphic-mt.2092 =============== Item was changed: ----- Method: SimpleHierarchicalListMorph>>mouseDown: (in category 'event handling') ----- mouseDown: evt | aMorph selectors | aMorph := self itemFromPoint: evt position. evt yellowButtonPressed "First check for option (menu) click" ifTrue: [ (PluggableListMorph menuRequestUpdatesSelection and: [model okToChange]) ifTrue: [ aMorph == selectedMorph ifFalse: [self setSelectedMorph: aMorph]]. ^ self yellowButtonActivity: evt shiftPressed]. aMorph ifNil: [^ super mouseDown: evt]. (aMorph notNil and:[aMorph inToggleArea: (aMorph point: evt position from: self)]) + ifTrue: [ | priorSelection | + priorSelection := self selectedMorph. - ifTrue: [ self toggleExpandedState: aMorph event: evt. + (priorSelection notNil and: [self selectedMorph isNil]) ifTrue: [ - self selectedMorph ifNil: [ self setProperty: #changeSelectionOnMouseUp toValue: true. self setProperty: #selectedMorph toValue: aMorph]. ^ self]. PluggableListMorph highlightPreSelection ifTrue: [ aMorph highlightedForMouseDown: true. self setProperty: #highlightedMorph toValue: aMorph]. self setProperty: #changeSelectionOnMouseUp toValue: true. selectors := Array with: #click: with: (self doubleClickEnabled ifTrue: [#doubleClick:] ifFalse: [nil]) with: nil with: (self dragEnabled ifTrue:[#startDrag:] ifFalse:[nil]). evt hand waitForClicksOrDrag: self event: evt selectors: selectors threshold: HandMorph dragThreshold "pixels".!

1 0

The Trunk: ToolBuilder-Kernel-mt.163.mcz
by commits＠source.squeak.org 23 Feb '23

23 Feb '23

Marcel Taeumel uploaded a new version of ToolBuilder-Kernel to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Kernel-mt.163.mcz ==================== Summary ==================== Name: ToolBuilder-Kernel-mt.163 Author: mt Time: 23 February 2023, 3:14:21.577976 pm UUID: 8ef4f45f-fbff-bb4e-80fd-33c453125c0d Ancestors: ToolBuilder-Kernel-mt.162 Complements ToolBuilder-Morphic-mt.335 =============== Diff against ToolBuilder-Kernel-mt.162 =============== Item was changed: PluggableWidgetSpec subclass: #PluggableTreeSpec + instanceVariableNames: 'roots getSelectedPath setSelectedPath setSelected getSelected setSelectedParent getChildren hasChildren label icon unusedVar menu keyPress doubleClick dropItem dropAccept autoDeselect dragItem dragType nodeClass columns vScrollBarPolicy hScrollBarPolicy dragStarted filterMode searchMode' - instanceVariableNames: 'roots getSelectedPath setSelectedPath setSelected getSelected setSelectedParent getChildren hasChildren label icon unusedVar menu keyPress doubleClick dropItem dropAccept autoDeselect dragItem dragType nodeClass columns vScrollBarPolicy hScrollBarPolicy dragStarted' classVariableNames: '' poolDictionaries: '' category: 'ToolBuilder-Kernel'! !PluggableTreeSpec commentStamp: 'pre 4/24/2018 10:20' prior: 0! A pluggable tree widget. PluggableTrees are slightly different from lists in such that they ALWAYS store the actual objects and use the label selector to query for the label of the item. PluggableTrees also behave somewhat differently in such that they do not have a "getSelected" message but only a getSelectedPath message. The difference is that getSelectedPath is used to indicate by the model that the tree should select the appropriate path. This allows disambiguation of items. Because of this, implementations of PluggableTrees must always set their internal selection directly, e.g., rather than sending the model a setSelected message and wait for an update of the #getSelected the implementation must set the selection before sending the #setSelected message. If a client doesn't want this, it can always just signal a change of getSelectedPath to revert to whatever is needed. Instance variables: roots <Symbol> The message to retrieve the roots of the tree. getSelectedPath <Symbol> The message to retrieve the selected path in the tree. setSelectedPath <Symbol> The message to set the selected path in the tree. setSelected <Symbol> The message to set the selected item in the tree. getChildren <Symbol> The message to retrieve the children of an item hasChildren <Symbol> The message to query for children of an item label <Symbol> The message to query for the label of an item. icon <Symbol> The message to query for the icon of an item. help <Symbol> The message to query for the help of an item. menu <Symbol> The message to query for the tree's menu keyPress <Symbol> The message to process a keystroke. wantsDrop <Symbol> The message to query whether a drop might be accepted. dropItem <Symbol> The message to drop an item. enableDrag <Boolean> Enable dragging from this tree. autoDeselect <Boolean> Whether the tree should allow automatic deselection or not. unusedVar (unused) This variable is a placeholder to fix problems with loading packages in 3.10.! Item was added: + ----- Method: PluggableTreeSpec>>filterMode (in category 'accessing') ----- + filterMode + + ^ filterMode ifNil: [#siblings]! Item was added: + ----- Method: PluggableTreeSpec>>filterMode: (in category 'accessing') ----- + filterMode: aSymbol + "#siblings (default), #visible, #all" + + filterMode := aSymbol.! Item was added: + ----- Method: PluggableTreeSpec>>searchMode (in category 'accessing') ----- + searchMode + + ^ searchMode ifNil: [#breadthFirst]! Item was added: + ----- Method: PluggableTreeSpec>>searchMode: (in category 'accessing') ----- + searchMode: aSymbol + "#breadthFirst (default), #depthFirst" + + searchMode := aSymbol.!

1 0

The Trunk: Morphic-mt.2092.mcz
by commits＠source.squeak.org 23 Feb '23

23 Feb '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2092.mcz ==================== Summary ==================== Name: Morphic-mt.2092 Author: mt Time: 23 February 2023, 3:13:48.782976 pm UUID: b22a193c-cb4d-ef4f-b189-f1ce12cbf7dd Ancestors: Morphic-mt.2091 Complements ToolBuilder-Morphic-mt.335. Increase default type-in filter delay to 1500 milliseconds to account for slow typers by default. Fast typers can hit [backspace] any time for faster reset. =============== Diff against Morphic-mt.2091 =============== Item was added: + ----- Method: IndentingListItemMorph>>applyRecursiveFilter:allowExpand: (in category 'filtering') ----- + applyRecursiveFilter: filter allowExpand: allowExpand + + | selfMatch childMatch | + selfMatch := container matchesPattern: filter contents: contents. + + childMatch := false. + (self isExpanded not and: [allowExpand]) + ifTrue: [self expand]. + self childrenDo: [:child | + (child applyRecursiveFilter: filter allowExpand: allowExpand) ifTrue: [childMatch := true]]. + + selfMatch ifTrue: [ + backgroundColor := FilterBackgroundColor. + childMatch ifFalse: [ + allowExpand + ifTrue: [ + "User is able to expand node again." + self collapse] + ifFalse: [ + "Show at least some context for non-matching children." + self childrenDo: [:child | child extension visible: true] ]]]. + + ^ selfMatch | childMatch + ifTrue: [true] + ifFalse: [self extension visible: false. false]! Item was added: + ----- Method: IndentingListItemMorph>>applyRecursiveFilter:column:allowExpand: (in category 'filtering') ----- + applyRecursiveFilter: filter column: index allowExpand: allowExpand + + | selfMatch childMatch | + index ifNil: [^ self applyRecursiveFilter: filter allowExpand: allowExpand]. + + selfMatch := container matchesPattern: filter contents: contents column: index. + + childMatch := false. + (self isExpanded not and: [allowExpand]) + ifTrue: [self expand]. + self childrenDo: [:child | + (child applyRecursiveFilter: filter column: index allowExpand: allowExpand) + ifTrue: [childMatch := true]]. + + selfMatch ifTrue: [ + backgroundColor := FilterBackgroundColor. + childMatch ifFalse: [ + allowExpand + ifTrue: [self collapse "User is able to expand node again."] + ifFalse: [self childrenDo: [:child | child extension visible: true] ]]]. + + ^ selfMatch | childMatch + ifTrue: [true] + ifFalse: [self extension visible: false. false]! Item was added: + ----- Method: IndentingListItemMorph>>firstChild: (in category 'accessing') ----- + firstChild: aMorph + + firstChild := aMorph.! Item was changed: ----- Method: IndentingListItemMorph>>initializeFromText: (in category 'initialization') ----- initializeFromText: aText "Overridden to keep track of text-based attributes." | priorFont priorEmphasis priorColor | priorFont := self font. priorEmphasis := self emphasis. priorColor := self color. super initializeFromText: aText. self setProperty: #hasFontFromText toValue: priorFont ~~ self font. + self setProperty: #hasEmphasisFromText toValue: priorEmphasis ~~ self emphasis. - self setProperty: #hasEmphasisFromText toValue: priorFont ~~ self emphasis. self setProperty: #hasColorFromText toValue: priorColor ~~ self color.! Item was changed: ----- Method: PluggableListMorph class>>clearFilterDelay (in category 'preferences') ----- clearFilterDelay <preference: 'Filterable Lists Clear Delay' category: 'scrolling' description: 'Defines the maximum delay (in milliseconds) between keystrokes before the filter expression is cleared again.' type: #Number> + ^ ClearFilterDelay ifNil: [1500]! - ^ ClearFilterDelay ifNil: [500]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>collapseAll (in category 'events') ----- + collapseAll + "Do not use #collapse for each child to avoid intermediate layout updates." + + | orphans | + orphans := OrderedCollection new. + self roots do: [:ea | + ea isExpanded: false. + ea firstChild ifNotNil: [:child | child withSiblingsDo: [:node | node recursiveAddTo: orphans]]. + ea firstChild: nil]. + self noteRemovalOfAll: orphans. + + self adjustSubmorphPositions.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandAll (in category 'events') ----- expandAll + + selectedMorph ifNil: [^ self]. - (selectedMorph isNil - or: [selectedMorph isExpanded]) - ifTrue: [^self]. self expandAll: selectedMorph. self adjustSubmorphPositions! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandAll: (in category 'events') ----- expandAll: aMorph + + aMorph canExpand ifFalse: [^ self]. + aMorph isExpanded ifFalse: [aMorph toggleExpandedState]. + aMorph childrenDo: [:child | self expandAll: child].! - | allChildren | - aMorph toggleExpandedState. - allChildren := OrderedCollection new: 10. - aMorph recursiveAddTo: allChildren. - allChildren do: [:each | - (each canExpand and: [each isExpanded not]) - ifTrue: [self expandAll: each]]. - ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'event handling') ----- itemFromPoint: aPoint "Return the list element (morph) at the given point or nil if outside" | ptY visibleRows | scroller hasSubmorphs ifFalse:[^nil]. (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. visibleRows := scroller submorphs select: [:m | m visible]. ptY := (visibleRows first point: aPoint from: self) y. "note: following assumes that submorphs are vertical, non-overlapping, and ordered" visibleRows first top > ptY ifTrue:[^nil]. + visibleRows last bottom < ptY ifTrue:[^visibleRows last]. - visibleRows last bottom < ptY ifTrue:[^nil]. "now use binary search" ^visibleRows findBinary:[:item| (item top <= ptY and:[item bottom >= ptY]) ifTrue:[0] "found" ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]] ifNone: [nil]! Item was changed: ----- Method: SimpleHierarchicalListMorph>>update: (in category 'updating') ----- update: aSymbol aSymbol == getSelectionSelector ifTrue: + [self updateSelection. - [self selection: self getCurrentSelectionItem. ^self]. aSymbol == getListSelector ifTrue: [self list: self getList. ^self]. ((aSymbol isKindOf: Array) and: [aSymbol notEmpty and: [aSymbol first == #openPath]]) ifTrue: [^(scroller submorphs at: 1 ifAbsent: [^self]) openPath: aSymbol allButFirst]! Item was added: + ----- Method: SimpleHierarchicalListMorph>>updateSelection (in category 'updating') ----- + updateSelection + "Fetch selected item from the model." + + self selection: self getCurrentSelectionItem.!

1 0

The Trunk: ToolBuilder-Morphic-mt.335.mcz
by commits＠source.squeak.org 23 Feb '23

23 Feb '23

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

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages February 2023