Mercurial Mercurial > hg > stx-goodies-monticello / diff
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | comparison | raw | help
Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
MCMethodDefinition.st
changeset 52 de0d45ac5b93
child 146 e92158173b96 
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/MCMethodDefinition.st	Wed Nov 22 14:09:36 2006 +0100
@@ -0,0 +1,307 @@
+"{ Package: 'stx:goodies/monticello' }"
+
+MCDefinition subclass:#MCMethodDefinition
+	instanceVariableNames:'classIsMeta source category selector className timeStamp'
+	classVariableNames:'Definitions'
+	poolDictionaries:''
+	category:'Monticello-Modeling'
+!
+
+
+!MCMethodDefinition class methodsFor:'as yet unclassified'!
+
+cachedDefinitions
+	Definitions ifNil: [Definitions _ WeakIdentityKeyDictionary new.  WeakArray addWeakDependent: Definitions].
+	^ Definitions
+!
+
+className: classString
+classIsMeta: metaBoolean
+selector: selectorString
+category: catString
+timeStamp: timeString
+source: sourceString
+	^ self instanceLike:
+		(self new initializeWithClassName: classString
+					classIsMeta: metaBoolean
+					selector: selectorString
+					category: catString
+					timeStamp: timeString
+					source: sourceString)
+!
+
+className: classString
+selector: selectorString
+category: catString
+timeStamp: timeString
+source: sourceString
+	^ self	className: classString
+			classIsMeta: false
+			selector: selectorString
+			category: catString
+			timeStamp: timeString
+			source: sourceString
+!
+
+forMethodReference: aMethodReference
+	| definition |
+	definition := self cachedDefinitions at: aMethodReference compiledMethod ifAbsent: [].
+	(definition isNil
+		or: [definition selector ~= aMethodReference methodSymbol]
+		or: [definition className ~= aMethodReference classSymbol]
+		or: [definition classIsMeta ~= aMethodReference classIsMeta]
+		or: [definition category ~= aMethodReference category])
+			ifTrue: [definition := self 
+						className: aMethodReference classSymbol
+						classIsMeta: aMethodReference classIsMeta
+						selector: aMethodReference methodSymbol
+						category: aMethodReference category
+						timeStamp: aMethodReference timeStamp
+						source: aMethodReference source.
+					self cachedDefinitions at: aMethodReference compiledMethod put: definition].
+	^ definition
+	
+!
+
+initialize
+	Smalltalk addToShutDownList: self
+!
+
+shutDown
+	WeakArray removeWeakDependent: Definitions.
+	Definitions _ nil.
+! !
+
+!MCMethodDefinition methodsFor:'accessing'!
+
+actualClass
+	^Smalltalk at: className
+		ifPresent: [:class | classIsMeta ifTrue: [class class] ifFalse: [class]]
+!
+
+category
+	^ category
+!
+
+classIsMeta
+	^ classIsMeta
+!
+
+className
+	^className
+!
+
+fullTimeStamp
+	^TimeStamp fromMethodTimeStamp: timeStamp
+!
+
+load
+	self actualClass
+		compile: source
+		classified: category
+		withStamp: timeStamp
+		notifying: (SyntaxError new category: category)
+!
+
+selector
+	^selector
+!
+
+source
+	^ source
+!
+
+timeStamp
+	^ timeStamp
+! !
+
+!MCMethodDefinition methodsFor:'annotations'!
+
+printAnnotations: requests on: aStream
+	"Add a string for an annotation pane, trying to fulfill the annotation requests.
+	These might include anything that
+		Preferences defaultAnnotationRequests 
+	might return. Which includes anything in
+		Preferences annotationInfo
+	To edit these, use:"
+	"Preferences editAnnotations"
+
+	requests do: [ :aRequest |
+		aRequest == #timeStamp ifTrue: [ aStream nextPutAll: self timeStamp ].
+		aRequest == #messageCategory ifTrue: [ aStream nextPutAll: self category ].
+		aRequest == #requirements ifTrue: [
+			self requirements do: [ :req |
+				aStream nextPutAll: req ] separatedBy: [ aStream space ]].
+	] separatedBy: [ aStream space ].
+! !
+
+!MCMethodDefinition methodsFor:'comparing'!
+
+= aDefinition
+	^(super = aDefinition)
+		and: [aDefinition source = self source]
+		and: [aDefinition category = self category]
+		and: [aDefinition timeStamp = self timeStamp]
+!
+
+hash
+	| hash |
+	hash _ String stringHash: classIsMeta asString initialHash: 0.
+	hash _ String stringHash: source initialHash: hash.
+	hash _ String stringHash: category initialHash: hash.
+	hash _ String stringHash: className initialHash: hash.
+	^ hash
+!
+
+requirements
+	^ Array with: className
+!
+
+sortKey
+	^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector
+! !
+
+!MCMethodDefinition methodsFor:'installing'!
+
+isExtensionMethod
+	^ category beginsWith: '*'
+!
+
+isOverrideMethod
+	"this oughta check the package"
+	^ self isExtensionMethod and: [category endsWith: '-override']
+!
+
+postload
+	self isInitializer ifTrue: [self actualClass theNonMetaClass initialize]
+!
+
+scanForPreviousVersion
+	| position prevPos prevFileIndex preamble tokens sourceFilesCopy stamp method file methodCategory |
+	method _ self actualClass compiledMethodAt: selector ifAbsent: [^ nil].
+	position _ method filePosition.
+	sourceFilesCopy _ SourceFiles collect:
+		[:x | x isNil ifTrue: [ nil ]
+				ifFalse: [x readOnlyCopy]].
+	[method fileIndex == 0 ifTrue: [^ nil].
+	file _ sourceFilesCopy at: method fileIndex.
+	[position notNil & file notNil]
+		whileTrue:
+		[file position: (0 max: position-150).  "Skip back to before the preamble"
+		[file position < (position-1)]  "then pick it up from the front"
+			whileTrue: [preamble _ file nextChunk].
+
+		"Preamble is likely a linked method preamble, if we're in
+			a changes file (not the sources file).  Try to parse it
+			for prior source position and file index"
+		prevPos _ nil.
+		stamp _ ''.
+		(preamble findString: 'methodsFor:' startingAt: 1) > 0
+			ifTrue: [tokens _ Scanner new scanTokens: preamble]
+			ifFalse: [tokens _ Array new  "ie cant be back ref"].
+		((tokens size between: 7 and: 8)
+			and: [(tokens at: tokens size-5) = #methodsFor:])
+			ifTrue:
+				[(tokens at: tokens size-3) = #stamp:
+				ifTrue: ["New format gives change stamp and unified prior pointer"
+						stamp _ tokens at: tokens size-2.
+						prevPos _ tokens last.
+						prevFileIndex _ sourceFilesCopy fileIndexFromSourcePointer: prevPos.
+						prevPos _ sourceFilesCopy filePositionFromSourcePointer: prevPos]
+				ifFalse: ["Old format gives no stamp; prior pointer in two parts"
+						prevPos _ tokens at: tokens size-2.
+						prevFileIndex _ tokens last].
+				(prevPos = 0 or: [prevFileIndex = 0]) ifTrue: [prevPos _ nil]].
+		((tokens size between: 5 and: 6)
+			and: [(tokens at: tokens size-3) = #methodsFor:])
+			ifTrue:
+				[(tokens at: tokens size-1) = #stamp:
+				ifTrue: ["New format gives change stamp and unified prior pointer"
+						stamp _ tokens at: tokens size]].
+		methodCategory _ tokens after: #methodsFor: ifAbsent: ['as yet unclassifed'].
+		methodCategory = category ifFalse:
+			[methodCategory = (Smalltalk 
+									at: #Categorizer 
+									ifAbsent: [Smalltalk at: #ClassOrganizer]) 
+										default ifTrue: [methodCategory _ methodCategory, ' '].
+			^ ChangeRecord new file: file position: position type: #method
+						class: className category: methodCategory meta: classIsMeta stamp: stamp].
+		position _ prevPos.
+		prevPos notNil ifTrue:
+			[file _ sourceFilesCopy at: prevFileIndex]].
+		^ nil]
+			ensure: [sourceFilesCopy do: [:x | x notNil ifTrue: [x close]]]
+	
+!
+
+unload
+	| previousVersion |
+	self isOverrideMethod ifTrue: [previousVersion _ self scanForPreviousVersion].
+	previousVersion
+		ifNil: [self actualClass ifNotNilDo: [:class | class removeSelector: selector]]
+		ifNotNil: [previousVersion fileIn] 
+! !
+
+!MCMethodDefinition methodsFor:'printing'!
+
+description
+	^ Array	
+		with: className
+		with: selector
+		with: classIsMeta
+!
+
+fullClassName
+	^ self classIsMeta
+		ifFalse: [self className]
+		ifTrue: [self className, ' class']
+!
+
+summary
+	^ self fullClassName , '>>' , selector
+! !
+
+!MCMethodDefinition methodsFor:'serializing'!
+
+initializeWithClassName: classString
+classIsMeta: metaBoolean
+selector: selectorString
+category: catString
+timeStamp: timeString
+source: sourceString
+	className _ classString asSymbol.
+	selector _ selectorString asSymbol.
+	category _ catString asSymbol.
+	timeStamp _ timeString.
+	classIsMeta _ metaBoolean.
+	source _ sourceString withSqueakLineEndings.
+! !
+
+!MCMethodDefinition methodsFor:'testing'!
+
+isCodeDefinition
+	^ true
+!
+
+isInitializer
+	^ selector = #initialize and: [classIsMeta]
+	
+!
+
+isMethodDefinition
+	^true
+! !
+
+!MCMethodDefinition methodsFor:'visiting'!
+
+accept: aVisitor
+	^ aVisitor visitMethodDefinition: self
+! !
+
+!MCMethodDefinition class methodsFor:'documentation'!
+
+version
+    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.1 2006-11-22 13:09:36 cg Exp $'
+! !
+
+MCMethodDefinition initialize!
hg/stx-goodies-monticello