(defgroup lisp-indent nil
"Indentation in Lisp."
:group 'lisp)
(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."
:type 'integer
:group 'lisp-indent)
(defcustom lisp-tag-indentation 1
"*Indentation of tags relative to containing list.
This variable is used by the function `lisp-indent-tagbody'."
:type 'integer
:group 'lisp-indent)
(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 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'."
: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)))))
(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)))
(let ((depth 0)
(path ())
calculated
tentative-calculated
(last-point indent-point)
(containing-form-start (elt state 1))
sexp-column)
(goto-char containing-form-start)
(setq sexp-column (current-column))
(while (and (not calculated)
(< depth lisp-indent-maximum-backtracking))
(let ((containing-sexp (point)))
(forward-char 1)
(parse-partial-sexp (point) indent-point 1 t)
(let (tem function method tentative-defun)
(if (not (looking-at "\\sw\\|\\s_"))
(setq function nil method nil)
(setq tem (point))
(forward-sexp 1)
(setq function (downcase (buffer-substring-no-properties
tem (point))))
(goto-char tem)
(setq tem (intern-soft function)
method (get tem 'common-lisp-indent-function))
(cond ((and (null method)
(string-match ":[^:]+" function))
(setq function (substring function
(1+ (match-beginning 0)))
method (get (intern-soft function)
'common-lisp-indent-function)))
((and (null method))
(setq method (get tem 'lisp-indent-function)))))
(let ((n 0))
(if (< (point) indent-point)
(while (condition-case ()
(progn
(forward-sexp 1)
(if (>= (point) indent-point)
nil
(parse-partial-sexp (point)
indent-point 1 t)
(setq n (1+ n))
t))
(error nil))))
(setq path (cons n path)))
(cond ((null function))
((null method)
(when (null (cdr path))
(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))))))
((eq method 'defun)
(setq method lisp-indent-defun-method)))
(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)) ?\#)))
(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)) ?\,)))
(setq calculated normal-indent))
((eq (char-after (1- containing-sexp)) ?\#)
(setq calculated (1+ sexp-column)))
((null method)
(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)
(setq calculated (cond ((cdr path)
normal-indent)
((<= (car path) method)
(list (+ sexp-column 4)
containing-form-start))
((= (car path) (1+ method))
(+ sexp-column lisp-body-indent))
(t
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)
(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"
lisp-indent-error-function 'common-lisp-indent-function m))
(defun lisp-indent-259 (method path state indent-point
sexp-column normal-indent)
(catch 'exit
(let ((p path)
(containing-form-start (elt state 1))
n tem tail)
(while p
(if (not (consp method)) (lisp-indent-report-bad-format method))
(setq n (1- (car p))
p (cdr p)
tail nil)
(while n
(setq tem (car method))
(or (eq tem 'nil) (eq tem '&lambda) (and (eq tem '&body) (null (cdr method)))
(and (eq tem '&rest)
(consp (cdr method))
(null (cddr method)))
(integerp tem) (and (consp tem) (eq (car tem) '&whole)
(or (symbolp (cadr tem))
(integerp (cadr tem))))
(and (symbolp tem) (null (cdr method)))
(lisp-indent-report-bad-format method))
(cond ((and tail (not (consp tem)))
(throw 'exit normal-indent))
((eq tem '&body)
(throw 'exit
(if (and (= n 0) (null p)) (+ sexp-column
lisp-body-indent)
normal-indent)))
((eq tem '&rest)
(setq tail (> n 0)
n 0
method (cdr method)))
((> n 0)
(setq n (1- n)
method (cdr method))
(if (< n 0)
(throw 'exit normal-indent)))
((eq tem 'nil)
(throw 'exit (if (consp normal-indent)
normal-indent
(list normal-indent containing-form-start))))
((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) (list (+ sexp-column tem) containing-form-start)
normal-indent)))
((symbolp tem) (throw 'exit
(funcall tem path state indent-point
sexp-column normal-indent)))
(t
(if (not (null p))
(setq method (cddr tem)
n nil)
(setq tem (cadr tem))
(throw 'exit
(cond (tail
normal-indent)
((eq tem 'nil)
(list normal-indent
containing-form-start))
((integerp tem)
(list (+ sexp-column tem)
containing-form-start))
(t
(funcall tem path state indent-point
sexp-column normal-indent))))))))))))
(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent)
(if (not (null (cdr path)))
normal-indent
(save-excursion
(goto-char indent-point)
(beginning-of-line)
(skip-chars-forward " \t")
(list (cond ((looking-at "\\sw\\|\\s_")
(+ sexp-column lisp-tag-indentation))
((integerp lisp-tag-body-indentation)
(+ sexp-column lisp-tag-body-indentation))
((eq lisp-tag-body-indentation 't)
(condition-case ()
(progn (backward-sexp 1) (current-column))
(error (1+ sexp-column))))
(t (+ sexp-column lisp-body-indent)))
(elt state 1)
))))
(defun lisp-indent-do (path state indent-point sexp-column 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))
(funcall (function lisp-indent-259)
'((&whole nil &rest
)
(&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)
(if (or (cdr path) (> (car path) 3))
normal-indent
(condition-case ()
(save-excursion
(backward-up-list 2)
(forward-char 1)
(if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)")
(+ lisp-body-indent -1 (current-column))
(+ sexp-column lisp-body-indent)))
(error (+ sexp-column lisp-body-indent)))))
(let ((l '((block 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)))
(defvar (4 2 2))
(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
((&whole 6 &rest 1) 4 &body))
(do lisp-indent-do)
(do* . do)
(dolist ((&whole 4 2 1) &body))
(dotimes . dolist)
(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)
(if (nil nil &body))
(if (&rest nil))
(lambda (&lambda &rest lisp-indent-function-lambda-hack))
(let ((&whole 4 &rest (&whole 1 1 2)) &body))
(let* . let)
(compiler-let . let) (handler-bind . let) (restart-bind . let)
(locally 1)
(:method (&lambda &body)) (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-setf . multiple-value-setq)
(pprint-logical-block (4 2))
(print-unreadable-object ((&whole 4 1 &rest 1) &body))
(prog (&lambda &rest lisp-indent-tagbody))
(prog* . prog)
(prog1 1)
(prog2 2)
(progn 0)
(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)
(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))))))