diff -r 4a48f107431a -r 3f14301cec84 ProjectBuilder.st --- a/ProjectBuilder.st Tue Oct 20 21:48:02 2009 +0200 +++ b/ProjectBuilder.st Tue Oct 20 21:51:54 2009 +0200 @@ -21,86 +21,40 @@ !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. +methodsFor:'examples' ! ! !ProjectBuilder methodsFor:'accessing'! -buildDirectory - ^ buildDirectory +x:clients/Demos/foxCalcApplication'. + builder build. + + UserPreferences fileBrowserClass openOnDirectory:builder packageBuildDirectory. ! -package:aPackageIDOrSymbol - package := aPackageIDOrSymbol asPackageId. +buildDirectory:something + buildDirectory := something. +! + +uilder build. + + UserPreferences fileBrowserClass openOnDirectory:builder packageBuildDirectory. +! + +kageBuildDirectory. ! packageBuildDirectory "the directoray, where the deployable binary is created (xxxSetup.exe)" ^ buildDirectory / (package asPackageId module) / (package asPackageId directory) -! - -projectDefinitionClass:something - projectDefinitionClass := 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 stdOut stdErr lock| - - 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. - ] - ]. - - self buildWithOutputTo:stdOut errorTo:stdErr. - - TextView openWith:makeOutput contents. +(package asPackageId module) / (package asPackageId directory) ! buildWithOutputTo:stdOut errorTo:stdErr @@ -122,9 +76,11 @@ module := package module. directory := package directory. - buildDirectory := PreviousBuildDirectory ifNil:[ UserPreferences current buildDirectory ]. buildDirectory isNil ifTrue:[ - buildDirectory := Filename tempDirectory construct:'stx_build'. + buildDirectory := PreviousBuildDirectory ifNil:[ UserPreferences current buildDirectory ]. + buildDirectory isNil ifTrue:[ + buildDirectory := Filename tempDirectory construct:'stx_build'. + ]. ]. buildDirectory := buildDirectory asFilename. @@ -167,65 +123,27 @@ 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. +...'. + self copySupportFilesForLinkage. + self copyStartupFilesFromSmalltalk. - "/ 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. + self activityNotification:'Executing make...'. + self makeWithOutputTo:stdOut errorTo:stdErr. +! + +(packageTargetDir / dllRelativePath) directory recursiveMakeDirectory. (dllSourceDir / dllRelativePath) copyTo:(packageTargetDir / dllRelativePath). ] ]. ! -copyDirectory:relativepath +tory: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,'...'. +ification:'copying ',eachFile pathName,'...'. eachFile copyTo:(targetDir construct:eachFile baseName) ] ]. @@ -233,41 +151,13 @@ 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:[ +tory / 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:[ +me ]) ifTrue:[ self activityNotification:'copying ',sourceFile pathName,'...'. sourceFile copyTo:targetFile ]. @@ -275,119 +165,27 @@ 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' +'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. +ry / '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'). +ename / ((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 +self generateSourceFilesByCheckingOutUsing:sourceCodeManager ] ifFalse:[ "/ local build "/ fileout the project @@ -395,40 +193,7 @@ ] ! -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 +:nil outputTo:Transcript errorTo:Transcript inDirectory:(buildDirectory construct:module) @@ -436,80 +201,7 @@ 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 +or:cls in:packageTargetDir ]. ]. self copyResourcesForPackage:eachPackageToFileout. @@ -518,32 +210,7 @@ "/ 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 +nil outputTo:stdOut errorTo:stdErr inDirectory:(buildDirectory / module / directory) @@ -551,57 +218,12 @@ ] ! -setupBuildDirectory - buildDirectory exists ifFalse:[ - buildDirectory recursiveMakeDirectory. - ]. - (buildDirectory / 'stx') exists ifFalse:[ +(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'!