"{ 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 isSmalltalkX ifFalse:[
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.2 2009-10-26 15:25:29 cg Exp $'
!
version_CVS
^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.2 2009-10-26 15:25:29 cg Exp $'
! !
MCMethodDefinition initialize!