Class.st
changeset 10084 f6af35f81242
parent 10078 1be7d1df3829
child 10102 729c151ddff1
--- a/Class.st	Thu Oct 12 20:34:25 2006 +0200
+++ b/Class.st	Thu Oct 12 21:33:18 2006 +0200
@@ -3202,26 +3202,38 @@
     "Modified: / 18-09-2006 / 20:37:16 / cg"
 !
 
+extensions
+    "return a collection of extension-methods from any package, or empty if there are none."
+
+    |classPackage|
+
+    classPackage := self package.
+    ^ self instAndClassMethods select:[:mthd | mthd package ~= classPackage]
+
+    "
+     CType extensions
+     Rectangle extensions
+     Rectangle hasExtensions
+    "
+
+    "Created: / 12-10-2006 / 18:29:51 / cg"
+    "Modified: / 12-10-2006 / 20:18:36 / cg"
+!
+
 extensionsFrom:aPackageID
     "return the set of extension-methods from the given package."
 
-    |methods|
-
-    aPackageID == self package ifTrue:[^ #() ].
-
-    methods := OrderedCollection new.
-    self instAndClassSelectorsAndMethodsDo:[:sel :mthd |
-        mthd package = aPackageID ifTrue:[
-            methods add:mthd
-        ]
-    ].
-    ^ methods
+    aPackageID = self package ifTrue:[^ #() ].
+    ^ self instAndClassMethods select:[:mthd | mthd package = aPackageID]
 
     "
-     CType extensionsFrom:'bosch::dapasx'
+     CType extensionsFrom:#'bosch:dapasx'
+     Rectangle extensionsFrom:#'bosch:dapasx/support'
+     Rectangle extensions
     "
 
     "Created: / 07-08-2006 / 22:02:15 / fm"
+    "Modified: / 12-10-2006 / 20:41:35 / cg"
 !
 
 hasExtensions
@@ -3232,23 +3244,24 @@
 
     |clsPkg defaultPkg|
 
-    defaultPkg := Project defaultProject package.
+    defaultPkg := Project noProjectID.
     clsPkg := self package.
-    self instAndClassSelectorsAndMethodsDo:[:sel :mthd |
-        |mthdPkg|
-
-        mthdPkg := mthd package.
-        mthdPkg ~= clsPkg ifTrue:[
-            mthdPkg ~= defaultPkg ifTrue:[
-                ^ true
-            ]
+    ^ self instAndClassMethods 
+        contains:[:mthd | |mthdPkg|
+            ((mthdPkg := mthd package) ~= clsPkg) and:[ mthdPkg ~= defaultPkg ]
         ].
-    ].
-    ^ false
 
     "
      Smalltalk allClasses select:[:each | each hasExtensions]
+
+     Dictionary 
+        withAssociations:
+            (Smalltalk allClasses 
+                select:[:each | each hasExtensions]
+                thenCollect:[:each | each -> each extensions])
     "
+
+    "Modified: / 12-10-2006 / 20:40:18 / cg"
 !
 
 hasExtensionsFrom:aPackageID
@@ -3257,14 +3270,22 @@
      Those are class extensions, which must be treated specially when checking classes
      into the sourceCode repository. (extensions are stored separate)"
 
-    self instAndClassSelectorsAndMethodsDo:[:sel :mthd |
-        mthd package = aPackageID ifTrue:[^ true].
-    ].
-    ^ false
+    |clsPkg|
+
+    clsPkg := self package.
+    aPackageID = clsPkg ifTrue:[^ #()].
+
+    ^ self instAndClassMethods 
+        contains:[:mthd | mthd package = aPackageID]
 
     "
-     Smalltalk allClasses select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
+     Smalltalk allClasses 
+        select:[:each | each hasExtensionsFrom:'stx:goodies/refactyBrowser']
+     Smalltalk allClasses 
+        select:[:each | each hasExtensionsFrom:'stx:libboss']
     "
+
+    "Modified: / 12-10-2006 / 20:42:10 / cg"
 !
 
 isBrowserStartable
@@ -4683,5 +4704,5 @@
 !Class class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.515 2006-10-12 13:50:11 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libbasic/Class.st,v 1.516 2006-10-12 19:33:18 cg Exp $'
 ! !