1;;; cl-indent.el --- enhanced lisp-indent mode 2 3;; Copyright (C) 1987 Free Software Foundation, Inc. 4 5;; Author: Richard Mlynark <mly@eddie.mit.edu> 6;; Created: July 1987 7;; Maintainer: FSF 8;; Keywords: lisp, tools 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to 24;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 25 26;;; Commentary: 27 28;; This package supplies a single entry point, common-lisp-indent-function, 29;; which performs indentation in the preferred style for Common Lisp code. 30;; To enable it: 31;; 32;; (setq lisp-indent-function 'common-lisp-indent-function) 33 34;;>> TODO 35;; :foo 36;; bar 37;; :baz 38;; zap 39;; &key (like &body)?? 40 41;; &rest 1 in lambda-lists doesn't work 42;; -- really want (foo bar 43;; baz) 44;; not (foo bar 45;; baz) 46;; Need something better than &rest for such cases 47 48;;; Code: 49 50(defvar lisp-indent-maximum-backtracking 3 51 "*Maximum depth to backtrack out from a sublist for structured indentation. 52If this variable is 0, no backtracking will occur and forms such as flet 53may not be correctly indented.") 54 55(defvar lisp-tag-indentation 1 56 "*Indentation of tags relative to containing list. 57This variable is used by the function `lisp-indent-tagbody'.") 58 59(defvar lisp-tag-body-indentation 3 60 "*Indentation of non-tagged lines relative to containing list. 61This variable is used by the function `lisp-indent-tagbody' to indent normal 62lines (lines without tags). 63The indentation is relative to the indentation of the parenthesis enclosing 64the special form. If the value is t, the body of tags will be indented 65as a block at the same indentation as the first s-expression following 66the tag. In this case, any forms before the first tag are indented 67by `lisp-body-indent'.") 68 69 70;;;###autoload 71(defun common-lisp-indent-function (indent-point state) 72 (let ((normal-indent (current-column))) 73 ;; Walk up list levels until we see something 74 ;; which does special things with subforms. 75 (let ((depth 0) 76 ;; Path describes the position of point in terms of 77 ;; list-structure with respect to containing lists. 78 ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)' 79 (path ()) 80 ;; set non-nil when somebody works out the indentation to use 81 calculated 82 (last-point indent-point) 83 ;; the position of the open-paren of the innermost containing list 84 (containing-form-start (elt state 1)) 85 ;; the column of the above 86 sexp-column) 87 ;; Move to start of innermost containing list 88 (goto-char containing-form-start) 89 (setq sexp-column (current-column)) 90 ;; Look over successively less-deep containing forms 91 (while (and (not calculated) 92 (< depth lisp-indent-maximum-backtracking)) 93 (let ((containing-sexp (point))) 94 (forward-char 1) 95 (parse-partial-sexp (point) indent-point 1 t) 96 ;; Move to the car of the relevant containing form 97 (let (tem function method) 98 (if (not (looking-at "\\sw\\|\\s_")) 99 ;; This form doesn't seem to start with a symbol 100 (setq function nil method nil) 101 (setq tem (point)) 102 (forward-sexp 1) 103 (setq function (downcase (buffer-substring tem (point)))) 104 (goto-char tem) 105 (setq tem (intern-soft function) 106 method (get tem 'common-lisp-indent-function)) 107 (cond ((and (null method) 108 (string-match ":[^:]+" function)) 109 ;; The pleblisp package feature 110 (setq function (substring function 111 (1+ (match-beginning 0))) 112 method (get (intern-soft function) 113 'common-lisp-indent-function))) 114 ((and (null method)) 115 ;; backwards compatibility 116 (setq method (get tem 'lisp-indent-function))))) 117 (let ((n 0)) 118 ;; How far into the containing form is the current form? 119 (if (< (point) indent-point) 120 (while (condition-case () 121 (progn 122 (forward-sexp 1) 123 (if (>= (point) indent-point) 124 nil 125 (parse-partial-sexp (point) 126 indent-point 1 t) 127 (setq n (1+ n)) 128 t)) 129 (error nil)))) 130 (setq path (cons n path))) 131 132 ;; backwards compatibility. 133 (cond ((null function)) 134 ((null method) 135 (if (null (cdr path)) 136 ;; (package prefix was stripped off above) 137 (setq method (cond ((string-match "\\`def" 138 function) 139 '(4 (&whole 4 &rest 1) &body)) 140 ((string-match "\\`\\(with\\|do\\)-" 141 function) 142 '(4 &body)))))) 143 ;; backwards compatibility. Bletch. 144 ((eq method 'defun) 145 (setq method '(4 (&whole 4 &rest 1) &body)))) 146 147 (cond ((and (memq (char-after (1- containing-sexp)) '(?\' ?\`)) 148 (not (eql (char-after (- containing-sexp 2)) ?\#))) 149 ;; No indentation for "'(...)" elements 150 (setq calculated (1+ sexp-column))) 151 ((or (eql (char-after (1- containing-sexp)) ?\,) 152 (and (eql (char-after (1- containing-sexp)) ?\@) 153 (eql (char-after (- containing-sexp 2)) ?\,))) 154 ;; ",(...)" or ",@(...)" 155 (setq calculated normal-indent)) 156 ((eql (char-after (1- containing-sexp)) ?\#) 157 ;; "#(...)" 158 (setq calculated (1+ sexp-column))) 159 ((null method)) 160 ((integerp method) 161 ;; convenient top-level hack. 162 ;; (also compatible with lisp-indent-function) 163 ;; The number specifies how many `distinguished' 164 ;; forms there are before the body starts 165 ;; Equivalent to (4 4 ... &body) 166 (setq calculated (cond ((cdr path) 167 normal-indent) 168 ((<= (car path) method) 169 ;; `distinguished' form 170 (list (+ sexp-column 4) 171 containing-form-start)) 172 ((= (car path) (1+ method)) 173 ;; first body form. 174 (+ sexp-column lisp-body-indent)) 175 (t 176 ;; other body form 177 normal-indent)))) 178 ((symbolp method) 179 (setq calculated (funcall method 180 path state indent-point 181 sexp-column normal-indent))) 182 (t 183 (setq calculated (lisp-indent-259 184 method path state indent-point 185 sexp-column normal-indent))))) 186 (goto-char containing-sexp) 187 (setq last-point containing-sexp) 188 (if (not calculated) 189 (condition-case () 190 (progn (backward-up-list 1) 191 (setq depth (1+ depth))) 192 (error (setq depth lisp-indent-maximum-backtracking)))))) 193 calculated))) 194 195 196(defun lisp-indent-report-bad-format (m) 197 (error "%s has a badly-formed %s property: %s" 198 ;; Love those free variable references!! 199 function 'common-lisp-indent-function m)) 200 201;; Blame the crufty control structure on dynamic scoping 202;; -- not on me! 203(defun lisp-indent-259 (method path state indent-point 204 sexp-column normal-indent) 205 (catch 'exit 206 (let ((p path) 207 (containing-form-start (elt state 1)) 208 n tem tail) 209 ;; Isn't tail-recursion wonderful? 210 (while p 211 ;; This while loop is for destructuring. 212 ;; p is set to (cdr p) each iteration. 213 (if (not (consp method)) (lisp-indent-report-bad-format method)) 214 (setq n (1- (car p)) 215 p (cdr p) 216 tail nil) 217 (while n 218 ;; This while loop is for advancing along a method 219 ;; until the relevant (possibly &rest/&body) pattern 220 ;; is reached. 221 ;; n is set to (1- n) and method to (cdr method) 222 ;; each iteration. 223 (setq tem (car method)) 224 225 (or (eq tem 'nil) ;default indentation 226; (eq tem '&lambda) ;abbrev for (&whole 4 (&rest 1)) 227 (and (eq tem '&body) (null (cdr method))) 228 (and (eq tem '&rest) 229 (consp (cdr method)) (null (cdr (cdr method)))) 230 (integerp tem) ;explicit indentation specified 231 (and (consp tem) ;destructuring 232 (eq (car tem) '&whole) 233 (or (symbolp (car (cdr tem))) 234 (integerp (car (cdr tem))))) 235 (and (symbolp tem) ;a function to call to do the work. 236 (null (cdr method))) 237 (lisp-indent-report-bad-format method)) 238 239 (cond ((and tail (not (consp tem))) 240 ;; indent tail of &rest in same way as first elt of rest 241 (throw 'exit normal-indent)) 242 ((eq tem '&body) 243 ;; &body means (&rest <lisp-body-indent>) 244 (throw 'exit 245 (if (and (= n 0) ;first body form 246 (null p)) ;not in subforms 247 (+ sexp-column 248 lisp-body-indent) 249 normal-indent))) 250 ((eq tem '&rest) 251 ;; this pattern holds for all remaining forms 252 (setq tail (> n 0) 253 n 0 254 method (cdr method))) 255 ((> n 0) 256 ;; try next element of pattern 257 (setq n (1- n) 258 method (cdr method)) 259 (if (< n 0) 260 ;; Too few elements in pattern. 261 (throw 'exit normal-indent))) 262 ((eq tem 'nil) 263 (throw 'exit (list normal-indent containing-form-start))) 264; ((eq tem '&lambda) 265; ;; abbrev for (&whole 4 &rest 1) 266; (throw 'exit 267; (cond ((null p) 268; (list (+ sexp-column 4) containing-form-start)) 269; ((null (cdr p)) 270; (+ sexp-column 1)) 271; (t normal-indent)))) 272 ((integerp tem) 273 (throw 'exit 274 (if (null p) ;not in subforms 275 (list (+ sexp-column tem) containing-form-start) 276 normal-indent))) 277 ((symbolp tem) ;a function to call 278 (throw 'exit 279 (funcall tem path state indent-point 280 sexp-column normal-indent))) 281 (t 282 ;; must be a destructing frob 283 (if (not (null p)) 284 ;; descend 285 (setq method (cdr (cdr tem)) 286 n nil) 287 (setq tem (car (cdr tem))) 288 (throw 'exit 289 (cond (tail 290 normal-indent) 291 ((eq tem 'nil) 292 (list normal-indent 293 containing-form-start)) 294 ((integerp tem) 295 (list (+ sexp-column tem) 296 containing-form-start)) 297 (t 298 (funcall tem path state indent-point 299 sexp-column normal-indent)))))))))))) 300 301(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent) 302 (if (not (null (cdr path))) 303 normal-indent 304 (save-excursion 305 (goto-char indent-point) 306 (beginning-of-line) 307 (skip-chars-forward " \t") 308 (list (cond ((looking-at "\\sw\\|\\s_") 309 ;; a tagbody tag 310 (+ sexp-column lisp-tag-indentation)) 311 ((integerp lisp-tag-body-indentation) 312 (+ sexp-column lisp-tag-body-indentation)) 313 ((eq lisp-tag-body-indentation 't) 314 (condition-case () 315 (progn (backward-sexp 1) (current-column)) 316 (error (1+ sexp-column)))) 317 (t (+ sexp-column lisp-body-indent))) 318; (cond ((integerp lisp-tag-body-indentation) 319; (+ sexp-column lisp-tag-body-indentation)) 320; ((eq lisp-tag-body-indentation 't) 321; normal-indent) 322; (t 323; (+ sexp-column lisp-body-indent))) 324 (elt state 1) 325 )))) 326 327(defun lisp-indent-do (path state indent-point sexp-column normal-indent) 328 (if (>= (car path) 3) 329 (let ((lisp-tag-body-indentation lisp-body-indent)) 330 (funcall (function lisp-indent-tagbody) 331 path state indent-point sexp-column normal-indent)) 332 (funcall (function lisp-indent-259) 333 '((&whole nil &rest 334 ;; the following causes weird indentation 335 ;;(&whole 1 1 2 nil) 336 ) 337 (&whole nil &rest 1)) 338 path state indent-point sexp-column normal-indent))) 339 340(defun lisp-indent-function-lambda-hack (path state indent-point 341 sexp-column normal-indent) 342 ;; indent (function (lambda () <newline> <body-forms>)) kludgily. 343 (if (or (cdr path) ; wtf? 344 (> (car path) 3)) 345 ;; line up under previous body form 346 normal-indent 347 ;; line up under function rather than under lambda in order to 348 ;; conserve horizontal space. (Which is what #' is for.) 349 (condition-case () 350 (save-excursion 351 (backward-up-list 2) 352 (forward-char 1) 353 (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)") 354 (+ lisp-body-indent -1 (current-column)) 355 (+ sexp-column lisp-body-indent))) 356 (error (+ sexp-column lisp-body-indent))))) 357 358 359(let ((l '((block 1) 360 (catch 1) 361 (case (4 &rest (&whole 2 &rest 1))) 362 (ccase . case) (ecase . case) 363 (typecase . case) (etypecase . case) (ctypecase . case) 364 (catch 1) 365 (cond (&rest (&whole 2 &rest 1))) 366 (block 1) 367 (defvar (4 2 2)) 368 (defconstant . defvar) (defparameter . defvar) 369 (define-modify-macro 370 (4 &body)) 371 (define-setf-method 372 (4 (&whole 4 &rest 1) &body)) 373 (defsetf (4 (&whole 4 &rest 1) 4 &body)) 374 (defun (4 (&whole 4 &rest 1) &body)) 375 (defmacro . defun) (deftype . defun) 376 (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) 377 &rest (&whole 2 &rest 1))) 378 (destructuring-bind 379 ((&whole 6 &rest 1) 4 &body)) 380 (do lisp-indent-do) 381 (do* . do) 382 (dolist ((&whole 4 2 1) &body)) 383 (dotimes . dolist) 384 (eval-when 1) 385 (flet ((&whole 4 &rest (&whole 1 (&whole 4 &rest 1) &body)) 386 &body)) 387 (labels . flet) 388 (macrolet . flet) 389 ;; `else-body' style 390 (if (nil nil &body)) 391 ;; single-else style (then and else equally indented) 392 (if (&rest nil)) 393 ;(lambda ((&whole 4 &rest 1) &body)) 394 (lambda ((&whole 4 &rest 1) 395 &rest lisp-indent-function-lambda-hack)) 396 (let ((&whole 4 &rest (&whole 1 1 2)) &body)) 397 (let* . let) 398 (compiler-let . let) ;barf 399 (locally 1) 400 ;(loop ...) 401 (multiple-value-bind 402 ((&whole 6 &rest 1) 4 &body)) 403 (multiple-value-call 404 (4 &body)) 405 (multiple-value-list 1) 406 (multiple-value-prog1 1) 407 (multiple-value-setq 408 (4 2)) 409 ;; Combines the worst features of BLOCK, LET and TAGBODY 410 (prog ((&whole 4 &rest 1) &rest lisp-indent-tagbody)) 411 (prog* . prog) 412 (prog1 1) 413 (prog2 2) 414 (progn 0) 415 (progv (4 4 &body)) 416 (return 0) 417 (return-from (nil &body)) 418 (tagbody lisp-indent-tagbody) 419 (throw 1) 420 (unless 1) 421 (unwind-protect 422 (5 &body)) 423 (when 1)))) 424 (while l 425 (put (car (car l)) 'common-lisp-indent-function 426 (if (symbolp (cdr (car l))) 427 (get (cdr (car l)) 'common-lisp-indent-function) 428 (car (cdr (car l))))) 429 (setq l (cdr l)))) 430 431 432;(defun foo (x) 433; (tagbody 434; foo 435; (bar) 436; baz 437; (when (losing) 438; (with-big-loser 439; (yow) 440; ((lambda () 441; foo) 442; big))) 443; (flet ((foo (bar baz zap) 444; (zip)) 445; (zot () 446; quux)) 447; (do () 448; ((lose) 449; (foo 1)) 450; (quux) 451; foo 452; (lose)) 453; (cond ((x) 454; (win 1 2 455; (foo))) 456; (t 457; (lose 458; 3)))))) 459 460 461;(put 'while 'common-lisp-indent-function 1) 462;(put 'defwrapper'common-lisp-indent-function ...) 463;(put 'def 'common-lisp-indent-function ...) 464;(put 'defflavor 'common-lisp-indent-function ...) 465;(put 'defsubst 'common-lisp-indent-function ...) 466 467;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) 468;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1))))) 469;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((* 1))) (3 4 ((* 1))) (4 &body))) 470;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) 471;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body))))) 472 473;;; cl-indent.el ends here 474