class: Tools::NewSystemBrowser
authorClaus Gittinger <cg@exept.de>
Wed, 03 Apr 2013 17:43:53 +0200
changeset 12634 b4a405095ab4
parent 12633 9f6eace86016
child 12635 3fea79e9a79b
class: Tools::NewSystemBrowser added:5 methods changed: #browseMenuClassesReferringToPool #classMenu
Tools__NewSystemBrowser.st
--- a/Tools__NewSystemBrowser.st	Wed Apr 03 15:51:38 2013 +0200
+++ b/Tools__NewSystemBrowser.st	Wed Apr 03 17:43:53 2013 +0200
@@ -7767,7 +7767,7 @@
                (MenuItem
                   enabled: hasClassSelectedHolder
                   label: 'Buffer with Class(es)'
-                  itemValue: classMenuSpawnClassesBuffer
+                  itemValue: classMenuSpawnClassBuffer
                   isVisible: #'isLintResultBrowserHolder_and_isNotEmbeddedBrowserHolder'
                 )
                (MenuItem
@@ -7825,7 +7825,7 @@
                (MenuItem
                   enabled: hasClassSelectedHolder
                   label: 'Browser on Class(es)'
-                  itemValue: classMenuSpawnClassesBuffer
+                  itemValue: classMenuSpawnClass
                   isVisible: isLintResultBrowserHolder
                 )
                (MenuItem
@@ -23293,6 +23293,60 @@
 
 !NewSystemBrowser methodsFor:'menu actions-browse'!
 
+browseClassesReferringToAnyPool:poolsArg in:doWhat
+    "open a dialog asking for a poolname; search for classes importing that pool."
+
+    |pools poolNameString classes|
+
+    poolsArg isEmptyOrNil ifTrue:[
+        ^ self
+    ].
+    pools := poolsArg 
+                collect:[:poolOrName |
+                    |p|
+                    poolOrName isSharedPool ifTrue:[
+                        poolOrName
+                    ] ifFalse:[
+                        p := Smalltalk classNamed:poolNameString.
+                        (p notNil and:[p isSharedPool]) ifTrue:[
+                            p
+                        ] ifFalse:[
+                            nil
+                        ]
+                    ]
+                 ]
+                  thenSelect:[:p | p notNil].
+    pools isEmptyOrNil ifTrue:[
+        ^ self
+    ].
+
+    classes := Smalltalk allClasses
+                select:[:cls | 
+                        cls isMeta not and:[(cls sharedPools includesAny:pools)]
+                ].
+
+    classes size == 0 ifTrue:[
+        self information:'None found.'.
+        ^ self
+    ].
+    classes := classes asOrderedCollection sort:[:a :b | a name < b name].
+
+    (doWhat == #newBrowser or:[ doWhat == #newBuffer ]) ifTrue:[
+        pools size == 1 ifTrue:[
+            poolNameString := pools first name
+        ] ifFalse:[
+            poolNameString := (resources string:'any of %1 pools' with:pools size)
+        ].
+        self
+            spawnClassBrowserFor:classes
+            label:(resources string:'Classes Referring to %1' with:poolNameString)
+            in:doWhat select:false.
+        ^ self
+    ].
+
+    self selectClasses:classes.
+!
+
 browseImplementorsOf
     "launch an enterBox for selector to search for"
 
@@ -23776,7 +23830,7 @@
 browseMenuClassesReferringToPool
     "open a dialog asking for a poolname; search for classes importing that pool."
 
-    |box title okText okText2 okText3 poolNameString pool list button2 button3 doWhat doWhat2 doWhat3 classes|
+    |box title okText okText2 okText3 poolNameString pool list button2 button3 doWhat doWhat2 doWhat3|
 
     title := 'Browse/Search Class(es) which refer to a Pool:\'.
     okText2 := 'Open'.      doWhat2 := #newBrowser.
@@ -23843,25 +23897,7 @@
         Dialog warn:'Not a sharedPool: ',poolNameString.
         ^ self.
     ].
-
-    classes := Smalltalk allClasses
-                select:[:cls | cls isMeta not and:[(cls sharedPools includes:pool)] ].
-
-    classes size == 0 ifTrue:[
-        self information:'None found.'.
-        ^ self
-    ].
-    classes := classes asOrderedCollection sort:[:a :b | a name < b name].
-
-    (doWhat == #newBrowser or:[ doWhat == #newBuffer ]) ifTrue:[
-        self
-            spawnClassBrowserFor:classes
-            label:(resources string:'Classes Referring to %1' with:poolNameString)
-            in:doWhat select:false.
-        ^ self
-    ].
-
-    self selectClasses:classes.
+    self browseClassesReferringToAnyPool:(Array with:pool) in:doWhat
 !
 
 browseMenuClassesWithFilter:aFilterBlock label:aLabelString
@@ -25390,6 +25426,24 @@
     "Modified: / 28-02-2012 / 16:15:36 / cg"
 !
 
+classMenuSpawnBufferWithPoolVariableReferences
+    "search for classes importing the selectred pool(s)"
+
+    |pools|
+
+    pools := self selectedClasses value select:[:cls | cls isSharedPool].
+    self browseClassesReferringToAnyPool:pools in:#newBuffer
+!
+
+classMenuSpawnPoolVariableReferences
+    "search for classes importing the selectred pool(s)"
+
+    |pools|
+
+    pools := self selectedClasses select:[:cls | cls isSharedPool].
+    self browseClassesReferringToAnyPool:pools in:#newBrowser
+!
+
 defaultSearchArea
     "return a useful default seach area"
 
@@ -58244,11 +58298,11 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1860 2013-04-02 16:06:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1861 2013-04-03 15:43:53 cg Exp $'
 !
 
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1860 2013-04-02 16:06:50 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.1861 2013-04-03 15:43:53 cg Exp $'
 !
 
 version_SVN