Packages September 2023

packages@lists.squeakfoundation.org

1 participants
17 discussions

The Trunk: Tools-mt.1234.mcz
by commits＠source.squeak.org 19 Sep '23

19 Sep '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1234.mcz ==================== Summary ==================== Name: Tools-mt.1234 Author: mt Time: 19 September 2023, 3:35:13.083856 pm UUID: 34a15a73-2d28-e04b-857f-21f551b0d53a Ancestors: Tools-mt.1233 In TreeBrowser, show and integrate "missing" classes in the inheritance tree. This can happen if inner super-classes belong to a different category such as for PluggableSystemWindowWithLabelButton. =============== Diff against Tools-mt.1233 =============== Item was changed: Browser subclass: #TreeBrowser + instanceVariableNames: 'parentCategories lastSystemCategoryList lastClassList lastMessageCategoryList isHierarchyMode classForHierarchy lastClassListIndentForHierarchy extraClasses' - instanceVariableNames: 'parentCategories lastSystemCategoryList lastClassList lastMessageCategoryList isHierarchyMode classForHierarchy lastClassListIndentForHierarchy' classVariableNames: 'ShowAllClassesInPackage ShowAllMethodsCategory ShowBlankClassIcons ShowCoreMethodsCategory ShowEmptyPackages' poolDictionaries: '' category: 'Tools-Browser'! !TreeBrowser commentStamp: 'mt 4/13/2023 14:31' prior: 0! Like a regular Smalltalk System Browser, I am a tool that helps explore and modify source code in the system. I am able to detect and show hierarchical structure in class (or system) categories, classes, and message categories (aka. protocols). The class hierarchy is formed by Smalltalk's single inheritance (i.e., #superclass and #subclasses). A hierarchy from any list of categories is derived by splitting dashes ("-") to reveal groups. Type-in filters are expected to work as in regular lists. Class (or system) categories, left-most pane: - Synthetic groups have (parentheses) and are empty - Groups that represent modified Monticello packages have an *asterisk - Groups that represent packages can list all classes in it, see class-side preference - Groups (or entries) that are just categories (i.e. no packages), are set in italic - Type-in filter searches complete hierarchy, including collapsed items Class tree, second-from-left pane: - Complete hierarchy expanded when selecting a different class category, except for "-- all --" category - Type-in filter only searches visible items, not complete hierarchy, for better performance in "-- all --" category - Blank icons disabled by default for better overview, see class-side preference Message categories (or protocols), third-from-left pane: - Synthetic groups have (parentheses) and are empty - All extensions grouped in "-- extensions --" category, which also aggregates all extension methods - Type-in filter searches complete hierarchy, including collapsed items Note that a useful metaphor for category-hierarchies is the file system with its hierarchy of directories. Directories can be empty. Selecting a parent directory does not list the files of all sub-directories. While single-child paths are condensed for clarity, they can still occur when intermediate items are valid categories with content. I also have built-in support for showing a class hierarchy around a specific class, just like the HierarchyBrowser does. I also have built-in support for traits, especially when in hierarchy-mode.! Item was added: + ----- Method: TreeBrowser>>allClassesInCategoryAndOther (in category 'class tree - support') ----- + allClassesInCategoryAndOther + "Like #allClassesInCategory, but adds missing inner classes for a complete-looking inheritance tree." + + | allClasses roots more | + self hasSystemCategorySelected ifFalse: [^ #()]. + self isHierarchy ifTrue: [^ self allClassesForHierarchy]. + + allClasses := self allClassesInCategory. + roots := self classRootsFrom: allClasses. "See #classRoots for the widget callback" + more := Set new. "Which inner classes to add?" + + roots do: [:inner | roots do: [:outer | (inner inheritsFrom: outer) + ifTrue: [ | addMore | + addMore := true. + inner allSuperclassesDo: [:missing | + (addMore := addMore and: [missing ~~ outer]) + ifTrue: [more add: missing] ]] ]]. + + self flag: #ugly. "mt: This is an unexpected side effect and clashes with how #updateTreesIfNeeded works... yet, it does not send a superfluous changed event to the view..." + extraClasses := more asArray. + + ^ more ifEmpty: [allClasses] ifNotEmpty: [allClasses, more asArray]! Item was changed: ----- Method: TreeBrowser>>classLabel: (in category 'class tree') ----- classLabel: aClassOrTrait self isShowingHierarchyOfClass ifTrue: [^ self classLabelForHierarchy: aClassOrTrait]. + + extraClasses isEmpty ifTrue: [ "Not #ifEmpty: to avoid push-closure GC overhead." + ^ aClassOrTrait isTrait + ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] + ifFalse: [aClassOrTrait name]]. + + ^ (extraClasses includes: aClassOrTrait) + ifTrue: [ | label | + "Emphasize that this class does not belong to the currently selected class category." + label := '(', aClassOrTrait name, ')'. + aClassOrTrait isTrait + ifTrue: [label asText addAttribute: TextEmphasis italic] + ifFalse: [label]] + ifFalse: [ + aClassOrTrait isTrait + ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] + ifFalse: [aClassOrTrait name] ]! - - ^ aClassOrTrait isTrait - ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] - ifFalse: [aClassOrTrait name]! Item was changed: ----- Method: TreeBrowser>>classRoots (in category 'class tree') ----- classRoots - | all | self isShowingAllClasses ifTrue: [^ {ProtoObject}]. self isShowingHierarchyOfClass ifTrue: [^ self classRootsForHierarchy]. + ^ self classRootsFrom: lastClassList! - all := lastClassList. - - self flag: #todo. "mt: Can we add a placeholder for missing intermediate superclasses? For example, if a super-super class is in the same category but the super class is not, that class will currently be a root in the tree..." - ^ all select: [:class | all noneSatisfy: [:ea | class superclass == ea]]! Item was added: + ----- Method: TreeBrowser>>classRootsFrom: (in category 'class tree - support') ----- + classRootsFrom: someClasses + + ^ someClasses reject: [:class | someClasses includes: class superclass]! Item was changed: ----- Method: TreeBrowser>>initialize (in category 'initialization') ----- initialize super initialize. parentCategories := Dictionary new. lastSystemCategoryList := #(). + lastClassList := #(). extraClasses := #(). - lastClassList := #(). lastMessageCategoryList := #().! Item was changed: ----- Method: TreeBrowser>>updateClassTree (in category 'updating') ----- updateClassTree + self updateClassTree: self allClassesInCategoryAndOther.! - self updateClassTree: self allClassesInCategory.! Item was changed: ----- Method: TreeBrowser>>updateTreesIfNeeded (in category 'updating') ----- updateTreesIfNeeded | tmp | lastSystemCategoryList = (tmp := self allClassCategories) ifFalse: [self updateSystemCategoryTree: tmp]. + lastClassList = (tmp := self allClassesInCategoryAndOther) - lastClassList = (tmp := self allClassesInCategory) ifFalse: [self updateClassTree: tmp]. lastMessageCategoryList = (tmp := self allMessageCategories) ifFalse: [self updateMessageCategoryTree: tmp].! Item was changed: + (PackageInfo named: 'Tools') postscript: '"Initialize new instVar in all existing tree browsers." + TreeBrowser allInstancesDo: [:tb | tb instVarNamed: ''extraClasses'' put: #()].'! - (PackageInfo named: 'Tools') postscript: 'SystemBrowser default: TreeBrowser.'!

1 0

The Trunk: Morphic-mt.2129.mcz
by commits＠source.squeak.org 19 Sep '23

19 Sep '23

Marcel Taeumel uploaded a new version of Morphic to project The Trunk: http://source.squeak.org/trunk/Morphic-mt.2129.mcz ==================== Summary ==================== Name: Morphic-mt.2129 Author: mt Time: 19 September 2023, 9:56:14.547349 am UUID: 88ff3046-2fb5-3546-ac13-948c116518d7 Ancestors: Morphic-mt.2128 Fix an annoying layout issue where a flaky answer to #minExtent in a ScrollPane resulted in a (table-)layouted sibling that as height-for-width properties to not be finished after its second layout run. For example: Create any container (morph) with a TableLayout and add two children (or submorphs), one a ScrollPane and one a PluggableTextMorph. Let them be #spaceFill in all directions except for the text widget, which should #shrinkWrap for #vReszing (and #wrapFlag be true like the MorphicToolBuilder does implementing #softLineWrap in #buildPluggableText:). Now, if scrollbars are set to #whenNeeded, a too tiny container and that scrollpane with a not-too-small-not-too-big scrollable content (morph) will change #layoutBounds after the first layout run, which should not be. Morph >> #minExtent expects a steady answer between two runs (see senders of #doLayoutAgain to understand that two-pass mechanism). So, the original override of #innerBounds (from 2015!... by me :o), which is needed by #layoutBounds, in ScrollPane was conceptually wrong. Even if ScrollPane implements its own layout strategy without using a #layoutPolicy, those #layoutBounds affect all the receiver's things: two scrollbars and the scroller. Not just the scroller. Rename the calculation and use it as #newScrollerBounds. Even if this change has no super-serious implications in past projects, I will backport it to Squeak 6.0 so that people can create more interactive tools and combine PluggableScrollPane and PluggableTextMorph there. We currently do this in a University-related project. :-) =============== Diff against Morphic-mt.2128 =============== Item was removed: - ----- Method: ScrollPane>>innerBounds (in category 'geometry') ----- - innerBounds - - | inner bottomOffset leftOffset rightOffset | - (retractableScrollBar or: [self vIsScrollbarShowing not]) - ifTrue: [leftOffset := rightOffset := 0] - ifFalse: [ - scrollBarOnLeft - ifTrue: [ - leftOffset := self scrollBarThickness - self borderWidth. - rightOffset := 0.] - ifFalse: [ - leftOffset := 0. - rightOffset := self scrollBarThickness - self borderWidth]]. - - (retractableScrollBar or: [self hIsScrollbarShowing not]) - ifTrue: [bottomOffset := 0] - ifFalse: [bottomOffset := self scrollBarThickness - self borderWidth]. - - inner := super innerBounds. - ^ (inner left + leftOffset) @ (inner top "+ topOffset") - corner: (inner right - rightOffset) @ (inner bottom - bottomOffset)! Item was added: + ----- Method: ScrollPane>>newScrollerBounds (in category 'layout') ----- + newScrollerBounds + "Answer the new bounds for the receiver's scrolling area. Should be called after a #layoutChanged." + + | inner bottomOffset leftOffset rightOffset | + (retractableScrollBar or: [self vIsScrollbarShowing not]) + ifTrue: [leftOffset := rightOffset := 0] + ifFalse: [ + scrollBarOnLeft + ifTrue: [ + leftOffset := self scrollBarThickness - self borderWidth. + rightOffset := 0.] + ifFalse: [ + leftOffset := 0. + rightOffset := self scrollBarThickness - self borderWidth]]. + + (retractableScrollBar or: [self hIsScrollbarShowing not]) + ifTrue: [bottomOffset := 0] + ifFalse: [bottomOffset := self scrollBarThickness - self borderWidth]. + + inner := self innerBounds. + ^ (inner left + leftOffset) @ (inner top "+ topOffset") + corner: (inner right - rightOffset) @ (inner bottom - bottomOffset)! Item was changed: ----- Method: ScrollPane>>resizeScroller (in category 'layout - resizing') ----- resizeScroller scroller + bounds: self newScrollerBounds; - bounds: self layoutBounds; fullBounds. "To make #shrinkWrap work."! Item was changed: ----- 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 newScrollerBounds. - scroller privateBounds: self layoutBounds. doLayout ifTrue: [scroller fullBounds] ifFalse: [scroller privateFullBounds: scroller bounds].!

1 0

The Trunk: CollectionsTests-mt.400.mcz
by commits＠source.squeak.org 14 Sep '23

14 Sep '23

Marcel Taeumel uploaded a new version of CollectionsTests to project The Trunk: http://source.squeak.org/trunk/CollectionsTests-mt.400.mcz ==================== Summary ==================== Name: CollectionsTests-mt.400 Author: mt Time: 14 September 2023, 4:59:34.513231 pm UUID: 5252ed4b-a931-1e41-b067-28f86244d942 Ancestors: CollectionsTests-mt.399 Complements Collections-mt.1050 =============== Diff against CollectionsTests-mt.399 =============== Item was added: + ----- Method: TextTest>>test09AddAttributeFromToChecking (in category 'tests') ----- + test09AddAttributeFromToChecking + + | attribute | + attribute := TextEmphasis bold. + + #( + 'abc' -5 10 "negative start, stop behind end of content" + 'abc' 10 15 "both start and stop behind end of content" + 'abc' 2 1 "start behind stop" + 'abc' 15 10 "start behind stop and both behind content" + 'abc' 10 1 "start behind stop and start behind content" + '' 1 2 "empty string" + ) groupsDo: [:content :start :stop | + | text | + text := Text fromString: content. + text addAttribute: attribute from: start to: stop. + self assert: text size equals: text runs size].! Item was added: + ----- Method: TextTest>>test10RemoveAttributeFromToChecking (in category 'tests') ----- + test10RemoveAttributeFromToChecking + + | attribute | + attribute := TextEmphasis bold. + + #( + 'abc' -5 10 "negative start, stop behind end of content" + 'abc' 10 15 "both start and stop behind end of content" + 'abc' 2 1 "start behind stop" + 'abc' 15 10 "start behind stop and both behind content" + 'abc' 10 1 "start behind stop and start behind content" + '' 1 2 "empty string" + ) groupsDo: [:content :start :stop | + | text | + text := Text string: content attribute: attribute. + text removeAttribute: attribute from: start to: stop. + self assert: text size equals: text runs size].! Item was changed: + ----- Method: TextTest>>testLineCorrespondingToIndex (in category 'tests - lines') ----- - ----- Method: TextTest>>testLineCorrespondingToIndex (in category 'tests -lines ') ----- testLineCorrespondingToIndex | sampleText | sampleText := 'Fred the Bear' asTextFromHtml. self flag: #forLater. "do not re- and enable common attributes in HtmlReadWriter" self assert: 'the' equals: (sampleText lineCorrespondingToIndex: (sampleText indexOf: $h)) printHtmlString. self assert: 'Bear' equals: (sampleText lineCorrespondingToIndex: (sampleText indexOf: $B)) printHtmlString. self assert: 'Fred' equals: (sampleText lineCorrespondingToIndex: (sampleText indexOf: $d)) printHtmlString.! Item was changed: + ----- Method: TextTest>>testLineCount (in category 'tests - lines') ----- - ----- Method: TextTest>>testLineCount (in category 'tests -lines ') ----- testLineCount | sampleText | sampleText := 'Fred the Bear' asTextFromHtml. self assert: 3 equals: sampleText lineCount.! Item was changed: + ----- Method: TextTest>>testLineNumber (in category 'tests - lines') ----- - ----- Method: TextTest>>testLineNumber (in category 'tests -lines ') ----- testLineNumber | sampleText | sampleText := 'Fred the Bear' asTextFromHtml. self flag: #forLater. "do not re- and enable common attributes in HtmlReadWriter" self assert: 'the' equals: (sampleText lineNumber: 2) printHtmlString.! Item was changed: + ----- Method: TextTest>>testLines (in category 'tests - lines') ----- - ----- Method: TextTest>>testLines (in category 'tests -lines ') ----- testLines | html text lines | html := 'Fred', String cr , 'the' , String lf , 'Bear'. text := (HtmlReadWriter on: html readStream) breakLines: false; nextText. lines := text lines. self assert: (#('Fred' 'the' 'Bear') collect: #asTextFromHtml) equals: lines.!

1 0

The Trunk: Collections-mt.1050.mcz
by commits＠source.squeak.org 14 Sep '23

14 Sep '23

Marcel Taeumel uploaded a new version of Collections to project The Trunk: http://source.squeak.org/trunk/Collections-mt.1050.mcz ==================== Summary ==================== Name: Collections-mt.1050 Author: mt Time: 14 September 2023, 4:59:12.295231 pm UUID: e3a36b63-6434-b140-bf66-44d075d72970 Ancestors: Collections-mt.1049 In texts, invalid intervals for add/remove text attributes violated the contract that the size of a text's runs equals that text's content/string size. Fix that by clamping those intervals to the content size. I wonder if #copyFrom:to: and #copyReplaceFrom:to:with: need a similar protection... Nicolas? Levente? :-) =============== Diff against Collections-mt.1049 =============== Item was changed: ----- Method: Text>>addAttribute:from:to: (in category 'emphasis') ----- addAttribute: att from: start to: stop "Set the attribute for characters in the interval start to stop." + + | stringSize realStart realStop | + (stringSize := self size) = 0 ifTrue: [^ self]. + start < 1 + ifTrue: [realStart := 1] + ifFalse: [realStart := start min: stringSize]. + stop > self size + ifTrue: [realStop := stringSize] + ifFalse: [realStop := stop max: realStart]. + runs := runs copyReplaceFrom: realStart to: realStop + with: ((runs copyFrom: realStart to: realStop) - runs := runs copyReplaceFrom: start to: stop - with: ((runs copyFrom: start to: stop) replace: [:attributes | Text addAttribute: att toArray: attributes]) ! Item was changed: ----- Method: Text>>removeAttribute:from:to: (in category 'emphasis') ----- removeAttribute: att from: start to: stop "Remove the attribute over the interval start to stop." + + | stringSize realStart realStop | + (stringSize := self size) = 0 ifTrue: [^ self]. + start < 1 + ifTrue: [realStart := 1] + ifFalse: [realStart := start min: stringSize]. + stop > self size + ifTrue: [realStop := stringSize] + ifFalse: [realStop := stop max: realStart]. + runs := runs copyReplaceFrom: realStart to: realStop + with: ((runs copyFrom: realStart to: realStop) - runs := runs copyReplaceFrom: start to: stop - with: ((runs copyFrom: start to: stop) replace: [:attributes | attributes copyWithout: att]) !

1 0

The Trunk: Kernel-mt.1525.mcz
by commits＠source.squeak.org 14 Sep '23

14 Sep '23

Marcel Taeumel uploaded a new version of Kernel to project The Trunk: http://source.squeak.org/trunk/Kernel-mt.1525.mcz ==================== Summary ==================== Name: Kernel-mt.1525 Author: mt Time: 14 September 2023, 4:17:08.281231 pm UUID: 50a3746a-fb06-d246-9548-fe7d0d44b4c6 Ancestors: Kernel-eem.1524 Since the addition of #sanitizeName: in class organizations, we forgot to clean-up existing mistakes, which makes those misspelled categories un-browse-able ... neither in TreeBrowser nor in Browser. Fix that now. =============== Diff against Kernel-eem.1524 =============== Item was added: + ----- Method: Categorizer>>sanitizeAllNames (in category 'private') ----- + sanitizeAllNames + + categoryArray ifNotNil: [ + categoryArray := categoryArray collect: [:name | self sanitizeName: name]].! Item was changed: (PackageInfo named: 'Kernel') postscript: '"Make sure the 4th inst var of Process is threadAffinity, not threadId" - (Process instVarNames at: 4) = ''threadId'' ifTrue: + [Process instVarNames at: 4 put: ''threadAffinity'' copy]. + + "Sanitize all existing message categories so that they can be browsed again." + Smalltalk allClassesAndTraitsDo: [:classOrTrait | + classOrTrait organization sanitizeAllNames. + classOrTrait class organization sanitizeAllNames].'! - [Process instVarNames at: 4 put: ''threadAffinity'' copy]'!

1 0

The Trunk: Tools-mt.1233.mcz
by commits＠source.squeak.org 13 Sep '23

13 Sep '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1233.mcz ==================== Summary ==================== Name: Tools-mt.1233 Author: mt Time: 13 September 2023, 5:21:03.767147 pm UUID: 559d5f03-8a7b-8c49-9021-a9570350c6cb Ancestors: Tools-mt.1232 In treebrowser, quick-fix for missing classses with inconsistent category layout. It now matches the original behavior in Browser but is still not very user friendly. See #todo flag comment in the code. =============== Diff against Tools-mt.1232 =============== Item was changed: ----- Method: TreeBrowser>>classRoots (in category 'class tree') ----- classRoots | all | self isShowingAllClasses ifTrue: [^ {ProtoObject}]. self isShowingHierarchyOfClass ifTrue: [^ self classRootsForHierarchy]. all := lastClassList. + + self flag: #todo. "mt: Can we add a placeholder for missing intermediate superclasses? For example, if a super-super class is in the same category but the super class is not, that class will currently be a root in the tree..." + ^ all select: [:class | all noneSatisfy: [:ea | class superclass == ea]]! - - ^ all select: [:class | all noneSatisfy: [:ea | class inheritsFrom: ea]]!

1 0

The Trunk: ToolsTests-mt.123.mcz
by commits＠source.squeak.org 13 Sep '23

13 Sep '23

Marcel Taeumel uploaded a new version of ToolsTests to project The Trunk: http://source.squeak.org/trunk/ToolsTests-mt.123.mcz ==================== Summary ==================== Name: ToolsTests-mt.123 Author: mt Time: 13 September 2023, 4:02:00.258147 pm UUID: 4cc4562c-0922-cf40-a784-654b46732b17 Ancestors: ToolsTests-mt.122 Adds a test that documents whether the TreeBrowser still hides classes due to strange class-category layout. =============== Diff against ToolsTests-mt.122 =============== Item was added: + ----- Method: TreeBrowserTest>>testClassListNoMissing (in category 'tests - system category list') ----- + testClassListNoMissing + "Check whether the tree of classes is complete for each class category. This means that also classes with missing intermediate parents are there somehow." + + | allIssues | + allIssues := OrderedCollection new. + + browser systemOrganizer categories do: [:cat | + | expected found toCheck | + browser selectSystemCategory: cat. + expected := browser allClassesInCategory. + found := #() asOrderedCollection. + toCheck := browser classRoots asOrderedCollection. + [toCheck notEmpty] whileTrue: [ + found addLast: toCheck removeFirst. + toCheck addAll: (browser classChildren: found last)]. + (expected copyWithoutAll: found) ifNotEmpty: [:issues | + allIssues add: cat -> issues]]. + + self + assert: allIssues isEmpty + description: ('{1} classes missing in {2} categories.' + format: {allIssues inject: 0 into: [:sum :issue | sum + issue value size]. allIssues size}).!

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

Packages September 2023