"

 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 }"

	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 class methodsFor:'utilities'!

fileOutPackage:packageID on:aStream

    aStream lineEndCRLF.

    classesToFileout := Smalltalk allClassesInPackage:packageID.

    classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].

    writer := VSEPackageFileSourceWriter new.

    writer packageName:packageID.

    writer writeHeaderOn:aStream.

    AbstractSourceFileWriter methodSourceRewriteQuery handle:[:rewriteQuery |

        |method source|

        method := rewriteQuery method.

        source := rewriteQuery source.

        rewriteQuery proceedWith:source.

    ] do:[

        classesToFileout do:[:eachClass |

            writer fileOut:eachClass on:aStream

        ].

        "/ fileout extensions

        ].

    ].

! !

!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

!

version_CVS

! !