class: VSEPackageFileSourceWriter
authorClaus Gittinger <cg@exept.de>
Tue, 03 Feb 2015 20:14:55 +0100
changeset 3747 8e31691caf36
parent 3746 a1c99e6f50b4
child 3748 37670404c9ec
class: VSEPackageFileSourceWriter class definition added: #fileOutMethod:isExtension:on: changed:5 methods seems to be complete now
VSEPackageFileSourceWriter.st
--- a/VSEPackageFileSourceWriter.st	Tue Feb 03 20:14:40 2015 +0100
+++ b/VSEPackageFileSourceWriter.st	Tue Feb 03 20:14:55 2015 +0100
@@ -14,7 +14,7 @@
 "{ NameSpace: Smalltalk }"
 
 VSEFileSourceWriter subclass:#VSEPackageFileSourceWriter
-	instanceVariableNames:'packageName'
+	instanceVariableNames:'packageName projectDefinitionClass'
 	classVariableNames:''
 	poolDictionaries:''
 	category:'Kernel-Classes-Support'
@@ -82,33 +82,38 @@
 
 fileOut:aClass on:aStream withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
     aStream nextPutAll:'Class '.
-    aStream nextPutAll:aClass nameWithoutPrefix.
+    aStream nextPutAll:(self rewrittenClassNameOf:aClass).
     aStream space.
-    aStream nextPutAll:aClass superclass nameWithoutPrefix.
+    aClass superclass isNil ifTrue:[
+        self error:'unimplemented: nil superclass'.
+    ].
+    aStream nextPutAll:(self rewrittenClassNameOf:aClass superclass).
     aStream nextPutLine:'!!'.
 
     aClass isVariable ifTrue:[
+        aClass isPointers ifTrue:[
+            aStream nextPutLine:'IndexableObject!!'.
+        ] ifFalse:[
+            self error:'unimplemented: non-pointer indexable'.
+        ]
     ] ifFalse:[
         aStream nextPutLine:'NonIndexable!!'.
     ].
     aClass instanceVariableNames do:[:v |
         aStream nextPutLine:'InstanceVariable ',v,'!!'.
     ].
