[squeak-dev] The Trunk: System-ul.436.mcz

commits at source.squeak.org commits at source.squeak.org
Tue May 10 00:32:27 UTC 2011


Levente Uzonyi uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-ul.436.mcz

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

Name: System-ul.436
Author: ul
Time: 9 May 2011, 2:45:43.306 am
UUID: 15b8a8d0-1b0d-f74a-95de-89587d59d31a
Ancestors: System-nice.435

First stab of SystemNavigation refactorings:
- #browseMessageList:name:autoSelect: now accepts a block as it's first argument and shows the wait cursor while evaluating it
- unified #allCallsOn* variants. They all use #allCallsOn:fromBehaviors:sorted: internally and all of them return an OrderedCollection.
- removed cursor changes from updated methods of the query category

=============== Diff against System-nice.435 ===============

Item was changed:
  ----- Method: SystemNavigation class>>default (in category 'accessing') -----
  default
+ 	
+ 	^Default ifNil: [ Default := self new ]!
- 	Default isNil ifTrue: [Default := self new].
- 	^Default!

Item was added:
+ ----- Method: SystemNavigation>>allAccessesTo:from: (in category 'query') -----
+ allAccessesTo: instVarName from: aClass
+ 	"Return a collection of all methods of aClass or it's sub/superclass that refer to the instance variable instVarName."
+ 	
+ 	| result |
+ 	result := OrderedCollection new.
+ 	aClass withAllSubAndSuperclassesDo: [ :class | 
+ 		(class whichSelectorsAccess: instVarName) do: [ :selector |
+ 			result add: (MethodReference class: class selector: selector) ] ].
+ 	^result!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn: (in category 'query') -----
  allCallsOn: aLiteral 
+ 	"Answer a sorted collection of all the methods that call on aLiteral even deeply embedded in literal array."
+ 	"self default browseAllCallsOn: #open:label:."
+ 	
+ 	^self
+ 		allCallsOn: aLiteral
+ 		fromBehaviors: (Generator on: [ :generator |
+ 			self allBehaviorsDo: [ :each |
+ 				generator yield: each ] ])
+ 		sorted: true!
- 	"Answer a Collection of all the methods that call on aLiteral even deeply embedded in 
- 	literal array."
- 	"self new browseAllCallsOn: #open:label:."
- 	| aCollection special thorough byte |
- 	aCollection := OrderedCollection new.
- 	special := Smalltalk
- 				hasSpecialSelector: aLiteral
- 				ifTrueSetByte: [:b | byte := b].
- 	thorough := (aLiteral isSymbol)
- 				and: ["Possibly search for symbols imbedded in literal arrays"
- 					Preferences thoroughSenders].
- 	Cursor wait
- 		showWhile: [self
- 				allBehaviorsDo: [:class | | aList | 
- 					aList := thorough
- 								ifTrue: [class
- 										thoroughWhichSelectorsReferTo: aLiteral
- 										special: special
- 										byte: byte]
- 								ifFalse: [class
- 										whichSelectorsReferTo: aLiteral
- 										special: special
- 										byte: byte].
- 					aList
- 						do: [:sel | sel isDoIt
- 								ifFalse: [aCollection
- 										add: (MethodReference new setStandardClass: class methodSymbol: sel)]]]].
- 	^ aCollection!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:and: (in category 'query') -----
  allCallsOn: firstLiteral and: secondLiteral
+ 	"Answer a sorted collection of all the methods that call on both firstLiteral and secondLiteral."
- 	"Answer a SortedCollection of all the methods that call on both aLiteral 
- 	and secondLiteral."
  
+ 	| firstList secondList |
+ 	firstList := self allCallsOn: firstLiteral.
+ 	secondList := (self 
+ 		allCallsOn: secondLiteral
+ 		fromBehaviors: (firstList collect: [ :each | each actualClass ] as: IdentitySet)
+ 		sorted: false) asSet.
+ 	firstList removeAllSuchThat: [ :each | (secondList includes: each) not ].
+ 	^firstList
+ 	!
- 	| aCollection firstSpecial secondSpecial firstByte secondByte |
- 	self flag: #ShouldUseAllCallsOn:. "sd"
- 	aCollection := SortedCollection new.
- 	firstSpecial := Smalltalk hasSpecialSelector: firstLiteral ifTrueSetByte: [:b | firstByte := b].
- 	secondSpecial := Smalltalk hasSpecialSelector: secondLiteral ifTrueSetByte: [:b | secondByte := b].
- 	Cursor wait showWhile: [
- 		self allBehaviorsDo: [:class | | secondArray |
- 			secondArray := class 
- 				whichSelectorsReferTo: secondLiteral
- 				special: secondSpecial
- 				byte: secondByte.
- 			((class whichSelectorsReferTo: firstLiteral special: firstSpecial byte: firstByte) select:
- 				[:aSel | (secondArray includes: aSel)]) do:
- 						[:sel | 
- 							aCollection add: (
- 								MethodReference new
- 									setStandardClass: class 
- 									methodSymbol: sel
- 							)
- 						]
- 		]
- 	].
- 	^aCollection!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:from: (in category 'query') -----
+ allCallsOn: aSymbol from: aBehavior
+ 	"Answer a sorted collection of all the methods from aBehavior that call on aSymbol."
- allCallsOn: aSymbol from: aClass
- 	"Answer a SortedCollection of all the methods that call on aSymbol."
  
