Squeak-dev May 2023

squeak-dev@lists.squeakfoundation.org

16 participants
109 discussions

FileStream vs StandardFileStream
by christoph.thiede＠student.hpi.uni-potsdam.de 18 May '23

18 May '23

Hi all, this feels like a FAQ, but I could not find an answer to it in the image or in the list: In terms of semantics and best practices, when should you use FileStream vs StandardFileStream? Apparently, FileStream redirects to MultiByteFileStream whereas StandardFileStream processes each byte independently, so only the first one seems to be able to handle UTF8 encoding. I wonder which of them we should normally use in Squeak. Currently usage seems to be inconsistent - for instance, ZipArchive or Squeak-FileSystem use StandardFileStream while ChangeList and FileDirectory use FileStream. Thanks in advance! Best, Christoph --- Sent from Squeak Inbox Talk

5 5

The Trunk: System-ct.1413.mcz
by commits＠source.squeak.org 17 May '23

17 May '23

Christoph Thiede uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-ct.1413.mcz ==================== Summary ==================== Name: System-ct.1413 Author: ct Time: 17 May 2023, 9:08:47.042764 pm UUID: 91cf1af6-3f19-9c4b-98e9-0c45f6736c83 Ancestors: System-eem.1412 Minor refactoring: Adds lazy accessors for text attribute constants on TextDiffBuilder and exposes them to other objects. =============== Diff against System-eem.1412 =============== Item was changed: ----- Method: TextDiffBuilder>>buildDisplayPatch (in category 'creating patches') ----- buildDisplayPatch | stream result | stream := AttributedTextStream new. - "Lazy initialize the text attributes cache." - NormalTextAttributes ifNil: [NormalTextAttributes := self userInterfaceTheme normalTextAttributes - ifNil: [{TextEmphasis normal}]]. - InsertTextAttributes ifNil: [InsertTextAttributes := self userInterfaceTheme insertTextAttributes - ifNil: [{TextColor red}]]. - RemoveTextAttributes ifNil: [RemoveTextAttributes := self userInterfaceTheme removeTextAttributes - ifNil: [{TextEmphasis struckOut. TextColor blue}]]. - self patchSequenceDoIfMatch: [ :string | + self print: string withAttributes: self normalTextAttributes on: stream ] - self print: string withAttributes: NormalTextAttributes on: stream ] ifInsert: [ :string | + self print: string withAttributes: self insertTextAttributes on: stream ] - self print: string withAttributes: InsertTextAttributes on: stream ] ifRemove: [ :string | + self print: string withAttributes: self removeTextAttributes on: stream ]. - self print: string withAttributes: RemoveTextAttributes on: stream ]. result := stream contents. (result notEmpty and: [result last = Character cr and: [(self lastIsCR: xLines) not and: [(self lastIsCR: yLines) not]]]) ifTrue: [result := result allButLast]. ^result! Item was added: + ----- Method: TextDiffBuilder>>insertTextAttributes (in category 'accessing') ----- + insertTextAttributes + + ^ InsertTextAttributes ifNil: [InsertTextAttributes := + self userInterfaceTheme insertTextAttributes + ifNil: [{TextColor red}]]! Item was added: + ----- Method: TextDiffBuilder>>normalTextAttributes (in category 'accessing') ----- + normalTextAttributes + + ^ NormalTextAttributes ifNil: [NormalTextAttributes := + self userInterfaceTheme normalTextAttributes + ifNil: [{TextEmphasis normal}]]! Item was added: + ----- Method: TextDiffBuilder>>removeTextAttributes (in category 'accessing') ----- + removeTextAttributes + + ^ RemoveTextAttributes ifNil: [RemoveTextAttributes := + self userInterfaceTheme removeTextAttributes + ifNil: [{TextEmphasis struckOut. TextColor blue}]]!

1 0

The Trunk: CommandLine-ct.23.mcz
by commits＠source.squeak.org 17 May '23

17 May '23

