1;;; cl-indent.el --- enhanced lisp-indent mode 2 3;; Copyright (C) 1987, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Richard Mlynarik <mly@eddie.mit.edu> 7;; Created: July 1987 8;; Maintainer: FSF 9;; Keywords: lisp, tools 10 11;; This file is part of GNU Emacs. 12 13;; GNU Emacs is free software; you can redistribute it and/or modify 14;; it under the terms of the GNU General Public License as published by 15;; the Free Software Foundation; either version 2, or (at your option) 16;; any later version. 17 18;; GNU Emacs is distributed in the hope that it will be useful, 19;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21;; GNU General Public License for more details. 22 23;; You should have received a copy of the GNU General Public License 24;; along with GNU Emacs; see the file COPYING. If not, write to the 25;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 26;; Boston, MA 02110-1301, USA. 27 28;;; Commentary: 29 30;; This package supplies a single entry point, common-lisp-indent-function, 31;; which performs indentation in the preferred style for Common Lisp code. 32;; To enable it: 33;; 34;; (setq lisp-indent-function 'common-lisp-indent-function) 35 36;;>> TODO 37;; :foo 38;; bar 39;; :baz 40;; zap 41;; &key (like &body)?? 42 43;; &rest 1 in lambda-lists doesn't work 44;; -- really want (foo bar 45;; baz) 46;; not (foo bar 47;; baz) 48;; Need something better than &rest for such cases 49 50;;; Code: 51 52(defgroup lisp-indent nil 53 "Indentation in Lisp." 54 :group 'lisp) 55 56 57(defcustom lisp-indent-maximum-backtracking 3 58 "*Maximum depth to backtrack out from a sublist for structured indentation. 59If this variable is 0, no backtracking will occur and forms such as `flet' 60may not be correctly indented." 61 :type 'integer 62 :group 'lisp-indent) 63 64(defcustom lisp-tag-indentation 1 65 "*Indentation of tags relative to containing list. 66This variable is used by the function `lisp-indent-tagbody'." 67 :type 'integer 68 :group 'lisp-indent) 69 70(defcustom lisp-tag-body-indentation 3 71 "*Indentation of non-tagged lines relative to containing list. 72This variable is used by the function `lisp-indent-tagbody' to indent normal 73lines (lines without tags). 74The indentation is relative to the indentation of the parenthesis enclosing 75the special form. If the value is t, the body of tags will be indented 76as a block at the same indentation as the first s-expression following 77the tag. In this case, any forms before the first tag are indented 78by `lisp-body-indent'." 79 :type 'integer 80 :group 'lisp-indent) 81 82(defcustom lisp-backquote-indentation t 83 "*Whether or not to indent backquoted lists as code. 84If nil, indent backquoted lists as data, i.e., like quoted lists." 85 :type 'boolean 86 :group 'lisp-indent) 87 88 89(defcustom lisp-loop-keyword-indentation 3 90 "*Indentation of loop keywords in extended loop forms." 91 :type 'integer 92 :group 'lisp-indent) 93 94 95(defcustom lisp-loop-forms-indentation 5 96 "*Indentation of forms in extended loop forms." 97 :type 'integer 98 :group 'lisp-indent) 99 100 101(defcustom lisp-simple-loop-indentation 3 102 "*Indentation of forms in simple loop forms." 103 :type 'integer 104 :group 'lisp-indent) 105 106 107(defvar lisp-indent-error-function) 108(defvar lisp-indent-defun-method '(4 &lambda &body)) 109 110 111(defun extended-loop-p (loop-start) 112 "True if an extended loop form starts at LOOP-START." 113 (condition-case () 114 (save-excursion 115 (goto-char loop-start) 116 (forward-char 1) 117 (forward-sexp 2) 118 (backward-sexp 1) 119 (looking-at "\\sw")) 120 (error t))) 121 122 123(defun common-lisp-loop-part-indentation (indent-point state) 124 "Compute the indentation of loop form constituents." 125 (let* ((loop-indentation (save-excursion 126 (goto-char (elt state 1)) 127 (current-column)))) 128 (goto-char indent-point) 129 (beginning-of-line) 130 (cond ((not (extended-loop-p (elt state 1))) 131 (+ loop-indentation lisp-simple-loop-indentation)) 132 ((looking-at "^\\s-*\\(:?\\sw+\\|;\\)") 133 (+ loop-indentation lisp-loop-keyword-indentation)) 134 (t 135 (+ loop-indentation lisp-loop-forms-indentation))))) 136 137 138;;;###autoload 139(defun common-lisp-indent-function (indent-point state) 140 (if (save-excursion (goto-char (elt state 1)) 141 (looking-at "([Ll][Oo][Oo][Pp]")) 142 (common-lisp-loop-part-indentation indent-point state) 143 (common-lisp-indent-function-1 indent-point state))) 144 145 146(defun common-lisp-indent-function-1 (indent-point state) 147 (let ((normal-indent (current-column))) 148 ;; Walk up list levels until we see something 149 ;; which does special things with subforms. 150 (let ((depth 0) 151 ;; Path describes the position of point in terms of 152 ;; list-structure with respect to containing lists. 153 ;; `foo' has a path of (0 4 1) in `((a b c (d foo) f) g)' 154 (path ()) 155 ;; set non-nil when somebody works out the indentation to use 156 calculated 157 ;; If non-nil, this is an indentation to use 158 ;; if nothing else specifies it more firmly. 159 tentative-calculated 160 (last-point indent-point) 161 ;; the position of the open-paren of the innermost containing list 162 (containing-form-start (elt state 1)) 163 ;; the column of the above 164 sexp-column) 165 ;; Move to start of innermost containing list 166 (goto-char containing-form-start) 167 (setq sexp-column (current-column)) 168 169 ;; Look over successively less-deep containing forms 170 (while (and (not calculated) 171 (< depth lisp-indent-maximum-backtracking)) 172 (let ((containing-sexp (point))) 173 (forward-char 1) 174 (parse-partial-sexp (point) indent-point 1 t) 175 ;; Move to the car of the relevant containing form 176 (let (tem function method tentative-defun) 177 (if (not (looking-at "\\sw\\|\\s_")) 178 ;; This form doesn't seem to start with a symbol 179 (setq function nil method nil) 180 (setq tem (point)) 181 (forward-sexp 1) 182 (setq function (downcase (buffer-substring-no-properties 183 tem (point)))) 184 (goto-char tem) 185 (setq tem (intern-soft function) 186 method (get tem 'common-lisp-indent-function)) 187 (cond ((and (null method) 188 (string-match ":[^:]+" function)) 189 ;; The pleblisp package feature 190 (setq function (substring function 191 (1+ (match-beginning 0))) 192 method (get (intern-soft function) 193 'common-lisp-indent-function))) 194 ((and (null method)) 195 ;; backwards compatibility 196 (setq method (get tem 'lisp-indent-function))))) 197 (let ((n 0)) 198 ;; How far into the containing form is the current form? 199 (if (< (point) indent-point) 200 (while (condition-case () 201 (progn 202 (forward-sexp 1) 203 (if (>= (point) indent-point) 204 nil 205 (parse-partial-sexp (point) 206 indent-point 1 t) 207 (setq n (1+ n)) 208 t)) 209 (error nil)))) 210 (setq path (cons n path))) 211 212 ;; backwards compatibility. 213 (cond ((null function)) 214 ((null method) 215 (when (null (cdr path)) 216 ;; (package prefix was stripped off above) 217 (cond ((string-match "\\`def" 218 function) 219 (setq tentative-defun t)) 220 ((string-match 221 (eval-when-compile 222 (concat "\\`\\(" 223 (regexp-opt '("with" "without" "do")) 224 "\\)-")) 225 function) 226 (setq method '(&lambda &body)))))) 227 ;; backwards compatibility. Bletch. 228 ((eq method 'defun) 229 (setq method lisp-indent-defun-method))) 230 231 (cond ((and (or (eq (char-after (1- containing-sexp)) ?\') 232 (and (not lisp-backquote-indentation) 233 (eq (char-after (1- containing-sexp)) ?\`))) 234 (not (eq (char-after (- containing-sexp 2)) ?\#))) 235 ;; No indentation for "'(...)" elements 236 (setq calculated (1+ sexp-column))) 237 ((or (eq (char-after (1- containing-sexp)) ?\,) 238 (and (eq (char-after (1- containing-sexp)) ?\@) 239 (eq (char-after (- containing-sexp 2)) ?\,))) 240 ;; ",(...)" or ",@(...)" 241 (setq calculated normal-indent)) 242 ((eq (char-after (1- containing-sexp)) ?\#) 243 ;; "#(...)" 244 (setq calculated (1+ sexp-column))) 245 ((null method) 246 ;; If this looks like a call to a `def...' form, 247 ;; think about indenting it as one, but do it 248 ;; tentatively for cases like 249 ;; (flet ((defunp () 250 ;; nil))) 251 ;; Set both normal-indent and tentative-calculated. 252 ;; The latter ensures this value gets used 253 ;; if there are no relevant containing constructs. 254 ;; The former ensures this value gets used 255 ;; if there is a relevant containing construct 256 ;; but we are nested within the structure levels 257 ;; that it specifies indentation for. 258 (if tentative-defun 259 (setq tentative-calculated 260 (common-lisp-indent-call-method 261 function lisp-indent-defun-method 262 path state indent-point 263 sexp-column normal-indent) 264 normal-indent tentative-calculated))) 265 ((integerp method) 266 ;; convenient top-level hack. 267 ;; (also compatible with lisp-indent-function) 268 ;; The number specifies how many `distinguished' 269 ;; forms there are before the body starts 270 ;; Equivalent to (4 4 ... &body) 271 (setq calculated (cond ((cdr path) 272 normal-indent) 273 ((<= (car path) method) 274 ;; `distinguished' form 275 (list (+ sexp-column 4) 276 containing-form-start)) 277 ((= (car path) (1+ method)) 278 ;; first body form. 279 (+ sexp-column lisp-body-indent)) 280 (t 281 ;; other body form 282 normal-indent)))) 283 (t 284 (setq calculated 285 (common-lisp-indent-call-method 286 function method path state indent-point 287 sexp-column normal-indent))))) 288 (goto-char containing-sexp) 289 (setq last-point containing-sexp) 290 (unless calculated 291 (condition-case () 292 (progn (backward-up-list 1) 293 (setq depth (1+ depth))) 294 (error (setq depth lisp-indent-maximum-backtracking)))))) 295 (or calculated tentative-calculated)))) 296 297 298(defun common-lisp-indent-call-method (function method path state indent-point 299 sexp-column normal-indent) 300 (let ((lisp-indent-error-function function)) 301 (if (symbolp method) 302 (funcall method 303 path state indent-point 304 sexp-column normal-indent) 305 (lisp-indent-259 method path state indent-point 306 sexp-column normal-indent)))) 307 308(defun lisp-indent-report-bad-format (m) 309 (error "%s has a badly-formed %s property: %s" 310 ;; Love those free variable references!! 311 lisp-indent-error-function 'common-lisp-indent-function m)) 312 313;; Blame the crufty control structure on dynamic scoping 314;; -- not on me! 315(defun lisp-indent-259 (method path state indent-point 316 sexp-column normal-indent) 317 (catch 'exit 318 (let ((p path) 319 (containing-form-start (elt state 1)) 320 n tem tail) 321 ;; Isn't tail-recursion wonderful? 322 (while p 323 ;; This while loop is for destructuring. 324 ;; p is set to (cdr p) each iteration. 325 (if (not (consp method)) (lisp-indent-report-bad-format method)) 326 (setq n (1- (car p)) 327 p (cdr p) 328 tail nil) 329 (while n 330 ;; This while loop is for advancing along a method 331 ;; until the relevant (possibly &rest/&body) pattern 332 ;; is reached. 333 ;; n is set to (1- n) and method to (cdr method) 334 ;; each iteration. 335 (setq tem (car method)) 336 337 (or (eq tem 'nil) ;default indentation 338 (eq tem '&lambda) ;lambda list 339 (and (eq tem '&body) (null (cdr method))) 340 (and (eq tem '&rest) 341 (consp (cdr method)) 342 (null (cddr method))) 343 (integerp tem) ;explicit indentation specified 344 (and (consp tem) ;destructuring 345 (eq (car tem) '&whole) 346 (or (symbolp (cadr tem)) 347 (integerp (cadr tem)))) 348 (and (symbolp tem) ;a function to call to do the work. 349 (null (cdr method))) 350 (lisp-indent-report-bad-format method)) 351 352 (cond ((and tail (not (consp tem))) 353 ;; indent tail of &rest in same way as first elt of rest 354 (throw 'exit normal-indent)) 355 ((eq tem '&body) 356 ;; &body means (&rest <lisp-body-indent>) 357 (throw 'exit 358 (if (and (= n 0) ;first body form 359 (null p)) ;not in subforms 360 (+ sexp-column 361 lisp-body-indent) 362 normal-indent))) 363 ((eq tem '&rest) 364 ;; this pattern holds for all remaining forms 365 (setq tail (> n 0) 366 n 0 367 method (cdr method))) 368 ((> n 0) 369 ;; try next element of pattern 370 (setq n (1- n) 371 method (cdr method)) 372 (if (< n 0) 373 ;; Too few elements in pattern. 374 (throw 'exit normal-indent))) 375 ((eq tem 'nil) 376 (throw 'exit (if (consp normal-indent) 377 normal-indent 378 (list normal-indent containing-form-start)))) 379 ((eq tem '&lambda) 380 (throw 'exit 381 (cond ((null p) 382 (list (+ sexp-column 4) containing-form-start)) 383 ((null (cdr p)) 384 (+ sexp-column 1)) 385 (t normal-indent)))) 386 ((integerp tem) 387 (throw 'exit 388 (if (null p) ;not in subforms 389 (list (+ sexp-column tem) containing-form-start) 390 normal-indent))) 391 ((symbolp tem) ;a function to call 392 (throw 'exit 393 (funcall tem path state indent-point 394 sexp-column normal-indent))) 395 (t 396 ;; must be a destructing frob 397 (if (not (null p)) 398 ;; descend 399 (setq method (cddr tem) 400 n nil) 401 (setq tem (cadr tem)) 402 (throw 'exit 403 (cond (tail 404 normal-indent) 405 ((eq tem 'nil) 406 (list normal-indent 407 containing-form-start)) 408 ((integerp tem) 409 (list (+ sexp-column tem) 410 containing-form-start)) 411 (t 412 (funcall tem path state indent-point 413 sexp-column normal-indent)))))))))))) 414 415(defun lisp-indent-tagbody (path state indent-point sexp-column normal-indent) 416 (if (not (null (cdr path))) 417 normal-indent 418 (save-excursion 419 (goto-char indent-point) 420 (beginning-of-line) 421 (skip-chars-forward " \t") 422 (list (cond ((looking-at "\\sw\\|\\s_") 423 ;; a tagbody tag 424 (+ sexp-column lisp-tag-indentation)) 425 ((integerp lisp-tag-body-indentation) 426 (+ sexp-column lisp-tag-body-indentation)) 427 ((eq lisp-tag-body-indentation 't) 428 (condition-case () 429 (progn (backward-sexp 1) (current-column)) 430 (error (1+ sexp-column)))) 431 (t (+ sexp-column lisp-body-indent))) 432; (cond ((integerp lisp-tag-body-indentation) 433; (+ sexp-column lisp-tag-body-indentation)) 434; ((eq lisp-tag-body-indentation 't) 435; normal-indent) 436; (t 437; (+ sexp-column lisp-body-indent))) 438 (elt state 1) 439 )))) 440 441(defun lisp-indent-do (path state indent-point sexp-column normal-indent) 442 (if (>= (car path) 3) 443 (let ((lisp-tag-body-indentation lisp-body-indent)) 444 (funcall (function lisp-indent-tagbody) 445 path state indent-point sexp-column normal-indent)) 446 (funcall (function lisp-indent-259) 447 '((&whole nil &rest 448 ;; the following causes weird indentation 449 ;;(&whole 1 1 2 nil) 450 ) 451 (&whole nil &rest 1)) 452 path state indent-point sexp-column normal-indent))) 453 454 455(defun lisp-indent-defmethod (path state indent-point sexp-column 456 normal-indent) 457 "Indentation function defmethod." 458 (lisp-indent-259 (if (and (>= (car path) 3) 459 (null (cdr path)) 460 (save-excursion (goto-char (elt state 1)) 461 (forward-char 1) 462 (forward-sexp 3) 463 (backward-sexp) 464 (looking-at ":\\|\\sw+"))) 465 '(4 4 (&whole 4 &rest 4) &body) 466 (get 'defun 'common-lisp-indent-function)) 467 path state indent-point sexp-column normal-indent)) 468 469 470(defun lisp-indent-function-lambda-hack (path state indent-point 471 sexp-column normal-indent) 472 ;; indent (function (lambda () <newline> <body-forms>)) kludgily. 473 (if (or (cdr path) ; wtf? 474 (> (car path) 3)) 475 ;; line up under previous body form 476 normal-indent 477 ;; line up under function rather than under lambda in order to 478 ;; conserve horizontal space. (Which is what #' is for.) 479 (condition-case () 480 (save-excursion 481 (backward-up-list 2) 482 (forward-char 1) 483 (if (looking-at "\\(lisp:+\\)?function\\(\\Sw\\|\\S_\\)") 484 (+ lisp-body-indent -1 (current-column)) 485 (+ sexp-column lisp-body-indent))) 486 (error (+ sexp-column lisp-body-indent))))) 487 488 489 490(let ((l '((block 1) 491 (case (4 &rest (&whole 2 &rest 1))) 492 (ccase . case) (ecase . case) 493 (typecase . case) (etypecase . case) (ctypecase . case) 494 (catch 1) 495 (cond (&rest (&whole 2 &rest 1))) 496 (defvar (4 2 2)) 497 (defclass (6 4 (&whole 2 &rest 1) (&whole 2 &rest 1))) 498 (defconstant . defvar) 499 (defcustom (4 2 2 2)) 500 (defparameter . defvar) 501 (defconst . defcustom) 502 (define-condition . defclass) 503 (define-modify-macro (4 &lambda &body)) 504 (defsetf (4 &lambda 4 &body)) 505 (defun (4 &lambda &body)) 506 (define-setf-method . defun) 507 (define-setf-expander . defun) 508 (defmacro . defun) (defsubst . defun) (deftype . defun) 509 (defmethod lisp-indent-defmethod) 510 (defpackage (4 2)) 511 (defstruct ((&whole 4 &rest (&whole 2 &rest 1)) 512 &rest (&whole 2 &rest 1))) 513 (destructuring-bind 514 ((&whole 6 &rest 1) 4 &body)) 515 (do lisp-indent-do) 516 (do* . do) 517 (dolist ((&whole 4 2 1) &body)) 518 (dotimes . dolist) 519 (eval-when 1) 520 (flet ((&whole 4 &rest (&whole 1 &lambda &body)) &body)) 521 (labels . flet) 522 (macrolet . flet) 523 (generic-flet . flet) (generic-labels . flet) 524 (handler-case (4 &rest (&whole 2 &lambda &body))) 525 (restart-case . handler-case) 526 ;; `else-body' style 527 (if (nil nil &body)) 528 ;; single-else style (then and else equally indented) 529 (if (&rest nil)) 530 (lambda (&lambda &rest lisp-indent-function-lambda-hack)) 531 (let ((&whole 4 &rest (&whole 1 1 2)) &body)) 532 (let* . let) 533 (compiler-let . let) ;barf 534 (handler-bind . let) (restart-bind . let) 535 (locally 1) 536 ;(loop lisp-indent-loop) 537 (:method (&lambda &body)) ; in `defgeneric' 538 (multiple-value-bind ((&whole 6 &rest 1) 4 &body)) 539 (multiple-value-call (4 &body)) 540 (multiple-value-prog1 1) 541 (multiple-value-setq (4 2)) 542 (multiple-value-setf . multiple-value-setq) 543 (pprint-logical-block (4 2)) 544 (print-unreadable-object ((&whole 4 1 &rest 1) &body)) 545 ;; Combines the worst features of BLOCK, LET and TAGBODY 546 (prog (&lambda &rest lisp-indent-tagbody)) 547 (prog* . prog) 548 (prog1 1) 549 (prog2 2) 550 (progn 0) 551 (progv (4 4 &body)) 552 (return 0) 553 (return-from (nil &body)) 554 (symbol-macrolet . let) 555 (tagbody lisp-indent-tagbody) 556 (throw 1) 557 (unless 1) 558 (unwind-protect (5 &body)) 559 (when 1) 560 (with-accessors . multiple-value-bind) 561 (with-condition-restarts . multiple-value-bind) 562 (with-output-to-string (4 2)) 563 (with-slots . multiple-value-bind) 564 (with-standard-io-syntax (2))))) 565 (dolist (el l) 566 (put (car el) 'common-lisp-indent-function 567 (if (symbolp (cdr el)) 568 (get (cdr el) 'common-lisp-indent-function) 569 (car (cdr el)))))) 570 571 572;(defun foo (x) 573; (tagbody 574; foo 575; (bar) 576; baz 577; (when (losing) 578; (with-big-loser 579; (yow) 580; ((lambda () 581; foo) 582; big))) 583; (flet ((foo (bar baz zap) 584; (zip)) 585; (zot () 586; quux)) 587; (do () 588; ((lose) 589; (foo 1)) 590; (quux) 591; foo 592; (lose)) 593; (cond ((x) 594; (win 1 2 595; (foo))) 596; (t 597; (lose 598; 3)))))) 599 600 601;(put 'while 'common-lisp-indent-function 1) 602;(put 'defwrapper'common-lisp-indent-function ...) 603;(put 'def 'common-lisp-indent-function ...) 604;(put 'defflavor 'common-lisp-indent-function ...) 605;(put 'defsubst 'common-lisp-indent-function ...) 606 607;(put 'with-restart 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) 608;(put 'restart-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (* 1))))) 609;(put 'define-condition 'common-lisp-indent-function '((1 6) (2 6 ((&whole 1))) (3 4 ((&whole 1))) (4 &body))) 610;(put 'with-condition-handler 'common-lisp-indent-function '((1 4 ((* 1))) (2 &body))) 611;(put 'condition-case 'common-lisp-indent-function '((1 4) (* 2 ((0 1) (1 3) (2 &body))))) 612;(put 'defclass 'common-lisp-indent-function '((&whole 2 &rest (&whole 2 &rest 1) &rest (&whole 2 &rest 1))) 613;(put 'defgeneric 'common-lisp-indent-function 'defun) 614 615;;; arch-tag: 7914d50f-92ec-4476-93fc-0f043a380e03 616;;; cl-indent.el ends here 617