[slime-cvs] CVS slime

[heller]

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

Modified Files:
	ChangeLog swank-openmcl.lisp 
Log Message:
Fix inspecting of arrays.

* swank-openmcl.lisp (emacs-inspect :around (t)): call-next-method
may return a lazy list.  Detect that case and only append to
ordinary lists.
(emacs-inspect (t)): Don't mark labels as inspectable. Just print
them.

--- /project/slime/cvsroot/slime/ChangeLog	2008/09/20 16:33:55	1.1529
+++ /project/slime/cvsroot/slime/ChangeLog	2008/09/20 16:34:08	1.1530
@@ -1,5 +1,15 @@
 2008-09-20  Helmut Eller  <heller at common-lisp.net>
 
+	Fix inspecting of arrays.
+
+	* swank-openmcl.lisp (emacs-inspect :around (t)): call-next-method
+	may return a lazy list.  Detect that case and only append to
+	ordinary lists.
+	(emacs-inspect (t)): Don't mark labels as inspectable. Just print
+	them.
+
+2008-09-20  Helmut Eller  <heller at common-lisp.net>
+
 	Fix BREAK and backtraces after interrupts.
 
 	* swank-openmcl.lisp (*sldb-stack-top-hint*): New variable.
--- /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/09/20 16:33:55	1.136
+++ /project/slime/cvsroot/slime/swank-openmcl.lisp	2008/09/20 16:34:08	1.137
@@ -764,7 +764,7 @@
              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 (if label (format nil "~(~a~)" label) i)
              collect " = "
              collect `(:value ,value)
              collect '(:newline))))
@@ -774,10 +774,13 @@
   (if (or (uvector-inspector-p o)
           (not (ccl:uvectorp o)))
       (call-next-method)
-      (append (call-next-method)
-                 `((:newline)
-                   (:value ,(make-instance 'uvector-inspector :object o)
-                           "Underlying UVECTOR")))))
+      (let ((value (call-next-method)))
+        (cond ((listp value)
+               (append value
+                       `((:newline)
+                         (:value ,(make-instance 'uvector-inspector :object o)
+                                 "Underlying UVECTOR"))))
+              (t value)))))
 
 (defclass uvector-inspector ()
   ((object :initarg :object)))
@@ -787,13 +790,11 @@
   (:method ((object uvector-inspector)) t))
 
 (defmethod emacs-inspect ((uv uvector-inspector))
-  (with-slots (object)
-      uv
-            (loop
-               for index below (ccl::uvsize object)
-               collect (format nil "~D: " index)
-               collect `(:value ,(ccl::uvref object index))
-               collect `(:newline))))
+  (with-slots (object) uv
+    (loop for index below (ccl::uvsize object)
+          collect (format nil "~D: " index)
+          collect `(:value ,(ccl::uvref object index))
+          collect `(:newline))))
 
 (defun closure-closed-over-values (closure)
   (let ((howmany (nth-value 8 (ccl::function-args (ccl::closure-function closure)))))
@@ -874,7 +875,8 @@
   (ccl:process-interrupt 
    thread 
    (lambda ()
-     (let ((*sldb-stack-top-hint* (ccl::%get-frame-ptr)))
+     (let ((*sldb-stack-top-hint* (or *sldb-stack-top-hint*
+                                      (ccl::%get-frame-ptr))))
        (funcall function)))))
   
 (defun mailbox (thread)