"{ Package: 'stx:libtool2' }"

"{ NameSpace: Tools }"

Object subclass:#ProjectBuilder
	instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory
		myWorkingDirectory mySTXTopDirectory myTopDirectory outputStream
		makeExeOnly usedCompiler'
	classVariableNames:'PreviousBuildDirectory'
	poolDictionaries:''
	category:'System-Support-Projects'
!


!ProjectBuilder class methodsFor:'accessing'!

previousBuildDirectory
    ^ PreviousBuildDirectory
!

previousBuildDirectory:something
    PreviousBuildDirectory := something.
! !

!ProjectBuilder class methodsFor:'examples'!

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

    self new
        package:'stx:projects/helloWorldApp';
        build
!

example2
    |builder|

    Smalltalk loadPackage:'stx:clients/Demos/foxCalcApplication' asAutoloaded:true.

    builder := self new.
    builder package:'stx:clients/Demos/foxCalcApplication'.
    builder build.

    UserPreferences fileBrowserClass openOnDirectory:builder packageBuildDirectory.
! !

!ProjectBuilder methodsFor:'accessing'!

buildDirectory
    ^ buildDirectory
!

buildDirectory:something
    buildDirectory := something.
!

makeExeOnly:aBoolean
    makeExeOnly := aBoolean.
!

package:aPackageIDOrSymbol
    package := aPackageIDOrSymbol asPackageId.
!

packageBuildDirectory
    "the directoray, where the deployable binary is created (xxxSetup.exe)"

    ^ buildDirectory / (package asPackageId module) / (package asPackageId directory)
!

projectDefinitionClass:something
    projectDefinitionClass := something.
!

suffixForHeaderFiles
    ^ OperatingSystem isUNIXlike ifTrue:['.H'] ifFalse:['.STH']
!

usedCompiler:something
    usedCompiler := something.
! !

!ProjectBuilder methodsFor:'building'!

build
    "/ intermediate - this will move into a commonly used utility class
    "/ (where all the project code support will be collected).

    |makeOutput|

    makeOutput := TextStream on:(Text new:10000).
    self buildWithColorizedOutputTo:makeOutput.

    TextView openWith:makeOutput contents.
!

buildWithColorizedOutputTo:makeOutput
    "/ intermediate - this will move into a commonly used utility class
    "/ (where all the project code support will be collected).

    |stdOut stdErr lock|

    lock := Semaphore forMutualExclusion.

    stdErr := ActorStream new
                    nextPutBlock:[:char |
                        lock critical:[
                            makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}.
                            makeOutput nextPut:char.
                            makeOutput emphasis:nil.
                        ]
                    ];
                    nextPutAllBlock:[:string |
                        lock critical:[          (string includesString:'das Ziel' )ifTrue:[self halt].
                            makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}.
                            makeOutput nextPutAll:string.
                            makeOutput emphasis:nil.
                        ]
                    ].
    stdOut := ActorStream new
                    nextPutBlock:[:char |
                        lock critical:[
                            makeOutput nextPut:char.
                        ]
                    ];
                    nextPutAllBlock:[:string |
                        lock critical:[         (string includesString:'das Ziel' )ifTrue:[self halt].
                            makeOutput nextPutAll:string.
                        ]
                    ].

    self buildWithOutputTo:stdOut errorTo:stdErr.
!

buildWithOutputTo:stdOut errorTo:stdErr
    "/ 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 isNil ifTrue:[
        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 activityNotification:'Generating stc directory...'.
    self copySTCDirectoryForBuild.
    self activityNotification:'Generating source files...'.
    self generateSourceFiles.
    self activityNotification:'Copying dlls for linkage...'.
    self copyDLLsForLinkage.
    self activityNotification:'Copying support files for linkage...'.
    self copySupportFilesForLinkage.
    self copyStartupFilesFromSmalltalk.

    self activityNotification:'Executing make...'.
    self makeWithOutputTo:stdOut errorTo:stdErr.
!