+ 	^self allCallsOn: aSymbol fromBehaviors: { aBehavior } sorted: true!
- 	| aSortedCollection special byte |
- 	aSortedCollection := SortedCollection new.
- 	special := Smalltalk hasSpecialSelector: aSymbol ifTrueSetByte: [:b | byte := b ].
- 	aClass withAllSubclassesDo: [ :class |
- 		(class whichSelectorsReferTo: aSymbol special: special byte: byte) do: [:sel |
- 			sel isDoIt ifFalse: [
- 				aSortedCollection add: (
- 					MethodReference new
- 						setStandardClass: class 
- 						methodSymbol: sel
- 				)
- 			]
- 		]
- 	].
- 	^aSortedCollection!

Item was added:
+ ----- Method: SystemNavigation>>allCallsOn:fromBehaviors:sorted: (in category 'query') -----
+ allCallsOn: aLiteral fromBehaviors: behaviors sorted: sorted
+ 	"Answer a collection of all the methods implemented by behaviors that call on aLiteral even deeply embedded in literal array."
+ 	
+ 	| result special thorough byte |
+ 	result := OrderedCollection new.
+ 	special := Smalltalk hasSpecialSelector: aLiteral ifTrueSetByte: [ :b | byte := b ].
+ 	"Possibly search for symbols imbedded in literal arrays"
+ 	thorough := aLiteral isSymbol and: [ Preferences thoroughSenders ].
+ 	behaviors do: [ :behavior |
+ 		| list | 
+ 		list := behavior whichSelectorsReferTo: aLiteral special: special byte: byte thorough: thorough.
+ 		list do: [ :selector |
+ 			result add: (MethodReference class: behavior selector: selector) ] ].
+ 	sorted ifTrue: [ result sort ].
+ 	^result!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:localTo: (in category 'query') -----
+ allCallsOn: aLiteral localTo: aClass
+ 	"Answer a sorted collection of MethodReferences for all the methods that call on aLiteral in, above or below the given class."
- allCallsOn: aSymbol localTo: aClass
- 	"Answer a Set of MethodReferences for all the methods
- 	 that call on aSymbol in, above or below the given class."
  
+ 	^self
+ 		allCallsOn: aLiteral
+ 		fromBehaviors: (Array streamContents: [ :stream |
+ 			aClass theNonMetaClass withAllSuperAndSubclassesDoGently: [ :each |
+ 				stream nextPut: each ].
+ 			aClass theNonMetaClass class withAllSuperAndSubclassesDoGently: [ :each |
+ 				stream nextPut: each ] ])
+ 		sorted: true!
- 	| aSet special byte enum |
- 	aSet := Set new.
- 	special := Smalltalk hasSpecialSelector: aSymbol ifTrueSetByte: [:b | byte := b].
- 	enum := [:behavior|
- 			(behavior whichSelectorsReferTo: aSymbol special: special byte: byte) do:
- 				[:sel | aSet add: (MethodReference new setStandardClass: behavior  methodSymbol: sel)]].
- 	aClass theNonMetaClass withAllSuperAndSubclassesDoGently: enum.
- 		aClass theNonMetaClass class withAllSuperAndSubclassesDoGently: enum.
- 	^aSet!

Item was changed:
  ----- Method: SystemNavigation>>allCallsOn:localToPackage: (in category 'query') -----
  allCallsOn: aLiteral localToPackage: packageNameOrInfo
+ 	"Answer a sorted collection of MethodReferences for all the methods that call on aLiteral in the given package."
- 	"Answer a Set of MethodReferences for all the methods
- 	 that call on aSymbol in the given package."
  
