BeeProjectWriter.st
author Jan Vrany <jan.vrany@fit.cvut.cz>
Tue, 03 Nov 2015 07:19:15 +0000
branchjv
changeset 3922 ae8879b8ba67
parent 3921 243f926d6101
child 4162 e96794cd9edd
permissions -rw-r--r--
Refactored and improved support for writing Bee packages. Added support to write both, .stp and .prj files.

"
 COPYRIGHT (c) 2006 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 }"

Object subclass:#BeeProjectWriter
	instanceVariableNames:'projectDefinitionClass classesToBeInitialized'
	classVariableNames:''
	poolDictionaries:''
	category:'Kernel-Classes-Support'
!

!BeeProjectWriter class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2006 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.
"
! !

!BeeProjectWriter class methodsFor:'private'!

basenameForPackage:pkg
    |  pkgdef |

    pkgdef := ProjectDefinition definitionClassForPackage: pkg.
    ^ pkgdef name.

    "Created: / 03-11-2015 / 07:15:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BeeProjectWriter class methodsFor:'queries'!

isAbstract
    "Return if this class is an abstract class.
     True is returned here for myself only; false for subclasses.
     Abstract subclasses must redefine again."

    ^ self == BeeProjectWriter.
! !

!BeeProjectWriter class methodsFor:'simple API'!

fileOut: pkg in: directory
    "File out Bee package (definition - .prj and source - .stp) in
     given directory."

    | basename prjFilename stpFilename |

    basename := self basenameForPackage: pkg.
    prjFilename := directory asFilename / (basename , '.prj').
    stpFilename := directory asFilename  / (basename , '.stp').

    BeeProjectDefinitionWriter fileOut: pkg to: prjFilename.
    BeeProjectSourceWriter fileOut: pkg to: stpFilename.

    "Created: / 03-11-2015 / 07:14:51 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fileOut:packageId on:stream
    self new fileOut:packageId on:stream

    "Modified: / 14-04-2015 / 13:52:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fileOut:packageId to: stringOrFilename
    stringOrFilename asFilename writingFileDo:[ :stream |
        self fileOut: packageId on: stream
    ].

    "Created: / 24-10-2015 / 08:49:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BeeProjectWriter methodsFor:'private'!

mappings
    | revinfo mappings |

    revinfo := projectDefinitionClass revisionInfo.
    mappings := Dictionary new.
    mappings at: 'NAME' put: projectDefinitionClass name.
    mappings at: 'VERSION' put: revinfo revision.
    mappings at: 'AUTHOR' put: revinfo author asString.
    mappings at: 'TIMESTAMP' put: revinfo date asString, ' ', revinfo time asString.
    mappings at: 'DESCRIPTION' put: projectDefinitionClass description.
    ^ mappings

    "Created: / 02-11-2015 / 16:59:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 02-11-2015 / 18:58:52 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !

!BeeProjectWriter methodsFor:'source writing'!

fileOut:packageID on:aStream
    |classesToFileout methodsToFileOut |

    projectDefinitionClass := packageID asPackageId projectDefinitionClass.
    classesToBeInitialized := OrderedCollection new.

    aStream lineEndCRLF.

    "/ make sure that everything is loaded.
    projectDefinitionClass notNil ifTrue:[
        projectDefinitionClass autoload.
        projectDefinitionClass ensureFullyLoaded.
        classesToFileout := Smalltalk allClassesInPackage:packageID.
    ] ifFalse:[
        classesToFileout := Smalltalk allClassesInPackage:packageID.
        classesToFileout := classesToFileout collect:[:each | each autoload].
    ].

    classesToFileout := classesToFileout reject:[:cls | cls isSubclassOf: ProjectDefinition ].
    classesToFileout topologicalSort:[:a :b | b isSubclassOf:a].

    classesToFileout do:[:cls | 
        cls isPrivate ifTrue:[
            self error:'Cannot file out private class: ',cls name.
        ].
    ].

    methodsToFileOut := projectDefinitionClass extensions.

    self activityNotification:'checking for unportable unicode...'.

    self fileOutHeaderOn:aStream.
    self fileOutClasses: classesToFileout on: aStream.
    self fileOutExtensions: methodsToFileOut on: aStream.
    self fileOutFooterOn: aStream.

    "Created: / 14-04-2015 / 13:42:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
    "Modified: / 03-11-2015 / 23:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fileOutClasses:arg1 on:arg2
    "raise an error: must be redefined in concrete subclass(es)"

    ^ self subclassResponsibility
!

fileOutExtensions:arg1 on:arg2
    "raise an error: must be redefined in concrete subclass(es)"

    ^ self subclassResponsibility
!

fileOutFooterOn:aStresm

    "Created: / 03-11-2015 / 23:05:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!

fileOutHeaderOn:arg
    "raise an error: must be redefined in concrete subclass(es)"

    ^ self subclassResponsibility
! !