[COMMIT] Support for IF* and a test suite

NOTE: This patch has been committed. xemacs-packages/prog-modes/ChangeLog addition: 2011-05-15 Didier Verna <didier(a)xemacs.org&gt; 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. XEmacs Packages source patch: Diff command: cvs -q diff -u Files affected: xemacs-packages/prog-modes/cl-indent.el Index: xemacs-packages/prog-modes/cl-indent.el =================================================================== RCS file: /cvsroot/xemacs/XEmacs/packages/xemacs-packages/prog-modes/cl-indent.el,v retrieving revision 1.11 diff -u -u -r1.11 cl-indent.el --- xemacs-packages/prog-modes/cl-indent.el 15 May 2011 11:53:52 -0000 1.11 +++ xemacs-packages/prog-modes/cl-indent.el 15 May 2011 12:39:09 -0000 ＠＠ -28,7 +28,7 ＠＠ ;;; 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: ＠＠ -136,6 +136,46 ＠＠ 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. ＠＠ -661,46 +701,6 ＠＠ (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 ... ＠＠ -871,33 +871,85 ＠＠ 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. ＠＠ -948,6 +1000,7 ＠＠ (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) ＠＠ -990,35 +1043,182 ＠＠ (get (cdr el) 'common-lisp-indent-function) (car (cdr el)))))) - -;(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)))))) +(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))"))) + ;(put 'while 'common-lisp-indent-function 1) ;(put 'defwrapper'common-lisp-indent-function ...) -- Scientific site: http://www.lrde.epita.fr/~didier Music (Jazz) site: http://www.didierverna.com _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://lists.xemacs.org/mailman/listinfo/xemacs-patches