Christoph Thiede uploaded a new version of CommandLine to project The Trunk: http://source.squeak.org/trunk/CommandLine-ct.23.mcz ==================== Summary ==================== Name: CommandLine-ct.23 Author: ct Time: 17 May 2023, 8:58:20.218764 pm UUID: c5a67244-b81f-5e41-baae-cb17152bdaa8 Ancestors: CommandLine-mt.22 To DummyUIManager, adds missing selectors from super. (Note that #openPluggableFileList:label:in: is only available when 60Deprecated is loaded. We seem to want to deprecate that anyway, see https://lists.squeakfoundation.org/archives/list/squeak-dev@lists.squeakfou….) =============== Diff against CommandLine-mt.22 =============== Item was added: + ----- Method: DummyUIManager>>chooseFileMatching:label: (in category 'ui requests') ----- + chooseFileMatching: patterns label: labelString + self askForProvidedAnswerTo: labelString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>chooseFileMatchingSuffixes:label: (in category 'ui requests') ----- + chooseFileMatchingSuffixes: suffixList label: labelString + self askForProvidedAnswerTo: labelString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>chooseFont:for:setSelector:getSelector: (in category 'ui requests') ----- + chooseFont: titleString for: aModel setSelector: setSelector getSelector: getSelector + self askForProvidedAnswerTo: titleString ifSupplied: [:answer | + ^ answer]. + + ^ nil! Item was added: + ----- Method: DummyUIManager>>confirm:orCancel:title: (in category 'ui requests') ----- + confirm: aString orCancel: cancelBlock title: titleString + + ^ self confirm: aString orCancel: cancelBlock! Item was added: + ----- Method: DummyUIManager>>confirm:title: (in category 'ui requests') ----- + confirm: aString title: titleString + + ^ self confirm: aString! Item was added: + ----- Method: DummyUIManager>>confirm:title:trueChoice:falseChoice: (in category 'ui requests') ----- + confirm: queryString title: titleString trueChoice: trueChoice falseChoice: falseChoice + + ^ self confirm: queryString title: titleString! Item was added: + ----- Method: DummyUIManager>>confirm:trueChoice:falseChoice: (in category 'ui requests') ----- + confirm: queryString trueChoice: trueChoice falseChoice: falseChoice + + ^ self confirm: queryString! Item was added: + ----- Method: DummyUIManager>>multiLineRequest:centerAt:initialAnswer:answerHeight: (in category 'ui requests') ----- + multiLineRequest: queryString centerAt: aPoint initialAnswer: defaultAnswer answerHeight: answerHeight + + ^ self request: queryString initialAnswer: defaultAnswer!

1 0

[Repair] ElGamalTest updated to convert to ByteArray
by rabbit 17 May '23

17 May '23

Hi Levente, your recent change to #hashMessage: broke a ElGamal test, so this repairs it. The issue was the test was trying to hash a LargePositiveInteger, coming from SecureRandom. I convert prior to hashing. I am attaching the fileOut. Furthermore, the package is updated > CryptographySignaturesTests-rabbt.2.mcz Finally, I have updated both ProCrypto,release.2 and ProCrypto.release.3 to reflect this and other changes. 371 tests #green. Yay! Stable baseline so I can now develop the v3.9 ParrotTalk protocol... ❤️‍🔥🐰

1 2

The Trunk: Tools-ct.1205.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Christoph Thiede uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-ct.1205.mcz ==================== Summary ==================== Name: Tools-ct.1205 Author: ct Time: 16 May 2023, 3:08:40.675819 pm UUID: 395ea534-e351-d84f-a1a4-4adeea3bb135 Ancestors: Tools-mt.1204 Fixes inheritance button color in browsers when selecting the first message (regression from Tools-mt.1193). #inheritanceButtonColor depends on currentCompiledMethod which is updated in #contentsChanged. =============== Diff against Tools-mt.1204 =============== Item was changed: ----- Method: Browser>>selectClassNamed: (in category 'class list') ----- selectClassNamed: aSymbolOrString | className currentMessageCategoryName currentMessageName | currentMessageCategoryName := [self selectedMessageCategoryName] on: Error do: [:ex| ex return: nil]. currentMessageName := [self selectedMessageName] on: Error do: [:ex| ex return: nil]. selectedClassName := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. self setClassOrganizer. self setClassDefinition. "Try to reselect the category and/or selector if the new class has them." selectedMessageCategoryName :=(self messageCategoryList includes: currentMessageCategoryName) ifTrue: [currentMessageCategoryName] ifFalse: [nil]. selectedMessageName := (self messageList includes: currentMessageName) ifTrue: [currentMessageName] ifFalse: [nil]. self hasMessageSelected ifTrue: [self editSelection: #editMessage] ifFalse: [self hasMessageCategorySelected ifTrue: [self editSelection: #newMessage] ifFalse: [self classCommentIndicated ifTrue: [self editSelection: #editComment] ifFalse: [self editSelection: (self hasClassSelected not ifTrue: [(metaClassIndicated or: [ self hasSystemCategorySelected not ]) ifTrue: [#none] ifFalse: [#newClass]] ifFalse: [#editClass])]]]. contents := nil. self selectedClass isNil ifFalse: [className := self selectedClass name. (RecentClasses includes: className) ifTrue: [RecentClasses remove: className]. RecentClasses addFirst: className. RecentClasses size > 16 ifTrue: [RecentClasses removeLast]]. self changed: #classSelectionChanged. self changed: #classCommentText. self changed: #classListIndex. "update my selection" self changed: #messageCategoryList. self changed: #messageList. self changed: #relabel. self changed: #selectedSystemCategoryName. + self contentsChanged; decorateButtons.! - self decorateButtons; contentsChanged! Item was changed: ----- Method: Browser>>selectMessageNamed: (in category 'message list') ----- selectMessageNamed: aSymbolOrString | name | name := aSymbolOrString ifNotNil: [ aSymbolOrString asSymbol ]. selectedMessageName := name. self editSelection: (name notNil ifTrue: [#editMessage] ifFalse: [self messageCategoryListIndex > 0 ifTrue: [#newMessage] ifFalse: [self hasClassSelected ifTrue: [#editClass] ifFalse: [#newClass]]]). contents := nil. self changed: #messageListIndex. "update my selection" + self contentsChanged; decorateButtons.! - self decorateButtons; contentsChanged.!