+ 	^self
+ 		allCallsOn: aLiteral
+ 		fromBehaviors: (self packageInfoFor: packageNameOrInfo) classesAndMetaClasses
+ 		sorted: true!
- 	| aSet special byte |
- 	aSet := Set new.
- 	special := Smalltalk hasSpecialSelector: aLiteral ifTrueSetByte: [:b | byte := b].
- 	Cursor wait showWhile:
- 		[(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
- 			[:method |
- 			((method hasLiteral: aLiteral) or: [special and: [method scanFor: byte]]) ifTrue:
- 				[((aLiteral isVariableBinding) not
- 					or: [method literals allButLast includes: aLiteral])
- 						ifTrue: [aSet add: method methodReference]]].].
- 	^aSet!

Item was changed:
  ----- Method: SystemNavigation>>allClassesImplementing: (in category 'query') -----
  allClassesImplementing: aSelector  
+ 	"Answer an collection of all classes that implement the message aSelector."
- 	"Answer an Array of all classes that implement the message aSelector."
  
+ 	| result |
+ 	result := OrderedCollection new.
+ 	self allBehaviorsDo: [ :behavior | 
+ 		(behavior includesSelector: aSelector) ifTrue: [
+ 			result add: behavior ] ].
+ 	^result!
- 	| aCollection |
- 	aCollection := ReadWriteStream on: Array new.
- 	self allBehaviorsDo:
- 		[:class | (class includesSelector: aSelector)
- 			ifTrue: [aCollection nextPut: class]].
- 	^ aCollection contents!

Item was changed:
  ----- Method: SystemNavigation>>browseAllAccessesTo:from: (in category 'browse') -----
  browseAllAccessesTo: instVarName from: aClass
+ 	"Create and schedule a Message Set browser for all the receiver's methods or any methods of a subclass/superclass that refer to the instance variable name."
- 	"Create and schedule a Message Set browser for all the receiver's methods 
- 	or any methods of a subclass/superclass that refer to the instance variable name."
- 
  	"self new browseAllAccessesTo: 'contents' from: Collection."
  	
- 	| coll |
- 	coll := OrderedCollection new.
- 	Cursor wait showWhile: [
- 		aClass withAllSubAndSuperclassesDo: [:class | 
- 			(class whichSelectorsAccess: instVarName) do: [:sel |
- 				sel isDoIt ifFalse: [
- 					coll add: (
- 						MethodReference new
- 							setStandardClass: class 
- 							methodSymbol: sel
- 					)
- 				]
- 			]
- 		].
- 	].
  	^ self 
+ 		browseMessageList: [ self allAccessesTo: instVarName from: aClass ]
- 		browseMessageList: coll 
  		name: 'Accesses to ' , instVarName 
  		autoSelect: instVarName!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn: (in category 'browse') -----
  browseAllCallsOn: aLiteral 
+ 	"Create and schedule a message browser on each method that refers to aLiteral."
+ 	"self default browseAllCallsOn: #open:label:."
+ 
+ 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
- 	"Create and schedule a message browser on each method that refers to 
- 	aLiteral. For example, SystemNavigation new browseAllCallsOn: #open:label:."
- 	self headingAndAutoselectForLiteral: aLiteral do:
- 		[:label :autoSelect|
  		self
+ 			browseMessageList: [ self allCallsOn: aLiteral ]
- 			browseMessageList: (self allCallsOn: aLiteral) asSortedCollection
  			name: label
  			autoSelect: autoSelect]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:and: (in category 'browse') -----
  browseAllCallsOn: literal1 and: literal2 
+ 	"Create and schedule a message browser on each method that calls on the two Symbols, literal1 and literal2."
+ 	"self default browseAllCallsOn: #at: and: #at:put:."
- 	"Create and schedule a message browser on each method that calls on the 
- 	two Symbols, literal1 and literal2. For example, SystemNavigation new 
- 	browseAllCallsOn: #at: and: #at:put:."
  
  	^self 
+ 		browseMessageList: [ self allCallsOn: literal1 and: literal2 ]
- 		browseMessageList: (self allCallsOn: literal1 and: literal2)
  		name: literal1 printString , ' -and- ' , literal2 printString!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:from: (in category 'browse') -----
  browseAllCallsOn: aLiteral from: aBehavior
+ 	"Create and schedule a Message Set browser for all the methods that call on aLiteral within aBehavior."
+ 	"self default browseAllCallsOn: #/ from: Number"
- 	"Create and schedule a Message Set browser for
- 	 all the methods that call on aLiteral within aBehavior."
  
+ 	^self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
- 	"self new browseAllCallsOn: #/ from: Number"
- 
- 	^self headingAndAutoselectForLiteral: aLiteral do:
- 		[:label :autoSelect|
  		self 
+ 			browseMessageList: [ self  allCallsOn: aLiteral from: aBehavior ]
- 			browseMessageList: (self  allCallsOn: aLiteral from: aBehavior)
  			name: label, ' from ', aBehavior name
+ 			autoSelect: autoSelect ]
- 			autoSelect: autoSelect]
  
  	!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:localTo: (in category 'browse') -----
