The Trunk: System-eem.369.mcz

Eliot Miranda uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-eem.369.mcz

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

Name: System-eem.369
Author: eem
Time: 4 September 2010, 10:57:34.748 am
UUID: b2ab3724-956d-4d92-8c32-accfa7dd8079
Ancestors: System-nice.368

Package-local queries allCallsOn:localToPackage:
allImplementorsOf:localToPackage: and
allMethodsSelect:localToPackage: that take either a package
name or a PackageInfo.  Needs PackageInfo-Base-eem.44.

Refactoring of deriving label and auto-select string for
the allCallsOn: variants so that one can use a Symbol
a binding (association) or an arbitrary literal.

Try e.g.
SystemNavigation new
        browseAllCallsOn: OrderedCollection binding
        localToPackage: 'Compiler'
       
SystemNavigation new
        browseAllCallsOn: 32
        localToPackage: 'Compiler'
       
SystemNavigation new
        browseAllCallsOn: 42 - 2
        localToPackage: 'Compiler'

=============== Diff against System-nice.368 ===============

Item was added:
+ ----- 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. For example,
+ SystemNavigation new browseAllCallsOn: #open:label: localToPackage: 'Tools'."
+
+ 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]!

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."
- browseAllCallsOn: aSymbol from: aClass
- "Create and schedule a Message Set browser for all the methods that call
- on aSymbol."
 
+ "self new browseAllCallsOn: #/ from: Number"
- "self new browseAllCallsOn: #/. from: Number"
 
+ ^self headingAndAutoselectForLiteral: aLiteral do:
+ [:label :autoSelect|
+ self
+ browseMessageList: (self  allCallsOn: aLiteral from: aBehavior)
+ name: label, ' from ', aBehavior name
+ autoSelect: autoSelect]
- | key label |
- label := (aSymbol isKindOf: LookupKey)
- ifTrue: ['Users of ' , (key := aSymbol key)]
- ifFalse: ['Senders of ' , (key := aSymbol)].
- ^ self
- browseMessageList: (self  allCallsOn: aSymbol from: aClass)
- name: label
- autoSelect: key
 
  !

Item was added:
+ ----- Method: SystemNavigation>>browseAllImplementorsOf:localToPackage: (in category 'browse') -----
+ browseAllImplementorsOf: selector localToPackage: packageNameOrInfo
+ "Create and schedule a message browser on each method in the given package
+ that implements the message whose selector is the argument, selector. For example,
+ SystemNavigation new browseAllImplementorsOf: #at:put: localToPackage: 'Collections'."
+
+ self browseMessageList: (self
+ allImplementorsOf: selector
+ localToPackage: packageNameOrInfo) asSortedCollection
+ name: 'Implementors of ' , selector,
+ ' local to package ', (self packageInfoFor: packageNameOrInfo) name!

Item was added:
+ ----- Method: SystemNavigation>>headingAndAutoselectForLiteral:do: (in category 'private') -----
+ headingAndAutoselectForLiteral: aLiteral do: binaryBlock
+ "Evaluate aBlock with either Users of ... or Senders of ... plus the auto-select string
+ for the given literal.  aLiteral can be a Symbol, a VariableBinding or an arbitrary object."
+
+ | autoSelect |
+ ^aLiteral isSymbol
+ ifTrue: [binaryBlock value: 'Senders of ', aLiteral value: aLiteral keywords first]
+ ifFalse:
+ [autoSelect := aLiteral isVariableBinding
+ ifTrue: [aLiteral key]
+ ifFalse: [aLiteral printString].
+ binaryBlock value: 'Users of ', autoSelect value: autoSelect]!

Item was added:
+ ----- Method: SystemNavigation>>allCallsOn:localToPackage: (in category 'query') -----
+ allCallsOn: aLiteral localToPackage: packageNameOrInfo
+ "Answer a Set of MethodReferences for all the methods
+ that call on aSymbol in the given package."
+
+ | 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>>browseAllCallsOn:localTo: (in category 'browse') -----
  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."
- aLiteral. For example, Smalltalk browseAllCallsOn: #open:label:."
 
  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]!
- (aLiteral isKindOf: LookupKey)
- ifTrue: [self browseMessageList: (aClass allLocalCallsOn: aLiteral) asSortedCollection
- name: 'Users of ' , aLiteral key, ' local to ', aClass name
- autoSelect: aLiteral key]
- ifFalse: [self browseMessageList: (aClass allLocalCallsOn: aLiteral) asSortedCollection
- name: 'Senders of ' , aLiteral, ' local to ', aClass name
- autoSelect: aLiteral keywords first]!

Item was changed:
  ----- Method: SystemNavigation>>browseAllCallsOn: (in category 'browse') -----
  browseAllCallsOn: aLiteral
  "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) asSortedCollection
+ name: label
+ autoSelect: autoSelect]!
- (aLiteral isKindOf: LookupKey)
- ifTrue: [^ self
- browseMessageList: (self allCallsOn: aLiteral) asSortedCollection
- name: 'Users of ' , aLiteral key
- autoSelect: aLiteral key].
- self
- browseMessageList: (self allCallsOn: aLiteral) asSortedCollection
- name: 'Senders of ' , aLiteral
- autoSelect: aLiteral keywords first!

Item was added:
+ ----- Method: SystemNavigation>>packageInfoFor: (in category 'private') -----
+ packageInfoFor: packageInfoOrString
+ ^packageInfoOrString isString
+ ifTrue: [PackageInfo named: packageInfoOrString]
+ ifFalse: [packageInfoOrString]!

Item was added:
+ ----- Method: SystemNavigation>>allMethodsSelect:localToPackage: (in category 'query') -----
+ allMethodsSelect: aBlock localToPackage: packageNameOrInfo
+ "Answer a SortedCollection of each method in the given package
+ for which the evaluation of aBlock with the metnod answers true."
+
+ | aSet |
+ aSet := Set new.
+ Cursor wait showWhile:
+ [(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
+ [:aMethod |
+ (aBlock value: aMethod) ifTrue:
+ [aSet add: aMethod methodReference]]].
+ ^aSet!

Item was added:
+ ----- Method: SystemNavigation>>allImplementorsOf:localToPackage: (in category 'query') -----
+ allImplementorsOf: aSelector  localToPackage: packageNameOrInfo
+ "Answer a SortedCollection of all the methods that implement the message
+ aSelector in the given package."
+
+ | aSet |
+ aSet := Set new.
+ Cursor wait showWhile:
+ [(self packageInfoFor: packageNameOrInfo) actualMethodsDo:
+ [:m |
+ (m selector = aSelector) ifTrue:
+ [aSet add: m methodReference]]].
+ ^aSet!

Item was added:
+ ----- Method: SystemNavigation>>allCallsOn:localTo: (in category 'query') -----
+ allCallsOn: aSymbol localTo: aClass
+ "Answer a Set of MethodReferences for all the methods
+ that call on aSymbol in, above or below the given class."
+
+ | 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!