Packages June 2023

packages@lists.squeakfoundation.org

1 participants
65 discussions

The Trunk: Morphic-mt.2112.mcz
by commits＠source.squeak.org 09 Jun '23

09 Jun '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2112.mcz ==================== Summary ==================== Name: Morphic-mt.2112 Author: mt Time: 9 June 2023, 1:53:13.652748 pm UUID: b55c81ff-2d7a-354d-9bf8-3012d349e9bf Ancestors: Morphic-mt.2111 Speed up tree widgets: - Bypass #fullBounds for each item in a tree - Bypass #adoptPaneColor: in transform morphs - Use Morphic's layout-policy mechansim via new PluggableLayoutPolicy - Dispatch user-input events through layout-policy if available to optimize submorphs-enumeration Also document a mismatch between #removeAllMorphsIn: and #privateAddAllMorphs:atIndex:. =============== Diff against Morphic-mt.2111 =============== Item was changed: ----- Method: IndentingListItemMorph>>collapse (in category 'container protocol') ----- collapse self isExpanded ifFalse: [^ self]. self isExpanded: false. firstChild ifNotNil: [:collapsingNode | | toDelete | toDelete := OrderedCollection new. collapsingNode withSiblingsDo: [:aNode | aNode recursiveAddTo: toDelete]. container noteRemovalOfAll: toDelete. + firstChild := nil].! - firstChild := nil]. - - self changed.! Item was changed: ----- Method: IndentingListItemMorph>>expand (in category 'container protocol') ----- expand | newChildren c | (self isExpanded or: [self canExpand not]) ifTrue: [^ self]. (c := self getChildren) ifEmpty: [ "Due to the guessing in #canExpand, it may still fail here." ^ self]. self isExpanded: true. newChildren := container addSubmorphsAfter: self fromCollection: c allowSorting: true. + container changed. "See mismatch between #removeAllMorphsIn: and #privateAddAllMorphs:atIndex:" firstChild := newChildren first.! Item was added: + ----- Method: IndentingListItemMorph>>fullBounds (in category 'layout') ----- + fullBounds + "For a better performance when containers have thousands of the receiver's kind, avoid extra layout checks since we already know that the receiver changes its appearance only via #drawOn: like other StringMorph's." + + ^ fullBounds ifNil: [fullBounds := bounds]! Item was changed: ----- Method: IndentingListItemMorph>>openPath: (in category 'container protocol - private') ----- openPath: anArray | found | anArray isEmpty ifTrue: [^ container setSelectedMorph: nil]. found := nil. self withSiblingsDo: [:each | found ifNil: [(each complexContents asString = anArray first or: [anArray first isNil]) ifTrue: [found := each]]]. found ifNil: ["try again with no case sensitivity" self withSiblingsDo: [:each | found ifNil: [(each complexContents asString sameAs: anArray first) ifTrue: [found := each]]]]. found ifNotNil: [found isExpanded + ifFalse: [found toggleExpandedState]. - ifFalse: [found toggleExpandedState. - container adjustSubmorphPositions]. - found changed. anArray size = 1 ifTrue: [^ container setSelectedMorph: found]. ^ found firstChild ifNil: [container setSelectedMorph: nil] ifNotNil: [found firstChild openPath: anArray allButFirst]]. ^ container setSelectedMorph: nil! 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]]. - self canExpand ifTrue: [self toggleExpandedState]. - container adjustSubmorphPositions]. super update: aspect.! Item was added: + ----- Method: LayoutPolicy>>isPluggableLayout (in category 'testing') ----- + isPluggableLayout + + ^ false! Item was added: + ----- Method: LayoutPolicy>>submorphsOf:do: (in category 'layout') ----- + submorphsOf: aMorph do: aBlock + "Enumerate submorphs of aMorph, evaluating aBlock on each submorph. Layout policies can override this for a more efficient enumeration." + + aMorph submorphsDo: aBlock.! Item was changed: ----- Method: Morph>>removeAllMorphsIn: (in category 'submorphs - add/remove') ----- removeAllMorphsIn: aCollection "greatly speeds up the removal of *lots* of submorphs" | set myWorld | set := IdentitySet new: aCollection size * 4 // 3. aCollection do: [:each | each owner == self ifTrue: [ set add: each]]. myWorld := self world. + self flag: #todo. "mt: The use of #invalidRect: here is inconsistent with what #privateAddAllMorphs:atIndex: does... Maybe redraw the receiver in both cases?" (fullBounds notNil or:[myWorld notNil]) ifTrue:[self invalidRect: self fullBounds]. set do: [:m | myWorld ifNotNil: [ m outOfWorld: myWorld ]. m privateOwner: nil]. submorphs := submorphs reject: [ :each | set includes: each]. set do: [ :m | self removedMorph: m ]. self layoutChanged. ! Item was changed: ----- Method: MorphicEventDispatcher>>dispatchEvent:toSubmorphsOf: (in category 'support') ----- dispatchEvent: anEvent toSubmorphsOf: aMorph "Dispatch the given event to the submorphs of the given morph. For coordinate transformations, work only with copies. Either return the given event or a copy of any filtered event to employ immutability to some extent. --- PRIVATE!!" + | dispatchBlock localEvent filteredEvent | + dispatchBlock := [:child | - | localEvent filteredEvent | - aMorph submorphsDo: [:child | localEvent := anEvent transformedBy: (child transformedFrom: aMorph). filteredEvent := child processEvent: localEvent. filteredEvent == #rejected ifFalse: [ "some event or #rejected symbol or any other object" filteredEvent isMorphicEvent ifFalse: [filteredEvent := localEvent]. self flag: #overlappingChildren. "mt: We cannot give two overlapping siblings the chance to handle the event!!" ^ self nextFromOriginal: anEvent local: localEvent filtered: filteredEvent]]. + aMorph layoutPolicy + ifNil: [aMorph submorphsDo: dispatchBlock] + ifNotNil: [:policy | policy submorphsOf: aMorph do: dispatchBlock]. + ^ #rejected! Item was added: + LayoutPolicy subclass: #PluggableLayoutPolicy + instanceVariableNames: 'target layoutSelector minExtentSelector flushCacheSelector submorphsSelector' + classVariableNames: '' + poolDictionaries: '' + category: 'Morphic-Layouts'! Item was added: + ----- Method: PluggableLayoutPolicy class>>on:layout: (in category 'instance creation') ----- + on: target layout: layoutSelector + + ^ self new + target: target; + layoutSelector: layoutSelector; + yourself! Item was added: + ----- Method: PluggableLayoutPolicy class>>on:layout:minExtent: (in category 'instance creation') ----- + on: target layout: layoutSelector minExtent: minExtentSelector + + ^ self new + target: target; + layoutSelector: layoutSelector; + minExtentSelector: minExtentSelector; + yourself! Item was added: + ----- Method: PluggableLayoutPolicy class>>on:layout:minExtent:flushCache: (in category 'instance creation') ----- + on: target layout: layoutSelector minExtent: minExtentSelector flushCache: flushCacheSelector + + ^ self new + target: target; + layoutSelector: layoutSelector; + minExtentSelector: minExtentSelector; + flushCacheSelector: flushCacheSelector; + yourself! Item was added: + ----- Method: PluggableLayoutPolicy class>>on:layout:submorphs: (in category 'instance creation') ----- + on: target layout: layoutSelector submorphs: submorphsSelector + + ^ self new + target: target; + layoutSelector: layoutSelector; + submorphsSelector: submorphsSelector; + yourself! Item was added: + ----- Method: PluggableLayoutPolicy>>flushCacheSelector (in category 'accessing') ----- + flushCacheSelector + + ^ flushCacheSelector! Item was added: + ----- Method: PluggableLayoutPolicy>>flushCacheSelector: (in category 'accessing') ----- + flushCacheSelector: anObject + + flushCacheSelector := anObject.! Item was added: + ----- Method: PluggableLayoutPolicy>>flushLayoutCache (in category 'layout') ----- + flushLayoutCache + + flushCacheSelector + ifNil: [super flushLayoutCache] + ifNotNil: [target perform: flushCacheSelector].! Item was added: + ----- Method: PluggableLayoutPolicy>>isPluggableLayout (in category 'testing') ----- + isPluggableLayout + + ^ true! Item was added: + ----- Method: PluggableLayoutPolicy>>layout:in: (in category 'layout') ----- + layout: aMorph in: newBounds + + | arity | + layoutSelector ifNil: [^ super layout: aMorph in: newBounds]. + arity := layoutSelector numArgs. + arity = 0 ifTrue: [^ target perform: layoutSelector]. + arity = 1 ifTrue: [^ target perform: layoutSelector with: newBounds "target should know about aMorph already"]. + arity = 2 ifTrue: [^ target perform: layoutSelector with: aMorph with: newBounds "keep #layout:in: order"]. + self error: 'Layout selectors must be symbols that take 0-2 arguments'! Item was added: + ----- Method: PluggableLayoutPolicy>>layoutSelector (in category 'accessing') ----- + layoutSelector + + ^ layoutSelector! Item was added: + ----- Method: PluggableLayoutPolicy>>layoutSelector: (in category 'accessing') ----- + layoutSelector: anObject + + layoutSelector := anObject.! Item was added: + ----- Method: PluggableLayoutPolicy>>minExtentOf:in: (in category 'layout') ----- + minExtentOf: aMorph in: newBounds + + | arity | + minExtentSelector ifNil: [^ super minExtentOf: aMorph in: newBounds]. + arity := minExtentSelector numArgs. + arity = 0 ifTrue: [^ target perform: minExtentSelector]. + arity = 1 ifTrue: [^ target perform: minExtentSelector with: newBounds "target should know about aMorph already"]. + arity = 2 ifTrue: [^ target perform: minExtentSelector with: aMorph with: newBounds "keep #layout:in: order"]. + self error: 'Layout selectors must be symbols that take 0-2 arguments'! Item was added: + ----- Method: PluggableLayoutPolicy>>minExtentSelector (in category 'accessing') ----- + minExtentSelector + + ^ minExtentSelector! Item was added: + ----- Method: PluggableLayoutPolicy>>minExtentSelector: (in category 'accessing') ----- + minExtentSelector: anObject + + minExtentSelector := anObject.! Item was added: + ----- Method: PluggableLayoutPolicy>>submorphsOf:do: (in category 'layout') ----- + submorphsOf: aMorph do: aBlock + + | arity | + submorphsSelector ifNil: [^ super submorphsOf: aMorph do: aBlock]. + arity := submorphsSelector numArgs. + arity = 1 ifTrue: [^ target perform: submorphsSelector with: aBlock "target should know about aMorph already"]. + arity = 2 ifTrue: [^ target perform: submorphsSelector with: aMorph with: aBlock "keep #submorphsOf:do: order"]. + self error: 'Layout selectors must be symbols that take 1-2 arguments'! Item was added: + ----- Method: PluggableLayoutPolicy>>submorphsSelector (in category 'accessing') ----- + submorphsSelector + + ^ submorphsSelector! Item was added: + ----- Method: PluggableLayoutPolicy>>submorphsSelector: (in category 'accessing') ----- + submorphsSelector: anObject + + submorphsSelector := anObject.! Item was added: + ----- Method: PluggableLayoutPolicy>>target (in category 'accessing') ----- + target + + ^ target! Item was added: + ----- Method: PluggableLayoutPolicy>>target: (in category 'accessing') ----- + target: anObject + + target := anObject.! Item was removed: - ----- Method: PluggableListMorph>>itemFromPoint: (in category 'accessing - items') ----- - itemFromPoint: aPoint - "Return the list element (morph) at the given point or nil if outside" - | ptY | - scroller hasSubmorphs ifFalse:[^nil]. - (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. - ptY := (scroller firstSubmorph point: aPoint from: self) y. - "note: following assumes that submorphs are vertical, non-overlapping, and ordered" - scroller firstSubmorph top > ptY ifTrue:[^nil]. - scroller lastSubmorph bottom < ptY ifTrue:[^nil]. - "now use binary search" - ^scroller - findSubmorphBinary:[:item| - (item top <= ptY and:[item bottom >= ptY]) - ifTrue:[0] "found" - ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]]! Item was changed: ----- Method: PluggableListMorph>>scrollSelectionIntoView (in category 'selection') ----- scrollSelectionIntoView "make sure that the current selection is visible" | row | + (row := self selectionIndex) = 0 ifFalse: [ + self fullBounds. "Compute layout for correct scrolling." + self scrollToShow: (self listMorph drawBoundsForRow: row)]! - (row := self selectionIndex) = 0 - ifFalse: [self scrollToShow: (self listMorph drawBoundsForRow: row)]! Item was changed: ----- Method: ScrollPane>>scrollToShow: (in category 'scrolling') ----- scrollToShow: aRectangle + "Change the receiver's scroller's offset to make aRectangle visible, which is determined by the scroller's current bounds on screen. Note that if aRectangle depends on the receiver's layout being already computed, you must call #fullBounds before fetching the info used for aRectangle." + - | newOffset | newOffset := self offsetToShow: aRectangle. self hScrollBar setValue: newOffset x. self vScrollBar setValue: newOffset y.! Item was added: + ----- Method: SimpleHierarchicalListMorph>>adjustOffset (in category 'layout') ----- + adjustOffset + "Ignored for performance reasons because #submorphBoundsForShrinkWrap can be very expensive."! Item was changed: + ----- Method: SimpleHierarchicalListMorph>>adjustSubmorphPositions (in category 'layout') ----- - ----- Method: SimpleHierarchicalListMorph>>adjustSubmorphPositions (in category 'private') ----- adjustSubmorphPositions + "Expensive. Do layout for the receiver's scroller's items. Note that we must update vertical coordinate to ensure a mapping from the scroller's vertical offset to its submorphs indexes." | p | p := 0@0. scroller submorphsDo: [ :each | | h | h := each height. each privateBounds: (p extent: self preferredSubmorphWidth@h). each visible ifTrue: [p := p + (0@h)]]. - scroller layoutChanged. selectedMorphIndex := nil. "to catch all collapse/expand events" + self clearColumnsCache.! - self - clearColumnsCache; - changed; - layoutChanged; - setScrollDeltas. - ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>applyUserInterfaceTheme (in category 'updating') ----- applyUserInterfaceTheme super applyUserInterfaceTheme. + scroller submorphsDo: [:ea | ea refreshIcon].! - - scroller submorphsDo: [:ea | ea refreshIcon]. - self adjustSubmorphPositions.! Item was changed: ----- 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 noteRemovalOfAll: orphans. - - self adjustSubmorphPositions.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawHoverOn: (in category 'drawing') ----- drawHoverOn: aCanvas self hoveredMorph ifNil: [^ self]. PluggableListMorph highlightHoveredRow ifFalse: [^ self]. + self hoveredMorph drawHoverOn: aCanvas.! - - aCanvas - transformBy: scroller transform - clippingTo: scroller innerBounds - during: [:c | self hoveredMorph drawHoverOn: c].! Item was removed: - ----- Method: SimpleHierarchicalListMorph>>drawLinesOn: (in category 'drawing') ----- - drawLinesOn: aCanvas - - | lColor | - lColor := self lineColor. - aCanvas - transformBy: scroller transform - clippingTo: scroller innerBounds - during:[:clippedCanvas | - scroller submorphsDo: [ :submorph | - (submorph visible and: [(submorph isExpanded - or: [clippedCanvas isVisible: submorph fullBounds] ) - or: [ submorph nextSibling notNil and: [clippedCanvas isVisible: submorph nextSibling fullBounds]]]) - ifTrue: [submorph drawLinesOn: clippedCanvas lineColor: lColor indentThreshold: 0] ] ] - smoothing: scroller smoothing. - ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawOn: (in category 'drawing') ----- drawOn: aCanvas super drawOn: aCanvas. + self drawBackgroundOn: aCanvas.! - - self drawBackgroundOn: aCanvas. - - self drawHoverOn: aCanvas. - self drawSelectionOn: aCanvas. - self drawLinesOn: aCanvas.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>drawSelectionOn: (in category 'drawing') ----- drawSelectionOn: aCanvas + self selectedMorph ifNotNil: [:m | m drawSelectionOn: aCanvas].! - self selectedMorph ifNotNil: [:m | - aCanvas - transformBy: scroller transform - clippingTo: scroller innerBounds - during: [:c | m drawSelectionOn: c] ].! Item was added: + ----- Method: SimpleHierarchicalListMorph>>drawSubmorphsOn: (in category 'drawing') ----- + drawSubmorphsOn: aCanvas + + | drawBlock | + submorphs isEmpty ifTrue: [^self]. + drawBlock := [:canvas | submorphs reverseDo: [:m | + m == scroller + ifFalse: [canvas fullDrawMorph: m] + ifTrue: [self drawVisibleItemsOn: canvas]]]. + self clipSubmorphs + ifTrue: [aCanvas clipBy: self clippingBounds during: drawBlock] + ifFalse: [drawBlock value: aCanvas]! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandAll (in category 'events') ----- expandAll + selectedMorph ifNotNil: [self expandAll: selectedMorph].! - selectedMorph ifNil: [^ self]. - self expandAll: selectedMorph. - self adjustSubmorphPositions! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandAllRoots (in category 'events') ----- expandAllRoots "Expand all, starting with the receiver's roots. Unlike #expandAll, which starts with the current selection." + self roots do: [:ea | self expandAll: ea].! - self roots do: [:ea | self expandAll: ea]. - self adjustSubmorphPositions.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandAllSafely: (in category 'events') ----- expandAllSafely: aMorph aMorph ifNil: [^ self]. Cursor wait showWhile: [ + [self expandAllSafely: aMorph seen: IdentitySet new] - [self expandAllSafely: aMorph seen: IdentitySet new. self adjustSubmorphPositions] on: TooManyItemsInTree do: [:ex | "Stop operation." - self adjustSubmorphPositions. self inform: 'Too many children in sub-tree. Raise #expandAllLimit preference if needed.' translated. self flag: #todo. "mt: Let the user choose to continue the operation for another n items..."]].! Item was changed: ----- Method: SimpleHierarchicalListMorph>>expandRoots (in category 'events') ----- expandRoots + + self roots do: [:each | each expand].! - "Expand all the receiver's roots" - self roots - do: [:each | - (each canExpand and: [each isExpanded not]) - ifTrue: [each toggleExpandedState]]. - self adjustSubmorphPositions! Item was removed: - ----- Method: SimpleHierarchicalListMorph>>extent: (in category 'geometry') ----- - extent: newExtent - bounds extent = newExtent ifTrue: [^ self]. - super extent: newExtent. - self setScrollDeltas ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>initialize (in category 'initialization') ----- initialize + - "initialize the state of the receiver" super initialize. + + scroller + wantsYellowButtonMenu: false; + layoutPolicy: (PluggableLayoutPolicy on: self + layout: #adjustSubmorphPositions + submorphs: #visibleItemsDo:).! - self setProperty: #autoExpand toValue: false. - scroller wantsYellowButtonMenu: false. - self - on: #mouseMove - send: #mouseStillDown:onItem: - to: self! Item was changed: ----- Method: SimpleHierarchicalListMorph>>insertNewMorphs: (in category 'private') ----- insertNewMorphs: morphList scroller addAllMorphs: morphList. + self selection: self getCurrentSelectionItem.! - self adjustSubmorphPositions. - self selection: self getCurrentSelectionItem. - self setScrollDeltas. - ! Item was changed: + ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'geometry') ----- - ----- Method: SimpleHierarchicalListMorph>>itemFromPoint: (in category 'event handling') ----- itemFromPoint: aPoint + "Return the list element (morph) at the given point or nil if outside. See #adjustSubmorphPositions." + + | items numItems ptY row item | - "Return the list element (morph) at the given point or nil if outside" - | items ptY firstVisibleRow lastVisibleRow row itemTop result | items := scroller submorphs. + (numItems := items size) = 0 ifTrue: [^nil]. - items ifEmpty: [^nil]. - (scroller fullBounds containsPoint: aPoint) ifFalse:[^nil]. + ptY := (items first point: aPoint from: self) y. + row := ((ptY max: 0) // self minItemHeight) + 1. + item := items at: numItems. - firstVisibleRow := items at: (items findFirst: [:m | m visible]). - lastVisibleRow := items at: (items findLast: [:m | m visible]). + "1) Linear search to account for non-uniform item height." + [row < numItems and: [(item := items at: row) bottom <= ptY]] + whileTrue: [row := row + 1]. + "2) Check visibility to support type-in filter." + [row < numItems and: [(item := items at: row) visible not]] + whileTrue: [row := row + 1]. + "3) Upper bound is the last visible item." + row = numItems ifTrue: [ + [(item := items at: row) visible] whileFalse: [row := row - 1]]. + + ^ item! - ptY := (firstVisibleRow point: aPoint from: self) y. - "note: following assumes that submorphs are vertical, non-overlapping, and ordered" - firstVisibleRow top > ptY ifTrue:[^nil]. - lastVisibleRow bottom <= ptY ifTrue:[^lastVisibleRow]. - "now use binary search" - row := items - findBinaryIndex:[:item| - (item top <= ptY and: [item bottom >= ptY]) - ifTrue:[0] "found" - ifFalse:[ (item top + item bottom // 2) > ptY ifTrue:[-1] ifFalse:[1]]] - ifNone: [^nil]. - "ignore invisible rows, find first visible at #top; see #adjustSubmorphPositions." - itemTop := (items at: row) top. row := row - 1. - [row > 1 and: [(items at: row) top = itemTop]] whileTrue: [row := row-1] . - row := row + 1. - [(result := items at: row) visible] whileFalse: [row := row+1]. - ^ result! Item was added: + ----- Method: SimpleHierarchicalListMorph>>itemsChanged (in category 'layout') ----- + itemsChanged + "The receiver's items (or submorphs) changed due to some node being collapsed or expanded or refreshed. We need to re-layout all items and re-draw the entire field the next time." + + scroller layoutChanged; changed.! Item was removed: - ----- Method: SimpleHierarchicalListMorph>>listItemHeight (in category 'initialization') ----- - listItemHeight - "This should be cleaned up. The list should get spaced by this parameter." - ^ 12! Item was added: + ----- Method: SimpleHierarchicalListMorph>>resizeScroller (in category 'layout - resizing') ----- + resizeScroller + "For performance, skip re-layouting all items if layout only changed from the outside, which we know if our scroller still has its fullBounds. This happens, for example, when the receiver is resized via #extent:." + + | doLayout | + doLayout := scroller layoutComputed not. + scroller privateBounds: self layoutBounds. + doLayout + ifTrue: [scroller fullBounds] + ifFalse: [scroller privateFullBounds: scroller bounds].! Item was changed: ----- Method: SimpleHierarchicalListMorph>>scrollDeltaHeight (in category 'geometry') ----- scrollDeltaHeight + + ^ self minItemHeight! - ^ scroller hasSubmorphs - ifTrue: [scroller firstSubmorph height] - ifFalse: [super scrollDeltaHeight]! Item was changed: ----- 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 fullBounds. "Compute layout for correct scrolling." + self scrollToShow: m lastVisibleChild bounds]. - m isExpanded ifTrue: [self scrollToShow: m lastVisibleChild bounds]. self scrollSelectionIntoView].! Item was changed: ----- 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 fullBounds. "Compute layout for correct scrolling." self scrollToShow: (m bounds outsetBy: (0@ (m height * numExtraItemsToShow))). self scrollSelectionIntoView].! Item was changed: ----- Method: SimpleHierarchicalListMorph>>scrollSelectionIntoView (in category 'selection') ----- scrollSelectionIntoView "Ensure that the user can see the current selection. If there is no current selection, keep the view stable." + self selectedMorph ifNotNil: [:m | + self fullBounds. "Compute layout for correct scrolling." + self scrollToShow: m bounds].! - self selectedMorph ifNotNil: [:m | self scrollToShow: m bounds].! Item was changed: ----- 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 fullBounds. "Compute layout for correct scrolling." + self scrollToShow: pm bounds]. - parentOrNil ifNotNil: [:pm | self scrollToShow: pm bounds]. self scrollSelectionIntoView.! Item was changed: ----- Method: SimpleHierarchicalListMorph>>toggleExpandedState: (in category 'keyboard navigation') ----- toggleExpandedState: aMorph aMorph toggleExpandedState. - self adjustSubmorphPositions. ! Item was changed: ----- Method: SimpleHierarchicalListMorph>>toggleExpandedState:event: (in category 'events') ----- toggleExpandedState: aMorph event: aMouseEvent "Mouse navigation. Thus, avoid changing scroll position. See #toggleExpandedState: for keyboard navigation." autoExpand == true ifTrue: [^ self]. aMorph toggleExpandedState. - self adjustSubmorphPositions. ! Item was added: + ----- Method: TransformMorph>>adoptPaneColor: (in category 'as yet unclassified') ----- + adoptPaneColor: aColor + "Ignore. This is a window-color feature and thus not used for submorphs that are in a scroll container. Note that other layout containers are not effected such as button rows."! Item was changed: + (PackageInfo named: 'Morphic') postscript: '"Endable layoutPolicy for all tree widgets." + SimpleHierarchicalListMorph allSubInstancesDo: [:treeWidget | + treeWidget scroller + layoutPolicy: (PluggableLayoutPolicy on: treeWidget + layout: #adjustSubmorphPositions + submorphs: #visibleItemsDo:)].'! - (PackageInfo named: 'Morphic') postscript: 'IndentingListItemMorph applyUserInterfaceTheme. "Filter background color"'!

1 0

The Trunk: Morphic-mt.2111.mcz
by commits＠source.squeak.org 09 Jun '23

09 Jun '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2111.mcz ==================== Summary ==================== Name: Morphic-mt.2111 Author: mt Time: 9 June 2023, 1:47:47.479748 pm UUID: cf52a53c-27bd-d74a-a198-a2de98ad0e7a Ancestors: Morphic-mt.2110 Prepare update that speeds up tree widgets having thousands of items. =============== Diff against Morphic-mt.2110 =============== Item was added: + ----- Method: SimpleHierarchicalListMorph>>drawVisibleItemsOn: (in category 'drawing') ----- + drawVisibleItemsOn: aCanvas + + aCanvas + transformBy: scroller transform + clippingTo: scroller innerBounds + during: [ :clippedCanvas | | lColor | + + self drawHoverOn: clippedCanvas. + self drawSelectionOn: clippedCanvas. + + lColor := self lineColor. + self flag: #todo. "mt: Optimize line drawing to finish after a single enumeration of visible morphs." + self visibleItemsDo: [:m | m drawLinesOn: clippedCanvas lineColor: lColor indentThreshold: 0]. + self visibleItemsDo: [:m | clippedCanvas fullDrawMorph: m]] + smoothing: scroller smoothing. + + ! Item was added: + ----- Method: SimpleHierarchicalListMorph>>minItemHeight (in category 'geometry') ----- + minItemHeight + "Answer the minimum height of each item. For uniform lists, this is the definite height of all items. See #minHeight in IndentingListItemMorph." + + ^ scroller hasSubmorphs + ifTrue: [scroller firstSubmorph height] + ifFalse: [self font lineGridForMorphs] + ! Item was added: + ----- Method: SimpleHierarchicalListMorph>>visibleItemsDo: (in category 'drawing') ----- + visibleItemsDo: block + "Enumerate all visible items, which is more efficient that just #submorphsDo: for scrollers that have thousands of items but typically only dozens visible on screen." + + | items numItems maxY row item | + items := scroller submorphs. + (numItems := items size) = 0 ifTrue: [^ self]. + + row := ((scroller offset y max: 0) // self minItemHeight) + 1. + maxY := scroller offset y + scroller height. + [row <= numItems and: [(item := items at: row) top < maxY]] whileTrue: [ + item visible ifTrue: [block value: item]. + row := row + 1].!

1 0

The Trunk: Tools-mt.1221.mcz
by commits＠source.squeak.org 09 Jun '23

09 Jun '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1221.mcz ==================== Summary ==================== Name: Tools-mt.1221 Author: mt Time: 9 June 2023, 1:06:42.794748 pm UUID: d57ea849-d0a5-4544-8217-a1cb5eb2f3fc Ancestors: Tools-ct.1220 In TreeBrowser, fixes sorting issue in "-- core --" category where some of the elements were texts, not just strings. =============== Diff against Tools-ct.1220 =============== Item was changed: ----- Method: TreeBrowser>>messageList (in category 'message list') ----- messageList "Overwritten to show all extensions when the '-- extensions --' category is selected." self selectedMessageCategoryName = self class coreCategory ifTrue: [ ^ (Array streamContents: [:coreSelectors | self classOrMetaClassOrganizer categories reject: [:cat | cat first == $*] thenDo: [:coreCat | (self classOrMetaClassOrganizer listAtCategoryNamed: coreCat) + do: [:coreSel | coreSelectors nextPut: (self formattedLabel: coreSel)]]]) + sorted: [:a :b | a string <= b string "#sorted not working bc. of possible text elements"]]. - do: [:coreSel | coreSelectors nextPut: (self formattedLabel: coreSel)]]]) sort]. ^ self selectedMessageCategoryName = self class extensionCategory ifFalse: [super messageList] ifTrue: [ Array streamContents: [:extensionSelectors | self classOrMetaClassOrganizer categories select: [:cat | cat first == $*] thenDo: [:extCat | (self classOrMetaClassOrganizer listAtCategoryNamed: extCat) do: [:extSel | extensionSelectors nextPut: (self formattedLabel: extSel)]]]]!

