"

 COPYRIGHT (c) 2015-2016 Jan Vrany

              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:'name version author timestamp description classesToBeInitialized

		writer'

	classVariableNames:''

	poolDictionaries:''

	category:'Kernel-Classes-Support'

!

!BeeProjectWriter class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 2015-2016 Jan Vrany

              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:'initialization'!

initialize

    "Invoked at system start or when the class is dynamically loaded."

    "/ please change as required (and remove this comment)

! !

!BeeProjectWriter class methodsFor:'instance creation'!

new

    "return an initialized instance"

    ^ self basicNew initialize.

! !

!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:'accessing'!

author

    ^ author

!

author:something

    author := something.

!

description

    ^ description

!

description:something

    description := something.

!

name

    ^ name

!

name:something

    name := something.

!

timestamp

    ^ timestamp

!

timestamp:something

    timestamp := something.

!

version

    ^ version

!

version:something

    version := something.

! !

!BeeProjectWriter methodsFor:'initialization'!

initialize

    "Invoked when a new instance is created."

    "/ please change as required (and remove this comment)

    "/ name := nil.

    author := OperatingSystem getFullUserName.

    version := timestamp := Timestamp now.

    description := 'Not yet described'.

    classesToBeInitialized := Dictionary new.

    writer := BeeSourceWriter new.

    "/ super initialize.   -- commented since inherited method does nothing

    "Modified: / 26-10-2018 / 11:46:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BeeProjectWriter methodsFor:'private'!

mappings

    | mappings |

    mappings := Dictionary new.

    mappings at: 'NAME' put: name.

    mappings at: 'VERSION' put: version.

    mappings at: 'AUTHOR' put: author .

    mappings at: 'TIMESTAMP' put: timestamp asDate asString, ' ', timestamp asTime asString.

    mappings at: 'DESCRIPTION' put: description.

    ^ mappings

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

    "Modified: / 07-09-2016 / 14:21:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectClassesFrom: aCollection 

    ^ aCollection reject:[:class | class isProjectDefinition or:[ class isSharedPool ] ]

    "Created: / 29-10-2018 / 15:45:16 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectExtensionsFrom: aCollection 

    ^ aCollection

    "Created: / 29-10-2018 / 15:45:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"

!

selectPoolsFrom: aCollection

    ^ aCollection select:[:class | class isSharedPool ]

    "Created: / 29-10-2018 / 15:45:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BeeProjectWriter methodsFor:'source writing'!

fileOut:packageID on:aStream

    | projectDefinitionClass revinfo classes extensions |

    projectDefinitionClass := packageID asPackageId projectDefinitionClass.

    classesToBeInitialized := OrderedCollection new.

    name := projectDefinitionClass name.

    writer project: name.

    description := projectDefinitionClass description.  

    revinfo := projectDefinitionClass revisionInfo.

    revinfo notNil ifTrue:[ 

        version := revinfo revision.

        author := revinfo author asString.

        timestamp := Timestamp fromDate: (Date readFrom: revinfo date) andTime: (Time readFrom: revinfo time).

    ] ifFalse:[ 

        version := Timestamp now printString.

        author := UserPreferences current historyManagerSignature.

        timestamp := Timestamp now.

    ].

    aStream lineEndCRLF.

    "/ make sure that everything is loaded.

    projectDefinitionClass notNil ifTrue:[

        projectDefinitionClass autoload.

        projectDefinitionClass ensureFullyLoaded.

        classes := Smalltalk allClassesInPackage:packageID.

    ] ifFalse:[

        classes := Smalltalk allClassesInPackage:packageID.

        classes := classes collect:[:each | each autoload].

    ].

    extensions := projectDefinitionClass extensionMethods.

    self fileOutHeaderOn:aStream.

    self fileOutPools: (self selectPoolsFrom:classes) on:  aStream. 

    self fileOutClasses: (self selectClassesFrom:classes) on: aStream.

    self fileOutExtensions: (self selectExtensionsFrom:extensions) on: aStream.

    self fileOutFooterOn: aStream.

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

    "Modified: / 30-10-2018 / 14:43:08 / 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

!

fileOutPools: pools on: stream

    ^ self subclassResponsibility

    "Created: / 29-10-2018 / 15:40:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"

! !

!BeeProjectWriter class methodsFor:'documentation'!

version_HG

    ^ '$Changeset: <not expanded> $'

! !

BeeProjectWriter initialize!