[j-devel] improved swank browsing for java objects

[Russ M. <rus...@ya...>]

I got frustrated that I couldn't arbitrarily inspect java classes,
methods, and objects, and came up with the following.

Please give it a try and let me know what you think.

Note that I tried to implement this with EQL specializers and
DEFMETHOD, but apparently this is presently beyond the capability of
ABCL's CLOS implementation.

-russ


(defmethod swank:emacs-inspect ((java-object java-object))
  (emacs-inspect-java java-object))

(defun swank-backend::emacs-inspect-java-class (jclass)
  (flet ((jclass->name (jclass)
           (let* ((s (jclass-name jclass))
                  (prefix "java.lang.")
                  (lang-pos (search prefix s)))
             (if lang-pos
                 (subseq s (+ lang-pos (length prefix)))
                 s))))
    (append 
     `("Java Class: " ,(princ-to-string jclass) (:newline))
     `("Methods" (:newline))
     (loop for method across (jclass-methods jclass)
        for i = 0 then (1+ i)
        append (let ((args (mapcar #'jclass->name (coerce (jmethod-params method) 'list))))
                 `(,(format nil "[~2D] ~A ~A(~{~A~^,~}): ~40T" 
                            i 
                            (jclass->name (jmethod-return-type method))
                            (jmethod-name method)
                            args)
                    (:value ,method)
                    (:newline)))))))

(defun swank-backend::emacs-inspect-java-object (jobject)
  (let* ((jclass (jobject-class jobject))
         (fields (coerce (jclass-fields jclass) 'list)))
    (append 
     `("Java Object" ":" ,(princ-to-string jobject) (:newline))
     `("Java Class" ":" ,(jclass-name jclass)  " " (:value ,jclass) (:newline))
     `("Fields" (:newline))
     (loop for field in fields 
        for i = 0 then (1+ i)
        append `(,(format nil "[~2D] ~20A : " i (jfield-name field)) 
                  (:value ,(jcall (jmethod (jclass "java.lang.reflect.Field")
                                           "get"
                                           (jclass "java.lang.Object"))
                                  field
                                  jobject))
                  (:newline))))))

(defun swank-backend::emacs-inspect-java-method (jmethod)
  (let ((return-type (jcall (jmethod (jclass "java.lang.reflect.Method") "getReturnType") jmethod))
        (args (coerce (jmethod-params jmethod) 'list)))
    (setf args
          (mapcar (lambda (arg)
                    (jclass-name arg))
                  args))
    (append 
     `("Java Method: " ,(jmethod-name jmethod) (:newline))
     `("Return Type: " ,(jclass-name return-type) ": " (:value ,return-type) (:newline))
     (if args
         (append `("Arguments" (:newline))
                 (loop for arg in args
                    for i = 0 then (1+ i)
                    append `(,(format nil "[~2D] ~20A : " i arg) (:value ,arg) (:newline))))
         `("Arguments: none" (:newline))))))

(defun swank-backend::emacs-inspect-java (java-object)
  (flet ((is-a (class-name)
           (jinstance-of-p java-object (jclass class-name))))
    (cond ((is-a "java.lang.Class") 
           (swank-backend::emacs-inspect-java-class java-object))
          ((is-a "java.lang.reflect.Method")
           (swank-backend::emacs-inspect-java-method java-object))
          (t 
           (swank-backend::emacs-inspect-java-object java-object)))))

(defmethod swank:emacs-inspect ((java-object java-object))
  (swank-backend::emacs-inspect-java java-object))