1 0

The Trunk: Tools-ct.1220.mcz
by commits＠source.squeak.org 07 Jun '23

07 Jun '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1220.mcz ==================== Summary ==================== Name: Tools-ct.1220 Author: ct Time: 7 June 2023, 7:31:49.780387 pm UUID: 0b87add4-e50a-7241-aa4f-a19d54fbac08 Ancestors: Tools-mt.1219 Adds missing widget names to the tree browser, analogously to superclass. This not only improves explorability but is also used in some UI automations in other projects. =============== Diff against Tools-mt.1219 =============== Item was changed: ----- Method: TreeBrowser>>buildClassListWith: (in category 'toolbuilder') ----- buildClassListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; + name: #classList; roots: #classRoots; label: #classLabel:; getChildren: #classChildren:; hasChildren: #classHasChildren:; autoExpand: #classTreeExpanded; help: #classHelpAt:; getSelectedPath: #classPath; getSelected: #classChild; setSelected: #classChild:; doubleClick: #doubleClickClassChild:; icon: #classIcon:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; filterMode: #visible; "not #all bc. class-tree is too deep, which makes filtering slow" searchMode: #depthFirst. SystemBrowser browseWithDragNDrop ifTrue: [ tree dragItem: #dragFromClassTree:; dragType: #dragTypeForClassTreeAt:]. ^ tree! Item was changed: ----- Method: TreeBrowser>>buildMessageCategoryListWith: (in category 'toolbuilder') ----- buildMessageCategoryListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; + name: #messageCategoryList; roots: #messageCategoryRoots; label: #messageCategoryLabel:; getChildren: #messageCategoryChildren:; hasChildren: #messageCategoryHasChildren:; help: #messageCategoryHelpAt:; getSelectedPath: #messageCategoryPath; getSelected: #messageCategoryChild; setSelected: #messageCategoryChild:; menu: #messageCategoryMenu:; keyPress: #messageCategoryListKey:from:; filterMode: #all; searchMode: #depthFirst. SystemBrowser browseWithDragNDrop ifTrue:[ tree dropAccept: #wantsMessageCategoriesDrop:; dropItem: #dropOnMessageCategories:on:]. ^ tree! Item was changed: ----- Method: TreeBrowser>>buildSystemCategoryListWith: (in category 'toolbuilder') ----- buildSystemCategoryListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; + name: #systemCategoryList; roots: #systemCategoryRoots; label: #systemCategoryLabel:; getChildren: #systemCategoryChildren:; hasChildren: #systemCategoryHasChildren:; help: #systemCategoryHelpAt:; getSelectedPath: #systemCategoryPath; getSelected: #systemCategoryChild; setSelected: #systemCategoryChild:; menu: #systemCategoryMenu:; keyPress: #systemCatListKey:from:; filterMode: #all; searchMode: #depthFirst. ^ tree!

