[squeak-dev] The Trunk: Tools-ar.198.mcz

commits at source.squeak.org commits at source.squeak.org
Wed Mar 3 06:22:23 UTC 2010


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 at 0 corner: 0.2 at max) -> [self buildPackageListWith: builder].
+ 		(0.2 at 0 corner: 0.4 at max) -> [self buildPackageDepsWith: builder].
+ 		(0.4 at 0 corner: 0.6 at max) -> [self buildClassDepsWith: builder].
+ 		(0.6 at 0 corner: 0.8 at max) -> [self buildClassListWith: builder].
+ 		(0.8 at 0 corner: 1.0 at max) -> [self buildMessageListWith: builder].
+ 		(0 at max corner: 1 at 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
+ !




More information about the Squeak-dev mailing list