[slime-devel] abcl special inspector support for java classes, methods, and other good stuff - slime-devel - mailman3.common-lisp.net

28 Feb 2009


      I have written a couple of dozen lines of code to improve the way the
inspector works in abcl for certain java objects.  At this point, I
can't work without these improvements, but I haven't been able to
quite figure out how to produce a proper patch to slime for inclusion.
Normally, what i do is execute the following forms after swank is
already loaded.  This seems to work fine.  However when I put all the
following forms into swank-abcl.lisp, this approach fails because the
swank package is not loaded yet.
Any ideas about how I can get organize the following code so that it
works cleanly with slime?
Thanks,
-russ
Here is the code:
;; this is the troublesome form.  where should it go?
(defmethod swank:emacs-inspect ((java-object java-object))
  (swank-backend::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)))))