"{ Package: 'stx:libtool2' }"

Object subclass:#ProjectBuilder

	instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory

		myWorkingDirectory mySTXTopDirectory myTopDirectory'

	classVariableNames:'PreviousBuildDirectory'

	poolDictionaries:''

	category:'System-Support-Projects'

!

!ProjectBuilder class methodsFor:'examples'!

example1

    Smalltalk loadPackage:'stx:projects/helloWorldApp' asAutoloaded:true.

    self new

        package:'stx:projects/helloWorldApp';

        build

! !

!ProjectBuilder methodsFor:'accessing'!

package:aPackageIDOrSymbol

    package := aPackageIDOrSymbol asPackageId.

!

projectDefinitionClass:something

    projectDefinitionClass := something.

! !

!ProjectBuilder methodsFor:'building'!

build

    "/ intermediate - this will move into a commonly used utility class

    "/ (where all the project code support will be collected).

    |module directory|

    projectDefinitionClass := ProjectDefinition definitionClassForPackage:package.

    projectDefinitionClass isNil ifTrue:[

        self error:('Missing ProjectDefinition class for "',package asString,'"')

    ].

    "/ ensure that everything is loaded...

    projectDefinitionClass loadAsAutoloaded:false.

    projectDefinitionClass loadExtensions.

    projectDefinitionClass loadAllClassesAsAutoloaded:false.

    module := package module.

    directory := package directory.

    buildDirectory := PreviousBuildDirectory ifNil:[ UserPreferences current buildDirectory ].

    buildDirectory isNil ifTrue:[

        buildDirectory := Filename tempDirectory construct:'stx_build'.

    ].

    buildDirectory := buildDirectory asFilename.

    "/ self validateBuildDirectoryIsPresent.

    PreviousBuildDirectory := buildDirectory.

    "/ UserPreferences current localBuild:true

    UserPreferences current localBuild ifFalse:[

        SourceCodeManager notNil ifTrue:[

            sourceCodeManager := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinitionClass.

        ]

    ].

    sourceCodeManager := nil.

    myTopDirectory := 

        Smalltalk packagePath 

            detect:[:aPath |

                (aPath asFilename / 'stx' / 'include') exists

                and: [ (aPath asFilename / 'stx' / 'rules') exists ]]

            ifNone:nil.       

    myTopDirectory isNil ifTrue:[

        self error:('Cannot figure out my top directory (where stx/include and stx/rules are)')

    ].

    myTopDirectory := myTopDirectory asFilename.

    mySTXTopDirectory := myTopDirectory / 'stx'.

    self setupBuildDirectory.

    self copySTCDirectoryForBuild.

    self generateSourceFiles.

    OperatingSystem

        executeCommand:(ParserFlags makeCommand,' exe')

        inputFrom:nil

        outputTo:Transcript

        errorTo:Transcript

        inDirectory:(buildDirectory / module / directory)

        onError:[:status| self error:'make failed'].

    "Created: / 09-08-2006 / 18:37:19 / fm"

    "Modified: / 09-08-2006 / 19:55:50 / fm"

    "Modified: / 22-09-2006 / 17:37:11 / cg"

!

copyDirectory:relativepath

    "/ need rules in stx

    ((Smalltalk projectDirectoryForPackage:'stx') asFilename construct:relativepath)

        recursiveCopyTo:(buildDirectory construct:'stx').

!

copyDirectoryForBuild:subdir

    |targetDir targetFile|

    targetDir := buildDirectory / 'stx' / subdir.

    targetDir exists ifFalse:[

        targetDir makeDirectory.

    ].

    (mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |

        eachFile isDirectory ifFalse:[

            targetFile := targetDir / eachFile baseName.

            (targetFile exists not

            or:[ targetFile modificationTime < eachFile modificationTime ]) ifTrue:[

                self activityNotification:'copying ',eachFile pathName,'...'.

                eachFile copyTo:(targetDir construct:eachFile baseName)

            ]

        ].

    ].

    self activityNotification:nil

!

copySTCDirectoryForBuild

    |targetDir stc files|

    targetDir := buildDirectory / 'stx' / 'stc'.

    targetDir exists ifFalse:[ targetDir makeDirectory ].

    stc := OperatingSystem isMSWINDOWSlike 

                ifTrue:[ 'stc.exe' ]

                ifFalse:[ 'stc' ].

    files := #( ) copyWith:stc.

    files do:[:eachFile |

        |sourceFile targetFile|

        sourceFile := mySTXTopDirectory / 'stc' / eachFile.

        targetFile := targetDir / eachFile.

        (targetFile exists not

        or:[ targetFile modificationTime < sourceFile modificationTime ]) ifTrue:[

            self activityNotification:'copying ',sourceFile pathName,'...'.

            sourceFile copyTo:targetFile

        ].

    ].

    self activityNotification:nil

!

createHeaderFileFor:aClass in:packageTargetDir

    |instVarList classInstVarList classVarList bindings superclassFilename

     template file newContents oldContents|

    instVarList := StringCollection new.

    aClass instVarNames do:[:v |

        instVarList add:('OBJ %1;' bindWith:v)

    ].

    classInstVarList := StringCollection new.

    aClass class instVarNames do:[:v |

(v includes:$_) ifTrue:[self halt].

        classInstVarList add:('OBJ %1;' bindWith:v)

    ].

    classVarList := StringCollection new.

    aClass classVarNames do:[:v |

        classVarList add:('extern OBJ %1_%2;' bindWith:aClass name with:v)

    ].

    bindings := Dictionary new.

    bindings at:'ClassName' put:aClass name. 

    aClass superclass isNil ifTrue:[

        bindings at:'SuperclassName' put:'-'. 

        bindings at:'SuperclassFileInclude' put:nil.

    ] ifFalse:[

        bindings at:'SuperclassName' put:aClass superclass name. 

        bindings at:'SuperclassFileName' put:(superclassFilename := Smalltalk fileNameForClass:aClass superclass).

        bindings at:'SuperclassFileInclude' put:('#include "%1.STH"' bindWith:superclassFilename).

    ].

    bindings at:'InstVarList' put:instVarList asString. 

    bindings at:'ClassVarList' put:classVarList asString. 

    bindings at:'ClassInstVarList' put:classInstVarList asString. 

    template := 

'/* This file was generated by ProjectBuilder. */

/* !!!!!!!! Do not change by hand !!!!!!!! */

/* Class: %(ClassName) */

/* Superclass: %(SuperclassName) */

%(SuperclassFileInclude)

/* INDIRECTGLOBALS */

#ifdef _HEADER_INST_

%(InstVarList)

#endif /* _HEADER_INST_ */

#ifdef _HEADER_CLASS_

%(ClassVarList)

#endif /* _HEADER_CLASS_ */

#ifdef _HEADER_CLASSINST_

%(ClassInstVarList)

#endif /* _HEADER_CLASSINST_ */

'.

    newContents := template bindWithArguments:bindings.

    file := packageTargetDir asFilename / ((Smalltalk fileNameForClass:aClass),'.STH').

    (file exists not

    or:[ (oldContents := file contents) ~= newContents ]) ifTrue:[

        file contents: newContents.

    ].

!

generateSourceFiles

    sourceCodeManager notNil ifTrue:[

        "/ check out / generate files there

        self generateSourceFilesByCheckingOutUsing:sourceCodeManager

    ] ifFalse:[

        "/ local build

        "/ fileout the project

        self generateSourceFilesByFilingOut

    ]

!

generateSourceFilesByCheckingOutUsing:aSourceCodeManager

    "/ will no longer be needed/supported

    |repository stxRepository module directory|

self halt.

    "/ check out / generate files there

    repository := (aSourceCodeManager repositoryNameForModule:module) ifNil:[aSourceCodeManager repositoryName].

    stxRepository := aSourceCodeManager repositoryName.

    (buildDirectory construct:'stx') exists ifFalse:[

        (module ~= 'stx') ifTrue:[

            OperatingSystem

                executeCommand:('cvs -d ',stxRepository,' co stx')

                inputFrom:nil

                outputTo:Transcript

                errorTo:Transcript

                inDirectory:buildDirectory

                onError:[:status| self error:'cvs update stx failed'].

        ].

    ].

    ((buildDirectory construct:module) construct:'CVS') exists ifFalse:[

        OperatingSystem

            executeCommand:('cvs -d ',repository,' co -l ',directory)

            inputFrom:nil

            outputTo:Transcript

            errorTo:Transcript

            inDirectory:buildDirectory

            onError:[:status| self error:'cvs update failed'].

    ].

    OperatingSystem

        executeCommand:'cvs upd -d'

        inputFrom:nil

        outputTo:Transcript

        errorTo:Transcript

        inDirectory:(buildDirectory construct:module)

        onError:[:status| self error:'cvs update failed'].

self halt.

!

