Commits

didier-guest  committed 08feafa

Another batch of improvements for cl-indent.el

  • Participants
  • Parent commits 8df3eb0

Comments (0)

Files changed (2)

+2011-05-11  Didier Verna  <didier@xemacs.org>
+	
+	* cl-indent.el: Subclause-aware loop indentation from Slime.
+	(lisp-indent-loop-subclauses): New customizable user option.
+	(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-case'd here.
+	(lisp-indent-loop): New function. Choose between the old naive
+	indentation and the 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): New variables.
+	Regular expressions for identifying loop parts.
+	(common-lisp-indent-parse-state-depth):
+	(common-lisp-indent-parse-state-start):
+	(common-lisp-indent-parse-state-prev): New functions. Parse state
+	accessors.
+	(common-lisp-indent-loop-macro-1): New function. Subclause aware
+	loop indentation.
+	(common-lisp-indent-loop-advance-past-keyword-on-line): Utility
+	used by the above.
+
+2011-05-11  Didier Verna  <didier@xemacs.org>
+
+        From Nikodemus Siivola.
+	* cl-indent.el (common-lisp-loop-type): New function. Replaces
+	extended-loop-p.
+	(common-lisp-loop-part-indentation): Use common-lisp-loop-type to
+	decide how to indent, supporting both "split" and "unsplit"
+	styles.
+	(lisp-loop-keyword-indentation):
+	(lisp-loop-forms-indentation): Deleted. Pointless now that both
+	split and unsplit styles work automatically.
+	(extended-loop-p): Deleted.
+	(lisp-simple-loop-indentation): Change default to 2.
+	(common-lisp-loop-part-indentation): Return (<indent>
+	<loop-start>) instead of <indent> for non-simple loops.	This lets
+	calculate-lisp-indent know that the following lines of the loop
+	might be indented differently, fixing indent-sexp for loops.
+	(common-lisp-indent-function-1): Remove	bogus special casing of
+	,(...) and ,@(...). Even if backquote was being indented as data,
+	the escaped forms are evaluated, and hence should be indented as
+	lisp code.
+	(lisp-indent-259): Don't throw to exit with normal-indent if
+	processing a tail that isn't a cons. Doing that breaks (... &rest
+	foo) specs.
+	(common-lisp-indent-function-1): Don't take `default' for a
+	tentative defun, unlike anything else starting with `def'.
+
 2011-05-11  Didier Verna  <didier@xemacs.org>
 
 	* cl-indent.el: Whitespace cleanup.

File cl-indent.el

 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
 
 ;;; Synched up with: GNU Emacs 23.3.1
-;;; Enhancements on defmethod and lambda-lists indentation by Didier Verna.
+;;; Plus:
+;;; - Enhancements on defmethod and lambda-lists indentation by Didier Verna.
+;;; - Enhancements on LOOP indentation merged from Slime.
+;;; - A couple of additions from Nikodemus Siivola.
 
 ;;; Commentary:
 
   :type 'boolean
   :group 'lisp-indent)
 
-
-(defcustom lisp-loop-keyword-indentation 3
-  "Indentation of loop keywords in extended loop forms."
-  :type 'integer
+(defcustom lisp-loop-indent-subclauses t
+  "Whether or not to indent loop subclauses."
+  :type 'boolean
   :group 'lisp-indent)
 
-
-(defcustom lisp-loop-forms-indentation 5
-  "Indentation of forms in extended loop forms."
-  :type 'integer
-  :group 'lisp-indent)
-
-
-(defcustom lisp-simple-loop-indentation 3
+(defcustom lisp-simple-loop-indentation 2
   "Indentation of forms in simple loop forms."
   :type 'integer
   :group 'lisp-indent)
 This applies when the value of the `common-lisp-indent-function' property
 is set to `defun'.")
 
-
-(defun extended-loop-p (loop-start)
-  "True if an extended loop form starts at LOOP-START."
-  (condition-case ()
-      (save-excursion
-	(goto-char loop-start)
-	(forward-char 1)
-	(forward-sexp 2)
-	(backward-sexp 1)
-	(looking-at "\\sw"))
-    (error t)))
-
-
-(defun common-lisp-loop-part-indentation (indent-point state)
-  "Compute the indentation of loop form constituents."
-  (let* ((loop-indentation (save-excursion
-			     (goto-char (elt state 1))
-			     (current-column))))
-    (goto-char indent-point)
-    (beginning-of-line)
-    (cond ((not (extended-loop-p (elt state 1)))
-	   (+ loop-indentation lisp-simple-loop-indentation))
-	  ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
-	   (+ loop-indentation lisp-loop-keyword-indentation))
-	  (t
-	   (+ loop-indentation lisp-loop-forms-indentation)))))
-
-
 ;;;###autoload
 (defun common-lisp-indent-function (indent-point state)
   "Function to indent the arguments of a Lisp function call.
   * 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)
 		  ((null method)
 		   (when (null (cdr path))
 		     ;; (package prefix was stripped off above)
-		     (cond ((string-match "\\`def"
-					  function)
+		     (cond ((and (string-match "\\`def" function)
+				 (not (string-match "\\`default" function)))
 			    (setq tentative-defun t))
 			   ((string-match
 			     (eval-when-compile
 			(not (eq (char-after (- containing-sexp 2)) ?\#)))
 		   ;; No indentation for "'(...)" elements
 		   (setq calculated (1+ sexp-column)))
-		  ((or (eq (char-after (1- containing-sexp)) ?\,)
-		       (and (eq (char-after (1- containing-sexp)) ?\@)
-			    (eq (char-after (- containing-sexp 2)) ?\,)))
-		   ;; ",(...)" or ",@(...)"
-		   (setq calculated normal-indent))
 		  ((eq (char-after (1- containing-sexp)) ?\#)
 		   ;; "#(...)"
 		   (setq calculated (1+ sexp-column)))
   (let (limit)
     (cond ((save-excursion
 	     (goto-char indent-point)
-	     (beginning-of-line)
-	     (skip-chars-forward " \t")
+	     (back-to-indentation)
 	     (setq limit (point))
 	     (looking-at lisp-indent-lambda-list-keywords-regexp))
 	   ;; We're facing a lambda-list keyword.
 		   (null (cdr method)))
 	      (lisp-indent-report-bad-format method))
 
-	  (cond ((and tail (not (consp tem)))
-		 ;; indent tail of &rest in same way as first elt of rest
-		 (throw 'exit normal-indent))
-		((eq tem '&body)
+	  (cond ((eq tem '&body)
 		 ;; &body means (&rest <lisp-body-indent>)
 		 (throw 'exit
 		   (if (and (= n 0)     ;first body form
       normal-indent
     (save-excursion
       (goto-char indent-point)
-      (beginning-of-line)
-      (skip-chars-forward " \t")
+      (back-to-indentation)
       (list (cond ((looking-at "\\sw\\|\\s_")
 		   ;; a tagbody tag
 		   (+ sexp-column lisp-tag-indentation))
 	      (+ 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 simple version
+
+(defun common-lisp-loop-type (loop-start)
+  "Returns the type of the loop form at LOOP-START.
+Possible types are SIMPLE, EXTENDED, and EXTENDED/SPLIT.
+EXTENDED/SPLIT refers to extended loops whose body does
+not start on the same line as the opening parenthesis of
+the loop."
+  (condition-case ()
+      (save-excursion
+	(goto-char loop-start)
+	(let ((line (line-number-at-pos)))
+	  (forward-char 1)
+	  (forward-sexp 2)
+	  (backward-sexp 1)
+	  (if (looking-at "\\sw")
+	      (if (= line (line-number-at-pos))
+		  'extended
+		'extended/split)
+	    'simple)))
+    (error 'simple)))
+
+(defun common-lisp-loop-part-indentation (indent-point state)
+  "Compute the indentation of loop form constituents."
+  (let* ((loop-start (elt state 1))
+	 (type (common-lisp-loop-type loop-start))
+	 (loop-indentation (save-excursion
+			     (goto-char loop-start)
+			     (if (eq 'extended/split type)
+				 (- (current-column) 4)
+			       (current-column)))))
+    (goto-char indent-point)
+    (beginning-of-line)
+    (cond ((eq 'simple type)
+	   (+ loop-indentation lisp-simple-loop-indentation))
+	  ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)")
+	   (list (+ loop-indentation 6) loop-start))
+	  (t
+	   (list (+ loop-indentation 9) loop-start)))))
+
+;;;; 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)
 	   (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))