1 0

The Trunk: Tools-mt.1202.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1202.mcz ==================== Summary ==================== Name: Tools-mt.1202 Author: mt Time: 15 May 2023, 12:54:53.997855 pm UUID: 0343153d-f5dc-d947-94b0-d3ebed3da962 Ancestors: Tools-mt.1201 Some tweaks for the TreeBrowser: - generic icon for classes help retain the visible hierarchy without a blank gap, making it possible to mix classes that have special icons (e.g., collection or morph) with ones that have not - both '-- all --' and '-- core --' can now be switched off to get two more rows in message-category pane; no selection still means '-- all --' - now, no selection in system-category pane also means 'all classes' - fixes #findMethod when browsing the entire class tree via '-- all --' =============== Diff against Tools-mt.1201 =============== Item was changed: ----- Method: Browser>>findMethod (in category 'class functions') ----- findMethod "Pop up a list of the current class's methods, and select the one chosen by the user" | aClass selectors reply cat messageCatIndex messageIndex | + self hasClassSelected ifFalse: [^ self]. - self classListIndex = 0 ifTrue: [^ self]. self okToChange ifFalse: [^ self]. aClass := self selectedClassOrMetaClass. selectors := aClass selectors sorted. selectors isEmpty ifTrue: [self inform: aClass name, ' has no methods.'. ^ self]. reply := UIManager default chooseFrom: selectors values: selectors lines: #(1). reply ifNil: [^ self]. cat := aClass whichCategoryIncludesSelector: reply. messageCatIndex := self messageCategoryList indexOf: cat. self messageCategoryListIndex: messageCatIndex. messageIndex := (self messageList indexOf: reply). self messageListIndex: messageIndex! Item was added: + ----- Method: ToolIcons class>>genericClass (in category 'private') ----- + genericClass + "© 2023 Marcel Taeumel" + + ^ Form fromBinaryStream: (Base64MimeConverter mimeDecodeToBytes: 'iVBORw0KGgoAAAANSUhEUgAAAAwAAAAMCAYAAABWdVznAAAFEGlUWHRYTUw6Y29tLmFkb2Jl + LnhtcAAAAAAAPD94cGFja2V0IGJlZ2luPSLvu78iIGlkPSJXNU0wTXBDZWhpSHpyZVN6TlRj + emtjOWQiPz4KPHg6eG1wbWV0YSB4bWxuczp4PSJhZG9iZTpuczptZXRhLyIgeDp4bXB0az0i + WE1QIENvcmUgNS41LjAiPgogPHJkZjpSREYgeG1sbnM6cmRmPSJodHRwOi8vd3d3LnczLm9y + Zy8xOTk5LzAyLzIyLXJkZi1zeW50YXgtbnMjIj4KICA8cmRmOkRlc2NyaXB0aW9uIHJkZjph + Ym91dD0iIgogICAgeG1sbnM6eG1wPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvIgog + ICAgeG1sbnM6cGhvdG9zaG9wPSJodHRwOi8vbnMuYWRvYmUuY29tL3Bob3Rvc2hvcC8xLjAv + IgogICAgeG1sbnM6ZXhpZj0iaHR0cDovL25zLmFkb2JlLmNvbS9leGlmLzEuMC8iCiAgICB4 + bWxuczp0aWZmPSJodHRwOi8vbnMuYWRvYmUuY29tL3RpZmYvMS4wLyIKICAgIHhtbG5zOnht + cE1NPSJodHRwOi8vbnMuYWRvYmUuY29tL3hhcC8xLjAvbW0vIgogICAgeG1sbnM6c3RFdnQ9 + Imh0dHA6Ly9ucy5hZG9iZS5jb20veGFwLzEuMC9zVHlwZS9SZXNvdXJjZUV2ZW50IyIKICAg + eG1wOkNyZWF0ZURhdGU9IjIwMjMtMDUtMTVUMTE6Mzc6NTUrMDIwMCIKICAgeG1wOk1vZGlm + eURhdGU9IjIwMjMtMDUtMTVUMTI6NDU6MzMrMDI6MDAiCiAgIHhtcDpNZXRhZGF0YURhdGU9 + IjIwMjMtMDUtMTVUMTI6NDU6MzMrMDI6MDAiCiAgIHBob3Rvc2hvcDpEYXRlQ3JlYXRlZD0i + MjAyMy0wNS0xNVQxMTozNzo1NSswMjAwIgogICBwaG90b3Nob3A6Q29sb3JNb2RlPSIzIgog + ICBwaG90b3Nob3A6SUNDUHJvZmlsZT0ic1JHQiBJRUM2MTk2Ni0yLjEiCiAgIGV4aWY6UGl4 + ZWxYRGltZW5zaW9uPSIxMiIKICAgZXhpZjpQaXhlbFlEaW1lbnNpb249IjEyIgogICBleGlm + OkNvbG9yU3BhY2U9IjEiCiAgIHRpZmY6SW1hZ2VXaWR0aD0iMTIiCiAgIHRpZmY6SW1hZ2VM + ZW5ndGg9IjEyIgogICB0aWZmOlJlc29sdXRpb25Vbml0PSIyIgogICB0aWZmOlhSZXNvbHV0 + aW9uPSI3Mi8xIgogICB0aWZmOllSZXNvbHV0aW9uPSI3Mi8xIj4KICAgPHhtcE1NOkhpc3Rv + cnk+CiAgICA8cmRmOlNlcT4KICAgICA8cmRmOmxpCiAgICAgIHN0RXZ0OmFjdGlvbj0icHJv + ZHVjZWQiCiAgICAgIHN0RXZ0OnNvZnR3YXJlQWdlbnQ9IkFmZmluaXR5IFBob3RvIDIuMC4z + IgogICAgICBzdEV2dDp3aGVuPSIyMDIzLTA1LTE1VDEyOjQ1OjMzKzAyOjAwIi8+CiAgICA8 + L3JkZjpTZXE+CiAgIDwveG1wTU06SGlzdG9yeT4KICA8L3JkZjpEZXNjcmlwdGlvbj4KIDwv + cmRmOlJERj4KPC94OnhtcG1ldGE+Cjw/eHBhY2tldCBlbmQ9InIiPz7/kf7jAAABgGlDQ1Bz + UkdCIElFQzYxOTY2LTIuMQAAKJF1kbtLA0EQh79Eg28iaGFhEUStVHxA0MYiwReoRXKCryY5 + 7xIhj+PuggRbwVZQEG18FfoXaCtYC4KiCGKrtaKNhnPOCBExs8zOt7/dGXZnwauk1LRV2Qvp + jG1GxkKB2bn5QNUTPvzU0EZrTLWMqeioQll7v8Xjxutut1b5c/9a3ZJmqeCpFh5WDdMWHhee + XLENl7eEm9VkbEn4RLjLlAsK37h6vMjPLieK/OmyqUTC4G0UDiR+cfwXq0kzLSwvpz2dyqk/ + 93FfUq9lZqIS28RbsYgwRogAE4wQJkgfQzIH6aafHllRJr/3O3+arOSqMhvkMVkmQRKbLlFz + Ul2TqIuuyUiRd/v/t6+WPtBfrF4fAt+j47x2QNUmFDYc5+PAcQqHUPEA55lSfnYfBt9E3yhp + 7XvgX4PTi5IW34azdWi5N2Jm7FuqEPfqOrwcQ8McNF1B7UKxZz/7HN2BsipfdQk7u9Ap5/2L + X15rZ+IS+wnUAAAACXBIWXMAAAsTAAALEwEAmpwYAAAAd0lEQVQokZWR0Q3AIAhEoXGwm8Np + mcMBcAz7BQFKm/S+RN+FA5mKzjkn1szMsR4VXmsREZGq+l00cYUNjALgnbiDATgsIsnkkSw6 + AIc6XXbYe79CreFLca5RH0WkncGUttRlV1Wac+YtdSaLEeGHwUwpQvnp37oBWg9Q90fgLz4A + AAAASUVORK5CYII=' readStream)! Item was changed: Browser subclass: #TreeBrowser instanceVariableNames: 'parentCategories lastSystemCategoryList lastClassList lastMessageCategoryList isHierarchyMode classForHierarchy lastClassListIndentForHierarchy' + classVariableNames: 'ShowAllClassesInPackage ShowAllMethodsCategory ShowBlankClassIcons ShowCoreMethodsCategory ShowEmptyPackages' - classVariableNames: 'ShowAllClassesInPackage ShowBlankClassIcons 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 class>>showAllMethodsCategory (in category 'preferences') ----- + showAllMethodsCategory + <preference: 'Show ''-- all --'' entry in message-category list in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, an ''-- all --'' category can be selected to show selectors of all methods in the selected class. Note that having no selection will also show all methods in that class.' + type: #Boolean> + + ^ ShowAllMethodsCategory ifNil: [true]! Item was added: + ----- Method: TreeBrowser class>>showAllMethodsCategory: (in category 'preferences') ----- + showAllMethodsCategory: aBooleanOrNil + + ShowAllMethodsCategory == aBooleanOrNil ifTrue: [^ self]. + ShowAllMethodsCategory := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateMessageCategoryTree].! Item was changed: ----- Method: TreeBrowser class>>showBlankClassIcons (in category 'preferences') ----- showBlankClassIcons + <preference: 'Show generic class icons in Tree Browser' - <preference: 'Show blank class icons in Tree Browser' categoryList: #(Morphic Tools Browsing) + description: 'When true, classes with no distinct icon will get a generic icon. Note that #showClassIcons must be enabled for this to have an effect.' - description: 'When true, classes with no distinct icon will get a blank icon, which makes such labels wider and might obfuscate hierarchy indication. Note that #showClassIcons must be enabled for this to have an effect.' type: #Boolean> + ^ ShowBlankClassIcons ifNil: [true]! - ^ ShowBlankClassIcons ifNil: [false]! Item was added: + ----- Method: TreeBrowser class>>showCoreMethodsCategory (in category 'preferences') ----- + showCoreMethodsCategory + <preference: 'Show ''-- core --'' entry in message-category list in Tree Browser' + categoryList: #(Morphic Tools Browsing) + description: 'When true, a ''-- core --'' category can be selected to show selectors of all methods that are no extensions in the selected class.' + type: #Boolean> + + ^ ShowCoreMethodsCategory ifNil: [true]! Item was added: + ----- Method: TreeBrowser class>>showCoreMethodsCategory: (in category 'preferences') ----- + showCoreMethodsCategory: aBooleanOrNil + + ShowCoreMethodsCategory == aBooleanOrNil ifTrue: [^ self]. + ShowCoreMethodsCategory := aBooleanOrNil. + + self allInstancesDo: [:treeBrowser | treeBrowser updateMessageCategoryTree].! Item was changed: ----- Method: TreeBrowser>>classChildren: (in category 'class tree') ----- classChildren: aClass | all | + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ aClass subclasses sortedSafely]. + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classChildrenForHierarchy: aClass]. all := lastClassList. ^ all select: [:subclass | subclass superclass == aClass]! Item was changed: ----- Method: TreeBrowser>>classHasChildren: (in category 'class tree') ----- classHasChildren: aClass aClass == Class "... ProtoObject class ..." ifTrue: [^ false]. + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ aClass subclasses notEmpty]. + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classHasChildrenForHierarchy: aClass]. ^ lastClassList includesAnyOf: aClass subclasses! Item was changed: ----- Method: TreeBrowser>>classIcon: (in category 'class tree') ----- classIcon: aClass "Answer 'nil' instead of blank icon to keep the tree widget compact." | iconName | self class showClassIcons ifFalse: [^ nil]. ^ ((iconName := ToolIcons iconForClass: aClass name) ~~ #blank or: [ShowBlankClassIcons == true]) + ifTrue: [ToolIcons iconNamed: (iconName == #blank ifTrue: [#genericClass] ifFalse: [iconName])]! - ifTrue: [ToolIcons iconNamed: iconName]! Item was changed: ----- Method: TreeBrowser>>classLabel: (in category 'class tree') ----- classLabel: aClassOrTrait + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classLabelForHierarchy: aClassOrTrait]. ^ aClassOrTrait isTrait ifTrue: [aClassOrTrait name asText addAttribute: TextEmphasis italic] ifFalse: [aClassOrTrait name]! Item was changed: ----- Method: TreeBrowser>>classPath (in category 'class tree') ----- classPath + self isShowingHierarchyOfClass - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classPathForHierarchy]. ^ self selectedClass ifNotNil: [:cls | | roots shouldAdd | roots := self classRoots asSet. shouldAdd := true. (Array streamContents: [:s | cls withAllSuperclassesDo: [:ea | shouldAdd ifTrue: [s nextPut: ea]. (roots includes: ea) ifTrue: [shouldAdd := false]]]) reversed]! Item was changed: ----- Method: TreeBrowser>>classRoots (in category 'class tree') ----- classRoots | all | + self isShowingAllClasses ifTrue: [^ {ProtoObject}]. + self isShowingHierarchyOfClass ifTrue: [^ self classRootsForHierarchy]. - self selectedSystemCategory = SystemOrganizer allCategory ifTrue: [^ {ProtoObject}]. - self selectedSystemCategory = self class hierarchyCategory ifTrue: [^ self classRootsForHierarchy]. all := lastClassList. ^ all select: [:class | all noneSatisfy: [:ea | class inheritsFrom: ea]]! Item was changed: ----- Method: TreeBrowser>>classTreeExpanded (in category 'class tree') ----- classTreeExpanded + "For reasons of usability and performance, we do not expand the entire class tree when potentially all classes in the system would be shown." + ^ self isShowingAllClasses not! - ^ self selectedSystemCategory ~= SystemOrganizer allCategory ! Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." + self isShowingAllClasses - self selectedSystemCategory = SystemOrganizer allCategory " ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]" ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].! Item was added: + ----- Method: TreeBrowser>>isShowingAllClasses (in category 'class tree - support') ----- + isShowingAllClasses + + ^ self selectedSystemCategory = SystemOrganizer allCategory + or: [self selectedSystemCategory isNil]! Item was added: + ----- Method: TreeBrowser>>isShowingHierarchyOfClass (in category 'class tree - support') ----- + isShowingHierarchyOfClass + + ^ self selectedSystemCategory = self class hierarchyCategory! Item was changed: ----- Method: TreeBrowser>>messageCategoryRoots (in category 'message category tree') ----- messageCategoryRoots | hasExtensions hasAny roots | self hasClassSelected ifFalse: [^ Array new]. hasAny := self classOrMetaClassOrganizer isEmpty not. hasExtensions := self classOrMetaClassOrganizer categories anySatisfy: [:cat | cat first == $*]. roots := OrderedCollection new. + (hasAny and: [self class showAllMethodsCategory]) ifTrue: [ + roots add: ClassOrganizer allCategory]. - hasAny ifTrue: [roots add: ClassOrganizer allCategory]. hasExtensions ifTrue: [ + self class showCoreMethodsCategory ifTrue: [roots add: self class coreCategory]. - roots add: self class coreCategory. roots add: self class extensionCategory]. roots addAll: (self messageCategoryChildren: ''). ^ roots!

