Merged with /CVS jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Wed, 18 Jul 2012 18:03:09 +0100
branchjv
changeset 3058 c4388bddfcb1
parent 3057 99b7b9518c91
child 3059 a0bf6a16346c
Merged with /CVS
ClassDefinitionChange.st
SourceCodeManagerUtilities.st
--- 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
--- a/SourceCodeManagerUtilities.st	Wed Jul 18 10:53:28 2012 +0100
+++ b/SourceCodeManagerUtilities.st	Wed Jul 18 18:03:09 2012 +0100
@@ -12,11 +12,11 @@
 "{ Package: 'stx:libbasic3' }"
 
 Object subclass:#SourceCodeManagerUtilities
-	instanceVariableNames:'manager resources'
-	classVariableNames:'LastSourceLogMessage LastModule LastPackage YesToAllQuery
-		YesToAllNotification LastSourceLogMessages'
-	poolDictionaries:''
-	category:'System-SourceCodeManagement'
+        instanceVariableNames:'manager resources'
+        classVariableNames:'LastSourceLogMessage LastModule LastPackage YesToAllQuery
+                YesToAllNotification LastSourceLogMessages'
+        poolDictionaries:''
+        category:'System-SourceCodeManagement'
 !
 
 !SourceCodeManagerUtilities class methodsFor:'documentation'!
@@ -137,7 +137,7 @@
 !SourceCodeManagerUtilities class methodsFor:'others'!
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.250 2012/06/02 09:01:13 cg Exp §'
+    ^ 'Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.250 2012/06/02 09:01:13 cg Exp '
 ! !
 
 !SourceCodeManagerUtilities class methodsFor:'private-migration'!
@@ -3450,7 +3450,10 @@
         mgr notNil ifTrue:[
             aStream nextPutLine:'**** Repository information ****'; cr.
 
-            module := info2 at:#module ifAbsent:nil.
+            module := nil.
+            info2 notNil ifTrue:[
+                module := info2 at:#module ifAbsent:nil.
+            ].
             module notNil ifTrue:[
                 aStream nextPutLine:('  Repository URL ......: ' , 
                                     ((mgr repositoryNameForPackage:aClass package) ifNil:[mgr repositoryName , ' (default)'])).
@@ -3475,8 +3478,8 @@
         ]
     ]
 
-    "Modified: / 06-10-2006 / 13:25:22 / cg"
     "Modified: / 06-06-2012 / 11:07:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 11-07-2012 / 13:50:59 / cg"
 !
 
 tagClass:aClass as:tag
@@ -4359,9 +4362,10 @@
 !SourceCodeManagerUtilities class methodsFor:'documentation'!
 
 version
-    ^ '$Id: SourceCodeManagerUtilities.st 1929 2012-07-18 09:53:28Z vranyj1 $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/SourceCodeManagerUtilities.st,v 1.252 2012/07/11 14:20:16 cg Exp $'
 !
 
 version_SVN
-    ^ '$Id: SourceCodeManagerUtilities.st 1929 2012-07-18 09:53:28Z vranyj1 $'
+    ^ '$Id: SourceCodeManagerUtilities.st 1931 2012-07-18 17:03:09Z vranyj1 $'
 ! !
+