X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/9750e079ddb0df24810a8a19a3210616d3f71db9..b1b2ae81628a5edce8492e5e1004de8f2a15830d:/lisp/emacs-lisp/cl-indent.el diff --git a/lisp/emacs-lisp/cl-indent.el b/lisp/emacs-lisp/cl-indent.el index 537b16e691..2e6265d4df 100644 --- a/lisp/emacs-lisp/cl-indent.el +++ b/lisp/emacs-lisp/cl-indent.el @@ -1,12 +1,12 @@ ;;; cl-indent.el --- enhanced lisp-indent mode -;; Copyright (C) 1987 Free Software Foundation, Inc. -;; Written by Richard Mlynarik July 1987 -;; Author: Richard Mlynark +;; Copyright (C) 1987, 2000, 2001, 2002 Free Software Foundation, Inc. + +;; Author: Richard Mlynarik +;; Created: July 1987 ;; Maintainer: FSF ;; Keywords: lisp, tools - ;; This file is part of GNU Emacs. ;; GNU Emacs is free software; you can redistribute it and/or modify @@ -20,11 +20,18 @@ ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to -;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, +;; Boston, MA 02111-1307, USA. ;;; Commentary: +;; This package supplies a single entry point, common-lisp-indent-function, +;; which performs indentation in the preferred style for Common Lisp code. +;; To enable it: +;; +;; (setq lisp-indent-function 'common-lisp-indent-function) + ;;>> TODO ;; :foo ;; bar @@ -41,18 +48,25 @@ ;;; Code: -;;; Hairy lisp indentation. +(defgroup lisp-indent nil + "Indentation in Lisp" + :group 'lisp) + -(defvar lisp-indent-maximum-backtracking 3 +(defcustom lisp-indent-maximum-backtracking 3 "*Maximum depth to backtrack out from a sublist for structured indentation. If this variable is 0, no backtracking will occur and forms such as flet -may not be correctly indented.") +may not be correctly indented." + :type 'integer + :group 'lisp-indent) -(defvar lisp-tag-indentation 1 +(defcustom lisp-tag-indentation 1 "*Indentation of tags relative to containing list. -This variable is used by the function `lisp-indent-tagbody'.") +This variable is used by the function `lisp-indent-tagbody'." + :type 'integer + :group 'lisp-indent) -(defvar lisp-tag-body-indentation 3 +(defcustom lisp-tag-body-indentation 3 "*Indentation of non-tagged lines relative to containing list. This variable is used by the function `lisp-indent-tagbody' to indent normal lines (lines without tags). @@ -60,22 +74,89 @@ The indentation is relative to the indentation of the parenthesis enclosing the special form. If the value is t, the body of tags will be indented as a block at the same indentation as the first s-expression following the tag. In this case, any forms before the first tag are indented -by `lisp-body-indent'.") +by `lisp-body-indent'." + :type 'integer + :group 'lisp-indent) + +(defcustom lisp-backquote-indentation t + "*Whether or not to indent backquoted lists as code. +If nil, indent backquoted lists as data, i.e., like quoted lists." + :type 'boolean + :group 'lisp-indent) + + +(defcustom lisp-loop-keyword-indentation 3 + "*Indentation of loop keywords in extended loop forms." + :type 'integer + :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 + "*Indentation of forms in simple loop forms." + :type 'integer + :group 'lisp-indent) +(defvar lisp-indent-error-function) +(defvar lisp-indent-defun-method '(4 &lambda &body)) + + +(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) + (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))) + + +(defun common-lisp-indent-function-1 (indent-point state) (let ((normal-indent (current-column))) ;; Walk up list levels until we see something ;; which does special things with subforms. (let ((depth 0) ;; Path describes the position of point in terms of - ;; list-structure with respect to contining lists. + ;; list-structure with respect to containing lists. ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)' (path ()) ;; set non-nil when somebody works out the indentation to use calculated - (last-point indent-point) + ;; If non-nil, this is an indentation to use + ;; if nothing else specifies it more firmly. + tentative-calculated + (last-point indent-point) ;; the position of the open-paren of the innermost containing list (containing-form-start (elt state 1)) ;; the column of the above @@ -83,6 +164,7 @@ by `lisp-body-indent'.") ;; Move to start of innermost containing list (goto-char containing-form-start) (setq sexp-column (current-column)) + ;; Look over successively less-deep containing forms (while (and (not calculated) (< depth lisp-indent-maximum-backtracking)) @@ -90,13 +172,14 @@ by `lisp-body-indent'.") (forward-char 1) (parse-partial-sexp (point) indent-point 1 t) ;; Move to the car of the relevant containing form - (let (tem function method) + (let (tem function method tentative-defun) (if (not (looking-at "\\sw\\|\\s_")) ;; This form doesn't seem to start with a symbol (setq function nil method nil) (setq tem (point)) (forward-sexp 1) - (setq function (downcase (buffer-substring tem (point)))) + (setq function (downcase (buffer-substring-no-properties + tem (point)))) (goto-char tem) (setq tem (intern-soft function) method (get tem 'common-lisp-indent-function)) @@ -128,31 +211,52 @@ by `lisp-body-indent'.") ;; backwards compatibility. (cond ((null function)) ((null method) - (if (null (cdr path)) - ;; (package prefix was stripped off above) - (setq method (cond ((string-match "\\`def" - function) - '(4 (&whole 4 &rest 1) &body)) - ((string-match "\\`\\(with\\|do\\)-" - function) - '(4 &body)))))) + (when (null (cdr path)) + ;; (package prefix was stripped off above) + (cond ((string-match "\\`def" + function) + (setq tentative-defun t)) + ((string-match "\\`\\(with\\|do\\)-" + function) + (setq method '(&lambda &body)))))) ;; backwards compatibility. Bletch. ((eq method 'defun) - (setq method '(4 (&whole 4 &rest 1) &body)))) + (setq method lisp-indent-defun-method))) - (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`)) - (not (eql (char-after (- containing-sexp 2)) ?\#))) + (cond ((and (or (eq (char-after (1- containing-sexp)) ?\') + (and (not lisp-backquote-indentation) + (eq (char-after (1- containing-sexp)) ?\`))) + (not (eq (char-after (- containing-sexp 2)) ?\#))) ;; No indentation for "'(...)" elements (setq calculated (1+ sexp-column))) - ((or (eql (char-after (1- containing-sexp)) ?\,) - (and (eql (char-after (1- containing-sexp)) ?\@) - (eql (char-after (- containing-sexp 2)) ?\,))) - ;; ",(...)" or ",@(...)" - (setq calculated normal-indent)) - ((eql (char-after (1- containing-sexp)) ?\#) + ((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))) - ((null method)) + ((null method) + ;; If this looks like a call to a `def...' form, + ;; think about indenting it as one, but do it + ;; tentatively for cases like + ;; (flet ((defunp () + ;; nil))) + ;; Set both normal-indent and tentative-calculated. + ;; The latter ensures this value gets used + ;; if there are no relevant containing constructs. + ;; The former ensures this value gets used + ;; if there is a relevant containing construct + ;; but we are nested within the structure levels + ;; that it specifies indentation for. + (if tentative-defun + (setq tentative-calculated + (common-lisp-indent-call-method + function lisp-indent-defun-method + path state indent-point + sexp-column normal-indent) + normal-indent tentative-calculated))) ((integerp method) ;; convenient top-level hack. ;; (also compatible with lisp-indent-function) @@ -171,28 +275,35 @@ by `lisp-body-indent'.") (t ;; other body form normal-indent)))) - ((symbolp method) - (setq calculated (funcall method - path state indent-point - sexp-column normal-indent))) - (t - (setq calculated (lisp-indent-259 - method path state indent-point - sexp-column normal-indent))))) + (t + (setq calculated + (common-lisp-indent-call-method + function method path state indent-point + sexp-column normal-indent))))) (goto-char containing-sexp) (setq last-point containing-sexp) - (if (not calculated) - (condition-case () - (progn (backward-up-list 1) - (setq depth (1+ depth))) - (error (setq depth lisp-indent-maximum-backtracking)))))) - calculated))) + (unless calculated + (condition-case () + (progn (backward-up-list 1) + (setq depth (1+ depth))) + (error (setq depth lisp-indent-maximum-backtracking)))))) + (or calculated tentative-calculated)))) + +(defun common-lisp-indent-call-method (function method path state indent-point + sexp-column normal-indent) + (let ((lisp-indent-error-function function)) + (if (symbolp method) + (funcall method + path state indent-point + sexp-column normal-indent) + (lisp-indent-259 method path state indent-point + sexp-column normal-indent)))) (defun lisp-indent-report-bad-format (m) (error "%s has a badly-formed %s property: %s" ;; Love those free variable references!! - function 'common-lisp-indent-function m)) + lisp-indent-error-function 'common-lisp-indent-function m)) ;; Blame the crufty control structure on dynamic scoping ;; -- not on me! @@ -219,15 +330,16 @@ by `lisp-body-indent'.") (setq tem (car method)) (or (eq tem 'nil) ;default indentation -; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1)) + (eq tem '&lambda) ;lambda list (and (eq tem '&body) (null (cdr method))) (and (eq tem '&rest) - (consp (cdr method)) (null (cdr (cdr method)))) + (consp (cdr method)) + (null (cddr method))) (integerp tem) ;explicit indentation specified (and (consp tem) ;destructuring (eq (car tem) '&whole) - (or (symbolp (car (cdr tem))) - (integerp (car (cdr tem))))) + (or (symbolp (cadr tem)) + (integerp (cadr tem)))) (and (symbolp tem) ;a function to call to do the work. (null (cdr method))) (lisp-indent-report-bad-format method)) @@ -257,14 +369,13 @@ by `lisp-body-indent'.") (throw 'exit normal-indent))) ((eq tem 'nil) (throw 'exit (list normal-indent containing-form-start))) -; ((eq tem '&lambda) -; ;; abbrev for (&whole 4 &rest 1) -; (throw 'exit -; (cond ((null p) -; (list (+ sexp-column 4) containing-form-start)) -; ((null (cdr p)) -; (+ sexp-column 1)) -; (t normal-indent)))) + ((eq tem '&lambda) + (throw 'exit + (cond ((null p) + (list (+ sexp-column 4) containing-form-start)) + ((null (cdr p)) + (+ sexp-column 1)) + (t normal-indent)))) ((integerp tem) (throw 'exit (if (null p) ;not in subforms @@ -278,9 +389,9 @@ by `lisp-body-indent'.") ;; must be a destructing frob (if (not (null p)) ;; descend - (setq method (cdr (cdr tem)) + (setq method (cddr tem) n nil) - (setq tem (car (cdr tem))) + (setq tem (cadr tem)) (throw 'exit (cond (tail normal-indent) @@ -324,14 +435,30 @@ by `lisp-body-indent'.") (if (>= (car path) 3) (let ((lisp-tag-body-indentation lisp-body-indent)) (funcall (function lisp-indent-tagbody) - path state indent-point sexp-column normal-indent)) + path state indent-point sexp-column normal-indent)) (funcall (function lisp-indent-259) - '((&whole nil &rest - ;; the following causes wierd indentation - ;;(&whole 1 1 2 nil) - ) - (&whole nil &rest 1)) - path state indent-point sexp-column normal-indent))) + '((&whole nil &rest + ;; the following causes weird indentation + ;;(&whole 1 1 2 nil) + ) + (&whole nil &rest 1)) + path state indent-point sexp-column normal-indent))) + + +(defun lisp-indent-defmethod (path state indent-point sexp-column + normal-indent) + "Indentation function defmethod." + (lisp-indent-259 (if (and (>= (car path) 3) + (null (cdr path)) + (save-excursion (goto-char (elt state 1)) + (forward-char 1) + (forward-sexp 3) + (backward-sexp) + (looking-at ":"))) + '(4 4 (&whole 4 &rest 4) &body) + (get 'defun 'common-lisp-indent-function)) + path state indent-point sexp-column normal-indent)) + (defun lisp-indent-function-lambda-hack (path state indent-point sexp-column normal-indent) @@ -351,24 +478,29 @@ by `lisp-body-indent'.") (+ sexp-column lisp-body-indent))) (error (+ sexp-column lisp-body-indent))))) + (let ((l '((block 1) - (catch 1) (case (4 &rest (&whole 2 &rest 1))) (ccase . case) (ecase . case) (typecase . case) (etypecase . case) (ctypecase . case) (catch 1) (cond (&rest (&whole 2 &rest 1))) - (block 1) (defvar (4 2 2)) - (defconstant . defvar) (defparameter . defvar) - (define-modify-macro - (4 &body)) - (define-setf-method - (4 (&whole 4 &rest 1) &body)) - (defsetf (4 (&whole 4 &rest 1) 4 &body)) - (defun (4 (&whole 4 &rest 1) &body)) - (defmacro . defun) (deftype . defun) + (defclass (6 4 (&whole 2 &rest 1) (&whole 2 &rest 1))) + (defconstant . defvar) + (defcustom (4 2 2 2)) + (defparameter . defvar) + (defconst . defcustom) + (define-condition . defclass) + (define-modify-macro (4 &lambda &body)) + (defsetf (4 &lambda 4 &body)) + (defun (4 &lambda &body)) + (define-setf-method . defun) + (define-setf-expander . defun) + (defmacro . defun) (defsubst . defun) (deftype . defun) + (defmethod lisp-indent-defmethod) + (defpackage (4 2)) (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) &rest (&whole 2 &rest 1))) (destructuring-bind @@ -377,33 +509,34 @@ by `lisp-body-indent'.") (do* . do) (dolist ((&whole 4 2 1) &body)) (dotimes . dolist) - (eval-when 1) - (flet ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body)) - &body)) + (eval-when 1) + (flet ((&whole 4 &rest (&whole 1 &lambda &body)) &body)) (labels . flet) (macrolet . flet) + (generic-flet . flet) (generic-labels . flet) + (handler-case (4 &rest (&whole 2 &lambda &body))) + (restart-case . handler-case) ;; `else-body' style (if (nil nil &body)) ;; single-else style (then and else equally indented) (if (&rest nil)) - ;(lambda ((&whole 4 &rest 1) &body)) - (lambda ((&whole 4 &rest 1) - &rest lisp-indent-function-lambda-hack)) + (lambda (&lambda &rest lisp-indent-function-lambda-hack)) (let ((&whole 4 &rest (&whole 1 1 2)) &body)) (let* . let) (compiler-let . let) ;barf - (locally 1) - ;(loop ...) - (multiple-value-bind - ((&whole 6 &rest 1) 4 &body)) - (multiple-value-call - (4 &body)) - (multiple-value-list 1) + (handler-bind . let) (restart-bind . let) + (locally 1) + ;(loop lisp-indent-loop) + (:method (&lambda &body)) ; in `defgeneric' + (multiple-value-bind ((&whole 6 &rest 1) 4 &body)) + (multiple-value-call (4 &body)) (multiple-value-prog1 1) - (multiple-value-setq - (4 2)) + (multiple-value-setq (4 2)) + (multiple-value-setf . multiple-value-setq) + (pprint-logical-block (4 2)) + (print-unreadable-object ((&whole 4 1 &rest 1) &body)) ;; Combines the worst features of BLOCK, LET and TAGBODY - (prog ((&whole 4 &rest 1) &rest lisp-indent-tagbody)) + (prog (&lambda &rest lisp-indent-tagbody)) (prog* . prog) (prog1 1) (prog2 2) @@ -411,18 +544,22 @@ by `lisp-body-indent'.") (progv (4 4 &body)) (return 0) (return-from (nil &body)) + (symbol-macrolet . let) (tagbody lisp-indent-tagbody) (throw 1) (unless 1) - (unwind-protect - (5 &body)) - (when 1)))) - (while l - (put (car (car l)) 'common-lisp-indent-function - (if (symbolp (cdr (car l))) - (get (cdr (car l)) 'common-lisp-indent-function) - (car (cdr (car l))))) - (setq l (cdr l)))) + (unwind-protect (5 &body)) + (when 1) + (with-accessors . multiple-value-bind) + (with-condition-restarts . multiple-value-bind) + (with-output-to-string (4 2)) + (with-slots . multiple-value-bind) + (with-standard-io-syntax (2))))) + (dolist (el l) + (put (car el) 'common-lisp-indent-function + (if (symbolp (cdr el)) + (get (cdr el) 'common-lisp-indent-function) + (car (cdr el)))))) ;(defun foo (x) @@ -452,7 +589,7 @@ by `lisp-body-indent'.") ; (t ; (lose ; 3)))))) - + ;(put 'while 'common-lisp-indent-function 1) ;(put 'defwrapper'common-lisp-indent-function ...) @@ -462,14 +599,11 @@ by `lisp-body-indent'.") ;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) ;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1))))) -;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body))) +;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((&whole 1))) (3 4 ((&whole 1))) (4 &body))) ;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) ;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body))))) +;(put 'defclass 'common-lisp-indent-function '((&whole 2 &rest (&whole 2 &rest 1) &rest (&whole 2 &rest 1))) +;(put 'defgeneric 'common-lisp-indent-function 'defun) - -;;;; Turn it on. -;(setq lisp-indent-function 'common-lisp-indent-function) - -;; To disable this stuff, (setq lisp-indent-function 'lisp-indent-function) - +;;; arch-tag: 7914d50f-92ec-4476-93fc-0f043a380e03 ;;; cl-indent.el ends here