Squeak-dev June 2023

squeak-dev@lists.squeakfoundation.org

23 participants
127 discussions

The Trunk: Collections-ct.1045.mcz
by commits＠source.squeak.org 13 Jun '23

13 Jun '23

Christoph Thiede uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ct.1045.mcz ==================== Summary ==================== Name: Collections-ct.1045 Author: ct Time: 13 June 2023, 11:23:46.884003 pm UUID: 79db8083-31b4-554f-83bd-42c6aac35e64 Ancestors: Collections-ct.1044 Fixes comment in asCommaStringAnd. Sorry for the noise. =============== Diff against Collections-ct.1044 =============== Item was changed: ----- Method: Collection>>asCommaStringAnd (in category 'printing - obsolete') ----- asCommaStringAnd + "Return collection printed as 'a, b, and c' " - "Return collection printed as 'a, b and c' " self flag: #deprecate. ^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ', and '] !

1 0

The Trunk: Collections-ct.930.mcz
by commits＠source.squeak.org 13 Jun '23

13 Jun '23

Christoph Thiede uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-ct.930.mcz ==================== Summary ==================== Name: Collections-ct.930 Author: ct Time: 11 March 2021, 10:56:52.528559 am UUID: 6b1a0ee3-8c2d-a547-9ee2-f029a32d07b7 Ancestors: Collections-nice.929 Uses oxford comma in #asCommaStringAnd. Full discussion is here: http://forum.world.st/The-Inbox-Tools-ct-1015-mcz-tp5124286p5127654.html =============== Diff against Collections-nice.929 =============== Item was changed: ----- Method: Collection>>asCommaStringAnd (in category 'printing - obsolete') ----- asCommaStringAnd "Return collection printed as 'a, b and c' " self flag: #deprecate. + ^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ', and '] - ^String streamContents: [:s | self asStringOn: s delimiter: ', ' last: ' and '] !

1 0

The Trunk: CollectionsTests-ct.397.mcz
by commits＠source.squeak.org 13 Jun '23

13 Jun '23

