Fixes to fileout changeset in St/X class source format. jv
authorJan Vrany <jan.vrany@fit.cvut.cz>
Mon, 19 Mar 2012 20:13:30 +0000
branchjv
changeset 3031 66f3216e3ea5
parent 3030 f89aa3cfedde
child 3032 f8b04203694b
Fixes to fileout changeset in St/X class source format.
ChangeSet.st
ClassDefinitionChange.st
MethodChange.st
stx_libbasic3.st
--- a/ChangeSet.st	Mon Mar 19 15:30:00 2012 +0000
+++ b/ChangeSet.st	Mon Mar 19 20:13:30 2012 +0000
@@ -42,7 +42,7 @@
 !
 
 Object subclass:#ClassInfo
-	instanceVariableNames:'name superclass definition methods'
+	instanceVariableNames:'name superclass definition methods methodDictionary'
 	classVariableNames:''
 	poolDictionaries:''
 	privateIn:ChangeSet::ClassSourceWriter
@@ -1963,11 +1963,18 @@
             ].
             aStream cr.
         ].
+        ^self.
     ].
 
-self halt
+    formatSymbolOrNil == #classSource ifTrue:[
+        ClassSourceWriter new fileOut: self on: aStream.
+        ^self.
+    ].
+
+    self error:'Unknown format, possible formats are { nil, #classSource }'
 
     "Created: / 08-02-2011 / 11:25:16 / cg"
+    "Modified: / 19-03-2012 / 17:22:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !ChangeSet::ChangeFileReader methodsFor:'accessing'!
@@ -2754,10 +2761,15 @@
 
 privateClassesOf: classInfo
 
+    | classInfoNameSz |
+
+    classInfoNameSz := classInfo name size.
     ^classInfos values select:[:info|
-        info name size > classInfo name size and:[
-            (info name indexOf: $: startingAt: classInfo name size + 3) == 0.
-        ]
+        info name size > classInfoNameSz and:[
+            (info name startsWith: classInfo name)
+                and:[(info name at:classInfoNameSz + 1) == $:
+                    and:[(info name at:classInfoNameSz + 2) == $:
+                        and:[(info name indexOf: $: startingAt: classInfo name size + 3) == 0]]]]
     ]
 
     "Created: / 15-03-2012 / 19:31:50 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -2777,7 +2789,7 @@
             "/    b is a subclass of a
             "/    b has a private class which is a subclass of a
 
-            |mustComeBefore pivateClassesOfB|
+            |mustComeBefore privateClassesOfB|
             mustComeBefore := (b isSubclassOf:a) or:[b isPrivateClassOf: a].
             mustComeBefore
         ].
@@ -2853,8 +2865,6 @@
         self fileOutPrimitiveSpecsOf: nonMeta on:outStream.
     ].
 
-    ^self.
-
     "/
     "/ methods from all categories in metaclass (i.e. class methods)
     "/ EXCEPT: the version method is placed at the very end, to
@@ -2862,7 +2872,7 @@
     "/         (RCS expands this string, so its size is not constant)
     "/
     collectionOfCategories := meta categories asSortedCollection.