3 3

Question about renaming "EToys" to "Etoys"
by Marcel Taeumel 16 May '23

16 May '23

Hi all -- I was wondering how easy it would be to fix the case-issue in the MC package for Etoys: wc := MCWorkingCopy forPackageNamed: 'EToys'. mcPkg := wc package. sqPkg := wc packageInfo. mc name: 'Etoys'. PackageOrganizer default unregisterPackage: sqPkg. sqPkg packageName: 'Etoys'. PackageOrganizer default registerPackage: sqPkg. Yet, I need to figure out whether Squeaksource (server) will complain when filing-out "Etoys-XX.1234.mcz" instead of "EToys-XX.1234.mcz" ... I would want to avoid that "Etoys" would be treated as a new package but connected to the "EToys" ancestry... Hmm... any Squeaksource experts around? :-) Best, Marcel

1 0

The Trunk: Tools-mt.1204.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1204.mcz ==================== Summary ==================== Name: Tools-mt.1204 Author: mt Time: 16 May 2023, 10:52:20.408174 am UUID: 2cd6d83a-7746-5942-b1e3-616b0ae9fc2d Ancestors: Tools-mt.1203 In TreeBrowser, fixes performance bug in #expandClassTree. Also expand all non-extension protocols automatically. =============== Diff against Tools-mt.1203 =============== Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." self isShowingAllClasses ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}] ifFalse: [(self classTreeExpanded not and: [lastClassList size <= self class classTreeAutoExpandLimit]) + ifTrue: [self changed: #expandAllNodesRequested with: #classChildren:]]! - ifTrue: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]]! Item was added: + ----- Method: TreeBrowser>>expandMessageCategoryTree (in category 'message category tree - support') ----- + expandMessageCategoryTree + "Expand all non-extension groups. Typically, there are only a few groups so browsing should be possible without having to filter or manually expand non-extension groups." + + self messageCategoryRoots do: [:ea | + ea first ~= $- "not -- all --, -- core --, -- extensions --" + ifTrue: [self changed: #expandAllNodesRequested with: {#messageCategoryChildren:. ea}]]! Item was changed: ----- Method: TreeBrowser>>updateMessageCategoryTree: (in category 'updating') ----- updateMessageCategoryTree: newList lastMessageCategoryList := newList. + self changed: #messageCategoryRoots. + self expandMessageCategoryTree.! - self changed: #messageCategoryRoots.!

