[slime-cvs] CVS slime/contrib

CVS User nsiivola nsiivola at common-lisp.net
Sun May 15 17:16:24 UTC 2011


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

Modified Files:
	ChangeLog slime-cl-indent.el 
Log Message:
slime-indentation: subclause aware loop indentation

  Adapted from cl-indent-patches.el.

  Setting lisp-loop-indent-subclauses to nil causes old indentation method to
  be used. Default is t.


--- /project/slime/cvsroot/slime/contrib/ChangeLog	2011/05/15 17:13:28	1.441
+++ /project/slime/cvsroot/slime/contrib/ChangeLog	2011/05/15 17:16:24	1.442
@@ -1,5 +1,29 @@
 2011-05-10  Nikodemus Siivola  <nikodemus at random-state.net>
 
+	* slime-cl-indent.el: subclause aware loop indentation, adapted from
+	cl-indent-patches.el.
+	(lisp-indent-loop-subclauses): New customization.
+	(common-lisp-indent-function): Trampoline directly to
+	common-lisp-indent-function-1 -- loop indentation is now picked up
+	by the normal machinery instead of being special cased here.
+	(lisp-indent-loop): New function. Chooses between the old naive
+	indentation and new subclause-aware version based on
+	lisp-indent-loop-subclauses.
+	(common-lisp-indent-body-introducing-loop-macro-keyword):
+	(common-lisp-indent-prefix-loop-macro-keyword):
+	(common-lisp-indent-clause-joining-loop-macro-keyword):
+	(common-lisp-indent-indented-loop-macro-keyword):
+	(common-lisp-indent-indenting-loop-macro-keyword):
+	(common-lisp-indent-loop-macro-else-keyword): Regular expressions
+	for identifying loop parts.
+	(common-lisp-indent-parse-state-depth):
+	(common-lisp-indent-parse-state-start):
+	(common-lisp-indent-parse-state-prev): Parse state accessors.
+	(common-lisp-indent-loop-macro-1): Subclause aware loop indentation.
+	(common-lisp-indent-loop-advance-past-keyword-on-line): Utility used by the above.
+
+2011-05-10  Nikodemus Siivola  <nikodemus at random-state.net>
+
 	* slime-cl-indent.el (common-lisp-loop-type): New function,
 	replaces extended-loop-p.
 	(common-lisp-loop-part-indentation): Use common-lisp-loop-type to
--- /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/05/15 17:13:28	1.7
+++ /project/slime/cvsroot/slime/contrib/slime-cl-indent.el	2011/05/15 17:16:24	1.8
@@ -69,6 +69,11 @@
   :type 'boolean
   :group 'lisp-indent)
 
