"{ 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 preRequisites dllRelativePaths|

    targetBuildDir := buildDirectory / package module / package directory.

    preRequisites := projectDefinitionClass allPreRequisites.

    OperatingSystem isUNIXlike ifTrue:[

        "For now: unix Makefiles require some libs implicitely..."

        preRequisites := preRequisites union:#(

                               'stx:goodies/refactoryBrowser/parser'

                               'stx:libtool'

                            ).

    ].

    preRequisites 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 

            dllRelativePaths := Array with:('objbc\', libraryName, '.dll').

        ] ifFalse:[

            dllRelativePaths := Array with:(libraryName,'.so').

            (packageModule = 'stx' and:[packageDirectory = 'libview']) ifTrue:[

                dllRelativePaths := dllRelativePaths, #('XWorkstation.so' 'GLXWorkstation.so').

            ].

        ].

        dllRelativePaths do:[:dllRelativePath|

            ((packageTargetDir / dllRelativePath) exists not

             or:[(dllSourceDir / dllRelativePath) fileSize ~= (packageTargetDir / dllRelativePath) fileSize

             or:[(dllSourceDir / dllRelativePath) modificationTime >= (packageTargetDir / dllRelativePath) modificationTime

             "/ or:[ ((dllSourceDir / dllRelativePath) sameContentsAs:(packageTargetDir / dllRelativePath)) not ]

            ]]) ifTrue:[

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

        ].

    ].