hg/stx-libbasic: comparison ProjectDefinition.st

equal deleted inserted replaced

-:d17dbf11e306
+:2aa6ef1820fe
 ].
 ].
 ].
 self classNamesAndAttributes:newSpec usingCompiler:compilerOrNil
+!
+updateExtensionMethodNamesUsingCompiler:compilerOrNil
+"set the set of extension methods
+Because this requires compilation of my extensionMethodNames-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)"
+|newCode|
+newCode := self extensionMethodNames_code.
+(compilerOrNil ? self compilerClass)
+compile:newCode
+forClass:self theMetaclass
+inCategory:'description - contents'.
 ! !
 !ProjectDefinition class methodsFor:'accessing - tests'!
 aTwoArgBlock
 value: self excludedFromPreRequisites_code
 value: 'description'.
 ].
+aTwoArgBlock
+value: self subProjects_code
+value: 'description'.
 (self monticelloPackageName notNil and:[self respondsTo:#monticelloTimestamps_code]) ifTrue:[
 aTwoArgBlock
 value: self monticelloTimestamps_code
 value: 'description - monticello'.
 ].
 "Modified: / 08-08-2006 / 19:24:34 / fm"
 "Created: / 17-08-2006 / 21:28:09 / cg"
 "Modified: / 09-10-2006 / 14:27:20 / cg"
 !
+subProjects_code
+"generate the code of the #subProjects method.
+Returns nil if no such code is needed (because there are none)"
+^ String streamContents:[:s |
+s nextPutLine:'subProjects'.
+s nextPutLine:'    "list packages which are known as subprojects.'.
+s nextPutLine:'     The generated makefile will enter those and make there as well.'.
+s nextPutLine:'     However: they are not forced to be loaded when a package is loaded;'.
+s nextPutLine:'     for those, redefine requiredPrerequisites"'.
+s nextPutLine:''.
+s nextPutLine:'    ^ #('.
+ProjectDefinition allSubclassesDo:[:each |
+(each package startsWith:(self package,'/')) ifTrue:[
+s nextPutLine:'        #''',each package,''''.
+]
+].
+s nextPutLine:'    )'
+].
+!
 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"'.
 !
 subProjects
 "list packages which are known as subprojects.
 The generated makefile will enter those and make there as well.
-However: they are not forced to be loaded when a package is loaded; for those,
+However: they are not forced to be loaded when a package is loaded;
-redefine requiredPrerequisites."
+for those, redefine requiredPrerequisites."
 ^ #()
 "Modified: / 17-08-2006 / 19:57:46 / cg"
 ! !
 These methods are now in my safe"
 ^ safeForOverwrittenMethods notEmptyOrNil
 !
-methodOverwrittenBy:aMethod
+methodOverwrittenBy:anExtensionMethod
 "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.
+mclass := anExtensionMethod mclass.
-selector := aMethod selector.
+selector := anExtensionMethod selector.
 oldPackage := extensionOverwriteInfo at:(mclass name,'>>',selector) ifAbsent:nil.
 oldPackage isNil ifTrue:[^ nil].
 ^ oldPackage asPackageId projectDefinitionClass
 savedOverwrittenMethodForClass:mclass selector:selector.
 !
 ].
 safeForOverwrittenMethods isNil ifTrue:[
 safeForOverwrittenMethods := Dictionary new.
 ].
-safeForOverwrittenMethods at:(aClass name -> selector) put:oldMethod.
+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."
+which got overloaded by me.
+Unfinished!!"
 self extensionMethodNames pairWiseDo:[:className :selector |
 |class oldMethod oldPackage|
 oldPackage := extensionOverwriteInfo at:(className,'>>',selector).
 savedOverwrittenMethodForClass:aClass selector:aSelector
 "return one of my saved original methods"
 safeForOverwrittenMethods isNil ifTrue:[^ nil].
 ^ safeForOverwrittenMethods at:(aClass name,'>>',aSelector) ifAbsent:nil
+!
+savedOverwrittenMethods
+"return my saved original methods"
+^ safeForOverwrittenMethods ? #()
 ! !
 !ProjectDefinition class methodsFor:'private-loading'!
 checkPrerequisitesForLoading
 "Modified: / 07-08-2006 / 21:25:25 / fm"
 "Created: / 30-08-2007 / 18:48:09 / cg"
 !
+canHaveExtensions
+"return true, if this class allows extensions from other packages.
+Private classes, namespaces and projectDefinitions don't allow this"
+^ self isAbstract
+"
+Smalltalk allClasses select:[:each | each canHaveExtensions not]
+"
+"Created: / 30-08-2006 / 15:29:49 / cg"
+!
 classNames
 "answer an array containing all the class names of the project's classes"
 ^ self classNamesAndAttributesAsSpecArray collect:[:entry | entry first].
 !ProjectDefinition class methodsFor:'sanity checks'!
 validateDescription
 "perform some consistency checks (set of classes in project same as those listed in description);
-called before checking in build support files"
+called before checking in build support files.
+Somewhat obsolete: use the ProjectChecker, which does more checks"
 |emptyProjects nonProjects emptyOrNonProjects classesInImage
 classesInDescription onlyInImage onlyInDescription missingPools myPackage|
 emptyProjects := Set withAll:self subProjects.
 missingPools add:eachPoolName.
 ].
 ].
 ].
 ].
 missingPools notEmpty ifTrue:[
 (Dialog
 confirm:('The following sharedpools are non-existent, or not pools:\\    '
 , ((missingPools
 asSortedCollection
 ifFalse:[
 AbortSignal raise
 ].
 ].
+"/ also found by ProjectChecker...
 classesInImage ~= classesInDescription ifTrue:[
 onlyInImage := (classesInImage reject:[:cls | classesInDescription includes:cls]).
 onlyInImage notEmpty ifTrue:[
 Transcript show:self name; show:': only in image: '; showCR:onlyInImage
 ].
 ].
 (Dialog confirm:'The set of classes in the image is different from the listed classes in the project definition.\\Proceed?' withCRs) ifFalse:[
 AbortSignal raiseRequest
 ]
 ].
 "/    self validateOrderOfClasses
 "
 squeak_vmMaker validateDescription
 "
 !
 isProjectDefinition
 "concrete i.e. not abstract"
-^ self ~~ ProjectDefinition "/ skip myself - I am abstract
+^ self isAbstract not
 "Created: / 10-08-2006 / 16:24:02 / cg"
 "Modified: / 08-02-2011 / 10:03:49 / cg"
 ! !
 ! !
 !ProjectDefinition class methodsFor:'documentation'!
 version
-^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.439 2013-03-26 13:21:07 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
 !
 version_CVS
-^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.439 2013-03-26 13:21:07 cg Exp $'
+^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.444 2013-03-27 19:36:15 cg Exp $'
 !
 version_HG
 ^ '$Changeset: <not expanded> $'

branch	jv
changeset 18042	2aa6ef1820fe
parent 18040	a11a12546f23
parent 14988	3c06d7207200
child 18043	03660093fe98