Christoph Thiede uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-ct.397.mcz ==================== Summary ==================== Name: CollectionsTests-ct.397 Author: ct Time: 13 June 2023, 11:07:56.508003 pm UUID: 79ef9ab5-6bbd-cd43-88cb-75b43177c28b Ancestors: CollectionsTests-ct.396 Complements Collections-ct.1044 (oxford comma in #asCommaStringAnd). =============== Diff against CollectionsTests-ct.396 =============== Item was changed: ----- Method: CollectionTest>>testAsCommaStringAnd (in category 'tests') ----- testAsCommaStringAnd {OrderedCollection new. Set new.} do: [ :coll | self assert: coll asCommaStringAnd = ''. coll add: 1. self assert: coll asCommaStringAnd = '1'. coll add: 2; add: 3. + self assert: coll asCommaStringAnd = '1, 2, and 3'].! - self assert: coll asCommaStringAnd = '1, 2 and 3'].! Item was changed: ----- Method: LinkedListTest>>testAsCommaStringMore (in category 'tests - comma and delimiter') ----- testAsCommaStringMore "self assert: self oneTwoThreeItemCol asCommaString = '1, 2, 3'. + self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2, and 3' - self assert: self oneTwoThreeItemCol asCommaStringAnd = '1, 2 and 3' " | result resultAnd index allElementsAsString | result:= self nonEmpty asCommaString . resultAnd:= self nonEmpty asCommaStringAnd . index := 1. (result findBetweenSubStrs: ',' )do: [:each | index = 1 ifTrue: [self assert: each= ((self nonEmpty at:index)asString)] ifFalse: [self assert: each= (' ',(self nonEmpty at:index) asString)]. index:=index+1 ]. + "verifying resultAnd :" - "verifying esultAnd :" allElementsAsString:=(resultAnd findBetweenSubStrs: ',' ). 1 to: allElementsAsString size do: [:i | i<(allElementsAsString size ) ifTrue: [ i = 1 ifTrue:[self assert: (allElementsAsString at:i)=((self nonEmpty at:i) asString)] ifFalse:[self assert: (allElementsAsString at:i)=(' ',(self nonEmpty at:i) asString)] ]. i=(allElementsAsString size) ifTrue:[ i = 1 ifTrue:[self assert: (allElementsAsString at:i)=( (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )] + ifFalse:[self assert: (allElementsAsString at:i)=( ' and ', (self nonEmpty at: i ) asString )] - ifFalse:[self assert: (allElementsAsString at:i)=( ' ' , (self nonEmpty at:i ) asString ,' and ', (self nonEmpty at: ( i + 1) ) asString )] ]. ].!

1 0

The Trunk: Collections-mt.1043.mcz
by commits＠source.squeak.org 12 Jun '23

12 Jun '23

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.1043.mcz ==================== Summary ==================== Name: Collections-mt.1043 Author: mt Time: 12 June 2023, 1:42:34.426515 pm UUID: 9cd16a22-7109-e245-8472-6666db485ccc Ancestors: Collections-ct.1042 Fix typo in comment =============== Diff against Collections-ct.1042 =============== Item was changed: SignedIntegerArray variableWordSubclass: #SignedWordArray instanceVariableNames: '' classVariableNames: '' poolDictionaries: '' category: 'Collections-Arrayed'! + !SignedWordArray commentStamp: 'mt 6/12/2023 13:42' prior: 0! + A SignedWordArray store 32bit signed Integer values in the range -16r80000000 (-2,147,483,648) to 16r7FFFFFFF (2,147,483,647) - !SignedWordArray commentStamp: 'nice 5/10/2020 17:22' prior: 0! - A SignedWordArray store 64bit signed Integer values in the range -16r80000000 (-2,147,483,648) to 16r7FFFFFFF (2,147,483,647) Negative values are stored as 2's complement.!

1 0

Re: [Board] Re: Minimum Processor for Squeak
by Bruce O'Neel 12 Jun '23

12 Jun '23

Hi So this might be better on Squeak-dev or Squeak-beginners, but I'll give it a shot: Squeak is quite light on system resources. It runs fine on a Raspberry Pi 3 with 1G of memory and a small SD Card. On startup it wants about 10% of that 1G of memory. On disk it should fit well within 150 to 200meg. I guess this will run Windows though, right? I suspect that the overhead will be larger. Does anyone run on a small Windows system? How is the performance? cheers bruce On 2023-06-08T23:21:49.000+02:00, stacy smith <vet.goldrushstreaming(a)gmail.com> wrote: > Greetings Squeakers, > > Please have someone respond to this email since I have never > programmed before, and am not sure how to make sure my machine is > compatible. > > Thanks, > Stacy > > On Thu, Jun 1, 2023 at 4:49 PM stacy smith > <vet.goldrushstreaming(a)gmail.com> wrote: > >> Greetings Squeakers, >> >> I am going to purchase myself and my 11 and 13 year old niece and >> nephew a cheap computer to learn Squeak. Any ideas? >> >> I am looking at the >> >> HP - STREAM 11.6" LAPTOP - INTEL CELERON - 4GB MEMORY - 64GB EMMC >> - DIAMOND WHITE >> >> Thanks, >> Stacy Smith

4 4

The Trunk: WebClient-Help-pre.14.mcz
by commits＠source.squeak.org 09 Jun '23

09 Jun '23

Patrick Rein uploaded a new version of WebClient-Help to project The Trunk: http://source.squeak.org/trunk/WebClient-Help-pre.14.mcz ==================== Summary ==================== Name: WebClient-Help-pre.14 Author: pre Time: 9 June 2023, 4:55:32.241055 pm UUID: 35b81cd9-5803-2e42-a541-1c4c60c7baf5 Ancestors: WebClient-Help-tpr.13 Fixes incorrect web server error handling documentation (#24 in the bug tracker). =============== Diff against WebClient-Help-tpr.13 =============== Item was changed: ----- Method: WebServerHelp class>>errorHandling (in category 'pages') ----- errorHandling "This method was automatically generated. Edit it using:" "WebServerHelp edit: #errorHandling" + <generated> + ^(HelpTopic - ^HelpTopic title: 'Error Handling' contents: 'By default WebServer will send a 500 response with a full debug stack when an error occurs. This may not be appropriate in production environments and consequently, the error handler can be customized. Typically, the error handler will perform one of the following actions: * Pass the error through. This is useful for debugging, when an error in WebServer should raise a notifier: + webServer errorHandler: [:err :request | err pass]. - webServer errorHandler:[:err :socket| err pass]. * Send the ''standard'' 500 response (including the full stack): You can simply use WebServer''s default action for this: + webServer errorHandler: [:err :request | webServer handleError: err request: request.]. - webServer errorHandler:[:err :socket| webServer handleError: err socket: socket.]. * Send a custom 500 response, or perform a redirect, for example: + webServer errorHandler: [:err :request | + [request send302Response: ''/error.html''] + on: Error + do: ["Ignore errors in error handling"] ]. - webServer errorHandler:[:err :socket| - [socket sendData: - ''HTTP/1.0 302 Temporary redirect'', String crlf, - ''Location: /error.html'', String crlf, - String crlf. - socket close] on: Error do:[ - "Ignore errors in error handling" - ]. - ]. Of course, you can use any possible combination; including the ability to turn error handling on and off via WebServer http requests.!! + ]style[(395 14 2 3 1 9 1 1 3 1 4 135 14 2 3 9 1 1 11 12 1 3 1 8 1 7 83 14 2 3 1 9 5 38 1 5 3 11 4 1 33 1 138),c000000118,,c000000118,,c000000118,cgray;,,c000000118,,c000000118,,c000000118,,c000000118,,c000000118,cgray;,,c000000118,,c000000118,,c000000118,,c000000118,,c000000118,,c000000118,,c000000118,cgray;,,c000118000,,c000000118,,c000000118,c000118000,,c000118000,!!' readStream nextChunkText) + key: #errorHandling; + shouldStyle: false; + yourself! - ]style[(384 11 13 2 3 2 6 1 1 3 1 4 2 123 10 13 2 3 2 6 1 11 12 1 3 1 7 1 6 3 69 11 13 2 3 2 6 1 3 1 6 1 9 4 33 1 8 5 4 23 1 8 5 11 4 4 6 1 5 1 1 3 7 3 1 4 33 3 1 5 135),cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cgray;,cblack;,c000000126,cblack;,c000000126,cblack;,,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cgray;,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cgray;,cblack;,c000126000,c000000126,cblack;,c000000126,cblack;,c126000126,c000000126,cblack;,c000000126,cblack;,c126000126,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,cblack;,c000000126,c000126000,cblack;,c000000126,cblack;,c000000126,c000126000,cblack;,c000126126,cblack;,c000126000,cblack;,!!' readStream nextChunkText!

1 0

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

09 Jun '23

Marcel Taeumel uploaded a new version of EToys to project The Trunk: http://source.squeak.org/trunk/EToys-mt.499.mcz ==================== Summary ==================== Name: EToys-mt.499 Author: mt Time: 9 June 2023, 1:54:14.992748 pm UUID: bb35e295-68b6-4f4c-af52-67627cf71c50 Ancestors: EToys-mt.498 Complement Morphic-mt.2112 =============== Diff against EToys-mt.498 =============== Item was removed: - ----- Method: SimpleHierarchicalListMorph class>>on:list:selected:changeSelected:menu:keystroke:autoExpand: (in category '*Etoys-Squeakland-instance creation') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel autoExpand: aBoolean - "Create a 'pluggable' list view on the given model parameterized by the given message selectors. See ListView>>aboutPluggability comment." - - ^ self new - on: anObject - list: getListSel - selected: getSelectionSel - changeSelected: setSelectionSel - menu: getMenuSel - keystroke: keyActionSel - autoExpand: aBoolean - ! Item was removed: - ----- Method: SimpleHierarchicalListMorph>>on:list:selected:changeSelected:menu:keystroke:autoExpand: (in category '*Etoys-Squeakland-initialization') ----- - on: anObject list: getListSel selected: getSelectionSel changeSelected: setSelectionSel menu: getMenuSel keystroke: keyActionSel autoExpand: aBoolean - - self setProperty: #autoExpand toValue: aBoolean. - self model: anObject. - getListSelector := getListSel. - getSelectionSelector := getSelectionSel. - setSelectionSelector := setSelectionSel. - getMenuSelector := getMenuSel. - keystrokeActionSelector := keyActionSel. - autoDeselect := true. - self borderWidth: 1. - self list: self getList. - !

1 0

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

09 Jun '23

Marcel Taeumel uploaded a new version of ToolBuilder-Morphic to project The Trunk: http://source.squeak.org/trunk/ToolBuilder-Morphic-mt.344.mcz ==================== Summary ==================== Name: ToolBuilder-Morphic-mt.344 Author: mt Time: 9 June 2023, 1:53:39.558748 pm UUID: 3ee84953-f0e8-db43-85c1-b0c8203d2a1b Ancestors: ToolBuilder-Morphic-ct.343 Complement Morphic-mt.2112 =============== Diff against ToolBuilder-Morphic-ct.343 =============== Item was changed: ----- Method: PluggableTreeMorph>>filterTreeNow (in category 'filtering') ----- filterTreeNow self hasFilter ifFalse: [^ self removeFilter]. "Show all current items again before filtering them out." self items do: [:item | item 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]. + + self itemsChanged.! - - self adjustSubmorphPositions.! 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: [ + self fullBounds. "Compute layout for correct scrolling." self scrollToBottom. self scrollToShow: (selectedMorph bounds outsetBy: (0@vDelta corner: 0@0))].! Item was changed: ----- Method: PluggableTreeMorph>>removeFilter (in category 'filtering') ----- removeFilter "Remove the current filter. Keep the current selection stable unless it is expanded and needs more space for its children. Note that we must not check for #hasFilter here but in the sender if needed; see #filterTreeNow." lastKeystrokes := String empty. self filterMode = #all ifTrue: [ self items do: [:item | item removeFilter]. self collapseAllButSelection] ifFalse: [ self fixateSelectionDuring: [ self items do: [:item | item removeFilter]. + self itemsChanged]]. - self adjustSubmorphPositions]]. "Try to show all children again for the current selection." self scrollSelectionAndChildrenIntoView. self scrollSelectionAndExtraIntoView.! 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]. self items ifEmpty: [^ self]. newSelection := self selectPath: path in: self items first. + self itemsChanged. - self adjustSubmorphPositions. "First adjust, then select to keep selection visible." self selectedMorph: newSelection.! Item was changed: ----- Method: PluggableTreeMorph>>selectPath:in: (in category 'selection') ----- selectPath: path in: listItem + "Private. Use #selectPath: because this here does not invalidate the item's layout for performance reasons." - "Private. Use #selectPath:." listItem withSiblingsDo: [:each | each complexContents item = path first ifTrue: [ each extension visible: true. "Ensure visibility in case of a filter." 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! Item was changed: ----- Method: PluggableTreeMorph>>toggleExpandedState: (in category 'keyboard navigation') ----- toggleExpandedState: aMorph aMorph toggleExpandedState. - self adjustSubmorphPositions. aMorph isExpanded ifTrue: [self scrollSelectionAndChildrenIntoView] ifFalse: [self scrollSelectionAndExtraIntoView].! 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: (self items 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: [ self items detect: [:ea | ea complexContents item == item] ifFound: [:morph | (morph canExpand and: [morph isExpanded not]) ifTrue: [self toggleExpandedState: morph]]. ^ self]].! Item was changed: ----- Method: PluggableTreeMorph>>updateMorph: (in category 'updating') ----- updateMorph: morph morph complexContents refresh. morph refresh. morph isExpanded ifFalse: [self changed] ifTrue: [ morph toggleExpandedState; + toggleExpandedState]. - toggleExpandedState. - self adjustSubmorphPositions]. !

1 0

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

← Newer
1
...
4
5
6
7
8
9
10
...
13
Older →