--- 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 $'
! !