*** empty log message ***
authorClaus Gittinger <cg@exept.de>
Tue, 20 May 2003 12:36:12 +0200
changeset 4918 306a94fac04a
parent 4917 9f2476c53513
child 4919 482c78fef912
*** empty log message ***
NewSystemBrowser.st
Tools__NewSystemBrowser.st
--- a/NewSystemBrowser.st	Mon May 19 20:44:37 2003 +0200
+++ b/NewSystemBrowser.st	Tue May 20 12:36:12 2003 +0200
@@ -6300,6 +6300,13 @@
                   #enabled: #hasMethodSelectedHolder
                 )
                #(#MenuItem
+                  #label: 'Buffer with Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensionsBuffer
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
+               #(#MenuItem
                   #label: '-'
                 )
                #(#MenuItem
@@ -6332,6 +6339,13 @@
                   #value: #selectorMenuSpawnSenders
                   #enabled: #hasMethodSelectedHolder
                 )
+               #(#MenuItem
+                  #label: 'Browser on Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensions
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
                )
               nil
               nil
@@ -7684,6 +7698,13 @@
                   #enabled: #hasMethodSelectedHolder
                 )
                #(#MenuItem
+                  #label: 'Buffer with Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensionsBuffer
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
+               #(#MenuItem
                   #label: '-'
                 )
                #(#MenuItem
@@ -7720,6 +7741,13 @@
                   #value: #selectorMenuSpawnSenders
                   #enabled: #hasMethodSelectedHolder
                 )
+               #(#MenuItem
+                  #label: 'Browser on Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensions
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
                )
               nil
               nil
@@ -10967,6 +10995,17 @@
     "Created: / 4.2.2000 / 22:11:34 / cg"
 !
 
+hasExtensionMethodSelected
+    ^ self selectedMethods value ? #()
+        contains:[:aMethod | aMethod package ~= aMethod containingClass package ]
+!
+
+hasExtensionMethodSelectedHolder
+    ^ BlockValue
+        with:[:m | m value and:[self hasExtensionMethodSelected]] 
+        argument:(self hasMethodSelectedHolder)
+!
+
 hasFindHistoryClassesHolder
     ^ [ FindHistory size > 0 ]
 
@@ -25011,6 +25050,18 @@
     ]
 !
 
+selectorMenuPrintOut
+    "print out the current method(s)"
+
+    |printStream|
+
+    printStream := Printer new.
+    self selectedMethodsDo:[:eachMethod |
+        eachMethod mclass printOutSource:(eachMethod source) on:printStream.
+    ].
+    printStream close
+!
+
 selectorMenuProcess
     "process methods"
 
@@ -25439,6 +25490,24 @@
         label:nil
 !
 
+selectorMenuSpawnProjectExtensions
+    "open a new browser  showing all extension methods for the 
+     selected methods project(s)"
+
+    ^ self 
+        spawnProjectExtensionsBrowserFor:(self selectedMethods value) 
+        in:#newBrowser 
+!
+
+selectorMenuSpawnProjectExtensionsBuffer
+    "add a new buffer showing all extension methods for the 
+     selected methods project(s)"
+
+    ^ self 
+        spawnProjectExtensionsBrowserFor:(self selectedMethods value) 
+        in:#newBuffer 
+!
+
 selectorMenuSpawnSenders
     "open a new browser showing senders of the selected method"
 
@@ -26047,6 +26116,75 @@
     ]
 !
 