generateSourceFilesByFilingOut

    "/ local build

    "/ fileout the project

    (package module ~= 'stx') ifTrue:[

        (buildDirectory / package module) makeDirectory.

    ].

    "/ file out the package(s) which are to be built

    ((Array with:package))

    do:[:eachPackageToFileout |

        |packageId packageModule packageDirectory packageTargetDir packageDef|

        packageId := eachPackageToFileout asPackageId.

        packageModule := packageId module.

        packageDirectory := packageId directory.

        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.

        packageDef := packageId projectDefinitionClass.

        (packageDef compiled_classNames_common ,

        packageDef compiled_classNamesForPlatform) do:[:eachClassName |

            |cls|

            cls := Smalltalk classNamed:eachClassName.

            self assert:cls isLoaded.

            cls fileOutIn:packageTargetDir

        ].

"/        (Smalltalk allClassesInPackage:eachPackageToFileout) do:[:cls |

"/            cls isPrivate ifFalse:[

"/                cls isLoaded ifFalse:[

"/                    self halt.

"/                    cls autoload.

"/                ].

"/                cls fileOutIn:packageTargetDir

"/            ]

"/        ].

        projectDefinitionClass forEachFileNameAndGeneratedContentsDo:[:fileName :fileContents |

            ((packageTargetDir / fileName) exists

            and:[ (packageTargetDir / fileName) contents = fileContents ]) ifFalse:[

                (packageTargetDir / fileName) contents:fileContents.

            ].

        ].    

    ].

    "/ generate header files in prerequisite packages...

    (projectDefinitionClass allPreRequisites)

    do:[:eachPackageToFileout |

        |packageId packageDef packageModule packageDirectory packageTargetDir|

        packageId := eachPackageToFileout asPackageId.

        packageModule := packageId module.

        packageDirectory := packageId directory.

        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.

        packageDef := packageId projectDefinitionClass.

        (packageDef compiled_classNames_common ,

        packageDef compiled_classNamesForPlatform) do:[:eachClassName |

            |cls|

            cls := Smalltalk classNamed:eachClassName.

            cls isLoaded ifTrue:[    

                self createHeaderFileFor:cls in:packageTargetDir

            ].

        ].

    ].

"/    stx_libbasic2 preRequisitesForBuilding#(#'stx:libbasic')

!

setupBuildDirectory

    buildDirectory exists ifFalse:[

        buildDirectory recursiveMakeDirectory.

    ].

    (buildDirectory / 'stx') exists ifFalse:[

        (buildDirectory / 'stx') makeDirectory.

    ].

    self copyDirectoryForBuild:'include'.

    self copyDirectoryForBuild:'rules'.

!

validateBuildDirectoryIsPresent

    ^ self.

"/    [

"/        |default directoryIsOKForMe stc |

"/

"/        default := (buildDirectory ?

"/                          PreviousBuildDirectory)

"/                          ifNil:[ UserPreferences current buildDirectory].

"/

"/        buildDirectory := Dialog requestDirectoryName:'Temporary Work-ROOT for build:'

"/                                 default:default.

"/

"/        buildDirectory isEmptyOrNil ifTrue:[^ self].

"/        buildDirectory := buildDirectory asFilename.

"/        directoryIsOKForMe := true.

"/

"/        buildDirectory exists ifFalse:[

"/            Dialog warn:(self classResources string:'Work directory %1 does not exist.' with:buildDirectory).

"/            directoryIsOKForMe := false.

"/        ] ifTrue:[

"/            (buildDirectory construct:'stx') exists ifFalse:[

"/                Dialog warn:(self classResources stringWithCRs:'Work directory must contain an stx subDirectory,\which contains (at least) the stc and include subdirectories.').

"/                directoryIsOKForMe := false.

"/            ] ifTrue:[

"/                stc := (OperatingSystem isMSDOSlike) ifTrue:['stc.exe'] ifFalse:['stc'].

"/                (((buildDirectory construct:'stx')construct:'stc')construct:stc) exists ifFalse:[

"/                    Dialog warn:(self classResources stringWithCRs:'Work directory must contain an stc compiler in the stx/stc subDirectory.').

"/                    directoryIsOKForMe := false.

"/                ].

"/                ((buildDirectory construct:'stx')construct:'include') exists ifFalse:[

"/                    Dialog warn:(self classResources stringWithCRs:'Work directory must have had a make run before (for include files to exists).').

"/                    directoryIsOKForMe := false.

"/                ].

"/            ]

"/        ].

"/        directoryIsOKForMe

"/    ] whileFalse

! !

!ProjectBuilder class methodsFor:'documentation'!

version_CVS

    ^ '$Header$'

! !