--- a/ProjectDefinition.st Mon Oct 12 19:17:14 2009 +0200
+++ b/ProjectDefinition.st Mon Oct 12 19:26:08 2009 +0200
@@ -3870,7 +3870,7 @@
[:package |
(package ~= myPackageID) ifTrue:[
true "(package startsWith:'stx:') not" ifTrue:[
- package ~= Project noProjectID ifTrue:[
+ package ~= PackageId noProjectID ifTrue:[
requiredPackages add:package.
]
]
@@ -3953,7 +3953,7 @@
myPackage := self package.
^ Smalltalk allProjectIDs
select:[:projectID |
- projectID ~= Project noProjectID
+ projectID ~= PackageId noProjectID
and:[ (projectID asPackageId parentPackage) = myPackage ]].
"
@@ -3992,6 +3992,20 @@
^ 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|
+
+ mclass := aMethod mclass.
+ selector := aMethod selector.
+ oldPackage := extensionOverwriteInfo at:(mclass name,'>>',selector) ifAbsent:nil.
+ oldPackage isNil ifTrue:[^ nil].
+ ^ oldPackage asPackageId projectDefinition
+ 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.
@@ -4000,18 +4014,22 @@
b) correct unloading of myself"
self extensionMethodNames pairWiseDo:[:className :selector |
- |class oldMethod oldPackage|
+ |class oldMethod oldPackage defClass|
class := Smalltalk classNamed:className.
oldMethod := class compiledMethodAt:selector.
oldMethod notNil ifTrue:[
- oldPackage := oldMethod package asPackageId.
- oldPackage projectDefinitionClass
- rememberOverwrittenMethod:oldMethod inClass:class.
- extensionOverwriteInfo isNil ifTrue:[
- extensionOverwriteInfo := Dictionary new.
+ 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.
+ ]
].
- extensionOverwriteInfo at:(className,'>>',selector) put:oldPackage.
].
].
!
@@ -4045,6 +4063,12 @@
safeForOverwrittenMethods := Dictionary new.
].
safeForOverwrittenMethods at:(aClass name -> selector) put:oldMethod.
+!
+
+savedOverwrittenMethodForClass:aClass selector:aSelector
+ "return one of my saved original methods"
+
+ ^ safeForOverwrittenMethods at:(aClass name,'>>',aSelector)
! !
!ProjectDefinition class methodsFor:'private-loading'!
@@ -4322,7 +4346,7 @@
ifFalse:[ self searchForSubProjects ]) asSet.
ignoredPackages add:self package.
- ignoredPackages add:Project noProjectID.
+ ignoredPackages add:PackageId noProjectID.
"now map classes to packages and collect the reasons"
requiredPackageReasons := Dictionary new.
@@ -4597,11 +4621,11 @@
!ProjectDefinition class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.243 2009-10-12 16:45:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.244 2009-10-12 17:26:08 cg Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.243 2009-10-12 16:45:41 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libbasic/ProjectDefinition.st,v 1.244 2009-10-12 17:26:08 cg Exp $'
! !
ProjectDefinition initialize!