+(defcustom lisp-loop-indent-subclauses t
+  "Whether or not to indent loop subclauses."
+  :type 'boolean
+  :group 'lisp-indent)
+
 (defcustom lisp-simple-loop-indentation 2
   "Indentation of forms in simple loop forms."
   :type 'integer
@@ -122,7 +127,9 @@
 (defvar lisp-indent-defun-method '(4 &lambda &body)
   "Defun-like indentation method.
 This applies when the value of the `common-lisp-indent-function' property
-is set to `defun'.") 
+is set to `defun'.")
+
+;;;; LOOP indentation, the simple version
 
 (defun common-lisp-loop-type (loop-start)
   "Returns the type of the loop form at LOOP-START.
@@ -162,7 +169,6 @@
           (t
            (list (+ loop-indentation 9) loop-start)))))
 
-
 ;;;###autoload
 (defun common-lisp-indent-function (indent-point state)
   "Function to indent the arguments of a Lisp function call.
@@ -234,10 +240,7 @@
   * arguments after the first should be lists, and there may be any number
     of them.  The first list element has an offset of 2, all the rest
     have an offset of 2+1=3."
-  (if (save-excursion (goto-char (elt state 1))
-		      (looking-at "([Ll][Oo][Oo][Pp]"))
-      (common-lisp-loop-part-indentation indent-point state)
-    (common-lisp-indent-function-1 indent-point state)))
+  (common-lisp-indent-function-1 indent-point state))
 
 
 (defun common-lisp-indent-function-1 (indent-point state)
@@ -654,8 +657,204 @@
               (+ sexp-column lisp-body-indent)))
        (error (+ sexp-column lisp-body-indent)))))
 
+(defun lisp-indent-loop (path state indent-point sexp-column normal-indent)
+  (if lisp-loop-indent-subclauses
+      (list (common-lisp-indent-loop-macro-1 state indent-point)
+            (common-lisp-indent-parse-state-start state))
+    (common-lisp-loop-part-indentation indent-point state)))
+
+;;;; LOOP indentation, the complex version -- handles subclause indentation
+
+;; Regexps matching various varieties of loop macro keyword ...
+(defvar common-lisp-indent-body-introducing-loop-macro-keyword
+  "do\\|finally\\|initially"
+  "Regexp matching loop macro keywords which introduce body-forms.")
+
+;; This is so "and when" and "else when" get handled right
+;; (not to mention "else do" !!!)
+(defvar common-lisp-indent-prefix-loop-macro-keyword
+  "and\\|else"
+  "Regexp matching loop macro keywords which are prefixes.")
+
+(defvar common-lisp-indent-clause-joining-loop-macro-keyword
+  "and"
+  "Regexp matching 'and', and anything else there ever comes to be like it.")
+
+;; This is handled right, but it's incomplete ...
+;; (It could probably get arbitrarily long if I did *every* iteration-path)
+(defvar common-lisp-indent-indented-loop-macro-keyword
+  "into\\|by\\|upto\\|downto\\|above\\|below\\|on\\|being\\|=\\|first\\|then\\|from\\|to"
+  "Regexp matching keywords introducing loop subclauses.
+Always indented two.")
+
+(defvar common-lisp-indent-indenting-loop-macro-keyword
+  "when\\|unless\\|if"
+  "Regexp matching keywords introducing conditional clauses.
+Cause subsequent clauses to be indented.")
+
+(defvar common-lisp-indent-loop-macro-else-keyword "else")
+
+;;; Attempt to indent the loop macro ...
+
+(defun common-lisp-indent-parse-state-depth (parse-state)
+  (car parse-state))
+
+(defun common-lisp-indent-parse-state-start (parse-state)
+  (car (cdr parse-state)))
+
+(defun common-lisp-indent-parse-state-prev (parse-state)
+  (car (cdr (cdr parse-state))))
+
+(defun common-lisp-indent-loop-macro-1 (parse-state indent-point)
+  (catch 'return-indentation
+    (save-excursion
+      ;; Find first clause of loop macro, and use it to establish
+      ;; base column for indentation
+      (goto-char (common-lisp-indent-parse-state-start parse-state))
+      (let ((loop-start-column (current-column)))
+	(common-lisp-indent-loop-advance-past-keyword-on-line)
+
+	(when (eolp)
+          (forward-line 1)
+          (end-of-line)
+          ;; If indenting first line after "(loop <newline>"
+          ;; cop out ...
+          (if (<= indent-point (point))
+              (throw 'return-indentation (+ 2 loop-start-column)))
+          (back-to-indentation))
+
+	(let* ((case-fold-search t)
+	       (loop-macro-first-clause (point))
+	       (previous-expression-start (common-lisp-indent-parse-state-prev parse-state))
+	       (default-value (current-column))
+	       (loop-body-p nil)
+	       (loop-body-indentation nil)
+	       (indented-clause-indentation (+ 2 default-value)))
+	  ;; Determine context of this loop clause, starting with the
+	  ;; expression immediately preceding the line we're trying to indent
+	  (goto-char previous-expression-start)
+
+	  ;; Handle a body-introducing-clause which ends a line specially.
+	  (if (looking-at common-lisp-indent-body-introducing-loop-macro-keyword)
+	      (let ((keyword-position (current-column)))
+		(setq loop-body-p t)
+		(setq loop-body-indentation
+		      (if (common-lisp-indent-loop-advance-past-keyword-on-line)
+			  (current-column)
+			(back-to-indentation)
+			(if (/= (current-column) keyword-position)
+			    (+ 2 (current-column))
+                          (+ keyword-position 3)))))
+
+	    (back-to-indentation)
+	    (if (< (point) loop-macro-first-clause)
+		(goto-char loop-macro-first-clause))
+	    ;; If there's an "and" or "else," advance over it.
+	    ;; If it is alone on the line, the next "cond" will treat it
+	    ;; as if there were a "when" and indent under it ...
+	    (let ((exit nil))
+	      (while (and (null exit)
+			  (looking-at common-lisp-indent-prefix-loop-macro-keyword))
+		(if (null (common-lisp-indent-loop-advance-past-keyword-on-line))
+		    (progn (setq exit t)
+			   (back-to-indentation)))))
+
+	    ;; Found start of loop clause preceding the one we're trying to indent.
+	    ;; Glean context ...
+	    (cond
+             ((looking-at "(")
+              ;; We're in the middle of a clause body ...
+              (setq loop-body-p t)
+              (setq loop-body-indentation (current-column)))
+             ((looking-at common-lisp-indent-body-introducing-loop-macro-keyword)
+              (setq loop-body-p t)
+              ;; Know there's something else on the line (or would
+              ;; have been caught above)
+              (common-lisp-indent-loop-advance-past-keyword-on-line)
+              (setq loop-body-indentation (current-column)))
+             (t
+              (setq loop-body-p nil)
+              (if (or (looking-at common-lisp-indent-indenting-loop-macro-keyword)
+                      (looking-at common-lisp-indent-prefix-loop-macro-keyword))
+                  (setq default-value (+ 2 (current-column))))
+              (setq indented-clause-indentation (+ 2 (current-column)))
+              ;; We still need loop-body-indentation for "syntax errors" ...
+              (goto-char previous-expression-start)
+              (setq loop-body-indentation (current-column)))))
+
+          ;; Go to first non-blank character of the line we're trying to indent.
+          ;; (if none, wind up poised on the new-line ...)
+          (goto-char indent-point)
+          (back-to-indentation)
+          (cond
+           ((looking-at "(")
+            ;; Clause body ...
+            loop-body-indentation)
+           ((or (eolp) (looking-at ";"))
+            ;; Blank line.  If body-p, indent as body, else indent as
+            ;; vanilla clause.
+            (if loop-body-p
+                loop-body-indentation
+              default-value))
+           ((looking-at common-lisp-indent-indented-loop-macro-keyword)
+            indented-clause-indentation)
+           ((looking-at common-lisp-indent-clause-joining-loop-macro-keyword)
+            (let ((stolen-indent-column nil))
+              (forward-line -1)
+              (while (and (null stolen-indent-column)
+                          (> (point) loop-macro-first-clause))
+                (back-to-indentation)
+                (if (and (< (current-column) loop-body-indentation)
+                         (looking-at "\\sw"))
+                    (progn
+                      (if (looking-at common-lisp-indent-loop-macro-else-keyword)
+                          (common-lisp-indent-loop-advance-past-keyword-on-line))
+                      (setq stolen-indent-column
+                            (current-column)))
+                  (forward-line -1)))
+              (if stolen-indent-column
+                  stolen-indent-column
+                default-value)))
+           (t default-value)))))))
+
+(defun common-lisp-indent-loop-advance-past-keyword-on-line ()
+  (forward-word 1)
+  (while (and (looking-at "\\s-") (not (eolp)))
+    (forward-char 1))
+  (if (eolp)
+      nil
+    (current-column)))
+
+;; Test-case for subclause indentation
+'(loop for i from 0 below 2
+       for j from 0 below 2
+       when foo
+         do (fubar)
+            (bar)
+            (moo)
+         and collect cash
+               into honduras
+       else do ;; this is the body of the first else
+               ;; the body is ...
+               (indented to the above comment)
+               (ZMACS gets this wrong)
+            and do this
+            and do that
+            and when foo
+                  do the-other
+                  and cry
+       when this-is-a-short-condition do
+         (body code of the when)
+       when here's something I used to botch do (here is a body)
+                                                (rest of body indented same)
+       do
+          (exdented loop body)
+          (I'm not sure I like this but it's compatible)
+       when funny-predicate do ;; Here's a comment
+                               (body filled to comment))
 
 
+;;;; Indentation specs for standard symbols, and a few semistandard ones.
 (let ((l '((block 1)
            (case        (4 &rest (&whole 2 &rest 1)))
            (ccase . case)
@@ -710,7 +909,7 @@
            (handler-bind . let)
            (restart-bind . let)
            (locally 1)
-           ;(loop         lisp-indent-loop)
+           (loop           lisp-indent-loop)
            (:method (&lambda &body)) ; in `defgeneric'
            (multiple-value-bind ((&whole 6 &rest 1) 4 &body))
            (multiple-value-call (4 &body))





More information about the slime-cvs mailing list