"

 COPYRIGHT (c) 2009 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: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:'documentation'!

copyright

"

 COPYRIGHT (c) 2009 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.

"

! !

!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 class methodsFor:'queries'!

defaultUsedCompiler

    |compiler|

    (compiler := UserPreferences current usedCompilerForBuild) notNil ifTrue:[

        ^ compiler

    ].

    OperatingSystem isMSWINDOWSlike ifTrue:[

        ^ 'bcc'

    ].

    ^ 'gcc'

    "Created: / 21-01-2012 / 14:06:51 / cg"

!

listOfPossibleCompilers

    OperatingSystem isMSWINDOWSlike ifTrue:[

        ^ #('bcc' 'vc' 'lcc' 'gcc' )

    ].

    ^ #('gcc')

    "Created: / 21-01-2012 / 14:04:15 / cg"

! !

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

!

usedCompilerForBuild:something

    usedCompiler := something.

    "Created: / 22-01-2012 / 10:50:48 / cg"

! !

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

    "Modified: / 21-01-2012 / 13:49:13 / cg"

!

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

! !

!ProjectBuilder methodsFor:'building/private'!

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|

            |source dest|

            source := dllSourceDir / dllRelativePath.

            dest := packageTargetDir / dllRelativePath.

            (dest exists not

             or:[source fileSize ~= dest fileSize

             or:[source modificationTime >= dest modificationTime

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

            ]]) ifTrue:[

                Transcript showCR:'updating ',dllRelativePath.

                dest directory recursiveMakeDirectory.

                source copyTo:dest.    

            ].

        ].

    ].

    "Modified: / 20-07-2012 / 18:30:06 / 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

!

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/objbc/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.

        ].

    ].

    "Modified: / 21-01-2012 / 13:40:56 / cg"

!

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:''.

    ] ifFalse:[

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