+spawnProjectExtensionsBrowserFor:aMethodCollection in:openHow
+    "open a new browser or add a buffer showing the selected methods senders only"
+
+    |label|
+
+    self withSearchCursorDo:[
+        |packages cachedList newBrowser theSinglePackage searchBlock|
+
+        packages := (aMethodCollection collect:[:each | each package]) asSet.        
+        packages size == 1 ifTrue:[
+            theSinglePackage := packages first.
+            label := 'Extensions for %1' bindWith:theSinglePackage.
+        ] ifFalse:[
+            label := 'Extensions'.
+        ].
+
+        searchBlock := [
+                            |l|
+
+                            cachedList notNil ifTrue:[
+                                l := cachedList.
+                                cachedList := nil
+                            ] ifFalse:[
+                                l := IdentitySet new.
+                                Smalltalk allClasses do:[:eachClass |
+                                    |cPackage|
+
+                                    cPackage := eachClass package.
+                                    eachClass instAndClassMethodsDo:[:eachMethod |
+                                        |mPackage|
+
+                                        mPackage := eachMethod package.
+                                        mPackage ~= cPackage ifTrue:[
+                                            (theSinglePackage notNil 
+                                                ifTrue:[theSinglePackage = mPackage]
+                                                ifFalse:[packages includes:mPackage])
+                                            ifTrue:[    
+                                                l add:eachMethod
+                                            ]
+                                        ]
+                                    ]
+                                ].
+                                l := l asOrderedCollection
+                            ].
+                            l
+                       ].
+
+        theSinglePackage notNil ifTrue:[
+            cachedList := searchBlock value.
+            cachedList size == 0 ifTrue:[
+                self information:(label , ' - none found').
+                ^ self
+            ].
+            (cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
+                (self confirm:((label bindWith:label) , ' - only the selected method found.\\Browse anyway ?' withCRs))
+                ifFalse:[
+                    ^ self
+                ]
+            ].
+        ].
+
+        newBrowser := self 
+                        spawnMethodBrowserForSearch:searchBlock
+                        sortBy:#class
+                        in:openHow
+                        label:label.
+    ]
+!
+
 spawnSenderChainBrowser
     "browse selected methods sender chain"
 
@@ -55943,7 +56081,7 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.583 2003-05-19 09:24:39 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Attic/NewSystemBrowser.st,v 1.584 2003-05-20 10:36:12 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!
--- a/Tools__NewSystemBrowser.st	Mon May 19 20:44:37 2003 +0200
+++ b/Tools__NewSystemBrowser.st	Tue May 20 12:36:12 2003 +0200
@@ -6300,6 +6300,13 @@
                   #enabled: #hasMethodSelectedHolder
                 )
                #(#MenuItem
+                  #label: 'Buffer with Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensionsBuffer
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
+               #(#MenuItem
                   #label: '-'
                 )
                #(#MenuItem
@@ -6332,6 +6339,13 @@
                   #value: #selectorMenuSpawnSenders
                   #enabled: #hasMethodSelectedHolder
                 )
+               #(#MenuItem
+                  #label: 'Browser on Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensions
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
                )
               nil
               nil
@@ -7684,6 +7698,13 @@
                   #enabled: #hasMethodSelectedHolder
                 )
                #(#MenuItem
+                  #label: 'Buffer with Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensionsBuffer
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
+               #(#MenuItem
                   #label: '-'
                 )
                #(#MenuItem
@@ -7720,6 +7741,13 @@
                   #value: #selectorMenuSpawnSenders
                   #enabled: #hasMethodSelectedHolder
                 )
+               #(#MenuItem
+                  #label: 'Browser on Extensions for Project'
+                  #translateLabel: true
+                  #isVisible: #hasExtensionMethodSelectedHolder
+                  #value: #selectorMenuSpawnProjectExtensions
+                  #enabled: #hasExtensionMethodSelectedHolder
+                )
                )
               nil
               nil
@@ -10967,6 +10995,17 @@
     "Created: / 4.2.2000 / 22:11:34 / cg"
 !
 
+hasExtensionMethodSelected
+    ^ self selectedMethods value ? #()
+        contains:[:aMethod | aMethod package ~= aMethod containingClass package ]
+!
+
+hasExtensionMethodSelectedHolder
+    ^ BlockValue
+        with:[:m | m value and:[self hasExtensionMethodSelected]] 
+        argument:(self hasMethodSelectedHolder)
+!
+
 hasFindHistoryClassesHolder
     ^ [ FindHistory size > 0 ]
 
