[slime-cvs] CVS slime/contrib

[CVS User nsiivola]

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

Modified Files:
	ChangeLog swank-indentation.lisp 
Log Message:
macro-indentation: try to sort it out

 * Restore old default.

 * Give slime-indentation the more complex one, and try to address the issues
   of the previous attempt at complexity.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/15 09:13:21	1.485
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/06/16 08:29:17	1.486
@@ -1,3 +1,9 @@
+2011-06-16  Nikodemus Siivola  <nikodemus at random-state.net>
+
+	* swank-indentation.lisp (macro-indentation): More complex
+	version than the default. Fixes some of the misbehaviour of
+	the previous complex version.
+
 2011-06-15  Stas Boukarev  <stassats at gmail.com>
 
 	* slime-scheme.el (slime-scheme-indentation-update):
--- /project/slime/cvsroot/slime/contrib/swank-indentation.lisp	2011/05/21 17:01:44	1.3
+++ /project/slime/cvsroot/slime/contrib/swank-indentation.lisp	2011/06/16 08:29:17	1.4
@@ -45,4 +45,90 @@
           (macro-indentation arglist)))))
     (t nil)))
 
+;;; More complex version.
+(defun macro-indentation (arglist)
+  (labels ((frob (list)
+             (if (every (lambda (x)
+                          (member x '(nil "&rest") :test #'equal))
+                        list)
+                 ;; If there was nothing interesting, don't return anything.
+                 nil
+                 ;; Otherwise substitute leading NIL's with 4.
+                 (let ((ok t))
+                   (substitute-if 4 (lambda (x)
+                                      (if (and ok (not x))
+                                          t
+                                          (setf ok nil)))
+                                  list))))
+           (walk (list level &optional firstp)
+             (when (consp list)
+               (let ((head (car list)))
+                 (if (consp head)
+                     (let ((indent (frob (walk head (+ level 1) t))))
+                       (cons (list* "&whole" 4 indent) (walk (cdr list) level)))
+                     (case head
+                       ;; &BODY is &BODY, this is clear.
+                       (&body
+                        '("&body"))
+                       ;; &KEY is tricksy. If it's at the base level, we want
+                       ;; to indent them normally:
+                       ;;
+                       ;;  (foo bar quux
+                       ;;       :quux t
+                       ;;       :zot nil)
+                       ;;
+                       ;; If it's at a destructuring level, we want indent of 1:
+                       ;;
+                       ;;  (with-foo (var arg
+                       ;;             :foo t
+                       ;;             :quux nil)
+                       ;;     ...)
+                       (&key
+                        (if (zerop level)
+                            '("&rest" nil)
+                            '("&rest" 1)))
+                       ;; &REST is tricksy. If it's at the front of
+                       ;; destructuring, we want to indent by 1, otherwise
+                       ;; normally:
+                       ;;
+                       ;;  (foo (bar quux
+                       ;;        zot)
+                       ;;    ...)
+                       ;;
+                       ;; but
+                       ;;
+                       ;;  (foo bar quux
+                       ;;       zot)
+                       (&rest
+                        (if (and (plusp level) firstp)
+                            '("&rest" 1)
+                            '("&rest" nil)))
+                       ;; &WHOLE and &ENVIRONMENT are skipped as if they weren't there
+                       ;; at all.
+                       ((&whole &environment)
+                        (walk (cddr list) level firstp))
+                       ;; &OPTIONAL is indented normally -- and the &OPTIONAL marker
+                       ;; itself is not counted.
+                       (&optional
+                        (walk (cdr list) level))
+                       ;; Indent normally, walk the tail -- but
+                       ;; unknown lambda-list keywords terminate the walk.
+                       (otherwise
+                        (unless (member head lambda-list-keywords)
+                          (cons nil (walk (cdr list) level))))))))))
+    (frob (walk arglist 0 t))))
+
+#+nil
+(progn
+  (assert (equal '(4 4 ("&whole" 4 "&rest" 1) "&body")
+                 (macro-indentation '(bar quux (&rest slots) &body body))))
+  (assert (equal nil
+                 (macro-indentation '(a b c &rest more))))
+  (assert (equal '(4 4 4 "&body")
+                 (macro-indentation '(a b c &body more))))
+  (assert (equal '(("&whole" 4 4 4 "&rest" 1) "&body")
+                 (macro-indentation '((name zot &key foo bar) &body body))))
+  (assert (equal nil
+                 (macro-indentation '(x y &key z)))))
+
 (provide :swank-indentation)