[squeak-dev] The Trunk: Tools-mt.1073.mcz

commits at source.squeak.org commits at source.squeak.org
Tue Nov 23 14:07:05 UTC 2021


Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.1073.mcz

==================== Summary ====================

Name: Tools-mt.1073
Author: mt
Time: 23 November 2021, 3:07:02.043922 pm
UUID: f873ae33-8582-ed41-a89e-5cdc18ebfa26
Ancestors: Tools-mt.1072

Adds support for traits in HierarchyBrowser.

Thanks to Christoph (ct) for the idea! See: http://lists.squeakfoundation.org/pipermail/squeak-dev/2021-October/216835.html

=============== Diff against Tools-mt.1072 ===============

Item was changed:
  ----- Method: Browser>>browseClassHierarchy (in category 'multi-window support') -----
  browseClassHierarchy
  	"Overridden to consider multi-window state and hierarchy browser."
  
  	| behavior newBrowser |
  	(behavior := self selectedClassOrMetaClass) isNil ifTrue:
  		[^self].
  
  	(self isPackage "PackageBrowser panes can't support a hierarchy browser; not sure why."
  	 or: [self multiWindowState isNil]) ifTrue:
  		[^super browseClassHierarchy].
  
+ 	newBrowser := HierarchyBrowser new
+ 		setClass: behavior;
- 	(newBrowser := HierarchyBrowser new initHierarchyForClass: behavior)
  		selectMessageCategoryNamed: self selectedMessageCategoryName;
  		selectMessageNamed: self selectedMessageName;
+ 		editSelection: editSelection;
+ 		yourself.
- 		editSelection: editSelection.
  
  	self multiWindowState addWindow: newBrowser!

Item was changed:
  ----- Method: Browser>>setClass: (in category 'initialize-release') -----
  setClass: aBehavior
  	"Set the state of a new, uninitialized Browser."
  
  	| isMeta aClass |
  	aBehavior ifNil: [^ self].
+ 	aBehavior isMeta
- 	(aBehavior isKindOf: Metaclass)
  		ifTrue: [
  			isMeta := true.
  			aClass := aBehavior soleInstance]
  		ifFalse: [
  			isMeta := false.
  			aClass := aBehavior].
  		
  	self
  		selectEnvironment: aClass environment;
  		selectCategoryForClass: aClass;
  		classListIndex: (self classListIndexOf: aClass name);
  		metaClassIndicated: isMeta.!

Item was changed:
+ ----- Method: Browser>>traitsMenu: (in category 'traits') -----
- ----- Method: Browser>>traitsMenu: (in category '*Tools-traits') -----
  traitsMenu: aMenu
  	<classListMenuShifted: false>
  	<menuPriority: 140>
  
  	self selectedClass isTrait ifTrue: [
  		aMenu add: 'browse trait users' action: #browseTraitUsers].
  	^ aMenu!

Item was added:
+ ----- Method: HierarchyBrowser>>allAncestorsOfTrait:withLevelDo: (in category 'traits') -----
+ allAncestorsOfTrait: trait withLevelDo: traitAndLevelBlock
+ 
+ 	self
+ 		allAncestorsOfTrait: trait
+ 		withLevelDo: traitAndLevelBlock
+ 		startingLevel: 1.!

Item was added:
+ ----- Method: HierarchyBrowser>>allAncestorsOfTrait:withLevelDo:startingLevel: (in category 'traits') -----
+ allAncestorsOfTrait: trait withLevelDo: traitAndLevelBlock startingLevel: level
+ 
+ 	trait traitComposition asTraitComposition traits
+ 		do: [:ancestor |
+ 			self
+ 				allAncestorsOfTrait: ancestor
+ 				withLevelDo: traitAndLevelBlock
+ 				startingLevel: level + 1.
+ 			traitAndLevelBlock value: ancestor value: level].!

Item was added:
+ ----- Method: HierarchyBrowser>>allSuccessorsOfTrait:withLevelDo:startingLevel: (in category 'traits') -----
+ allSuccessorsOfTrait: trait withLevelDo: traitAndLevelBlock startingLevel: level 
+ 
+ 	traitAndLevelBlock value: trait value: level.
+ 	(trait users sorted: #name ascending)
+ 		do: [:user |
+ 			self
+ 				allSuccessorsOfTrait: user 
+ 				withLevelDo: traitAndLevelBlock
+ 				startingLevel: level + 1].!

Item was added:
+ ----- Method: HierarchyBrowser>>initHierarchyFor: (in category 'initialization') -----
+ initHierarchyFor: classOrTrait
+ 
+ 	classOrTrait isTrait
+ 		ifTrue: [self initHierarchyForTrait: classOrTrait]
+ 		ifFalse: [self initHierarchyForClass: classOrTrait].!

Item was added:
+ ----- Method: HierarchyBrowser>>initHierarchyForTrait: (in category 'traits') -----
+ initHierarchyForTrait: baseTraitOrClassTrait
+ 
+ 	| baseTrait baseLevel |
+ 	centralClass := baseTraitOrClassTrait.
+ 	baseTrait := baseTraitOrClassTrait baseTrait.
+ 	self selectEnvironment: baseTraitOrClassTrait environment.
+ 	metaClassIndicated := baseTraitOrClassTrait isClassTrait.
+ 	classDisplayList := OrderedCollection new.
+ 	baseLevel := 0.
+ 	self
+ 		allAncestorsOfTrait: baseTrait
+ 		withLevelDo: [:each :level | baseLevel := baseLevel max: level].
+ 	self
+ 		allAncestorsOfTrait: baseTrait
+ 		withLevelDo:
+ 			[:each :level | classDisplayList add:
+ 				(String streamContents:
+ 					[ : stream | baseLevel - level timesRepeat: [ stream nextPutAll: '  ' ].
+ 					stream nextPutAll: each name ]) ].
+ 	self
+ 		allSuccessorsOfTrait: baseTrait
+ 		withLevelDo:
+ 			[:each :level | classDisplayList add:
+ 				(String streamContents:
+ 					[ : stream | level timesRepeat: [ stream nextPutAll: '  ' ].
+ 					stream nextPutAll: each name ]) ]
+ 		startingLevel: baseLevel.
+ 	
+ 	self changed: #classList.
+ 	self selectClass: baseTrait.!

Item was changed:
  ----- Method: HierarchyBrowser>>setClass: (in category 'initialization') -----
+ setClass: aClassOrTrait
+ 	self initHierarchyFor: (centralClass ifNil: [ aClassOrTrait ]).
+ 	super setClass: aClassOrTrait!
- setClass: aClass 
- 	self initHierarchyForClass: (centralClass ifNil: [ aClass ]).
- 	super setClass: aClass!

Item was changed:
  ----- Method: HierarchyBrowser>>updateAfterClassChange (in category 'initialization') -----
  updateAfterClassChange
  	"It is possible that some the classes comprising the hierarchy have changed, so reinitialize the entire browser."
  
  	| priorSelection |
  	priorSelection := self selectedClassName.
  	
  	(centralClass notNil and: [centralClass isObsolete not])
+ 		ifTrue: [self initHierarchyFor: centralClass].
- 		ifTrue: [self initHierarchyForClass: centralClass].
  		
  	(self classListIndexOf: priorSelection) > 0
  		ifTrue: [self selectClassNamed: priorSelection].!



More information about the Squeak-dev mailing list