--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/VSEPackageFileSourceWriter.st Wed Jan 21 10:49:00 2015 +0100
@@ -0,0 +1,279 @@
+"
+ COPYRIGHT (c) 2015 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libbasic3' }"
+
+"{ NameSpace: Smalltalk }"
+
+SmalltalkChunkFileSourceWriter subclass:#VSEPackageFileSourceWriter
+ instanceVariableNames:'packageName'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Kernel-Classes-Support'
+!
+
+!VSEPackageFileSourceWriter class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2015 by eXept Software AG
+ All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice. This software may not
+ be provided or otherwise made available to, or used by, any
+ other person. No title to or ownership of the software is
+ hereby transferred.
+"
+!
+
+documentation
+"
+ fileout in a format which can be read by visualAge.
+ For transporting software.
+"
+!
+
+examples
+"
+ [exBegin]
+ |s|
+
+ s := 'test.st' asFilename writeStream.
+ [
+ VSEPackageFileSourceWriter new
+ fileOut:OrderedCollection on:s
+ ] ensure:[
+ s close
+ ]
+ [exEnd]
+
+ [exBegin]
+ |s|
+
+ s := '' writeStream.
+ [
+ VSEPackageFileSourceWriter new
+ fileOut:OrderedCollection on:s
+ ] ensure:[
+ s close
+ ].
+ s contents
+ [exEnd]
+"
+! !
+
+!VSEPackageFileSourceWriter methodsFor:'accessing'!
+
+packageName:something
+ packageName := something.
+! !
+
+!VSEPackageFileSourceWriter methodsFor:'source writing'!
+
+fileOut:aClass on:aStream withTimeStamp:stampIt withInitialize:initIt withDefinition:withDefinition methodFilter:methodFilter encoder:encoderOrNil
+ aStream nextPutAll:'Class '.
+ aStream nextPutAll:aClass nameWithoutPrefix.
+ aStream space.
+ aStream nextPutAll:aClass superclass nameWithoutPrefix.
+ aStream nextPutLine:'!!'.
+
+ aClass isVariable ifTrue:[
+ ] 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 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.
+ ].
+
+ self putEntry:'EndClass' value:nil on:aStream.
+!
+
+fileOutCategory:aCategory of:aClass except:skippedMethods only:savedMethods methodFilter:methodFilter on:aStream
+ "file out all methods belonging to aCategory, aString onto aStream.
+ If skippedMethods is nonNil, those are not saved.
+ If savedMethods is nonNil, only those are saved.
+ If both are nil, all are saved. See version-method handling in
+ fileOut for what this is needed."
+
+ |sortedSelectors first prevPrivacy privacy interestingMethods|
+
+ interestingMethods := OrderedCollection new.
+ aClass methodsDo:[:aMethod |
+ |wanted|
+
+ (methodsAlreadySaved includes:aMethod) ifFalse:[
+ (aCategory = aMethod category) ifTrue:[
+ (methodFilter isNil or:[methodFilter value:aMethod]) ifTrue:[
+ skippedMethods notNil ifTrue:[
+ wanted := (skippedMethods includesIdentical:aMethod) not
+ ] ifFalse:[
+ wanted := savedMethods isNil or:[ savedMethods includesIdentical:aMethod ].
+ ].
+ wanted ifTrue:[
+ aMethod selector isSymbol ifTrue:[
+ interestingMethods add:aMethod
+ ] ifFalse:[
+ Transcript showCR:'skipping non-symbol method ', aMethod selector printString.
+ ].
+ ].
+ ]
+ ]
+ ]
+ ].
+ interestingMethods notEmpty ifTrue:[
+ first := true.
+ prevPrivacy := nil.
+
+ "/
+ "/ sort by selector
+ "/
+ sortedSelectors := interestingMethods collect:[:m | aClass selectorAtMethod:m].
+ sortedSelectors sortWith:interestingMethods.
+
+ interestingMethods do:[:eachMethod |
+ privacy := eachMethod privacy.
+
+ first ifFalse:[
+ privacy ~~ prevPrivacy ifTrue:[
+ first := true.
+ aStream space.
+ aStream nextPutChunkSeparator.
+ ].
+ aStream cr; cr
+ ].
+
+ first ifTrue:[
+ aStream nextPutChunkSeparator.
+ aClass printClassNameOn:aStream.
+ privacy ~~ #public ifTrue:[
+ aStream nextPutAll:' privateMethods'.
+ ] ifFalse:[
+ aStream nextPutAll:' publicMethods'.
+ ].
+ aStream nextPutChunkSeparator; cr; cr.
+ first := false.
+ ].
+ self fileOutMethod:eachMethod on:aStream.
+ methodsAlreadySaved add:eachMethod.
+
+ prevPrivacy := privacy.
+ ].
+ aStream space.
+ aStream nextPutChunkSeparator.
+ aStream cr
+ ].
+ aStream cr
+!
+
+fileOutDefinitionOf:aClass on:aStream
+ "append an expression on aStream, which defines myself."
+
+ |s owner ns superclass nm|
+
+ owner := aClass owningClass.
+ ns := aClass topNameSpace.
+
+ "take care of nil-superclass"
+ superclass := aClass superclass.
+ superclass isNil ifTrue:[
+ s := 'nil'
+ ] ifFalse:[
+ s := superclass nameWithNameSpacePrefix.
+ ].
+
+ aStream nextPutAll:s. "/ superclass
+ aStream space.
+ aClass basicFileOutInstvarTypeKeywordOn:aStream.
+
+ nm := aClass nameWithoutPrefix.
+ aStream nextPut:$#.
+ aStream nextPutAll:nm.
+
+ aStream crtab.
+ aStream nextPutAll:'instanceVariableNames:'''.
+ aClass printInstVarNamesOn:aStream indent:16.
+ aStream nextPutAll:''''.
+
+ aStream crtab.
+ aStream nextPutAll:'classVariableNames:'''.
+ aClass printClassVarNamesOn:aStream indent:16.
+ aStream nextPutAll:''''.
+
+ aStream crtab.
+ aStream nextPutAll:'poolDictionaries:'''.
+ aClass printSharedPoolNamesOn:aStream indent:16.
+ aStream nextPutAll:''''.
+
+ aStream cr.
+!
+
+putEntry:key value:value on:aStream
+ key notNil ifTrue:[
+ aStream nextPutAll:key.
+ ].
+ value notNil ifTrue:[
+ aStream space.
+ self putString:value on:aStream
+ ].
+ aStream nextPutLine:'!!'.
+!
+
+putString:aString on:aStream
+ aStream nextPutAll:'<S'.
+ aStream nextPutAll:aString size asString.
+ aStream nextPutAll:'>'.
+ aStream nextPutAll:aString.
+!
+
+writeHeaderOn:aStream
+ 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:'EndHeader' value:nil 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:'Property' value:'RevisionNumber' on:aStream.
+ self putEntry:nil value:'1' on:aStream.
+ self putEntry:'Property' value:'Author' on:aStream.
+ self putEntry:nil value:'nobody' on:aStream.
+! !
+
+!VSEPackageFileSourceWriter class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.1 2015-01-21 09:49:00 cg Exp $'
+!
+
+version_CVS
+ ^ '$Header: /cvs/stx/stx/libbasic3/VSEPackageFileSourceWriter.st,v 1.1 2015-01-21 09:49:00 cg Exp $'
+! !
+