The Trunk: Tools-ar.198.mcz

Andreas Raab uploaded a new version of Tools to project The Trunk:
http://source.squeak.org/trunk/Tools-ar.198.mcz

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

Name: Tools-ar.198
Author: ar
Time: 2 March 2010, 10:21:17.225 pm
UUID: d25c2788-0ae0-be4e-a0f2-466c93f7b78d
Ancestors: Tools-laza.197

A quick adoption of DependencyBrowser.

=============== Diff against Tools-laza.197 ===============

Item was added:
+ ----- Method: DependencyBrowser classSide>>open (in category 'opening') -----
+ open
+ "DependencyBrowser open"
+ ^ToolBuilder open: self!

Item was added:
+ ----- Method: DependencyBrowser>>classDepsIndex: (in category 'class deps') -----
+ classDepsIndex: idx
+ "Class dependency selection"
+ classDepsIndex := idx.
+ self classListIndex: 0.
+ self changed: #classDepsIndex.
+ self changed: #classList.
+ !

Item was added:
+ ----- Method: DependencyBrowser>>classDepsIndex (in category 'class deps') -----
+ classDepsIndex
+ "Class dependency selection"
+ ^classDepsIndex ifNil:[0]!

Item was added:
+ ----- Method: DependencyBrowser>>aboutToStyle: (in category 'contents') -----
+ aboutToStyle: aStyler
+ "This is a notification that aStyler is about to re-style its text.
+ Set the classOrMetaClass in aStyler, so that identifiers
+ will be resolved correctly.
+ Answer true to allow styling to proceed, or false to veto the styling"
+ | selectedClass |
+ selectedClass := self classListSelection ifNil:[^false].
+ aStyler classOrMetaClass: ((self messageListSelection == #Definition) ifFalse:[Smalltalk classNamed: selectedClass]).
+ ^true!

Item was added:
+ ----- Method: DependencyBrowser>>classListIndex: (in category 'class list') -----
+ classListIndex: idx
+ "Class list selection"
+ classListIndex := idx.
+ self messageListIndex: 0.
+ self changed: #classListIndex.
+ self changed: #messageList.
+ !

Item was added:
+ ----- Method: DependencyBrowser>>classDepsSelection (in category 'class deps') -----
+ classDepsSelection
+ "Class dependency selection"
+ ^(self classDepsIndex between: 1 and: self classDeps size)
+ ifTrue:[self classDeps at: self classDepsIndex].!

Item was added:
+ ----- Method: DependencyBrowser>>classList (in category 'class list') -----
+ classList
+ "List of classes that refer to dependencies"
+ ^((classDeps at: self classDepsSelection ifAbsent:[#()])
+ collect:[:mref| mref classSymbol] as: Set) asArray sort!

Item was added:
+ ----- Method: DependencyBrowser>>classListSelection (in category 'class list') -----
+ classListSelection
+ "Class list selection"
+ ^(self classListIndex between: 1 and: self classList size)
+ ifTrue:[self classList at: self classListIndex]!

Item was added:
+ ----- Method: DependencyBrowser>>selectedMessage (in category 'contents') -----
+ selectedMessage
+ "Source code for currently selected message"
+ | className methodName mref |
+ className := self classListSelection.
+ methodName := self messageListSelection.
+ mref := (classDeps at: self classDepsSelection ifAbsent:[#()])
+ detect:[:mr| mr classSymbol = className
+ and:[mr methodSymbol = methodName]]
+ ifNone:[nil].
+ mref ifNil:[^''].
+ mref methodSymbol == #Definition ifTrue:[^mref actualClass definition].
+ ^mref sourceCode!

Item was added:
+ ----- Method: DependencyBrowser>>packageDepsSelection (in category 'package deps') -----
+ packageDepsSelection
+ "Current package dependencies selection"
+ ^(self packageDepsIndex between: 1 and: self packageDeps size)
+ ifTrue:[self packageDeps at: self packageDepsIndex]!

Item was added:
+ ----- Method: DependencyBrowser>>packageDepsIndex: (in category 'package deps') -----
+ packageDepsIndex: aNumber
+ "Current package dependencies selection"
+ packageDepsIndex := aNumber.
+ self classDepsIndex: 0.
+ self changed: #packageDepsIndex.
+ self changed: #classDeps.
+ !

Item was added:
+ CodeHolder subclass: #DependencyBrowser
+ instanceVariableNames: 'packageList packageDeps classDeps classList messageList packageListIndex packageDepsIndex classDepsIndex classListIndex messageListIndex'
+ classVariableNames: ''
+ poolDictionaries: ''
+ category: 'Tools-Browser'!
+
+ !DependencyBrowser commentStamp: 'ar 3/2/2010 22:19' 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 added:
+ ----- Method: DependencyBrowser>>messageListIndex: (in category 'message list') -----
+ messageListIndex: idx
+ "Message list selection"
+ messageListIndex := idx.
+ self changed: #messageListIndex.
+ self changed: #contents.!

Item was added:
+ ----- Method: DependencyBrowser>>packageListSelection (in category 'package list') -----
+ packageListSelection
+ "Current package list selection"
+ ^(self packageListIndex between: 1 and: self packageList size)
+ ifTrue:[self packageList at: self packageListIndex]!

Item was added:
+ ----- Method: DependencyBrowser>>packageDepsIndex (in category 'package deps') -----
+ packageDepsIndex
+ "Current package dependencies selection"
+ ^packageDepsIndex ifNil:[0]!

Item was added:
+ ----- Method: DependencyBrowser>>packageList (in category 'package list') -----
+ packageList
+ "The base list of packages in the system"
+ ^packageList ifNil:[packageList := (MCWorkingCopy allManagers collect:[:each| each packageName]) sort]!

Item was added:
+ ----- 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|
+ (classDeps at: (pkgClass superclass ifNil:[ProtoObject]) name
+ ifAbsentPut:[OrderedCollection new]) add:
+ (MethodReference class: pkgClass selector: #Definition)].
+
+ pi methods do:[:mref| | cm |
+ cm := mref compiledMethod.
+ 1 to: cm numLiterals do:[:i| | lit |
+ ((lit := cm literalAt: i) isVariableBinding and:[lit value isBehavior]) ifTrue:[
+ (classDeps at: lit value name ifAbsentPut:[OrderedCollection new])
+ add: (MethodReference class: cm methodClass selector: cm selector)]]].
+
+ classDeps keys do:[:className| | aClass pkg |
+ aClass := Smalltalk classNamed: className.
+ pkg := 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>>classDeps (in category 'class deps') -----
+ classDeps
+ "Class dependencies for the currently selected package"
+ ^(packageDeps at: self packageDepsSelection ifAbsent:[#()]) sort!

Item was added:
+ ----- Method: DependencyBrowser>>messageListIndex (in category 'message list') -----
+ messageListIndex
+ "Message list selection"
+ ^messageListIndex ifNil:[0]!

Item was added:
+ ----- Method: DependencyBrowser>>buildPackageListWith: (in category 'toolbuilder') -----
+ buildPackageListWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #packageList;
+ getIndex: #packageListIndex;
+ setIndex: #packageListIndex:;
+ menu: #packageListMenu:;
+ keyPress: #packageListKey:from:.
+ ^listSpec
+ !

Item was added:
+ ----- Method: DependencyBrowser>>messageListSelection (in category 'message list') -----
+ messageListSelection
+ "Message list selection"
+ ^(self messageListIndex between: 1 and: self messageList size)
+ ifTrue:[self messageList at: self messageListIndex]!

Item was added:
+ ----- Method: DependencyBrowser>>buildClassListWith: (in category 'toolbuilder') -----
+ buildClassListWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #classList;
+ getIndex: #classListIndex;
+ setIndex: #classListIndex:;
+ menu: #classListMenu:;
+ keyPress: #classListKey:from:.
+ ^listSpec
+ !

Item was added:
+ ----- Method: DependencyBrowser>>buildWith: (in category 'toolbuilder') -----
+ buildWith: builder
+ "Create the ui for the browser"
+ | windowSpec max |
+ max := self wantsOptionalButtons ifTrue:[0.42] ifFalse:[0.5].
+ windowSpec := self buildWindowWith: builder specs: {
+ (0@0 corner: 0.2@max) -> [self buildPackageListWith: builder].
+ (0.2@0 corner: 0.4@max) -> [self buildPackageDepsWith: builder].
+ (0.4@0 corner: 0.6@max) -> [self buildClassDepsWith: builder].
+ (0.6@0 corner: 0.8@max) -> [self buildClassListWith: builder].
+ (0.8@0 corner: 1.0@max) -> [self buildMessageListWith: builder].
+ (0@max corner: 1@1) -> [self buildCodePaneWith: builder].
+ }.
+ ^builder build: windowSpec!

Item was added:
+ ----- Method: DependencyBrowser>>packageListIndex (in category 'package list') -----
+ packageListIndex
+ "Current package list selection"
+ ^packageListIndex ifNil:[0]!

Item was added:
+ ----- Method: DependencyBrowser>>packageDeps (in category 'package deps') -----
+ packageDeps
+ "Package dependencies for the currently selected package"
+ packageDeps ifNil:[
+ packageDeps := Dictionary new.
+ Cursor wait showWhile:[
+ self computePackageDependencies: self packageListSelection.
+ ].
+ ].
+ ^packageDeps keys sort!

Item was added:
+ ----- Method: DependencyBrowser>>buildPackageDepsWith: (in category 'toolbuilder') -----
+ buildPackageDepsWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #packageDeps;
+ getIndex: #packageDepsIndex;
+ setIndex: #packageDepsIndex:;
+ menu: #packageDepsMenu:;
+ keyPress: #packageDepsKey:from:.
+ ^listSpec
+ !

Item was added:
+ ----- Method: DependencyBrowser>>classListIndex (in category 'class list') -----
+ classListIndex
+ "Class list selection"
+ ^classListIndex ifNil:[0]!

Item was added:
+ ----- Method: DependencyBrowser>>packageListIndex: (in category 'package list') -----
+ packageListIndex: aNumber
+ "Current package list selection"
+ packageListIndex := aNumber.
+ self changed: #packageListIndex.
+ self packageDepsIndex: 0.
+ packageDeps := nil.
+ self changed: #packageDeps.
+ !

Item was added:
+ ----- Method: DependencyBrowser>>messageList (in category 'message list') -----
+ messageList
+ "List of messages creating dependencies"
+ | selectedClass |
+ selectedClass := self classListSelection.
+ ^((classDeps at: self classDepsSelection ifAbsent:[#()])
+ select:[:each| each classSymbol = selectedClass]
+ thenCollect:[:mref| mref methodSymbol]) asArray sort!

Item was added:
+ ----- Method: DependencyBrowser>>buildClassDepsWith: (in category 'toolbuilder') -----
+ buildClassDepsWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #classDeps;
+ getIndex: #classDepsIndex;
+ setIndex: #classDepsIndex:;
+ menu: #classDepsMenu:;
+ keyPress: #classDepsKey:from:.
+ ^listSpec
+ !

Item was added:
+ ----- Method: DependencyBrowser>>buildMessageListWith: (in category 'toolbuilder') -----
+ buildMessageListWith: builder
+ | listSpec |
+ listSpec := builder pluggableListSpec new.
+ listSpec
+ model: self;
+ list: #messageList;
+ getIndex: #messageListIndex;
+ setIndex: #messageListIndex:;
+ menu: #messageListMenu:;
+ keyPress: #messageListKey:from:.
+ ^listSpec
+ !