"
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 projectIsLoaded'
"
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'!
allPreRequisites
"answer all (recursive) prerequisite project ids of myself - in random order.
If we exclude a project, but one of our prerequisite projects depends on it, "
|setOfAllPreRequisites toAdd|
setOfAllPreRequisites := Set new.
toAdd := Set new.
toAdd addAll:self effectivePreRequisites.
"are subprojects really a prerequisite??
I think, they are not, so this line should be deleted.
Unfortunately the meaning of 'subproject' has never been defined. SV."
toAdd addAll:self effectiveSubProjects.
[toAdd notEmpty] whileTrue:[
|aPreRequisiteProjectID def|
aPreRequisiteProjectID := toAdd removeFirst.
(setOfAllPreRequisites includes:aPreRequisiteProjectID) ifFalse:[
setOfAllPreRequisites add:aPreRequisiteProjectID.
def := self definitionClassForPackage:aPreRequisiteProjectID.
def isNil ifTrue:[
Transcript showCR:'ProjectDefinition ', aPreRequisiteProjectID, ' is missing - cannot find its preRequisites.'.
] ifFalse:[
def effectivePreRequisites
select:[:eachSubPreRequisite | (setOfAllPreRequisites includes:eachSubPreRequisite) not]
thenDo:[:eachSubPreRequisite |
Transcript showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
toAdd add:eachSubPreRequisite ].
def effectiveSubProjects
select:[:eachSubSubRequisite | (setOfAllPreRequisites includes:eachSubSubRequisite) not]
thenDo:[:eachSubSubRequisite |
Transcript showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
toAdd add:eachSubSubRequisite ].
].
]
].
^ setOfAllPreRequisites.
"
stx_libbasic allPreRequisites
stx_libbasic2 allPreRequisites
stx_libview2 allPreRequisites
ubs_application allPreRequisites
ubs_application allPreRequisitesSorted
exept_expeccoNET_application allPreRequisites
alspa_batch_application allPreRequisites
"
!
allPreRequisitesSorted
"answer all the prerequisites of this projects sorted in
the order they are needed.
Use this to e.g. compile packages in the dependency order"
|allPreRequisites orderedTuples effective|
orderedTuples := OrderedCollection new.
allPreRequisites := self allPreRequisites.
allPreRequisites do:[:eachPackageID |
|def|
def := self definitionClassForPackage:eachPackageID.
def isNil ifTrue:[
Transcript showCR:'Warning: no definition class for package: ', eachPackageID.
orderedTuples add:(Array with:eachPackageID).
] ifFalse:[
effective := def effectivePreRequisites.
effective isEmptyOrNil ifTrue:[
orderedTuples add:(Array with:eachPackageID).
] ifFalse:[
effective do:[:eachPrerequisitePackageID|
orderedTuples add:(Array with:eachPrerequisitePackageID with:eachPackageID).
].
].
].
].
^ orderedTuples topologicalSort.
"
stx_libbasic allPreRequisitesSorted
stx_libbasic2 allPreRequisitesSorted
stx_libwidg2 allPreRequisitesSorted
exept_expecco_application allPreRequisitesSorted
alspa_batch_application allPreRequisitesSorted
ubs_application allPreRequisitesSorted
"
!
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"
!
moduleDirectory_win32For: projectID
^(self moduleDirectoryFor:projectID) copy replaceAll:$/ with:$\
"
self moduleDirectory_win32For: #'bosch:dapasx/pav_vergleich'
self moduleDirectory_win32For: #'stx:goodies/xml/stx'
self moduleDirectory_win32For: #'stx:libbasic2'
"
!
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|
parts1 := fromPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
parts2 := toPackageID asCollectionOfSubstringsSeparatedByAny:':/'.
common := parts1 commonPrefixWith:parts2.
up := ((1 to:parts1 size - common size) collect:[:p | '..']) asStringWith:'\'.
down := (parts2 copyFrom:common size+1) asStringWith:'\'.
up isEmpty ifTrue:[
down isEmpty ifTrue:[^ '.'].
^ down.
].
down isEmpty ifTrue:[
^ up.
].
^ up, '\', down
"
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'
self msdosPathToPackage:'exept:expecco' from:'exept:expecco/application'
self msdosPathToPackage:'exept:expecco/application' from:'exept:expecco'
"
"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
"
stx_libwidg2 packageName
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"
|rel|
aPackageID asPackageId module = self package asPackageId module ifTrue:[
^ self unixPathToPackage:aPackageID from:self package
].
rel := self topRelativePathToPackage_unix:aPackageID.
(rel startsWith:'stx/') ifTrue:[
^ '$(TOP)/', (rel copyFrom:'stx/' size + 1).
] ifFalse:[
^ '$(TOP)/../', rel
]
"
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"
|rel|
aPackageID asPackageId module = self package asPackageId module ifTrue:[
^ self msdosPathToPackage:aPackageID from:self package
].
rel := self topRelativePathToPackage_win32:aPackageID.
(rel startsWith:'stx\') ifTrue:[
^ '$(TOP)\', (rel copyFrom:'stx\' size + 1).
] ifFalse:[
^ '$(TOP)\..\', rel
]
"
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"
!
projectIsLoaded
"answer true, if this project is completely loaded into the image"
projectIsLoaded isNil ifTrue:[
projectIsLoaded := false.
].
^ projectIsLoaded
"
stx_libbasic projectIsLoaded
"
!
projectIsLoaded:something
projectIsLoaded := something.
something == true ifTrue:[
"register myself as dependent - I want to get notified on method changes"
self class addDependent:self.
].
!
requiredProjects
^ self effectivePreRequisites , 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"
|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_unix:toPackageID).
(rel startsWith:'stx/') ifTrue:[
^ '$(TOP)', (rel copyFrom:'stx/' size)
].
^ '$(TOP)/../', rel.
"/ pTop := self unixPathToTopFor:fromPackageID.
"/ (pTop endsWith:'/stx') ifTrue:[
"/ pTop := pTop copyButLast:'stx' size.
"/ ] ifFalse:[
"/ pTop isEmpty ifTrue:[
"/ pTop := '../'.
"/ ] ifFalse:[
"/ pTop := pTop, '/../'.
"/ ].
"/ ].
"/ ^ pTop, (self topRelativePathToPackage_unix:toPackageID)
"
self unixPathToPackage:'bosch:dapasx/kernel' from:'bosch:dapasx/application'
self unixPathToPackage:'stx:libbasic' from:'bosch:dapasx/application'
self unixPathToPackage:'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:[
Error handle:[:ex |
('ProjectDefinition [warning]: failed to install autoloaded: ',className) errorPrintCR
] do:[
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'!
applicationIconFileName_code
^ String streamContents:[:s |
s nextPutLine:'applicationIconFileName'.
s nextPutLine:' "Return the name (without suffix) of an icon-file (the app''s icon); will be included in the rc-resource file"'.
s cr;
nextPutLine:' ^ nil';
nextPutLine:' "/ ^ self applicationName'.
].
"
self legalCopyright_code
stx_libbasic3 legalCopyright_code
"
"Created: / 18-08-2006 / 16:21:01 / cg"
!
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"
!
effectivePreRequisites
"get the preRequisites, that are not excluded"
|preRequisites|
preRequisites := self preRequisites asSet.
preRequisites removeAllFoundIn:self excludedFromPreRequisites.
preRequisites remove:self package ifAbsent:[].
^ preRequisites
!
effectiveSubProjects
"get the subProjects, that are not excluded"
|subProjects|
subProjects := self subProjects asSet.
subProjects removeAllFoundIn:self excludedFromSubProjects.
subProjects remove:self package ifAbsent:[].
^ subProjects
!
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.
(mclassName endsWith:' class') ifTrue:[
mclassName := mclassName asString.
].
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'.
].
(self class implements:#applicationIconFileName) ifFalse:[
aTwoArgBlock
value: self applicationIconFileName_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
"generate the code of the #preRequisites method"
|preRequisites searchedPreRequisites importantReason|
"maybe, some prerequisites have been added manually - keep them
The drawback of this - a preRequisite will never go away, even if it is no longer used"
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 removeAllFoundIn:self excludedFromPreRequisites.
preRequisites remove:self package ifAbsent:[].
^ String streamContents:[:s |
s nextPutLine:'preRequisites'.
s nextPutLine:' ^ #('.
preRequisites asSortedCollection do:[:eachPackageID |
|reason|
s spaces:8.
eachPackageID asSymbol storeOn:s.
reason := searchedPreRequisites at:eachPackageID ifAbsent:nil.
reason notEmptyOrNil ifTrue:[
"superclasses are really important"
importantReason := reason detect:[:eachReasonString|
eachReasonString includesString:' superclass '
] ifNone:[reason anElement].
s nextPutAll:' "'; nextPutAll:importantReason; nextPutAll:' "'.
].
s cr.
].
s nextPutLine:' )'
].
"
bosch_dapasx_application preRequisites_code
demo_demoApp1 preRequisites_code
stx_libbasic3 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
"
!
defaultCategory
^'* Projects & Packages *'
"Created: / 11-08-2006 / 14:16:49 / cg"
!
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
!
splashFileName
"answer the base-name of the splash bitmap.
Default is nil, for no splash. If non-nil, it must be a bmp file's name"
^ nil.
!
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 ].
!
autoloaded_classNames
^ self classNamesForWhich:[:nm :attr | attr notEmptyOrNil and:[attr includes:#autoload]].
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Created: / 30-08-2007 / 18:48:09 / cg"
!
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
"answer the classes to be compiled only for the current platformName"
^ self compiled_classNamesForPlatform:OperatingSystem platformName
!
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.
Subclasses 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"
!
globalDefines
"allow for the specification of additional defines for stc compilation of prerequisite packages
an subprojects"
^ ''
!
globalDefines_unix
"allow for the specification of additional defines for stc compilation of prerequisite packages
an subprojects"
^ self globalDefines
!
globalDefines_win32
"allow for the specification of additional defines for stc compilation of prerequisite packages
an subprojects"
^ self globalDefines
!
localDefines
"allow for the specification of additional defines for stc compilation"
^ ''
!
localDefines_unix
"allow for the specification of additional defines for stc compilation"
^ self localDefines
!
localDefines_win32
"allow for the specification of additional defines for stc compilation"
^ self localDefines
!
localIncludes
"allow for the specification of additional include directories"
^ ''
"Created: / 06-09-2006 / 18:14:31 / cg"
!
localIncludes_unix
"allow for the specification of additional 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 additional include directories"
^ self makeWin32Includes:(self localIncludes)
"Created: / 18-08-2006 / 12:50:27 / cg"
"Modified: / 06-09-2006 / 18:15:37 / cg"
!
primaryTarget
"allows the primary make target to be defined in the Make.proto/bc.mak file."
^ ''
"Created: / 22-08-2006 / 23:53:33 / cg"
!
primaryTarget_bc_dot_mak
"allows the primary make target to be defined in the bc.mak file."
^ self primaryTarget
"Created: / 22-08-2006 / 23:53:33 / cg"
!
primaryTarget_make_dot_proto
"allows the primary make target to be defined in the Make.proto file."
^ self primaryTarget
"Created: / 22-08-2006 / 23:53:33 / 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'!
applicationIconFileName
"Return the icon-filename for the application (nil if there is none)"
^ nil
!
companyName
"Returns a company string which will appear in <lib>.rc.
Under win32, this is placed into the dlls file-info"
(
#(
'stx'
'exept'
) includes:self module) 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"
^ self majorVersionNr
"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"
^ self minorVersionNr
"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,
but ignore a possibly present 'm'-flag that is set when this revision has been modified"
^ self cvsRevision last upTo:$m
"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') "
^ '%1.%2.%3.%4'
bindWith:self fileMajorVersionNr
with:self fileMinorVersionNr
with:self fileRevisionNr
with: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') "
^ '%1,%2,%3,%4'
bindWith:self fileMajorVersionNr
with:self fileMinorVersionNr
with:self fileRevisionNr
with:self fileReleaseNr.
"Created: / 17-08-2006 / 20:16:17 / cg"
"Modified: / 30-08-2006 / 18:54:20 / cg"
!
internalName
"Returns a name string which will appear in libName.rc"
^ self package
"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
"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
"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 and the installer file"
"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"
|m|
m := self module.
m = 'stx' ifTrue:[
^ 'Smalltalk/X'
].
m = 'exept' ifTrue:[
^ 'eXept addOns'
].
Error handle:[:ex |
^ 'ProductName'
] do:[
^ self startupClassName
].
"Modified: / 08-11-2007 / 16:45:14 / 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 and the installer file"
"<major>.<minor>.<revision>.<release> (such as '5.3.2.1')"
^ '%1.%2.%3.%4'
bindWith:self majorVersionNr
with:self minorVersionNr
with:self revisionNr
with: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') "
^ '%1,%2,%3,%4'
bindWith:self majorVersionNr
with:self minorVersionNr
with:self revisionNr
with:self releaseNr.
"
self productVersionCommaSeparated
"
"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
"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
"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
"answer a dictionary (filename -> generator method) with all the files, that have to be generated for this
package"
|dict|
dict := Dictionary withKeysAndValues:#(
'Make.spec' #'generate_make_dot_spec'
'Make.proto' #'generate_make_dot_proto'
'bc.mak' #'generate_bc_dot_mak'
'abbrev.stc' #'generate_abbrev_dot_stc'
'bmake.bat' #'generate_bmake_dot_mak'
).
dict
at:self rcFilename put:#'generate_packageName_dot_rc'.
^ dict.
!
fileNamesToGenerate
"answer the files that have to be generated"
^ self basicFileNamesToGenerate removeAllKeys:self protectedFileNames ifAbsent:[]
"
stx_libbasic fileNamesToGenerate
"
!
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
self fileNamesToGenerate keysAndValuesDo:aTwoArgBlock
"Modified: / 14-09-2006 / 21:02:37 / cg"
!
generateFile:filename
|action|
action := self basicFileNamesToGenerate at:filename ifAbsent:[].
action notNil ifTrue:[
^ self perform:action
].
(filename = 'app.rc' or:[filename = 'lib.rc']) ifTrue:[
^ self generate_packageName_dot_rc
].
(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
|someNilClassesName check|
check :=
[:eachClassName |
|cls fn wasLoaded failedToLoad numClassInstvars|
cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
Transcript showCR:eachClassName.
someNilClassesName := eachClassName.
].
].
self allClassNames do:check.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
check value:nm
].
].
someNilClassesName notNil ifTrue:[
(Dialog confirm:(Dialog classResources
stringWithCRs:'"%1" and possibly more classes are missing.\Cannot generate a correct "abbrev.stc" file.\\Continue anyway?'
with:someNilClassesName allBold))
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 := (self filenameForClassNamed: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:' ''' , (self filenameForClassNamed:nm) asFilename baseName, ''''.
].
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
s nextPutLine:' ''' , (self filenameForClassNamed: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_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"
!
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.
Only needed for WIN"
^ 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_proto
"the template code for the make.proto file"
^ self subclassResponsibility
!
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.
Only used for WIN"
^
'//
// 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|
self projectIsLoaded ifTrue:[^ false].
thisContext isRecursive ifTrue:[^ false].
newStuffHasBeenLoaded := false.
(self 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.
].
self projectIsLoaded:true.
self postLoadAction.
^ 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: 'PRIMARY_TARGET' put: (self primaryTarget_bc_dot_mak);
at: 'ADDITIONAL_DEFINITIONS' put: (self additionalDefinitions_bc_dot_mak);
at: 'ADDITIONAL_RULES' put: (self additionalRules_bc_dot_mak);
at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_bc_dot_mak);
at: 'ADDITIONAL_LINK_LIBRARIES' put: (self additionalLinkLibraries_bc_dot_mak);
at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_win32);
at: 'LOCAL_DEFINES' put: self localDefines_win32;
at: 'GLOBAL_DEFINES' put: self globalDefines_win32;
at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_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"
!
filenameForClassNamed:className
|class|
class := Smalltalk classNamed:className.
class notNil ifTrue:[
"/ the actual name
^ class classFilename asFilename withoutSuffix baseName
] ifFalse:[
"/ the expected name
^ Smalltalk fileNameForClass:className
].
"Created: / 08-08-2006 / 20:17:28 / fm"
"Modified: / 09-08-2006 / 18:26:52 / fm"
"Modified: / 20-10-2006 / 16:22:58 / 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: 'GLOBAL_DEFINES' put: self globalDefines_unix;
at: 'COMMONSYMFLAG' put: (self commonSymbolsFlag);
at: 'HEADEROUTPUTARG' put: (self headerFileOutputArg);
at: 'PRIMARY_TARGET' put: (self primaryTarget_make_dot_proto);
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);
at: 'MODULE' put: ( self module );
at: 'MODULE_DIRECTORY' put: ( self moduleDirectory );
at: 'MODULE_PATH' put: ( self moduleDirectory );
at: 'MAKE_PREREQUISITES' put: (self generateRequiredMakePrerequisites_make_dot_proto);
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
^ Dictionary new
at: 'CLASSFILE' put:(self filenameForClassNamed:aClassName);
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 applicationIconFileName.
s notNil ifTrue:[
d at: #'ICONDEFINITION_LINE' put: 'IDR_MAINFRAME ICON DISCARDABLE "',s,'.ico"'
].
s := self splashFileName.
s notNil ifTrue:[
d at: #'SPLASHDEFINITION_LINE' put: 'IDR_SPLASH BITMAP DISCARDABLE "',s,'.bmp"'
].
^ 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 clsBaseName putDependencyForClassBlock
putDependencyForClassBaseNameBlock
archClassNames archClassesPresent 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)'.
].
putDependencyForClassBaseNameBlock := [:clsBaseName |
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'.
].
putDependencyForClassBlock := [:cls |
|clsBaseName already|
clsBaseName := cls classFilename asFilename withoutSuffix baseName.
putDependencyForClassBaseNameBlock value:clsBaseName.
cls isLoaded ifTrue:[
already := IdentitySet new.
cls
allSuperclassesDo:[:scls |
putSingleClassDependencyEntryBlock value:scls.
already add:scls.
].
cls
allPrivateClassesDo:[: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].
(Class classesSortedByLoadOrder:classesLoaded) 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.
archClassesPresent := archClassNames
collect:[:className | Smalltalk classNamed:className]
thenSelect:[:cls | cls notNil].
archClassesLoaded := archClassesPresent
select:[:cls | cls isLoaded].
(Class classesSortedByLoadOrder:archClassesLoaded) do:putDependencyForClassBlock.
"some classes are not loaded - probably this is the wrong architecture.
Sorry, but for these classes, we do not know the superclass chain"
archClassesPresent
select:[:cls | cls isLoaded not]
thenDo:putDependencyForClassBlock.
"for the following classes, we do not know the superclass chain
and neither the real class file name"
archClassNames
select:[:eachClassName | (Smalltalk classNamed:eachClassName) isNil]
thenDo:[:eachClassName |
putDependencyForClassBaseNameBlock value:(eachClassName copyReplaceAll:$: with:$_).
s nextPutLine:' $(STCHDR)'.
].
self hasExtensionMethods ifTrue:putDependencyForExtensionsBlock.
]
"
stx_libbasic3 generateDependencies:#unix
stx_libbasic3 generateDependencies:#win32
"
"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)',(self filenameForClassNamed: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"
!
generateRequiredMakePrerequisites_bc_dot_mak
|myProjectId|
^ String streamContents:[:s |
myProjectId := self package.
"Note: the trailing blank in 'CFLAGS_LOCAL=$(GLOBALDEFINES) '
is required!!
Use 'pushd' instead of 'cd', since cd is executed by borland make directly.
'popd' is not needed, since each line is executed in
an own cmd.exe process.
'popd' is not desireable, since it masks a possible
error return from the 'bmake'.
"
(self allPreRequisitesSorted copyWith:'stx:librun') do:[:eachProjectId |
s tab; nextPutAll:'pushd ';
nextPutAll:(self msdosPathToPackage:eachProjectId from:myProjectId);
nextPutLine:' & bmake "CFLAGS_LOCAL=$(GLOBALDEFINES) "'.
].
].
"
exept_expecco_application generateRequiredMakePrerequisites_bc_dot_mak
alspa_batch_application generateRequiredMakePrerequisites_bc_dot_mak
"
!
generateRequiredMakePrerequisites_make_dot_proto
|libPath|
^ String streamContents:[:s |
(self allPreRequisitesSorted copyWith:'stx:librun') do:[:projectID |
libPath := self pathToPackage_unix:projectID.
s tab; nextPutAll: '(cd ', libPath; nextPutLine:' ; $(MAKE))'.
].
s cr.
].
"
exept_expecco_application generateRequiredMakePrerequisites_make_dot_proto
alspa_batch_application generateRequiredMakePrerequisites_make_dot_proto
"
!
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'!
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 |
|cls|
cls := (Smalltalk at:eachName asSymbol).
cls isNil ifTrue:[
self warn:'Missing class: ',eachName.
].
cls
]
thenSelect:[:cls| cls notNil "isBehavior"]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
"Modified: / 09-11-2007 / 17:37:39 / cg"
!
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 := Smalltalk allExtensionsForPackage: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"
!
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 allPrivateClassesDo:[: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"
"Modified: / 09-11-2007 / 17:38:02 / 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.
self packageDirectory isNil ifTrue:[
self
error:(self name,'[error] cannot install because packageDirectory is unknown')
mayProceed:true.
^ false.
].
"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
Return true if ok, false if not."
|libraryName|
libraryName := self libraryName.
(Smalltalk isClassLibraryLoaded:libraryName) ifTrue:[
"already loaded"
^ true
].
^ Smalltalk fileInClassLibrary: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 effectivePreRequisites) 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"
!
update:anAspectSymbol with:argument from:changedObject
"when any of my class methods is changed, we mark the project as unloaded.
May be some mor classes have to be loaded"
(changedObject == self class and:[anAspectSymbol == #methodDictionary]) ifTrue:[
self projectIsLoaded:false.
]
! !
!ProjectDefinition class methodsFor:'private-prerequisites'!
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 |
|resources|
resources := method resources.
(resources isNil
or:[ ((resources includesKey:#'ignoreInPrerequisites') not
and:[(resources includesKey:#'example') not])])
ifTrue:[
method usedGlobals
do:[:global |
|globalsName usedClass|
globalsName := global asSymbol.
usedClass := Smalltalk at:globalsName.
(usedClass notNil and:[usedClass isClass and:[usedClass isNameSpace not]]) ifTrue:[
usedClass name == globalsName ifTrue:[ "/ skip aliases
(usedClassReasons at:usedClass ifAbsentPut:[Set new])
add:(usedClass name, ' - referenced by ', method mclass name,'>>',method selector)
]
]
]
]
]
"Created: / 10-10-2006 / 23:00:07 / cg"
"Modified: / 30-05-2007 / 12:48:30 / 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"
! !
!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"
! !
!ProjectDefinition class methodsFor:'queries-privacy'!
showClassDocumentationOf:aClass
"used by the HTMLDoc-generator to ask if a classes' protocol is to be documented.
(used by expecco, to suppress documentation of workflow- and expecco classes"
^ true
"Created: / 05-11-2007 / 16:44:16 / 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.214 2009-02-18 11:42:06 cg Exp $'
! !
ProjectDefinition initialize!