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