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 187 fe82fa7ff57b
parent 146 e92158173b96
child 269 afcd566792e2 
--- a/MCMethodDefinition.st	Sat Aug 20 13:39:05 2011 +0200
+++ b/MCMethodDefinition.st	Sat Aug 20 13:40:49 2011 +0200
@@ -11,8 +11,10 @@
 !MCMethodDefinition class methodsFor:'as yet unclassified'!
 
 cachedDefinitions
-	Definitions ifNil: [Definitions _ WeakIdentityKeyDictionary new.  WeakArray addWeakDependent: Definitions].
-	^ Definitions
+        Definitions ifNil: [Definitions := WeakIdentityDictionary new.  WeakArray addDependent: Definitions].
+        ^ Definitions
+
+    "Modified: / 26-08-2009 / 12:20:45 / Jaroslav Havlin <havlij6@fel.cvut.cz>"
 !
 
 className: classString
@@ -64,21 +66,23 @@
 !
 
 initialize
-    Smalltalk isSmalltalkX ifFalse:[
+    "
         Smalltalk addToShutDownList: self
-    ]
+    "
+
+    "Modified: / 13-10-2010 / 14:12:35 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 shutDown
 	WeakArray removeWeakDependent: Definitions.
-	Definitions _ nil.
+	Definitions := nil.
 ! !
 
 !MCMethodDefinition methodsFor:'accessing'!
 
 actualClass
 	^Smalltalk at: className
-		ifPresent: [:class | classIsMeta ifTrue: [class class] ifFalse: [class]]
+		ifPresent: [:class | classIsMeta ifTrue: [class classSide] ifFalse: [class]]
 !
 
 category
@@ -94,15 +98,7 @@
 !
 
 fullTimeStamp
-	^TimeStamp fromMethodTimeStamp: timeStamp
-!
-
-load
-	self actualClass
-		compile: source
-		classified: category
-		withStamp: timeStamp
-		notifying: (SyntaxError new category: category)
+	^Timestamp fromMethodTimeStamp: timeStamp
 !
 
 selector
@@ -140,18 +136,21 @@
 !MCMethodDefinition methodsFor:'comparing'!
 
 = aDefinition
-	^(super = aDefinition)
-		and: [aDefinition source = self source]
-		and: [aDefinition category = self category]
-		and: [aDefinition timeStamp = self timeStamp]
+        ^(super = aDefinition)
+                and: [aDefinition source = self source
+                and: [aDefinition category = self category
+                "and: [aDefinition timeStamp = self timeStamp]"]]
+
+    "Modified: / 18-08-2009 / 10:18:43 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 14-09-2010 / 19:03:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 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 := 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
 !
 
@@ -163,6 +162,22 @@
 	^ self className, '.', (self classIsMeta ifTrue: ['meta'] ifFalse: ['nonmeta']), '.', self selector
 ! !
 
+!MCMethodDefinition methodsFor:'converting'!
+
+asChange
+
+    ^MethodDefinitionChange new
+        mcDefinition: self;
+        className: className , (classIsMeta ifTrue:[' class'] ifFalse:['']);
+        selector: selector;
+        source: source asStringWithNativeLineEndings;
+        category: category;
+        yourself
+
+    "Created: / 13-10-2010 / 17:17:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 08-11-2010 / 17:56:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !MCMethodDefinition methodsFor:'installing'!
 
 isExtensionMethod
@@ -174,74 +189,104 @@
 	^ self isExtensionMethod and: [category endsWith: '-override']
 !
 
-postload
-	self isInitializer ifTrue: [self actualClass theNonMetaClass initialize]
+load
+    | package oldMethod newMethod |
+    package := MCStXPackageQuery query.
+    oldMethod := self actualClass compiledMethodAt: self selector.
+    (oldMethod notNil and:[oldMethod package ~= package])
+        ifTrue:[Class methodRedefinitionNotification
+                    raiseRequestWith: (oldMethod -> self)].
+
+    newMethod := self actualClass
+                compile: source asStringWithNativeLineEndings
+                classified: category
+                withStamp: timeStamp
+                "notifying: (SyntaxError new category: category)".
+    newMethod package: package
+
+    "Modified: / 08-11-2010 / 20:13:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+postloadOver: aDefinition
+	super postloadOver: aDefinition.
+	(self isInitializer
+		and: [ self actualClass isTrait not ]
+		and: [ aDefinition isNil or: [ self source ~= aDefinition source ] ]) 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:
+	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.
+	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].
+			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 _ ''.
+		prevPos := nil.
+		stamp := ''.
 		(preamble findString: 'methodsFor:' startingAt: 1) > 0