copyDLLsForLinkage
    |targetBuildDir|

    targetBuildDir := buildDirectory / package module / package directory.

    (projectDefinitionClass allPreRequisites)
    do:[:eachPackageToFileout |
        |packageId packageDef packageModule packageDirectory packageTargetDir
         dllSource dllSourceDir libraryName dllRelativePath|

        packageId := eachPackageToFileout asPackageId.
        packageModule := packageId module.
        packageDirectory := packageId directory.
        packageTargetDir := (buildDirectory / packageModule / packageDirectory) recursiveMakeDirectory.

        packageDef := packageId projectDefinitionClass.
        libraryName := packageDef libraryName.

        "/ mhmh - take them from my tree or from the projects/smalltalk execution directory ??
        dllSourceDir := myTopDirectory / packageModule / packageDirectory.
        OperatingSystem isMSWINDOWSlike ifTrue:[
"/            dllRelativePath := 'objvc','/',(libraryName,'.dll').
"/            (dllSourceDir / dllRelativePath) exists 
            false ifFalse:[
                dllRelativePath := 'objbc','/',(libraryName,'.dll').
            ]
        ] ifFalse:[
            dllRelativePath := libraryName,'.so'.
        ].
        ((packageTargetDir / dllRelativePath) exists
        and:[ (dllSourceDir / dllRelativePath) fileSize = (packageTargetDir / dllRelativePath) fileSize
        and:[ (dllSourceDir / dllRelativePath) modificationTime < (packageTargetDir / dllRelativePath) modificationTime
        "/ and:[ (dllSourceDir / dllRelativePath) sameContentsAs:(packageTargetDir / dllRelativePath) ]
        ]]) ifFalse:[
            (packageTargetDir / dllRelativePath) directory recursiveMakeDirectory.
            (dllSourceDir / dllRelativePath) copyTo:(packageTargetDir / dllRelativePath).    
        ]
    ].
!

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
!

copyResourcesForPackage:aPackage
    |module directory|

    module := aPackage asPackageId module.
    directory := aPackage asPackageId directory.

    (myTopDirectory / module / directory / 'resources' ) exists ifTrue:[
        (myTopDirectory / module / directory / 'resources' )
            recursiveCopyTo:(buildDirectory / module / directory)
    ].
    (myTopDirectory / module / directory / 'styles' ) exists ifTrue:[
        (myTopDirectory / module / directory / 'styles' )
            recursiveCopyTo:(buildDirectory / module / directory)
    ].
!

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
        ].
    ].

    OperatingSystem isUNIXlike ifTrue:[
        (targetDir / 'stc') makeExecutableForAll    
    ].

    self activityNotification:nil
!

copyStartupFilesFromSmalltalk
    (buildDirectory / 'stx' / 'projects/smalltalk' ) exists ifFalse:[
        (buildDirectory / 'stx' / 'projects/smalltalk' ) recursiveMakeDirectory.
    ].

    #( 
        'keyboard.rc' 
        'keyboardMacros.rc' 
        'display.rc' 
        'd_win32.rc'
        'host.rc' 
        'h_win32.rc'  
        'smalltalk.rc'  
        'private.rc'  
    ) do:[:fn |
        (myTopDirectory / 'stx' / 'projects/smalltalk' / fn)
            copyTo: (buildDirectory / 'stx' / 'projects/smalltalk' / fn)
    ].

    (myTopDirectory / 'stx' / 'doc/online/english/LICENCE_STX.html')
            copyTo: (buildDirectory / 'stx' / 'projects/smalltalk' / 'LICENCE_STX.html').
!

copySupportFilesForLinkage
    |files|

    OperatingSystem isMSWINDOWSlike ifTrue:[
        files := #( 
                    'support/win32/borland/cs3245.dll' 
                    'support/win32/X11.dll'
                    'support/win32/Xext.dll'
                    'librun/librun.dll'
                    'libbc/librun.lib'
                    'libbc/cs32i.lib'
                    'librun/genDate.exe'
                    'librun/main.c'
                    'projects/smalltalk/stx_16x16.ico'
                    'projects/smalltalk/stx_32x32.ico'
                    'projects/smalltalk/stx_splash.bmp'
                 ).
    ] ifFalse:[
        files := #(
                    'librun/main.c'
                    'librun/librun.so'
                )
    ].
    files := files asOrderedCollection.

    OperatingSystem isMSWINDOWSlike ifTrue:[
        projectDefinitionClass applicationIconFileName notNil ifTrue:[
            files add:('projects/smalltalk/',projectDefinitionClass applicationIconFileName,'.ico')
        ].
        projectDefinitionClass splashFileName notNil ifTrue:[
            files add:('projects/smalltalk/',projectDefinitionClass splashFileName,'.bmp')
        ].
    ].

    files do:[:dllRelativePath |
        (mySTXTopDirectory / dllRelativePath) exists ifTrue:[
            ((buildDirectory / 'stx' / dllRelativePath) exists
            and:[ (mySTXTopDirectory / dllRelativePath) fileSize = (buildDirectory / 'stx' / dllRelativePath) fileSize
            and:[ (mySTXTopDirectory / dllRelativePath) modificationTime < (buildDirectory / 'stx' / dllRelativePath) modificationTime
            "/ and:[ (mySTXTopDirectory / dllRelativePath) sameContentsAs:(targetBuildDir / dllRelativePath) ]
            ]]) ifFalse:[
                (buildDirectory / 'stx' / dllRelativePath) directory recursiveMakeDirectory.
                (mySTXTopDirectory / dllRelativePath) copyTo:(buildDirectory / 'stx' / dllRelativePath).    
            ]
        ] ifFalse:[
            self error:'Missing file: ',dllRelativePath printString mayProceed:true.
        ].
    ].