+ browseAllCallsOn: aLiteral localTo: aBehavior
+ 	"Create and schedule a message browser on each method in or below the given class that refers to aLiteral."
+ 	"self default browseAllCallsOn: #open:label: localTo: CodeHolder"
- browseAllCallsOn: aLiteral localTo: aClass
- 	"Create and schedule a message browser on each method in or below the given class that refers to
- 	aLiteral. For example, SystemNavigation new browseAllCallsOn: #open:label: localTo: CodeHolder."
  
+ 	aBehavior ifNil: [ ^self inform: 'No behavior selected.' ].
+ 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
+ 		self
+ 			browseMessageList:  [ self allCallsOn: aLiteral from: aBehavior ]
+ 			name: label, ' local to ', aBehavior name
+ 			autoSelect: autoSelect ]!
- 	aClass ifNil: [ ^self inform: 'no selected class' ].
- 	self headingAndAutoselectForLiteral: aLiteral do:
- 		[:label :autoSelect|
- 		self browseMessageList: (aClass allLocalCallsOn: aLiteral) asSortedCollection
- 			name: label, ' local to ', aClass name
- 			autoSelect: autoSelect]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn:localToPackage: (in category 'browse') -----
  browseAllCallsOn: aLiteral localToPackage: packageNameOrInfo
+ 	"Create and schedule a message browser on each method in the given package that refers to aLiteral."
+ 	"self default browseAllCallsOn: #open:label: localToPackage: 'Tools'."
- 	"Create and schedule a message browser on each method in the given package
- 	 that refers to aLiteral. For example,
- 		SystemNavigation new browseAllCallsOn: #open:label: localToPackage: 'Tools'."
  
+ 	self headingAndAutoselectForLiteral: aLiteral do: [ :label :autoSelect |
+ 		self
+ 			browseMessageList: [ 
+ 				self 
+ 					allCallsOn: aLiteral
+ 					localToPackage: packageNameOrInfo ]
- 	self headingAndAutoselectForLiteral: aLiteral do:
- 		[:label :autoSelect|
- 		self browseMessageList: (self allCallsOn: aLiteral localToPackage: packageNameOrInfo) asSortedCollection
  			name: label, ' local to package ', (self packageInfoFor: packageNameOrInfo) name
+ 			autoSelect: autoSelect ]!
- 			autoSelect: autoSelect]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOnClass: (in category 'browse') -----
+ browseAllCallsOnClass: aBehavior
+ 	"Create and schedule a message browser on each method that refers to aClass."
+ 	"self default browseAllCallsOnClass: Array"
+ 	
+ 	| behaviorName |
+ 	behaviorName := aBehavior theNonMetaClass name.
- browseAllCallsOnClass: aClass
- 	"Create and schedule a message browser on each method that refers to 
- 	aClass. For example, SystemNavigation new browseAllCallsOnClass: Object."
  	self
+ 		browseMessageList: [ aBehavior allCallsOn ]
+ 		name: 'Users of ', behaviorName
+ 		autoSelect: behaviorName!
- 		browseMessageList: aClass allCallsOn asSortedCollection
- 		name: 'Users of class ' , aClass theNonMetaClass name
- 		autoSelect: aClass theNonMetaClass name!

Item was changed:
  ----- Method: SystemNavigation>>browseMessageList:name:autoSelect: (in category 'browse') -----
+ browseMessageList: messageListOrBlock name: labelString autoSelect: autoSelectString
+ 	"Create and schedule a MessageSet browser on the message list. If messageListOrBlock is a block, then evaluate it to get the message list."
- browseMessageList: messageList name: labelString autoSelect: autoSelectString
- 	| title aSize |
- 	"Create and schedule a MessageSet browser on the message list."
  
+ 	| messageList title |
+ 	messageList := messageListOrBlock isBlock
+ 		ifTrue: [ Cursor wait showWhile: messageListOrBlock ]
+ 		ifFalse: [ messageListOrBlock ].
+ 	messageList size = 0 ifTrue: [
+ 		^self inform: 'There are no', String cr, labelString ].
+ 	title := messageList size > 1
+ 		ifFalse: [ labelString ]
+ 		ifTrue: [ labelString, ' [', messageList size printString, ']' ].
- 	messageList size = 0 ifTrue: 
- 		[^ self inform: 'There are no
- ' , labelString].
- 
- 	title := (aSize := messageList size) > 1
- 		ifFalse:	[labelString]
- 		ifTrue:	[ labelString, ' [', aSize printString, ']'].
- 
  	ToolSet 
  		browseMessageSet: messageList 
  		name: title 
  		autoSelect: autoSelectString!




More information about the Squeak-dev mailing list