lisp/emacs-lisp/cl-indent.el

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