-;; Lisp mode, and its idiosyncratic commands.
-;; Copyright (C) 1987 Free Software Foundation, Inc.
-;; Written by Richard Mlynarik July 1987
+;;; cl-indent.el --- enhanced lisp-indent mode
+
+;; Copyright (C) 1987, 2000, 2001, 2002, 2003, 2004,
+;; 2005, 2006 Free Software Foundation, Inc.
+
+;; Author: Richard Mlynarik <mly@eddie.mit.edu>
+;; 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
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 1, or (at your option)
+;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; 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., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, 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
;; baz)
;; Need something better than &rest for such cases
+;;; 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.")
+If this variable is 0, no backtracking will occur and forms such as `flet'
+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).
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)
\f
+(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
;; 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))
(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))
;; 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
+ (eval-when-compile
+ (concat "\\`\\("
+ (regexp-opt '("with" "without" "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)
(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!
(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))
(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
;; 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)
(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 ":\\|\\sw+")))
+ '(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)
(+ sexp-column lisp-body-indent)))
(error (+ sexp-column lisp-body-indent)))))
+
\f
(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
(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)
(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))))))
\f
;(defun foo (x)
; (t
; (lose
; 3))))))
-
+
;(put 'while 'common-lisp-indent-function 1)
;(put 'defwrapper'common-lisp-indent-function ...)
;(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)
-\f
-;;;; 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