1 0

The Trunk: Tools-mt.1203.mcz
by commits＠source.squeak.org 16 May '23

16 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1203.mcz ==================== Summary ==================== Name: Tools-mt.1203 Author: mt Time: 16 May 2023, 10:11:05.470174 am UUID: c4f5d92e-3df6-374e-8bd0-f52038816bb7 Ancestors: Tools-mt.1202 In TreeBrowser, tweak the behavior of class-tree auto-expansion and whether to show collapse/expand arrows or not. Compact hierarchies benefit from not showing the arrows for less clutter. Note that you can expand all children via SHIFT+RightArrow or SHIFT+RedClick. =============== Diff against Tools-mt.1202 =============== Item was added: + ----- Method: TreeBrowser class>>classTreeAutoExpandLimit (in category 'defaults') ----- + classTreeAutoExpandLimit + "Answer the maximum number of classes where the class tree should be expanded automatically." + + ^ 750! Item was added: + ----- Method: TreeBrowser class>>classTreeAutoExpandLockLimit (in category 'defaults') ----- + classTreeAutoExpandLockLimit + "Answer the maximum number of classes where the class tree should be expanded automatically and the user should not be able to collapse the tree but just use the type-in filter. This number should be smaller than #classTreeAutoExpandLimit." + + ^ 50! Item was changed: ----- Method: TreeBrowser>>classTreeExpanded (in category 'class tree') ----- classTreeExpanded "For reasons of usability and performance, we do not expand the entire class tree when potentially all classes in the system would be shown." + ^ (self isShowingAllClasses or: [lastClassList size > self class classTreeAutoExpandLockLimit]) not! - ^ self isShowingAllClasses not! Item was changed: ----- Method: TreeBrowser>>expandClassTree (in category 'class tree - support') ----- expandClassTree "Expand full class hierarchy for specific categories, top-level only for the '-- all --' category." self isShowingAllClasses + ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}] + ifFalse: [(self classTreeExpanded not and: [lastClassList size <= self class classTreeAutoExpandLimit]) + ifTrue: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]]! - " ifFalse: [self classRoots do: [:ea | self changed: #expandAllNodesRequested with: #classChildren:]]" - ifTrue: [self changed: #expandNodeRequested with: {#classChildren:. ProtoObject}].!

1 0

The Trunk: Tools-mt.1201.mcz
by commits＠source.squeak.org 15 May '23

15 May '23

Marcel Taeumel uploaded a new version of Tools to project The Trunk: http://source.squeak.org/trunk/Tools-mt.1201.mcz ==================== Summary ==================== Name: Tools-mt.1201 Author: mt Time: 12 May 2023, 9:32:33.304412 am UUID: 1d78afe7-8c20-4e4d-b091-3807faf620a4 Ancestors: Tools-mt.1200 In TreeBrowser, add message category "-- core --" to all classes that have extensions to be able to filter/browse through not-extension methods. The name 'core' stems from #coreMethods in PackageInfo. =============== Diff against Tools-mt.1200 =============== Item was added: + ----- Method: TreeBrowser class>>coreCategory (in category 'defaults') ----- + coreCategory + "The name 'core' stems from #coreMethods in PackageInfo." + + ^ #'-- core --'! Item was changed: ----- Method: TreeBrowser>>messageCategoryChildren: (in category 'message category tree') ----- messageCategoryChildren: category | all | category = ClassOrganizer allCategory ifTrue: [^ #()]. + category = self class coreCategory ifTrue: [^ #()]. all := (category = self class extensionCategory or: [category notEmpty and: [category first == $*]]) ifTrue: [lastMessageCategoryList select: [:cat | cat first == $*]] ifFalse: [lastMessageCategoryList reject: [:cat | cat first == $*]]. ^ self for: (category = self class extensionCategory ifTrue: [''] ifFalse: [category]) from: all select: [:prefix :cat | self hasMessageCategory: cat prefix: prefix] thenCollect: [:cat :start | self findTrimmedPrefix: cat startingAt: start]! Item was changed: ----- Method: TreeBrowser>>messageCategoryHasChildren: (in category 'message category tree') ----- messageCategoryHasChildren: category | predicate | category == ClassOrganizer allCategory ifTrue: [^ false]. + category = self class coreCategory ifTrue: [^ false]. predicate := category == self class extensionCategory ifTrue: [ [:cat | cat first == $*] ] ifFalse: [ [:cat | self hasMessageCategory: cat prefix: category] ]. ^ lastMessageCategoryList anySatisfy: [:cat | predicate value: cat]! Item was changed: ----- Method: TreeBrowser>>messageCategoryLabel: (in category 'message category tree') ----- messageCategoryLabel: category | label | category = ClassOrganizer allCategory ifTrue: [^ category]. category = self class extensionCategory ifTrue: [^ category]. + category = self class coreCategory ifTrue: [^ category]. label := self findTrimmedSuffix: category. (self classOrMetaClassOrganizer categories includes: category) ifFalse: [ label := '(', label, ')']. ^ label! Item was changed: ----- Method: TreeBrowser>>messageCategoryPath (in category 'message category tree') ----- messageCategoryPath "Answer the path represented by the category. Ensure to fill the cache." self hasClassSelected ifFalse: [^ #()]. self hasMessageCategorySelected ifFalse: [^ #()]. selectedMessageCategoryName = ClassOrganizer allCategory ifTrue: [^ {selectedMessageCategoryName}]. selectedMessageCategoryName = self class extensionCategory ifTrue: [^ {selectedMessageCategoryName}]. + selectedMessageCategoryName = self class coreCategory ifTrue: [^ {selectedMessageCategoryName}]. ^ Array streamContents: [:s | | parent | selectedMessageCategoryName first == $* "Is extension category?" ifTrue: [s nextPut: (parent := self class extensionCategory)] ifFalse: [parent := '']. [parent notNil] whileTrue: [ (self messageCategoryChildren: parent) detect: [:ea | selectedMessageCategoryName beginsWith: ea] ifFound: [:ea | s nextPut: (parent := ea)] ifNone: [parent := nil]]]! Item was changed: ----- Method: TreeBrowser>>messageCategoryRoots (in category 'message category tree') ----- messageCategoryRoots | hasExtensions hasAny roots | self hasClassSelected ifFalse: [^ Array new]. hasAny := self classOrMetaClassOrganizer isEmpty not. hasExtensions := self classOrMetaClassOrganizer categories anySatisfy: [:cat | cat first == $*]. roots := OrderedCollection new. hasAny ifTrue: [roots add: ClassOrganizer allCategory]. + hasExtensions ifTrue: [ + roots add: self class coreCategory. + roots add: self class extensionCategory]. - hasExtensions ifTrue: [roots add: self class extensionCategory]. roots addAll: (self messageCategoryChildren: ''). ^ roots! 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: [:extCat | (self classOrMetaClassOrganizer listAtCategoryNamed: extCat) + do: [:extSel | coreSelectors nextPut: (self formattedLabel: extSel)]]]]. + ^ 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)]]]]!

4 5