diff -r dbfb457033ff -r 428bb83dd360 ProjectBuilder.st --- a/ProjectBuilder.st Tue Oct 20 22:39:17 2009 +0200 +++ b/ProjectBuilder.st Tue Oct 20 22:46:36 2009 +0200 @@ -23,96 +23,90 @@ !ProjectBuilder class methodsFor:'examples'! +example1 + Smalltalk loadPackage:'stx:projects/helloWorldApp' asAutoloaded:true. + + self new + package:'stx:projects/helloWorldApp'; + build ! -methodsFor:'examples' +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'! -ileBrowserClass openOnDirectory:builder packageBuildDirectory. +buildDirectory + ^ buildDirectory ! buildDirectory:something buildDirectory := something. ! -kageBuildDirectory. +package:aPackageIDOrSymbol + package := aPackageIDOrSymbol asPackageId. ! -he directoray, where the deployable binary is created (xxxSetup.exe)" +packageBuildDirectory + "the directoray, where the deployable binary is created (xxxSetup.exe)" ^ buildDirectory / (package asPackageId module) / (package asPackageId directory) ! -'building' +projectDefinitionClass:something + projectDefinitionClass := something. ! ! !ProjectBuilder methodsFor:'building'! -"/ intermediate - this will move into a commonly used utility class +build + "/ 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. + |makeOutput stdOut stdErr lock| - "/ UserPreferences current localBuild:true - UserPreferences current localBuild ifFalse:[ - SourceCodeManager notNil ifTrue:[ - sourceCodeManager := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinitionClass. - ] - ]. - sourceCodeManager := nil. + lock := Semaphore forMutualExclusion. + makeOutput := TextStream on:(Text new:10000). + stdErr := ActorStream new + nextPutBlock:[:char | + lock critical:[ + makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}. + makeOutput nextPut:char. + makeOutput emphasis:nil. + ] + ]; + nextPutAllBlock:[:char | + lock critical:[ + makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}. + makeOutput nextPutAll:char. + makeOutput emphasis:nil. + ] + ]. + stdOut := ActorStream new + nextPutBlock:[:char | + lock critical:[ + makeOutput nextPut:char. + ] + ]; + nextPutAllBlock:[:char | + lock critical:[ + makeOutput nextPutAll:char. + ] + ]. - 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 buildWithOutputTo:stdOut errorTo:stdErr. - self setupBuildDirectory. - self activityNotification:'Generating stc directory...'. - self copySTCDirectoryForBuild. - self activityNotification:'Generating source files...'. - self generateSourceFiles. - self activityNotification:'Generating dlls for linkage...'. - self copyDLLsForLinkage. - self activityNotification:'Generating support files for linkage...'. - self copySupportFilesForLinkage. - self copyStartupFilesFromSmalltalk. - - self activityNotification:'Executing make...'. - self makeWithOutputTo:stdOut errorTo:stdErr. + TextView openWith:makeOutput contents. ! buildWithOutputTo:stdOut errorTo:stdErr @@ -181,35 +175,441 @@ self makeWithOutputTo:stdOut errorTo:stdErr. ! -lRelativePath). +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 + ]. + ]. + 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' + ) 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). ] ]. ! -! +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 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| + + module := package module. + directory := package directory. + + projectDefinitionClass isLibraryDefinition ifTrue:[ + OperatingSystem + executeCommand:(ParserFlags makeCommand,' classLibRule') + inputFrom:nil + outputTo:stdOut + errorTo:stdErr + inDirectory:(buildDirectory / module / directory) + onError:[:status| self error:'make failed']. + ] ifFalse:[ + OperatingSystem + executeCommand:(ParserFlags makeCommand,' exe') + inputFrom:nil + outputTo:stdOut + errorTo:stdErr + inDirectory:(buildDirectory / module / directory) + onError:[:status| self error:'make failed']. + + OperatingSystem + executeCommand:(ParserFlags makeCommand,' setup') + inputFrom:nil + outputTo:stdOut + 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. + ]. + + self copyDirectoryForBuild:'include'. + self copyDirectoryForBuild:'rules'. ! -! +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'!