"
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
PackagesBeingLoaded Verbose AbbrevDictionary'
poolDictionaries:''
category:'System-Support-Projects'
!
ProjectDefinition class instanceVariableNames:'safeForOverwrittenMethods extensionOverwriteInfo projectIsLoaded'
"
No other class instance variables are inherited by this class.
"
!
!ProjectDefinition class methodsFor:'documentation'!
buildingMakefiles
"
You can define additional rules and flag settings for use in the makeFile generation:
redefinable build-file attributes:
stcOptimizationOptions -> STCLOCALOPT
stcWarningOptions -> STCLOCALOPT
localIncludes_unix -> LOCALINCLUDES (Make.proto)
localIncludes_win32 -> LOCALINCLUDES (bc.mak)
for applications:
startupClassName
startupSelector
for libraries:
"
!
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
"
As ST/X is (still) very tightly bound with stc, we keep the package and project information
in a class-object (instead of some Project-object). This has the advantage, that it can be
compiled and included in a compiled class library just like any other class.
Every package includes an subclass of me (an instance of my meta), which provides useful
information about the versioning and packaging. Me myself, I know how to generate dependency
information and can generate makefiles and other build-support files for compilation.
Some special notes about extension methods:
if a package is loaded (Smalltalk loadPackage:'foo:bar/baz'), any already loaded package of which
methods are overwritten by an extension of this package, the other package is asked to safe those
methods in its safe(ForOverwrittenMethods). Thus, if the other package or any of its classes is asked
to file itself out, it can do so using the safe (otherwise, you'D not be able to checkin a class while
it has an overriding extension loaded).
Also, the information about which other package was in charge when a method is overwritten is recorded in
extensionOverwriteInfo. This is used to correctly reinstall an overwritten method, whenever a package is
unloaded.
"
! !
!ProjectDefinition class methodsFor:'instance creation'!
definitionClassForMonticelloPackage:aMonicelloPackagename
^ self definitionClassForMonticelloPackage:aMonicelloPackagename createIfAbsent:false
"
self definitionClassForMonticelloPackage:'foobar'
"
!
definitionClassForMonticelloPackage:aMonicelloPackagename createIfAbsent:createIfAbsent
^ self allSubclasses
detect:[:eachProjectDefinition |
eachProjectDefinition monticelloPackageName = aMonicelloPackagename ]
ifNone:[
|dfn squeakPackageInfo|
createIfAbsent ifTrue:[
dfn := ApplicationDefinition
definitionClassForPackage:'mc:',aMonicelloPackagename createIfAbsent:true projectType:GUIApplicationType.
"/ if the squeak-stuff is loaded, use it.
PackageInfo notNil ifTrue:[
squeakPackageInfo := PackageInfo allSubclasses
detect:[:pi | pi new packageName = aMonicelloPackagename] ifNone:nil.
].
squeakPackageInfo notNil ifTrue:[
dfn classNames:(squeakPackageInfo new classes collect:[:each | each name]).
].
] ifFalse:[
nil
]
]
"
self definitionClassForMonticelloPackage:'foobar'
self definitionClassForMonticelloPackage:'foobar' createIfAbsent:true
"
"Modified: / 30-10-2010 / 00:26:07 / cg"
!
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.
"/ look what is there and include it; is this ok ?
class compileDescriptionMethods
].
] ifFalse:[
typeOrNil notNil ifTrue:[
class projectType == typeOrNil ifFalse: [
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 ]. "/ temporary - for backward compat.
self error:'unknown project type'.
"Created: / 17-08-2006 / 14:46:28 / cg"
"Modified: / 23-08-2006 / 13:49:27 / cg"
!
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, "
^ self allPreRequisitesWithParentDo:[:parent :prereq |
prereq = self package ifTrue:[ Transcript showCR:('oops: %1 depends on itself' bindWith:prereq) ].
]
"
stx_libbasic allPreRequisites
stx_libbasic2 allPreRequisites
stx_libview2 allPreRequisites
ubs_application allPreRequisites
ubs_application allPreRequisitesSorted
exept_expecco_application allPreRequisites
exept_expeccoNET_application allPreRequisites
alspa_batch_application allPreRequisites
"
"Modified: / 13-04-2011 / 15:30:45 / sr"
!
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 allPreRequisitesWithExtensions sortedPackages|
orderedTuples := OrderedCollection new.
allPreRequisites := self allPreRequisites.
allPreRequisitesWithExtensions := allPreRequisites union:self extensionPackages.
allPreRequisites do:[:eachPackageID |
|def|
self assert:(eachPackageID ~= self package).
orderedTuples add:(Array with:eachPackageID with:self package).
def := self definitionClassForPackage:eachPackageID.
def isNil ifTrue:[
Transcript showCR:'Warning: no definition class for package: ', eachPackageID.
effective := (self searchForPreRequisites: eachPackageID) keys.
] ifFalse:[
effective := def effectivePreRequisites union:def extensionPackages.
effective notEmptyOrNil ifTrue:[
effective do:[:eachPrerequisitePackageID|
self assert:(eachPrerequisitePackageID ~= eachPackageID).
orderedTuples add:(Array with:eachPrerequisitePackageID with:eachPackageID).
].
].
].
].
(orderedTuples detect:[:el | el first = el second] ifNone:nil) notNil ifTrue:[self halt].
sortedPackages := orderedTuples topologicalSort.
"packages which only result from extension methods are used for computing the sort order,
but they are not added, if not present in the first place"
^ sortedPackages select:[:eachProject| allPreRequisites includes:eachProject]
"
stx_libbasic allPreRequisitesSorted
stx_libbasic2 allPreRequisitesSorted
stx_libwidg2 allPreRequisitesSorted
exept_expecco_application allPreRequisitesSorted
alspa_batch_application allPreRequisitesSorted
ubs_application allPreRequisitesSorted
"
"Modified: / 13-04-2011 / 15:19:13 / sr"
"Modified: / 28-06-2011 / 14:04:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
allPreRequisitesWithParentDo:aBlock
"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.
"is a subproject really a prerequisite??
No, it works the other way: parent projects are prerequisites of sub projects,
so the following line has been deleted.
Unfortunately the meaning of 'subproject' has never been well 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 show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' requires ', eachSubPreRequisite).
aBlock value:def value:eachSubPreRequisite.
toAdd add:eachSubPreRequisite
].
"but subprojects of our prerequisites are also prerequisites"
def effectiveSubProjects
select:[:eachSubSubRequisite | eachSubSubRequisite ~= self package and:[ (setOfAllPreRequisites includes:eachSubSubRequisite) not ]]
thenDo:[:eachSubSubRequisite |
Transcript show:'ProjectDefinition preRequisites: '; showCR:(aPreRequisiteProjectID, ' hasSub ', eachSubSubRequisite).
aBlock value:def value:eachSubSubRequisite.
toAdd add:eachSubSubRequisite
].
].
]
].
^ setOfAllPreRequisites.
"
stx_libbasic allPreRequisites
stx_libbasic2 allPreRequisites
stx_libview2 allPreRequisites
ubs_application allPreRequisites
ubs_application allPreRequisitesSorted
exept_expecco_application allPreRequisites
exept_expeccoNET_application allPreRequisites
alspa_batch_application allPreRequisites
"
"Created: / 13-04-2011 / 15:23:21 / sr"
!
directory
"for packageId compatibility"
^ self moduleDirectory
"
bosch_dapasx_datenbasis_Definition moduleDirectory
bosch_dapasx_parameter_system_Definition moduleDirectory
stx_libbasic3 moduleDirectory
cg_croquet moduleDirectory
cg_croquet package asPackageId module
cg_croquet moduleDirectory
stx_goodies_xml_vw moduleDirectory
"
"Created: / 08-08-2006 / 20:25:39 / fm"
"Modified: / 18-08-2006 / 12:18:33 / cg"
!
initialClassNameForDefinitionOf:aPackageId
"given a package-ID, return an appropriate class name for this package"
|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
stx_libbasic3 directory
"
"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
cg_croquet moduleDirectory
cg_croquet package asPackageId module
cg_croquet moduleDirectory
stx_goodies_xml_vw 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"
!
monticelloPackageName
"hook for packages which have been loaded from monticello"
^ nil
!
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"
!
packageDirectory
^ Smalltalk packageDirectoryForPackageId: self package
"Created: / 15-06-2009 / 12:01:18 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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
cg_croquet packageName
stx_goodies_xml_vw packageName
stx_goodies_xml_vw packageDirectory
"
"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
(ProjectDefinition definitionClassForPackage:#'stx:libbasic') projectIsLoaded
"
!
projectIsLoaded:something
projectIsLoaded := something.
something 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:'accessing - packaging'!
classNames:aCollectionOfClassNames
"set the set of classes"
self classNamesAndAttributes:aCollectionOfClassNames usingCompiler:nil
!
classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
"set the set of classes. and attributes
Because this requires compilation of my classList-method, a compiler can be passed in,
which has to do the job.
(this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
|oldSpec newCode|
oldSpec := self classNamesAndAttributes.
newSpec = oldSpec ifTrue: [^ self].
newCode := self classNamesAndAttributes_codeFor:newSpec.
(compilerOrNil ? self compilerClass)
compile:newCode
forClass:self theMetaclass
inCategory:'description - contents'.
!
excludeClasses:toExclude usingCompiler:compilerOrNil
"exclude (remove from classList) a number of classes.
Because this requires compilation of my classList-method, a compiler can be passed in,
which has to do the job.
(this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
|newSpec|
newSpec := self classNamesAndAttributes copy.
toExclude do:[:eachClassToExclude |
|className|
className := eachClassToExclude theNonMetaclass name.
(self allClassNames includes:className) ifTrue:[
|idx|
idx := newSpec findFirst:[:entry | entry = className or:[entry first = className]].
idx ~~ 0 ifTrue:[
newSpec := newSpec copyWithoutIndex:idx.
].
].
].
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
"Created: / 30-08-2007 / 18:28:28 / cg"
!
includeClasses:toInclude usingCompiler:compilerOrNil
"include (add to classList) a number of classes.
Because this requires compilation of my classList-method, a compiler can be passed in,
which has to do the job.
(this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
|oldSpec newSpec|
oldSpec := self classNamesAndAttributes.
newSpec := oldSpec copy.
toInclude do:[:eachClassToInclude |
|className|
className := eachClassToInclude theNonMetaclass name.
(self compiled_classNames includes:className) ifFalse:[
| idx entry|
idx := oldSpec findFirst:[:entry | entry = className or:[entry first = className]].
idx == 0 ifTrue:[
newSpec := newSpec copyWith:(Array with:className)
] ifFalse:[
entry := newSpec at:idx.
entry isArray ifTrue:[
entry := entry copyWithout:#autoload
].
newSpec at:idx put:entry
].
].
].
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
!
makeClassesAutoloaded:toMakeAutoloaded usingCompiler:compilerOrNil
"include as autoloaded (add to classList) a number of classes.
Because this requires compilation of my classList-method, a compiler can be passed in,
which has to do the job.
(this is used by the systembrowser to pass in a CodeGeneratorTool with undo support)"
|newSpec|
newSpec := self classNamesAndAttributes copy.
toMakeAutoloaded do:[:eachClassToMakeAutoloaded |
|className|
className := eachClassToMakeAutoloaded theNonMetaclass name.
(self autoloaded_classNames includes:className) ifFalse:[
|idx entry|
idx := newSpec findFirst:[:entry | entry = className or:[entry first = className]].
idx == 0 ifTrue:[
newSpec := newSpec copyWith:(Array with:className with:#autoload)
] ifFalse:[
entry := newSpec at:idx.
entry isArray ifTrue:[
entry := (entry copyWithout:#autoload) copyWith:#autoload.
] ifFalse:[
entry := Array with:entry with:#autoload
].
newSpec at:idx put:entry.
].
].
].
self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
! !
!ProjectDefinition class methodsFor:'accessing - svn'!
svnRevision
"
Answers SVN revision of given package. The revision is computed
as follows:
1) Look at package directory if there is .svn administration
directory. If so, uses SVN to obtain SVN revision & return
2) If svnRevisionNr return non-nil, use that as SVN revision & return
3) If everything fails, compute maximum from all revision of all
classes & extensions
"
| pkgDir revNr |
"1)"
pkgDir := self packageDirectory.
(pkgDir notNil and: [pkgDir exists and: [(pkgDir / '.svn') exists]]) ifTrue:
[[revNr := (SVN::InfoCommand new
workingCopy: (SVN::WorkingCopy branch: (SVN::Branch new) path: pkgDir);
execute) anyOne revision]
value
"/on: Error do: [revNr := nil]
].
revNr ifNotNil:[^SVN::Revision number:revNr].
"2)"
"We have to explicitly check for existence of svnRevisionNr,
because we don't want to invoke inherited method"
(self class methodDictionary includesKey: #svnRevisionNr)
ifTrue:[revNr := self perform:#svnRevisionNr].
revNr ifNotNil:[^SVN::Revision number:(revNr asString select:[:e|e isDigit])].
"3)"
revNr := (self searchForClassesWithProject: self package)
inject: 0
into:
[:rev :cls|
((cls revision ? '.') includes: $.)"/ CVS revision number?
ifTrue:[rev]
ifFalse:[rev max: (cls revision ? '0') asNumber]].
^revNr ~= 0
ifTrue: [SVN::Revision number:revNr]
ifFalse:[SVN::Revision head]
"
stx_libbasic svnRevision
stx_goodies_libsvn svnRevision
stx_goodies_libsvn revision
"
"Created: / 15-06-2009 / 11:54:33 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-08-2009 / 09:06:29 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 13-02-2010 / 19:27:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'accessing - tests'!
excludedFromTestSuite
"List of testcases and/or tests excluded from testsuite.
Entries maybe ClassName or #(ClassName testName)
"
^ #()
"Created: / 03-06-2011 / 16:56:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
testSuite
"generate and return a testSuite containing all of my test-classes"
|suite classes|
suite := TestSuite named:self package.
classes := self classes
select:[:each |
each isLoaded ifFalse:[each autoload].
(each isTestCaseLike) and:[ each isAbstract not ]
].
classes := classes asSortedCollection:[:a :b | a name <= b name ].
classes do: [:eachClass |
| tests |
tests := eachClass suite tests.
tests := tests reject:[:test|self shouldExcludeTest: test].
suite addTests: tests
].
^ suite
"Created: / 01-04-2011 / 15:20:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 03-06-2011 / 17:07:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 08-08-2011 / 14:59:45 / 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"
|isStandAloneApp|
isStandAloneApp := Smalltalk isStandAloneApp.
self allSubclassesDo:[:eachProjectDefinitionClass |
isStandAloneApp ifFalse:[
eachProjectDefinitionClass installAutoloadedClasses.
].
eachProjectDefinitionClass projectIsLoaded:true.
].
"
self initialize
"
"Created: / 23-10-2006 / 16:40:53 / cg"
!
installAutoloadedClasses
"install all of my autoloaded classes (if any)"
(self classNamesForWhich:[:nm :attr | (attr includes:#autoload)])
do:[:className |
"/ 'install as autoloaded: ' errorPrint. className errorPrintCR.
(Smalltalk classNamed:className) isNil ifTrue:[
Error handle:[:ex |
(self name,' [warning]: failed to install autoloaded: ',className) errorPrintCR.
(self name,' [info]: reason: ',ex description) errorPrintCR.
"/ thisContext fullPrintAll.
] do:[
Smalltalk
installAutoloadedClassNamed:className
category:'* as yet unknown category *'
package:self package
revision:nil
].
].
].
Smalltalk isStandAloneApp ifFalse:[
Smalltalk addStartBlock:[
|abbrevs|
Class withoutUpdatingChangesDo:[
abbrevs := self abbrevs.
self classNames do:
[:nm | | cls|
cls := Smalltalk at: nm.
(cls notNil and:[cls isLoaded not and:[(abbrevs at:cls name ifAbsent:[nil]) size >= 4]]) ifTrue:
[cls category:
((abbrevs at: cls name) at: 4)]]]
]
]
"
stx_libbasic installAutoloadedClasses
stx_libhtml installAutoloadedClasses
"
"Created: / 23-10-2006 / 16:02:12 / cg"
"Modified: / 08-11-2006 / 17:08:06 / cg"
"Modified: / 06-03-2011 / 18:26:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!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:' "lists the classes which are to be included in the project.'.
s nextPutLine:' Each entry in the list may be: a single class-name (symbol),'.
s nextPutLine:' or an array-literal consisting of class name and attributes.'.
s nextPutLine:' Attributes are: #autoload or #<os> where os is one of win32, unix,..."'.
s nextPutLine:''.
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.
].
].
].
"JV @ 2010-06-19
Force merge default class attributes with existing ones"
newEntry := self mergeDefaultClassAttributesFor: cls with: newEntry.
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) ].
].
].
"JV @ 2010-06-19
Support fo additional class attributes and programming language attribute"
attributes := self mergeDefaultClassAttributesFor: eachClass with: attributes.
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"
"Modified: / 19-06-2010 / 10:56:46 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
companyName_code
^ self companyName_codeFor:self companyName
"
self companyName_code
stx_libbasic3 companyName_code
"
"Created: / 18-08-2006 / 16:20:42 / cg"
!
companyName_codeFor:aString
^ String streamContents:[:s |
s nextPutLine:'companyName'.
s nextPutLine:' "Return a companyname which will appear in <lib>.rc"'.
s cr; nextPutLine:' ^ ',aString 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
!
excludedFromPreRequisites_code
"generate the code of the #excludedFromPreRequisites method"
^ String streamContents:[:s |
s nextPutLine:'excludedFromPreRequisites'.
s nextPutLine:' "list all packages which should be ignored in the automatic'.
s nextPutLine:' preRequisites scan. See #preRequisites for more."'.
s nextPutLine:''.
s nextPutLine:' ^ #('.
s nextPutLine:' )'
].
!
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:' "lists the extension methods which are to be included in the project.'.
s nextPutLine:' Entries are 2-element array literals, consisting of class-name and selector."'.
s nextPutLine:''.
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'.
aTwoArgBlock
value: self excludedFromPreRequisites_code
value: 'description'.
(self monticelloPackageName notNil and:[self respondsTo:#monticelloTimestamps_code]) ifTrue:[
aTwoArgBlock
value: self monticelloTimestamps_code
value: 'description - monticello'.
].
"Modified: / 09-11-2010 / 18:41:07 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
forEachMethodsCodeToCompileDo:aTwoArgBlock
self forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:false
!
forEachMethodsCodeToCompileDo:aTwoArgBlock ignoreOldDefinition:ignoreOldDefinition
self
forEachContentsMethodsCodeToCompileDo:aTwoArgBlock
ignoreOldDefinition:ignoreOldDefinition.
(self class includesSelector:#description) ifFalse:[
aTwoArgBlock
value: self description_code
value: 'description - project information'.
].
(self class includesSelector:#productName) ifFalse:[
aTwoArgBlock
value: self productName_code
value: 'description - project information'.
].
(self class includesSelector:#companyName) ifFalse:[
aTwoArgBlock
value: self companyName_code
value: 'description - project information'.
].
(self class includesSelector:#legalCopyright) ifFalse:[
aTwoArgBlock
value: self legalCopyright_code
value: 'description - project information'.
].
(self class includesSelector:#applicationIconFileName) ifFalse:[
aTwoArgBlock
value: self applicationIconFileName_code
value: 'description - project information'.
].
(self monticelloPackageName notNil and:[self respondsTo:#monticelloTimestamps_code]) ifTrue:[
aTwoArgBlock
value: self monticelloTimestamps_code
value: 'description - monticello'.
].
"Created: / 18-08-2006 / 16:22:37 / cg"
"Modified: / 10-10-2006 / 22:02:24 / cg"
"Modified: / 09-11-2010 / 18:41:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
monticelloTimestamps_code
| methodsWithTimestamp |
methodsWithTimestamp := OrderedCollection new.
self classes do:[:cls|
cls methodsDo:[:mthd|
(mthd hasAnnotation: #mctimestamp:) ifTrue:[
methodsWithTimestamp add: mthd
]
].
].
self extensionMethods do:[:mthd|
(mthd hasAnnotation: #mctimestamp:) ifTrue:[
methodsWithTimestamp add: mthd
]
].
^self monticelloTimestamps_codeFor: methodsWithTimestamp
"
stx_goodies_mondrian_core monticelloTimestamps_code
"
"Created: / 09-11-2010 / 18:23:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
monticelloTimestamps_codeFor: methods
| code |
code := String new writeStream.
code nextPutAll:'monticelloTimestamps
^#('.
methods do:[:mthd|
code
tab; tab;
nextPut:$(;
nextPutAll: mthd mclass fullName;
space;
nextPutAll: mthd selector;
space;
nextPutAll: (mthd annotationAt: #mctimestamp:) timestamp storeString;
nextPut:$);
cr.
].
code nextPutAll:'
)'.
^code contents
"
stx_goodies_mondrian_core mcTimestamps_code
"
"Created: / 09-11-2010 / 18:27:45 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:' "list all required packages.'.
s nextPutLine:' This list can be maintained manually or (better) generated and'.
s nextPutLine:' updated by scanning the superclass hierarchies and looking for'.
s nextPutLine:' global variable accesses. (the browser has a menu function for that)'.
s nextPutLine:' Howevery, often too much is found, and you may want to explicitely'.
s nextPutLine:' exclude individual packages in the #excludedFromPrerequisites method."'.
s nextPutLine:''.
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
^ self productName_codeFor:(self productName)
"
self productName_code
stx_libbasic3 productName_code
"
"Created: / 18-08-2006 / 16:14:19 / cg"
!
productName_codeFor:aString
^ String streamContents:[:s |
s nextPutLine:'productName'.
s nextPutLine:' "Return a product name which will appear in <lib>.rc"'.
s cr; nextPutLine:' ^ ',aString storeString.
].
"
self productName_code
stx_libbasic3 productName_code
"
"Created: / 18-08-2006 / 16:14:19 / cg"
!
svnRevisionNr_code: revisionNrOrNil
^ String streamContents:[:s |
s nextPutLine:'svnRevisionNr'.
s nextPutLine:' "Return a SVN revision number of myself.'.
s nextPutLine:' This number is updated after a commit"'.
s cr;
nextPutLine:' ^ "$SVN-Revision:"''', revisionNrOrNil printString , '''"$"'.
].
"
self svnRevisionNr_code
stx_libbasic3 svnRevisionNr_code
"
"Created: / 16-06-2009 / 12:12:37 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-08-2009 / 09:05:05 / Jan Vrany <vranyj1@fel.cvut.cz>"
! !
!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
!
projectTypeSelectors
"a list of possible project type selectors"
^ #( libraryType guiApplicationType nonGuiApplicationType )
"
self libraryType
self guiApplicationType
self nonGuiApplicationType
"
"Created: / 23-08-2006 / 14:27:32 / cg"
!
projectTypes
"a list of possible project types"
^ self libraryTypes , self applicationTypes
"
self projectTypes
"
"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"
!
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"
!
preRequisitesFor: packageId
| def |
def := self definitionClassForPackage:packageId.
def ifNil:
["Maybe the package is not loaded? Try to load it..."
(Smalltalk loadPackage: packageId) ifTrue:
[def := self definitionClassForPackage:packageId]].
^def
ifNil:
["Still no project definition - maybe does not exists?"
(ProjectDefinition searchForPreRequisites: packageId) keys]
ifNotNil:
[def effectivePreRequisites]
"Created: / 24-02-2011 / 22:47:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
preRequisitesForBuilding
"for now, there is only one list of prerequisites present;
will be changed in the (near?) future"
^ self preRequisites
!
preRequisitesForLoading
"for now, there is only one list of prerequisites present;
will be changed in the (near?) future"
^ self preRequisites
!
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
<resource: #obsolete>
"OBSOLETE.
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 - actions'!
postLoadAction
"invoked after loading a project"
"/ intentionally left blank, to be redefined by subclasses (i.e. real projects)
"Modified: / 17-08-2006 / 19:59:17 / cg"
!
preLoadAction
"invoked before loading a project"
"/ intentionally left blank, to be redefined by subclasses (i.e. real projects)
!
preUnloadAction
"invoked before unloading a project"
"/ intentionally left blank, to be redefined by subclasses (i.e. real projects)
"Modified: / 17-08-2006 / 19:59:26 / cg"
! !
!ProjectDefinition class methodsFor:'description - classes'!
additionalClassNamesAndAttributes
^ #()
"Created: / 21-08-2006 / 19:53:04 / cg"
!
classNamesAndAttributes
"a correponding method with real names must be present in my concrete subclasses"
"/ should this be a subclassResponsibility here ?
^ #()
"Created: / 07-08-2006 / 19:02:57 / fm"
"Modified: / 07-08-2006 / 21:25:25 / fm"
"Modified: / 17-08-2006 / 20:47:20 / cg"
!
extensionMethodNames
"list class/selector pairs of extensions.
A correponding method with real names must be present in my concrete subclasses"
"/ should this be a subclassResponsibility here ?
^ #()
"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'!
additionalBaseAddressDefinition_bc_dot_mak
"allows for a base-address definition to be added to the bc.mak file.
Subclasses may redefine this to something like
LIB_BASE=$(LIBWIDG_BASE)
This will be inserted BEFORE the 'include stdHeader'
"
^ nil
!
additionalDefinitions
"allows for additional definitions/rules to be added to the make.proto and bc.mak file."
^ ''
!
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."
^ self additionalDefinitions
"Created: / 22-08-2006 / 23:53:08 / cg"
!
additionalDefinitions_nt_dot_mak
"obsolete - kept for compatibility with old project files"
^ self additionalDefinitions
"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"
!
additionalRulesSvn_make_dot_proto
(self class includesSelector: #svnRevisionNr) ifFalse:[^''].
^ String streamContents:
[:s|s
nextPutLine:'update-svn-revision:';
tab; nextPutLine: 'if [ !! -r .svnversion -o "$(shell svnversion -n)" !!= "$(shell cat .svnversion)" ]; then \';
tab; tab; nextPutLine: 'svnversion -n > .svnversion; \';
tab; tab; nextPutLine: 'sed -i -e "s/\"\$$SVN\-Revision:\".*\"\$$\"/\"\$$SVN-Revision:\"''$(shell svnversion -n)''\"\$$\"/g" \';
tab; tab; tab; nextPutLine: (self name , '.st; \');
tab; nextPutLine: 'fi';
nextPutLine: '.PHONY: update-svn-revision']
"Created: / 24-06-2009 / 21:33:32 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 07-05-2011 / 13:49:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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."
^ ''
!
additionalTargetsSvn_make_dot_proto
(self class includesSelector: #svnRevisionNr) ifFalse:[^''].
^ 'update-svn-revision'
"Created: / 24-06-2009 / 21:35:15 / Jan Vrany <vranyj1@fel.cvut.cz>"
!
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'!
applicationAdditionalIconFileNames
"Return the icon-filenames for additional icons of the application
(empty collection if there are none)"
^ #()
!
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"
!
productDescription
"Returns a description (for autopackage)"
^ self description
"Created: / 21-12-2010 / 09:32:16 / 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"
!
productLicense
"Returns the license (for autopackage)"
^ 'Commercial'
"Created: / 21-12-2010 / 09:31:25 / cg"
!
productMaintainer
"Returns the maintainer (for autopackage)"
^ self companyName
"Created: / 21-12-2010 / 09:26:16 / 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'
].
^ self companyName
"Created: / 14-09-2006 / 21:12:54 / cg"
!
productType
"Returns the product type for autopackage"
^ 'Application'
"Created: / 21-12-2010 / 09:28:48 / 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'!
apspecFilename
^ 'autopackage/default.apspec'
"Created: / 21-12-2010 / 09:43:13 / cg"
!
basicFileNamesToGenerate
"answer a dictionary (filename -> generator method) with all the files,
that have to be generated for this package"
|dict|
dict := OrderedDictionary withKeysAndValues:#(
'Make.spec' #'generate_make_dot_spec'
'Make.proto' #'generate_make_dot_proto'
'Makefile' #'generate_makefile'
'bc.mak' #'generate_bc_dot_mak'
'abbrev.stc' #'generate_abbrev_dot_stc'
'bmake.bat' #'generate_bmake_dot_mak'
'vcmake.bat' #'generate_vcmake_dot_mak'
'lcmake.bat' #'generate_lcmake_dot_mak'
).
dict
at:self rcFilename put:#'generate_packageName_dot_rc';
at:self apspecFilename put:#'generate_autopackage_default_dot_apspec'.
^ dict.
"Modified: / 21-12-2010 / 11:02:02 / cg"
!
fileNamesToGenerate
"answer the files that have to be generated as a dictionary of names and generator method"
^ 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
].
(filename = 'autopackage/default.apspec' or:[filename = self apspecFilename]) ifTrue:[
^ self generate_autopackage_default_dot_apspec
].
self error:('File "%1" not appropriate (not generated) for this type of project.' bindWith:filename)
"Modified: / 21-12-2010 / 11:01:10 / cg"
!
generateFile:filename in: directory
| dir s |
dir := directory asFilename.
dir exists ifFalse:[self error:'Directory does not exist'].
[
s := ( dir / (filename asFilename baseName) ) writeStream.
s nextPutAll: (self generateFile: filename).
] ensure:[
s ifNotNil:[s close]
]
"
stx_projects_smalltalk generateFile:'package.deps.rake' in: '/tmp'
"
"Created: / 26-02-2011 / 10:42:58 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-06-2011 / 14:53:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generateRemoveShellScriptOn:aStream
"generate a shell script to a cvs remove of broken class filenames.
To be called after the output of #generateRenameShellScript: has been performed"
|firstLine|
firstLine := true.
self searchForClasses do:[:eachClass|
firstLine ifTrue:[
aStream nextPutAll:'cvs rm -f '.
firstLine := false.
].
eachClass classFilename ~= (eachClass generateClassFilename, '.st') ifTrue:[
aStream nextPutAll:eachClass classBaseFilename; space.
]
].
firstLine ifFalse:[
aStream cr.
].
"
stx_goodies_webServer_htmlTree generateRemoveShellScriptOn:Transcript
"
!
generateRenameShellScriptOn:aStream
"generate a shell script to rename broken class filenames"
self searchForClasses do:[:eachClass|
eachClass classFilename ~= (eachClass generateClassFilename, '.st') ifTrue:[
aStream nextPutAll:'cp ';
nextPutAll:eachClass classBaseFilename; nextPutAll:',v ';
nextPutAll:eachClass generateClassFilename; nextPutAll:'.st,v'; cr.
]
].
"
stx_libdb generateRemoveShellScriptOn:Transcript
"
!
generate_abbrev_dot_stc
self checkIfClassesArePresent.
^ 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 filenameForClass:eachClassName.
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 := self filenameForClass:cls.
(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_autopackage_default_dot_apspec
^self
replaceMappings: self autopackage_default_dot_apspec_mappings
in: self autopackage_default_dot_apspec
"
stx_projects_smalltalk generate_autopackage_default_dot_apspec
"
"Created: / 21-12-2010 / 09:40:04 / 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_builder_baseline_dot_rbspec
^ self replaceMappings:self builder_baseline_dot_rbspec_mappings
in:self builder_baseline_dot_rbspec
"
stx_projects_smalltalk generate_builder_baseline_dot_rbspec
"
"Created: / 24-02-2011 / 11:38:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
generate_lcmake_dot_mak
^self replaceMappings: self bmake_dot_mak_mappings
in: self lcmake_dot_mak
!
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:' ''' , (self filenameForClass:eachClass), ''''.
].
classNamesUnloaded do:[:nm |
s nextPutLine:' ''' , (self filenameForClass:nm), ''''.
].
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
s nextPutLine:' ''' , (self filenameForClass:nm), ''''.
].
].
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_makefile
^ (self
replaceMappings: self makefile_mappings
in: self makefile) asStringCollection withTabs asString
"
stx_libbasic2 generate_makefile
"
!
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_package_dot_deps_dot_rake
^ (self replaceMappings:self package_dot_deps_dot_rake_mappings
in:self package_dot_deps_dot_rake) asStringCollection
withTabs asString
"
stx_libjava generate_dependencies_dot_rake"
"Created: / 24-02-2011 / 22:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
generate_vcmake_dot_mak
^self replaceMappings: self bmake_dot_mak_mappings
in: self vcmake_dot_mak
!
protectedFileNames
"names of files which should NOT be generated (because they are hand-maintained)
- redefine this to protect a hand-written Make.proto or other handwritten support files"
^ #()
"Created: / 14-09-2006 / 14:38:40 / cg"
"Modified: / 21-12-2010 / 11:36:46 / cg"
!
rcFilename
^ self packageName,'.rc'.
"Created: / 07-09-2006 / 17:07:00 / cg"
! !
!ProjectDefinition class methodsFor:'file mappings'!
autopackage_default_dot_apspec_mappings
|mappings|
mappings := Dictionary new.
mappings
"/ at: 'TOP' put: ( self pathToTop_unix );
"/ at: 'NSI_FILENAME' put: self nsiFilename ;
at: 'DESCRIPTION' put: (self description);
at: 'PRODUCT_VERSION' put: (self productVersion);
at: 'PRODUCT_DATE' put: (self productDate);
at: 'PRODUCT_PUBLISHER' put: (self productPublisher);
at: 'PRODUCT_WEBSITE' put: (self productWebSite);
at: 'PRODUCT_INSTALLDIR' put: (self productInstallDir);
at: 'PRODUCT_TYPE' put: (self productType);
at: 'PRODUCT_LICENSE' put: (self productLicense);
at: 'PRODUCT_DESCRIPTION' put: (self productDescription);
at: 'MAINTAINER' put: (self productMaintainer);
at: 'PACKAGER' put: (self productPublisher);
"/ at: 'STARTUP_CLASS' put: (self startupClassName);
"/ at: 'STARTUP_SELECTOR' put: (self startupSelector);
"/ at: 'MAIN_DEFINES' put: (self mainDefines);
"/ at: 'REQUIRED_LIBS' put: (self generateRequiredLibs_make_dot_proto);
"/ at: 'PREREQUISITES_LIBS' put: (self generatePreRequisiteLines_make_dot_proto);
"/ at: 'SUBPROJECTS_LIBS' put: (self generateSubProjectLines_make_dot_proto);
"/ at: 'REQUIRED_LIBOBJS' put: (self generateRequiredLibobjs_make_dot_proto);
"/ at: 'REQUIRED_LINK_LIBOBJS' put: (self generateRequiredLinkLibobjs_make_dot_proto);
"/ at: 'DEPENDENCIES' put: (self generateDependencies_unix);
"/ at: 'SUBPROJECTS_LIBS' put: (self generateSubProjectLines_make_dot_proto );
"/ at: 'BUILD_TARGET' put: (self buildTarget );
yourself.
"/ self offerSmalltalkSourceCode ifTrue:[
"/ mappings
"/ at: 'STX_SOURCE_RULES' put: ( self replaceMappings: mappings
"/ in: self make_dot_proto_stx_source_rules).
"/ ].
"/ self offerApplicationSourceCode ifTrue:[
"/ mappings
"/ at: 'SOURCE_RULES' put:( self replaceMappings: mappings
"/ in: self make_dot_proto_app_source_rules ).
"/ ].
"/ self needResources ifTrue:[
"/ mappings
"/ at: 'REQUIRED_SUPPORT_DIRS' put: 'RESOURCEFILES';
"/ at: 'RESOURCE_RULES' put:( self replaceMappings: mappings
"/ in: self make_dot_proto_resource_rules );
"/ at: 'STX_RESOURCE_RULES' put: ( self replaceMappings: mappings
"/ in: self make_dot_proto_stx_resource_rules);
"/ at: 'ADDITIONAL_RESOURCE_TARGETS' put:( self additionalResourceTargets asStringWith:' ');
"/ yourself.
"/ ].
^ mappings
"Created: / 21-12-2010 / 09:00:49 / cg"
"Modified: / 21-12-2010 / 11:14:41 / cg"
!
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_BASE_ADDRESS_DEFINITION' put: (self additionalBaseAddressDefinition_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: / 24-11-2010 / 20:15:05 / cg"
!
bmake_dot_mak_mappings
^ (Dictionary new)
at:'SUBPROJECT_BMAKE_CALLS' put:(self subProjectBmakeCalls);
at:'SUBPROJECT_VCMAKE_CALLS' put:(self subProjectVCmakeCalls);
at:'SUBPROJECT_LCMAKE_CALLS' put:(self subProjectLCmakeCalls);
yourself
"Created: / 17-08-2006 / 21:41:56 / cg"
"Modified: / 14-09-2006 / 18:55:33 / cg"
!
builder_baseline_dot_rbspec_mappings
|mappings|
mappings := Dictionary new.
mappings
at:'APPLICATION' put:(self perform:#applicationName ifNotUnderstood:[self packageName]);
at:'APPLICATION_PACKAGE' put:self package printString;
at:'PREAMBLE' put:self builder_baseline_dot_rbspec_preamble;
at:'POSTAMBLE' put:self builder_baseline_dot_rbspec_postamble;
at:'PACKAGES' put:self builder_baseline_dot_rbspec_packages;
yourself.
^ mappings
"Modified: / 21-12-2010 / 11:00:22 / cg"
"Created: / 24-02-2011 / 11:58:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 09-06-2011 / 14:55:31 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
builder_baseline_dot_rbspec_packages
^ String streamContents:
[:s |
self allPreRequisitesSorted do:
[:packageId |
s
nextPutAll:(' package "%1"' bindWith:packageId);
cr ] ].
"Created: / 24-02-2011 / 11:59:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
classLine_mappings:aClassName
^ Dictionary new
at:'CLASS' put:(self st2c:aClassName);
yourself
"Modified: / 09-08-2006 / 18:27:07 / fm"
"Created: / 19-09-2006 / 22:47:43 / cg"
!
make_dot_proto_mappings
^ Dictionary new
at: 'TAB' put: ( Character tab asString );
at: 'TOP' put: ( self pathToTop_unix );
at: 'LIBRARY_NAME' put: ( self libraryName );
at: 'SUBDIRECTORIES' put: (self generateSubDirectories);
at: 'LOCAL_INCLUDES' put: (self generateLocalIncludes_unix);
at: 'LOCAL_DEFINES' put: self localDefines_unix;
at: '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_RULES_SVN' put: (self additionalRulesSvn_make_dot_proto);
at: 'ADDITIONAL_TARGETS' put: (self additionalTargets_make_dot_proto);
at: 'ADDITIONAL_TARGETS_SVN' put: (self additionalTargetsSvn_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"
"Modified: / 24-06-2009 / 21:50:13 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-08-2009 / 12:03:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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: 'CLASSES' put: [self generateClasses_make_dot_spec];
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"
!
makefile_mappings
^ Dictionary new
yourself
!
packageName_dot_rc_mappings
|d s resourceCount|
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 := String streamContents:[:stream|
|suff|
s := self applicationIconFileName.
s notNil ifTrue:[
s asFilename suffix isEmptyOrNil ifTrue:[
suff := '.ico'
] ifFalse:[
suff := ''
].
'IDR_MAINFRAME ICON DISCARDABLE "%1%2"'
expandPlaceholdersWith:(Array with:s with:suff) on:stream.
stream cr.
].
s := self splashFileName.
s notNil ifTrue:[
s asFilename suffix isEmptyOrNil ifTrue:[
suff := '.bmp'
] ifFalse:[
suff := ''
].
'IDR_SPLASH BITMAP DISCARDABLE "%1%2"'
expandPlaceholdersWith:(Array with:s with:suff) on:stream.
stream cr.
].
resourceCount := 2.
self applicationAdditionalIconFileNames do:[:eachFilename|
'IDR_MAINFRAME+%1 ICON DISCARDABLE "%2"'
expandPlaceholdersWith:(Array with:resourceCount with:eachFilename) on:stream.
stream cr.
resourceCount := resourceCount+1.
].
].
d at: #'ICONDEFINITION_LINE' put:s.
^ d
"Created: / 09-08-2006 / 11:21:21 / fm"
"Modified: / 22-02-2011 / 11:30:36 / cg"
!
package_dot_deps_dot_rake_mappings
| dependencies |
dependencies := String streamContents:
[:s|
self allPreRequisites do:
[:package|
(self preRequisitesFor: package) do:
[:prereq|
s nextPutAll: ('task "%1" => "%2"' bindWith: package with: prereq); cr].
s cr].
self effectivePreRequisites do:
[:prereq|
s nextPutAll: ('task "%1" => "%2"' bindWith: self package with: prereq); cr].
].
^ (Dictionary new)
at:'DEPENDENCIES' put:dependencies;
yourself
"
stx_libjava generate_package_dot_deps_dot_rake
"
"Created: / 24-02-2011 / 22:32:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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:'file mappings support'!
classNamesByCategory
"answer a dictionary
category -> classNames topological sorted"
|pivateClassesOf sorter classes classNames mapping|
mapping := Dictionary new.
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 sharedPoolNames 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.
OperatingSystem knownPlatformNames do:[:platformID |
|prefix depClasses depClassNames|
prefix := platformID asUppercase.
depClasses := self compiled_classesForArchitecture:platformID.
depClasses notEmpty ifTrue:[
(self compiled_classNamesForPlatform:platformID)
select:[:nm | (Smalltalk at:nm ifAbsent:nil) isNil]
thenDo:[:nm | Transcript showCR:nm].
(depClasses includes:nil) ifTrue:[
(Dialog confirm:'Dependencies are not in correct (some classes are not present).\\Continue anyway ?' withCRs)
ifFalse:[
AbortOperationRequest raise.
].
depClassNames := self compiled_classNamesForPlatform:platformID.
] ifFalse:[
depClasses topologicalSort:sorter.
depClassNames := depClasses collect:[:eachClass| eachClass name].
].
mapping at:prefix put:depClassNames.
].
classNames := classes collect:[:eachClass| eachClass name].
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do: [:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
classNames add:nm.
].
].
mapping at:'COMMON' put:classNames.
].
^ mapping
"
stx_libbasic classNamesByCategory
stx_libbasic3 classNamesByCategory
stx_libview classNamesByCategory
"
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 03-07-2011 / 21:51:36 / cg"
!
commonSymbolsFlag
"only for libraries"
^ ''
!
filenameForClass:classNameOrClass
"answer the base filename of the class without suffix"
"/ "enable this code if you want to convert old filenames to new filenames.
"/ See also: #generateRemoveShellScriptOn: and #generateRenamShellScriptOn:"
"/ classNameOrClass isBehavior ifTrue:[
"/ ^ classNameOrClass generateClassFilename.
"/ ] ifFalse:[
"/ |cls|
"/
"/ cls := Smalltalk classNamed:classNameOrClass.
"/ cls notNil ifTrue:[
"/ ^ cls generateClassFilename.
"/ ].
"/ ].
"/ "end special code"
^ Smalltalk fileNameForClass:classNameOrClass.
"
self filenameForClass:HTML::Encoder
Smalltalk fileNameForClass:HTML::Encoder
"
"Created: / 08-08-2006 / 20:17:28 / fm"
"Modified: / 20-10-2006 / 16:22:58 / cg"
!
generateClassLines:classLineTemplate
"for the init-file: generate class-init-lines for all classes"
^ self generateClassLines:classLineTemplate forClasses:(self compiled_classNames_common)
!
generateClassLines:classLineTemplate forClasses:classNames
"for the init-file: generate class-init-lines for a collection of classes"
^ self generateClassLines:classLineTemplate forClasses:classNames includeAdditionalClasses:true
!
generateClassLines:classLineTemplate forClasses:classNames includeAdditionalClasses:includeAdditionalClasses
"for the init-file: generate class-init-lines for a collection of classes"
^ String
streamContents:[:s |
|classesLoaded classNamesUnloaded classNamesSorted putLineForClassName|
putLineForClassName := [:className |
|newClassLine mappings|
mappings := self classLine_mappings:className.
newClassLine := self replaceMappings:mappings in:classLineTemplate.
s nextPutLine:newClassLine
].
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.
includeAdditionalClasses ifTrue:[
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"
!
generateClasses_make_dot_spec
|classNamesDict|
classNamesDict := self classNamesByCategory.
^ String streamContents:[:s |
classNamesDict keysAndValuesDo:[:eachCategory :classNames|
s nextPutLine:eachCategory,'_CLASSES= \'.
classNames do:[:eachClassName|
s tab; nextPutAll:eachClassName; nextPutLine:' \'.
].
s cr.
].
s cr.
].
"
stx_libbasic generateClasses_make_dot_spec
stx_libbasic3 generateClasses_make_dot_spec
stx_libview generateClasses_make_dot_spec
stx_libboss generateClasses_make_dot_spec
"
"Created: / 09-08-2006 / 11:24:39 / fm"
"Modified: / 20-10-2006 / 16:18:54 / 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 := self filenameForClass:cls.
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 := self filenameForClass:cls.
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:(self filenameForClass:eachClassName).
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
|classNamesDict|
classNamesDict := self classNamesByCategory.
^ String streamContents:[:s |
|putLineForClassName|
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.
].
classNamesDict keysAndValuesDo:[:eachCategory :classNames|
s nextPutLine:eachCategory,'_OBJS= \'.
classNames do:putLineForClassName.
(eachCategory = 'COMMON' and:[self hasExtensionMethods]) ifTrue:[
s nextPutLine:' $(OUTDIR)extensions.$(O) \'.
].
s cr.
].
s cr.
].
"
stx_libbasic generateObjects_make_dot_spec
stx_libbasic3 generateObjects_make_dot_spec
stx_libview generateObjects_make_dot_spec
stx_libboss 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:' & $(MAKE_BAT) "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) "CFLAGS_LOCAL=$(GLOBALDEFINES)"'.
].
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"
!
generate_definitionClassLine_libInit_dot_cc
"for the init-file: generate a single class-init-line for the definition class itself"
^ self
generateClassLines:(self classLine_libInit_dot_cc)
forClasses:(Array with:self name)
includeAdditionalClasses:false
"
stx_libbasic generate_definitionClassLine_libInit_dot_cc
"
!
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"
!
objectLine_make_dot_spec_mappings: aClassName
^ Dictionary new
at: 'CLASSFILE' put:(self filenameForClass: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"
!
subProjectBmakeCalls
"generate submake-calls for borland bcc"
^ self subProjectMakeCallsUsing:'call bmake %1 %2'.
!
subProjectLCmakeCalls
"generate submake-calls for lc"
^ self subProjectMakeCallsUsing:'call lcmake %1 %2'.
!
subProjectMakeCallsUsing:callString
^ String streamContents:[:s |
self subProjects do:[:packageID |
s nextPutLine:'@echo "***********************************"'.
s nextPutLine:'@echo "Buildung ',(packageID copyReplaceAll:$: with:$/).
s nextPutLine:'@echo "***********************************"'.
s nextPutLine:'cd ', (self msdosPathToPackage:packageID from:(self package)).
s nextPutLine:callString.
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"
!
subProjectVCmakeCalls
"generate submake-calls for visual-C"
^ self subProjectMakeCallsUsing:'call vcmake %1 %2'.
! !
!ProjectDefinition class methodsFor:'file templates'!
autopackage_default_dot_apspec
"for linux's autopackage"
^
'# -*- shell-script -*-
[Meta]
ShortName: %(APPLICATION)
SoftwareVersion: %(PRODUCT_VERSION)
DisplayName: %(DESCRIPTION)
RootName: @exept.de/expecco:$SOFTWAREVERSION
Summary: %(DESCRIPTION)
Maintainer: %(MAINTAINER)
Packager: %(PACKAGER)
PackageVersion: 1
CPUArchitectures: x86
AutopackageTarget: 1.0
Type: %(PRODUCT_TYPE)
License: %(PRODUCT_LICENSE)
[Description]
%(PRODUCT_DESCRIPTION)
[BuildPrepare]
# If you''re using autotools, the default should be enough.
# prepareBuild will set up apbuild and run configure for you. If you
# need to pass arguments to configure, just add them to prepareBuild:
# prepareBuild --enable-foo --disable-bar
#prepareBuild
[BuildUnprepare]
# If you''re using prepareBuild above, there is no need to change this!!
#unprepareBuild
[Globals]
# Variables declared in this section will be available in all other sections
export APKG_BUILD_SKIP_CONFIGURE=1
export APKG_BUILD_SKIP_MAKE=1
export MYPREFIX=/opt/%(APPLICATION)
[Prepare]
#recommend ''@autopackage.org/autopackage-gtk'' 1
[Imports]
import <<EOF
$source_dir/%(APPLICATION)
$source_dir/resources
$source_dir/keyboard.rc
$source_dir/display.rc
$source_dir/../doc
$source_dir/../testsuites/webedition
$source_dir/../projects/libraries
$source_dir/../reportGenerator/tools
$source_dir/../../pdf/afm
$source_dir/../plugin/selenium/libexept_expecco_plugin_selenium.so
$source_dir/../externalTools
EOF
for i in $source_dir/*.so
do
echo $source_dir/$(readlink $i)
done | import
[Install]
if [ "$PREFIX" !!= "/usr" ]
then
export MYPREFIX=$PREFIX
fi
find . -type d \( -name CVS -or -name ''not_*'' \) -print | xargs rm -rf
mkdir -p $MYPREFIX
copyFiles expecco *.rc resources $MYPREFIX/bin
copyFiles *.so $MYPREFIX/lib
copyFiles doc externalTools $MYPREFIX/packages/exept/expecco
copyFiles webedition/projects libraries $MYPREFIX/testsuites
copyFiles tools $MYPREFIX/packages/exept/expecco/reportGenerator
copyFiles afm $MYPREFIX/packages/exept/pdf
copyFiles libexept_expecco_plugin_selenium.so $MYPREFIX/plugin
#installExe expecco
#installLib *.so
#installData resources
#installData keyboard.rc
#installData doc
[Uninstall]
# Leaving this at the default is safe unless you use custom commands in
# "Install" to create files. All autopackage API functions
# that installs files are logged.
uninstallFromLog
'
"Created: / 21-12-2010 / 09:06:21 / cg"
!
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"
^
'@REM -------
@REM make using borland bcc
@REM type bmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
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"
!
builder_baseline_dot_rbspec
"For rake-base automatic builder"
^ '
# generated from project definition
# load package dependencies
load ''package.deps.rake''
# kludge: clear some invalid dependencies of libwidg
# (should be fixed in baseline)
clear "stx:libwidg" => "stx:libui"
clear "stx:libwidg2" => "stx:libui"
project :''%(APPLICATION):baseline'' do
# preamble
%(PREAMBLE)
# --------
%(PACKAGES)
application "%(APPLICATION_PACKAGE)"
# postamble
%(POSTABLE)
# ---------
end
'
"Created: / 24-02-2011 / 11:39:00 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 27-02-2011 / 12:42:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
builder_baseline_dot_rbspec_postamble
^ ''
"Created: / 24-02-2011 / 11:58:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
builder_baseline_dot_rbspec_preamble
^ ''
"Created: / 24-02-2011 / 11:58:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
lcmake_dot_mak
"the template code for the lcmake.bat file"
^
'@REM -------
@REM make using lcc compiler
@REM type lcmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
make.exe -N -f bc.mak USELCC=1 %%1 %%2
%(SUBPROJECT_LCCMAKE_CALLS)
'
!
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)
%(CLASSES)
%(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"
!
makefile
^
'#
# DO NOT EDIT
#
# make uses this file (Makefile) only, if there is no
# file named "makefile" (lower-case m) in the same directory.
# My only task is to generate the real makefile and call make again.
# Thereafter, I am no longer used and needed.
#
.PHONY: run
run: makefile
$(MAKE) -f makefile
#only needed for the definition of $(TOP)
include Make.proto
makefile:
$(TOP)/rules/stmkmf
'
!
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"
!
package_dot_deps_dot_rake
^ '
# Package dependencies.
# Automatically generated by project defintion.
%(DEPENDENCIES)
'
"Created: / 24-02-2011 / 22:32:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
vcmake_dot_mak
"the template code for the vcmake.bat file"
^
'@REM -------
@REM make using microsoft visual c
@REM type vcmake, and wait...
@REM do not edit - automatically generated from ProjectDefinition
@REM -------
make.exe -N -f bc.mak -DUSEVC %%1 %%2
%(SUBPROJECT_VCMAKE_CALLS)
'
"Modified: / 26-07-2010 / 12:25:44 / cg"
! !
!ProjectDefinition class methodsFor:'loading'!
ensureFullyLoaded
"ensure that all classes and extensions are loaded properly.
This is normally no problem for compiled classLibs - however, if a package
has only be installedAsAutoloaded, some classes might want to ensure that
when being loaded themself."
self hasAllExtensionsLoaded ifFalse:[
self breakPoint:#cg.
].
self hasAllClassesFullyLoaded ifFalse:[
self hasAllClassesLoaded ifFalse:[
self breakPoint:#cg.
].
self classes do:[:cls | cls autoload ].
].
"
stx_libbasic ensureFullyLoaded
"
"Verbose := true
stx_libjavascript hasAllExtensionsLoaded
"
"Verbose := true
stx_goodies_soap_xe hasAllExtensionsLoaded
"
!
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 meOrMySecondIncarnation|
self projectIsLoaded ifTrue:[^ false].
thisContext isRecursive ifTrue:[self breakPoint:#cg. ^ false]. "/ avoid endless loops
newStuffHasBeenLoaded := false.
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
"/ thisContext fullPrintAll.
Transcript showCR:('loading %1%2...'
bindWith:(asAutoloaded ifTrue:['as autoloaded '] ifFalse:[''])
with:self name).
].
self rememberOverwrittenExtensionMethods.
self activityNotification:'Executing pre-load action'.
self preLoadAction.
meOrMySecondIncarnation := self.
Class withoutUpdatingChangesDo:[
self activityNotification:'Loading prerequisities'.
self loadPreRequisitesAsAutoloaded:asAutoloaded.
self checkPrerequisitesForLoading.
asAutoloaded ifFalse:[
self loadClassLibrary.
"/ could have overloaded my first incarnation
meOrMySecondIncarnation := (Smalltalk at:(self name)) ? self.
meOrMySecondIncarnation ~~ self ifTrue:[
meOrMySecondIncarnation fetchSlotsFrom:self.
].
].
self activityNotification:'Loading extensions'.
newStuffHasBeenLoaded := newStuffHasBeenLoaded | meOrMySecondIncarnation loadExtensions.
self activityNotification:'Loading classes'.
newStuffHasBeenLoaded := newStuffHasBeenLoaded | (meOrMySecondIncarnation loadAllClassesAsAutoloaded:asAutoloaded).
"/ no, don't load subProjects here - will lead to a recursion, which leads
"/ to some classes being loaded from source (soap)
self activityNotification:'Loading sub projects'.
meOrMySecondIncarnation loadSubProjectsAsAutoloaded:asAutoloaded.
].
self activityNotification:('Executing post-load action for %1' bindWith:self package).
"/ mhmh - already done for dll-loaded packages
"/ meOrMySecondIncarnation initializeAllClasses.
meOrMySecondIncarnation postLoadAction.
meOrMySecondIncarnation projectIsLoaded:true.
meOrMySecondIncarnation ~~ self ifTrue:[
self projectIsLoaded:true.
].
self activityNotification:('Done (%1).' bindWith:self package).
^ newStuffHasBeenLoaded
"Created: / 17-08-2006 / 01:01:41 / cg"
"Modified: / 30-10-2008 / 08:16:21 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 22-08-2009 / 12:02:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 29-12-2010 / 10:09:34 / cg"
!
unloadPackage
"unload the project.
Fails if there are still instances of any of my classes in the system"
self projectIsLoaded ifFalse:[^ false].
thisContext isRecursive ifTrue:[^ false].
(self infoPrinting and:[Smalltalk silentLoading not]) ifTrue:[
"/ thisContext fullPrintAll.
Transcript show:'unloading '; showCR:self name.
].
self activityNotification:'Executing pre-unload action'.
self preUnloadAction.
self activityNotification:'Restoring original methods'.
self restoreOverwrittenExtensionMethods.
Class withoutUpdatingChangesDo:[
self activityNotification:'Unloading sunprojects'.
self unloadSubProjects.
self activityNotification:'Unloading classes'.
self unloadClassLibrary.
self unloadAllClasses.
].
self projectIsLoaded:false.
^ true
! !
!ProjectDefinition class methodsFor:'misc ui support'!
iconInBrowserSymbol
<resource: #programImage>
self theNonMetaclass isApplicationDefinition ifTrue:[
self theNonMetaclass isGUIApplication ifTrue:[
^ #guiApplicationDefinitionClassIcon
].
^ #applicationDefinitionClassIcon
].
^ super iconInBrowserSymbol
! !
!ProjectDefinition class methodsFor:'private'!
abbrevs
| abbrevs file stream |
AbbrevDictionary isNil ifTrue:[
AbbrevDictionary := WeakIdentityDictionary new.
].
[
abbrevs := AbbrevDictionary at:self ifAbsentPut:[ Dictionary new ].
] valueUninterruptably.
file := self packageDirectory / 'abbrev.stc'.
file exists ifTrue: [
stream := file readStream.
[Smalltalk
withAbbreviationsFromStream:stream
do:[:nm :fn :pkg :cat :sz|
abbrevs at: nm put: (Array with: nm with: fn with: pkg with: cat with: sz)]
] ensure:[
stream close
]
].
^abbrevs
"Created: / 06-03-2011 / 18:25:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
additionalClassAttributesFor: aClass
"Answers additional set of class attributes for given class
Individual project definitions may override this method, but
overriding method should always merge its attributes with result
of 'super additionalClassAttributesFor: aClass'.
Here, we add #autoload attributes to all test cases and
test resources, as they are not neccessary for the package
and should not be compiled (because of unwanted dependency
on stx:goodies/sunit package)
"
(aClass inheritsFrom: TestCase) ifTrue:[^#(autoload)].
(aClass inheritsFrom: TestResource) ifTrue:[^#(autoload)].
"No additional attributes"
^#()
"
stx_libbasic additionalClassAttributesFor: Object
stx_libtool additionalClassAttributesFor: Tools::NavigationHistoryTests
stx_goodies_sunit additionalClassAttributesFor: TestCase
stx_libtool classNamesAndAttributes_code_ignoreOldEntries:true ignoreOldDefinition: true
"
"Created: / 26-10-2009 / 12:54:38 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
checkIfClassesArePresent
"check if all classes defined by this project are present and
offer a dialog to abort the current operation if not"
|check nonExistantClasses|
nonExistantClasses := Set new.
check :=
[:eachClassName |
|cls fn wasLoaded failedToLoad numClassInstvars|
cls := Smalltalk classNamed:eachClassName.
cls isNil ifTrue:[
Transcript showCR:eachClassName.
nonExistantClasses add:eachClassName.
].
].
self allClassNames do:check.
self namesAndAttributesIn:(self additionalClassNamesAndAttributes) do:[:nm :attr |
(attr isEmptyOrNil or:[(attr includes:#autoload) not]) ifTrue:[
check value:nm
].
].
nonExistantClasses notEmpty ifTrue:[
(Dialog confirm:(Dialog classResources
stringWithCRs:'"%1" and possibly more classes are missing.\Cannot generate a correct "abbrev.stc" file.\\Continue anyway?'
with:nonExistantClasses anElement allBold))
ifFalse:[
AbortOperationRequest raise.
].
^ false.
].
^ true
!
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"
!
classNamesAndAttributesDo: aBlock
self namesAndAttributesIn:(self classNamesAndAttributes) do: aBlock
"Modified: / 22-08-2006 / 18:20:21 / 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"
!
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 or:[cls isBehavior not]) ifTrue:[
Transcript showCR:('ProjectDefinition: missing/invalid class: ', eachName).
cls := nil.
].
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 isBehavior ifFalse:[
self warn:('Missing/invalid class: %1\\%2'
bindWith:eachName
with:('Warning: The class is skipped in the list of compiled classes.' allBold)) withCRs.
cls := nil.
].
cls
]
thenSelect:[:cls| cls notNil "isBehavior"]
"Created: / 09-08-2006 / 16:28:15 / fm"
"Modified: / 09-08-2006 / 18:02:28 / fm"
"Modified: / 11-10-2010 / 12:11:06 / 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"
!
defaultClassAttributesFor: aClass
"Answers default set of class attributes for given class.
This is internal method only, to per-project customization
please override either #additionalClassAttributes or
#additional classAttributesFor:"
| attrs |
"JV @ 2010-06-19
Add a programming language attribute for non-smalltalk classes.
Used by multi-lang enabled loading mechanism"
attrs := aClass programmingLanguage isSmalltalk
ifTrue:[#()]
ifFalse:[Array with: (Array with: #lang with: aClass programmingLanguage name asSymbol)].
"JV @ 2009-10-26
Give a project definition to specify additional attributes for given class."
attrs := attrs , (self additionalClassAttributesFor: aClass).
^attrs
"Created: / 19-06-2010 / 10:44:13 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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"
!
mergeClassAttributes: attr1 with: attr2
^attr1 , (attr2 reject:[:each|attr1 includes: each])
"Created: / 19-06-2010 / 10:50:02 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
mergeDefaultClassAttributesFor: aClass with: attributes
^self mergeClassAttributes: attributes with: (self defaultClassAttributesFor: aClass)
"Created: / 19-06-2010 / 10:51:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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
stx_goodies_webServer_htmlTree 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 ~= PackageId noProjectID ifTrue:[
requiredPackages add:package.
]
]
]
].
"/ need them also...
self preRequisites do:[:eachPreRequisitePackage |
addPackage value:eachPreRequisitePackage
].
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 sharedPoolNames do:[:eachPoolName |
|eachPoolClass|
eachPoolClass := Smalltalk classNamed:eachPoolName.
eachPoolClass isNil ifTrue:[
Transcript showCR:('Warning: missing pool: %1 (required by %2)' bindWith:eachPoolName with:cls name)
] ifFalse:[
eachPoolClass withAllSuperclassesDo:[:eachPoolSuperClass |
addPackage value:(eachPoolSuperClass package)
]
]
].
].
self extensionMethodNames pairWiseDo:[:className :selector |
|cls|
((cls := Smalltalk classNamed:className) notNil and:[cls isLoaded]) ifTrue:[
cls withAllSuperclassesDo:[:eachSuperClass |
addPackage value:(eachSuperClass package)
]
]
].
^ requiredPackages
"
stx_libtool searchForProjectsWhichProvideHeaderFiles
"
"Created: / 07-12-2006 / 17:46:38 / cg"
"Modified: / 18-01-2011 / 17:58:33 / 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 ~= PackageId 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
"return true, if this is a GUI application.
(these need more libraries and use a different startup procedure)"
^ true
'
categorized:'description'.
self superclass: ApplicationDefinition.
^ self
].
typeOrNil = NonGUIApplicationType ifTrue:[
self compile:
'isGUIApplication
"return true, if this is a GUI application.
(these need more libraries and use a different startup procedure)"
^ false
'
categorized:'description'.
self superclass: ApplicationDefinition.
^ self
].
self theMetaclass removeSelector: #isGUIApplication.
self superclass: LibraryDefinition.
^ self.
"Created: / 23-08-2006 / 14:26:10 / cg"
!
shouldExcludeTest: test
self excludedFromTestSuite do:
[:spec|
(spec isSymbol and:[test class name == spec])
ifTrue:[^true].
(spec isArray and:[test class name == spec first and:[test selector == spec second]])
ifTrue:[^true].
].
^false
"Created: / 03-06-2011 / 17:01:14 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'private-extension handling'!
hasSavedOverwrittenMethods
"true, if any of my methods was overwritten by another loaded package.
These methods are now in my safe"
^ safeForOverwrittenMethods notEmptyOrNil
!
methodOverwrittenBy:aMethod
"return the (hidden) original method, which was located in another package
and which got overwritten by one of my extension methods. Nil if there is none."
|mclass selector oldPackage|
extensionOverwriteInfo isNil ifTrue:[^ nil].
mclass := aMethod mclass.
selector := aMethod selector.
oldPackage := extensionOverwriteInfo at:(mclass name,'>>',selector) ifAbsent:nil.
oldPackage isNil ifTrue:[^ nil].
^ oldPackage asPackageId projectDefinitionClass
savedOverwrittenMethodForClass:mclass selector:selector.
!
rememberOverwrittenExtensionMethods
"before loading, tell other packages to keep a safe reference to any method
which gets overloaded by me, and also remember here, whome I have overloaded.
This allows for two things:
a) correct fileout of the other base-package (for example, when checking in any of its class)
b) correct unloading of myself"
self extensionMethodNames pairWiseDo:[:className :selector |
|class oldMethod oldPackage defClass|
class := Smalltalk classNamed:className.
class notNil ifTrue:[
oldMethod := class compiledMethodAt:selector.
].
oldMethod notNil ifTrue:[
oldPackage := oldMethod package.
oldPackage ~= PackageId noProjectID ifTrue:[
defClass := oldPackage asPackageId projectDefinitionClass.
defClass notNil ifTrue:[
defClass rememberOverwrittenMethod:oldMethod inClass:class.
extensionOverwriteInfo isNil ifTrue:[
extensionOverwriteInfo := Dictionary new.
].
extensionOverwriteInfo at:(className,'>>',selector) put:oldPackage.
]
].
].
].
!
rememberOverwrittenMethod:oldMethod inClass:aClass
"invoked from another projectDefinition, when that package is about to be loaded
and about to overwrite one of my methods.
I will save the method locally, to allow for correct fileout of this class/project or
to correctly reestablish my methods when the other package is unloaded later."
|thisIsOneOfMyMethods selector|
selector := oldMethod selector.
thisIsOneOfMyMethods := (self classNames includes:aClass theNonMetaclass name)
or:[ aClass isPrivate and:[ self classNames includes: aClass topOwningClass theNonMetaclass name ]].
thisIsOneOfMyMethods ifFalse:[
self extensionMethodNames pairWiseDo:[:extClassName :extSelector |
extClassName = aClass name ifTrue:[
selector = extSelector ifTrue:[
thisIsOneOfMyMethods := true
].
].
]
].
thisIsOneOfMyMethods ifFalse:[
self error:'oops - this is not one of my methods' mayProceed:true.
^ self
].
safeForOverwrittenMethods isNil ifTrue:[
safeForOverwrittenMethods := Dictionary new.
].
safeForOverwrittenMethods at:(aClass name -> selector) put:oldMethod.
!
restoreOverwrittenExtensionMethods
"after unloading, tell other packages to restore any safed reference to any method
which got overloaded by me."
self extensionMethodNames pairWiseDo:[:className :selector |
|class oldMethod oldPackage|
oldPackage := extensionOverwriteInfo at:(className,'>>',selector).
oldPackage notNil ifTrue:[
class := Smalltalk classNamed:className.
class notNil ifTrue:[
oldMethod := oldPackage savedOverwrittenMethodForClass:class selector:selector.
oldMethod notNil ifTrue:[
self breakPoint:#cg.
].
]
].
].
!
savedOverwrittenMethodForClass:aClass selector:aSelector
"return one of my saved original methods"
^ safeForOverwrittenMethods at:(aClass name,'>>',aSelector) ifAbsent:nil
! !
!ProjectDefinition class methodsFor:'private-loading'!
checkPrerequisitesForLoading
|classesAlreadyWarned|
classesAlreadyWarned := Set new.
self extensionMethodNames
pairWiseDo:[:className :selector |
|class |
class := Smalltalk classNamed:className.
class isNil ifTrue:[
(classesAlreadyWarned includes:className) ifFalse:[
self error:'missing class for extension: ', className mayProceed:true.
classesAlreadyWarned add:className.
].
].
]
"/ todo: more needed here...
"
stx_libjavascript checkPrerequisitesForLoading
"
!
extensionOverwriteInfo
^ extensionOverwriteInfo
!
fetchSlotsFrom:myFirstIncarnation
"this is invoked in a just loaded instance of myself,
to fetch the safe and extensionInfo from my first incarnation"
safeForOverwrittenMethods := myFirstIncarnation safeForOverwrittenMethods.
extensionOverwriteInfo := myFirstIncarnation extensionOverwriteInfo.
!
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"
^self loadAllClassesAsAutoloaded:asAutoloaded languages: ProgrammingLanguage all
"Created: / 17-08-2006 / 01:01:14 / cg"
"Modified: / 26-10-2006 / 12:30:01 / cg"
"Modified: / 16-08-2009 / 13:31:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Modified: / 19-06-2010 / 11:37:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
loadAllClassesAsAutoloaded:asAutoloaded languages: langs
"load (fileIn) classes in given languages 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.
langs should be collection of ProgrammingLanguage available in the system.
Answer true, if classes have been loaded"
|classNamesToLoad classNamesToAutoload classNamesToLangs hasClassesToLoad loadedClasses platformName
classesWhichFailedToLoad|
platformName := OperatingSystem platformName.
classNamesToLoad := OrderedCollection new.
classNamesToAutoload := OrderedCollection new.
classNamesToLangs := Dictionary new.
hasClassesToLoad := false.
self classNamesAndAttributesDo:[:eachClassname :eachAttributes |
|eachClassnameSym isAutoload clsLangAttr clsLang cls |
eachClassnameSym := eachClassname asSymbol.
isAutoload := asAutoloaded or:[eachAttributes includes:#autoload].
clsLangAttr := eachAttributes detect:[:a|a isArray and: [a size == 2 and:[a first == #lang]]] ifNone:[nil].
clsLang := clsLangAttr
ifNil:[SmalltalkLanguage instance]
ifNotNil:[ProgrammingLanguage named: clsLangAttr second ifNone:[nil]].
classNamesToLangs at: eachClassname put: clsLang.
"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]]) and:[clsLang notNil and:[langs includes: clsLang]]) ifTrue:[
(eachAttributes isEmpty
or:[(eachAttributes size == 1 and:[isAutoload])
or:[(eachAttributes includes:platformName)
or:[eachAttributes contains:[:a|a isArray]]]]) "/FIXME: Hack."
ifTrue:[
hasClassesToLoad := true.
isAutoload ifTrue:[
classNamesToAutoload add:eachClassnameSym.
] ifFalse:[
classNamesToLoad add:eachClassnameSym.
].
].
].
].
hasClassesToLoad ifTrue:[
loadedClasses := OrderedCollection new.
self packageDirectory isNil ifTrue:[
classNamesToLoad notEmpty ifTrue:[
"required classes are missing.
Autoloaded classes are considered as optional..."
self
error:(self name,'[error] cannot install because packageDirectory is unknown for missing classes: ', classNamesToLoad printString)
mayProceed:true.
^ false.
].
(self name,'[info] cannot install autoloaded classes because packageDirectory is unknown') infoPrintCR.
^ true.
].
"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 withIndexDo:[:eachClassName :index|
ActivityNotification
raiseRequestWith: ((100 / classNamesToAutoload size ) * index) rounded
errorString: 'Autoloading class ', eachClassName.
self loadClass: eachClassName asAutoloaded: true language: (classNamesToLangs at: eachClassName) .
].
classesWhichFailedToLoad := OrderedCollection new.
classNamesToLoad notEmpty ifTrue:[
Verbose == true ifTrue:[
Transcript showCR:(' %1: filing in missing classes (%2) individually...'
bindWith:self name with:classNamesToLoad size).
]
].
classNamesToLoad withIndexDo:[:eachClassName :index|
|cls|
ActivityNotification
raiseRequestWith: ((100 / classNamesToLoad size) * index) rounded
errorString: 'Loading class ', eachClassName.
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.
self loadClass: eachClassName asAutoloaded: true language: (classNamesToLangs at: eachClassName).
] do:[
Verbose == true ifTrue:[
Transcript showCR:(' %1: filing in %2...' bindWith:self name with:eachClassName).
].
cls := self loadClass: eachClassName asAutoloaded: false language: (classNamesToLangs at: eachClassName).
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 includesSelector:#initialize) ifTrue:[
eachLoadedClass initialize
].
].
^ true.
].
^ false.
"Modified: / 26-10-2006 / 12:30:01 / cg"
"Modified: / 16-08-2009 / 13:31:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 19-06-2010 / 11:35:49 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 19-06-2010 / 15:06:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
loadClass: className asAutoloaded: asAutoloaded language: lang
| packageDir classFile |
"Handle smalltalk classes specially to provide backward
compatibility"
lang isSmalltalk ifTrue:[
^asAutoloaded ifTrue:[
Smalltalk
installAutoloadedClassNamed: className
category: ((self abbrevs at: className ifAbsent:[#(nil nil nil #autoloaded)]) at: 4)
package: self package
revision: nil
numClassInstVars: ((self abbrevs at: className ifAbsent:[#(nil nil nil nil 0)]) at: 5)
] ifFalse: [
Smalltalk
fileInClass:className
package:self package
initialize:false
lazy:false
silent:true
]
].
"For non-smalltalk language do"
asAutoloaded ifTrue:[^self error:'Only Smalltalk classes may be autoloaded (yet)'].
packageDir := self packageDirectory asFilename.
classFile := packageDir / ((Smalltalk fileNameForClass: className) , '.' , lang sourceFileSuffix).
classFile exists ifFalse:[^nil].
lang fileIn: classFile.
^nil "FIXME: should return the class"
"Created: / 19-06-2010 / 09:11:41 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified: / 06-03-2011 / 18:29:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
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
].
Verbose == true ifTrue:[
Transcript showCR:(' %1: loading classLibrary...' bindWith:self name).
].
self activityNotification:'Loading classLibrary'.
^ Smalltalk fileInClassLibrary:libraryName inPackage:self package.
!
loadExtensions
"load extension methods - do not load if they are already present"
self hasAllExtensionsLoaded ifFalse:[
self breakPoint:#cg.
Verbose == true ifTrue:[
Transcript showCR:(' %1: filing in extensions...' bindWith:self name).
].
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."
|packagesToLoad packagesBefore|
packagesToLoad := aListOfPackages
reject:[:packageID |
|cls|
cls := ProjectDefinition definitionClassForPackage:packageID.
cls notNil and:[cls projectIsLoaded]
].
packagesToLoad isEmpty ifTrue:[^ self].
packagesBefore := PackagesBeingLoaded copy.
PackagesBeingLoaded isNil ifTrue:[
PackagesBeingLoaded := Set new
].
[
Class withoutUpdatingChangesDo:[
packagesToLoad do:[:aPackage |
(PackagesBeingLoaded includes:aPackage) ifFalse:[
PackagesBeingLoaded add:aPackage.
Smalltalk loadPackage:aPackage asAutoloaded:asAutoloaded.
]
].
].
] ensure:[
PackagesBeingLoaded := packagesBefore.
].
"Modified: / 09-12-2010 / 12:36:17 / cg"
!
loadPreRequisitesAsAutoloaded:asAutoloaded
"load other packages (at least the projectDefinitions and their extensions)"
|prereq|
prereq := self effectivePreRequisites.
prereq notEmptyOrNil ifTrue:[
Verbose == true ifTrue:[
Transcript showCR:(' %1 loading prerequisites...' bindWith:self name).
].
self loadPackages:prereq asAutoloaded:asAutoloaded
].
!
loadSubProjects
"load other packages (at least the projectDefinitions and their extensions)"
self loadSubProjectsAsAutoloaded:false.
self subProjects do:[:p |
|subDef|
subDef := self definitionClassForPackage:p.
subDef notNil ifTrue:[
subDef loadSubProjects
].
].
!
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"
!
old_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.
hasClassesToLoad := false.
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 withIndexDo:[:eachClassName :index|
ActivityNotification
raiseRequestWith: ((100 / classNamesToAutoload size ) * index) rounded
errorString: 'Autoloading class ', eachClassName.
Smalltalk
installAutoloadedClassNamed:eachClassName
category:#autoloaded "FIXME"
package:self package
revision:nil
numClassInstVars:0. "FIXME"
].
classesWhichFailedToLoad := OrderedCollection new.
classNamesToLoad notEmpty ifTrue:[
Verbose == true ifTrue:[
Transcript showCR:(' %1: filing in missing classes (%2) individually...'
bindWith:self name with:classNamesToLoad size).
]
].
classNamesToLoad withIndexDo:[:eachClassName :index|
|cls|
ActivityNotification
raiseRequestWith: ((100 / classNamesToLoad size) * index) rounded
errorString: 'Loading class ', eachClassName.
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:[
Verbose == true ifTrue:[
Transcript showCR:(' %1: filing in %2...' bindWith:self name with:eachClassName).
].
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 includesSelector:#initialize) ifTrue:[
eachLoadedClass initialize
].
].
^ true.
].
^ false.
"Modified: / 26-10-2006 / 12:30:01 / cg"
"Modified: / 16-08-2009 / 13:31:40 / Jan Vrany <vranyj1@fel.cvut.cz>"
"Created: / 19-06-2010 / 11:36:06 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
safeForOverwrittenMethods
^ safeForOverwrittenMethods
!
unloadAllClasses
Transcript showCR:'unloading not yet fully supported'
!
unloadClassLibrary
Transcript showCR:'unloading not yet fully supported'
!
unloadSubProjects
"unload other packages"
self subProjects do:[:p |
|subDef|
subDef := self definitionClassForPackage:p.
subDef notNil ifTrue:[
subDef unloadSubProjects.
subDef unloadPackage.
].
].
!
update:anAspectSymbol with:argument from:changedObject
"when any of my class methods is changed, we mark the project as unloaded.
May be some more classes have to be loaded"
(changedObject == self class and:[anAspectSymbol == #methodDictionary]) ifTrue:[
self projectIsLoaded:false.
]
! !
!ProjectDefinition class methodsFor:'private-prerequisites'!
addReferencesToClassesFromGlobalsIn:aSetOfClasses to:usedClassReasons
"helper for searchForPreRequisites"
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
"helper for searchForPreRequisites"
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:PackageId 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"
!
searchForPreRequisites: packageId
"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: packageId) 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:PackageId 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
self searchForPreRequisites:#'stx:libwidg3'
bosch_dapasx_Application searchForPreRequisites
bosch_dapasx_pav_browser searchForPreRequisites
"
"Modified: / 07-08-2006 / 21:56:25 / fm"
"Modified: / 20-09-2006 / 17:29:59 / cg"
"Created: / 17-11-2010 / 18:27:42 / Jan Vrany <jan.vrany@fit.cvut.cz>"
! !
!ProjectDefinition class methodsFor:'queries'!
allClassNames
^ self classNamesForWhich:[:nm :attr | true ].
!
allClasses
^ self allClassNames collect:[:nm | Smalltalk classNamed:nm]
"Created: / 06-08-2011 / 15:47:36 / cg"
!
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"
^ self classNamesAndAttributesAsSpecArray collect:[:entry | entry first].
"
stx_libhtml classNames
stx_libhtml classNamesAndAttributesAsSpecArray
"
!
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"
!
classes
"list my classes.
Project must be loaded - otherwise an error is reported here.
Use #classNames if you are only interested in the names"
^ self classNames collect:[:nm | Smalltalk at:nm ifAbsent:[self error:'Missing class']]
"
stx_libbasic3 classNames
stx_libbasic3 classes
"
!
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"
!
extensionClasses
"answer the set of classes, which are extended by the package"
|classes|
classes := IdentitySet new.
self extensionMethodNames pairWiseDo:[:className :selector |
|mthdCls cls|
mthdCls := Smalltalk classNamed:className.
(mthdCls notNil and:[mthdCls isLoaded]) ifTrue:[
cls := mthdCls theNonMetaclass.
(classes includes:cls) ifFalse:[
cls withAllSuperclassesDo:[:eachClass |
classes add:eachClass.
].
].
].
].
^ classes.
"
stx_libboss extensionClasses
"
!
extensionMethods
"list my extension methods.
Project must be loaded - otherwise an error is reported here.
Use #extensionMethodsNames if you are only interested in the names"
^ self extensionMethodNames
pairWiseCollect:[:className :selector |
(Smalltalk classNamed:className) compiledMethodAt:selector.
].
"
stx_libbasic2 extensionMethodNames
stx_libbasic2 extensionMethods
"
!
extensionPackages
"answer the set of packages, which are extended by this package"
^ self extensionClasses collect:[:eachClass| eachClass package]
"
stx_libboss extensionPackages
"
!
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 means: 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:[
Verbose == true 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:[
Verbose == true 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:[
(self name,' [info]: missing class: ',eachClassName) infoPrintCR.
^ false
].
(checkIfFullyLoaded and:[cls isLoaded not]) ifTrue:[
(self name,' [info]: unloaded class: ',eachClassName) infoPrintCR.
^ false.
].
].
^ true
!
hasExtensionMethods
^ self extensionMethodNames notEmpty
"Created: / 14-09-2006 / 14:19:35 / cg"
!
hasPostLoadAction
"/ true if postLoadAction has been redefined
^ (self class whichClassIncludesSelector:#postLoadAction) theNonMetaclass isAbstract not
!
hasPostUnloadAction
"/ true if postUnloadAction has been redefined
^ (self class whichClassIncludesSelector:#postUnloadAction) theNonMetaclass isAbstract not
!
hasPreLoadAction
"/ true if preLoadAction has been redefined
^ (self class whichClassIncludesSelector:#preLoadAction) theNonMetaclass isAbstract not
!
hasPreUnloadAction
"/ true if preUnloadAction has been redefined
^ (self class whichClassIncludesSelector:#preUnloadAction) theNonMetaclass isAbstract not
!
isFullyLoaded
^ self hasAllCompiledClassesFullyLoaded
and:[self hasAllClassesLoaded and:[self hasAllExtensionsLoaded]]
"Created: / 24-10-2006 / 23:52:23 / cg"
"Modified: / 09-12-2010 / 12:32:31 / cg"
!
projectType
^ self subclassResponsibility
! !
!ProjectDefinition class methodsFor:'queries-privacy'!
showClassDocumentationOf:aClass
"used by the HTMLDoc-generator to ask if a classes' protocol is to be documented
or hidden.
(used for expecco, to suppress documentation of workflow- and expecco classes
in the expecco-class browser)"
^ 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'!
isAbstract
^ self == ProjectDefinition
!
isApplicationDefinition
^ false
"Created: / 23-08-2006 / 15:17:32 / cg"
"Modified: / 20-09-2006 / 14:59:56 / cg"
!
isConsoleApplication
^ false
"Created: / 20-09-2006 / 14:59:49 / 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 "/ skip myself - I am abstract
"Created: / 10-08-2006 / 16:24:02 / cg"
"Modified: / 08-02-2011 / 10:03:49 / cg"
! !
!ProjectDefinition class methodsFor:'documentation'!
version_CVS
^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.342 2011-08-08 13:00:12 cg Exp $'
!
version_SVN
^ '§ Id: ProjectDefinition.st 10645 2011-06-09 15:28:45Z vranyj1 §'
! !
ProjectDefinition initialize!