From nsiivola at common-lisp.net  Sun Jul  3 18:15:38 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Sun, 03 Jul 2011 11:15:38 -0700
Subject: [slime-cvs] CVS slime
Message-ID: <E1QdRCk-0000NN-Eh@common-lisp.net>

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

Modified Files:
	ChangeLog swank-sbcl.lisp 
Log Message:
sbcl: teach the SBCL backend about &MORE vars

  Only makes a difference on bleeding-edge SBCL.


--- /project/slime/cvsroot/slime/ChangeLog	2011/06/21 11:24:01	1.2205
+++ /project/slime/cvsroot/slime/ChangeLog	2011/07/03 18:15:38	1.2206
@@ -1,3 +1,9 @@
+2011-07-03  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank-sbcl.lisp (debug-var-info): New function: calls SB-DI::DEBUG-VAR-INFO
+	when available.
+	(frame-locals, frame-var-value): Treat more-context and more-count vars specially.
+
 2011-06-21  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* swank.lisp (*indentation-cache-lock*): Deleted.
--- /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/06/16 08:28:45	1.284
+++ /project/slime/cvsroot/slime/swank-sbcl.lisp	2011/07/03 18:15:38	1.285
@@ -1188,20 +1188,62 @@
     (:valid (sb-di:debug-var-value var frame))
     ((:invalid :unknown) ':<not-available>)))
 
+(defun debug-var-info (var)
+  ;; Introduced by SBCL 1.0.49.76.
+  (let ((s (find-symbol "DEBUG-VAR-INFO" :sb-di)))
+    (when (and s (fboundp s))
+      (funcall s var))))
+
 (defimplementation frame-locals (index)
   (let* ((frame (nth-frame index))
 	 (loc (sb-di:frame-code-location frame))
-	 (vars (frame-debug-vars frame)))
+	 (vars (frame-debug-vars frame))
+         ;; Since SBCL 1.0.49.76 PREPROCESS-FOR-EVAL understands SB-DEBUG::MORE
+         ;; specially.
+         (more-name (or (find-symbol "MORE" :sb-debug) 'more))
+         (more-context nil)
+         (more-count nil)
+         (more-id 0))
     (when vars
-      (loop for v across vars collect
-            (list :name (sb-di:debug-var-symbol v)
-                  :id (sb-di:debug-var-id v)
-                  :value (debug-var-value v frame loc))))))
+      (let ((locals
+              (loop for v across vars
+                    do (when (eq (sb-di:debug-var-symbol v) more-name)
+                         (incf more-id))
+                       (case (debug-var-info v)
+                         (:more-context
+                          (setf more-context (debug-var-value v frame loc)))
+                         (:more-count
+                          (setf more-count (debug-var-value v frame loc))))
+                    collect
+                       (list :name (sb-di:debug-var-symbol v)
+                             :id (sb-di:debug-var-id v)
+                             :value (debug-var-value v frame loc)))))
+        (when (and more-context more-count)
+          (setf locals (append locals
+                               (list
+                                (list :name more-name
+                                      :id more-id
+                                      :value (multiple-value-list
+                                              (sb-c:%more-arg-values more-context
+                                                                     0 more-count)))))))
+        locals))))
 
 (defimplementation frame-var-value (frame var)
   (let* ((frame (nth-frame frame))
-         (dvar (aref (frame-debug-vars frame) var)))
-    (debug-var-value dvar frame (sb-di:frame-code-location frame))))
+         (vars (frame-debug-vars frame))
+         (loc (sb-di:frame-code-location frame))
+         (dvar (if (= var (length vars))
+                   ;; If VAR is out of bounds, it must be the fake var we made up for
+                   ;; &MORE.
+                   (let* ((context-var (find :more-context vars :key #'debug-var-info))
+                          (more-context (debug-var-value context-var frame loc))
+                          (count-var (find :more-count vars :key #'debug-var-info))
+                          (more-count (debug-var-value count-var frame loc)))
+                     (return-from frame-var-value
+                       (multiple-value-list (sb-c:%more-arg-values more-context
+                                                                   0 more-count))))
+                   (aref vars var))))
+    (debug-var-value dvar frame loc)))
 
 (defimplementation frame-catch-tags (index)
   (mapcar #'car (sb-di:frame-catches (nth-frame index))))




From nsiivola at common-lisp.net  Wed Jul 27 16:45:37 2011
From: nsiivola at common-lisp.net (CVS User nsiivola)
Date: Wed, 27 Jul 2011 09:45:37 -0700
Subject: [slime-cvs] CVS slime/contrib
Message-ID: <E1Qm7En-0006X4-72@common-lisp.net>

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

Modified Files:
	ChangeLog slime-cl-indent-test.txt slime-cl-indent.el 
Log Message:
slime-indentation: tweak COND indentation

  Indent

    (cond (symbol (foo)
                  (bar)))

  not

    (cond (symbol (foo)
           (bar)))

  -- should not change anything unless there is a form on the same
  line with a test that's a symbol.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/21 11:49:37	1.487
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/07/27 16:45:36	1.488
@@ -1,3 +1,8 @@
+2011-07-27  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* slime-cl-indent.el: Tweak COND indentation.
+	* slime-cl-indent-test.txt: Tests 48 and 49.
+
 2011-06-21  Nikodemus Siivola  <nikodemus at random-state.net>
 
 	* slime-cl-indent.el (lisp-loop-indent-forms-like-keywords): Fix type error.
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/06/14 13:59:31	1.9
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent-test.txt	2011/07/27 16:45:37	1.10
@@ -505,3 +505,30 @@
      :quux nil)
   ...)
 
+;;; Test: 48
+
+(cond
+  ((> x y) (foo)
+   ;; This isn't ideal -- I at least would align with (FOO here.
+   (bar) (quux)
+   (zot))
+  (qux (foo)
+       (bar)
+       (zot))
+  (zot
+   (foo)
+   (foo2))
+  (t (foo)
+     (bar)))
+
+;;; Test: 49
+
+(cond ((> x y) (foo)
+       ;; This isn't ideal -- I at least would align with (FOO here.
+       (bar))
+      (qux (foo)
+           (bar))
+      (zot
+       (foo))
+      (t (foo)
+         (bar)))
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/06/21 11:49:37	1.48
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/07/27 16:45:37	1.49
@@ -1472,7 +1472,7 @@
            (etypecase   (as case))
            (ctypecase   (as case))
            (catch 1)
-           (cond        (&rest (&whole 2 &rest 1)))
+           (cond        (&rest (&whole 2 &rest nil)))
            ;; for DEFSTRUCT
            (:constructor (4 &lambda))
            (defvar      (4 2 2))