changed:
#flyByHelpSpec
#page1_projectTypeSelectionSpec
#page2_projectSelectionSpec
"{ Package: 'stx:libtool2' }"
"{ NameSpace: Tools }"
Object subclass:#ProjectBuilder
instanceVariableNames:'package projectDefinitionClass sourceCodeManager buildDirectory
myWorkingDirectory mySTXTopDirectory myTopDirectory outputStream
makeExeOnly usedCompiler'
classVariableNames:'PreviousBuildDirectory'
poolDictionaries:''
category:'System-Support-Projects'
!
!ProjectBuilder class methodsFor:'accessing'!
previousBuildDirectory
^ PreviousBuildDirectory
!
previousBuildDirectory:something
PreviousBuildDirectory := something.
! !
!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
!
buildDirectory:something
buildDirectory := something.
!
makeExeOnly:aBoolean
makeExeOnly := aBoolean.
!
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.
!
suffixForHeaderFiles
^ OperatingSystem isUNIXlike ifTrue:['.H'] ifFalse:['.STH']
!
usedCompiler:something
usedCompiler := 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|
makeOutput := TextStream on:(Text new:10000).
self buildWithColorizedOutputTo:makeOutput.
TextView openWith:makeOutput contents.
!
buildWithColorizedOutputTo:makeOutput
"/ intermediate - this will move into a commonly used utility class
"/ (where all the project code support will be collected).
|stdOut stdErr lock|
lock := Semaphore forMutualExclusion.
stdErr := ActorStream new
nextPutBlock:[:char |
lock critical:[
makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}.
makeOutput nextPut:char.
makeOutput emphasis:nil.
]
];
nextPutAllBlock:[:string |
lock critical:[ (string includesString:'das Ziel' )ifTrue:[self halt].
makeOutput emphasis:{#backgroundColor->Color red. #color->Color white.}.
makeOutput nextPutAll:string.
makeOutput emphasis:nil.
]
].
stdOut := ActorStream new
nextPutBlock:[:char |
lock critical:[
makeOutput nextPut:char.
]
];
nextPutAllBlock:[:string |
lock critical:[ (string includesString:'das Ziel' )ifTrue:[self halt].
makeOutput nextPutAll:string.
]
].
self buildWithOutputTo:stdOut errorTo:stdErr.
!
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 isNil ifTrue:[
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 activityNotification:'Generating stc directory...'.
self copySTCDirectoryForBuild.
self activityNotification:'Generating source files...'.
self generateSourceFiles.
self activityNotification:'Copying dlls for linkage...'.
self copyDLLsForLinkage.
self activityNotification:'Copying support files for linkage...'.
self copySupportFilesForLinkage.
self copyStartupFilesFromSmalltalk.
self activityNotification:'Executing make...'.
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
].
].
OperatingSystem isUNIXlike ifTrue:[
(targetDir / 'stc') makeExecutableForAll
].
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'
'smalltalk.rc'
'private.rc'
) do:[:fn |
(myTopDirectory / 'stx' / 'projects/smalltalk' / fn)
copyTo: (buildDirectory / 'stx' / 'projects/smalltalk' / fn)
].
(myTopDirectory / 'stx' / 'doc/online/english/LICENCE_STX.html')
copyTo: (buildDirectory / 'stx' / 'projects/smalltalk' / 'LICENCE_STX.html').
!
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'
'projects/smalltalk/stx_16x16.ico'
'projects/smalltalk/stx_32x32.ico'
'projects/smalltalk/stx_splash.bmp'
).
] ifFalse:[
files := #(
'librun/main.c'
'librun/librun.so'
)
].
files := files asOrderedCollection.
OperatingSystem isMSWINDOWSlike ifTrue:[
projectDefinitionClass applicationIconFileName notNil ifTrue:[
files add:('projects/smalltalk/',projectDefinitionClass applicationIconFileName,'.ico')
].
projectDefinitionClass splashFileName notNil ifTrue:[
files add:('projects/smalltalk/',projectDefinitionClass splashFileName,'.bmp')
].
].
files do:[:dllRelativePath |
(mySTXTopDirectory / dllRelativePath) exists ifTrue:[
((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).
]
] ifFalse:[
self error:'Missing file: ',dllRelativePath printString mayProceed:true.
].
].
!
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),(self suffixForHeaderFiles)).
(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 compilerFlag makeCommand|
module := package module.
directory := package directory.
makeCommand := ParserFlags makeCommand.
usedCompiler = 'vc' ifTrue:[ makeCommand := 'vcmake'. compilerFlag := 'USEVC=1' ].
usedCompiler = 'lcc' ifTrue:[ makeCommand := 'lcmake'. compilerFlag := 'USELCC=1' ].
usedCompiler = 'gcc' ifTrue:[ makeCommand := 'make'. ].
OperatingSystem isUNIXlike ifTrue:[
OperatingSystem
executeCommand:'sh ../../stx/rules/stmkmf'
inputFrom:nil
outputTo:stdOut
errorTo:stdErr
inDirectory:(buildDirectory / module / directory)
onError:[:status| self error:'make failed'].
].
projectDefinitionClass isLibraryDefinition ifTrue:[
OperatingSystem
executeCommand:(makeCommand,' classLibRule')
inputFrom:nil
outputTo:stdOut
errorTo:stdErr
inDirectory:(buildDirectory / module / directory)
onError:[:status| self error:'make failed'].
] ifFalse:[
OperatingSystem
executeCommand:(makeCommand,' exe')
inputFrom:nil
outputTo:stdOut
errorTo:stdErr
inDirectory:(buildDirectory / module / directory)
onError:[:status| self error:'make failed'].
(makeExeOnly ? false) ifFalse:[
OperatingSystem
executeCommand:(makeCommand,' setup')
inputFrom:nil
outputTo:stdOut
errorTo:stdErr
inDirectory:(buildDirectory / module / directory)
onError:[:status| self error:'make failed'].
]
]
!
recursiveCopyDirectoryForBuild:subdir
|targetDir|
targetDir := buildDirectory / 'stx' / subdir.
targetDir exists ifFalse:[
targetDir makeDirectory.
].
(mySTXTopDirectory / subdir) directoryContentsAsFilenamesDo:[:eachFile |
eachFile recursiveCopyTo:(targetDir construct:eachFile baseName)
].
self activityNotification:nil
!
setupBuildDirectory
buildDirectory exists ifFalse:[
buildDirectory recursiveMakeDirectory.
].
(buildDirectory / 'stx') exists ifFalse:[
(buildDirectory / 'stx') makeDirectory.
].
self copyDirectoryForBuild:'include'.
self copyDirectoryForBuild:'rules'.
OperatingSystem isUNIXlike ifTrue:[
self recursiveCopyDirectoryForBuild:'configurations'.
]
!
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$'
! !