tools/JavaToolbox.st
branchdevelopment
changeset 2708 648286432b9a
parent 2703 cec245f60b30
child 2711 a00302fe5083
--- a/tools/JavaToolbox.st	Thu Sep 05 03:29:47 2013 +0100
+++ b/tools/JavaToolbox.st	Thu Sep 05 16:37:21 2013 +0100
@@ -29,9 +29,20 @@
 !JavaToolbox methodsFor:'browsing'!
 
 spawnBrowserOnAllImplementorsOf: selector class: class 
-    self shouldImplement
+    | label |
+
+    self ensureBrowser.
+    browser withWaitCursorDo:[
+        label := browser resources string:'Implementors of %1' with: (self displayStringForSelector: selector in: class name).
+        browser 
+            spawnMethodBrowserForSearch:[self searchForImplementorsOf: selector class: class]
+            sortBy:#class
+            in:#newBuffer
+            label:label.
+    ]
 
     "Created: / 01-09-2013 / 17:59:53 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 05-09-2013 / 12:44:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 spawnBrowserOnAllSendersOf: selector class: class 
@@ -75,13 +86,13 @@
     builder := [:class :selector |
         menu addItem:
             (MenuItem 
-                label: (self displayStringForSelector: selector in: class)
+                label: (self displayStringForSelector: selector in: class name)
                 itemValue: [ self perform: xlatedSelector with: selector with: class ])
     ].
 
     menu := Menu new.
     withMethodSelectors ifTrue:[
-        methods do:[:m | builder value: m javaClass name value: m selector ].
+        methods do:[:m | builder value: m javaClass value: m selector ].
     ].
     withSentSelectors ifTrue:[
         sent := Set new.
@@ -92,14 +103,14 @@
             ].
             sent := sent asSortedCollection:[:a :b|a selector < b selector ].
             sent do:[:mref |
-                builder value: mref classRef javaClassName value: mref selector
+                builder value: mref classRef javaClass value: mref selector
             ]
         ].
     ].
     ^ menu.
 
     "Created: / 01-09-2013 / 17:03:05 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 01-09-2013 / 18:11:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 05-09-2013 / 13:38:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !JavaToolbox methodsFor:'private-presentation'!
@@ -129,10 +140,71 @@
 
 !JavaToolbox methodsFor:'searching'!
 
+searchForDeclarationOf: selector class: class in: classes
+    "Return 'declaration' of method with given selector in given class.
+     By 'declaration' we mean top-most definition of the method or
+     definition of the method in one of class's interface. 
+     Returns the class (ot interface) in which the method is
+     first declared."
+
+    | current declaring |
+
+    current := declaring := class.
+    [ current ~~ JavaObject ] whileTrue:[
+        (current canUnderstand: selector) ifTrue:[
+            declaring := current.
+        ].
+        current allInterfaces do:[:iface|
+            (iface canUnderstand: selector) ifTrue:[
+                ^ iface
+            ].
+        ].
+        current := current superclass.
+    ].
+
+    ^ declaring
+
+    "Created: / 05-09-2013 / 13:10:25 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+searchForImplementorsOf: selector class: class
+    ^ self searchForImplementorsOf: selector class: class in: environment allClasses
+
+    "Created: / 05-09-2013 / 12:44:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+searchForImplementorsOf: selector class: class in: classes
+    | senders |
+
+    senders := Set new.
+    self searchForImplementorsOf: selector class: class in: classes whenFoundDo: [:mthd | senders add: mthd ].
+    ^ senders
+
+    "Created: / 05-09-2013 / 12:45:03 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+searchForImplementorsOf: selector class: class in: classes whenFoundDo: block 
+    | searchSelector searchClass |
+
+    searchSelector := selector.
+    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)
+            ]
+        ]
+    ].
+
+    "Created: / 05-09-2013 / 12:45:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 searchForSendersOf: selector class: class
-    ^ self searchForSendersOf: selector class: class in: Smalltalk allClasses
+    ^ self searchForSendersOf: selector class: class in: environment allClasses
 
     "Created: / 01-09-2013 / 10:07:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 05-09-2013 / 12:46:27 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 searchForSendersOf: selector class: class in: classes
@@ -149,7 +221,7 @@
     | searchSelector searchClass |
 
     searchSelector := selector.
-    searchClass := class.
+    searchClass := self searchForDeclarationOf: selector class: class in: classes.
 
     classes do: [:cls | 
         cls isJavaClass ifTrue: [
@@ -176,6 +248,6 @@
     ]
 
     "Created: / 01-09-2013 / 03:11:12 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-    "Modified: / 01-09-2013 / 09:52:21 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 05-09-2013 / 13:10:56 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !