--- a/ClassDefinitionChange.st Wed Jul 18 10:53:28 2012 +0100
+++ b/ClassDefinitionChange.st Wed Jul 18 18:03:09 2012 +0100
@@ -196,7 +196,12 @@
!
poolDictionaries
+ poolDictionaries isNil ifTrue:[
+ self setupFromSource.
+ ].
^ poolDictionaries
+
+ "Modified: / 13-06-2012 / 12:23:41 / cg"
!
poolDictionaries:something
@@ -340,19 +345,17 @@
!ClassDefinitionChange methodsFor:'printing & storing'!
definitionString
- |ns classNameUsed superClassNameUsed|
+ |ns classNameUsed superClassNameUsed selPart|
ns := self nameSpaceOverride.
objectType == #variable ifTrue:[
^ String streamContents:[:stream |
ns notNil ifTrue:[
- stream
- nextPutAll:((ns asCollectionOfSubstringsSeparatedBy:$.) asStringWith:'::')
+ stream nextPutAll:((ns asCollectionOfSubstringsSeparatedBy:$.) asStringWith:'::')
] ifFalse:[
self halt:'can this happen ?'.
- stream
- nextPutAll:'Smalltalk'
+ stream nextPutAll:'Smalltalk'
].
stream
@@ -363,221 +366,41 @@
superClassNameUsed := self superClassName.
classNameUsed := self className.
-
- ^ String streamContents:[:stream |
- self isPrivateClassDefinitionChange ifFalse:[
- stream
- nextPutAll:superClassNameUsed;
- nextPutAll:' subclass:';
- nextPutAll: classNameUsed asSymbol storeString
- ;
- cr;
- tab;
- nextPutAll:'instanceVariableNames:';
- nextPutAll:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'poolDictionaries:';
- nextPutAll:(poolDictionaries ? '') storeString;
- cr;
- tab;
- nextPutAll:'category:';
- nextPutAll:(category ? '') storeString;
- cr
- ] ifTrue:[
- stream
- nextPutAll:superClassNameUsed;
- nextPutAll:' subclass:';
- nextPutAll: (classNameUsed copyFrom: owningClassName size + 3) asSymbol storeString
- ;
- cr;
- tab;
- nextPutAll:'instanceVariableNames:';
- nextPutAll:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'poolDictionaries:';
- nextPutAll:(poolDictionaries ? '') storeString;
- cr;
- tab;
- nextPutAll:'privateIn:';
- nextPutAll:owningClassName;
- cr
- ]
- ]
-
- "Modified: / 06-10-2011 / 17:02:05 / cg"
- "Modified: / 19-03-2012 / 19:19:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-definitionStringInNamespace: ns
- | classNameUsed superClassNameUsed |
-
- 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.
+ selPart := (self definitionSelector ? #'subclass:instanceVariableNames:classVariableNames:poolDictionaries:category:')
+ keywords first.
^ String streamContents:[:stream |
- self isPrivateClassDefinitionChange ifFalse:[
- stream
- nextPutAll:superClassNameUsed ? 'nil';
- nextPutAll:' subclass:';
- nextPutAll: classNameUsed asSymbol storeString
- ;
- cr;
- tab;
- nextPutAll:'instanceVariableNames:';
- nextPutAll:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'poolDictionaries:';
- nextPutAll:(poolDictionaries ? '') storeString;
- cr;
- tab;
- nextPutAll:'category:';
- nextPutAll:(category ? '') storeString;
- cr
- ] ifTrue:[
+ stream
+ nextPutAll:superClassNameUsed;
+ nextPutAll:' ',selPart;
+ nextPutAll: classNameUsed asSymbol storeString;
+ cr;
+ spaces:4;
+ nextPutAll:'instanceVariableNames: ';
+ nextPutAll:(instanceVariableNames ? '') storeString;
+ cr;
+ spaces:4;
+ nextPutAll:'classVariableNames: ';
+ nextPutAll:(classVariableNames ? '') storeString;
+ cr;
+ spaces:4;
+ nextPutAll:'poolDictionaries: ';
+ nextPutAll:(poolDictionaries ? '') storeString;
+ cr.
+ private == true ifTrue:[
stream
- nextPutAll:superClassNameUsed;
- nextPutAll:' subclass:';
- nextPutAll: (self className copyFrom: owningClassName size + 3) asSymbol storeString
- ;
- cr;
- tab;
- nextPutAll:'instanceVariableNames:';
- nextPutAll:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'poolDictionaries:';
- nextPutAll:(poolDictionaries ? '') storeString;
- cr;
- tab;
- nextPutAll:'privateIn:';
- nextPutAll:
- (ns isNil
- ifTrue:[owningClassName]
- ifFalse:[owningClassName copyFrom: ns size + 3]);
- cr
- ]
- ]
-
- "Modified: / 06-10-2011 / 17:02:05 / cg"
- "Created: / 20-03-2012 / 19:40:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-definitionStringWithoutNamespace
- |ns classNameUsed superClassNameUsed|
-
- ns := self nameSpaceOverride.
+ spaces:4;
+ nextPutAll:'privateIn: ';
+ nextPutAll:(self owningClassName)
+ ] ifFalse:[
+ stream
+ spaces:4;
+ nextPutAll:'category: ';
+ nextPutAll:(category ? '') storeString
+ ].
+ ]
- 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:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') 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:(instanceVariableNames ? '') storeString;
- cr;
- tab;
- nextPutAll:'classVariableNames:';
- nextPutAll:(classVariableNames ? '') 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>"
+ "Modified: / 13-06-2012 / 13:01:58 / cg"
!
printOn:aStream
@@ -604,6 +427,12 @@
"Modified: / 11-10-2006 / 14:11:44 / cg"
!
+definitionSelector:aSelector
+ definitionSelector := aSelector
+
+ "Created: / 13-06-2012 / 12:45:02 / cg"
+!
+
isClassDefinitionChange
^ true
!
@@ -718,7 +547,7 @@
setupFromSource
"extract privacy, category and selector from the source"
- |parseTree idx|
+ |parseTree catIdx poolIdx|
source notNil ifTrue:[
parseTree := Parser parseExpression:source.
@@ -734,22 +563,22 @@
owningClassName := parseTree args last name.
].
- #( instanceVariableNames:
- classVariableNames:
- poolDictionaries:
- ) do:[:kw|
- idx := definitionSelector keywords indexOf:kw.
- idx ~~ 0 ifTrue:[
- self perform: kw with: (parseTree args at:idx) evaluate.
- ].
+ catIdx := definitionSelector keywords indexOf:'category:'.
+ catIdx ~~ 0 ifTrue:[
+ category := (parseTree args at:catIdx) evaluate.
+ ].
+
+ poolIdx := definitionSelector keywords indexOf:'poolDictionaries:'.
+ poolIdx ~~ 0 ifTrue:[
+ poolDictionaries := (parseTree args at:poolIdx) evaluate.
].
superClassName := parseTree receiver name.
].
"Created: / 11-10-2006 / 14:10:02 / cg"
- "Modified: / 26-10-2006 / 19:29:17 / cg"
- "Modified: / 21-03-2012 / 01:12:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 08-11-2010 / 13:47:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 13-06-2012 / 12:25:10 / cg"
! !
!ClassDefinitionChange methodsFor:'visiting'!
@@ -763,13 +592,13 @@
!ClassDefinitionChange class methodsFor:'documentation'!
version
- ^ '$Id: ClassDefinitionChange.st 1909 2012-03-31 00:14:49Z vranyj1 $'
+ ^ '$Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.70 2012/06/13 11:03:04 cg Exp $'
!
version_CVS
- ^ '§Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.66 2012/01/24 22:17:07 vrany Exp §'
+ ^ 'Header: /cvs/stx/stx/libbasic3/ClassDefinitionChange.st,v 1.70 2012/06/13 11:03:04 cg Exp '
!
version_SVN
- ^ '$Id: ClassDefinitionChange.st 1909 2012-03-31 00:14:49Z vranyj1 $'
-! !
+ ^ '$ Id: ClassDefinitionChange.st 1867 2011-06-08 21:57:08Z vranyj1 $'
+! !
\ No newline at end of file