I hope the format is useable.
Thanks, -russ
Index: swank-abcl.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/swank-abcl.lisp,v retrieving revision 1.63 diff -u -u -8 -p -r1.63 swank-abcl.lisp --- swank-abcl.lisp 10 Jan 2009 12:25:16 -0000 1.63 +++ swank-abcl.lisp 1 Mar 2009 19:35:33 -0000 @@ -552,8 +552,89 @@ part of *sysdep-pathnames* in swank.load
;; WORKAROUND: call/initialize accessors at load time (let ((c (make-condition 'compiler-condition :original-condition nil :severity ':note :message "" :location nil)) (slots `(severity message short-message references location))) (dolist (slot slots) (funcall slot c))) + +;; special inspector support for java objects, methods, and classes + +(defun swank-backend::emacs-inspect-java-class (jclass) + (flet ((jclass->name (jclass) + (let* ((s (java:jclass-name jclass)) + (prefix "java.lang.") + (lang-pos (search prefix s))) + (if lang-pos + (subseq s (+ lang-pos (length prefix))) + s)))) + (append + `(,(princ-to-string jclass) " is the Java class named " + ,(java:jclass-name jclass) + (:newline)) + `("Constructors: " (:newline)) + (loop for c across (java:jclass-constructors jclass) + for i = 0 then (1+ i) + append (let ((args (map 'list #'jclass->name (java:jconstructor-params c)))) + `(,(format nil "[~2D] ~{~A~^,~}: ~40T" + i + args) + (:value ,c) + (:newline)))) + `("Methods" (:newline)) + (loop for method across (java:jclass-methods jclass) + for i = 0 then (1+ i) + append (let ((args (mapcar #'jclass->name (coerce (java:jmethod-params method) 'list)))) + `(,(format nil "[~2D] ~A ~A(~{~A~^,~}): ~40T" + i + (jclass->name (java:jmethod-return-type method)) + (java:jmethod-name method) + args) + (:value ,method) + (:newline))))))) + +(defun swank-backend::emacs-inspect-java-object (jobject) + (let* ((jclass (java:jobject-class jobject)) + (fields (coerce (java:jclass-fields jclass) 'list))) + (append + `(,(princ-to-string jobject) (:newline) + " is an instance of Java class " ,(java: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 (java:jfield-name field)) + (:value ,(java:jcall (java:jmethod (java:jclass "java.lang.reflect.Field") + "get" + (java:jclass "java.lang.Object")) + field + jobject)) + (:newline)))))) + +(defun swank-backend::emacs-inspect-java-method (jmethod) + (let ((return-type (java:jcall + (java:jmethod (java:jclass "java.lang.reflect.Method") "getReturnType") + jmethod)) + (args (coerce (java:jmethod-params jmethod) 'list))) + (setf args + (mapcar #'java:jclass-name args)) + (append + `("Java Method: " ,(java:jmethod-name jmethod) (:newline)) + `("Return Type: " ,(java: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) + (java:jinstance-of-p java-object (java: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))))) + Index: contrib/swank-fancy-inspector.lisp =================================================================== RCS file: /project/slime/cvsroot/slime/contrib/swank-fancy-inspector.lisp,v retrieving revision 1.16 diff -u -u -8 -p -r1.16 swank-fancy-inspector.lisp --- contrib/swank-fancy-inspector.lisp 10 Jan 2009 10:09:47 -0000 1.16 +++ contrib/swank-fancy-inspector.lisp 1 Mar 2009 19:35:34 -0000 @@ -687,16 +687,20 @@ SPECIAL-OPERATOR groups." (position (file-position stream))) (lambda () (ed-in-emacs `(,pathname :charpos ,position)))) :refreshp nil) (:newline)) content) content))))
+#+abcl +(defmethod emacs-inspect ((java-object java:java-object)) + (swank-backend::emacs-inspect-java java-object)) + (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v)))) (butlast (loop for i in list collect (funcall callback i) collect ", ")))