"{ Package: 'stx:libtool2' }"
Object subclass:#ProjectBuilder
instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory
myWorkingDirectory mySTXTopDirectory myTopDirectory'
classVariableNames:'PreviousBuildDirectory'
poolDictionaries:''
category:'System-Support-Projects'
!
!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.
! !
!ProjectBuilder methodsFor:'accessing'!
buildDirectory
^ buildDirectory
!
package:aPackageIDOrSymbol
package := aPackageIDOrSymbol asPackageId.
!
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.
!
buildWithOutputTo:stdOut errorTo:stdErr
"/ 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 := PreviousBuildDirectory ifNil:[ UserPreferences current buildDirectory ].
buildDirectory isNil ifTrue:[
buildDirectory := Filename tempDirectory construct:'stx_build'.
].
buildDirectory := buildDirectory asFilename.
"/ self validateBuildDirectoryIsPresent.
PreviousBuildDirectory := buildDirectory.
"/ UserPreferences current localBuild:true
UserPreferences current localBuild ifFalse:[
SourceCodeManager notNil ifTrue:[
sourceCodeManager := SourceCodeManagerUtilities sourceCodeManagerFor:projectDefinitionClass.
]
].
sourceCodeManager := nil.
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 setupBuildDirectory.
self copySTCDirectoryForBuild.
self generateSourceFiles.
self copyDLLsForLinkage.
self copySupportFilesForLinkage.
self copyStartupFilesFromSmalltalk.
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).
]
].
!
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|
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')
!
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'!
version_CVS
^ '$Header$'
! !