[Pkg] The Trunk: System-fbs.536.mcz

commits at source.squeak.org commits at source.squeak.org
Tue May 21 21:54:00 UTC 2013


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!



More information about the Packages mailing list