[slime-cvs] CVS update: slime/swank-sbcl.lisp slime/swank-openmcl.lisp slime/swank-lispworks.lisp slime/swank-cmucl.lisp slime/swank-backend.lisp slime/swank-allegro.lisp slime/ChangeLog

Marco Baringer mbaringer at common-lisp.net
Tue Sep 14 16:01:10 UTC 2004


Update of /project/slime/cvsroot/slime
In directory common-lisp.net:/tmp/cvs-serv18999

Modified Files:
	swank-sbcl.lisp swank-openmcl.lisp swank-lispworks.lisp 
	swank-cmucl.lisp swank-backend.lisp swank-allegro.lisp 
	ChangeLog 
Log Message:
2004-09-14  Marco Baringer  <mb at bese.it>

	* swank-backend.lisp (inspector, make-default-inspector): Add an
	INSPECTOR object argument to the inspector protocol. This allows
	implementations to provide more information regarding cretain
	objects which can't be, or simply aren't, inspected using the
	generic inspector implementation. also export inspect-for-emacs
	and related symbols from the backend package.
	(make-default-inspector): New function.
	
	* swank.lisp (inspected-parts): Rename to inspect-for-emacs and
	add an inspector argument. Move inspect-for-emacs to
	swank-backend.lisp, leave only the default implementations.

	* swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp,
	swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename
	and change argument list. Many of the inspected-parts methods were
	being clobbered by the inspected-parts in swank.lisp, now that
	they're being used the return values have been updated for the new
	inspect-for-emacs API.

Date: Tue Sep 14 18:01:07 2004
Author: mbaringer

Index: slime/swank-sbcl.lisp
diff -u slime/swank-sbcl.lisp:1.101 slime/swank-sbcl.lisp:1.102
--- slime/swank-sbcl.lisp:1.101	Mon Sep 13 18:42:31 2004
+++ slime/swank-sbcl.lisp	Tue Sep 14 18:01:06 2004
@@ -658,78 +658,98 @@
 
 ;;;; Inspector
 
