class: Tools::NewSystemBrowser
added:5 methods
changed:
#browseMenuClassesReferringToPool
#classMenu
--- 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