[squeak-dev] The Trunk: System-ul.436.mczChris Muller asqueaker at gmail.comTue May 10 01:59:52 UTC 2011
Uh oh, lookout! Levente is pulling out the Generator!! :-) On Mon, May 9, 2011 at 7:32 PM, <commits at source.squeak.org> wrote: > 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 |