"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
"{ Package: 'stx:libbasic' }"
Object subclass:#ProjectDefinition
instanceVariableNames:''
classVariableNames:'LibraryType GUIApplicationType NonGUIApplicationType'
poolDictionaries:''
category:'System-Support-Projects'
!
ProjectDefinition class instanceVariableNames:'overwrittenMethods'
"
No other class instance variables are inherited by this class.
"
!
!ProjectDefinition class methodsFor:'documentation'!
copyright
"
COPYRIGHT (c) 2006 by eXept Software AG
All Rights Reserved
This software is furnished under a license and may be used
only in accordance with the terms of that license and with the
inclusion of the above copyright notice. This software may not
be provided or otherwise made available to, or used by, any
other person. No title to or ownership of the software is
hereby transferred.
"
!
documentation
"
redefinable build-file attributes:
stcOptimizationOptions -> STCLOCALOPT
stcWarningOptions -> STCLOCALOPT
localIncludes_unix -> LOCALINCLUDES (Make.proto)
localIncludes_win32 -> LOCALINCLUDES (bc.mak)
for applications:
startupClassName
startupSelector
for libraries:
"
! !
!ProjectDefinition class methodsFor:'instance creation'!
newForPackage:packageID
^ self
newNamed:(self initialClassNameForDefinitionOf:packageID)
package:packageID.
"Created: / 11-08-2006 / 14:27:19 / cg"
!
newNamed:newName package:packageID
|newClass|
"/ for now, we are strict.
self assert:(self initialClassNameForDefinitionOf:packageID) = newName.
self assert:(self ~~ ProjectDefinition). "ProjectDefinition is abstract"
newClass := self
subclass:(newName asSymbol)
instanceVariableNames:''
classVariableNames:''
poolDictionaries:''
category:(self defaultCategory).
newClass package:packageID asSymbol.
^ newClass
"Created: / 09-08-2006 / 17:57:37 / fm"
"Modified: / 09-08-2006 / 19:27:53 / fm"
"Modified: / 17-08-2006 / 17:24:23 / cg"
! !
!ProjectDefinition class methodsFor:'accessing'!
defaultCategory
^'* Projects *'
"Created: / 11-08-2006 / 14:16:49 / cg"
!
initialClassNameForDefinitionOf:aPackageId
|s|
s := aPackageId asString copy replaceAny:':/' with:$_.
(s endsWith:$_) ifTrue:[
s := s copyWithoutLast:1
].
^ s
"
DapasXProject initialClassNameForDefinitionOf:'bosch:dapasx/interactiver_editor'
DapasXProject initialClassNameForDefinitionOf:'stx:libbasic'
DapasXProject initialClassNameForDefinitionOf:'stx:goodies/xml'
"
"Created: / 09-08-2006 / 17:44:47 / fm"
"Modified: / 11-08-2006 / 14:00:05 / cg"
!
libraryName
^ self package asPackageId libraryName
"
bosch_dapasx_datenbasis libraryName
stx_libbasic3 libraryName
"
"Modified: / 09-08-2006 / 18:20:29 / fm"
"Modified: / 18-08-2006 / 12:36:45 / cg"
!
libraryNameFor:aProjectID
^ aProjectID asPackageId libraryName
"
bosch_dapasx_datenbasis libraryName
stx_libbasic3 libraryNameFor:'stx:libbasic'
stx_libbasic3 libraryNameFor:'bosch:dapasx/datenbasis'
"
"Modified: / 09-08-2006 / 18:20:29 / fm"
"Modified: / 18-08-2006 / 12:37:02 / cg"
!
module
^ self moduleOfClass:self
"
bosch_dapasx_datenbasis_Definition module
DapasX_Datenbasis module
stx_libbasic3 module
"
"Created: / 08-08-2006 / 20:24:53 / fm"
"Modified: / 09-08-2006 / 16:16:37 / fm"
"Modified: / 17-08-2006 / 20:50:46 / cg"
!
moduleDirectory
^ (PackageId from:self package) directory
"
bosch_dapasx_datenbasis_Definition moduleDirectory
bosch_dapasx_parameter_system_Definition moduleDirectory
stx_libbasic3 moduleDirectory
"
"Created: / 08-08-2006 / 20:25:39 / fm"
"Modified: / 18-08-2006 / 12:18:33 / cg"
!
moduleDirectoryFor:aProjectID
^ (aProjectID subStrings:$:) last
"
bosch_dapasx_datenbasis_Definition moduleDirectory
bosch_dapasx_parameter_system_Definition moduleDirectory
"
"Created: / 08-08-2006 / 20:25:39 / fm"
"Modified: / 17-08-2006 / 14:13:41 / cg"
!
moduleDirectory_win32
^ (PackageId from:self package) directory copy replaceAll:$/ with:$\
"
bosch_dapasx_datenbasis moduleDirectory_win32
bosch_dapasx_parameter_system moduleDirectory_win32
stx_libbasic3 moduleDirectory_win32
"
"Created: / 14-09-2006 / 20:19:17 / cg"
!
moduleFor:aProjectID
^ (aProjectID subStrings:$:) first
"
DapasXProject module
DapasX_Datenbasis module
"
"Created: / 09-08-2006 / 16:16:16 / fm"
"Modified: / 17-08-2006 / 14:13:46 / cg"
!
moduleOfClass:aClass
^ self moduleFor:aClass package
"
DapasXProject module
DapasX_Datenbasis module
"
"Created: / 09-08-2006 / 16:16:16 / fm"
"Modified: / 17-08-2006 / 14:13:51 / cg"
!
msdosPathToPackage:toPackageID from:fromPackageID
"Returns the path to the package defined by aPackageID relative to my path"
|parts1 parts2 common up down rel|
parts1 := fromPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
parts2 := toPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
common := parts1 commonPrefixWith:parts2.
common notEmpty ifTrue:[
up := ((1 to:parts1 size - common size) collect:[:p | '..\']) asStringWith:''.
down := (parts2 copyFrom:common size+1) asStringWith:'\'.
(up isEmpty and:[down isEmpty]) ifTrue:[^ '.'].
^ up,down
].
rel := (self topRelativePathToPackage_win32:toPackageID).
(rel startsWith:'stx\') ifTrue:[
^ '$(TOP)',(rel copyFrom:'stx' size+1)
].
^ '$(TOP)\..\',rel.
"/ pTop := self msdosPathToTopFor:fromPackageID.
"/ (pTop endsWith:'\stx') ifTrue:[
"/ ^ (pTop copyButLast:'stx' size),(self topRelativePathToPackage_win32:toPackageID)
"/ ] ifFalse:[
"/ ^ pTop,'\..\',(self topRelativePathToPackage_win32:toPackageID)
"/ ].
"
self msdosPathToPackage:'bosch:dapasx/kernel' from:'bosch:dapasx/application'
self msdosPathToPackage:'stx:libbasic' from:'bosch:dapasx/application'
self msdosPathToPackage:'bosch:dapasx/application' from:'stx:libbasic'
"
"Created: / 17-08-2006 / 14:26:39 / cg"
"Modified: / 14-09-2006 / 22:04:56 / cg"
!
msdosPathToTopFor:aProjectID
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
|parts|
parts := aProjectID asCollectionOfSubstringsSeparatedByAny:':/'.
aProjectID asPackageId module = 'stx' ifTrue:[
parts size == 1 ifTrue:[^ '.'].
^ (((2 to:parts size-1) collect:[:p | '..\']) asStringWith:'') , '..'
].
^ ((parts collect:[:p | '..\']) asStringWith:'') , 'stx'
"
self msdosPathToTopFor: #'bosch'
self msdosPathToTopFor: #'bosch:dapasx'
self msdosPathToTopFor: #'bosch:dapasx/datenbasis'
self msdosPathToTopFor: #'stx'
self msdosPathToTopFor: #'stx:libview'
self msdosPathToTopFor: #'stx:goodies/foo'
"
"Created: / 09-08-2006 / 15:45:54 / fm"
"Modified: / 14-09-2006 / 14:49:17 / cg"
!
packageName
"the last component"
^ self packageNameFor: self package
"
bosch_dapasx_hw_schnittstellen packageName
bosch_dapasx_datenbasis packageName
bosch_dapasx_parameter_system packageName
"
"Created: / 08-08-2006 / 20:24:53 / fm"
"Modified: / 09-08-2006 / 16:16:37 / fm"
!
packageNameFor: aProjectID
^ (aProjectID asCollectionOfSubstringsSeparatedByAny:':/') last.
"
bosch_dapasx_hw_schnittstellen packageName
bosch_dapasx_datenbasis packageName
bosch_dapasx_parameter_system packageName
"
"Created: / 08-08-2006 / 20:24:53 / fm"
"Modified: / 09-08-2006 / 16:16:37 / fm"
"Modified: / 11-08-2006 / 14:02:32 / cg"
!
parentProject
^ (self parentProjectFor: self package)
"
bosch_dapasx_hw_schnittstellen_Definition parentProject
DapasX_Datenbasis parentProject
"
"Created: / 07-08-2006 / 20:18:27 / fm"
"Modified: / 08-08-2006 / 10:47:37 / fm"
!
parentProjectFor: aProjectID
^ (aProjectID subStrings: $/) first
"
bosch_dapasx_hw_schnittstellen parentProject
"
"Created: / 07-08-2006 / 20:18:27 / fm"
"Modified: / 08-08-2006 / 10:47:37 / fm"
"Modified: / 23-08-2006 / 15:07:36 / cg"
!
pathSeparator:platformName
platformName == #unix ifTrue:[
^ self pathSeparator_unix
].
platformName == #win32 ifTrue:[
^ self pathSeparator_win32
].
self error:'unknown operating system platform'.
"Created: / 14-09-2006 / 13:38:00 / cg"
!
pathSeparator_unix
^ $/
"Created: / 14-09-2006 / 13:37:18 / cg"
!
pathSeparator_win32
^ $\
"Created: / 14-09-2006 / 13:37:23 / cg"
!
pathTo:aBaseFilename inPackage:aPackageID architecture:arch
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
|p|
arch == #unix ifTrue:[
p := (self pathToPackage_unix:aPackageID).
aBaseFilename isNil ifTrue:[^ p].
^ p , '/' , aBaseFilename
].
arch == #win32 ifTrue:[
p := self pathToPackage_win32:aPackageID.
aBaseFilename isNil ifTrue:[^ p].
^ p , '\' , aBaseFilename
].
self error:'unknown operating system platform'.
"Created: / 14-09-2006 / 13:29:20 / cg"
!
pathToPackage_unix:aPackageID
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
|pTop|
aPackageID asPackageId module = self package asPackageId module ifTrue:[
^ self unixPathToPackage:aPackageID from:self package
].
pTop := self pathToTop_unix.
(pTop endsWith:'/stx') ifTrue:[
^ (pTop copyWithoutLast:'stx' size),(self topRelativePathToPackage_unix:aPackageID)
] ifFalse:[
^ pTop,'/../',(self topRelativePathToPackage_unix:aPackageID)
]
"
bosch_dapasx_kernel pathToPackage_unix:'bosch:dapasx/kernel'
bosch_dapasx_kernel pathToPackage_unix:'bosch:dapasx/support'
stx_libbasic pathToPackage_unix:'bosch:dapasx/kernel'
"
"Modified: / 16-08-2006 / 18:55:41 / User"
"Created: / 14-09-2006 / 13:21:23 / cg"
"Modified: / 14-09-2006 / 15:23:59 / cg"
!
pathToPackage_win32:aPackageID
"Returns the path to the package defined by aPackageID relative to my path"
|pTop|
aPackageID asPackageId module = self package asPackageId module ifTrue:[
^ self msdosPathToPackage:aPackageID from:self package
].
pTop := self pathToTop_win32.
(pTop endsWith:'\stx') ifTrue:[
^ (pTop copyWithoutLast:'stx' size),(self topRelativePathToPackage_win32:aPackageID)
] ifFalse:[
^ pTop,'\..\',(self topRelativePathToPackage_win32:aPackageID)
].
"
self pathToPackage_win32:'bosch:dapasx/kernel'
bosch_dapasx_kernel pathToPackage_win32:'bosch:dapasx/kernel'
bosch_dapasx_kernel pathToPackage_win32:'bosch:dapasx/support'
stx_libbasic pathToPackage_win32:'bosch:dapasx/kernel'
"
"Created: / 14-09-2006 / 13:22:52 / cg"
"Modified: / 14-09-2006 / 15:28:45 / cg"
!
pathToTop_unix
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
^ self unixPathToTopFor:self package.
"
bosch_dapasx_kernel pathToTop_unix
stx_goodies_xml pathToTop_unix
stx_libhtml pathToTop_unix
stx_goodies_refactoryBrowser_changes pathToTop_unix
"
"Created: / 09-08-2006 / 15:45:54 / fm"
"Modified: / 14-09-2006 / 15:01:47 / cg"
!
pathToTop_win32
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
^self msdosPathToTopFor: self package
"
bosch_dapasx_datenbasis pathToTop_win32
stx_libbasic pathToTop_win32
"
"Created: / 09-08-2006 / 15:45:54 / fm"
"Modified: / 07-09-2006 / 15:51:00 / cg"
!
requiredProjects
^self preRequisites, self subProjects
!
topRelativePathTo:aBaseFilename inPackage:aPackageID architecture:arch
"Returns the path to stx counting the number of $/ and $: in the package name
and adding for each one '../' to get the ST/X top directory"
|p|
arch == #unix ifTrue:[
p := (self topRelativePathToPackage_unix:aPackageID).
aBaseFilename isNil ifTrue:[^ p].
^ p , '/' , aBaseFilename
].
arch == #win32 ifTrue:[
p := self topRelativePathToPackage_win32:aPackageID.
aBaseFilename isNil ifTrue:[^ p].
^ p , '\' , aBaseFilename
].
self error:'unknown operating system platform'.
"Created: / 14-09-2006 / 13:34:05 / cg"
!
topRelativePathToPackage_unix:aPackageID
"Returns the path to the package as specified by aPackageID relative to the top directory"
^ aPackageID asString copy replaceAny:':/' with:$/
"
self topRelativePathToPackage_unix:'stx:goodies/xml'
self topRelativePathToPackage_unix:'bosch:dapasx/kernel'
"
"Created: / 14-09-2006 / 13:20:40 / cg"
!
topRelativePathToPackage_win32:aPackageID
"Returns the path to the package as specified by aPackageID relative to the top directory"
^ aPackageID asString copy replaceAny:':/' with:$\
"
self topRelativePathToPackage_win32:'stx:goodies/xml'
self topRelativePathToPackage_win32:'bosch:dapasx/kernel'
"
"Created: / 14-09-2006 / 13:20:12 / cg"
!
unixPathToPackage:toPackageID from:fromPackageID
"Returns the path to the package defined by aPackageID relative to my path"
|pTop parts1 parts2 common up down|
parts1 := fromPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
parts2 := toPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
common := parts1 commonPrefixWith:parts2.
common notEmpty ifTrue:[
up := ((1 to:parts1 size - common size) collect:[:p | '../']) asStringWith:''.
down := (parts2 copyFrom:common size+1) asStringWith:'/'.
(up isEmpty and:[down isEmpty]) ifTrue:[^ '.'].
^ up , down
].
pTop := self unixPathToTopFor:fromPackageID.
(pTop endsWith:'/stx') ifTrue:[
^ (pTop copyButLast:'stx' size),(self topRelativePathToPackage_unix:toPackageID)
] ifFalse:[
^ pTop,'/../',(self topRelativePathToPackage_unix:toPackageID)
].
"
self msdosPathToPackage:'bosch:dapasx/kernel' from:'bosch:dapasx/application'
self msdosPathToPackage:'stx:libbasic' from:'bosch:dapasx/application'
self msdosPathToPackage:'bosch:dapasx/application' from:'stx:libbasic'
"
"Created: / 14-09-2006 / 15:21:10 / cg"
!
unixPathToTopFor:aProjectID
"Returns the path to stx counting the number of $/ and $: in the package name and adding for each one '../' to get the ST/X top directory"
|parts|
parts := aProjectID asCollectionOfSubstringsSeparatedByAny:':/'.
aProjectID asPackageId module = 'stx' ifTrue:[
parts size == 1 ifTrue:[^ '.'].
^ (((2 to:parts size-1) collect:[:p | '../']) asStringWith:'') , '..'
].
^ ((parts collect:[:p | '../']) asStringWith:'') , 'stx'
"
self unixPathToTopFor: #'bosch'
self unixPathToTopFor: #'bosch:dapasx'
self unixPathToTopFor: #'bosch:dapasx/datenbasis'
self unixPathToTopFor: #'stx'
self unixPathToTopFor: #'stx:libview'
self unixPathToTopFor: #'stx:goodies/foo'
"
"Created: / 14-09-2006 / 14:59:53 / cg"
! !
!ProjectDefinition class methodsFor:'class initialization'!
initialize
LibraryType := #'Library'.
GUIApplicationType := #'GUI-Application'.
NonGUIApplicationType := #'NonGUI-Application'.
"
self initialize
"
"Modified: / 23-10-2006 / 16:40:58 / cg"
!
initializeAllProjectDefinitions
"needs everything else (especially the compiler etc.) to be initialized.
Therefore, its not invoked by #initialize, but instead explicitely,
by Smalltalk"
Smalltalk isStandAloneApp ifFalse:[
self allSubclassesDo:[:eachProjectDefinitionClass |
eachProjectDefinitionClass installAutoloadedClasses.
].
].
"
self initialize
"
"Created: / 23-10-2006 / 16:40:53 / cg"
!
installAutoloadedClasses
(self classNamesForWhich:[:nm :attr | (attr includes:#autoload)])
do:[:className |
"/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
(Smalltalk classNamed:className) isNil ifTrue:[
Smalltalk
installAutoloadedClassNamed:className
category:'* as yet unknown category *'
package:self package
revision:nil
].
].
"
stx_libbasic installAutoloadedClasses
"
"Created: / 23-10-2006 / 16:02:12 / cg"
"Modified: / 08-11-2006 / 17:08:06 / cg"
! !
!ProjectDefinition class methodsFor:'code generation'!
classNamesAndAttributes_codeFor:aSpecArray
"generate method code returning all classes of the project from the given spec."
^ String streamContents:[:s |
s nextPutLine:'classNamesAndAttributes'.
s nextPutLine:' ^ #('.
s nextPutLine:' "<className> or (<className> attributes...) in load order"'.
(self classNamesAndAttributesFromSpecArray:aSpecArray) do:[:entry |
s spaces:8.
entry storeArrayElementOn:s.
s cr.
].
s nextPutLine:' )'
].
"
stx_libbasic3 classNamesAndAttributes_codeFor:(stx_libbasic3 classNamesAndAttributes)
exept_expecco classNamesAndAttributes_codeFor:(exept_expecco classNamesAndAttributes)
"
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 19-02-2007 / 15:43:27 / cg"
!
classNamesAndAttributes_code_ignoreOldEntries:ignoreOldEntries ignoreOldDefinition:ignoreOldDefinition
"generate method code returning all classes of the project.
Platform attributes are kept from the old definition.
If ignoreOldEntries is true, the list is completely recreated;
if false, existing entries are preserved.
If ignoreOldDefinition is true, the autoload attribute is set/reset if
the class is installed as autoloaded in the image (i.e. the state in the image is taken).
If false, it is taken from an existing definition in #classNamesAndAttributes"
|newSpec oldSpec ignored|
oldSpec := self classNamesAndAttributesAsSpecArray.
ignored := self ignoredClassNames asSet.
newSpec := OrderedCollection new.
ignoreOldEntries ifFalse:[
oldSpec do:[:oldEntry |
|newEntry className cls|
newEntry := oldEntry copy.
className := newEntry first.
(ignored includes:className) ifFalse:[
cls := Smalltalk classNamed:className.
ignoreOldDefinition ifTrue:[
(cls notNil and:[cls isLoaded not]) ifTrue:[
(newEntry includes:#autoload) ifFalse:[
newEntry := newEntry copyWith:#autoload.
].
].
].
newSpec add:newEntry.
].
].
].
self searchForClasses do:[:eachClass |
|className attributes oldSpecEntry oldAttributes newEntry|
className := eachClass name.
(ignored includes:className) ifFalse:[
oldSpecEntry := oldSpec detect:[:entry | entry first = className] ifNone:nil.
(ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
(eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
(self additionalClassNamesAndAttributes includes:className) ifFalse:[
(oldSpecEntry size > 1) ifTrue:[
oldAttributes := oldSpecEntry copyFrom:2.
].
ignoreOldDefinition ifTrue:[
"take autoload attribute from classes state in the image"
oldAttributes notNil ifTrue:[
attributes := oldAttributes copyWithout:#autoload.
] ifFalse:[
attributes := #()
].
eachClass isLoaded ifFalse:[
attributes := attributes copyWith:#autoload.
].
] ifFalse:[
"keep any existing attribute"
oldAttributes notNil ifTrue:[
attributes := oldAttributes.
] ifFalse:[
attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #(autoload) ].
].
].
newEntry := Array with:className.
attributes notEmptyOrNil ifTrue:[
newEntry := newEntry , attributes.
].
newSpec add:newEntry
]
]
]
]
].
^ self classNamesAndAttributes_codeFor:newSpec
"
stx_libbasic3 classNamesAndAttributes_code_ignoreOldEntries:false ignoreOldDefinition:true
exept_expecco classNamesAndAttributes_code_ignoreOldEntries:false ignoreOldDefinition:true
"
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 10-10-2006 / 22:00:50 / cg"
"Modified: / 22-02-2007 / 15:06:37 / cg"
!
companyName_code
^ String streamContents:[:s |
s nextPutLine:'companyName'.
s nextPutLine:' "Return a companyname which will appear in <lib>.rc"'.
s cr; nextPutLine:' ^ ',self companyName storeString.
].
"
self companyName_code
stx_libbasic3 companyName_code
"
"Created: / 18-08-2006 / 16:20:42 / cg"
!
compileDescriptionMethods
(self isLibraryDefinition
or:[ self isApplicationDefinition ] ) ifFalse:[
self error:'I am abstract - must be a subclass of Libray- or ApplicationDefinition.'
].
self
forEachMethodsCodeToCompileDo:[:code :category |
self compile:code categorized:category
].
"/ self instAndClassMethodsDo:[:m | m package:self package].
"
DapasXProject compileDescriptionMethods
DapasX_Datenbasis compileDescriptionMethods
bosch_dapasx_interactiver_editor compileDescriptionMethods
stx_libbasic compileDescriptionMethods
"
"Created: / 09-08-2006 / 18:00:31 / fm"
"Modified: / 05-09-2006 / 13:46:29 / cg"
!
description_code
^ String streamContents:[:s |
s nextPutLine:'description'.
s nextPutLine:' "Return a description string which will appear in vc.def / bc.def"'.
s cr; nextPutLine:' ^ ',self description asString storeString.
].
"
self description_code
stx_libbasic3 description_code
"
"Created: / 17-08-2006 / 21:24:01 / cg"
"Modified: / 18-08-2006 / 16:16:24 / cg"
!
extensionMethodNames_code
^ self extensionMethodNames_code_ignoreOldEntries:true
"
self extensionMethodNames_code
"
"Created: / 17-08-2006 / 21:21:48 / cg"
"Modified: / 10-10-2006 / 22:02:42 / cg"
!
extensionMethodNames_code_ignoreOldEntries:ignoreOldEntries
^ String streamContents:[:s |
|oldSpec|
s nextPutLine:'extensionMethodNames'.
s nextPutLine:' ^ #('.
oldSpec := self extensionMethodNames pairWiseCollect:[:className :selector | className -> selector ].
ignoreOldEntries ifFalse:[
oldSpec do:[:entry |
|mclassName mselector|
mclassName := entry key asSymbol.
mselector := entry value asSymbol.
s spaces:8.
mclassName storeArrayElementOn:s.
s space.
mselector storeArrayElementOn:s.
s cr.
].
].
self searchForExtensions do:[:eachMethod |
|attributes oldSpecEntry mclassName mselector|
mclassName := eachMethod mclass name.
mselector := eachMethod selector.
oldSpecEntry := oldSpec detect:[:entry | entry key = mclassName and:[ entry value = mselector]] ifNone:nil.
(ignoreOldEntries or:[ oldSpecEntry isNil]) ifTrue:[
s spaces:8.
mclassName storeArrayElementOn:s.
s space.
mselector storeArrayElementOn:s.
s cr.
]
].
s nextPutLine:' )'
].
"
self extensionMethodNames_code_ignoreOldEntries:false
stx_libtool extensionMethodNames_code_ignoreOldEntries:false
stx_libtool extensionMethodNames_code_ignoreOldEntries:true
"
"Created: / 10-10-2006 / 22:02:36 / cg"
"Modified: / 23-10-2006 / 11:07:29 / cg"
!
forEachContentsMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition
aTwoArgBlock
value:(self classNamesAndAttributes_code_ignoreOldEntries:ignoreOldDefinition ignoreOldDefinition:ignoreOldDefinition)
value:'description - contents'.
aTwoArgBlock
value: (self extensionMethodNames_code_ignoreOldEntries:ignoreOldDefinition)
value: 'description - contents'.
aTwoArgBlock
value: self preRequisites_code
value: 'description'.
"Created: / 15-09-2006 / 16:47:54 / cg"
"Modified: / 10-10-2006 / 22:01:28 / cg"
!
forEachMethodsCodeToCompileDo:aTwoArgBlock
self forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:false
!
forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition
self
forEachContentsMethodsCodeToCompileDo:aTwoArgBlock
ignoreOldDefinition:ignoreOldDefinition.
(self class implements:#description) ifFalse:[
aTwoArgBlock
value: self description_code
value: 'description - project information'.
].
(self class implements:#productName) ifFalse:[
aTwoArgBlock
value: self productName_code
value: 'description - project information'.
].
(self class implements:#companyName) ifFalse:[
aTwoArgBlock
value: self companyName_code
value: 'description - project information'.
].
(self class implements:#legalCopyright) ifFalse:[
aTwoArgBlock
value: self legalCopyright_code
value: 'description - project information'.
].
"Created: / 18-08-2006 / 16:22:37 / cg"
"Modified: / 10-10-2006 / 22:02:24 / cg"
!
legalCopyright_code
^ String streamContents:[:s |
s nextPutLine:'legalCopyright'.
s nextPutLine:' "Return a copyright string which will appear in <lib>.rc"'.
s cr; nextPutLine:' ^ ', self legalCopyright storeString.
].
"
self legalCopyright_code
stx_libbasic3 legalCopyright_code
"
"Created: / 18-08-2006 / 16:21:01 / cg"
!
preRequisites_code
|preRequisites searchedPreRequisites|
preRequisites := self preRequisites asSet.
searchedPreRequisites := self searchForPreRequisites.
preRequisites addAll: (searchedPreRequisites keys).
self isApplicationDefinition ifTrue:[
preRequisites add:#'stx:libcomp'.
self isGUIApplication ifTrue:[
preRequisites add:#'stx:libbasic2'.
preRequisites add:#'stx:libview'.
preRequisites add:#'stx:libview2'.
preRequisites add:#'stx:libwidg'.
preRequisites add:#'stx:libwidg2'.
preRequisites add:#'stx:libui'.
].
].
preRequisites removeAll: self excludedFromPreRequisites.
preRequisites remove:self package ifAbsent:[].
^ String streamContents:[:s |
s nextPutLine:'preRequisites'.
s nextPutLine:' ^ #('.
preRequisites asSortedCollection do:[:eachPackageID |
|reason|
s spaces:8.
eachPackageID storeOn:s.
reason := searchedPreRequisites at:eachPackageID ifAbsent:nil.
reason notEmptyOrNil ifTrue:[
s nextPutAll:' "'; nextPutAll:reason anElement; nextPutAll:' "'.
].
s cr.
].
s nextPutLine:' )'
].
"
bosch_dapasx_application preRequisites_code
demo_demoApp1 preRequisites_code
stx_libtool2 preRequisites_code
"
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 17-08-2006 / 21:28:09 / cg"
"Modified: / 09-10-2006 / 14:27:20 / cg"
!
productName_code
^ String streamContents:[:s |
s nextPutLine:'productName'.
s nextPutLine:' "Return a product name which will appear in <lib>.rc"'.
s cr; nextPutLine:' ^ ',self productName storeString.
].
"
self productName_code
stx_libbasic3 productName_code
"
"Created: / 18-08-2006 / 16:14:19 / cg"
! !
!ProjectDefinition class methodsFor:'defaults'!
applicationTypes
GUIApplicationType isNil ifTrue:[self initialize].
^ Array with:GUIApplicationType with:NonGUIApplicationType
"
self applicationTypes
"
!
defaultProjectType
^ self libraryTypes first
"/ ^ self applicationTypes first
"Created: / 23-08-2006 / 14:27:32 / cg"
!
defaultProjectTypeForGUIApplication
^ GUIApplicationType
!
defaultProjectTypeForNonGUIApplication
^ NonGUIApplicationType
!
guiApplicationType
^ GUIApplicationType
!
libraryType
^ LibraryType
!
libraryTypes
LibraryType isNil ifTrue:[self initialize].
^ Array with:LibraryType
"
self libraryTypes
"
!
nonGuiApplicationType
^ NonGUIApplicationType
!
projectTypes
^ self libraryTypes , self applicationTypes
"Created: / 23-08-2006 / 14:27:32 / cg"
! !
!ProjectDefinition class methodsFor:'description'!
excludedFromPreRequisites
"list packages which are to be explicitely excluded from the automatic constructed
prerequisites list. If empty, everything that is found along the inheritance of any of
my classes is considered to be a prerequisite package."
^ #()
"Modified: / 17-08-2006 / 19:48:59 / cg"
!
excludedFromSubProjects
"list packages which are to be explicitely excluded from the automatic constructed
subProjects list. If empty, every sub-package is included as a prerequisite."
^ #()
"Modified: / 17-08-2006 / 19:49:40 / cg"
!
postLoadAction
"invoked after loading a project"
"/ intentionally left blank
"Created: / 08-08-2006 / 11:07:40 / fm"
"Modified: / 17-08-2006 / 19:59:17 / cg"
!
preRequisites
"list packages which are required as a prerequisite. This method is generated automatically,
by searching along the inheritance chain of all of my classes.
However, when generating automatically, packages are only added - never removed, unless listed
in excludedFromPreRequisites."
^ #()
"Modified: / 17-08-2006 / 19:54:21 / cg"
!
preUnloadAction
"invoked before unloading a project"
"/ intentionally left blank
"Created: / 08-08-2006 / 11:07:40 / fm"
"Modified: / 17-08-2006 / 19:59:26 / cg"
!
siblingsAreSubProjects
^ false
!
subProjects
"list packages which are known as subprojects. This method is generated automatically.
However, when generating automatically, packages are only added - never removed, unless listed
in excludedFromSubProjects."
^ #()
"Modified: / 17-08-2006 / 19:57:46 / cg"
! !
!ProjectDefinition class methodsFor:'description - classes'!
additionalClassNamesAndAttributes
^ #()
"Created: / 21-08-2006 / 19:53:04 / cg"
!
allClassNames
^ self classNamesForWhich:[:nm :attr | true ].
!
classNames
"answer an array containing all the class names of the project's classes.
A correponding method with real names is generated in my subclasses"
^ self subclassResponsibility.
!
classNamesAndAttributes
"a correponding method with real names is generated in my subclasses"
^ #()
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 17-08-2006 / 20:47:20 / cg"
!
classNamesAndAttributesAsSpecArray
"given a classNamesAndAttributes array, make this a spec array (array of arrays).
This decompresses class-name entries into a one-element array for easier processing"
^ self classNamesAndAttributes
collect:[:entry |
entry isArray ifTrue:[
entry first isSymbol ifTrue:[
entry
] ifFalse:[
(Array with:entry first asSymbol) , (entry copyFrom:2)
].
] ifFalse:[
Array with:entry asSymbol.
]].
"Created: / 19-02-2007 / 16:11:53 / cg"
!
classNamesAndAttributesFromSpecArray:aSpecArray
"given a spec array (array of arrays), make this a classNamesAndAttributes array
as stored literally in the method.
This compresses single element array-elements into plain names
(to save code in the compiled binaries)"
^ aSpecArray
collect:[:entry |
(entry isArray and:[entry size == 1]) ifTrue:[
entry first
] ifFalse:[
entry
]].
"Created: / 19-02-2007 / 16:12:32 / cg"
!
classNamesForWhich:aBlock
"a correponding method with real names is generated in my subclasses"
|coll|
coll := OrderedCollection new.
self classNamesAndAttributesDo:[:nm :attributes |
(aBlock value:nm value:attributes) ifTrue:[
coll add:nm.
].
].
^ coll
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 17-08-2006 / 20:47:20 / cg"
!
compiled_classNames
^ self classNamesForWhich:[:nm :attr | attr isEmptyOrNil or:[(attr includes:#autoload) not]].
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 21-08-2006 / 18:48:31 / cg"
!
compiled_classNamesForPlatform:platformName
"answer the classes to be compiled only for platformName
platformName is one of #unix, #win32 (OperatingSystem platformName)"
^ self
classNamesForWhich:[:nm :attr |
(attr includes:#autoload) not and:[attr includes:platformName]
].
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 09-10-2006 / 13:30:08 / cg"
!
compiled_classNames_common
"classes to be compiled for any platform"
^ self
classNamesForWhich:[:nm :attr |
attr isEmptyOrNil
].
"Created: / 18-08-2006 / 13:37:51 / cg"
!
compiled_classNames_unix
"class, only to be compiled under unix"
^ self compiled_classNamesForPlatform:#unix.
"Created: / 18-08-2006 / 13:37:51 / cg"
!
compiled_classNames_windows
"class, only to be compiled under windows"
^ self compiled_classNamesForPlatform:#win32.
"Created: / 18-08-2006 / 13:37:56 / cg"
!
extensionMethodNames
"list class/selector pairs of extensions.
A correponding method with real names is generated in my subclasses"
^ #()
"Modified: / 17-08-2006 / 20:49:51 / cg"
!
ignoredClassNames
"can be redefined to suppress some classes from being included in a
generated classNamesAndAttributes spec"
^ #()
"Created: / 23-01-2007 / 19:08:27 / cg"
! !
!ProjectDefinition class methodsFor:'description - compilation'!
additionalDefinitions_bc_dot_mak
"allows for additional definitions/rules to be added to the bc.mak file.
Subcallses may redefine this."
^ self additionalDefinitions_nt_dot_mak
"Created: / 22-08-2006 / 23:59:32 / cg"
!
additionalDefinitions_make_dot_proto
"allows for additional definitions/rules to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:53:08 / cg"
!
additionalDefinitions_nt_dot_mak
"obsolete - kept for compatibility with old project files"
^ ''
"Created: / 22-08-2006 / 23:59:32 / cg"
!
additionalLinkLibraries_bc_dot_mak
"allows for additional static libraries to be added to the bc.mak file.
Subclasses may redefine this"
"backward compatibilty with old projects"
^ self additionalLinkLibraries_nt_dot_mak
"Created: / 22-08-2006 / 23:53:33 / cg"
!
additionalLinkLibraries_make_dot_proto
"allows for additional static libraries to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:53:33 / cg"
!
additionalLinkLibraries_nt_dot_mak
"obsolete - kept for compatibility with old project files"
^ ''
"Created: / 22-08-2006 / 23:53:33 / cg"
!
additionalRules_bc_dot_mak
"obsolete - kept for compatibility with old project files"
^ ''
"Created: / 22-08-2006 / 23:59:24 / cg"
!
additionalRules_make_dot_proto
"allows for additional rules to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:59:16 / cg"
!
additionalSharedLinkLibraries_make_dot_proto
"allows for additional shared libraries to be added to the make.proto file."
^ ''
!
additionalTargets_bc_dot_mak
"obsolete - kept for compatibility with old project files"
^ ''
"Created: / 23-08-2006 / 00:00:35 / cg"
!
additionalTargets_make_dot_proto
"allows for additional targets to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:53:33 / cg"
!
localDefines
"allow for the specification of addition include directories"
^ ''
!
localDefines_unix
"allow for the specification of addition defines for stc compilation"
^ self localDefines
!
localDefines_win32
"allow for the specification of addition defines for stc compilation"
^ self localDefines
!
localIncludes
"allow for the specification of addition include directories"
^ ''
"Created: / 06-09-2006 / 18:14:31 / cg"
!
localIncludes_unix
"allow for the specification of addition include directories"
^ self makeUnixIncludes:(self localIncludes)
"Created: / 18-08-2006 / 12:50:27 / cg"
"Modified: / 06-09-2006 / 18:15:26 / cg"
!
localIncludes_win32
"allow for the specification of addition include directories"
^ self makeWin32Includes:(self localIncludes)
"Created: / 18-08-2006 / 12:50:27 / cg"
"Modified: / 06-09-2006 / 18:15:37 / cg"
!
stcOptimizationOptions
"see the stc reference / stc usage for options.
For now, the following variants are useful:
+optspace3 most compact code
- use for all gui, application code.
+optinline +optinline2 +inlineNew
fastest code
- use only for computation-intensive classes"
^ '+optspace3'
"Created: / 18-08-2006 / 12:50:27 / cg"
!
stcWarningOptions
"see the stc reference / stc usage for options.
For now, the following variants are useful:
-warn no warnings
-warnNonStandard no warnings about non-standard smalltalk features"
^ '-warnNonStandard'
"Created: / 18-08-2006 / 12:51:38 / cg"
! !
!ProjectDefinition class methodsFor:'description - project information'!
companyName
"Returns a company string which will appear in <lib>.rc.
Under win32, this is placed into the dlls file-info"
self module = 'stx' ifTrue:[
^ 'eXept Software AG'
].
^ 'My Company'
"Modified: / 18-08-2006 / 16:08:20 / cg"
!
description
"Returns a description string which will appear in vc.def / bc.def"
^self productName,' ',self packageName
"/ ^ self name
"Created: / 08-08-2006 / 11:15:01 / fm"
"Modified: / 17-08-2006 / 20:53:34 / cg"
!
fileDescription
"Returns a description string which will appear in libName.rc and the rc-file"
^self description
"Modified: / 17-08-2006 / 20:27:07 / cg"
!
fileMajorVersionNr
"Returns a versionNumber which will appear in libName.rc"
^ Smalltalk majorVersionNr printString
"Created: / 18-08-2006 / 12:03:32 / cg"
"Modified: / 30-08-2006 / 18:50:51 / cg"
!
fileMinorVersionNr
"Returns a versionNumber which will appear in libName.rc"
^ Smalltalk minorVersionNr printString
"Created: / 18-08-2006 / 12:03:13 / cg"
"Modified: / 30-08-2006 / 18:50:46 / cg"
!
fileReleaseNr
"Returns a releaseNumber which will appear in libName.rc"
"take the default revision from the cvs-version"
^ self cvsRevision last
"Created: / 18-08-2006 / 12:02:58 / cg"
"Modified: / 30-08-2006 / 18:54:48 / cg"
!
fileRevisionNr
"Returns a revisionNumber which will appear in libName.rc"
"take the default revision from the cvs-version"
^ self cvsRevision first
"Created: / 18-08-2006 / 12:02:39 / cg"
"Modified: / 30-08-2006 / 18:54:39 / cg"
!
fileVersion
"Returns a fileVersion string which will appear in libName.rc"
"<major>.<minor>.<rev>.<rel> (such as '1.2.17.1') "
^ self fileMajorVersionNr
, '.'
, self fileMinorVersionNr
, '.'
, self fileRevisionNr
, '.'
, self fileReleaseNr
"
self fileVersion
"
"Modified: / 30-08-2006 / 18:51:49 / cg"
!
fileVersionCommaSeparated
"Returns a fileVersion string which will appear in libName.rc"
"<major>,<minor>,<revision>,<release> (such as '2,17,1,2') "
^ self fileMajorVersionNr
, ','
, self fileMinorVersionNr
, ','
, self fileRevisionNr
, ','
, self fileReleaseNr
"Created: / 17-08-2006 / 20:16:17 / cg"
"Modified: / 30-08-2006 / 18:54:20 / cg"
!
iconFileName
"Returns the icon-filename for the application (nil if there is none)"
^ nil
"Created: / 30-08-2006 / 18:44:15 / cg"
!
internalName
"Returns a name string which will appear in libName.rc"
^ self packageName
"Modified: / 17-08-2006 / 20:27:37 / cg"
!
legalCopyright
"Returns a copyright string which will appear in <lib>.rc.
Under win32, this is placed into the dlls file-info"
self module = 'stx' ifTrue:[
"hardwired-default"
^ 'Copyright Claus Gittinger 1988-%1\nCopyright eXept Software AG 1998-%1'
bindWith:(Date today year printString)
].
self module = 'exept' ifTrue:[
"hardwired-default"
^ 'Copyright eXept Software AG 1998-%1'
bindWith:(Date today year printString)
].
^ 'My CopyRight or CopyLeft'
"Modified: / 30-08-2006 / 18:53:36 / cg"
!
majorVersionNr
"Returns a versionNumber which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')
the default here takes smalltalks version number.
But thats probably not good for an end-user-app."
^ Smalltalk majorVersionNr printString
"Created: / 17-08-2006 / 20:20:18 / cg"
"Modified: / 30-08-2006 / 18:52:13 / cg"
!
minorVersionNr
"Returns a versionNumber which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')
the default here takes smalltalks version number.
But thats probably not good for an end-user-app."
^ Smalltalk minorVersionNr printString
"Created: / 17-08-2006 / 20:20:32 / cg"
"Modified: / 30-08-2006 / 18:52:16 / cg"
!
productDate
"Returns a product-date string which will appear in libName.rc"
"take the current date - by default"
^ Timestamp now printStringRFC1123Format
"Created: / 17-08-2006 / 20:17:28 / cg"
!
productFilename
"Returns a filename which be used as linkname, product file name etc."
^ self productNameAsValidFilename
"
stx_projects_smalltalk productName
stx_projects_smalltalk productFilename
"
"Created: / 01-03-2007 / 19:33:06 / cg"
!
productInstallDir
"Returns a product default installDir which will appear in <app>.nsi."
^ '$PROGRAMFILES\',self module
"Created: / 14-09-2006 / 21:23:01 / cg"
!
productName
"Returns a product name which will appear in <lib>.rc.
Under win32, this is placed into the dlls file-info"
self module = 'stx' ifTrue:[
^ 'Smalltalk/X'
].
Error handle:[:ex |
^ 'ProductName'
] do:[
^ self startupClassName
].
"Modified: / 18-12-2006 / 17:34:19 / cg"
!
productNameAsValidFilename
"Returns a product name which will appear in <lib>.rc.
Under win32, this is placed into the dlls file-info"
|nm|
nm := self productName.
^ nm copy replaceAny:'/\:;.,' with:$_
"
'Smalltalk/X' replaceAny:'/\:;.,' with:nil
"
"Created: / 01-03-2007 / 19:19:21 / cg"
!
productPublisher
"Returns a product publisher which will appear in <app>.nsi."
( #('exept' 'stx') includes:self module) ifTrue:[
^ 'eXept Software AG'
].
^ 'thePublisher'
"Created: / 14-09-2006 / 21:12:54 / cg"
!
productVersion
"Returns a product version which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')"
^ self majorVersionNr
, '.'
, self minorVersionNr
, '.'
, self revisionNr
, '.'
, self releaseNr
"
self productVersion
"
"Modified: / 30-08-2006 / 18:52:47 / cg"
!
productVersionCommaSeparated
"Returns a product version which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '0,1,1,1') "
^ self majorVersionNr
, ','
, self minorVersionNr
, ','
, self revisionNr
, ','
, self releaseNr
"Created: / 17-08-2006 / 20:13:32 / cg"
"Modified: / 30-08-2006 / 18:52:42 / cg"
!
productWebSite
"Returns a product webSite which will appear in <app>.nsi."
( #('exept' 'stx') includes:self module) ifTrue:[
^ 'http://www.exept.de'
].
"/ should be redefined by concrete ApplicationDefinition
^ 'http://www.yoursite.com'
"Created: / 14-09-2006 / 21:15:05 / cg"
"Modified: / 01-03-2007 / 18:11:27 / cg"
!
releaseNr
"Returns a releaseNr which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')
the default here takes smalltalks version number.
But thats probably not good for an end-user-app."
^ Smalltalk releaseNr printString
"Created: / 17-08-2006 / 20:20:51 / cg"
"Modified: / 30-08-2006 / 18:52:22 / cg"
!
revisionNr
"Returns a revisionNr which will appear in libName.rc"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')
the default here takes smalltalks version number.
But thats probably not good for an end-user-app."
^ Smalltalk revisionNr printString
"Created: / 17-08-2006 / 20:20:40 / cg"
"Modified: / 30-08-2006 / 18:52:32 / cg"
!
versionNumber
"Returns a version string which will appear in bc.def / vc.def "
^''
"Created: / 08-08-2006 / 11:35:52 / fm"
"Modified: / 17-08-2006 / 19:46:29 / cg"
! !
!ProjectDefinition class methodsFor:'file generation'!
basicFileNamesToGenerate
self subclassResponsibility
"Created: / 14-09-2006 / 14:36:31 / cg"
!
fileNamesToGenerate
^ self basicFileNamesToGenerate reject:[:p | self protectedFileNames includes:(p first) ].
"Modified: / 14-09-2006 / 14:36:10 / cg"
!
forEachFileNameAndGeneratedContentsDo:aTwoArgBlock
|pairs|
pairs := OrderedCollection new.
self forEachFileNameAndGeneratorMethodDo:[:fileName :generator |
|file|
file := self perform:generator.
pairs add:(Array with:fileName with:file)
].
pairs pairsDo:aTwoArgBlock
"Created: / 16-08-2006 / 18:37:52 / User"
!
forEachFileNameAndGeneratorMethodDo:aTwoArgBlock
|fileNamesAndSelectors|
fileNamesAndSelectors := self fileNamesToGenerate.
fileNamesAndSelectors pairsDo:aTwoArgBlock
"Modified: / 14-09-2006 / 21:02:37 / cg"
!
generateFile:filename
self basicFileNamesToGenerate
pairsDo:[:fn :action |
filename = fn ifTrue:[
^ self perform:action
].
].
(filename = 'app.rc' or:[filename = 'lib.rc' or:[filename = self rcFilename]]) ifTrue:[
^ self generate_packageName_dot_rc
].
(filename = 'app.nsi' or:[filename = self nsiFilename]) ifTrue:[
^ self generate_packageName_dot_nsi
].
(filename = 'loadAll') ifTrue:[
^ self generate_loadAll
].
self error:('File "%1" not appropriate (not generated) for this type of project.'
bindWith:filename)
"Modified: / 14-09-2006 / 21:07:49 / cg"
!
generate_abbrev_dot_stc
|anyNil check|
anyNil := false.
check :=
[:eachClassName |
|cls fn wasLoaded failedToLoad numClassInstvars|
cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
anyNil := true.
].
].
self allClassNames do:check.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
check value:nm
].
].
anyNil ifTrue:[
(Dialog confirm:'Some classes are missing. Cannot generate a correct "abbrev.stc" file.\\Continue anyway?' withCRs)
ifFalse:[
AbortSignal raise.
].
].
^ String
streamContents:[:s |
|addEntry|
addEntry :=
[:eachClassName |
|cls fn wasLoaded failedToLoad numClassInstvars|
s nextPutAll:eachClassName.
s nextPutAll:' '.
cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
fn := (Smalltalk fileNameForClass:eachClassName) asFilename withoutSuffix.
fn suffix notEmptyOrNil ifTrue:[
fn := fn withoutSuffix
].
fn := fn baseName.
s nextPutAll:fn.
s nextPutAll:' '; nextPutAll:(self package); nextPutAll:' '.
s nextPutAll:' '; nextPutAll:'unknownCategory' storeString; nextPutAll:' '.
s nextPutAll:' '; nextPutAll:'0'.
] ifFalse:[
wasLoaded := cls isLoaded.
wasLoaded ifFalse:[
failedToLoad := false.
Error handle:[:ex |
failedToLoad := true.
] do:[
ParserFlags
withSTCCompilation:#never
do:[
cls autoload.
]
].
].
fn := cls classFilename asFilename withoutSuffix.
fn suffix notEmptyOrNil ifTrue:[
fn := fn withoutSuffix
].
fn := fn baseName.
(fn includes:Character space) ifTrue:[
s nextPutAll:fn storeString.
] ifFalse:[
s nextPutAll:fn.
].
s nextPutAll:' '; nextPutAll:(self package); nextPutAll:' '.
s nextPutAll: (cls category asString storeString).
failedToLoad ifTrue:[
s nextPutAll:' 0'.
] ifFalse:[
numClassInstvars := cls theMetaclass instSize - Class instSize.
s nextPutAll:' '; nextPutAll:numClassInstvars printString.
].
wasLoaded ifFalse:[
cls unload
]
].
s cr.
].
self allClassNames do:addEntry.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
addEntry value:nm
].
].
]
"
DapasXProject generate_abbrev_dot_stc
DapasX_Datenbasis generate_abbrev_dot_stc
bosch_dapasx_interactiver_editor generate_abbrev_dot_stc
"
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 20-10-2006 / 16:31:08 / cg"
!
generate_bc_dot_mak
^ (self
replaceMappings: self bc_dot_mak_mappings
in: self bc_dot_mak) asStringCollection withTabs asString
"
DapasXProject generate_bc_dot_mak
DapasX_Datenbasis generate_bc_dot_mak
"
"Modified: / 09-08-2006 / 11:46:14 / fm"
!
generate_bmake_dot_mak
^self replaceMappings: self bmake_dot_mak_mappings
in: self bmake_dot_mak
"Created: / 17-08-2006 / 20:03:43 / cg"
!
generate_loadAll
^ String
streamContents:[:s |
|classNames classesLoaded classNamesUnloaded classesSorted classNamesSorted|
classNames := self compiled_classNames_common.
classesLoaded := classNames
collect:[:nm | Smalltalk classNamed:nm]
thenSelect:[:cls | cls notNil and:[cls isLoaded] ].
classNamesUnloaded := classNames
select:[:nm | |cls| cls := Smalltalk classNamed:nm. cls isNil or:[cls isLoaded not]].
classesSorted := Class classesSortedByLoadOrder:classesLoaded.
classNamesSorted := classesSorted collect:[:cls | cls name].
s nextPutAll:'"/
"/ $' , 'Header' , '$
"/
"/ loadAll-file to fileIn code for: ' , self package , '
"/
"/ Automatically generated from the ProjectDefinition.
"/ DO NOT MODIFY THIS FILE;
"/
"/
"/ Prerequisites:
"/
"/ Smalltalk loadPackage:''module:directory''.
"/ Smalltalk loadPackage:''....''.
!!
"{ package:''' , self package, ''' }"
!!
|files|
''loading package ' , self package ,'...'' infoPrint.
files := #(
'.
classesSorted do:[:eachClass |
s nextPutLine:' ''' , eachClass classBaseFilename, ''''.
].
classNamesUnloaded do:[:nm |
s nextPutLine:' ''' , (Smalltalk fileNameForClass: nm) asFilename baseName, ''''.
].
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
s nextPutLine:' ''' , (Smalltalk fileNameForClass: nm) asFilename baseName, ''''.
].
].
self hasExtensionMethods ifTrue:[
s nextPutLine:' ''extensions.st'''.
].
s nextPutAll:'
).
"/ see if there is a classLibrary
(Smalltalk fileInClassLibrary:''' , (self libraryName) , ''') ifTrue:[
|handle loaded|
handle := ObjectFileLoader loadedObjectHandles
detect:[:h | h package = ''' , self package , '''] ifNone:nil.
handle ifNotNil:[
loaded := Set new:(handle classes size).
handle classes do:[:c| c isMeta ifFalse:[loaded add:c classBaseFilename]].
files := files \ loaded.
].
].
"/ load files which are not in the classLibrary (all if there is none)
files notEmpty ifTrue:[
'''' infoPrintCR.
files do:[:f |
''.'' infoPrint.
f asFilename exists ifTrue:[
Smalltalk fileIn:f.
] ifFalse:[
Smalltalk fileIn:(''source/'' , f)
]
].
'' '' infoPrintCR.
].
''done (' , self package ,').'' infoPrintCR.
'.
].
"Created: / 14-09-2006 / 14:21:31 / cg"
"Modified: / 12-10-2006 / 15:55:00 / cg"
!
generate_make_dot_proto
^ (self
replaceMappings: self make_dot_proto_mappings
in: self make_dot_proto) asStringCollection withTabs asString
"
stx:libbasic2 generate_make_dot_proto
"
"Modified: / 09-08-2006 / 11:31:01 / fm"
!
generate_make_dot_spec
^ (self
replaceMappings: self make_dot_spec_mappings
in: self make_dot_spec) asStringCollection withTabs asString
"
DapasXProject generate_make_dot_spec
DapasX_Datenbasis generate_make_dot_spec
bosch_dapasx_kernel_Definition generate_make_dot_spec
"
"Modified: / 09-08-2006 / 11:31:09 / fm"
!
generate_modules_dot_stx
^self replaceMappings: self modules_dot_stx_mappings
in: self modules_dot_stx
"
bosch_dapasx_application generate_modules_dot_stx
"
"Modified: / 09-08-2006 / 11:31:09 / fm"
"Modified: / 11-08-2006 / 14:01:56 / cg"
!
generate_packageName_dot_rc
^self replaceMappings: self packageName_dot_rc_mappings
in: self packageName_dot_rc
"
bosch_dapasx_datenbasis generate_packageName_dot_rc
bosch_dapasx_hw_schnittstellen generate_packageName_dot_rc
stx_libbasic3 generate_packageName_dot_rc
stx_libwidg3 generate_packageName_dot_rc
stx_libwidg3 productVersion
"
"Modified: / 09-08-2006 / 11:31:09 / fm"
"Modified: / 21-08-2006 / 19:33:21 / cg"
!
generate_vc_dot_def
^self replaceMappings: self vc_dot_def_mappings
in: self vc_dot_def
"
DapasXProject generate_vc_dot_def
DapasX_Datenbasis generate_vc_dot_def
"
"Modified: / 09-08-2006 / 11:31:21 / fm"
!
nsiFilename
^ self packageName,'.nsi'.
"Created: / 14-09-2006 / 21:03:41 / cg"
!
protectedFileNames
"names of files which should NOT be generated
- redefine this to protect a hand-written Make.proto"
^ #()
"Created: / 14-09-2006 / 14:38:40 / cg"
!
rcFilename
^ self packageName,'.rc'.
"Created: / 07-09-2006 / 17:07:00 / cg"
! !
!ProjectDefinition class methodsFor:'file templates'!
bc_dot_mak
"answer a template for the bc.mak makefile.
Any variable definition %(Variable) will be later replaced by the mapping.
$% characters have to be duplicated"
^ self subclassResponsibility
!
bmake_dot_mak
"the template code for the bmake.bat file"
^ '
make.exe -N -f bc.mak %%1 %%2
%(SUBPROJECT_BMAKE_CALLS)
'
"Created: / 17-08-2006 / 20:04:14 / cg"
"Modified: / 14-09-2006 / 19:46:40 / cg"
!
classLine_libInit_dot_cc
^'_%(CLASS)_Init(pass,__pRT__,snd);'
"Created: / 08-08-2006 / 12:51:44 / fm"
"Modified: / 08-08-2006 / 15:46:05 / fm"
!
make_dot_spec
^
'# $','Header','$
#
# DO NOT EDIT
# automagically generated from the projectDefinition: ',self name,'.
#
# Warning: once you modify this file, do not rerun
# stmkmp or projectDefinition-build again - otherwise, your changes are lost.
#
# This file contains specifications which are common to all platforms.
#
# Do NOT CHANGE THESE DEFINITIONS
# (otherwise, ST/X will have a hard time to find out the packages location from its packageID,
# to find the source code of a class and to find the library for a package)
MODULE=%(MODULE)
MODULE_DIR=%(MODULE_DIRECTORY)
PACKAGE=$(MODULE):$(MODULE_DIR)
# Argument(s) to the stc compiler (stc --usage).
# -H. : create header files locally
# (if removed, they will be created as common
# -Pxxx : defines the package
# -Zxxx : a prefix for variables within the classLib
# -Dxxx : defines passed to to CC for inline C-code
# -Ixxx : include path passed to CC for inline C-code
# +optspace : optimized for space
# +optspace2 : optimized more for space
# +optspace3 : optimized even more for space
# +optinline : generate inline code for some ST constructs
# +inlineNew : additionally inline new
# +inlineMath : additionally inline some floatPnt math stuff
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCLOCALOPTIMIZATIONS=+optinline +inlineNew
# STCLOCALOPTIMIZATIONS=+optspace3
STCLOCALOPTIMIZATIONS=%(STCOPTIMIZATIONOPTIONS)
# Argument(s) to the stc compiler (stc --usage).
# -warn : no warnings
# -warnNonStandard : no warnings about ST/X extensions
# -warnEOLComments : no warnings about EOL comment extension
# -warnPrivacy : no warnings about privateClass extension
#
# ********** OPTIONAL: MODIFY the next line(s) ***
# STCWARNINGS=-warn
# STCWARNINGS=-warnNonStandard
# STCWARNINGS=-warnEOLComments
STCWARNINGS=%(STCWARNINGOPTIONS)
%(OBJECTS)
'
"Created: / 08-08-2006 / 19:31:29 / fm"
"Modified: / 09-08-2006 / 15:10:57 / fm"
"Modified: / 30-08-2006 / 19:07:26 / cg"
!
objectLine_make_dot_spec
^' $(OUTDIR)%(CLASSFILE).$(O) \'
"Created: / 08-08-2006 / 20:16:46 / fm"
"Modified: / 23-08-2006 / 11:11:38 / cg"
!
packageName_dot_rc
"the template code for the <libName>.rc file"
^
'//
// DO NOT EDIT
// automagically generated from the projectDefinition: ',self name,'.
//
VS_VERSION_INFO VERSIONINFO
FILEVERSION %(FILE_VERSION_COMMASEPARATED)
PRODUCTVERSION %(PRODUCT_VERSION_COMMASEPARATED)
FILEFLAGSMASK VS_FF_DEBUG | VS_FF_PRERELEASE
FILEFLAGS VS_FF_PRERELEASE | VS_FF_SPECIALBUILD
FILEOS VOS_NT_WINDOWS32
FILETYPE %(FILETYPE)
FILESUBTYPE VS_USER_DEFINED
BEGIN
BLOCK "StringFileInfo"
BEGIN
BLOCK "040904E4"
BEGIN
VALUE "CompanyName", "%(COMPANY_NAME)\0"
VALUE "FileDescription", "%(FILE_DESCRIPTION)\0"
VALUE "FileVersion", "%(FILE_VERSION)\0"
VALUE "InternalName", "%(INTERNAL_NAME)\0"
%(LEGAL_COPYRIGHT_LINE)
VALUE "ProductName", "%(PRODUCT_NAME)\0"
VALUE "ProductVersion", "%(PRODUCT_VERSION)\0"
VALUE "ProductDate", "%(PRODUCT_DATE)\0"
END
END
BLOCK "VarFileInfo"
BEGIN // Language | Translation
VALUE "Translation", 0x409, 0x4E4 // U.S. English, Windows Multilingual
END
END
'
"
stx_libbasic3 packageName_dot_rc
stx_libbasic3 generate_packageName_dot_rc
"
"Created: / 08-08-2006 / 19:31:29 / fm"
"Modified: / 09-08-2006 / 15:10:57 / fm"
"Modified: / 23-08-2006 / 01:32:23 / cg"
! !
!ProjectDefinition class methodsFor:'loading'!
load
"load the project
Answer true, if new classes have been installed for this package,
false if the package's classes have been already present."
^ self loadAsAutoloaded:false.
!
loadAsAutoloaded:asAutoloaded
"load the project.
If asAutoloaded == true, install all new classes as autoloaded.
Answer true, if new classes have been installed for this package,
false if the package's classes have been already present."
|newStuffHasBeenLoaded|
newStuffHasBeenLoaded := false.
thisContext isRecursive ifTrue:[^ false].
"/ This is too much text when trying to load already loaded prerequisite packages!!
"/
"/ (Object infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
"/ "/ thisContext fullPrintAll.
"/ Transcript show:'loading '.
"/ asAutoloaded ifTrue:[
"/ Transcript show:'as autoloaded '.
"/ ].
"/ Transcript showCR:self name.
"/ ].
Class withoutUpdatingChangesDo:[
self loadPreRequisitesAsAutoloaded:asAutoloaded.
asAutoloaded ifFalse:[
self loadClassLibrary.
].
newStuffHasBeenLoaded := newStuffHasBeenLoaded | self loadExtensions.
newStuffHasBeenLoaded := newStuffHasBeenLoaded | (self loadAllClassesAsAutoloaded:asAutoloaded).
self loadSubProjectsAsAutoloaded:asAutoloaded.
].
^ newStuffHasBeenLoaded
"Created: / 17-08-2006 / 01:01:41 / cg"
"Modified: / 21-11-2006 / 15:07:09 / cg"
! !
!ProjectDefinition class methodsFor:'mappings'!
bc_dot_mak_mappings
|d|
d := Dictionary new.
d
at: 'TAB' put: ( Character tab asString );
at: 'TOP' put: ( self pathToTop_win32 );
at: 'MODULE' put: ( self module );
at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
at: 'MODULE_PATH' put: ( self moduleDirectory_win32 );
at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_bc_dot_mak).
^ d
"Created: / 18-08-2006 / 11:43:39 / cg"
"Modified: / 14-09-2006 / 20:20:19 / cg"
!
bmake_dot_mak_mappings
^ (Dictionary new)
at:'SUBPROJECT_BMAKE_CALLS' put:(self subProjectBmakeCalls);
yourself
"Created: / 17-08-2006 / 21:41:56 / cg"
"Modified: / 14-09-2006 / 18:55:33 / cg"
!
classLine_mappings: aClassName
^Dictionary new
at: 'CLASS' put: ( self st2c:aClassName );
yourself
"Modified: / 09-08-2006 / 18:27:07 / fm"
"Created: / 19-09-2006 / 22:47:43 / cg"
!
make_dot_proto_mappings
^ Dictionary new
at: 'TAB' put: ( Character tab asString );
at: 'TOP' put: ( self pathToTop_unix );
at: 'LIBRARY_NAME' put: ( self libraryName );
at: 'SUBDIRECTORIES' put: (self generateSubDirectories);
at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_unix);
at: 'LOCAL_DEFINES' put: self localDefines_unix;
at: 'COMMONSYMFLAG' put: (self commonSymbolsFlag);
at: 'HEADEROUTPUTARG' put: (self headerFileOutputArg);
at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_make_dot_proto);
at: 'ADDITIONAL_RULES' put: (self additionalRules_make_dot_proto);
at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_make_dot_proto);
at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_make_dot_proto);
at: 'ADDITIONAL_SHARED_LINK_LIBRARIES' put: (self additionalSharedLinkLibraries_make_dot_proto);
at: 'DEPENDENCIES' put: (self generateDependencies_unix);
yourself
"Created: / 09-08-2006 / 11:20:45 / fm"
"Modified: / 09-08-2006 / 16:44:48 / fm"
"Modified: / 14-09-2006 / 18:57:52 / cg"
!
make_dot_spec_mappings
^ Dictionary new
at: 'TAB' put: ( Character tab asString );
at: 'MODULE' put: ( self module );
at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
at: 'STCWARNINGOPTIONS' put: (self stcWarningOptions);
at: 'STCOPTIMIZATIONOPTIONS' put: (self stcOptimizationOptions);
at: 'OBJECTS' put: [self generateObjects_make_dot_spec];
yourself
"Created: / 18-08-2006 / 11:44:23 / cg"
"Modified: / 14-09-2006 / 18:51:24 / cg"
!
objectLine_make_dot_spec_mappings: aClassName
|cls fn|
(cls := Smalltalk classNamed:aClassName) isNil ifTrue:[
fn := Smalltalk fileNameForClass:aClassName
] ifFalse:[
fn := cls classFilename asFilename withoutSuffix baseName
].
^ Dictionary new
at: 'CLASSFILE' put: fn;
yourself
"Created: / 08-08-2006 / 20:17:28 / fm"
"Modified: / 09-08-2006 / 18:26:52 / fm"
"Modified: / 20-10-2006 / 16:22:58 / cg"
!
packageName_dot_rc_mappings
|d s|
d := Dictionary new.
d
at: 'PRODUCT_NAME' put: (self productName);
at: 'PRODUCT_VERSION' put: (self productVersion);
at: 'PRODUCT_DATE' put: (self productDate);
at: 'FILETYPE' put: ( 'VFT_DLL' );
at: 'FILE_VERSION_COMMASEPARATED' put: (self fileVersionCommaSeparated);
at: 'PRODUCT_VERSION_COMMASEPARATED' put: (self productVersionCommaSeparated);
at: 'COMPANY_NAME' put: (self companyName);
at: 'FILE_DESCRIPTION' put: (self fileDescription);
at: 'FILE_VERSION' put: (self fileVersion);
at: 'INTERNAL_NAME' put: (self internalName).
s := self legalCopyright.
s notNil ifTrue:[
d
at: 'LEGAL_COPYRIGHT_LINE' put: ' VALUE "LegalCopyright", "',s,'\0"'
].
s := self iconFileName.
s notNil ifTrue:[
d
at: #'ICONDEFINITION_LINE' put: 'IDR_MAINFRAME ICON DISCARDABLE "',s,'"'
].
^ d
"Created: / 09-08-2006 / 11:21:21 / fm"
"Modified: / 14-09-2006 / 18:52:37 / cg"
!
replaceMappings: mappings in: fileTemplate
"Replaces the defined variable mappings found in a file template with the corresponding information"
^ fileTemplate bindWithArguments:mappings.
"
self replaceMappings: (self nt_dot_def_mappingsFor: self) in: self nt_dot_def
"
"Created: / 08-08-2006 / 11:44:27 / fm"
"Modified: / 08-08-2006 / 12:46:13 / fm"
!
st2c:aString
^ (aString asString
copyReplaceString:'_' withString:('_',($_ codePoint printStringRadix:8)))
replaceAny:':' with:$_
! !
!ProjectDefinition class methodsFor:'mappings support'!
commonSymbolsFlag
"only for libraries"
^ ''
!
generateClassLines:classLineTemplate
^ String
streamContents:[:s |
|classNames classesLoaded classNamesUnloaded classNamesSorted putLineForClassName|
putLineForClassName := [:className |
|newClassLine mappings|
mappings := self classLine_mappings:className.
newClassLine := self replaceMappings:mappings in:classLineTemplate.
s nextPutLine:newClassLine
].
classNames := self compiled_classNames_common.
classesLoaded := classNames collect:[:eachClassName | Smalltalk classNamed:eachClassName]
thenSelect:[:eachClass | eachClass notNil and:[eachClass isLoaded]].
classNamesUnloaded := classNames
select:[:nm |
|cls|
cls := Smalltalk classNamed:nm.
cls isNil or:[ cls isLoaded not ]
].
classNamesSorted := (Class classesSortedByLoadOrder:classesLoaded) collect:[:cls | cls name].
classNamesSorted do:putLineForClassName.
classNamesUnloaded do:putLineForClassName.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
do:[:nm :attr |
(attr isEmptyOrNil or:[ (attr includes:#autoload) not ]) ifTrue:[
putLineForClassName value:nm.
].
].
#( ('UNIX' unix)
('WIN32' win32)
('VMS' vms)
('BEOS' beos) )
pairsDo:[:ifdef :platformName |
|archClassNames archClassesLoaded|
archClassNames := self compiled_classNamesForPlatform:platformName.
archClassNames notEmpty ifTrue:[
s nextPutLine:'#ifdef ' , ifdef.
archClassNames do:[:clsName |
putLineForClassName value:clsName
].
s nextPutLine:'#endif /* ' , ifdef , ' */'.
].
].
]
"
bosch_dapasx_datenbasis generateClassLines_libInit_dot_cc
bosch_dapasx_kernel generateClassLines_libInit_dot_cc
stx_libbasic3 generateClassLines_libInit_dot_cc
"
"Modified: / 16-08-2006 / 18:52:10 / User"
"Created: / 19-09-2006 / 22:47:50 / cg"
"Modified: / 20-09-2006 / 11:47:25 / cg"
!
generateClassLines_libInit_dot_cc
^ self generateClassLines:(self classLine_libInit_dot_cc)
"
bosch_dapasx_datenbasis generateClassLines_libInit_dot_cc
bosch_dapasx_kernel generateClassLines_libInit_dot_cc
stx_libbasic3 generateClassLines_libInit_dot_cc
"
"Created: / 09-08-2006 / 11:21:48 / fm"
"Modified: / 16-08-2006 / 18:52:10 / User"
"Modified: / 19-09-2006 / 22:48:14 / cg"
!
generateDependencies:whichArchitecture
^ String
streamContents:[:s |
|classNames classesPresent classesLoaded classesSorted classNamesSorted putDependencyForClassBlock
archClassNames archClassesLoaded
putSingleClassDependencyEntryBlock putDependencyForExtensionsBlock|
putSingleClassDependencyEntryBlock := [:cls |
|sclsBaseName|
s nextPutAll:' $(INCLUDE_TOP)'.
s nextPutAll:(self pathSeparator:whichArchitecture) asString.
sclsBaseName := cls classFilename asFilename withoutSuffix baseName.
s nextPutAll:(self
topRelativePathTo:sclsBaseName
inPackage:cls package
architecture:whichArchitecture).
s nextPutAll:'.$(H)'.
].
putDependencyForClassBlock := [:cls |
|clsBaseName already|
clsBaseName := cls classFilename asFilename withoutSuffix baseName.
s nextPutAll:'$(OUTDIR)'.
s nextPutAll:clsBaseName.
s nextPutAll:'.$(O)'.
s nextPutAll:' '.
s nextPutAll:clsBaseName.
s nextPutAll:'.$(H)'.
s nextPutAll:': '.
s nextPutAll:clsBaseName.
s nextPutAll:'.st'.
cls isLoaded ifTrue:[
already := Set new.
cls
allSuperclassesDo:[:scls |
putSingleClassDependencyEntryBlock value:scls.
already add:scls.
].
cls
privateClassesDo:[:eachPrivateClass |
eachPrivateClass
allSuperclassesDo:[:scls |
|sclsBaseName|
scls ~~ cls ifTrue:[
scls isPrivate ifFalse:[
(already includes:scls) ifFalse:[
putSingleClassDependencyEntryBlock value:scls.
already add:scls.
].
].
].
]
].
].
s nextPutLine:' $(STCHDR)'.
].
putDependencyForExtensionsBlock := [
|already|
s nextPutAll:'$(OUTDIR)extensions.$(O): extensions.st'.
already := Set new.
self extensionMethodNames
pairWiseDo:[:className :selector |
|mthdCls cls|
((mthdCls := Smalltalk classNamed:className) notNil
and:[ mthdCls isLoaded ])
ifTrue:[
cls := mthdCls theNonMetaclass.
(already includes:cls) ifFalse:[
cls
withAllSuperclassesDo:[:scls |
(already includes:scls) ifFalse:[
putSingleClassDependencyEntryBlock value:scls.
already add:scls.
].
].
].
].
].
s nextPutLine:' $(STCHDR)'.
].
classNames := self compiled_classNames_common.
classesPresent := classNames
collect:[:className | Smalltalk classNamed:className]
thenSelect:[:cls | cls notNil].
classesLoaded := classesPresent
select:[:cls | cls isLoaded].
classesSorted := Class classesSortedByLoadOrder:classesLoaded.
classesSorted do:putDependencyForClassBlock.
(classesPresent select:[:cls | cls isLoaded not]) do:putDependencyForClassBlock.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes)
do:[:className :attr |
|cls|
(attr isEmptyOrNil or:[ (attr includes:#autoload) not ]) ifTrue:[
((cls := Smalltalk classNamed:className) notNil) ifTrue:[
putDependencyForClassBlock value:cls.
]
].
].
archClassNames := self compiled_classNamesForPlatform:whichArchitecture.
archClassesLoaded := archClassNames
collect:[:className | Smalltalk classNamed:className]
thenSelect:[:cls | cls notNil and:[ cls isLoaded ] ].
archClassesLoaded notEmpty ifTrue:[
(Class classesSortedByLoadOrder:archClassesLoaded)
do:putDependencyForClassBlock.
].
self hasExtensionMethods ifTrue:putDependencyForExtensionsBlock.
]
"
stx_libbasic3 generateDependencies:#unix
stx_libbasic3 generateDependencies:#win32
"
"Modified: / 16-08-2006 / 18:52:10 / User"
"Created: / 14-09-2006 / 12:38:57 / cg"
"Modified: / 25-10-2006 / 16:01:13 / cg"
!
generateDependencies_unix
^ self generateDependencies:#unix
"
stx_libbasic3 generateDependencies:#unix
stx_libbasic3 generateDependencies:#win32
"
"Modified: / 14-09-2006 / 13:32:34 / cg"
!
generateDependencies_win32
^ self generateDependencies:#win32
"Created: / 14-09-2006 / 12:39:18 / cg"
!
generateLocalIncludes_unix
^ String streamContents:[:s |
s nextPutAll:(self localIncludes_unix).
self searchForProjectsWhichProvideHeaderFiles
do:[:includeProject |
s nextPutAll:' -I$(INCLUDE_TOP)/',(self topRelativePathToPackage_unix: includeProject)
]
]
"
bosch_dapasx generateLocalIncludes_unix
bosch_dapasx_datenbasis generateLocalIncludes_unix
stx_libbasic generateLocalIncludes_unix
stx_libview generateLocalIncludes_unix
stx_libtool2 generateLocalIncludes_unix
stx_libui generateLocalIncludes_unix
"
"Created: / 09-08-2006 / 16:46:49 / fm"
"Modified: / 07-12-2006 / 17:47:06 / cg"
!
generateLocalIncludes_win32
^ String streamContents:[:s |
s nextPutAll:(self localIncludes_win32).
self searchForProjectsWhichProvideHeaderFiles
do:[:includeProject |
s nextPutAll:' -I$(INCLUDE_TOP)\',(self topRelativePathToPackage_win32: includeProject)
]
]
"
bosch_dapasx_application generateLocalIncludes_win32
bosch_dapasx_datenbasis generateLocalIncludes_win32
stx_libbasic generateLocalIncludes_win32
stx_libview generateLocalIncludes_win32
stx_libtool2 generateLocalIncludes_win32
"
"Created: / 09-08-2006 / 16:46:49 / fm"
"Modified: / 07-12-2006 / 17:47:10 / cg"
!
generateObjects_make_dot_spec
|pivateClassesOf sorter classes|
classes := self compiled_classes_common.
pivateClassesOf := IdentityDictionary new.
classes do:[:each | pivateClassesOf at:each put:(each allPrivateClasses)].
sorter := [:a :b |
"/ a must come before b iff:
"/ b is a subclass of a
"/ b has a private class which is a subclass of a
"/ a is a sharedPool, used by b
|mustComeBefore pivateClassesOfB|
mustComeBefore := false.
mustComeBefore := (a isSharedPool and:[(b sharedPools includes: a name)]).
mustComeBefore := mustComeBefore or:[b isSubclassOf:a].
mustComeBefore ifFalse:[
pivateClassesOfB := pivateClassesOf at:b ifAbsent:[ #() ].
pivateClassesOfB do:[:eachClassInB |
mustComeBefore := mustComeBefore or:[eachClassInB isSubclassOf:a]
].
].
mustComeBefore
].
classes topologicalSort:sorter.
^ String streamContents:[:s |
|putLineForClass putLineForClassName sysDepOrNil|
putLineForClassName :=
[:eachClassName |
|mappings newObjectLine|
mappings := self objectLine_make_dot_spec_mappings: eachClassName.
newObjectLine := self replaceMappings: mappings in: self objectLine_make_dot_spec.
s nextPutLine:newObjectLine.
].
putLineForClass :=
[:eachClass |
putLineForClassName value:(eachClass name)
].
sysDepOrNil := nil.
OperatingSystem knownPlatformNames do:[:platformID |
|define prefix depClasses depClassNames|
define := OperatingSystem platformDefineForPlatformName:platformID.
prefix := define copyFrom:('-D' size + 1).
depClasses := self compiled_classesForArchitecture:platformID.
depClasses notEmpty ifTrue:[
sysDepOrNil := prefix,'_OBJS'.
s nextPutLine:sysDepOrNil,'= \'.
(depClasses includes:nil) ifTrue:[
(Dialog confirm:'Dependencies are not in order (some classes are not present).\\Continue anyway ?' withCRs)
ifFalse:[
AbortSignal raise.
].
depClassNames := self compiled_classNamesForPlatform:platformID.
depClassNames do:putLineForClassName.
] ifFalse:[
depClasses topologicalSort:sorter.
depClasses do:putLineForClass.
].
s cr.
s cr.
]
].
s nextPutLine:'COMMON_OBJS= \'.
classes do:putLineForClass.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
s nextPutLine:(' $(OUTDIR)',(Smalltalk fileNameForClass:nm),'.$(O) \').
].
].
self hasExtensionMethods ifTrue:[
s nextPutLine:' $(OUTDIR)extensions.$(O) \'.
].
s cr.
]
"
bosch_dapasx_hw_schnittstellen_Definition generateObjects_make_dot_spec
DapasXProject generateObjects_make_dot_spec
stx_libbasic3 generateObjects_make_dot_spec
"
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 20-10-2006 / 16:18:54 / cg"
!
generateSubDirectories
^ String streamContents:[:s |
self subProjects
do:[:eachProjectID |
s space; nextPutAll:(self unixPathToPackage:eachProjectID from:self package)
]
]
"
exept_expecco generateSubDirectories
"
"Created: / 09-08-2006 / 11:26:59 / fm"
"Modified: / 14-09-2006 / 18:46:18 / cg"
!
headerFileOutputArg
"/ "all stx stuff goes to the common include directory.
"/ Everything else is left locally"
"/
"/ (
"/ #(
"/ 'stx:libbasic' 'stx:libview' 'stx:libtool'
"/ 'stx:libbasic2' 'stx:libview2' 'stx:libtool2'
"/ 'stx:libbasic3' 'stx:libwidg' 'stx:libhtml'
"/ 'stx:libcomp' 'stx:libwidg2' 'stx:libui'
"/ 'stx:libboss' 'stx:libdb'
"/ )
"/ includes:self package) ifTrue:[
"/ ^ '-H$(INCLUDE)'
"/ ].
^ '-H.'
"Created: / 18-08-2006 / 13:01:52 / cg"
"Modified: / 14-09-2006 / 15:38:25 / cg"
!
subProjectBmakeCalls
^ String streamContents:[:s |
self subProjects do:[:packageID |
s nextPutLine:'cd ', (self msdosPathToPackage:packageID from:(self package)).
s nextPutLine:'call bmake %1 %2'.
s nextPutLine:'cd ', (self msdosPathToPackage:(self package) from:packageID).
s cr.
]
]
"Created: / 14-09-2006 / 18:40:09 / cg"
"Modified: / 14-09-2006 / 19:46:57 / cg"
! !
!ProjectDefinition class methodsFor:'private'!
addReferencesToClassesFromGlobalsIn:aSetOfClasses to:usedClassReasons
aSetOfClasses
do:[:aClass |
self
addReferencesToClassesFromGlobalsInMethods:
(aClass theNonMetaclass methodDictionary values
select:[:m | m package = aClass package])
to:usedClassReasons.
self
addReferencesToClassesFromGlobalsInMethods:
(aClass theMetaclass methodDictionary values
select:[:m | m package = aClass package])
to:usedClassReasons.
].
"Modified: / 10-10-2006 / 23:03:45 / cg"
!
addReferencesToClassesFromGlobalsInMethods:someMethods to:usedClassReasons
someMethods do:[:method |
method usedGlobals
do:[:global | |usedClass|
usedClass := Smalltalk at: global asSymbol.
(usedClass notNil and:[usedClass isClass and:[usedClass isNameSpace not]])
ifTrue:[
(usedClassReasons at: usedClass ifAbsentPut:[Set new])
add: (usedClass name, ' - referenced by ', method mclass name,'>>',method selector)
]
]
]
"Created: / 10-10-2006 / 23:00:07 / cg"
!
classNamesAndAttributesDo: aBlock
self namesAndAttributesIn:(self classNamesAndAttributes) do: aBlock
"Modified: / 22-08-2006 / 18:20:21 / cg"
!
compile:someCode categorized:category
Class packageQuerySignal
answer:self package
do:[
self theMetaclass compilerClass
compile:someCode
forClass:self theMetaclass
inCategory:category
notifying:nil
install:true
skipIfSame:true
silent:true.
]
"Created: / 23-08-2006 / 14:36:53 / cg"
!
compiled_classes
^ self compiled_classNames
collect:
[:eachName|
|cls|
cls := (Smalltalk at:eachName asSymbol).
cls isNil ifTrue:[
Transcript showCR:('ProjectDefinition: missing class: ', eachName).
].
cls.
]
thenSelect:[:cls | cls notNil]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
"Modified: / 07-12-2006 / 17:48:11 / cg"
!
compiled_classesDo:aBlock
self compiled_classes do:aBlock.
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
!
compiled_classesForArchitecture:arch
^ (self compiled_classNamesForPlatform:arch)
collect:[:eachName | (Smalltalk at:eachName asSymbol) ]
"
stx_libbasic compiled_classesForArchitecture:#win32
stx_libbasic compiled_classesForArchitecture:#macos
stx_libbasic compiled_classesForArchitecture:#unix
"
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
"Modified: / 07-12-2006 / 17:43:17 / cg"
!
compiled_classes_common
^ self compiled_classNames_common collect:[:eachName| (Smalltalk at:eachName asSymbol)]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
!
cvsRevision
|rev|
rev := self revision.
rev isNil ifTrue:[
"not yet pubplished"
^ #( '0' '1' )
].
^ rev asCollectionOfSubstringsSeparatedBy:$. .
"
self cvsRevision
stx_libbasic3 cvsRevision
"
"Created: / 17-08-2006 / 20:19:03 / cg"
!
inconsistency:message
Dialog warn:message
"
self searchForNeverCompiledSuperclasses
DapasX_Datenbasis searchForNeverCompiledSuperclasses
"
"Created: / 09-08-2006 / 16:32:31 / fm"
!
makeOSIncludesWith:fileSeparator from:aString
^ aString copy replaceAny:'/\' with:fileSeparator
"
self makeOSIncludesWith:$/ from:'-I$(TOP)/foo/bar'
self makeOSIncludesWith:$\ from:'-I$(TOP)/foo/bar'
"
"Created: / 06-09-2006 / 18:17:03 / cg"
!
makeUnixIncludes:aString
^ self makeOSIncludesWith:$/ from:aString
"Created: / 06-09-2006 / 18:16:19 / cg"
!
makeWin32Includes:aString
^ self makeOSIncludesWith:$\ from:aString
"Created: / 06-09-2006 / 18:16:13 / cg"
!
namesAndAttributesIn:aCollection do: aBlock
aCollection do:[:entry |
|className attributes|
entry isArray ifFalse:[
className := entry.
attributes := #().
] ifTrue:[
className := entry first.
attributes := entry copyFrom:2.
].
aBlock value: className value: attributes
].
"Created: / 22-08-2006 / 18:20:09 / cg"
!
searchForClasses
"answer all non-private classes that belong to this project.
They are sorted in load order"
^ Class classesSortedByLoadOrder:(self searchForClassesWithProject: self package)
"
stx_libbasic3 searchForClasses
"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Created: / 17-08-2006 / 21:18:30 / cg"
!
searchForClassesWithProject: aProjectID
^ Smalltalk allClasses
select:[:cls | (cls package = aProjectID) ].
"
self searchForClassesWithProject: #'bosch:dapasx'
self searchForClassesWithProject: #'bosch:dapasx/datenbasis'
self searchForClassesWithProject: #'bosch:dapasx/kernel'
"
"Created: / 07-08-2006 / 20:42:39 / fm"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Modified: / 16-08-2006 / 18:50:48 / User"
!
searchForExtensions
^ self searchForExtensionsWithProject:self package
"
self searchForExtensions
DapasXProject searchForExtensions
DapasX_Datenbasis searchForExtensions
stx_libtool searchForExtensions
"
"Modified: / 09-08-2006 / 13:01:26 / fm"
"Created: / 17-08-2006 / 21:17:46 / cg"
"Modified: / 23-10-2006 / 11:03:07 / cg"
!
searchForExtensionsWithProject:aProjectID
"search for any class which has extensions from aProjectID.
Return the extension-methods sorted by classname-selector"
|methods|
methods := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
methods addAll:(eachClass extensionsFrom:aProjectID).
].
methods
sort:[:m1 :m2 |
|c1 c2|
c1 := m1 mclass.
c2 := m2 mclass.
c1 == c2 ifTrue:[
m1 selector < m2 selector
] ifFalse:[
(c2 isMeta and:[c1 isMeta not]) ifTrue:[
true
] ifFalse:[
(c1 isMeta and:[c2 isMeta not]) ifTrue:[
false
] ifFalse:[
c1 name < c2 name
"/ (c2 isSubclassOf:c1) ifTrue:[
"/ true
"/ ] ifFalse:[
"/ (c1 isSubclassOf:c2) ifTrue:[
"/ false
"/ ] ifFalse:[
"/ "/ leave as is
"/ true
"/ ].
"/ ].
].
].
].
].
^ methods
"
self searchForExtensionsWithProject:#'bosch:dapasx'
self searchForExtensionsWithProject:#'cg:oyster'
self searchForExtensionsWithProject:#'stx:libboss'
"
"Created: / 17-08-2006 / 21:19:04 / cg"
"Modified: / 12-10-2006 / 20:45:39 / cg"
!
searchForPreRequisites
"answer a Dictionary where the keys are the prerequisite package for this package
and the values are a Set of reasons, why each package is required"
|requiredClasses requiredPackageReasons usedClassesWithReasons ignoredPackages|
usedClassesWithReasons := Dictionary new.
"my classes are required"
requiredClasses := (self searchForClassesWithProject:self package) asSet.
"my subproject's classes are required"
self subProjects do:[:eachProjectName |
requiredClasses addAll: (self searchForClassesWithProject:eachProjectName asSymbol)
].
"all superclasses of my classes and my subProject's classes are required"
requiredClasses do:[:cls |
cls allSuperclassesDo:[:eachSuperclass |
(usedClassesWithReasons at: eachSuperclass ifAbsentPut:[Set new])
add: (eachSuperclass name, ' - superclass of ', cls name).
]
].
"all classes referenced by my classes or my subproject's classes
are required. But:
only search for locals refered to by my methods (assuming that superclasses'
prerequisites are specified in their package)."
self addReferencesToClassesFromGlobalsIn:requiredClasses to:usedClassesWithReasons.
self addReferencesToClassesFromGlobalsInMethods:(self searchForExtensionsWithProject:self package) to:usedClassesWithReasons.
"don't put classes from subProjects into the required list"
ignoredPackages := (self siblingsAreSubProjects
ifTrue:[ self searchForSiblingProjects ]
ifFalse:[ self searchForSubProjects ]) asSet.
ignoredPackages add:self package.
ignoredPackages add:Project noProjectID.
"now map classes to packages and collect the reasons"
requiredPackageReasons := Dictionary new.
usedClassesWithReasons keysAndValuesDo:[:usedClass :reasonsPerClass | |usedClassPackage|
usedClassPackage := usedClass package.
(ignoredPackages includes:usedClassPackage) ifFalse:[
(requiredPackageReasons at:usedClassPackage ifAbsentPut:[Set new])
addAll:reasonsPerClass.
].
].
^ requiredPackageReasons
"
self searchForPreRequisites
stx_libbasic3 searchForPreRequisites
bosch_dapasx_Application searchForPreRequisites
bosch_dapasx_pav_browser searchForPreRequisites
"
"Created: / 07-08-2006 / 20:42:39 / fm"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Modified: / 20-09-2006 / 17:29:59 / cg"
!
searchForProjectsWhichProvideHeaderFiles
|addPackage myPackageID requiredPackages|
myPackageID := self package.
requiredPackages := Set new.
addPackage :=
[:package |
(package ~= myPackageID) ifTrue:[
true "(package startsWith:'stx:') not" ifTrue:[
package ~= Project noProjectID ifTrue:[
requiredPackages add:package.
]
]
]
].
self compiled_classesDo:[:cls |
cls allSuperclassesDo:[:eachSuperClass |
addPackage value:(eachSuperClass package)
].
cls privateClassesDo:[:eachPrivateClass |
eachPrivateClass allSuperclassesDo:[:eachSuperClass |
eachSuperClass isPrivate ifFalse:[
addPackage value:(eachSuperClass package)
].
]
].
cls sharedPools do:[:eachPoolName |
|eachPoolClass|
eachPoolClass := Smalltalk classNamed:eachPoolName.
eachPoolClass withAllSuperclassesDo:[:eachPoolSuperClass |
addPackage value:(eachPoolSuperClass package)
]
].
].
self extensionMethodNames pairWiseDo:[:className :selector |
|cls|
((cls := Smalltalk classNamed:className) notNil and:[cls isLoaded]) ifTrue:[
addPackage value:(cls package)
]
].
^ requiredPackages
"
stx_libtool searchForProjectsWhichProvideHeaderFiles
"
"Created: / 07-12-2006 / 17:46:38 / cg"
!
searchForSiblingProjects
"answer all the packages (package names) having the my parent package"
|myPackage myParentPackage|
myPackage := self package asPackageId.
myParentPackage := myPackage parentPackage.
myParentPackage isNil ifTrue:[^ #() ].
^ Smalltalk allProjectIDs
select:[:projectID |
|thisPackage|
thisPackage := projectID asPackageId.
(thisPackage parentPackage = myParentPackage)
and:[ thisPackage ~= myPackage ].
]
"
self searchForSiblingProjects
bosch_dapasx_Application searchForSiblingProjects
stx_goodies_refactoryBrowser_changes searchForSiblingProjects
"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Created: / 23-08-2006 / 15:06:12 / cg"
!
searchForSubProjects
"answer all packages (package names), that are my subProjects"
|myPackage|
myPackage := self package.
^ Smalltalk allProjectIDs
select:[:projectID |
projectID ~= Project noProjectID
and:[ (projectID asPackageId parentPackage) = myPackage ]].
"
self searchForSubProjects
bosch_dapasx_Application searchForSubProjects
stx_goodies_refactoryBrowser_changes searchForSubProjects
"
"Created: / 07-08-2006 / 20:42:39 / fm"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Modified: / 05-12-2006 / 18:04:27 / cg"
!
setupForType:typeOrNil
typeOrNil = GUIApplicationType ifTrue:[
self compile:'isGUIApplication\ ^ true' withCRs
categorized:'description'.
^ self
].
typeOrNil = NonGUIApplicationType ifTrue:[
self compile:'isGUIApplication\ ^ false' withCRs
categorized:'description'.
^ self
].
^ self.
"Created: / 23-08-2006 / 14:26:10 / cg"
! !
!ProjectDefinition class methodsFor:'private loading'!
loadAllClassesAsAutoloaded:asAutoloaded
"load (fileIn) classes that should be present -
install as autoloaded classes marked to be autoloaded.
If asAutoloaded == true, all classes will be installed as autoloaded, even if not marked.
Answer true, if classes have been loaded"
|classNamesToLoad classNamesToAutoload hasClassesToLoad loadedClasses platformName
classesWhichFailedToLoad|
platformName := OperatingSystem platformName.
classNamesToLoad := OrderedCollection new.
classNamesToAutoload := OrderedCollection new.
self classNamesAndAttributesDo:[:eachClassname :eachAttributes | |eachClassnameSym isAutoload cls|
eachClassnameSym := eachClassname asSymbol.
isAutoload := asAutoloaded or:[eachAttributes includes:#autoload].
"no need to (re-)load an existing class, but install if should be loaded"
cls := Smalltalk loadedClassNamed:eachClassnameSym.
(cls isNil or:[cls isLoaded not and:[isAutoload not]]) ifTrue:[
(eachAttributes isEmpty
or:[(eachAttributes size == 1 and:[isAutoload])
or:[eachAttributes includes:platformName]]) ifTrue:[
hasClassesToLoad := true.
isAutoload ifTrue:[
classNamesToAutoload add:eachClassnameSym.
] ifFalse:[
classNamesToLoad add:eachClassnameSym.
].
].
].
].
hasClassesToLoad ifTrue:[
loadedClasses := OrderedCollection new.
"we need the abbreviations, since sometimes there is no 1-to-1 mapping
of class name to file name"
Smalltalk recursiveReadAllAbbreviationsFrom:self packageDirectory maxLevels:1.
"install autoloaded classes first,
some others may depend on them"
classNamesToAutoload do:[:eachClassName |
Smalltalk
installAutoloadedClassNamed:eachClassName
category:#autoloaded "FIXME"
package:self package
revision:nil
numClassInstVars:0. "FIXME"
].
classesWhichFailedToLoad := OrderedCollection new.
classNamesToLoad do:[:eachClassName |
|cls|
Error handle:[:ex |
"maybe, fileIn failed, because the load order is wrong.
Work around this by installing the class as autoloaded and
loading it"
classesWhichFailedToLoad add:eachClassName.
Smalltalk
installAutoloadedClassNamed:eachClassName
category:#autoloaded "FIXME"
package:self package
revision:nil
numClassInstVars:0. "FIXME"
] do:[
cls := Smalltalk
fileInClass:eachClassName
package:self package
initialize:false
lazy:false
silent:true.
cls notNil ifTrue:[
loadedClasses add:cls
].
].
].
classesWhichFailedToLoad do:[:eachClassName |
(Smalltalk at:eachClassName) autoload.
].
loadedClasses do:[:eachLoadedClass |
"do not initialize, if initialize method is inherited"
(eachLoadedClass theMetaclass implements:#initialize) ifTrue:[
eachLoadedClass initialize
].
].
^ true.
].
^ false.
"Created: / 17-08-2006 / 01:01:14 / cg"
"Modified: / 26-10-2006 / 12:30:01 / cg"
!
loadClassLibrary
"try to load a binary class library"
^ Smalltalk fileInClassLibrary:self libraryName inPackage:self package
!
loadExtensions
"load extension methods - do not load if they are already present"
self hasAllExtensionsLoaded ifFalse:[
Smalltalk loadExtensionsForPackage:self package.
^ true.
].
^ false.
"Created: / 17-08-2006 / 00:21:39 / cg"
!
loadPackages:aListOfPackages asAutoloaded:asAutoloaded
"load some packages (at least the projectDefinitions and their extensions).
If asAutoloaded == true, classes will be only installed as autoloaded."
Class withoutUpdatingChangesDo:[
aListOfPackages do:[:aPackage |
Smalltalk loadPackageWithId:aPackage asAutoloaded:asAutoloaded.
].
].
!
loadPreRequisitesAsAutoloaded:asAutoloaded
"load other packages (at least the projectDefinitions and their extensions)"
self loadPackages:(self preRequisites) asAutoloaded:asAutoloaded
!
loadSubProjectsAsAutoloaded:asAutoloaded
"load other packages (at least the projectDefinitions and their extensions)"
self loadPackages:(self subProjects) asAutoloaded:asAutoloaded
"Modified: / 25-10-2006 / 17:51:58 / cg"
! !
!ProjectDefinition class methodsFor:'queries'!
definitionClassForPackage: aPackageID
^ self definitionClassForPackage:aPackageID createIfAbsent:false
"Modified: / 17-08-2006 / 14:33:35 / cg"
!
definitionClassForPackage:aPackageID createIfAbsent:doCreateIfAbsent
^ self definitionClassForPackage:aPackageID createIfAbsent:doCreateIfAbsent projectType:nil
"Modified: / 23-08-2006 / 14:29:15 / cg"
!
definitionClassForPackage: aPackageID createIfAbsent: doCreateIfAbsent projectType:typeOrNil
|packageDefinitionClassName class|
packageDefinitionClassName := ProjectDefinition initialClassNameForDefinitionOf:aPackageID.
class := Smalltalk classNamed:packageDefinitionClassName.
class isNil ifTrue:[
doCreateIfAbsent ifTrue:[
class := self newForPackage:aPackageID.
"setup before prerequisites are defined"
class setupForType:typeOrNil.
].
] ifFalse:[
typeOrNil notNil ifTrue:[
class setupForType:typeOrNil.
].
].
^ class
"Created: / 23-08-2006 / 14:29:21 / cg"
"Modified: / 23-08-2006 / 15:35:26 / cg"
!
definitionClassForPackage:newProjectID projectType:typeOrNil createIfAbsent:createIfAbsent
^ (self definitionClassForType:typeOrNil)
definitionClassForPackage:newProjectID
createIfAbsent:createIfAbsent
projectType:typeOrNil
"Created: / 23-08-2006 / 14:28:53 / cg"
!
definitionClassForType: type
"answer the class that describes a give project type"
(type = LibraryType) ifTrue:[ ^ LibraryDefinition ].
(type = GUIApplicationType) ifTrue:[ ^ ApplicationDefinition ].
(type = NonGUIApplicationType) ifTrue:[ ^ ApplicationDefinition ].
(type = 'Application') ifTrue:[ ^ ApplicationDefinition ].
self error:'unknown project type'.
"Created: / 17-08-2006 / 14:46:28 / cg"
"Modified: / 23-08-2006 / 13:49:27 / cg"
!
hasAllClassesFullyLoaded
"return true, if all classes are present and loaded"
^ self hasAllClassesLoaded:true
"Created: / 25-10-2006 / 16:08:25 / cg"
!
hasAllClassesLoaded
"return true, if all classes are present (although, some might be autoloaded)"
^ self hasAllClassesLoaded:false
"Modified: / 25-10-2006 / 16:08:11 / cg"
!
hasAllClassesLoaded:checkIfFullyLoaded
"check if all classes for this platform are present.
If checkIfFullyLoaded is true, they must be fully loaded, that is not autoloaded"
^ (self
hasClasses:(self classNamesForWhich:[:nm :attr | attr isEmptyOrNil or:[ attr includes:#autoload]])
loaded:checkIfFullyLoaded)
and:[
self
hasClasses:(self compiled_classNamesForPlatform:OperatingSystem platformName)
loaded:checkIfFullyLoaded ]
"Modified: / 07-11-2006 / 11:47:30 / cg"
!
hasAllCompiledClassesFullyLoaded
"return true, if all compiled classes are present and loaded"
^ self hasAllCompiledClassesLoaded:true
"Created: / 07-11-2006 / 11:48:02 / cg"
!
hasAllCompiledClassesLoaded:checkIfFullyLoaded
"check if all compiled classes for this platform are present.
If checkIfFullyLoaded is true, they must be fully loaded, that is not autoloaded"
^ (self
hasClasses:(self classNamesForWhich:[:nm :attr | attr isEmptyOrNil])
loaded:checkIfFullyLoaded)
and:[
self
hasClasses:(self compiled_classNamesForPlatform:OperatingSystem platformName)
loaded:checkIfFullyLoaded
]
!
hasAllExtensionsLoaded
"answer true, if all extensions of this package have been loaded.
This is a query - so no side effects please"
self extensionMethodNames pairWiseDo:[:className :selector |
|cls|
cls := Smalltalk loadedClassNamed:className.
cls isNil ifTrue:[
"/ Transcript showCR:(self name,' missing extension class "',className,'".').
^ false
].
"there is no possibility that we installed an extension method in an unloaded class"
(cls isLoaded not or:[(cls compiledMethodAt:selector) isNil]) ifTrue:[
"/ Transcript showCR:(self name,' missing extension method "',className,'>>',selector,'".').
^ false
].
].
^ true.
"Created: / 17-08-2006 / 00:50:01 / cg"
"Modified: / 25-10-2006 / 00:01:10 / cg"
!
hasClasses:classNames loaded:checkIfFullyLoaded
"answer true, if all classes referenced by classNames have been loaded
into the image. If checkIfFullyLoaded, classes installed as autoloaded
are not considered"
classNames do:[:eachClassName |
|cls|
cls := Smalltalk loadedClassNamed:eachClassName.
cls isNil ifTrue:[
Transcript showCR:(self name,' missing: ',eachClassName).
^ false
].
(checkIfFullyLoaded and:[cls isLoaded not]) ifTrue:[
Transcript showCR:(self name,' unloaded: ',eachClassName).
^ false.
].
].
^ true
!
hasExtensionMethods
^ self extensionMethodNames notEmpty
"Created: / 14-09-2006 / 14:19:35 / cg"
!
isFullyLoaded
^ self hasAllCompiledClassesFullyLoaded and:[self hasAllClassesLoaded and:[self hasAllExtensionsLoaded]]
"Created: / 24-10-2006 / 23:52:23 / cg"
!
packageDirectory
^ Smalltalk getPackageDirectoryForPackage:self package.
"
self packageDirectory
stx_libbasic3 packageDirectory
"
! !
!ProjectDefinition class methodsFor:'sanity checks'!
validateDescription
|emptyProjects nonProjects emptyOrNonProjects|
emptyProjects := Set withAll:self subProjects.
Smalltalk allClassesDo:[:cls |
emptyProjects remove:(cls package) ifAbsent:[].
].
nonProjects := self subProjects select:[:p |
(ProjectDefinition definitionClassForPackage: p) isNil
].
emptyOrNonProjects := Set withAll:emptyProjects.
emptyOrNonProjects addAll:nonProjects.
emptyOrNonProjects notEmpty ifTrue:[
(Dialog
confirm:('The following projects are non-existent, empty or without description:\\ '
, ((emptyOrNonProjects
asSortedCollection
collect:[:p | p allBold])
asStringWith:'\ ')
, '\\Continue ?') withCRs
yesLabel:'OK' noLabel:'Cancel')
ifFalse:[
AbortSignal raise
].
].
"Modified: / 19-09-2006 / 20:30:39 / cg"
! !
!ProjectDefinition class methodsFor:'testing'!
isApplicationDefinition
^ false
"Created: / 23-08-2006 / 15:17:32 / cg"
"Modified: / 20-09-2006 / 14:59:56 / cg"
!
isGUIApplication
^ false
"Created: / 20-09-2006 / 14:59:49 / cg"
!
isLibraryDefinition
^ false
"Created: / 23-08-2006 / 15:17:46 / cg"
"Modified: / 20-09-2006 / 15:00:00 / cg"
!
isProjectDefinition
"concrete i.e. not abstract"
^ self ~~ ProjectDefinition
"Created: / 10-08-2006 / 16:24:02 / cg"
"Modified: / 23-08-2006 / 14:24:38 / cg"
! !
!ProjectDefinition class methodsFor:'documentation'!
version
^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.153 2007-03-01 19:28:31 cg Exp $'
! !
ProjectDefinition initialize!