[slime-cvs] CVS slime

[CVS User mevenson]

Update of /project/slime/cvsroot/slime
In directory cl-net:/tmp/cvs-serv4954

Modified Files:
	ChangeLog swank-abcl.lisp 
Log Message:
* swank-abcl.lisp (emacs-inspect): Implementation for Java objects.
	Fix compiler warning about *ABCL-SIGNALED-CONDITIONS*.


--- /project/slime/cvsroot/slime/ChangeLog	2010/01/06 14:13:48	1.1961
+++ /project/slime/cvsroot/slime/ChangeLog	2010/01/11 13:23:08	1.1962
@@ -1,3 +1,10 @@
+2010-01-11  Mark Evenson  <evenson at dada.local>
+
+	* swank-abcl.lisp (emacs-inspect): Implementation for Java
+	objects.
+
+	Fix compiler warning about *ABCL-SIGNALED-CONDITIONS*.
+
 2010-01-06  Tobias C. Rittweiler <tcr at freebits.de>
 
 	* swank-backend (declaration-arglist): Normalize declaration
--- /project/slime/cvsroot/slime/swank-abcl.lisp	2009/12/19 14:56:06	1.78
+++ /project/slime/cvsroot/slime/swank-abcl.lisp	2010/01/11 13:23:08	1.79
@@ -390,6 +390,8 @@
 
 (in-package :swank-backend)
 
+(defvar *abcl-signaled-conditions*)
+
 (defun handle-compiler-warning (condition)
   (let ((loc (when (and jvm::*compile-file-pathname* 
                         system::*source-position*)
@@ -416,8 +418,6 @@
                                  (list :file (namestring *compile-filename*))
                                  (list :position 1)))))))))
 
-(defvar *abcl-signaled-conditions*)
-
 (defimplementation swank-compile-file (input-file output-file
                                        load-p external-format)
   (declare (ignore external-format))
@@ -516,35 +516,35 @@
 ;;;; Inspecting
 
 (defmethod emacs-inspect ((slot mop::slot-definition))
-          `("Name: " (:value ,(mop::%slot-definition-name slot))
-            (:newline)
-            "Documentation:" (:newline)
-            ,@(when (slot-definition-documentation slot)
-                `((:value ,(slot-definition-documentation slot)) (:newline)))
-            "Initialization:" (:newline)
-            "  Args: " (:value ,(mop::%slot-definition-initargs slot)) (:newline)
-            "  Form: "  ,(if (mop::%slot-definition-initfunction slot)
-                             `(:value ,(mop::%slot-definition-initform slot))
-                             "#<unspecified>") (:newline)
-            "  Function: " (:value ,(mop::%slot-definition-initfunction slot))
-            (:newline)))
+  `("Name: " (:value ,(mop::%slot-definition-name slot))
+             (:newline)
+             "Documentation:" (:newline)
+             ,@(when (slot-definition-documentation slot)
+                     `((:value ,(slot-definition-documentation slot)) (:newline)))
+             "Initialization:" (:newline)
+             "  Args: " (:value ,(mop::%slot-definition-initargs slot)) (:newline)
+             "  Form: "  ,(if (mop::%slot-definition-initfunction slot)
+                              `(:value ,(mop::%slot-definition-initform slot))
+                              "#<unspecified>") (:newline)
+                              "  Function: " (:value ,(mop::%slot-definition-initfunction slot))
+                              (:newline)))
 
 (defmethod emacs-inspect ((f function))
-          `(,@(when (function-name f)
-                    `("Name: " 
-                      ,(princ-to-string (function-name f)) (:newline)))
-            ,@(multiple-value-bind (args present) 
-                                   (sys::arglist f)
-                                   (when present `("Argument list: " ,(princ-to-string args) (:newline))))
-            (:newline)
-            #+nil,@(when (documentation f t)
-                         `("Documentation:" (:newline) ,(documentation f t) (:newline)))
-            ,@(when (function-lambda-expression f)
-                    `("Lambda expression:" 
-                      (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline)))))
+  `(,@(when (function-name f)
+            `("Name: " 
+              ,(princ-to-string (function-name f)) (:newline)))
+      ,@(multiple-value-bind (args present) 
+                             (sys::arglist f)
+                             (when present `("Argument list: " ,(princ-to-string args) (:newline))))
+      (:newline)
+      #+nil,@(when (documentation f t)
+                   `("Documentation:" (:newline) ,(documentation f t) (:newline)))
+      ,@(when (function-lambda-expression f)
+              `("Lambda expression:" 
+                (:newline) ,(princ-to-string (function-lambda-expression f)) (:newline)))))
 
 #|
-
+;;; XXX -- the default SLIME implementation looks ok.  Remove?  --ME 20100111
 (defmethod emacs-inspect ((o t))
   (let* ((class (class-of o))
          (slots (mop::class-slots class)))
@@ -555,6 +555,12 @@
                     slots)))
 |#
 
+(defmethod emacs-inspect ((o java:java-object))
+  (append 
+   (label-value-line "toString()" (java:jcall "toString" o)) 
+   (loop :for (label . value) :in (sys:inspected-parts o)
+      :appending (label-value-line label value))))
+  
 ;;;; Multithreading
 
 #+#.(cl:if (cl:find-package :threads) '(:and) '(:or))