"
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 (nt.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"
|pTop 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:architecture
architecture == #unix ifTrue:[
^ self pathSeparator_unix
].
architecture == #win32 ifTrue:[
^ self pathSeparator_win32
].
self error.
"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
"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
"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
"
! !
!ProjectDefinition class methodsFor:'code generation'!
classNamesAndAttributes_code_ignoreOldDefinition:ignoreOldDefinition
^ String streamContents:[:s |
s nextPutLine:'classNamesAndAttributes'.
s nextPutLine:' ^ #('.
s tab; nextPutLine:'"/ <className> or (<className> attributes...)'.
self searchForClasses do:[:eachClass |
|oldSpec attributes oldSpecEntry|
oldSpec := self classNamesAndAttributes.
(eachClass isLoaded not or:[eachClass isPrivate not]) ifTrue:[
oldSpecEntry := oldSpec detect:[:entry | entry first = eachClass name] ifNone:nil.
ignoreOldDefinition ifTrue:[
"/ take autoload attribute from current state
oldSpecEntry notNil ifTrue:[
attributes := oldSpecEntry copyFrom:2.
attributes := attributes copyWithout:#autoload.
] ifFalse:[
attributes := #()
].
eachClass isLoaded ifFalse:[
attributes isEmpty ifTrue:[
attributes := attributes , #( autoload ).
]
].
] ifFalse:[
"/ keep any existing attribute
oldSpecEntry notNil ifTrue:[
attributes := oldSpecEntry copyFrom:2.
] ifFalse:[
attributes := eachClass isLoaded ifTrue:[ #() ] ifFalse:[ #( autoload ) ].
].
].
s tab.
attributes isEmptyOrNil ifTrue:[
s nextPutAll:eachClass name asString storeString.
] ifFalse:[
s nextPutAll:'('; nextPutAll:eachClass name asString storeString.
attributes do:[:eachAttribute | s nextPutAll:' '. s nextPutAll:eachAttribute storeString.].
s nextPutAll:')'.
].
s cr.
]
].
s nextPutLine:' )'
].
"
stx_libbasic3 classNamesAndAttributes_code
"
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 17-08-2006 / 21:03:07 / cg"
"Modified: / 19-09-2006 / 17:14:17 / 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 nt.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
^ String streamContents:[:s |
s nextPutLine:'extensionMethodNames'.
s nextPutLine:' ^ #('.
self searchForExtensions do:[:eachMethod |
s nextPutAll:eachMethod mclass name storeString.
s nextPutAll:' '.
s nextPutLine: eachMethod selector storeString.
].
s nextPutLine:' )'
].
"
self extensionMethodNames_code
"
"Created: / 17-08-2006 / 21:21:48 / cg"
!
forEachContentsMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition
aTwoArgBlock
value:(self classNamesAndAttributes_code_ignoreOldDefinition:ignoreOldDefinition)
value:'description - contents'.
aTwoArgBlock
value: self extensionMethodNames_code
value: 'description - contents'.
aTwoArgBlock
value: self preRequisites_code
value: 'description'.
"Created: / 15-09-2006 / 16:47:54 / cg"
"Modified: / 20-09-2006 / 14:58:59 / cg"
!
forEachMethodsCodeToCompileDo:aTwoArgBlock
self forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:false
!
forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition
aTwoArgBlock
value:(self classNamesAndAttributes_code_ignoreOldDefinition:ignoreOldDefinition)
value:'description - contents'.
aTwoArgBlock
value: self extensionMethodNames_code
value: 'description - contents'.
(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: / 30-08-2006 / 19:04:11 / 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|
preRequisites := self preRequisites asSet.
preRequisites addAll: self searchForPreRequisites 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.
^ String streamContents:[:s |
s nextPutLine:'preRequisites'.
s nextPutLine:' ^ #('.
preRequisites asSortedCollection do:[:eachPackageID |
s nextPutLine:eachPackageID asString storeString
].
s nextPutLine:')'
].
"
bosch_dapasx_application preRequisites_code
demo_demoApp1 preRequisites_code
"
"Modified: / 08-08-2006 / 19:24:34 / fm"
"Created: / 17-08-2006 / 21:28:09 / cg"
"Modified: / 21-09-2006 / 17:37:28 / 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
"
!
defaultDescription
^ 'description'
!
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"
!
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
"a correponding method with real names is generated in my subclasses"
self halt.
^ #()
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 17-08-2006 / 20:47:20 / cg"
!
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"
!
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"
!
common_compiled_classNames
^ self classNamesForWhich:[:nm :attr | attr isEmptyOrNil].
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Created: / 21-08-2006 / 18:47:12 / 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_classNamesForArchitecture:architectureID
^ self
classNamesForWhich:[:nm :attr |
(attr includes:#autoload) not
and:[(attr includes:architectureID)]
].
"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_common
"class, only to be compiled under unix"
^ 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
classNamesForWhich:[:nm :attr |
attr includes:#unix
].
"Created: / 18-08-2006 / 13:37:51 / cg"
!
compiled_classNames_windows
"class, only to be compiled under windows"
^ self
classNamesForWhich:[:nm :attr |
attr includes:#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"
! !
!ProjectDefinition class methodsFor:'description - compilation'!
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
"allows for additional definitions/rules to be added to the nt.mak file."
^ ''
"Created: / 22-08-2006 / 23:59:32 / 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"
!
additionalRules_make_dot_proto
"allows for additional rules to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:59:16 / cg"
!
additionalRules_nt_dot_mak
"allows for additional rules to be added to the nt.mak file."
^ ''
"Created: / 22-08-2006 / 23:59:24 / cg"
!
additionalSharedLinkLibraries_make_dot_proto
"allows for additional shared libraries to be added to the make.proto file."
^ ''
!
additionalTargets_make_dot_proto
"allows for additional targets to be added to the make.proto file."
^ ''
"Created: / 22-08-2006 / 23:53:33 / cg"
!
additionalTargets_nt_dot_mak
"allows for additional targets to be added to the nt.mak file."
^ ''
"Created: / 23-08-2006 / 00:00:35 / cg"
!
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 nt.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"
^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"
!
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'
].
^ 'My Product'
"Modified: / 18-08-2006 / 16:08:26 / 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'
].
^ 'http://www.yoursite.com'
"Created: / 14-09-2006 / 21:15:05 / 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 nt.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
^ 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:'unknownPackage'; 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:(cls 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: / 23-08-2006 / 16:49:42 / cg"
!
generate_bc_dot_def
^self replaceMappings: self bc_dot_def_mappings
in: self bc_dot_def
"
DapasXProject generate_bc_dot_def
DapasX_Datenbasis generate_bc_dot_def
"
"Modified: / 09-08-2006 / 11:30:42 / 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 common_compiled_classNames.
classesLoaded := classNames
collect:[:nm | |cls| cls := 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 classFilename asFilename baseName, ''''.
].
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 classFilename]].
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"
!
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_nt_dot_def
^self replaceMappings: self nt_dot_def_mappings
in: self nt_dot_def
"
DapasXProject generate_nt_dot_def
DapasX_Datenbasis generate_nt_dot_def
"
"Modified: / 09-08-2006 / 11:31:21 / fm"
!
generate_nt_dot_mak
^ (self
replaceMappings: self nt_dot_mak_mappings
in: self nt_dot_mak) asStringCollection withTabs asString
"
DapasXProject generate_nt_dot_mak
DapasX_Datenbasis generate_nt_dot_mak
"
"Modified: / 09-08-2006 / 11:46:14 / fm"
!
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"
!
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'!
bmake_dot_mak
"the template code for the bmake.bat file"
^
'%(SUBPROJECT_BMAKE_CALLS)
make.exe -N -f nt.mak %%1 %%2
'
"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"
"try to load a binary class library first.
If this fails, classes are filed in, as well as classes not present
in the class library"
self loadClassLibrary.
self loadExtensions.
self loadAllClasses.
"Created: / 17-08-2006 / 01:01:41 / cg"
!
loadAllClasses
|loadedClasses loadClass|
loadedClasses := OrderedCollection new.
loadClass := [:className |
|cls|
cls := Smalltalk at:className asSymbol.
(cls isNil or:[cls isLoaded not]) ifTrue:[
cls := Smalltalk
fileInClass:className
package:self package
initialize:false
lazy:false
silent:false.
cls notNil ifTrue:[
loadedClasses add:cls
].
].
].
self allClassNames do:loadClass.
OperatingSystem isUNIXlike ifTrue:[
self compiled_classNames_unix do:loadClass.
] ifFalse:[
OperatingSystem isMSWINDOWSlike ifTrue:[
self compiled_classNames_windows do:loadClass.
] ifFalse:[
self error:'unknown OS'
].
].
loadedClasses do:[:each |
(each theMetaclass implements:#initialize) ifTrue:[
each initialize
].
].
"Created: / 17-08-2006 / 01:01:14 / cg"
"Modified: / 30-08-2006 / 18:32:56 / cg"
!
loadClassLibrary
"try to load a binary class library"
(Smalltalk fileInClassLibrary:self libraryName inPackage:self package) 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 classFilename]].
"/ files := files \ loaded.
"/ ].
].
!
loadExtensions
"load extension methods - do not load if they are already present"
self hasAllExtensionsLoaded ifFalse:[
Smalltalk loadExtensionsForPackage:self package.
].
"Created: / 17-08-2006 / 00:21:39 / cg"
!
postAutoload
self hasExtensionMethods ifTrue:[
self loadExtensions
].
"Created: / 17-08-2006 / 00:21:29 / cg"
"Modified: / 14-09-2006 / 14:20:33 / cg"
! !
!ProjectDefinition class methodsFor:'mappings'!
bc_dot_def_mappings
^ (Dictionary new)
at:'DESCRIPTION'
put:[
|d|
d := self description.
(d isEmptyOrNil ifTrue:[ self defaultDescription ] ifFalse:[ d ]) storeString.
];
yourself
"Created: / 09-08-2006 / 11:17:59 / fm"
"Modified: / 14-09-2006 / 18:51:17 / 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_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"
!
nt_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 ).
^ d
"Created: / 18-08-2006 / 11:43:39 / cg"
"Modified: / 14-09-2006 / 20:20:19 / cg"
!
objectLine_make_dot_spec_mappings: aClassName
^ Dictionary new
at: 'CLASSFILE'
put: ( (Smalltalk classNamed:aClassName) classFilename asFilename withoutSuffix baseName );
yourself
"Created: / 08-08-2006 / 20:17:28 / fm"
"Modified: / 09-08-2006 / 18:26:52 / fm"
"Modified: / 14-09-2006 / 18:51:49 / 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'!
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 common_compiled_classNames.
classesLoaded := classNames
collect:[:nm | |cls| cls := 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]].
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 :id|
|archClassNames archClassesLoaded|
archClassNames := self compiled_classNamesForArchitecture:id.
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 classesLoaded classesSorted classNamesSorted putDependencyForClass
archClassNames archClassesLoaded putSingleClassDependencyEntry putDependencyForExtensions|
putSingleClassDependencyEntry :=
[: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)'.
].
putDependencyForClass :=
[: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'.
already := Set new.
cls allSuperclassesDo:[:scls |
putSingleClassDependencyEntry value:scls.
already add:scls.
].
cls privateClassesDo:[:eachPrivateClass |
eachPrivateClass allSuperclassesDo:[:scls | |sclsBaseName|
scls ~~ cls ifTrue:[
scls isPrivate ifFalse:[
(already includes:scls) ifFalse:[
putSingleClassDependencyEntry value:scls.
already add:scls.
].
].
].
]
].
s nextPutAll:' $(STCHDR)'.
s cr.
].
putDependencyForExtensions :=
[
|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 allSuperclassesDo:[:scls |
(already includes:scls) ifFalse:[
putSingleClassDependencyEntry value:scls.
already add:scls.
].
].
].
].
].
s nextPutAll:' $(STCHDR)'.
s cr.
].
classNames := self common_compiled_classNames.
classesLoaded := classNames
collect:[:className | |cls| cls := Smalltalk classNamed:className]
thenSelect:[:cls | cls notNil and:[cls isLoaded] ].
classesSorted := Class classesSortedByLoadOrder:classesLoaded.
classesSorted do:putDependencyForClass.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:className :attr |
|cls|
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
((cls := Smalltalk classNamed:className) notNil and:[cls isLoaded]) ifTrue:[
putDependencyForClass value:cls.
]
].
].
archClassNames := self compiled_classNamesForArchitecture:whichArchitecture.
archClassesLoaded := archClassNames
collect:[:className | |cls| cls := Smalltalk classNamed:className]
thenSelect:[:cls | cls notNil and:[cls isLoaded] ].
archClassesLoaded notEmpty ifTrue:[
(Class classesSortedByLoadOrder:archClassesLoaded) do:putDependencyForClass.
].
self hasExtensionMethods ifTrue:putDependencyForExtensions.
]
"
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: / 14-09-2006 / 17:04:21 / 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: / 14-09-2006 / 15:38:16 / 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: / 14-09-2006 / 15:37:35 / 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 sysDepOrNil|
putLineForClass :=
[:eachClass |
|mappings newObjectLine|
mappings := self objectLine_make_dot_spec_mappings: eachClass name.
newObjectLine := self replaceMappings: mappings in: self objectLine_make_dot_spec.
s nextPutLine:newObjectLine.
].
sysDepOrNil := nil.
OperatingSystem knownPlatformNames do:[:platformID |
|define prefix depClasses|
define := OperatingSystem platformDefineForPlatformName:platformID.
prefix := define copyFrom:('-D' size + 1).
depClasses := self compiled_classesForArchitecture:platformID.
depClasses topologicalSort:sorter.
depClasses notEmpty ifTrue:[
sysDepOrNil := prefix,'_OBJS'.
s nextPutLine:sysDepOrNil,'= \'.
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: / 14-09-2006 / 16:21:46 / 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 |
aClass methodsDo:[: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 ', aClass name,'>>',method name)
]
]
]
].
!
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| (Smalltalk at:eachName asSymbol)]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
!
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_classNamesForArchitecture:arch) collect:[:eachName| (Smalltalk at:eachName asSymbol)]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
!
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
^ (self searchForClassesWithProject: self package)
asOrderedCollection sort:[:a :b | a name < b name]
"
self 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
"
"Modified: / 09-08-2006 / 13:01:26 / fm"
"Created: / 17-08-2006 / 21:17:46 / cg"
!
searchForExtensionsWithProject:aProjectID
"search for any class which has extensions from aProjectID.
Return the extension-methods"
|methods|
methods := OrderedCollection new.
Smalltalk allClassesDo:[:eachClass |
|classPackage|
classPackage := eachClass package.
classPackage ~= aProjectID ifTrue:[
eachClass instAndClassMethodsDo:[:mthd |
|methodsPackage|
methodsPackage := mthd package.
methodsPackage ~= classPackage ifTrue:[
methodsPackage = aProjectID ifTrue:[
methods add:mthd
]
].
].
].
].
"/ methods
"/ sort:[:m1 :m2 |
"/ |c1 c2|
"/
"/ c1 := m1 mclass theNonMetaclass.
"/ c2 := m2 mclass theNonMetaclass.
"/ c1 name < c2 name
"/ ].
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'
"
"Created: / 17-08-2006 / 21:19:04 / cg"
"Modified: / 15-09-2006 / 16:56:57 / cg"
!
searchForPreRequisites
|includedClasses requiredPackageReasons usedClassReasons allSubProjects|
requiredPackageReasons := Dictionary new.
usedClassReasons := Dictionary new.
includedClasses := Set new.
includedClasses addAll:(self searchForClassesWithProject:self package).
self subProjects do:[:projectID |
includedClasses addAll: (self searchForClassesWithProject: projectID asSymbol)
].
"/ only search for locals referred to by my methods (assuming that superclasses'
"/ requisites are specifief in their package.
self addReferencesToClassesFromGlobalsIn:includedClasses to:usedClassReasons.
includedClasses do:[:cls |
cls allSuperclassesDo:[:superClass |
(usedClassReasons at: superClass ifAbsentPut:[Set new])
add: (superClass name, ' - Superclass of ', cls name).
]
].
includedClasses addAll: (usedClassReasons keys).
allSubProjects :=
(self siblingsAreSubProjects)
ifTrue:[ self searchForSiblingProjects ]
ifFalse:[ self searchForSubProjects ].
usedClassReasons
keysAndValuesDo:[:usedClass :reasonsPerClass |
(allSubProjects includes: usedClass package asString)
ifFalse:[
usedClass package == Project noProjectID
ifFalse:[(requiredPackageReasons at:usedClass package ifAbsentPut:[Set new])
addAll:reasonsPerClass.]
].
].
"/ Transcript showCR:requiredPackageReasons.
^requiredPackageReasons
"
self searchForPreRequisites
bosch_dapasx_Application searchForPreRequisites
cg_testproject1 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: / 09-08-2006 / 16:26:37 / fm"
"Modified: / 19-09-2006 / 20:57:54 / cg"
!
searchForSiblingProjects
|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
|myPackage|
myPackage := self package.
^ Smalltalk allProjectIDs select:[:projectID |
(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: / 23-08-2006 / 15:11:50 / 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:'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
(type = GUIApplicationType) ifTrue:[ ^ ApplicationDefinition ].
(type = NonGUIApplicationType) ifTrue:[ ^ ApplicationDefinition ].
(type = LibraryType) ifTrue:[ ^ LibraryDefinition ].
(type = 'Application') ifTrue:[ ^ ApplicationDefinition ].
self error.
"Created: / 17-08-2006 / 14:46:28 / cg"
"Modified: / 23-08-2006 / 13:49:27 / cg"
!
hasAllClassesLoaded
|checkLoaded|
checkLoaded := [:nm |
|cls|
cls := Smalltalk classNamed:nm.
(cls isNil or:[cls isLoaded not]) ifTrue:[^ false ].
].
self allClassNames do:checkLoaded.
OperatingSystem isUNIXlike ifTrue:[
self compiled_classNames_unix do:checkLoaded.
] ifFalse:[
OperatingSystem isMSWINDOWSlike ifTrue:[
self compiled_classNames_windows do:checkLoaded.
] ifFalse:[
self error:'unknown OS'
].
].
^ true.
"Created: / 17-08-2006 / 00:50:01 / cg"
"Modified: / 18-08-2006 / 13:44:31 / cg"
!
hasAllExtensionsLoaded
self extensionMethodNames pairWiseDo:[:className :selector |
|cls|
cls := Smalltalk at:className asSymbol.
(cls isNil or:[cls isLoaded not]) ifTrue:[^ false ].
(cls compiledMethodAt:selector) isNil ifTrue:[^ false ].
].
^ true.
"Created: / 17-08-2006 / 00:50:01 / cg"
!
hasExtensionMethods
^ self extensionMethodNames notEmpty
"Created: / 14-09-2006 / 14:19:35 / cg"
! !
!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.79 2006-09-21 15:36:28 cg Exp $'
! !
ProjectDefinition initialize!