diff -r b8d38caaa884 -r ff815b56c808 ProjectBuilder.st --- a/ProjectBuilder.st Sun Oct 11 02:27:08 2009 +0200 +++ b/ProjectBuilder.st Mon Oct 12 09:35:01 2009 +0200 @@ -130,37 +130,346 @@ self makeWithOutputTo:stdOut errorTo:stdErr. ! -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 ! -'stx'). +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 + ]. + ]. + self activityNotification:nil ! -ion: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' + ) do:[:fn | + (myTopDirectory / 'stx' / 'projects/smalltalk' / fn) + copyTo: (buildDirectory / 'stx' / 'projects/smalltalk' / fn) + ] ! -]. +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' + ). + ] ifFalse:[ + files := #( + 'librun/genDate' + 'librun/main.c' + 'librun/librun.so' + ) + ]. + + files do:[:dllRelativePath | + ((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). + ] + ]. ! -ion: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. + ]. + ]. + ]. -f halt. + "/ 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 @@ -196,24 +505,57 @@ ] ! -errorTo:stdErr - inDirectory:(buildDirectory / module / directory) - onError:[:status| self error:'make failed']. +setupBuildDirectory + buildDirectory exists ifFalse:[ + buildDirectory recursiveMakeDirectory. + ]. + (buildDirectory / 'stx') exists ifFalse:[ + (buildDirectory / 'stx') makeDirectory. + ]. - OperatingSystem - executeCommand:(ParserFlags makeCommand,' setup') - inputFrom:nil - outputTo:stdOut - errorTo:stdErr - inDirectory:(buildDirectory / module / directory) - onError:[:status| self error:'make failed']. - ] + self copyDirectoryForBuild:'include'. + self copyDirectoryForBuild:'rules'. ! -:stdErr - inDirectory:(buildDirectory / module / directory) - onError:[:status| self error:'make failed']. - ] +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'!