diff -r 2e735008a4d8 -r b8d38caaa884 ProjectBuilder.st --- a/ProjectBuilder.st Sun Oct 11 02:20:25 2009 +0200 +++ b/ProjectBuilder.st Sun Oct 11 02:27:08 2009 +0200 @@ -119,7 +119,7 @@ ]. myTopDirectory := myTopDirectory asFilename. mySTXTopDirectory := myTopDirectory / 'stx'. -self halt. + self setupBuildDirectory. self copySTCDirectoryForBuild. self generateSourceFiles. @@ -130,346 +130,37 @@ 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). - ] - ]. +stdErr. ! -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 - ]. - ]. - self activityNotification:nil +'stx'). ! -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) - ] +ion:nil ! -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). - ] - ]. +]. ! -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. - ]. +ion:nil ! -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. - "/ self assert:cls isLoaded. - cls isLoaded ifTrue:[ - self createHeaderFileFor:cls in:packageTargetDir - ]. - ]. - self copyResourcesForPackage:eachPackageToFileout. - ]. - -"/ stx_libbasic2 preRequisitesForBuilding#(#'stx:libbasic') +f halt. ! makeWithOutputTo:stdOut errorTo:stdErr @@ -505,57 +196,24 @@ ] ! -setupBuildDirectory - buildDirectory exists ifFalse:[ - buildDirectory recursiveMakeDirectory. - ]. - (buildDirectory / 'stx') exists ifFalse:[ - (buildDirectory / 'stx') makeDirectory. - ]. +errorTo:stdErr + inDirectory:(buildDirectory / module / directory) + onError:[:status| self error:'make failed']. - self copyDirectoryForBuild:'include'. - self copyDirectoryForBuild:'rules'. + OperatingSystem + executeCommand:(ParserFlags makeCommand,' setup') + inputFrom:nil + outputTo:stdOut + errorTo: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 +:stdErr + inDirectory:(buildDirectory / module / directory) + onError:[:status| self error:'make failed']. + ] ! ! !ProjectBuilder class methodsFor:'documentation'!