-    versionMethods := meta methodDictionary values select:[:mthd | mthd isVersionMethod].
+    versionMethods := meta methods select:[:change |AbstractSourceCodeManager isVersionMethodSelector:change selector].
 
     collectionOfCategories notNil ifTrue:[
         "/
@@ -2936,7 +2946,7 @@
     "/
     "/ any private classes' methods
     "/
-    nonMeta privateClassesSorted do:[:aClass |
+    (self privateClassesSortedOf: nonMeta) do:[:aClass |
         self fileOutAllMethodsOf:aClass on:outStream methodFilter:methodFilter
     ].
 
@@ -2954,14 +2964,12 @@
         "/
         classesImplementingInitialize := OrderedCollection new.
 
-        (meta includesSelector:#initialize) ifTrue:[
-            classesImplementingInitialize add:nonMeta
-        ].
-        nonMeta privateClassesSorted do:[:aPrivateClass |
-            (aPrivateClass theMetaclass includesSelector:#initialize) ifTrue:[
-                classesImplementingInitialize add:aPrivateClass
+        classInfos values with: metaInfos values do:[:class :meta|
+            (meta includesSelector: #initialize) ifTrue:[
+                classesImplementingInitialize add: class.
             ]
         ].
+
         classesImplementingInitialize size ~~ 0 ifTrue:[
             classesImplementingInitialize topologicalSort:[:a :b | b isSubclassOf:a].
             outStream cr.
@@ -2984,6 +2992,14 @@
 
     | metaInfo |
 
+    nonMetaInfo definition isPrivateClassDefinitionChange ifFalse:[
+        nonMetaInfo definition package notNil ifTrue:[
+            aStream nextPutAll: ('"{ Package: ''%1'' }"' bindWith: nonMetaInfo definition package).
+            aStream cr.
+        ].
+    ].
+
+
     aStream nextPutAll: nonMetaInfo definition source.
     aStream nextPutChunkSeparator. 
     aStream cr; cr.
@@ -3015,6 +3031,35 @@
     "Created: / 15-03-2012 / 19:18:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+fileOutAllMethodsOf:aClass on:aStream methodFilter:methodFilter
+    | collectionOfCategories meta |
+
+    meta := metaInfos at: aClass name.
+
+    collectionOfCategories := meta categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self fileOutCategory:aCategory of:meta  methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+    collectionOfCategories := aClass categories asSortedCollection.
+    collectionOfCategories notNil ifTrue:[
+        collectionOfCategories do:[:aCategory |
+            self fileOutCategory:aCategory of:aClass methodFilter:methodFilter on:aStream.
+            aStream cr
+        ]
+    ].
+
+    (self privateClassesSortedOf: aClass) do:[:privateClass |
+        self fileOutAllMethodsOf:privateClass on:aStream methodFilter:methodFilter
+    ].
+
+    "Created: / 15-10-1996 / 11:13:00 / cg"
+    "Modified: / 22-03-1997 / 16:12:17 / cg"
+    "Created: / 19-03-2012 / 18:21:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 fileOutPrimitiveSpecsOf: nonMeta on:outStream
 
     "Nothing now..."
@@ -3061,6 +3106,13 @@
 
 !ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'accessing'!
 
+categories
+
+    ^ (methods collect:[:e|e category]) asSet
+
+    "Created: / 19-03-2012 / 18:03:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 definition
     ^ definition
 !
@@ -3075,12 +3127,26 @@
     "Created: / 15-03-2012 / 19:11:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
+methodDictionary
+
+    methodDictionary isNil ifTrue:[
+        methodDictionary := Dictionary new.
+    ].
+    ^methodDictionary
+
+    "Created: / 19-03-2012 / 18:11:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 methods
     ^ methods
 !
 
 methods:something
     methods := something.
+    methodDictionary := Dictionary new.
+    methods do:[:m|methodDictionary at: m selector put: m].
+
+    "Modified: / 19-03-2012 / 18:12:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 name
@@ -3091,6 +3157,12 @@
     name := something.
 !
 
+selectorAtMethod: m
+    ^m selector
+
+    "Created: / 19-03-2012 / 18:14:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 superclass
     ^ superclass
 !
@@ -3117,6 +3189,15 @@
     "Created: / 15-03-2012 / 19:12:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
+!ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'enumerating'!
+
+methodsDo: aBlock
+
+    methods do: aBlock
+
+    "Created: / 19-03-2012 / 18:14:19 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
 !ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'initialization'!
 
 initialize
@@ -3135,19 +3216,32 @@
 
 !ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'printing & storing'!
 
+printClassNameOn:aStream    
+    aStream nextPutAll: name
+
+    "Created: / 19-03-2012 / 18:17:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 printOn:aStream
     "append a printed representation if the receiver to the argument, aStream"
 
-    super printOn:aStream.
+    aStream nextPutAll: self class nameWithoutPrefix.
     aStream nextPutAll:'('.
     name printOn:aStream.
     aStream nextPutAll:')'.
 
-    "Modified: / 15-03-2012 / 19:49:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 19-03-2012 / 19:43:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !ChangeSet::ClassSourceWriter::ClassInfo methodsFor:'queries'!
 
+includesSelector: selector
+
+    ^methods anySatisfy:[:m|m selector == selector].
+
+    "Created: / 19-03-2012 / 18:22:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 isPrivateClassOf: classInfo
 
     ^name startsWith: classInfo name
@@ -3538,5 +3632,5 @@
 !
 
 version_SVN
-    ^ '$Id: ChangeSet.st 1895 2012-03-16 16:51:41Z vranyj1 $'
+    ^ '$Id: ChangeSet.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 ! !
--- a/ClassDefinitionChange.st	Mon Mar 19 15:30:00 2012 +0000
+++ b/ClassDefinitionChange.st	Mon Mar 19 20:13:30 2012 +0000
@@ -365,30 +365,57 @@
     classNameUsed := self className.
 
     ^ String streamContents:[:stream |
-        stream 
-            nextPutAll:superClassNameUsed;
-            nextPutAll:' subclass:';
-            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;
-            spaces:4;
-            nextPutAll:'category: ';
-            nextPutAll:(category ? '') storeString
-      ]
+        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>"
 !
 
 printOn:aStream
@@ -569,7 +596,7 @@
 !ClassDefinitionChange class methodsFor:'documentation'!
 
 version
-    ^ '$Id: ClassDefinitionChange.st 1872 2012-01-30 17:19:14Z vranyj1 $'
+    ^ '$Id: ClassDefinitionChange.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 !
 
 version_CVS
@@ -577,5 +604,5 @@
 !
 
 version_SVN
-    ^ '$Id: ClassDefinitionChange.st 1872 2012-01-30 17:19:14Z vranyj1 $'
+    ^ '$Id: ClassDefinitionChange.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 ! !
--- a/MethodChange.st	Mon Mar 19 15:30:00 2012 +0000
+++ b/MethodChange.st	Mon Mar 19 20:13:30 2012 +0000
@@ -202,6 +202,13 @@
     ^ previousVersion source
 !
 
+privacy
+
+    ^privacy ? #public
+
+    "Created: / 19-03-2012 / 18:16:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 selector
     ^ selector
 
@@ -446,5 +453,5 @@
 !
 
 version_SVN
-    ^ '$Id: MethodChange.st 1872 2012-01-30 17:19:14Z vranyj1 $'
+    ^ '$Id: MethodChange.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 ! !
--- a/stx_libbasic3.st	Mon Mar 19 15:30:00 2012 +0000
+++ b/stx_libbasic3.st	Mon Mar 19 20:13:30 2012 +0000
@@ -227,20 +227,19 @@
     "Return a SVN revision number of myself.
      This number is updated after a commit"
 
-    ^ "$SVN-Revision:"1885"$"
+    ^ "$SVN-Revision:"'1895'"$"
 ! !
 
 !stx_libbasic3 class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/stx_libbasic3.st,v 1.67 2012/01/30 18:56:18 vrany Exp $'
+    ^ '$Id: stx_libbasic3.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 !
 
 version_CVS
-    ^ '§Header: /cvs/stx/stx/libbasic3/stx_libbasic3.st,v 1.67 2012/01/30 18:56:18 vrany Exp §'
+    ^ '§Â§Header: /cvs/stx/stx/libbasic3/stx_libbasic3.st,v 1.67 2012/01/30 18:56:18 vrany Exp §§'
 !
 
 version_SVN
-    ^ '$Id: stx_libbasic3.st 1889 2012-02-28 15:44:01Z vranyj1 $'
+    ^ '$Id: stx_libbasic3.st 1897 2012-03-19 20:13:30Z vranyj1 $'
 ! !
-