"{ 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!