--- a/ChangeSet.st Tue Apr 02 21:21:48 2013 +0200
+++ b/ChangeSet.st Tue Apr 02 21:23:39 2013 +0200
@@ -21,7 +21,7 @@
Object subclass:#ChangeFileReader
instanceVariableNames:'inputStream parseTree changeAction changeSet selector receiver
arguments receiverSelector receiverReceiver lineNumber position
- className methodSelector chunk timestamp'
+ className methodSelector nameSpaceOverride chunk timestamp'
classVariableNames:''
poolDictionaries:''
privateIn:ChangeSet
@@ -2222,6 +2222,7 @@
!
classNameOf:aReceiver
+ "old"
| nameSpace clsName |
nameSpace := Class nameSpaceQuerySignal query.
@@ -2230,9 +2231,38 @@
ifTrue:[clsName := (aReceiver receiver name) , ' class']
ifFalse:[clsName := aReceiver name].
- ^(nameSpace ~~ Smalltalk and:[(clsName startsWith: nameSpace name) not])
- ifTrue:[nameSpace name , '::' , clsName]
- ifFalse:[clsName].
+ (nameSpace ~~ Smalltalk and:[(clsName startsWith: nameSpace name) not])
+ ifTrue:[
+ ^ nameSpace name , '::' , clsName
+ ] ifFalse:[
+ ^ clsName
+ ].
+
+ "Modified: / 24-01-2012 / 17:07:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+classNameOfRememberingNamespace:aReceiver
+ "new"
+
+ | nameSpace clsName |
+
+ nameSpace := Class nameSpaceQuerySignal query.
+
+ (aReceiver isUnaryMessage and:[aReceiver selector == #class])
+ ifTrue:[clsName := (aReceiver receiver name) , ' class']
+ ifFalse:[clsName := aReceiver name].
+
+ (nameSpace ~~ Smalltalk and:[(clsName startsWith: nameSpace name) not])
+ ifTrue:[
+ "/ old: remember namespace in name
+ "/ ^ nameSpace name , '::' , clsName
+ "/ new: remember in override
+ nameSpaceOverride := nameSpace.
+ ^ clsName
+ ] ifFalse:[
+ nameSpaceOverride := nil.
+ ^ clsName
+ ].
"Modified: / 24-01-2012 / 17:07:55 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
@@ -2247,12 +2277,11 @@
self error:'unexpected change' mayProceed:true.
^ false.
].
- className := self classNameOf:receiverReceiver.
+
+ "/ className := self classNameOf:receiverReceiver.
+ className := self classNameOfRememberingNamespace:receiverReceiver.
self assert:className notNil.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
methodSelector := (receiver arguments at:1) evaluate.
self assert:methodSelector notNil.
^ true.
@@ -2264,6 +2293,10 @@
^ self classNameOf:receiver
!
+receiversClassNameRememberingNamespace
+ ^ self classNameOfRememberingNamespace:receiver
+!
+
variableNameOfReceiver
receiver isVariable ifFalse:[ ^ nil ].
@@ -2316,7 +2349,7 @@
|selector category categories attributes change|
selector := arguments first value.
- className := self receiversClassName.
+ className := self receiversClassNameRememberingNamespace.
categories := OrderedCollection new.
attributes := OrderedCollection new.
@@ -2339,6 +2372,7 @@
selector:selector
source:(parseTree printString)
category:(categories first).
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
] ifFalse:[
self halt:'multiple/missing categories not supported'.
@@ -2353,6 +2387,7 @@
className:className
selector:selector
privacy:(attributes first asSymbol).
+ change nameSpaceOverride:nameSpaceOverride.
change source:(parseTree printString).
self addChange:change.
].
@@ -2365,13 +2400,11 @@
handleClassCommentChange
|change|
- className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+ className := self receiversClassNameRememberingNamespace.
change := ClassCommentChange new.
change className:className comment:(arguments at:1) evaluate.
+ change nameSpaceOverride:nameSpaceOverride.
change source:(parseTree printString).
self addChange:change.
^ true
@@ -2381,16 +2414,19 @@
|nameSpace change|
className := (arguments at:1) evaluate.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+
nameSpace := Class nameSpaceQuerySignal query.
- nameSpace ~~ Smalltalk ifTrue:[
- className := nameSpace name , '::' , className
- ].
+ (nameSpace == Smalltalk) ifTrue:[ nameSpace := nil ].
+
+ "/ old: remember namespace in className
+"/ nameSpace ~~ Smalltalk ifTrue:[
+"/ className := nameSpace name , '::' , className
+"/ ].
change := ClassDefinitionChange new.
change className:className; source:(parseTree printString).
+ "/ new: remember in override
+ change nameSpaceOverride:nameSpace.
receiver isVariable ifTrue:[
change superClassName:receiver name.
].
@@ -2428,13 +2464,11 @@
handleClassInstanceVariableDefinitionChange
|change|
- className := self receiversClassName.
-
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+ className := self receiversClassNameRememberingNamespace.
+
change := ClassInstVarDefinitionChange new.
change className:className.
+ change nameSpaceOverride:nameSpaceOverride.
change source:(parseTree printString).
change classInstVarNames:(parseTree arguments first value asCollectionOfWords asArray).
self addChange:change.
@@ -2456,6 +2490,7 @@
selector:methodSelector
category:(arguments at:1) evaluate.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
^ true
@@ -2465,10 +2500,7 @@
handleMethodCategoryRenameChange
|change|
- className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+ className := self receiversClassNameRememberingNamespace.
change := MethodCategoryRenameChange new.
change
@@ -2476,6 +2508,7 @@
oldCategoryName:(arguments at:1) evaluate
newCategoryName:(arguments at:2) evaluate.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
^ true
!
@@ -2505,15 +2538,13 @@
handleMethodChangeUnsafe
|priv categoryName methodSource changes change parser |
+ className := self receiversClassNameRememberingNamespace.
+
(selector == #'ignoredMethodsFor:') ifTrue:[
priv := #ignored.
] ifFalse:[
priv := nil
].
- className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
((selector == #'methods')
or:[(selector == #'publicMethods')
or:[(selector == #'methodsFor')]]) ifTrue:[
@@ -2555,6 +2586,7 @@
category:categoryName
privacy:priv.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
inputStream skipSeparators.
@@ -2580,6 +2612,7 @@
selector:methodSelector
package:(arguments at:1) evaluate.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
^ true
@@ -2599,6 +2632,7 @@
selector:methodSelector
privacy:(arguments at:1) evaluate.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
^ true
@@ -2624,28 +2658,7 @@
!
handlePrimitiveChange
- |change primSource|
-
- className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
-
- inputStream skipSeparators.
- primSource := inputStream nextChunk.
-
- selector == #'primitiveDefinitions' ifTrue:[
- change := ClassPrimitiveDefinitionsChange new
- ] ifFalse:[
- selector == #'primitiveFunctions' ifTrue:[
- change := ClassPrimitiveFunctionsChange new
- ] ifFalse:[
- change := ClassPrimitiveVariablesChange new
- ]
- ].
- change className:className source:primSource.
- self addChange:change.
- ^ true
+ self handlePrimitiveChange:nil
!
handlePrimitiveChange: sourceOrNil
@@ -2654,10 +2667,8 @@
|change primSource|
- className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+ className := self receiversClassNameRememberingNamespace.
+
sourceOrNil notNil ifTrue:[
primSource := sourceOrNil
] ifFalse:[
@@ -2675,6 +2686,7 @@
]
].
change className:className source:primSource.
+ change nameSpaceOverride:nameSpaceOverride.
self addChange:change.
^ true
@@ -2704,9 +2716,7 @@
|change|
className := self receiversClassName.
-"/ nameSpace ~~ Smalltalk ifTrue:[
-"/ className := nameSpace name , '::' , className
-"/ ].
+
methodSelector := (arguments at:1) evaluate.
change := MethodRemoveChange new.
change className:className selector:methodSelector.
@@ -2737,7 +2747,8 @@
comment := inputStream nextChunk.
- className := self receiversClassName.
+ className := self receiversClassNameRememberingNamespace.
+
change := ClassCommentChange new.
change className:className comment:comment.
change source:(parseTree printString).
@@ -2827,13 +2838,18 @@
| kind sel |
inputStream skip: 5.
kind := inputStream upTo: Character space.
+ (kind endsWith:$:) ifTrue:[
+ kind := kind copyWithoutLast:1
+ ].
sel := ('process_', kind) asSymbolIfInterned.
sel notNil ifTrue:[
- MessageNotUnderstood handle:[
- "/Unknown info record, do nothing"
+ MessageNotUnderstood handle:[
+ self process_otherInfo:kind
] do:[
self perform: sel.
]
+ ] ifFalse:[
+ self process_otherInfo:kind
]
"Created: / 30-03-2012 / 16:44:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -2863,6 +2879,10 @@
^ self handleClassCommentChange.
!
+process_encoding
+ "St/X encoding info record. Ignored"
+!
+
process_ignoredMethodsFor_
"'ignoredMethodsFor:' chunk (ST/X)"
@@ -2911,6 +2931,18 @@
^ self handleNameSpaceCreationChange.
!
+process_otherInfo:what
+ "'---- <what> 12-03-2012 10:49:40 ----'
+
+ '<what>' is already read from inputStream.
+ "
+
+ "/ inputStream skipSeparators.
+ self addChange: (InfoChange type: what data: (inputStream upToEnd) timestamp: nil)
+
+ "Created: / 18-05-2012 / 17:03:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
process_package_
"'package:' chunk (ST/X)"
@@ -4214,11 +4246,11 @@
!ChangeSet class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.218 2013-04-02 12:03:05 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.219 2013-04-02 19:23:39 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.218 2013-04-02 12:03:05 stefan Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ChangeSet.st,v 1.219 2013-04-02 19:23:39 cg Exp $'
!
version_SVN