-			ifTrue: [tokens _ Scanner new scanTokens: preamble]
-			ifFalse: [tokens _ Array new  "ie cant be back ref"].
+			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]
+						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]].
+						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'].
+						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, ' '].
+										default ifTrue: [methodCategory := methodCategory, ' '].
 			^ ChangeRecord new file: file position: position type: #method
 						class: className category: methodCategory meta: classIsMeta stamp: stamp].
-		position _ prevPos.
+		position := prevPos.
 		prevPos notNil ifTrue:
-			[file _ sourceFilesCopy at: prevFileIndex]].
+			[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] 
+        | previousVersion class |
+
+        (class := self actualClass) ifNotNil: [class removeSelector: selector].
+        ^self.
+
+        "Original stuff"
+
+        self isOverrideMethod ifTrue: [previousVersion := self scanForPreviousVersion].
+        previousVersion
+                ifNil: [(class := self actualClass) ifNotNil: [class removeSelector: selector]]
+                ifNotNil: [previousVersion fileIn]
+
+    "Modified: / 11-09-2010 / 18:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MCMethodDefinition methodsFor:'printing'!
@@ -254,15 +299,32 @@
 !
 
 fullClassName
+	"Using #class selector for classes for backwards compatibility"
+
 	^ self classIsMeta
 		ifFalse: [self className]
-		ifTrue: [self className, ' class']
+		ifTrue: [
+			(self actualClass isNil or: [ self actualClass isTrait ])
+				ifFalse: [self className, ' class']
+				ifTrue: [self className, ' classSide']]
 !
 
 summary
 	^ self fullClassName , '>>' , selector
 ! !
 
+!MCMethodDefinition methodsFor:'private'!
+
+existingMethodOrNil
+    | actualClass |
+    actualClass := self actualClass.
+    ^actualClass 
+        ifNil:[nil]
+        ifNotNil: [actualClass compiledMethodAt:self selector]
+
+    "Modified: / 08-11-2010 / 17:41:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !MCMethodDefinition methodsFor:'serializing'!
 
 initializeWithClassName: classString
@@ -270,13 +332,15 @@
 selector: selectorString
 category: catString
 timeStamp: timeString
-source: sourceString
-	className _ classString asSymbol.
-	selector _ selectorString asSymbol.
-	category _ catString asSymbol.
-	timeStamp _ timeString.
-	classIsMeta _ metaBoolean.
-	source _ sourceString withSqueakLineEndings.
+source: sourceString 
+        className := classString asSymbol.
+        selector := selectorString asSymbol.
+        category := catString asSymbol.
+        timeStamp := timeString.
+        classIsMeta := metaBoolean.
+        source := sourceString asStringWithSqueakLineEndings.
+
+    "Modified: / 12-09-2010 / 16:02:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MCMethodDefinition methodsFor:'testing'!
@@ -292,6 +356,18 @@
 
 isMethodDefinition
 	^true
+!
+
+isOverrideDefinition
+
+    | oldMethod |
+
+    oldMethod := self existingMethodOrNil.
+    ^oldMethod 
+        ifNil:[false]
+        ifNotNil:[oldMethod package ~= MCStXPackageQuery query]
+
+    "Created: / 08-11-2010 / 17:29:36 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MCMethodDefinition methodsFor:'visiting'!
@@ -302,12 +378,12 @@
 
 !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.3 2011-08-20 11:40:49 cg Exp $'
 !
 
-version_CVS
-    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCMethodDefinition.st,v 1.2 2009-10-26 15:25:29 cg Exp $'
+version_SVN
+    ^ '§Id: MCMethodDefinition.st 24 2010-11-09 14:00:17Z vranyj1 §'
 ! !
 
 MCMethodDefinition initialize!
hg/stx-goodies-monticello