1 0

The Trunk: System-eem.1415.mcz
by commits＠source.squeak.org 06 Jun '23

06 Jun '23

Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.1415.mcz ==================== Summary ==================== Name: System-eem.1415 Author: eem Time: 6 June 2023, 11:36:51.136681 am UUID: 8e9c1e20-e023-4821-abc3-49779f11630e Ancestors: System-ct.1414 Smalltalk platformName is evaluated in may places, (e.g. even in each event input; see EventSensor>>#processEvent:). It's a slow primitive and does an allocation. So since it doesn't change within a single run, cache it just as endianness is cached. Fix the nilling of the endianness cache to be after running the shutdown list, not before. There's nothing to preclude something in the shutdown list wanting to know endianness and/or platform name info. =============== Diff against System-ct.1414 =============== Item was changed: Object subclass: #SmalltalkImage instanceVariableNames: 'globals' + classVariableNames: 'EndianCache LastImageName LastQuitLogPosition LastStats LowSpaceProcess LowSpaceSemaphore MemoryHogs PlatformNameCache ShutDownList SourceFileVersionString StartUpList StartupStamp VMMakerVersion WordSize' - classVariableNames: 'EndianCache LastImageName LastQuitLogPosition LastStats LowSpaceProcess LowSpaceSemaphore MemoryHogs ShutDownList SourceFileVersionString StartUpList StartupStamp VMMakerVersion WordSize' poolDictionaries: '' category: 'System-Support'! !SmalltalkImage commentStamp: 'dtl 3/6/2010 14:00' prior: 0! I represent the current image and runtime environment, including system organization, the virtual machine, object memory, plugins and source files. My instance variable #globals is a reference to the system dictionary of global variables and class names. My singleton instance is called Smalltalk.! Item was changed: ----- Method: SmalltalkImage>>platformName (in category 'os') ----- platformName + "Answer the name of the platform we're running on." - "Return the name of the platform we're running on." "Smalltalk os platformName" + ^PlatformNameCache ifNil: [PlatformNameCache := self getSystemAttribute: 1001]! - ^self getSystemAttribute: 1001! Item was changed: ----- Method: SmalltalkImage>>processShutDownList: (in category 'snapshot and quit') ----- processShutDownList: quitting "Send #shutDown to each class that needs to wrap up before a snapshot. + Also void the various caches; this can't safely be done on start-up because - Also void the endianness chace; this can't safely be done on start-up because Smalltalk is too late in the start-up sequence." + self send: #shutDown: toClassesNamedIn: ShutDownList with: quitting. + EndianCache := PlatformNameCache := nil! - EndianCache := nil. - self send: #shutDown: toClassesNamedIn: ShutDownList with: quitting!

1 0

The Trunk: Monticello-eem.790.mcz
by commits＠source.squeak.org 05 Jun '23

05 Jun '23

Eliot Miranda uploaded a new version of Monticello to project The Trunk: http://source.squeak.org/trunk/Monticello-eem.790.mcz ==================== Summary ==================== Name: Monticello-eem.790 Author: eem Time: 5 June 2023, 11:29:03.938098 am UUID: 4179c240-0619-4930-9ec6-e3c04bf2a42f Ancestors: Monticello-ct.789 Get "fileOut theirs" to work properly. =============== Diff against Monticello-ct.789 =============== Item was added: + ----- Method: MCCodeTool>>fileOutInverse (in category 'menus') ----- + fileOutInverse + "Put a description of the inverses of the selected definition(s) on a file." + + | index fileName itemsToFileOut | + itemsToFileOut := (index := self selection) ~= 0 + ifTrue: [{items at: index}] + ifFalse: [items select: [:item| self shouldIncludeInFileOut: item]]. + items isEmpty ifTrue: + [^self]. + fileName := UIManager default + saveFilenameRequest: 'File out on which file?' + initialAnswer: (index ~= 0 + ifTrue: [itemsToFileOut first summary] + ifFalse: ['definitions']). + fileName isEmptyOrNil ifTrue: [^self]. + Cursor write showWhile: + [| definitionStream | + definitionStream := WriteStream on: (String new: 1000). + definitionStream header; timeStamp. + itemsToFileOut + do: [:patchOp| | inverseOp | + inverseOp := patchOp inverse. + (inverseOp isRemoval ifTrue: [inverseOp] ifFalse: [inverseOp definition]) fileOutOn: definitionStream] + separatedBy: [definitionStream cr; cr]. + FileStream writeSourceCodeFrom: definitionStream baseName: fileName isSt: true useHtml: false]! Item was changed: ----- Method: MCCodeTool>>methodListMenu: (in category 'menus') ----- methodListMenu: aMenu "Build the menu for the selected method, if any." self selectedMessageName ifNil: [items notEmpty ifTrue: [aMenu addList:#( ('fileOut ours (o)' fileOutMessage) + ('fileOut theirs' fileOutInverse))]] - ('fileOut theirs' fileOutDefinition))]] ifNotNil: [ aMenu addList:#( ('browse full (b)' browseMethodFull) ('browse hierarchy (h)' browseClassHierarchy) ('browse protocol (p)' browseFullProtocol) - ('fileOut ours (o)' fileOutMessage) ('fileOut theirs' fileOutDefinition) ('printOut' printOutMessage) ('copy selector (c)' copySelector) ('copy reference (C)' copyReference)). aMenu addList: #( - ('browse senders (n)' browseSendersOfMessages) ('browse implementors (m)' browseMessages) ('inheritance (i)' methodHierarchy) ('versions (v)' browseVersions) ('change sets with this method' findMethodInChangeSets) " ('x revert to previous version' revertToPreviousVersion)" ('remove from current change set' removeFromCurrentChanges) " ('x revert & remove from changes' revertAndForget)" ('add to current change set' adoptMessageInCurrentChangeset) " ('x copy up or copy down...' copyUpOrCopyDown)" " ('x remove method (x)' removeMessage)" "-" ). ]. " aMenu addList: #( ('x inst var refs...' browseInstVarRefs) ('x inst var defs...' browseInstVarDefs) ('x class var refs...' browseClassVarRefs) ('x class variables' browseClassVariables) ('x class refs (N)' browseClassRefs) ). " ^ aMenu !

1 0

The Trunk: Tools-ct.1217.mcz
by commits＠source.squeak.org 05 Jun '23

05 Jun '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1217.mcz ==================== Summary ==================== Name: Tools-ct.1217 Author: ct Time: 3 June 2023, 10:27:19.522136 pm UUID: 0c2e8345-da8a-b74d-a527-510fdf8c7ce5 Ancestors: Tools-ct.1216 Fixes change logging for methods that are recompiled from a browser without its existing category being selected. Previously, this kept the organization in the image intact but logged a {nil} category to the change set and to the changes file. =============== Diff against Tools-ct.1216 =============== Item was changed: ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | currentSelector selector category oldMessageList selectedClassOrMetaClass | currentSelector := self selectedMessageName. oldMessageList := self messageList. selectedClassOrMetaClass := self selectedClassOrMetaClass. contents := nil. selector := (selectedClassOrMetaClass newParser parseSelector: aString). (self metaClassIndicated and: [(selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A first-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. category := currentSelector + ifNil: [ self selectedMessageCategoryName ifNil: [ selectedClassOrMetaClass whichCategoryIncludesSelector: selector ] ] - ifNil: [ self selectedMessageCategoryName ] ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. selector := selectedClassOrMetaClass compile: aString classified: category notifying: aController. selector ifNil: [^ nil]. contents := aString copy. self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." selector ~~ currentSelector ifTrue: [category = ClassOrganizer nullCategory ifTrue: [self changed: #classSelectionChanged. self changed: #classList. self messageCategoryListIndex: 1]. self setClassOrganizer. "In case organization not cached" (oldMessageList includes: selector) ifFalse: [self changed: #messageList]. self messageListIndex: (self messageList indexOf: selector)]. ^ selector!

1 0

The Trunk: Tools-ct.1215.mcz
by commits＠source.squeak.org 05 Jun '23

05 Jun '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1215.mcz ==================== Summary ==================== Name: Tools-ct.1215 Author: ct Time: 3 June 2023, 7:04:29.849136 pm UUID: ab8c72a8-6e42-3d40-9fa1-9c5c3e02d775 Ancestors: Tools-ct.1213 Proposal: Double-click a class or trait in hierarchy tree browser to switch the central class. =============== Diff against Tools-ct.1213 =============== Item was changed: ----- Method: TreeBrowser>>buildClassListWith: (in category 'toolbuilder') ----- buildClassListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; roots: #classRoots; label: #classLabel:; getChildren: #classChildren:; hasChildren: #classHasChildren:; autoExpand: #classTreeExpanded; help: #classHelpAt:; getSelectedPath: #classPath; getSelected: #classChild; setSelected: #classChild:; + doubleClick: #doubleClickClassChild:; icon: #classIcon:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; filterMode: #visible; "not #all bc. class-tree is too deep, which makes filtering slow" searchMode: #depthFirst. SystemBrowser browseWithDragNDrop ifTrue: [ tree dragItem: #dragFromClassTree:; dragType: #dragTypeForClassTreeAt:]. ^ tree! Item was added: + ----- Method: TreeBrowser>>doubleClickClassChild: (in category 'class tree') ----- + doubleClickClassChild: aClassNotMeta + + self isHierarchy ifFalse: [^ false]. + self hasClassSelected ifFalse: [^ false]. + self initHierarchyFor: self selectedClassOrMetaClass. + ^ true!

1 0

The Trunk: Tools-ct.1214.mcz
by commits＠source.squeak.org 05 Jun '23

05 Jun '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1214.mcz ==================== Summary ==================== Name: Tools-ct.1214 Author: ct Time: 3 June 2023, 6:52:38.283136 pm UUID: b37182a9-07fd-6045-a122-9e5c2458c589 Ancestors: Tools-ct.1213 Proposal: Sort classes in ClassListBrowser, analogously to SystemNavigation>>#allMethodsSelect:. =============== Diff against Tools-ct.1213 =============== Item was changed: ----- Method: ClassListBrowser class>>browseClassesSatisfying:title: (in category 'instance creation') ----- browseClassesSatisfying: classBlock title: aTitle "Put up a ClassListBrowser showing all classes that satisfy the classBlock." self newOnClassesNamed: (self systemNavigation allClasses select: [:c | (classBlock value: c) == true] + thenCollect: [:c | c name]) sorted - thenCollect: [:c | c name]) label: aTitle!

1 0

The Trunk: Tools-mt.1219.mcz
by commits＠source.squeak.org 05 Jun '23

05 Jun '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1219.mcz ==================== Summary ==================== Name: Tools-mt.1219 Author: mt Time: 5 June 2023, 11:21:12.203422 am UUID: 5b8b6246-fc9b-8f4e-b048-a8bc93db5f1f Ancestors: Tools-ct.1218, Tools-ct.1214, Tools-ct.1215, Tools-ct.1217 Merge, merge, merge. Tools-ct.1214: Proposal: Sort classes in ClassListBrowser, analogously to SystemNavigation>>#allMethodsSelect:. Tools-ct.1215: Proposal: Double-click a class or trait in hierarchy tree browser to switch the central class. Tools-ct.1217: Fixes change logging for methods that are recompiled from a browser without its existing category being selected. Previously, this kept the organization in the image intact but logged a {nil} category to the change set and to the changes file. =============== Diff against Tools-ct.1218 =============== Item was changed: ----- Method: Browser>>defineMessageFrom:notifying: (in category 'message functions') ----- defineMessageFrom: aString notifying: aController "Compile the expressions in aString. Notify aController if a syntax error occurs. Install the compiled method in the selected class classified under the currently selected message category name. Answer the selector obtained if compilation succeeds, nil otherwise." | currentSelector selector category oldMessageList selectedClassOrMetaClass | currentSelector := self selectedMessageName. oldMessageList := self messageList. selectedClassOrMetaClass := self selectedClassOrMetaClass. contents := nil. selector := (selectedClassOrMetaClass newParser parseSelector: aString). (self metaClassIndicated and: [(selectedClassOrMetaClass includesSelector: selector) not and: [Metaclass isScarySelector: selector]]) ifTrue: ["A first-time definition overlaps the protocol of Metaclasses" (self confirm: ((selector , ' is used in the existing class system. Overriding it could cause serious problems. Is this really what you want to do?') asText makeBoldFrom: 1 to: selector size)) ifFalse: [^nil]]. category := currentSelector + ifNil: [ self selectedMessageCategoryName ifNil: [ selectedClassOrMetaClass whichCategoryIncludesSelector: selector ] ] - ifNil: [ self selectedMessageCategoryName ] ifNotNil: [ (selectedClassOrMetaClass >> selectedMessageName) methodReference ifNotNil: [ : ref | ref category ]]. selector := selectedClassOrMetaClass compile: aString classified: category notifying: aController. selector ifNil: [^ nil]. contents := aString copy. self changed: #messageCategoryList. "Because the 'as yet unclassified' might just appear." self changed: #messageList. "Because we have code-dependent list formatting by now such as #isDeprecated." selector ~~ currentSelector ifTrue: [category = ClassOrganizer nullCategory ifTrue: [self changed: #classSelectionChanged. self changed: #classList. self messageCategoryListIndex: 1]. self setClassOrganizer. "In case organization not cached" (oldMessageList includes: selector) ifFalse: [self changed: #messageList]. self messageListIndex: (self messageList indexOf: selector)]. ^ selector! Item was changed: ----- Method: ClassListBrowser class>>browseClassesSatisfying:title: (in category 'instance creation') ----- browseClassesSatisfying: classBlock title: aTitle "Put up a ClassListBrowser showing all classes that satisfy the classBlock." self newOnClassesNamed: (self systemNavigation allClasses select: [:c | (classBlock value: c) == true] + thenCollect: [:c | c name]) sorted - thenCollect: [:c | c name]) label: aTitle! Item was changed: ----- Method: TreeBrowser>>buildClassListWith: (in category 'toolbuilder') ----- buildClassListWith: builder | tree | tree := builder pluggableTreeSpec new. tree model: self; roots: #classRoots; label: #classLabel:; getChildren: #classChildren:; hasChildren: #classHasChildren:; autoExpand: #classTreeExpanded; help: #classHelpAt:; getSelectedPath: #classPath; getSelected: #classChild; setSelected: #classChild:; + doubleClick: #doubleClickClassChild:; icon: #classIcon:; menu: #classListMenu:shifted:; keyPress: #classListKey:from:; filterMode: #visible; "not #all bc. class-tree is too deep, which makes filtering slow" searchMode: #depthFirst. SystemBrowser browseWithDragNDrop ifTrue: [ tree dragItem: #dragFromClassTree:; dragType: #dragTypeForClassTreeAt:]. ^ tree! Item was added: + ----- Method: TreeBrowser>>doubleClickClassChild: (in category 'class tree - support') ----- + doubleClickClassChild: aClassNotMeta + + self isHierarchy ifFalse: [^ false]. + self hasClassSelected ifFalse: [^ false]. + self initHierarchyFor: self selectedClassOrMetaClass. + ^ true!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages June 2023