The Trunk: System-fbs.536.mcz

Frank Shearar uploaded a new version of System to project The Trunk:
http://source.squeak.org/trunk/System-fbs.536.mcz

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

Name: System-fbs.536
Author: fbs
Time: 21 May 2013, 10:52:46.108 pm
UUID: 543cd5f6-1000-4ca1-b790-710528460d66
Ancestors: System-fbs.535

MethodReference new setStandardClass: foo methodSymbol: bar -> MethodReference class: foo selector: bar.

And the very first toehold of making MethodReference Environmentally friendly.

=============== Diff against System-fbs.535 ===============

Item was changed:
  Object subclass: #MethodReference
+ instanceVariableNames: 'classSymbol classIsMeta methodSymbol stringVersion category environment'
- instanceVariableNames: 'classSymbol classIsMeta methodSymbol stringVersion category'
  classVariableNames: ''
  poolDictionaries: ''
  category: 'System-Tools'!
 
  !MethodReference commentStamp: 'tlk 5/9/2006 18:43' prior: 0!
  A MethodReference is is a lightweight proxy for a CompiledMethod.  Has methods for pointed to the CompileMethod's source statements, byte codes. Is heavily used my Tools.
 
  Instance Variables
  classIsMeta:     Boolean class vs. instance
  classSymbol: Symbol for method's class (without class keyword if meta)
  methodSymbol: Symbol for method's selector
  stringVersion: 'Class>>selector:' format
 
  !

Item was changed:
  ----- Method: MethodReference class>>class:selector: (in category 'instance creation') -----
  class: aClass selector: aSelector
+ ^ self class: aClass selector: aSelector environment: Smalltalk globals.!
- ^ self new setStandardClass: aClass methodSymbol: aSelector!

Item was added:
+ ----- Method: MethodReference class>>class:selector:environment: (in category 'instance creation') -----
+ class: aClass selector: aSelector environment: anEnvironment
+ ^ self new setStandardClass: aClass methodSymbol: aSelector environment: anEnvironment.!

Item was added:
+ ----- Method: MethodReference>>setStandardClass:methodSymbol:environment: (in category 'initialize-release') -----
+ setStandardClass: aClass methodSymbol: aSelector environment: anEnvironment
+ classSymbol := aClass theNonMetaClass name.
+ classIsMeta := aClass isMeta.
+ methodSymbol := aSelector.
+ environment := anEnvironment.
+ stringVersion := nil.!

Item was changed:
  ----- Method: SystemNavigation>>allMethodsSelect:localTo: (in category 'query') -----
  allMethodsSelect: aBlock localTo: aClass
  "Answer a SortedCollection of each methodr in, above, or below the given
  class that, when used as the argument to aBlock, gives a true result."
 
  | aSet |
  aSet := Set new.
  Cursor wait showWhile:
  [aClass theNonMetaClass withAllSuperAndSubclassesDoGently:
  [:class |
  class selectorsAndMethodsDo:
  [:aSelector :aMethod|
  (aBlock value: aMethod) ifTrue:
+ [aSet add: (MethodReference class: class selector: aSelector)]]].
- [aSet add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]].
  aClass theNonMetaClass class withAllSuperAndSubclassesDoGently:
  [:class |
  class selectorsAndMethodsDo:
  [:aSelector :aMethod|
  (aBlock value: aMethod) ifTrue:
+ [aSet add: (MethodReference class: class selector: aSelector)]]]].
- [aSet add: (MethodReference new setStandardClass: class methodSymbol: aSelector)]]]].
  ^aSet!

Item was changed:
  ----- Method: SystemNavigation>>allReferencesToPool:from: (in category 'query') -----
  allReferencesToPool: aPool from: aClass
  "Answer all the references to variables from aPool"
  | list |
  list := OrderedCollection new.
  aClass withAllSubclassesDo:[:cls|
  cls selectorsAndMethodsDo:[:sel :meth|
  (meth hasLiteralSuchThat: [:lit| lit isVariableBinding and:[(aPool bindingOf: lit key) notNil]]) ifTrue:
+ [list add:(MethodReference class: cls selector: sel)]]].
- [list add:(MethodReference new setStandardClass: cls methodSymbol: sel)]]].
  ^list!

Item was changed:
  ----- Method: SystemNavigation>>browseClassCommentsWithString: (in category 'browse') -----
  browseClassCommentsWithString: aString
  "Smalltalk browseClassCommentsWithString: 'my instances' "
  "Launch a message list browser on all class comments containing aString as a substring."
 
  | caseSensitive suffix list |
 
  suffix := (caseSensitive := Sensor shiftPressed)
  ifTrue: [' (case-sensitive)']
  ifFalse: [' (use shift for case-sensitive)'].
  list := Set new.
  Cursor wait showWhile: [
  Smalltalk allClassesDo: [:class |
  (class organization classComment asString findString: aString
  startingAt: 1 caseSensitive: caseSensitive) > 0 ifTrue: [
  list add: (
+ MethodReference
+ class: class
+ selector: #Comment
- MethodReference new
- setStandardClass: class
- methodSymbol: #Comment
  )
  ]
  ]
  ].
  ^ self
  browseMessageList: list asSortedCollection
  name: 'Class comments containing ' , aString printString , suffix
  autoSelect: aString!

Item was changed:
  ----- Method: TextDomainManager class>>allMethodsWithTranslations (in category 'accessing') -----
  allMethodsWithTranslations
  "Look for #translated calls"
  | methodsWithTranslations |
  methodsWithTranslations := TranslatedReceiverFinder new stringReceiversWithContext: #translated.
  methodsWithTranslations := methodsWithTranslations ,
  (TranslatedReceiverFinder new stringReceiversWithContext: #translatedNoop).
 
  methodsWithTranslations := methodsWithTranslations collect: [:each | each key compiledMethod].
 
  "Look for Etoys tiles and vocabularies"
  methodsWithTranslations := methodsWithTranslations , (EToyVocabulary allPhrasesWithContextToTranslate collect: [:r |
+ (MethodReference class: r second selector: r third) compiledMethod]).
- (MethodReference new setStandardClass: r second methodSymbol: r third) compiledMethod]).
 
  ^methodsWithTranslations!