!

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),(self suffixForHeaderFiles)).
    (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 fileName newSource|

            cls := Smalltalk classNamed:eachClassName.
            self assert:cls isLoaded.
            fileName := (Smalltalk fileNameForClass:cls),'.st'.
            fileName := packageTargetDir asFilename construct:fileName.
            fileName exists ifTrue:[
                newSource := String streamContents:[:s | cls fileOutOn:s withTimeStamp:false].
                newSource = fileName contentsAsString ifFalse:[
                    fileName contents:newSource
                ].
            ] ifFalse:[
                cls fileOutIn:packageTargetDir withTimeStamp:false
            ].
        ].

"/        (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.
            "/ self assert:cls isLoaded.
            cls isLoaded ifTrue:[    
                self createHeaderFileFor:cls in:packageTargetDir
            ].
        ].
        self copyResourcesForPackage:eachPackageToFileout.
    ].

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

makeWithOutputTo:stdOut errorTo:stdErr
    |module directory compilerFlag makeCommand|

    module := package module.
    directory := package directory.

    makeCommand := ParserFlags makeCommand.
    usedCompiler = 'vc' ifTrue:[ makeCommand := 'vcmake'. compilerFlag := 'USEVC=1' ].
    usedCompiler = 'lcc' ifTrue:[ makeCommand := 'lcmake'. compilerFlag := 'USELCC=1' ].
    usedCompiler = 'gcc' ifTrue:[ makeCommand := 'make'. ].

    OperatingSystem isUNIXlike ifTrue:[
        OperatingSystem
            executeCommand:'sh ../../stx/rules/stmkmf'
            inputFrom:nil
            outputTo:stdOut
            errorTo:stdErr
            inDirectory:(buildDirectory / module / directory)
            onError:[:status| self error:'make failed'].
    ].

    projectDefinitionClass isLibraryDefinition ifTrue:[
        OperatingSystem
            executeCommand:(makeCommand,' classLibRule')
            inputFrom:nil
            outputTo:stdOut
            errorTo:stdErr
            inDirectory:(buildDirectory / module / directory)
            onError:[:status| self error:'make failed'].
    ] ifFalse:[
        OperatingSystem
            executeCommand:(makeCommand,' exe')
            inputFrom:nil
            outputTo:stdOut
            errorTo:stdErr
            inDirectory:(buildDirectory / module / directory)
            onError:[:status| self error:'make failed'].

        (makeExeOnly ? false) ifFalse:[
            OperatingSystem
                executeCommand:(makeCommand,' setup')
                inputFrom:nil
                outputTo:stdOut
                errorTo:stdErr
                inDirectory:(buildDirectory / module / directory)
                onError:[:status| self error:'make failed'].
        ]
    ]
!

recursiveCopyDirectoryForBuild:subdir
    |targetDir|

    targetDir := buildDirectory / 'stx' / subdir.
    targetDir exists ifFalse:[
        targetDir makeDirectory.
    ].
    (mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |
        eachFile recursiveCopyTo:(targetDir construct:eachFile baseName)
    ].
    self activityNotification:nil
!

setupBuildDirectory
    buildDirectory exists ifFalse:[
        buildDirectory recursiveMakeDirectory.
    ].
    (buildDirectory / 'stx') exists ifFalse:[
        (buildDirectory / 'stx') makeDirectory.
    ].

    self copyDirectoryForBuild:'include'.
    self copyDirectoryForBuild:'rules'.
    OperatingSystem isUNIXlike ifTrue:[
        self recursiveCopyDirectoryForBuild:'configurations'.
    ]
!

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$'
! !