Commits

Anonymous committed dae614d

Support for IF* and a test suite

Comments (0)

Files changed (2)

+2011-05-15  Didier Verna  <didier@xemacs.org>
+
+	From Nikodemus Siivola.
+	* cl-indent.el (common-lisp-indent-if*-keyword): New variable.
+	* cl-indent.el (common-lisp-indent-if*):
+	* cl-indent.el (common-lisp-indent-if*-1):
+	* cl-indent.el (common-lisp-indent-if*-advance-past-keyword-on-line):
+	New functions.
+	* cl-indent.el: Add an IF* common-lisp-indent-property.
+	* cl-indent.el (test-lisp-indent):
+	* cl-indent.el (run-lisp-indent-tests): New functions.
+
 2011-05-15  Didier Verna  <didier@xemacs.org>
 
 	* cl-indent.el (common-lisp-indent-function-1):
 ;;; 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.
+;;; - Support for IF* and a test suite from Nikodemus Siivola.
 
 ;;; Commentary:
 
 This applies when the value of the `common-lisp-indent-function' property
 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.
+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)))))
+
 ;;;###autoload
 (defun common-lisp-indent-function (indent-point state)
   "Function to indent the arguments of a Lisp function call.
 	    (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 ...
       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))
+;;;; IF* is not standard, but a plague upon the land
+;;;; ...let's at least try to indent it.
+
+(defvar common-lisp-indent-if*-keyword
+  "threnret\\|elseif\\|then\\|else"
+  "Regexp matching if* keywords")
+
+(defun common-lisp-indent-if*
+    (path parse-state indent-point sexp-column normal-indent)
+  (list (common-lisp-indent-if*-1 parse-state indent-point)
+	(common-lisp-indent-parse-state-start parse-state)))
+
+(defun common-lisp-indent-if*-1 (parse-state indent-point)
+  (catch 'return-indentation
+    (save-excursion
+      ;; Find first clause of if* macro, and use it to establish
+      ;; base column for indentation
+      (goto-char (common-lisp-indent-parse-state-start parse-state))
+      (let ((if*-start-column (current-column)))
+	(common-lisp-indent-if*-advance-past-keyword-on-line)
+	(let* ((case-fold-search t)
+	       (if*-first-clause (point))
+	       (previous-expression-start
+		(common-lisp-indent-parse-state-prev parse-state))
+	       (default-value (current-column))
+	       (if*-body-p nil)
+	       (if*-body-indentation nil))
+	  ;; Determine context of this if* 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.
+	  (back-to-indentation)
+	  (if (< (point) if*-first-clause)
+	      (goto-char if*-first-clause))
+	  ;; Found start of if* clause preceding the one we're trying to indent.
+	  ;; Glean context ...
+	  (cond
+	   ((looking-at common-lisp-indent-if*-keyword)
+	    (setq if*-body-p t)
+	    ;; Know there's something else on the line (or would
+	    ;; have been caught above)
+	    (common-lisp-indent-if*-advance-past-keyword-on-line)
+	    (setq if*-body-indentation (current-column)))
+	   ((looking-at "#'\\|'\\|(")
+	    ;; We're in the middle of a clause body ...
+	    (setq if*-body-p t)
+	    (setq if*-body-indentation (current-column)))
+	   (t
+	    (setq if*-body-p nil)
+	    ;; We still need if*-body-indentation for "syntax errors" ...
+	    (goto-char previous-expression-start)
+	    (setq if*-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
+	   ((or (eolp) (looking-at ";"))
+	    ;; Blank line.  If body-p, indent as body, else indent as
+	    ;; vanilla clause.
+	    (if if*-body-p
+		if*-body-indentation
+	      default-value))
+	   ((not (looking-at common-lisp-indent-if*-keyword))
+	    ;; Clause body ...
+	    if*-body-indentation)
+	   (t
+	    (- (+ 7 if*-start-column)
+	       (- (match-end 0) (match-beginning 0))))))))))
+
+(defun common-lisp-indent-if*-advance-past-keyword-on-line ()
+  (forward-word 1)
+  (block move-forward
+    (while (and (looking-at "\\s-") (not (eolp)))
+      (forward-char 1)))
+  (if (eolp)
+      nil
+    (current-column)))
 
 
 ;;;; Indentation specs for standard symbols, and a few semistandard ones.
 	   (if          (nil nil &body))
 	   ;; single-else style (then and else equally indented)
 	   (if          (&rest nil))
+	   (if*         common-lisp-indent-if*)
 	   (lambda      (&lambda &rest lisp-indent-function-lambda-hack))
 	   (let         ((&whole 4 &rest (&whole 1 1 2)) &body))
 	   (let* . let)
 	     (get (cdr el) 'common-lisp-indent-function)
 	     (car (cdr el))))))
 
+(defun test-lisp-indent (tests)
+  (let ((ok 0))
+    (dolist (test tests)
+     (with-temp-buffer
+       (lisp-mode)
+       (setq indent-tabs-mode nil)
+       (when (consp test)
+	 (dolist (bind (first test))
+	   (make-variable-buffer-local (first bind))
+	   (set (first bind) (second bind)))
+	 (setf test (second test)))
+       (insert test)
+       (goto-char 0)
+       (skip-chars-forward " \t\n")
+       ;; Mess up the indentation so we know reindentation works
+       (let ((mess nil))
+	 (save-excursion
+	   (while (not (eobp))
+	     (forward-line 1)
+	     (ignore-errors (delete-char 1) (setf mess t))))
+	 (if (not mess)
+	     (error "Couldn't mess up indentation?")))
+       (indent-sexp)
+       (if (equal (buffer-string) test)
+	   (incf ok)
+	   (error "Bad indentation.\nWanted: %s\nGot: %s"
+		  test
+		  (buffer-string)))))
+    ok))
+
+;; (run-lisp-indent-tests)
+
+(defun run-lisp-indent-tests ()
+  (test-lisp-indent
+   '("
+ (defun foo ()
+   t)"
+     (((lisp-lambda-list-keyword-parameter-alignment nil)
+       (lisp-lambda-list-keyword-alignment nil))
+      "
+ (defun foo (foo &optional opt1
+                   opt2
+             &rest rest)
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment t)
+       (lisp-lambda-list-keyword-alignment nil))
+      "
+ (defun foo (foo &optional opt1
+                           opt2
+             &rest rest)
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment nil)
+       (lisp-lambda-list-keyword-alignment t))
+      "
+ (defun foo (foo &optional opt1
+                   opt2
+                 &rest rest)
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment t)
+       (lisp-lambda-list-keyword-alignment t))
+      "
+ (defun foo (foo &optional opt1
+                           opt2
+                 &rest rest)
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment nil)
+       (lisp-lambda-list-keyword-alignment nil))
+      "
+ (defmacro foo ((foo &optional opt1
+                       opt2
+                 &rest rest))
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment t)
+       (lisp-lambda-list-keyword-alignment nil))
+      "
+ (defmacro foo ((foo &optional opt1
+                               opt2
+                 &rest rest))
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment nil)
+       (lisp-lambda-list-keyword-alignment t))
+      "
+ (defmacro foo ((foo &optional opt1
+                       opt2
+                     &rest rest))
+   (list foo opt1 opt2
+         rest))")
+     (((lisp-lambda-list-keyword-parameter-alignment t)
+       (lisp-lambda-list-keyword-alignment t))
+      "
+ (defmacro foo ((foo &optional opt1
+                               opt2
+                     &rest rest))
+   (list foo opt1 opt2
+         rest))")
+     "
+  (let ((x y)
+        (foo #-foo (no-foo)
+             #+foo (yes-foo))
+        (bar #-bar
+             (no-bar)
+             #+bar
+             (yes-bar)))
+    (list foo bar
+          x))"
+     "
+  (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))"
+     "
+  (defun foo (x)
+    (tagbody
+     foo
+       (bar)
+     baz
+       (when (losing)
+         (with-big-loser
+             (yow)
+           ((lambda ()
+              foo)
+            big)))
+       (flet ((foo (bar baz zap)
+                (zip))
+              (zot ()
+                quux))
+         (do ()
+             ((lose)
+              (foo 1))
+           (quux)
+          foo
+           (lose))
+         (cond ((x)
+                (win 1 2
+                     (foo)))
+               (t
+                (lose
+                 3))))))"
+     "
+  (if* (eq t nil)
+     then ()
+          ()
+   elseif (dsf)
+     thenret x
+     else (balbkj)
+          (sdf))")))
+
 
-;(defun foo (x)
-;  (tagbody
-;   foo
-;     (bar)
-;   baz
-;     (when (losing)
-;       (with-big-loser
-;           (yow)
-;         ((lambda ()
-;            foo)
-;          big)))
-;     (flet ((foo (bar baz zap)
-;              (zip))
-;            (zot ()
-;              quux))
-;       (do ()
-;           ((lose)
-;            (foo 1))
-;         (quux)
-;        foo
-;         (lose))
-;       (cond ((x)
-;              (win 1 2
-;                   (foo)))
-;             (t
-;              (lose
-;                3))))))
-
 
 ;(put 'while    'common-lisp-indent-function 1)
 ;(put 'defwrapper'common-lisp-indent-function ...)