Marcel Taeumel uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-mt.975.mcz==================== Summary ====================
Name: Tools-mt.975
Author: mt
Time: 12 June 2020, 12:52:57.245703 pm
UUID: c79c0e69-43cf-1d48-9f95-7fd4f4435bb7
Ancestors: Tools-mt.974
- adds support for extension methods to dep browser
- adds support for shared pools to dep browser
- reveal nature of deps in labels early on
- pre-select the first item in lists to speed up dependency browsing
=============== Diff against Tools-mt.974 ===============
Item was changed:
CodeHolder subclass: #DependencyBrowser
+ instanceVariableNames: 'packageList packageDeps packageDepsList classDeps classDepsList classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex'
- instanceVariableNames: 'packageList packageDeps classDeps classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex'
classVariableNames: ''
poolDictionaries: ''
category: 'Tools-Browser'!
!DependencyBrowser commentStamp: 'fbs 5/6/2011 11:29' prior: 0!
A simple dependency browser showing five panes:
[1]: Packages: The list of available packages in the system.
[2]: Package Dependencies: The dependent packages of the currently selected package.
[3]: Class Dependencies: The classes causing the dependencies.
[4]: Class List: The classes introducing the dependencies.
[5]: Messages: The messages introducing the dependencies.!
Item was changed:
----- Method: DependencyBrowser>>buildClassDepsWith: (in category 'toolbuilder') -----
buildClassDepsWith: builder
| listSpec |
listSpec := builder pluggableListSpec new.
listSpec
model: self;
name: 'Required Classes' ;
+ list: #classDepsList;
- list: #classDeps;
getIndex: #classDepsIndex;
setIndex: #classDepsIndex:;
menu: #classDepsMenu:;
keyPress: #classDepsKey:from:.
^listSpec
!
Item was changed:
----- Method: DependencyBrowser>>buildPackageDepsWith: (in category 'toolbuilder') -----
buildPackageDepsWith: builder
| listSpec |
listSpec := builder pluggableListSpec new.
listSpec
model: self;
name: 'Required Packages' ;
+ list: #packageDepsList;
- list: #packageDeps;
getIndex: #packageDepsIndex;
setIndex: #packageDepsIndex:;
menu: #packageDepsMenu:;
keyPress: #packageDepsKey:from:.
^listSpec
!
Item was changed:
----- Method: DependencyBrowser>>classDepsIndex: (in category 'class deps') -----
classDepsIndex: idx
"Class dependency selection"
classDepsIndex := idx.
- self classListIndex: 0.
self changed: #classDepsIndex.
+ classList := nil.
self changed: #classList.
+ self classListIndex: (idx = 0 ifTrue: [0] ifFalse: [1]).!
- !
Item was added:
+ ----- Method: DependencyBrowser>>classDepsList (in category 'class deps') -----
+ classDepsList
+ "Class dependencies for the currently selected package"
+
+ ^ classDepsList ifNil: [
+ classDepsList := self classDeps.
+ classDepsList := classDepsList collect: [:className |
+ (self
+ depsForClassNamed: className
+ allSatisfy: [:mref | mref selector = #Definition])
+ ifTrue: [className, ' (defs only)']
+ ifFalse: [(self
+ depsForClassNamed: className
+ allSatisfy: [:mref | mref category notNil and: [mref category first = $*]])
+ ifTrue: [className, ' *ext only*']
+ ifFalse: [className]]].
+ classDepsList]!
Item was changed:
----- Method: DependencyBrowser>>classList (in category 'class list') -----
classList
"List of classes that refer to dependencies"
+ | selectedPackage |
classDeps ifNil: [^ #()].
+ self classDepsSelection ifNil: [^ #()].
+ selectedPackage := PackageOrganizer default
+ packageNamed: self packageListSelection ifAbsent: [nil].
- "classList stores the actual classes displayed in my class list, corresponding to the collection of Strings returned by self classList. This allows us to unambiguously determine the class or metaclass currently being browsed simply by knowing the index of the selected class."
- classList := ((classDeps at: self classDepsSelection ifAbsent:[#()])
- collect:[:mref| mref actualClass] as: Set) asArray sort: [:a :b | a name < b name].
+ classList := (classDeps at: self classDepsSelection ifAbsent: [#()])
+ collect: [:mref |
+ mref selector = #Definition
+ ifTrue: [mref actualClass name, ' (class definition)']
+ ifFalse: [mref category first = $*
+ ifTrue: ['*extensions']
+ ifFalse: [mref actualClass name]]]
+ as: Set.
+
+ ^ classList := classList asArray sort!
- ^ classList collect: #name.!
Item was changed:
----- Method: DependencyBrowser>>classListIndex: (in category 'class list') -----
classListIndex: idx
"Class list selection"
classListIndex := idx.
- self messageListIndex: 0.
self changed: #classListIndex.
self changed: #messageList.
+ self messageListIndex: (idx = 0 ifTrue: [0] ifFalse: [1]).
!
Item was changed:
----- Method: DependencyBrowser>>classListSelection (in category 'class list') -----
classListSelection
"Class list selection"
+ ^ self selectedClassOrMetaClass name!
- ^(self classListIndex between: 1 and: self classList size)
- ifTrue:[self classList at: self classListIndex]!
Item was changed:
----- Method: DependencyBrowser>>computePackageDependencies: (in category 'package deps') -----
computePackageDependencies: pkgName
"Compute the dependencies for the given package"
| pi |
classDeps := Dictionary new.
packageDeps := Dictionary new.
pkgName ifNil:[^self].
pi := PackageOrganizer default packageNamed: pkgName ifAbsent:[^self]. "unloaded"
+ pi classes do:[:pkgClass |
- pi classes do:[:pkgClass|
(classDeps at: (pkgClass superclass ifNil:[ProtoObject]) name
ifAbsentPut:[OrderedCollection new]) add:
+ (MethodReference class: pkgClass selector: #Definition).
+ pkgClass sharedPools do: [:sharedPool |
+ sharedPool isBehavior ifTrue: [
+ (classDeps at: sharedPool name
+ ifAbsentPut:[OrderedCollection new]) add:
+ (MethodReference class: pkgClass selector: #Definition)]]].
- (MethodReference class: pkgClass selector: #Definition)].
+ pi coreMethods do:[:mref|
- pi methods do:[:mref|
mref compiledMethod allLiteralsDo:[:lit |
(lit isVariableBinding and: [lit value isBehavior]) ifTrue:[
(classDeps at: lit value name ifAbsentPut:[OrderedCollection new])
add: mref]]].
+ pi extensionMethods do:[:mref|
+ (classDeps at: mref actualClass name ifAbsentPut: [OrderedCollection new])
+ add: mref].
+
classDeps keys do:[:className| | aClass pkg |
aClass := Smalltalk classNamed: className.
pkg := aClass ifNil: [nil] ifNotNil: [PackageOrganizer default packageOfClass: aClass ifNone:[nil]].
pkg ifNil:[
Transcript cr; show: 'WARNING: No package for ', className.
(classDeps removeKey: className) do:[:each| Transcript crtab; show: each].
] ifNotNil:[
(packageDeps at: pkg name ifAbsentPut:[OrderedCollection new]) add: className.
].
].
(packageDeps removeKey: pkgName ifAbsent:[#()]) do:[:each|
classDeps removeKey: each ifAbsent:[].
].!
Item was added:
+ ----- Method: DependencyBrowser>>depsForClassNamed:allSatisfy: (in category 'enumerating') -----
+ depsForClassNamed: className allSatisfy: workBlock
+
+ self
+ depsForClassNamed: className
+ do: [:mref | (workBlock value: mref) ifFalse: [^ false]].
+ ^ true!
Item was added:
+ ----- Method: DependencyBrowser>>depsForClassNamed:do: (in category 'enumerating') -----
+ depsForClassNamed: className do: workBlock
+
+ classDeps ifNil: [^ self].
+ (classDeps at: className ifAbsent: [^ self]) do: workBlock.!
Item was added:
+ ----- Method: DependencyBrowser>>depsForPackageNamed:allSatisfy: (in category 'enumerating') -----
+ depsForPackageNamed: packageName allSatisfy: workBlock
+
+ self
+ depsForPackageNamed: packageName
+ do: [:mref | (workBlock value: mref) ifFalse: [^ false]].
+ ^ true!
Item was added:
+ ----- Method: DependencyBrowser>>depsForPackageNamed:do: (in category 'enumerating') -----
+ depsForPackageNamed: packageName do: workBlock
+
+ classDeps ifNil: [^ self].
+ classDeps keysAndValuesDo: [:className :dependencies |
+ (self selectedEnvironment classNamed: className) ifNotNil: [:class |
+ class packageInfo name = packageName ifTrue: [
+ dependencies do: workBlock]]].!
Item was changed:
----- Method: DependencyBrowser>>messageList (in category 'message list') -----
messageList
"List of messages creating dependencies"
+ | selectedClass label filter |
- | selectedClass |
classDeps ifNil: [^ #()].
+ classList ifNil: [^ #()].
selectedClass := self classListSelection.
+ label := classList at: classListIndex ifAbsent: [''].
+
+ filter := label ifEmpty: [ [:mref | false] ] ifNotEmpty: [
+ (label first = $* or: [(label endsWith: '(class definition)') not])
+ ifTrue: [ [:mref | mref selector ~= #Definition and: [mref actualClass name = selectedClass]] ]
+ ifFalse: [ [:mref | mref selector = #Definition and: [mref actualClass name = selectedClass]] ]].
+
^((classDeps at: self classDepsSelection ifAbsent:[#()])
+ select: filter
+ thenCollect:[:mref| mref methodSymbol]) asSet asArray sort!
- select:[:each| each actualClass name = selectedClass]
- thenCollect:[:mref| mref methodSymbol]) asArray sort!
Item was changed:
----- Method: DependencyBrowser>>packageDepsIndex: (in category 'package deps') -----
packageDepsIndex: aNumber
"Current package dependencies selection"
packageDepsIndex := aNumber.
- self classDepsIndex: 0.
self changed: #packageDepsIndex.
+
+ classDepsList := nil.
+ self changed: #classDepsList.
+ self classDepsIndex: (aNumber = 0 ifTrue: [0] ifFalse: [1]).
- self changed: #classDeps.
!
Item was added:
+ ----- Method: DependencyBrowser>>packageDepsList (in category 'package deps') -----
+ packageDepsList
+ "Package dependencies for the currently selected package"
+
+ ^ packageDepsList ifNil: [
+ packageDepsList := self packageDeps.
+ packageDepsList := packageDepsList collect: [:packageName |
+ (self
+ depsForPackageNamed: packageName
+ allSatisfy: [:mref | mref selector = #Definition])
+ ifTrue: [packageName, ' (defs only)']
+ ifFalse: [(self
+ depsForPackageNamed: packageName
+ allSatisfy: [:mref | mref category notNil and: [mref category first = $*]])
+ ifTrue: [packageName, ' *ext only*']
+ ifFalse: [packageName]]].
+ packageDepsList]!
Item was changed:
----- Method: DependencyBrowser>>packageListIndex: (in category 'package list') -----
packageListIndex: aNumber
"Current package list selection"
packageListIndex := aNumber.
self changed: #packageListIndex.
- self packageDepsIndex: 0.
packageDeps := nil.
+ packageDepsList := nil.
+ self changed: #packageDepsList.
+ self packageDepsIndex: (aNumber = 0 ifTrue: [0] ifFalse: [1]).
- self changed: #packageDeps.
!
Item was changed:
----- Method: DependencyBrowser>>selectedClass (in category 'class list') -----
selectedClass
+ "Answer the class that is currently selected. Answer nil if no selection exists."
- "Answer the class that is currently selected. Answer nil if no selection
- exists."
+ ^ self selectedClassOrMetaClass
- | name envt nonMetaClass nonMetaName |
- (name := self selectedClassName) ifNil: [^ nil].
- (envt := self selectedEnvironment) ifNil: [^ nil].
- nonMetaName := (name endsWith: ' class') ifTrue: [name allButLast: 6] ifFalse: [name].
- nonMetaClass := envt at: nonMetaName asSymbol ifAbsent: [^ nil].
- ^ nonMetaName = name ifTrue: [nonMetaClass] ifFalse: [nonMetaClass class].
!
Item was changed:
----- Method: DependencyBrowser>>selectedClassName (in category 'class list') -----
selectedClassName
| idx |
idx := classListIndex ifNil: [0].
+ ^ (classList ifNotNil: [ :l | l at: idx ifAbsent: [nil]])
+ ifNotNil: [:label |
+ label first = $*
+ ifTrue: [nil "extension methods"]
+ ifFalse: [(label endsWith: '(class definition)')
+ ifTrue: [label findTokens first]
+ ifFalse: [label "e.g., 'String' or 'String class'"]]]!
- ^ self classList ifNotNil: [ :l | l at: idx ifAbsent: [nil]]!
Item was changed:
----- Method: DependencyBrowser>>selectedClassOrMetaClass (in category 'class list') -----
selectedClassOrMetaClass
"Answer the class or metaclass that is currently selected. Answer nil if no selection
exists."
classList ifNil: [^nil].
+ ^ (self selectedEnvironment classNamed: (self selectedClassName ifNil: ['']))
+ ifNil: [classListIndex > 0 ifFalse: [nil] ifTrue: [
+ "Use the class the current selection is depending on such as for method extensions or (base) class definitions."
+ self selectedEnvironment classNamed: (self classDepsSelection ifNil: [''])]]!
- ^ classList at: classListIndex ifAbsent: [nil].!
Locked
