checkin from browser
authorClaus Gittinger <cg@exept.de>
Sat, 09 Oct 1999 14:21:46 +0200
changeset 4887 f9e375e800a8
parent 4886 63d9275b8210
child 4888 8a44ac394b75
checkin from browser
Project.st
--- a/Project.st	Sat Oct 09 13:36:00 1999 +0200
+++ b/Project.st	Sat Oct 09 14:21:46 1999 +0200
@@ -167,10 +167,10 @@
     Method allSubInstancesDo:[:aMethod |
         |packageID prj who mthdClass|
 
-        packageID := aMethod package asSymbol.
-        (packages includesKey:packageID) ifFalse:[
-            who := aMethod who.
-            who notNil ifTrue:[ "/ skip unbound methods ...
+        who := aMethod who.
+        who notNil ifTrue:[ "/ skip unbound methods ...
+            packageID := aMethod package asSymbol.
+            (packages includesKey:packageID) ifFalse:[
                 "/ a new one ...
                 prj := self new.
         "/            prj name:libName.
@@ -182,6 +182,14 @@
                 prj isLoaded:true.
                 AllProjects add:prj.
                 packages at:packageID put:prj.
+            ] ifTrue:[
+                "/ see if the methods class is in the project;
+                "/ if so, remove any patch-entry for this method.
+                prj := packages at:packageID.
+                ((prj classes includes:who methodClass)
+                or:[prj classes includes:who methodClass name]) ifTrue:[
+                    prj removeMethod:aMethod.
+                ]
             ]
         ]
     ].
@@ -1577,7 +1585,6 @@
 ''loading package ' , myPackage , ' ...'' infoPrintCR.
 
 files := #(
-.
 '.
 
     classes do:[:cls |
@@ -1595,8 +1602,7 @@
                 fileName := fileName , '.st'
             ].
             fileName printOn:out.
-            out nextPutAll:'.st'''.
-            out cr.
+            out nextPutAll:''''; cr.
         ]
     ].
     (methodsFile := self propertyAt:#methodsFile) size > 0 ifTrue:[
@@ -1632,7 +1638,7 @@
 ].
 '' '' infoPrintCR.
 '' done (' , myPackage , ').'' infoPrintCR.
-.'.
+'.
 
     out close
 !
@@ -2581,34 +2587,32 @@
 
     |infoCollection index nm prefix|
 
-    (infoCollection := self methodInfo) isNil ifTrue:[
-	self methodInfo:(infoCollection := OrderedCollection new).
-    ].
+    infoCollection := self methodInfo.
 
     index := infoCollection findFirst:[:i | |cnm1 cnm2|
-					cnm1 := i className.
-					cnm2 := newInfo className.
-					(cnm1 includes:$:) ifFalse:[
-					    cnm1 := self defaultNameSpace name , '::' , cnm1
-					].
-					(cnm2 includes:$:) ifFalse:[
-					    cnm2 := self defaultNameSpace name , '::' , cnm2
-					].
-					cnm1 = cnm2 and:[i methodName = newInfo methodName]
-				      ].
+                                        cnm1 := i className.
+                                        cnm2 := newInfo className.
+                                        (cnm1 includes:$:) ifFalse:[
+                                            cnm1 := self defaultNameSpace name , '::' , cnm1
+                                        ].
+                                        (cnm2 includes:$:) ifFalse:[
+                                            cnm2 := self defaultNameSpace name , '::' , cnm2
+                                        ].
+                                        cnm1 = cnm2 and:[i methodName = newInfo methodName]
+                                      ].
     "/ strip off nameSpace prefix, if its the same as
     "/ the default ...
 
     nm := newInfo className.
     prefix := self defaultNameSpace name , '::'.
     (nm startsWith:prefix) ifTrue:[
-	nm := nm copyFrom:(prefix size + 1).
-	newInfo className:nm asSymbol.
+        nm := nm copyFrom:(prefix size + 1).
+        newInfo className:nm asSymbol.
     ].
     index ~~ 0 ifTrue:[
-	infoCollection at:index put:newInfo
+        infoCollection at:index put:newInfo
     ] ifFalse:[
-	infoCollection add:newInfo
+        infoCollection add:newInfo
     ]
 !
 
@@ -2714,7 +2718,7 @@
 
     |infoCollection index className selector|
 
-    (infoCollection := self methodInfo) isNil ifTrue:[^ self].
+    (infoCollection := self methodInfo) size == 0 ifTrue:[^ self].
     className := method who methodClass name.
     selector := method who methodSelector.
 
@@ -2859,6 +2863,59 @@
     "Modified: 4.1.1997 / 16:51:18 / cg"
 !
 
+includesClass:aClassOrClassName
+    "return true, if a class is contained in the project"
+
+    |infoCollection index className|
+
+    (infoCollection := self classInfo) isNil ifTrue:[^ false].
+
+    aClassOrClassName isBehavior ifTrue:[
+        className := aClassOrClassName name
+    ] ifFalse:[
+        className := aClassOrClassName
+    ].
+
+    index := infoCollection findFirst:[:i | |nm1 nm2|
+                                        i className = className
+                                      ].
+    ^ index ~~ 0 
+!
+
+includesMethod:aMethod
+    "return true, if the given method is contained in the project
+     (either as patch/extension or as class"
+
+    |who methodClass|
+
+    who := aMethod who.
+    who isNil ifTrue:[^ false].
+    methodClass := who methodClass.
+    (self includesClass:methodClass) ifTrue:[^ true].
+    ^ self includesMethodPatch:aMethod
+!
+
+includesMethodPatch:aMethod
+    "return true, if the given method is contained in the project
+     as patch/extension"
+
+    |who methodClass methodClassName methodSelector infoCollection index className selector|
+
+    who := aMethod who.
+    who isNil ifTrue:[^ false].
+    methodClass := who methodClass.
+    methodClassName := methodClass name.
+    methodSelector := who methodSelector.
+
+    infoCollection := self methodInfo.
+
+    index := infoCollection findFirst:[:i | 
+                        (i className = methodClassName 
+                        and:[i methodName = methodSelector])
+             ].
+    ^ index ~~ 0 
+!
+
 individualMethods
     "return a collection of individual methods belonging to that project,
      only methods are returned which are not contained in the
@@ -3261,6 +3318,6 @@
 !Project class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.123 1999-10-09 11:36:00 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Project.st,v 1.124 1999-10-09 12:21:46 cg Exp $'
 ! !
 Project initialize!