Support for implementors/senders menu. development
authorJan Vrany <jan.vrany@fit.cvut.cz>
Wed, 25 Sep 2013 10:27:55 +0100
branchdevelopment
changeset 2776 bf52a1e5701b
parent 2775 ddc68c69915a
child 2777 825b27484850
Support for implementors/senders menu.
tools/JavaToolbox.st
--- a/tools/JavaToolbox.st	Tue Sep 24 12:45:44 2013 +0100
+++ b/tools/JavaToolbox.st	Wed Sep 25 10:27:55 2013 +0100
@@ -61,10 +61,65 @@
     ]
 
     "Created: / 01-09-2013 / 17:59:23 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spawnBrowserOnClass: class selector: selector
+    self spawnBrowserOnMethod: (class compiledMethodAt: selector asSymbol)
+
+    "Created: / 25-09-2013 / 00:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+spawnBrowserOnMethod: method
+    browser isNil ifTrue:[
+         Tools::NewSystemBrowser openInMethod:method.
+         ^ self
+    ].
+    (UserPreferences current alwaysOpenNewTabWhenCtrlClick
+        or:[self browser navigationState modified])
+        ifTrue:
+            [self browser
+                spawnFullBrowserInClass: method mclass
+                selector:method selector
+                in:#newBuffer]
+        ifFalse:
+            [self browser
+                switchToClass: method containingClass
+                    selector: method selector].
+
+    "Created: / 25-09-2013 / 00:12:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !JavaToolbox methodsFor:'menus'!
 
+implementorMenuFor: selector inClassNamed: className
+    | menu definingClasses implementors |
+
+    menu := Menu new.
+    definingClasses := environment allClasses select:[:cls | cls name = className ].
+    definingClasses do:[:cls|
+        menu addItem: 
+            (MenuItem label: (self displayStringForSelector: selector in: cls name withClassName: true)
+                itemValue:[ self spawnBrowserOnClass: cls selector: selector]). 
+    ].
+    implementors := Set new.
+    definingClasses do:[:cls | implementors addAll: (self searchForImplementorsOf: selector class: cls)].
+    implementors := implementors reject:[:m | definingClasses includes: m mclass ].
+    implementors := implementors asSortedCollection:[:a :b | a mclass lastName < b mclass lastName ].
+    implementors notEmptyOrNil ifTrue:[
+        menu addSeparator.
+        implementors do:[:m|
+            menu addItem: 
+                (MenuItem label: (self displayStringForSelector: selector in: m mclass name withClassName: true)
+                    itemValue:[ self spawnBrowserOnMethod: m]). 
+        ].
+    ].
+
+    ^ menu
+
+    "Created: / 24-09-2013 / 23:48:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 25-09-2013 / 10:06:04 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 messagesMenuFor:actionSelector
     withMethods: methods
     withMethodSelectors:withMethodSelectors
@@ -111,31 +166,66 @@
 
     "Created: / 01-09-2013 / 17:03:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 05-09-2013 / 13:38:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+sendersMenuFor: selector inClassNamed: className
+    | menu definingClasses senders |
+
+    menu := Menu new.
+    definingClasses := environment allClasses select:[:cls | cls name = className ].
+    senders := Set new.
+    definingClasses do:[:cls | senders addAll: (self searchForSendersOf: selector class: cls)].
+    senders := senders reject:[:m | definingClasses includes: m mclass ].
+    senders := senders asSortedCollection:[:a :b | a mclass lastName < b mclass lastName ].
+    senders notEmptyOrNil ifTrue:[
+        senders do:[:m|
+            menu addItem: 
+                (MenuItem label: (self displayStringForSelector: selector in: m mclass name withClassName: true)
+                    itemValue:[ self spawnBrowserOnMethod: m]). 
+        ].
+    ].
+
+    ^ menu
+
+    "Created: / 25-09-2013 / 10:08:08 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !JavaToolbox methodsFor:'private-presentation'!
 
 displayStringForSelector: selector in: className
-    | i name descriptor package localName |
+    ^ self displayStringForSelector: selector in: className withClassName: false.
+
+    "Created: / 31-08-2013 / 23:31:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 25-09-2013 / 00:37:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+displayStringForSelector: selector in: className withClassName: withClassName
+    | i name descriptor package localName displayString|
 
     i := selector indexOf: $(.
     name := selector copyTo: i - 1.
-    name = #'<clinit>' ifTrue:[
-        ^ 'static {}'
-    ].
+
 
     descriptor := selector copyFrom: i.
     i := className lastIndexOf: $/.
     package := className copyTo: i - 1.
-
+    localName := className copyFrom: i + 1.
 
-    name = '<init>' ifTrue:[
-        localName := className copyFrom: i + 1.
-        ^ JavaMethod specTextFromSignature:descriptor in: package withName: localName.         
+    name = #'<clinit>' ifTrue:[
+        displayString :=  'static' asText allBold , ' {}'
+    ] ifFalse:[
+        name = '<init>' ifTrue:[
+            displayString := JavaMethod specTextFromSignature:descriptor in: package withName: localName.         
+        ] ifFalse:[
+            displayString := JavaMethod specTextFromSignature:descriptor in: package withName: name
+        ].
     ].
-    ^ JavaMethod specTextFromSignature:descriptor in: package withName: name
+    withClassName ifTrue:[
+         displayString := displayString , ' in ' , (localName asText allBold).
+    ].
+    ^ displayString
 
-    "Created: / 31-08-2013 / 23:31:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Created: / 25-09-2013 / 00:37:15 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !JavaToolbox methodsFor:'searching'!
@@ -174,11 +264,11 @@
 !
 
 searchForImplementorsOf: selector class: class in: classes
-    | senders |
+    | implementors |
 
-    senders := Set new.
-    self searchForImplementorsOf: selector class: class in: classes whenFoundDo: [:mthd | senders add: mthd ].
-    ^ senders
+    implementors := Set new.
+    self searchForImplementorsOf: selector class: class in: classes whenFoundDo: [:mthd | implementors add: mthd ].
+    ^ implementors
 
     "Created: / 05-09-2013 / 12:45:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
@@ -186,18 +276,24 @@
 searchForImplementorsOf: selector class: class in: classes whenFoundDo: block 
     | searchSelector searchClass |
 
-    searchSelector := selector.
+    searchSelector := selector asSymbolIfInterned.
+    searchSelector isNil ifTrue:[ ^ self ].
     searchClass := self searchForDeclarationOf: selector class: class in: classes.
 
     classes do: [:cls | 
         cls isJavaClass ifTrue: [
-            ((cls canUnderstand: searchSelector) and:[ JavaVM canCast: cls javaClass to: searchClass]) ifTrue:[
-                block value: (cls compiledMethodAt: searchSelector)
+            ((cls methodDictionary includesKey: searchSelector) and:[ JavaVM canCast: cls to: searchClass]) ifTrue:[
+                | m |
+
+                m := cls compiledMethodAt: searchSelector.
+                m isNil ifTrue:[ self error: 'Should not happen' ].
+                block value:  m.
             ]
         ]
     ].
 
     "Created: / 05-09-2013 / 12:45:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 25-09-2013 / 10:05:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 searchForSendersOf: selector class: class
@@ -220,7 +316,8 @@
 searchForSendersOf: selector class: class in: classes whenFoundDo: block 
     | searchSelector searchClass |
 
-    searchSelector := selector.
+    searchSelector := selector asSymbolIfInterned.
+    searchSelector isNil ifTrue:[ ^ self ].
     searchClass := self searchForDeclarationOf: selector class: class in: classes.
 
     classes do: [:cls | 
@@ -239,7 +336,7 @@
             ].
             matching notEmpty ifTrue:[
                 cls methodDictionary keysAndValuesDo:[:selector :method|
-                    (method analyzer methodsInvoked includesAny: matching) ifTrue:[
+                    (method isJavaMethod and:[method analyzer methodsInvoked includesAny: matching]) ifTrue:[
                         block value: method
                     ]
                 ]
@@ -248,12 +345,17 @@
     ]
 
     "Created: / 01-09-2013 / 03:11:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 05-09-2013 / 13:10:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 25-09-2013 / 10:16:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !JavaToolbox class methodsFor:'documentation'!
 
 version_CVS
     ^ '$Header$'
+!
+
+version_HG
+
+    ^ '$Changeset: <not expanded> $'
 ! !