@@ -25011,6 +25050,18 @@
     ]
 !
 
+selectorMenuPrintOut
+    "print out the current method(s)"
+
+    |printStream|
+
+    printStream := Printer new.
+    self selectedMethodsDo:[:eachMethod |
+        eachMethod mclass printOutSource:(eachMethod source) on:printStream.
+    ].
+    printStream close
+!
+
 selectorMenuProcess
     "process methods"
 
@@ -25439,6 +25490,24 @@
         label:nil
 !
 
+selectorMenuSpawnProjectExtensions
+    "open a new browser  showing all extension methods for the 
+     selected methods project(s)"
+
+    ^ self 
+        spawnProjectExtensionsBrowserFor:(self selectedMethods value) 
+        in:#newBrowser 
+!
+
+selectorMenuSpawnProjectExtensionsBuffer
+    "add a new buffer showing all extension methods for the 
+     selected methods project(s)"
+
+    ^ self 
+        spawnProjectExtensionsBrowserFor:(self selectedMethods value) 
+        in:#newBuffer 
+!
+
 selectorMenuSpawnSenders
     "open a new browser showing senders of the selected method"
 
@@ -26047,6 +26116,75 @@
     ]
 !
 
+spawnProjectExtensionsBrowserFor:aMethodCollection in:openHow
+    "open a new browser or add a buffer showing the selected methods senders only"
+
+    |label|
+
+    self withSearchCursorDo:[
+        |packages cachedList newBrowser theSinglePackage searchBlock|
+
+        packages := (aMethodCollection collect:[:each | each package]) asSet.        
+        packages size == 1 ifTrue:[
+            theSinglePackage := packages first.
+            label := 'Extensions for %1' bindWith:theSinglePackage.
+        ] ifFalse:[
+            label := 'Extensions'.
+        ].
+
+        searchBlock := [
+                            |l|
+
+                            cachedList notNil ifTrue:[
+                                l := cachedList.
+                                cachedList := nil
+                            ] ifFalse:[
+                                l := IdentitySet new.
+                                Smalltalk allClasses do:[:eachClass |
+                                    |cPackage|
+
+                                    cPackage := eachClass package.
+                                    eachClass instAndClassMethodsDo:[:eachMethod |
+                                        |mPackage|
+
+                                        mPackage := eachMethod package.
+                                        mPackage ~= cPackage ifTrue:[
+                                            (theSinglePackage notNil 
+                                                ifTrue:[theSinglePackage = mPackage]
+                                                ifFalse:[packages includes:mPackage])
+                                            ifTrue:[    
+                                                l add:eachMethod
+                                            ]
+                                        ]
+                                    ]
+                                ].
+                                l := l asOrderedCollection
+                            ].
+                            l
+                       ].
+
+        theSinglePackage notNil ifTrue:[
+            cachedList := searchBlock value.
+            cachedList size == 0 ifTrue:[
+                self information:(label , ' - none found').
+                ^ self
+            ].
+            (cachedList size == 1 and:[cachedList first == self theSingleSelectedMethod]) ifTrue:[
+                (self confirm:((label bindWith:label) , ' - only the selected method found.\\Browse anyway ?' withCRs))
+                ifFalse:[
+                    ^ self
+                ]
+            ].
+        ].
+
+        newBrowser := self 
+                        spawnMethodBrowserForSearch:searchBlock
+                        sortBy:#class
+                        in:openHow
+                        label:label.
+    ]
+!
+
 spawnSenderChainBrowser
     "browse selected methods sender chain"
 
@@ -55943,7 +56081,7 @@
 !NewSystemBrowser class methodsFor:'documentation'!
 
 version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.583 2003-05-19 09:24:39 cg Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowser.st,v 1.584 2003-05-20 10:36:12 cg Exp $'
 ! !
 
 NewSystemBrowser initialize!