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.'!