-(defmethod inspected-parts (o)
+(defclass sbcl-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'sbcl-inspector))
+
+(defmethod inspect-for-emacs ((o t) (inspector sbcl-inspector))
+  (declare (ignore inspector))
   (cond ((sb-di::indirect-value-cell-p o)
-	 (inspected-parts-of-value-cell o))
+         (values "A value cell."
+                 `("Value: " (:value ,(sb-kernel:value-cell-ref o)))))
 	(t
 	 (multiple-value-bind (text labeledp parts)
              (sb-impl::inspected-parts o)
-	   (let ((parts (if labeledp 
-			    (loop for (label . value) in parts
-				  collect (cons (string label) value))
-			    (loop for value in parts
-				  for i from 0
-				  collect (cons (format nil "~D" i) value)))))
-	     (values text parts))))))
-
-(defun inspected-parts-of-value-cell (o)
-  (values (format nil "~A~% is a value cell." o)
-	  (list (cons "Value" (sb-kernel:value-cell-ref o)))))
+           (if labeledp
+               (values text
+                       (loop for (label . value) in parts
+                             collect `(:value ,label)
+                             collect " = "
+                             collect `(:value ,value)
+                             collect '(:newline)))
+               (values text
+                       (loop for value in parts
+                             for i from 0
+                             collect (princ-to-string i)
+                             collect " = "
+                             collect `(:value ,value)
+                             collect '(:newline))))))))
 
-(defmethod inspected-parts ((o function))
+(defmethod inspect-for-emacs ((o function) (inspector sbcl-inspector))
+  (declare (ignore inspector))
   (let ((header (sb-kernel:widetag-of o)))
     (cond ((= header sb-vm:simple-fun-header-widetag)
-	   (values 
-	    (format nil "~A~% is a simple-fun." o)
-	    (list (cons "Self" (sb-kernel:%simple-fun-self o))
-		  (cons "Next" (sb-kernel:%simple-fun-next o))
-		  (cons "Name" (sb-kernel:%simple-fun-name o))
-		  (cons "Arglist" (sb-kernel:%simple-fun-arglist o))
-		  (cons "Type" (sb-kernel:%simple-fun-type o))
-		  (cons "Code Object" (sb-kernel:fun-code-header o)))))
+	   (values "A simple-fun." 
+                   `("Self: " (:value ,(sb-kernel:%simple-fun-self o))
+                     (:newline)
+                     "Next: " (:value ,(sb-kernel:%simple-fun-next o))
+                     (:newline)
+                     "Name: " (:value ,(sb-kernel:%simple-fun-name o))
+                     (:newline)
+                     "Arglist: " (:value ,(sb-kernel:%simple-fun-arglist o))
+                     (:newline)
+                     "Type: " (:value ,(sb-kernel:%simple-fun-type o))
+                     (:newline)
+                     "Code Object: " (:value ,(sb-kernel:fun-code-header o)))))
 	  ((= header sb-vm:closure-header-widetag)
-	   (values (format nil "~A~% is a closure." o)
-		   (list* 
-		    (cons "Function" (sb-kernel:%closure-fun o))
-		    (loop for i from 0 
+	   (values "A closure."
+		   `("Function: " (:value ,(sb-kernel:%closure-fun o))
+                     (:newline)
+                     "Closed over values:"
+                     (:newline)
+                     ,@(loop for i from 0 
                           below (- (sb-kernel:get-closure-length o) 
                                    (1- sb-vm:closure-info-offset))
-			  collect (cons (format nil "~D" i)
-					(sb-kernel:%closure-index-ref o i))))))
+			  collect (princ-to-string i)
+                          collect " = "
+                          collect `(:value ,(sb-kernel:%closure-index-ref o i))
+                          collect '(:newline)))))
 	  (t (call-next-method o)))))
 
-(defmethod inspected-parts ((o sb-kernel:code-component))
-  (values (format nil "~A~% is a code data-block." o)
-	  `(("First entry point" . ,(sb-kernel:%code-entry-points o))
-	    ,@(loop for i from sb-vm:code-constants-offset 
-		    below (sb-kernel:get-header-data o)
-		    collect (cons (format nil "Constant#~D" i)
-				  (sb-kernel:code-header-ref o i)))
-	    ("Debug info" . ,(sb-kernel:%code-debug-info o))
-	    ("Instructions"  . ,(sb-kernel:code-instructions o)))))
-
-(defmethod inspected-parts ((o sb-kernel:fdefn))
-  (values (format nil "~A~% is a fdefn object." o)
-	  `(("Name" . ,(sb-kernel:fdefn-name o))
-	    ("Function" . ,(sb-kernel:fdefn-fun o)))))
-
-
-(defmethod inspected-parts ((o generic-function))
-  (values (format nil "~A~% is a generic function." o)
-          (list
-           (cons "Method-Class" (sb-pcl:generic-function-method-class o))
-           (cons "Methods" (sb-pcl:generic-function-methods o))
-           (cons "Name" (sb-pcl:generic-function-name o))
-           (cons "Declarations" (sb-pcl:generic-function-declarations o))
-           (cons "Method-Combination" 
-                 (sb-pcl:generic-function-method-combination o))
-           (cons "Lambda-List" (sb-pcl:generic-function-lambda-list o))
-           (cons "Precedence-Order" 
-                 (sb-pcl:generic-function-argument-precedence-order o))
-           (cons "Pretty-Arglist"
-                 (sb-pcl::generic-function-pretty-arglist o))
-           (cons "Initial-Methods" 
-                 (sb-pcl::generic-function-initial-methods  o)))))
+(defmethod inspect-for-emacs ((o sb-kernel:code-component) (inspector sbcl-inspector))
+  (declare (ignore inspector))
+  (values "A code data-block."
+	  `("First entry point: " (:value ,(sb-kernel:%code-entry-points o))
+            (:newline)
+            "Constants: " (:newline)
+	    ,@(loop
+                 for i from sb-vm:code-constants-offset 
+                 below (sb-kernel:get-header-data o)
+                 collect (princ-to-string i)
+                 collect " = "
+                 collect `(:value ,(sb-kernel:code-header-ref o i))
+                 collect '(:newline))
+	    "Debug info: " (:value ,(sb-kernel:%code-debug-info o))
+	    "Instructions: "  (:value ,(sb-kernel:code-instructions o)))))
+
+(defmethod inspect-for-emacs ((o sb-kernel:fdefn) (inspector sbcl-inspector))
+  (declare (ignore sbcl-inspector))
+  (values "A fdefn object."
+	  `("Name: "  (:value ,(sb-kernel:fdefn-name o))
+            (:newline)
+            "Function" (:value,(sb-kernel:fdefn-fun o)))))
+
+(defmethod inspect-for-emacs :around ((o generic-function) (inspector sbcl-inspector))
+  (declare (ignore inspector))
+  (multiple-value-bind (title contents)
+      (call-next-method)
+    (values title
+            (append contents
+                    `("Pretty arglist: " (:value ,(sb-pcl::generic-function-pretty-arglist o))
+                      (:newline)
+                      "Initial methods: " (:value ,(sb-pcl::generic-function-initial-methods  o)))))))
 
 
 ;;;; Support for SBCL syntax


Index: slime/swank-openmcl.lisp
diff -u slime/swank-openmcl.lisp:1.82 slime/swank-openmcl.lisp:1.83
--- slime/swank-openmcl.lisp:1.82	Mon Sep 13 18:42:31 2004
+++ slime/swank-openmcl.lisp	Tue Sep 14 18:01:06 2004
@@ -638,30 +638,38 @@
 	   (< (symbol-value s) 255))
       (setf (gethash (symbol-value s) *value2tag*) s)))
 
+;;;; Inspection
+
+(defclass openmcl-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'openmcl-inspector))
+
 (defmethod describe-primitive-type (thing)
   (let ((typecode (ccl::typecode thing)))
     (if (gethash typecode *value2tag*)
 	(string (gethash typecode *value2tag*))
 	(string (nth typecode '(tag-fixnum tag-list tag-misc tag-imm))))))
 
-(defmethod inspected-parts (o)
+(defmethod inspect-for-emacs ((o t) (inspector openmcl-inspector))
+  (declare (ignore inspector))
   (let* ((i (inspector::make-inspector o))
 	 (count (inspector::compute-line-count i))
 	 (lines 
-          (loop for l below count
-                for (value label) = (multiple-value-list 
-                                     (inspector::line-n i l))
-                collect (cons (string-right-trim 
-                               " :" (string-capitalize 
-                                     (format nil "~a" label)))
-                              value))))
-    (values (string-left-trim
-	     (string #\newline)
-	     (with-output-to-string (s)
-	       (let ((*print-lines* 1)
-		     (*print-right-margin* 80))
-		 (pprint o s))))
-	    (cddr lines))))
+          (loop
+             for l below count
+             for (value label) = (multiple-value-list 
+                                  (inspector::line-n i l))
+             collect `(:value ,label ,(string-capitalize (format nil "~a" label)))
+             collect " = "
+             collect `(:value ,value)
+             collect '(:newline))))
+    (values (with-output-to-string (s)
+              (let ((*print-lines* 1)
+                    (*print-right-margin* 80))
+                (pprint o s)))
+            lines)))
 
 ;;; Multiprocessing
 


Index: slime/swank-lispworks.lisp
diff -u slime/swank-lispworks.lisp:1.57 slime/swank-lispworks.lisp:1.58
--- slime/swank-lispworks.lisp:1.57	Mon Sep 13 21:09:15 2004
+++ slime/swank-lispworks.lisp	Tue Sep 14 18:01:06 2004
@@ -578,12 +578,33 @@
                                   (make-dspec-location dspec location)))))
 ;;; Inspector
 
-(defmethod inspected-parts (o)
+(defclass lispworks-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'lispworks-inspector))
+
+(defimplementation inspect-for-emacs ((o t) (inspector lispworks-inspector))
+  (declare (ignore inspector))
   (multiple-value-bind (names values _getter _setter type)
       (lw:get-inspector-values o nil)
     (declare (ignore _getter _setter))
-    (values (format nil "~A~%   is a ~A" o type)
-            (mapcar #'cons names values))))
+    (values "A value."
+            `("Type: " (:value ,type)
+              (:newline)
+              "Getter: " (:value ,_getter)
+              (:newline)
+              "Setter: " (:value ,_setter)
+              (:newline)
+              "Slots:"
+              (:newline)
+              ,@(loop
+                   for name in names
+                   for value in values
+                   collect `(:value ,name)
+                   collect " = "
+                   collect `(:value ,value)
+                   collect `(:newline)))))) 
 
 ;;; Miscellaneous
 


Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.115 slime/swank-cmucl.lisp:1.116
--- slime/swank-cmucl.lisp:1.115	Mon Sep 13 18:42:31 2004
+++ slime/swank-cmucl.lisp	Tue Sep 14 18:01:06 2004
@@ -1676,6 +1676,12 @@
 
 ;;;; Inspecting
 
+(defclass cmucl-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'cmucl-inspector))
+
 (defconstant +lowtag-symbols+ 
   '(vm:even-fixnum-type
     vm:function-pointer-type
@@ -1718,59 +1724,74 @@
                                   :key #'symbol-value)))
           (format t ", type: ~A" type-symbol))))))
 
-(defimplementation inspected-parts (o)
+(defimplementation inspect-for-emacs ((o t) (inspector cmucl-inspector))
   (cond ((di::indirect-value-cell-p o)
-	 (inspected-parts-of-value-cell o))
+         (values "A value cell."
+                 `("Value: " (:value ,(c:value-cell-ref o)))))
 	(t
 	 (destructuring-bind (text labeledp . parts)
 	     (inspect::describe-parts o)
-	   (let ((parts (if labeledp 
-			    (loop for (label . value) in parts
-				  collect (cons (string label) value))
-			    (loop for value in parts
-				  for i from 0
-				  collect (cons (format nil "~D" i) value)))))
-	     (values text parts))))))
-
-(defun inspected-parts-of-value-cell (o)
-  (values (format nil "~A~% is a value cell." o)
-	  (list (cons "Value" (c:value-cell-ref o)))))
+           (values "A value."
+                   (if labeledp
+                       (loop for (label . value) in parts
+                          collect (princ-to-string label)
+                          collect " = "
+                          collect `(:value ,value)
+                          collect '(:newline))
+                       (loop for value in parts
+                          collect `(:value ,value)
+                          collect '(:newline))))))))
 
-(defmethod inspected-parts ((o function))
+(defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector))
+  (declare (ignore inspector))
   (let ((header (kernel:get-type o)))
     (cond ((= header vm:function-header-type)
-	   (values 
-	    (format nil "~A~% is a function." o)
-	    (list (cons "Self" (kernel:%function-self o))
-		  (cons "Next" (kernel:%function-next o))
-		  (cons "Name" (kernel:%function-name o))
-		  (cons "Arglist" (kernel:%function-arglist o))
-		  (cons "Type" (kernel:%function-type o))
-		  (cons "Code Object" (kernel:function-code-header o)))))
+	   (values "A function."
+                   `("Self: " (:value ,(kernel:%function-self o))
+                     (:newline)
+                     "Next: " (:value ,(kernel:%function-next o))
+                     (:newline)
+                     "Name: " (:value ,(kernel:%function-name o))
+                     (:newline)
+                     "Arglist: " (:value ,(kernel:%function-arglist o))
+                     (:newline)
+                     "Type: " (:value ,(kernel:%function-type o))
+                     (:newline)
+                     "Code Object: " (:value ,(kernel:function-code-header o)))))
 	  ((= header vm:closure-header-type)
-	   (values (format nil "~A~% is a closure." o)
-		   (list* 
-		    (cons "Function" (kernel:%closure-function o))
-		    (loop for i from 0 below (- (kernel:get-closure-length o) 
-						(1- vm:closure-info-offset))
-			  collect (cons (format nil "~D" i)
-					(kernel:%closure-index-ref o i))))))
+	   (values "A closure."
+		   (list*
+                    `("Function: " (:value ,(kernel:%closure-function o))
+                      (:newline)
+                      (loop for i from 0 below (- (kernel:get-closure-length o) 
+                                                  (1- vm:closure-info-offset))
+                         collect (princ-to-string i)
+                         collect " = "
+                         collect (:value ,(kernel:%closure-index-ref o i)))))))
 	  (t (call-next-method o)))))
 
-(defmethod inspected-parts ((o kernel:code-component))
-  (values (format nil "~A~% is a code data-block." o)
-	  `(("First entry point" . ,(kernel:%code-entry-points o))
+(defmethod inspect-for-emacs ((o kernel:code-component) (inspector cmucl-inspector))
+  (declare (ignore inspector))
+  (values "A code data-block."
+	  `("First entry point: " (:value ,(kernel:%code-entry-points o))
+            (:newline)
+            "Constants:" (:newline)
 	    ,@(loop for i from vm:code-constants-offset 
 		    below (kernel:get-header-data o)
-		    collect (cons (format nil "Constant#~D" i)
-				  (kernel:code-header-ref o i)))
-	    ("Debug info" . ,(kernel:%code-debug-info o))
-	    ("Instructions"  . ,(kernel:code-instructions o)))))
-
-(defmethod inspected-parts ((o kernel:fdefn))
-  (values (format nil "~A~% is a fdefn object." o)
-	  `(("Name" . ,(kernel:fdefn-name o))
-	    ("Function" . ,(kernel:fdefn-function o)))))
+		    collect (princ-to-string i)
+                    collect " = "
+                    collect `(:value ,(kernel:code-header-ref o i))
+                    collect '(:newline))
+            "Debug info: " (:value ,(kernel:%code-debug-info o))
+            (:newline)
+            "Instructions: " (:value ,(kernel:code-instructions o)))))
+
+(defmethod inspect-for-emacs ((o kernel:fdefn) (inspector cmucl-inspector))
+  (declare (ignore inspector))
+  (values "A fdefn object."
+	  `("Name: " (:value ,(kernel:fdefn-name o))
+            (:newline)
+            "Function: " (:value ,(kernel:fdefn-function o)))))
 
 
 ;;;; Profiling


Index: slime/swank-backend.lisp
diff -u slime/swank-backend.lisp:1.66 slime/swank-backend.lisp:1.67
--- slime/swank-backend.lisp:1.66	Mon Sep 13 18:42:31 2004
+++ slime/swank-backend.lisp	Tue Sep 14 18:01:07 2004
@@ -26,7 +26,13 @@
            #:print-output-to-string
            #:quit-lisp
            #:references
-           #:unbound-slot-filler))
+           #:unbound-slot-filler
+           ;; inspector related symbols
+           #:inspector
+           #:inspect-for-emacs
+           #:raw-inspection
+           #:fancy-inspection
+           ))
 
 (defpackage :swank-mop
   (:use)
@@ -600,17 +606,57 @@
 
 ;;;; Inspector
 
-(defstruct (unbound-slot-filler (:print-function print-unbound-slot))
-  "The definition of an object which serves as a placeholder in
-an unbound slot for inspection purposes.")
-
-(defun print-unbound-slot (o stream depth)
-  (declare (ignore depth))
-  (print-unreadable-object (o stream :type t)))
-
-(definterface inspected-parts (object)
-  "Return a short description and a list of (LABEL . VALUE) pairs."
-  (values (format nil "~S is an atom." object) '()))
+(defclass inspector ()
+  ()
+  (:documentation "Super class of inspector objects.
+
+Implementations should sub class in order to dispatch off of the
+inspect-for-emacs method."))
+
+(definterface make-default-inspector ()
+  "Return an inspector object suitable for passing to inspect-for-emacs.")
+
+(definterface inspect-for-emacs (object inspector)
+   "Explain to emacs how to inspect OBJECT.
+
+The argument INSPECTOR is an object representing how to get at
+the internals of OBJECT, it is usually an implementation specific
+class used simply for dispatching to the proper method.
+
+The orgument INSPECTION-MODE is an object specifying how, and
+what, to show to the user.
+
+Returns two values: a string which will be used as the title of
+the inspector buffer and a list specifying how to render the
+object for inspection.
+
+Every elementi of the list must be either a string, which will be
+inserted into the buffer as is, or a list of the form:
+
+ (:value object &optional format) - Render an inspectable
+ object. If format is provided it must be a string and will be
+ rendered in place of the value, otherwise use princ-to-string.
+
+ (:newline) - Render a \\n
+
+ (:action label lambda) - Render LABEL (a text string) which when
+ clicked will call LAMBDA.
+
+ NIL - do nothing.")
+
+(defmethod inspect-for-emacs (object inspector)
+  "Generic method for inspecting any kind of object.
+
+Since we don't know how to deal with OBJECT we simply dump the
+output of CL:DESCRIBE."
+  (declare (ignore inspector inspection-mode))
+  (values "A value."
+          `("Type: " (:value ,(type-of object))
+            (:newline)
+            "Don't know how to inspect the object, dumping output of CL:DESCIRBE:" 
+            (:newline) (:newline)
+            ,(with-output-to-string (desc)
+               (describe object desc)))))
 
 (definterface describe-primitive-type (object)
   "Return a string describing the primitive type of object."


Index: slime/swank-allegro.lisp
diff -u slime/swank-allegro.lisp:1.55 slime/swank-allegro.lisp:1.56
--- slime/swank-allegro.lisp:1.55	Tue Sep 14 09:48:50 2004
+++ slime/swank-allegro.lisp	Tue Sep 14 18:01:07 2004
@@ -409,17 +409,26 @@
 
 ;;;; Inspecting
 
-(defmethod inspected-parts (o)
-  (let* ((class (class-of o))
-         (slots (clos:class-slots class)))
-    (values (format nil "~A~%   is a ~A" o class)
-            (mapcar (lambda (slot)
-                      (let ((name (clos:slot-definition-name slot)))
-                        (cons (princ-to-string name)
-                              (if (slot-boundp o name)
-                                  (slot-value o name)
-                                  (make-unbound-slot-filler)))))
-                    slots))))
+(defclass acl-inspector (inspector)
+  ())
+
+(defimplementation make-default-inspector ()
+  (make-instance 'acl-inspector))
+
+(defimplementation inspect-for-emacs ((o t) (inspector acl-inspector))
+  (declare (ignore inspector))
+  (values "A value."
+          `("Type: " (:value ,(class-of o))
+            (:newline)
+            "Slots:" (:newline)
+            ,@(loop
+                 for slot in (clos:class-slots class)
+                 for name = (clos:slot-definition-name slot)
+                 collect `(:value ,name)
+                 collect " = "
+                 collect (if (slot-boundp o name)
+                             `(:value ,(slot-value o name))
+                             "#<unbound>")))))
 
 ;; duplicated from swank.lisp in order to avoid package dependencies
 (defun common-seperated-spec (list &optional (callback (lambda (v) `(:value ,v))))
@@ -429,19 +438,18 @@
       collect (funcall callback i)
       collect ", ")))
 
-;; AllegroCL doesn't support (documentation <function-obj> t)
-;; so we get the symbol and then its doc
-(defun function-documentation (obj)
-  (documentation (excl::external-fn_symdef obj) 'function))
-
-(defmethod inspected-parts ((f function))  
-  (values (format nil "The function ~S." f)
+(defmethod inspect-for-emacs ((f function) (inspector acl-inspector))
+  (declare (ignore inspector))
+  (values "A function."
           `("Name: " (:value ,(function-name f)) (:newline)
             "It's argument list is: " ,(princ-to-string (arglist f)) (:newline)
             "Documentation:" (:newline)
-            ,(function-documentation f))))
+            ;; AllegroCL doesn't support (documentation <function-obj> t)
+            ;; so we get the symbol and then its doc
+            ,(documentation (excl::external-fn_symdef obj) 'function))))
 
-(defmethod inspected-parts ((class structure-class))
+(defmethod inspect-for-emacs ((class structure-class) (inspector acl-inspector))
+  (declare (ignore inspector))
   (values "A structure class."
           `("Name: " (:value ,(class-name class))
             (:newline)
@@ -476,7 +484,8 @@
                                `(:value ,(swank-mop:class-prototype class))
                                '"N/A (class not finalized)"))))
 
-(defmethod inspected-parts ((slot excl::structure-slot-definition))
+(defmethod inspect-for-emacs ((slot excl::structure-slot-definition) (inspector acl-inspector))
+  (declare (ignore inspector))
   (values "A structure slot." 
           `("Name: " (:value ,(mop:slot-definition-name slot))
             (:newline)
@@ -492,7 +501,8 @@
             "Allocation: " (:value ,(excl::slotd-allocation slot)) (:newline)
             "Read-only: " (:value ,(excl::slotd-read-only slot)) (:newline))))
 
-(defmethod inspected-parts ((o structure-object))
+(defmethod inspect-for-emacs ((o structure-object) (inspector acl-inspector))
+  (declare (ignore inspector))
   (values "An structure object."
           `("Structure class: " (:value ,(class-of o))
             (:newline)


Index: slime/ChangeLog
diff -u slime/ChangeLog:1.525 slime/ChangeLog:1.526
--- slime/ChangeLog:1.525	Tue Sep 14 09:48:50 2004
+++ slime/ChangeLog	Tue Sep 14 18:01:07 2004
@@ -1,3 +1,24 @@
+2004-09-14  Marco Baringer  <mb at bese.it>
+
+	* swank-backend.lisp (inspector, make-default-inspector): Add an
+	INSPECTOR object argument to the inspector protocol. This allows
+	implementations to provide more information regarding cretain
+	objects which can't be, or simply aren't, inspected using the
+	generic inspector implementation. also export inspect-for-emacs
+	and related symbols from the backend package.
+	(make-default-inspector): New function.
+	
+	* swank.lisp (inspected-parts): Rename to inspect-for-emacs and
+	add an inspector argument. Move inspect-for-emacs to
+	swank-backend.lisp, leave only the default implementations.
+
+	* swank-openml.lisp, swank-sbcl.lisp, swank-allegro.lisp,
+	swank-cmucl.lisp, swank-lispworks.lisp (inspected-parts): Rename
+	and change argument list. Many of the inspected-parts methods were
+	being clobbered by the inspected-parts in swank.lisp, now that
+	they're being used the return values have been updated for the new
+	inspect-for-emacs API.
+	
 2004-09-14  Thomas Schilling <tjs_ng at yahoo.de>
 
 	* swank-allegro.lisp (inspected-parts): Implement inspector for





More information about the slime-cvs mailing list