"

COPYRIGHT (c) 2023 LabWare

"

"{ Package: 'stx:goodies/monticello' }"

"{ NameSpace: Smalltalk }"

MCMczWriter subclass:#MCStxMczWriter

	instanceVariableNames:''

	classVariableNames:''

	poolDictionaries:''

	category:'SCM-Monticello-St/X Storing'

!

!MCStxMczWriter class methodsFor:'documentation'!

copyright

"

COPYRIGHT (c) 2023 LabWare

"

!

documentation

"

    redefined to add some more stuff to the mcz archive:

    - package pragma to the source code.

    - stx subdirectory (optional), containing required support files for building

          plus resource files.

    - stx.bin subdirectory (optional), containing a precompiled binary dll as per architecture.

"

! !

!MCStxMczWriter class methodsFor:'as yet unclassified'!

readerClass

    ^ MCStXMczReader

    "Created: / 10-05-2015 / 05:46:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStxMczWriter methodsFor:'accessing'!

snapshotWriterClass

        ^ MCStxStWriter

! !

!MCStxMczWriter methodsFor:'serializing'!

serializeDefinitions:definitions

    |string|

    string := super serializeDefinitions:definitions.

    string isWideString ifTrue:[

        ^ string utf8Encoded

    ].

    ^ string

!

serializePackageStX:aPackage

    ^ '(name ''', aPackage packageInfo projectDefinition package , ''')'

    "Created: / 29-05-2013 / 01:49:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStxMczWriter methodsFor:'visiting'!

writeBuildSupportFiles:aVersion for:aProjectDefinition

    Error handle:[:ex |

        Dialog information:('Cannot write build support files because:\\',ex description,'\\Writing source files only.') withCRs.

        ^ self

    ] do:[

        aProjectDefinition forEachFileNameAndGeneratedContentsDo:[:file :contents |

            self addString: contents at: 'snapshot.stx/', file.

        ].

    ]

!

writeIndividualSourceFiles:aVersion for:aProjectDefinition

    "individual source files for dll compilation"

    aProjectDefinition classNames do:[:eachClassName |

        |cls fileName source|

        cls := Smalltalk classNamed:eachClassName.

        cls isNil ifTrue:[

            Transcript showCR:'class missing: ',eachClassName

        ] ifFalse:[

            cls autoload.

            fileName := (Smalltalk fileNameForClass:cls),'.st'.

            source := String streamContents:[:s | cls fileOutOn:s withTimeStamp:false].

            self addString: source at: 'snapshot.stx/', fileName.                               

        ]

    ].

!

writePackage: aPackage

    super writePackage: aPackage.

    aPackage isStXPackage ifTrue:[

        self writePackageStX:aPackage

    ]

    "Created: / 29-05-2013 / 01:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writePackageStX:aPackage 

    self addString:(self serializePackageStX:aPackage) at:'package.stx'

    "Created: / 29-05-2013 / 01:48:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

writeResourceFiles:aVersion for:aProjectDefinition

    "language translations kept in externalfiles"

    |dir rsrcDir|

    dir := aProjectDefinition projectDirectory.

    dir isNil ifTrue:[

        "/ no directory - no resource files

        ^  self.

    ].

    (rsrcDir := dir asFilename / 'resources') exists ifTrue:[

        rsrcDir recursiveDirectoryContentsDo:[:relFn |

            (rsrcDir construct:relFn) isDirectory ifFalse:[

                self addString: ((rsrcDir construct:relFn) contentsOfEntireFile) at: 'snapshot.stx/resources/', relFn.

            ]            

        ].

    ].

!

writeSnapshot: snapshot  forVersion: aVersion

    | source |

    source := 

        ('"{ Package: ''%1'' }" !!\\' withCRs bindWith:aVersion package name)

        ,  (self serializeDefinitions: snapshot definitions).

    self addString: source at: 'snapshot/source.', self snapshotWriterClass extension.

    "/ CG: I think, we can comment the following (or is it compatible?)

    "/ JV: 

    "/ NO, DON'T DO IT!! snapshot.bin is THE ONLY thing that Pharo/Squeak reads.

    "/ It does not care about snapshot/source.st, actually

    self addString: (self serializeInBinary: snapshot) at: 'snapshot.bin'

    "Modified (comment): / 31-07-2015 / 08:59:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"

    "Modified: / 23-03-2023 / 14:11:26 / Jan Vrany <jan.vrany@labware.com>"

!

writeVersion: aVersion

    |packageID prjDef|

    super writeVersion: aVersion.

    aVersion snapshot options includeExtrasForSTX ifTrue:[

        "/ ST/X specific stuff here.

        packageID := aVersion package name.

        prjDef := ProjectDefinition definitionClassForPackage:packageID.

        prjDef isNil ifTrue:[

            "/ not a project definition mcz - simply skip

            Transcript show:'No projectDefinition for ',packageID, ' generated simple source only'.

        ] ifFalse:[

            "/ additional support files for recompilation...

            self writeIndividualSourceFiles: aVersion for: prjDef.

            self writeBuildSupportFiles: aVersion for: prjDef.

            self writeResourceFiles: aVersion for: prjDef.

        ]

    ]

    "Modified: / 07-09-2015 / 15:28:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!MCStxMczWriter class methodsFor:'documentation'!

version

    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStxMczWriter.st,v 1.6 2013-05-29 11:47:31 vrany Exp $'

!

version_CVS

    ^ '$Header: /cvs/stx/stx/goodies/monticello/MCStxMczWriter.st,v 1.6 2013-05-29 11:47:31 vrany Exp $'

!

version_HG

    ^ '$Changeset: <not expanded> $'

! !