-
-    aClass class methodDictionary keysAndValuesDo:[:sel :mthd |
-        aStream nextPutLine:'Method class ',sel,'!!'.
-        self putString:mthd source on:aStream.
-        aStream nextPutLine:'!!'.
-        self putEntry:'Property' value:'Categories' on:aStream.
-        self putEntry:nil value:mthd category on:aStream.
+    aClass classVariableNames do:[:v |
+        aStream nextPutLine:'ClassVariable ',v,'!!'.
+    ].
+    aClass class instanceVariableNames do:[:v |
+        aStream nextPutLine:'ClassInstanceVariable ',v,'!!'.
     ].
 
-    aClass methodDictionary keysAndValuesDo:[:sel :mthd |
-        aStream nextPutLine:'Method instance ',sel,'!!'.
-        self putString:mthd source on:aStream.
-        aStream nextPutLine:'!!'.
-        self putEntry:'Property' value:'Categories' on:aStream.
-        self putEntry:nil value:mthd category on:aStream.
+    aClass methodDictionary keys asNewOrderedCollection sort do:[:sel |
+        self fileOutMethod:(aClass methodDictionary at:sel) isExtension:false on:aStream.
+    ].
+    aClass class methodDictionary keys asNewOrderedCollection sort do:[:sel |
+        self fileOutMethod:(aClass class methodDictionary at:sel) isExtension:false on:aStream.
     ].
 
     self putEntry:'EndClass' value:nil on:aStream.
@@ -233,6 +238,63 @@
     aStream cr.
 !
 
+fileOutMethod:aMethod isExtension:isExtension on:aStream
+    |sel mclass isMeta rewriteQuery originalSource possiblyRewrittenSource
+     date time user whatVersion methodVersionString info sourceCodeManager|
+
+    sel := aMethod selector.
+    mclass := aMethod mclass.
+    isMeta := mclass isMetaclass.
+
+    projectDefinitionClass isNil ifTrue:[
+        "/ 02/03/15 04:26:18 PM by unknown
+        date := Date today.
+        time := Time now.
+        user := OperatingSystem getFullUserName.
+        whatVersion := 'time exported'.
+    ] ifFalse:[
+        sourceCodeManager := projectDefinitionClass sourceCodeManager.
+        isExtension ifTrue:[
+            info := projectDefinitionClass extensionsRevisionInfoForManager:sourceCodeManager.
+        ] ifFalse:[
+            info := mclass theNonMetaclass revisionInfoOfManager:sourceCodeManager.
+        ].
+        date := Date readFrom:(info date).
+        time := Time readFrom:(info time).
+        user := info user.
+        whatVersion := 'cvs version ',(info revision).
+    ].
+    methodVersionString := '%1 %2 by %3 (%4)'
+                                bindWith:(date printStringFormat:'%m/%d/%Y')
+                                with:(time printStringFormat:'%u:%m:%s %A')
+                                with:user  
+                                with:whatVersion.   
+
+    originalSource := aMethod source.
+    rewriteQuery := AbstractSourceFileWriter methodSourceRewriteQuery new.
+    rewriteQuery method:aMethod source:originalSource.
+    possiblyRewrittenSource := (rewriteQuery query) ? originalSource.
+
+    isExtension ifTrue:[
+        aStream nextPutAll:'MethodDefinition ',(self rewrittenClassNameOf:mclass theNonMetaclass).
+    ] ifFalse:[
+        aStream nextPutAll:'Method'.   
+    ].
+    isMeta ifTrue:[
+        aStream nextPutLine:' class ',sel,'!!'.
+    ] ifFalse:[
+        aStream nextPutLine:' instance ',sel,'!!'.
+    ].
+
+    aStream space.
+    self putString:possiblyRewrittenSource on:aStream.
+    aStream nextPutLine:'!!'.
+    self putEntry:'Property' value:'.Version' on:aStream.
+    self putEntry:'' value:methodVersionString on:aStream.
+    self putEntry:'Property' value:'Categories' on:aStream.
+    self putEntry:'' value:aMethod category on:aStream.
+!
+
 putEntry:key value:value on:aStream
     key notNil ifTrue:[
         aStream nextPutAll:key.
@@ -245,32 +307,72 @@
 !
 
 putString:aString on:aStream
+    "as the string is written (and should be counted) with cr-lf,
+     count the returns and the size compute number"
+
+    |numCRs|
+
+    numCRs := aString occurrencesOf:Character cr.
+
     aStream nextPutAll:'<S'.
-    aStream nextPutAll:aString size asString.
+    aStream nextPutAll:(aString size + numCRs) asString.
     aStream nextPutAll:'>'.
     aStream nextPutAll:aString.
 !
 
 writeHeaderOn:aStream
+    |releaseNr revisionNr author vsePackageName|
+
+    releaseNr := 1.
+    revisionNr := 1.
+    author := OperatingSystem getFullUserName.
+
+    projectDefinitionClass notNil ifTrue:[
+        vsePackageName := projectDefinitionClass perform:#vsePackageName ifNotUnderstood:nil.
+    ].
+    vsePackageName isNil ifTrue:[
+        (Dialog confirm:('No vsePackageName defined in ProjectDefinition.\\Proceed (using ST/X package name)?') withCRs)
+        ifFalse:[
+            AbortOperationRequest raise
+        ].
+    ].
+
+    projectDefinitionClass notNil ifTrue:[
+        releaseNr := projectDefinitionClass perform:#vseReleaseNr ifNotUnderstood:nil.
+        releaseNr isNil ifTrue:[
+            releaseNr := projectDefinitionClass revisionInfo majorVersion 
+        ].
+        revisionNr := projectDefinitionClass perform:#vseRevisionNr ifNotUnderstood:nil. 
+        revisionNr isNil ifTrue:[
+            revisionNr := projectDefinitionClass revisionInfo minorVersion 
+        ].
+        author := projectDefinitionClass perform:#vseAuthor ifNotUnderstood:nil.
+        author isNil ifTrue:[
+            author := projectDefinitionClass revisionInfo author 
+        ].
+    ].
+
     self putEntry:'Header' value:nil on:aStream.
-    self putEntry:'Type' value:'Package' on:aStream.
-    self putEntry:'Format' value:'ExtendedFileOut' on:aStream.
-    self putEntry:'Version' value:'1.0' on:aStream.
+    self putEntry:'Type ' value:'Package' on:aStream.
+    self putEntry:'Format ' value:'ExtendedFileOut' on:aStream.
+    self putEntry:'Version ' value:'1.0' on:aStream.
     self putEntry:'EndHeader' value:nil on:aStream.
 
-    self putEntry:'Package' value:(packageName ? 'unnamed') on:aStream.
+    self putEntry:'Package ' value:(packageName ? 'unnamed') on:aStream.
     self putEntry:'Property' value:'Release' on:aStream.
-    self putEntry:nil value:'1' on:aStream.
+    self putEntry:nil value:(releaseNr asString) on:aStream.
     self putEntry:'Property' value:'RevisionNumber' on:aStream.
-    self putEntry:nil value:'1' on:aStream.
+    self putEntry:nil value:(revisionNr asString) on:aStream.
     self putEntry:'Property' value:'Author' on:aStream.
-    self putEntry:nil value:'nobody' on:aStream.
+    self putEntry:nil value:author on:aStream.
 ! !
 
 !VSEPackageFileSourceWriter methodsFor:'utilities'!
 
 fileOutPackage:packageID on:aStream
-    |classesToFileout methodsToFileOut rewriter|
+    |classesToFileout methodsToFileOut rewriter vsePackageName|
+
+    projectDefinitionClass := packageID asPackageId projectDefinitionClass.
 
     aStream lineEndCRLF.
 
@@ -290,7 +392,7 @@
         self ensureNoUnicodeInMethod:eachClass
     ].
 
-    self packageName:packageID.
+    self packageName:(vsePackageName ? packageID).
     self writeHeaderOn:aStream.
 
     AbstractSourceFileWriter methodSourceRewriteQuery handle:[:rewriteQuery |
@@ -307,7 +409,7 @@
 
         "/ fileout extensions
         methodsToFileOut do:[:eachMethod |
-            self fileOutMethod:eachMethod on:aStream.
+            self fileOutMethod:eachMethod isExtension:true on:aStream.
             aStream cr.
         ].
     ].
@@ -316,10 +418,10 @@
 !VSEPackageFileSourceWriter class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.5 2015-02-02 11:34:18 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.6 2015-02-03 19:14:55 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.5 2015-02-02 11:34:18 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.6 2015-02-03 19:14:55 cg Exp $'
 ! !