--- a/ClassDefinitionChange.st Tue Feb 04 21:01:56 2014 +0100
+++ b/ClassDefinitionChange.st Wed Apr 01 10:37:40 2015 +0100
@@ -11,10 +11,12 @@
"
"{ Package: 'stx:libbasic3' }"
+"{ NameSpace: Smalltalk }"
+
ClassChange subclass:#ClassDefinitionChange
instanceVariableNames:'objectType superClassName classType indexedType otherParameters
- instanceVariableNames classVariableNames
- classInstanceVariableNames poolDictionaries category private
+ instanceVariableString classVariableString
+ classInstanceVariableString poolDictionaries category private
definitionSelector'
classVariableNames:''
poolDictionaries:''
@@ -67,19 +69,35 @@
!
classInstanceVariableNames
- ^ classInstanceVariableNames
+ ^ self classInstanceVariableString asCollectionOfWords
+!
+
+classInstanceVariableNames:aCollectionOfWords
+ self classInstanceVariableString:(aCollectionOfWords asStringWith:' ').
!
-classInstanceVariableNames:something
- classInstanceVariableNames := something.
+classInstanceVariableString
+ ^ classInstanceVariableString ? ''
+!
+
+classInstanceVariableString:aString
+ classInstanceVariableString := aString.
!
classVariableNames
- ^ classVariableNames
+ ^ self classVariableString asCollectionOfWords
+!
+
+classVariableNames:aCollectionOfWords
+ self classVariableString:(aCollectionOfWords asStringWith:' ').
!
-classVariableNames:something
- classVariableNames := something.
+classVariableString
+ ^ classVariableString
+!
+
+classVariableString:aString
+ classVariableString := aString.
!
delta
@@ -162,12 +180,24 @@
^ cls definitionWithoutPackage
!
+indexedType
+ ^ indexedType
+!
+
instanceVariableNames
- ^ instanceVariableNames
+ ^ self instanceVariableString asCollectionOfWords
!
-instanceVariableNames:something
- instanceVariableNames := something.
+instanceVariableNames:aCollectionOfWords
+ self instanceVariableString:(aCollectionOfWords asStringWith:' ')
+!
+
+instanceVariableString
+ ^ instanceVariableString
+!
+
+instanceVariableString:aString
+ instanceVariableString := aString.
!
localClassName
@@ -176,6 +206,7 @@
Notice that className always returns the full name (incl. any owner prefix)"
self isPrivateClassDefinitionChange ifFalse:[^ self className].
+ owningClassName isNil ifTrue:[^ self className].
(className startsWith:(owningClassName,'::')) ifTrue:[
^ className copyFrom:(owningClassName size + 2 + 1).
@@ -210,18 +241,21 @@
nameSpaceName := aNameSpaceName.
classType := aClassType.
otherParameters := Dictionary new addAll:otherParametersArg; yourself.
+ private := otherParameters at:#private: ifAbsent:nil.
+ category := otherParameters at:#category: ifAbsent:nil.
- superClassName := otherParameters at:#superclass: ifAbsent:nil.
- self assert:(superClassName notNil).
- superClassName notNil ifTrue:[
- superClassName := superClassName pathString.
+ aClassType == #defineSharedVariable: ifTrue:[
+ ] ifFalse:[
+ superClassName := otherParameters at:#superclass: ifAbsent:nil.
+ self assert:(superClassName notNil).
+ superClassName notNil ifTrue:[
+ superClassName := superClassName pathString.
+ ].
+ indexedType := otherParameters at:#indexedType: ifAbsent:nil.
+ instanceVariableString := otherParameters at:#instanceVariableNames: ifAbsent:nil.
+ classInstanceVariableString := otherParameters at:#classInstanceVariableNames: ifAbsent:nil.
+ imports := otherParameters at:#imports: ifAbsent:nil.
].
- indexedType := otherParameters at:#indexedType: ifAbsent:nil.
- private := otherParameters at:#private: ifAbsent:nil.
- instanceVariableNames := otherParameters at:#instanceVariableNames: ifAbsent:nil.
- classInstanceVariableNames := otherParameters at:#classInstanceVariableNames: ifAbsent:nil.
- imports := otherParameters at:#imports: ifAbsent:nil.
- category := otherParameters at:#category: ifAbsent:nil.
"Modified: / 15-06-2010 / 14:50:35 / cg"
"Modified: / 12-12-2013 / 12:59:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -317,13 +351,20 @@
!ClassDefinitionChange methodsFor:'applying'!
apply
- |changeClass sourceWithNamespace|
+ |changeClass sourceWithNamespace ns|
superClassName isNil ifTrue:[
self setupFromSource.
].
"Some classes have nil superclass (such as Object)..."
superClassName notNil ifTrue:[
+ nameSpaceOverride notEmptyOrNil ifTrue:[
+ "/ a q&d hack: need to find those which pass in a nameSpace isntead of a string
+ (ns := nameSpaceOverride) isString ifFalse:[ ns := ns name ].
+ (superClassName startsWith:(ns,'::')) ifFalse:[
+ superClassName := (ns,'::',superClassName) asSymbol.
+ ].
+ ].
(Smalltalk classNamed:superClassName) isNil ifTrue:[
Class undeclared:superClassName
].
@@ -370,16 +411,18 @@
(cls := self changeClass) isNil ifTrue:[^ false].
cls superclass name ~= superClassName ifTrue:[ ^ true ].
- cls instanceVariableString ~= instanceVariableNames ifTrue:[ ^ true ].
- cls classVariableString ~= classVariableNames ifTrue:[ ^ true ].
- cls class instanceVariableString ~= classInstanceVariableNames ifTrue:[ ^ true ].
- cls sharedPoolNames ~= poolDictionaries ifTrue:[ ^ true ].
+ cls instanceVariableString ~= instanceVariableString ifTrue:[ ^ true ].
+ cls classVariableString ~= classVariableString ifTrue:[ ^ true ].
+ cls class instanceVariableString ~= (classInstanceVariableString ? '') ifTrue:[ ^ true ].
+ cls poolDictionaries ~= poolDictionaries ifTrue:[ ^ true ].
cls category ~= category ifTrue:[ ^ true ].
cls isPrivate ifTrue:[
cls owningClass name ~= owningClassName ifTrue:[ ^ true ].
].
cls definitionSelector ~= self definitionSelector ifTrue:[ ^ true ].
^ false
+
+ "Modified: / 12-02-2014 / 20:25:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
isForSameAs:changeB
@@ -483,14 +526,14 @@
nextPutLine: classNameSymbolString;
tab;
nextPutAll:'instanceVariableNames:';
- nextPutLine:(instanceVariableNames ? '') storeString;
+ nextPutLine:(instanceVariableString ? '') storeString;
tab;
nextPutAll:'classVariableNames:';
- nextPutLine:(classVariableNames ? '') storeString;
+ nextPutLine:(classVariableString ? '') storeString;
tab;
nextPutAll:'poolDictionaries:';
nextPutLine:(poolDictionaries ? '') storeString.
- self isPrivateClassDefinitionChange ifTrue:[
+ (self isPrivateClassDefinitionChange and:[owningClassName notNil]) ifTrue:[
ownerNameUsed := self owningClassName.
(nsOrNil isNil or:[nsOrNil ~~ nameSpaceName]) ifTrue:[
(nsOrNil ? nameSpaceName) notNil ifTrue:[
@@ -507,12 +550,105 @@
nextPutAll:'category:';
nextPutAll:(category ? '') asString storeString
].
+
+ classInstanceVariableString notEmptyOrNil ifTrue:[
+ stream nextPut:$.; cr;
+ nextPutAll:'"';
+ nextPutAll:classNameUsed;
+ nextPutAll:' class instanceVariableNames: ';
+ nextPutAll:classInstanceVariableString storeString;
+ nextPutAll:'"'
+ ].
]
"Modified: / 13-06-2012 / 13:01:58 / cg"
"Modified: / 13-11-2013 / 17:13:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+definitionStringWithoutNamespace
+ "cg - huh - who needs that? (the definitionString already does NOT include the classes namespace)"
+
+ |ns classNameUsed superClassNameUsed|
+
+ ns := self nameSpaceOverride.
+
+ objectType == #variable ifTrue:[
+ ^ String streamContents:[:stream |
+ ns notNil ifTrue:[
+ stream
+ nextPutAll:((ns asCollectionOfSubstringsSeparatedBy:$.) asStringWith:'::')
+ ] ifFalse:[
+ self halt:'can this happen ?'.
+ stream
+ nextPutAll:'Smalltalk'
+ ].
+
+ stream
+ nextPutAll:' addClassVarName:';
+ nextPutAll:className asString storeString
+ ].
+ ].
+
+ superClassNameUsed := self superClassName.
+ classNameUsed := self classNameWithoutNamespace.
+
+ ^ String streamContents:[:stream |
+ self isPrivateClassDefinitionChange ifFalse:[
+ stream
+ nextPutAll:superClassNameUsed;
+ nextPutAll:' subclass:';
+ nextPutAll: classNameUsed asSymbol storeString
+ ;
+ cr;
+ tab;
+ nextPutAll:'instanceVariableNames:';
+ nextPutAll:(instanceVariableString ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'classVariableNames:';
+ nextPutAll:(classVariableString ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'poolDictionaries:';
+ nextPutAll:(poolDictionaries ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'category:';
+ nextPutAll:(category ? '') storeString;
+ cr
+ ] ifTrue:[
+ stream
+ nextPutAll:superClassNameUsed;
+ nextPutAll:' subclass:';
+ nextPutAll: (self className copyFrom: owningClassName size + 3) asSymbol storeString
+ ;
+ cr;
+ tab;
+ nextPutAll:'instanceVariableNames:';
+ nextPutAll:(instanceVariableString ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'classVariableNames:';
+ nextPutAll:(classVariableString ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'poolDictionaries:';
+ nextPutAll:(poolDictionaries ? '') storeString;
+ cr;
+ tab;
+ nextPutAll:'privateIn:';
+ nextPutAll:
+ ((ns := self nameSpaceName) isNil
+ ifTrue:[owningClassName]
+ ifFalse:[owningClassName copyFrom: ns size + 3]);
+ cr
+ ]
+ ]
+
+ "Modified: / 06-10-2011 / 17:02:05 / cg"
+ "Created: / 20-03-2012 / 16:37:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
printOn:aStream
aStream
nextPutAll:className; nextPutAll:' {definition}'
@@ -531,10 +667,14 @@
definitionSelector
definitionSelector isNil ifTrue:[
self setupFromSource.
+ definitionSelector isNil ifTrue:[
+ definitionSelector := #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:'
+ ].
].
^ definitionSelector
"Modified: / 11-10-2006 / 14:11:44 / cg"
+ "Modified: / 12-02-2014 / 20:25:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
definitionSelector:aSelector
@@ -557,38 +697,6 @@
^ nm
!
-isClassDefinitionChange
- ^ true
-!
-
-isPrivateClassDefinitionChange
- "compute lazily; remember in private"
-
- private isNil ifTrue:[
- (className includes:$:) ifFalse:[
- "/ cannot be private
- private := false
- ] ifTrue:[
- source isNil ifTrue:[^ false ].
- (source includesString:'private') ifFalse:[
- private := false.
- ] ifTrue:[
-"/ (self changeClass notNil
-"/ and:[self changeClass isLoaded not]) ifTrue:[
-"/ "/ cannot be private
-"/ private := false
-"/ ] ifTrue:[
- self setupFromSource.
-"/ ].
- ].
- ].
- ].
- ^ private
-
- "Created: / 11-10-2006 / 14:19:03 / cg"
- "Modified: / 16-11-2006 / 16:34:19 / cg"
-!
-
owningClassName
"the owner's name, excluding the namespace"
@@ -600,6 +708,12 @@
^ owningClassName
"Created: / 12-10-2006 / 23:07:25 / cg"
+!
+
+owningClassName:aStringOrSymbol
+ owningClassName := aStringOrSymbol
+
+ "Created: / 30-08-2010 / 13:55:37 / cg"
! !
!ClassDefinitionChange methodsFor:'special'!
@@ -698,12 +812,12 @@
instVarIdx := definitionSelector keywords indexOf:'instanceVariableNames:'.
instVarIdx ~~ 0 ifTrue:[
- instanceVariableNames := (parseTree args at:instVarIdx) value.
+ instanceVariableString := (parseTree args at:instVarIdx) value.
].
classVarIdx := definitionSelector keywords indexOf:'classVariableNames:'.
classVarIdx ~~ 0 ifTrue:[
- classVariableNames := (parseTree args at:classVarIdx) value.
+ classVariableString := (parseTree args at:classVarIdx) value.
].
@@ -726,6 +840,52 @@
"Modified: / 10-06-2013 / 17:07:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
+!ClassDefinitionChange methodsFor:'testing'!
+
+isClassDefinitionChange
+ ^ true
+!
+
+isOrContainsClassDefinitionChange
+ ^ true
+!
+
+isPrivateClassDefinitionChange
+ "compute lazily; remember in private"
+
+ private isNil ifTrue:[
+ (className includes:$:) ifFalse:[
+ "/ cannot be private
+ private := false
+ ] ifTrue:[
+ source isNil ifTrue:[^ false ].
+ (source includesString:'private') ifFalse:[
+ private := false.
+ ] ifTrue:[
+"/ (self changeClass notNil
+"/ and:[self changeClass isLoaded not]) ifTrue:[
+"/ "/ cannot be private
+"/ private := false
+"/ ] ifTrue:[
+ self setupFromSource.
+"/ ].
+ ].
+ ].
+ ].
+ ^ private
+
+ "Created: / 11-10-2006 / 14:19:03 / cg"
+ "Modified: / 16-11-2006 / 16:34:19 / cg"
+!
+
+isVariable
+ indexedType notNil ifTrue:[
+ self halt.
+ ^ true.
+ ].
+ ^ false.
+! !
+
!ClassDefinitionChange methodsFor:'visiting'!
acceptChangeVisitor:aVisitor
@@ -737,11 +897,11 @@
!ClassDefinitionChange class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.86 2013-09-28 12:10:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.96 2015-03-24 18:01:04 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.86 2013-09-28 12:10:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.96 2015-03-24 18:01:04 cg Exp $'
!
version_HG
@@ -750,6 +910,6 @@
!
version_SVN
- ^ '$Id: ClassDefinitionChange.st,v 1.86 2013-09-28 12:10:20 cg Exp $'
+ ^ '$Id: ClassDefinitionChange.st,v 1.96 2015-03-24 18:01:04 cg Exp $'
! !