--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MethodReference.st	Sat Aug 20 15:17:11 2011 +0200
@@ -0,0 +1,266 @@
+"{ Package: 'stx:goodies/monticello' }"
+
+Object subclass:#MethodReference
+	instanceVariableNames:'classSymbol classIsMeta methodSymbol stringVersion category'
+	classVariableNames:''
+	poolDictionaries:''
+	category:'System-Tools'
+!
+
+MethodReference comment:'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
+
+'
+!
+
+
+!MethodReference class methodsFor:'instance creation'!
+
+class: aClass selector: aSelector
+	^ self new setStandardClass: aClass methodSymbol: aSelector
+! !
+
+!MethodReference methodsFor:'*Kernel-Traits'!
+
+actualClass 
+
+	| actualClass |
+
+	actualClass := Smalltalk at: classSymbol ifAbsent: [^nil].
+	classIsMeta ifTrue: [^actualClass classSide].
+	^actualClass
+
+! !
+
+!MethodReference methodsFor:'*OB-Standard'!
+
+asNode
+	^ OBMethodNode on: self
+! !
+
+!MethodReference methodsFor:'*fixunderscores'!
+
+fixLFInvisible
+	"Replace invisible with space. Answer true if fixed or no fix necessary, false if manual fix required"
+
+	| src ts |
+	"Check if we do need to do anything"
+	src := self actualClass sourceCodeAt: methodSymbol.
+	(src includes: Character lf) ifFalse: [^true].
+
+	"Chicken out if there is a literal underscore"
+	"cm := self actualClass compiledMethodAt: methodSymbol.
+	(cm hasLiteralSuchThat: [:lit | 
+		lit = Character lf or: [lit isString and: [lit includes: Character lf]]]) ifTrue: [^false]."
+
+	"Otherwise, replace underscores with :="
+	src := src copyReplaceAll: Character lf asString with: Character space asString, Character cr asString.
+	ts := self timeStamp.
+	ts = '' ifTrue: [ts := nil].
+	self actualClass 
+		compile: src
+		classified: ClassOrganizer default
+		withStamp: ts 
+		notifying: nil.
+
+	^true
+!
+
+fixUnderscores
+	"Replace underscores with :=. Answer true if fixed or no fix necessary, false if manual fix required"
+
+	| src cm ts |
+	"Check if we do need to do anything"
+	src := self actualClass sourceCodeAt: methodSymbol.
+	(src includes: $_) ifFalse: [^true].
+
+	"Chicken out if there is a literal underscore"
+	cm := self actualClass compiledMethodAt: methodSymbol.
+	(cm hasLiteralSuchThat: [:lit | 
+		lit = $_ or: [lit isString and: [lit includes: $_]]]) ifTrue: [^false].
+
+	"Otherwise, replace underscores with :="
+	src := src copyReplaceAll: '_' with: ':='.
+	ts := self timeStamp.
+	ts = '' ifTrue: [ts := nil].
+	self actualClass 
+		compile: src
+		classified: ClassOrganizer default
+		withStamp: ts 
+		notifying: nil.
+
+	^true
+! !
+
+!MethodReference methodsFor:'*monticello'!
+
+asMethodDefinition
+	^ MCMethodDefinition forMethodReference: self
+!
+
+compiledMethod
+	^ self actualClass compiledMethodAt: methodSymbol
+!
+
+isLocalSelector
+	^self actualClass
+		includesLocalSelector: self methodSymbol
+!
+
+source
+        ^ (self actualClass sourceCodeAt: methodSymbol) asString asStringWithSqueakLineEndings
+
+    "Modified: / 12-09-2010 / 16:06:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+timeStamp
+	^ self compiledMethod timeStamp
+! !
+
+!MethodReference methodsFor:'*packageinfo-base'!
+
+sourceCode
+	^ self actualClass sourceCodeAt: methodSymbol
+! !
+
+!MethodReference methodsFor:'comparisons'!
+
+<= anotherMethodReference
+
+	classSymbol < anotherMethodReference classSymbol ifTrue: [^true].
+	classSymbol > anotherMethodReference classSymbol ifTrue: [^false].
+	classIsMeta = anotherMethodReference classIsMeta ifFalse: [^classIsMeta not].
+	^methodSymbol <= anotherMethodReference methodSymbol
+!
+
+= anotherMethodReference 
+	"Answer whether the receiver and the argument represent the 
+	same object."
+	^ self species == anotherMethodReference species
+		and: [self classSymbol = anotherMethodReference classSymbol]
+		and: [self classIsMeta = anotherMethodReference classIsMeta]
+		and: [self methodSymbol = anotherMethodReference methodSymbol]
+!
+
+hash
+	"Answer a SmallInteger whose value is related to the receiver's  
+	identity."
+	^ (self species hash bitXor: self classSymbol hash)
+		bitXor: self methodSymbol hash
+! !
+
+!MethodReference methodsFor:'queries'!
+
+asStringOrText
+
+	^stringVersion
+!
+
+category
+	^ category ifNil: [category := self actualClass organization categoryOfElement: methodSymbol]
+!
+
+classIsMeta
+
+	^classIsMeta
+!
+
+classSymbol
+
+	^classSymbol
+!
+
+isValid
+	"Answer whether the receiver represents a current selector or Comment"
+
+	| aClass |
+	methodSymbol isDoIt ifTrue: [^ false].
+	(aClass := self actualClass) ifNil: [^ false].
+	^ (aClass includesSelector: methodSymbol) or:
+		[methodSymbol == #Comment]
+!
+
+methodSymbol
+
+	^methodSymbol
+!
+
+printOn: aStream
+        "Print the receiver on a stream"
+
+        "super printOn: aStream."
+        aStream nextPutAll: '"REF" ', self actualClass name, ' >> #', methodSymbol
+
+    "Modified: / 12-09-2010 / 19:03:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+sourceString
+	^ (self actualClass sourceCodeAt: self methodSymbol) asString
+! !
+
+!MethodReference methodsFor:'setting'!
+
+setClass: aClass methodSymbol: methodSym stringVersion: aString 
+
+	classSymbol := aClass theNonMetaClass name.
+	classIsMeta := aClass isMeta.
+	methodSymbol := methodSym.
+	stringVersion := aString.
+!
+
+setClassAndSelectorIn: csBlock
+
+	^csBlock value: self actualClass value: methodSymbol
+!
+
+setClassSymbol: classSym classIsMeta: isMeta methodSymbol: methodSym stringVersion: aString 
+
+	classSymbol := classSym.
+	classIsMeta := isMeta.
+	methodSymbol := methodSym.
+	stringVersion := aString.
+!
+
+setStandardClass: aClass methodSymbol: methodSym
+
+	classSymbol := aClass theNonMetaClass name.
+	classIsMeta := aClass isMeta.
+	methodSymbol := methodSym.
+	stringVersion := aClass name , ' ' , methodSym.
+! !
+
+!MethodReference methodsFor:'string version'!
+
+category: aString
+	
+	 category := aString
+!
+
+stringVersion
+
+	^stringVersion
+!
+
+stringVersion: aString
+
+	stringVersion := aString
+! !
+
+!MethodReference class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MethodReference.st,v 1.1 2011-08-20 13:17:11 cg Exp $'
+!
+
+version_CVS
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MethodReference.st,v 1.1 2011-08-20 13:17:11 cg Exp $'
+!
+
+version_SVN
+    ^ '§Id: MethodReference.st 8 2010-09-12 17:15:52Z vranyj1 §'
+! !