class: VSEPackageFileSourceWriter
class definition
added: #fileOutMethod:isExtension:on:
changed:5 methods
seems to be complete now
--- 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 $'
! !