[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
|