[slime-cvs] CVS update: slime/swank-cmucl.lisp

[Marco Baringer]

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

Modified Files:
	swank-cmucl.lisp 
Log Message:
(inspect-for-emacs function): Use next method's values and simply add
cmucl specific details.

Date: Mon Oct 25 18:17:57 2004
Author: mbaringer

Index: slime/swank-cmucl.lisp
diff -u slime/swank-cmucl.lisp:1.123 slime/swank-cmucl.lisp:1.124
--- slime/swank-cmucl.lisp:1.123	Sun Oct 17 20:23:52 2004
+++ slime/swank-cmucl.lisp	Mon Oct 25 18:17:57 2004
@@ -1857,30 +1857,31 @@
                        (loop for value in parts  for i from 0 
                              append (label-value-line i value))))))))
 
-(defmethod inspect-for-emacs ((o function) (inspector cmucl-inspector))
+(defmethod inspect-for-emacs :around ((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)
-                   (append (label-value-line*
-                            ("self" (kernel:%function-self o))
-                            ("next" (kernel:%function-next o))
-                            ("name" (kernel:%function-name o))
-                            ("arglist" (kernel:%function-arglist o))
-                            ("type" (kernel:%function-type o))
-                            ("code" (kernel:function-code-header o)))
-                           (list 
-                            (with-output-to-string (s)
-                              (disassem:disassemble-function o :stream s))))))
-	  ((= header vm:closure-header-type)
-	   (values (format nil "~A is a closure" o)
-                   (append 
-                    (label-value-line "function" (kernel:%closure-function o))
-                    `("Environment:" (:newline))
-                    (loop for i from 0 below (1- (kernel:get-closure-length o))
-                          append (label-value-line
-                                  i (kernel:%closure-index-ref o i))))))
-	  (t (call-next-method o)))))
+  (multiple-value-bind (title contents)
+      (call-next-method)
+    (let ((header (kernel:get-type o)))
+      (cond ((= header vm:function-header-type)
+             (values (format nil "~A is a function." o)
+                     (append contents
+                             (label-value-line*
+                              ("Self" (kernel:%function-self o))
+                              ("Next" (kernel:%function-next o))
+                              ("Type" (kernel:%function-type o))
+                              ("Code" (kernel:function-code-header o)))
+                             (list 
+                              (with-output-to-string (s)
+                                (disassem:disassemble-function o :stream s))))))
+            ((= header vm:closure-header-type)
+             (values (format nil "~A is a closure" o)
+                     (append 
+                      (label-value-line "Function Object" (kernel:%closure-function o))
+                      `("Environment:" (:newline))
+                      (loop
+                         for i from 0 below (1- (kernel:get-closure-length o))
+                         append (label-value-line i (kernel:%closure-index-ref o i))))))
+	  (t (values title contents))))))
 
 (defmethod inspect-for-emacs ((o kernel:code-component) (_ cmucl-inspector))
   (declare (ignore _))