MethodChange.st
branchjv
changeset 3838 474d8ec95b33
parent 3434 a140fb9f5970
parent 3835 2abde322db34
child 3862 476566b38577
--- a/MethodChange.st	Tue Feb 04 21:01:56 2014 +0100
+++ b/MethodChange.st	Wed Apr 01 10:37:40 2015 +0100
@@ -1,3 +1,5 @@
+"{ Encoding: utf8 }"
+
 "
  COPYRIGHT (c) 1993 by Claus Gittinger
 	       All Rights Reserved
@@ -11,6 +13,8 @@
 "
 "{ Package: 'stx:libbasic3' }"
 
+"{ NameSpace: Smalltalk }"
+
 ClassChange subclass:#MethodChange
 	instanceVariableNames:'selector methodCategory privacy previousVersion'
 	classVariableNames:'LastReplacementClass'
@@ -90,7 +94,7 @@
 
     cls := self changeClass.
     cls isNil ifTrue:[^ nil].
-    ^ cls compiledMethodAt:selector 
+    ^ cls compiledMethodAt:selector asSymbol 
 
     "Created: / 7.2.1998 / 19:47:53 / cg"
 !
@@ -263,7 +267,8 @@
 apply
     "apply the change"
 
-    |class replacementClassName suggestion oldMethodOrNil oldPackage newPackage defClass|
+    |class replacementClassName suggestion oldMethodOrNil oldPackage 
+     newPackage newMethod defClass|
 
     class := self changeClass.
     class isNil ifTrue:[
@@ -280,7 +285,14 @@
             ]])
         ifFalse:[
             "/ try a replacement class in the same namespace again
-            suggestion := LastReplacementClass.
+            (className includesString:'::') ifTrue:[
+                suggestion := className copyFrom:(className lastIndexOf:$:)+1.
+                (Smalltalk classNamed:suggestion) isBehavior ifFalse:[
+                    suggestion := nil.
+                ].
+            ].
+            suggestion := suggestion ? LastReplacementClass.
+            
             (class notNil
             and:[ (class := class nameSpace classNamed:className) notNil
             and:[ 
@@ -303,22 +315,24 @@
                     self error:('Cannot apply change for missing class: ' , replacementClassName) mayProceed:true.
                     ^ self
                 ].
-                (className endsWith:' class') ifTrue:[
-                    class := class theMetaclass
-                ] ifFalse:[
-                    class := class theNonMetaclass
-                ].
+                class := Smalltalk classNamed:replacementClassName.
+"/                (className endsWith:' class') ifTrue:[
+"/                    class := class theMetaclass
+"/                ] ifFalse:[
+"/                    class := class theNonMetaclass
+"/                ].
                 LastReplacementClass := replacementClassName
             ]
         ]
     ].
 
+    newPackage := package notNil ifTrue:[package] ifFalse:[Class packageQuerySignal query].
+
     "/ if overwriting an existing method from another package,
     "/ put the existing method into the packagessafe
     oldMethodOrNil := class compiledMethodAt:selector.
     oldMethodOrNil notNil ifTrue:[
         oldPackage := oldMethodOrNil package.
-        newPackage := Class packageQuerySignal query.
         (newPackage notNil and:[newPackage ~= oldPackage]) ifTrue:[
             defClass := oldPackage asPackageId projectDefinitionClass.
             defClass notNil ifTrue:[
@@ -327,9 +341,13 @@
         ].
     ].
 
-    class compile:source classified:methodCategory logged:true.
+    newMethod := class compile:source classified:methodCategory logged:true.
+    newMethod notNil ifTrue:[
+        newMethod package: newPackage.
+    ].
 
     "Modified: / 07-09-2011 / 21:09:19 / cg"
+    "Modified: / 29-03-2014 / 23:29:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !MethodChange methodsFor:'comparing'!
@@ -384,9 +402,11 @@
 
     self isMethodCodeChange ifFalse:[^super basicFileOutOn: aStream].
 
-
-
     aStream nextPutChunkSeparator.
+    nameSpaceName notEmptyOrNil ifTrue:[
+        nameSpaceName printOn:aStream.
+        aStream nextPutAll:'::'.
+    ].
     self className printOn:aStream.
 "/        self printClassNameOn:aStream.
 
@@ -424,7 +444,7 @@
      The format is suitable for a human - not meant to be read back."
 
     aStream
-        nextPutAll:(self className ? 'unnamed');
+        nextPutAll:(self fullClassName ? 'unnamed');
         nextPutAll:' >> ';
         nextPutAll:(selector ? '?');
         nextPutAll:' {';
@@ -456,7 +476,6 @@
     "Created: / 09-10-2006 / 13:58:09 / cg"
 ! !
 
-
 !MethodChange methodsFor:'testing'!
 
 isMethodChange
@@ -526,19 +545,14 @@
 !MethodChange class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.74 2014-01-23 16:11:18 stefan Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.80 2015-03-24 15:30:35 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.74 2014-01-23 16:11:18 stefan Exp $'
-!
-
-version_HG
-
-    ^ '$Changeset: <not expanded> $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/MethodChange.st,v 1.80 2015-03-24 15:30:35 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: MethodChange.st,v 1.74 2014-01-23 16:11:18 stefan Exp $'
+    ^ '$Id: MethodChange.st,v 1.80 2015-03-24 15:30:35 cg Exp $'
 ! !