[slime-cvs] CVS slime

[alendvai]

Update of /project/slime/cvsroot/slime
In directory clnet:/tmp/cvs-serv30109

Modified Files:
	swank-backend.lisp swank.lisp 
Log Message:
Added inspect-slot-for-emacs to let users customize it.

Use all-slots-for-inspector everywhere, render link to both the effective and direct slots when both are available.
Dropped slot-value-using-class-for-inspector and friends.
Added slot-makunbound-using-class to the swank-mop package and added a [make-unbound] action to the standard slot presentation.


--- /project/slime/cvsroot/slime/swank-backend.lisp	2006/12/05 12:57:57	1.110
+++ /project/slime/cvsroot/slime/swank-backend.lisp	2006/12/11 12:51:59	1.111
@@ -88,6 +88,7 @@
    #:slot-definition-writers
    #:slot-boundp-using-class
    #:slot-value-using-class
+   #:slot-makunbound-using-class
    ;; generic function protocol
    #:compute-applicable-methods-using-classes
    #:finalize-inheritance))
--- /project/slime/cvsroot/slime/swank.lisp	2006/12/11 12:44:02	1.423
+++ /project/slime/cvsroot/slime/swank.lisp	2006/12/11 12:51:59	1.424
@@ -21,6 +21,8 @@
            #:print-indentation-lossage
            #:swank-debugger-hook
            #:run-after-init-hook
+           #:inspect-for-emacs
+           #:inspect-slot-for-emacs
            ;; These are user-configurable variables:
            #:*communication-style*
            #:*dont-close*
@@ -4358,20 +4360,11 @@
 	  (method-specializers-for-inspect method)))
 
 (defmethod inspect-for-emacs ((o standard-object) inspector)
-  (declare (ignore inspector))
   (let ((c (class-of o)))
     (values "An object."
             `("Class: " (:value ,c) (:newline)
               "Slots:" (:newline)
-              ,@(loop for slotd in (swank-mop:class-slots c)
-                      for name = (swank-mop:slot-definition-name slotd)
-                      collect `(:value ,slotd ,(string name))
-                      collect " = "
-                      collect (if (slot-boundp-using-class-for-inspector c o slotd)
-                                  `(:value ,(slot-value-using-class-for-inspector 
-                                             c o slotd))
-                                  "#<unbound>")
-                      collect '(:newline))))))
+              ,@(all-slots-for-inspector o inspector)))))
 
 (defvar *gf-method-getter* 'methods-by-applicability
   "This function is called to get the methods of a generic function.
@@ -4408,13 +4401,13 @@
 		     maxlen
 		     (length doc))))
 
-(defgeneric slot-value-using-class-for-inspector (class object slot)
-  (:method (class object slot)
-           (swank-mop:slot-value-using-class class object slot)))
-
-(defgeneric slot-boundp-using-class-for-inspector (class object slot)
+(defgeneric inspect-slot-for-emacs (class object slot)
   (:method (class object slot)
-           (swank-mop:slot-boundp-using-class class object slot)))
+           (if (swank-mop:slot-boundp-using-class class object slot)
+               `((:value ,(swank-mop:slot-value-using-class class object slot))
+                 " " (:action "[make unbound]"
+                      ,(lambda () (swank-mop:slot-makunbound-using-class class object slot))))
+               '("#<unbound>"))))
 
 (defgeneric all-slots-for-inspector (object inspector)
   (:method ((object standard-object) inspector)
@@ -4422,25 +4415,16 @@
     (append '("------------------------------" (:newline)
               "All Slots:" (:newline))
             (loop
-               with class = (class-of object)
                with direct-slots = (swank-mop:class-direct-slots (class-of object))
-               for slot in (swank-mop:class-slots (class-of object))
-               for slot-def = (or (find-if (lambda (a)
-                                             ;; find the direct slot
-                                             ;; with the same name
-                                             ;; as SLOT (an
-                                             ;; effective slot).
-                                             (eql (swank-mop:slot-definition-name a)
-                                                  (swank-mop:slot-definition-name slot)))
-                                           direct-slots)
-                                  slot)
-               collect `(:value ,slot-def ,(inspector-princ (swank-mop:slot-definition-name slot-def)))
+               for effective-slot :in (swank-mop:class-slots (class-of object))
+               for direct-slot = (find (swank-mop:slot-definition-name effective-slot)
+                                       direct-slots :key #'swank-mop:slot-definition-name)
+               collect `(:value ,(if direct-slot
+                                     (list direct-slot effective-slot)
+                                     effective-slot)
+                         ,(inspector-princ (swank-mop:slot-definition-name effective-slot)))
                collect " = "
-               if (slot-boundp-using-class-for-inspector class object slot)
-               collect `(:value ,(slot-value-using-class-for-inspector
-                                  (class-of object) object slot))
-               else
-               collect "#<unbound>"
+               append (inspect-slot-for-emacs (class-of object) object effective-slot)
                collect '(:newline)))))
 
 (defmethod inspect-for-emacs ((gf standard-generic-function) inspector)