lisp/emacs-lisp/lisp-mode.el

   1 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
   2
   3 ;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
   4
   5 ;; Maintainer: FSF
   6 ;; Keywords: lisp, languages
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; The base major mode for editing Lisp code (used also for Emacs Lisp).
  28 ;; This mode is documented in the Emacs manual
  29
  30 ;;; Code:
  31
  32 (defvar lisp-mode-syntax-table nil "")
  33 (defvar emacs-lisp-mode-syntax-table nil "")
  34 (defvar lisp-mode-abbrev-table nil "")
  35
  36 (if (not emacs-lisp-mode-syntax-table)
  37     (let ((i 0))
  38       (setq emacs-lisp-mode-syntax-table (make-syntax-table))
  39       (while (< i ?0)
  40         (modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
  41         (setq i (1+ i)))
  42       (setq i (1+ ?9))
  43       (while (< i ?A)
  44         (modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
  45         (setq i (1+ i)))
  46       (setq i (1+ ?Z))
  47       (while (< i ?a)
  48         (modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
  49         (setq i (1+ i)))
  50       (setq i (1+ ?z))
  51       (while (< i 128)
  52         (modify-syntax-entry i "_   " emacs-lisp-mode-syntax-table)
  53         (setq i (1+ i)))
  54       (modify-syntax-entry ?  "    " emacs-lisp-mode-syntax-table)
  55       (modify-syntax-entry ?\t "    " emacs-lisp-mode-syntax-table)
  56       (modify-syntax-entry ?\n ">   " emacs-lisp-mode-syntax-table)
  57       ;; Give CR the same syntax as newline, for selective-display.
  58       (modify-syntax-entry ?\^m ">   " emacs-lisp-mode-syntax-table)
  59       (modify-syntax-entry ?\; "<   " emacs-lisp-mode-syntax-table)
  60       (modify-syntax-entry ?` "'   " emacs-lisp-mode-syntax-table)
  61       (modify-syntax-entry ?' "'   " emacs-lisp-mode-syntax-table)
  62       (modify-syntax-entry ?, "'   " emacs-lisp-mode-syntax-table)
  63       ;; Used to be singlequote; changed for flonums.
  64       (modify-syntax-entry ?. "_   " emacs-lisp-mode-syntax-table)
  65       (modify-syntax-entry ?# "'   " emacs-lisp-mode-syntax-table)
  66       (modify-syntax-entry ?\" "\"    " emacs-lisp-mode-syntax-table)
  67       (modify-syntax-entry ?\\ "\\   " emacs-lisp-mode-syntax-table)
  68       (modify-syntax-entry ?\( "()  " emacs-lisp-mode-syntax-table)
  69       (modify-syntax-entry ?\) ")(  " emacs-lisp-mode-syntax-table)
  70       (modify-syntax-entry ?\[ "(]  " emacs-lisp-mode-syntax-table)
  71       (modify-syntax-entry ?\] ")[  " emacs-lisp-mode-syntax-table)))
  72
  73 (if (not lisp-mode-syntax-table)
  74     (progn (setq lisp-mode-syntax-table
  75                  (copy-syntax-table emacs-lisp-mode-syntax-table))
  76            (modify-syntax-entry ?\| "\"   " lisp-mode-syntax-table)
  77            (modify-syntax-entry ?\[ "_   " lisp-mode-syntax-table)
  78            (modify-syntax-entry ?\] "_   " lisp-mode-syntax-table)))
  79
  80 (define-abbrev-table 'lisp-mode-abbrev-table ())
  81
  82 (defvar lisp-imenu-generic-expression
  83       '(
  84         (nil
  85          "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
  86         ("Variables"
  87          "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
  88         ("Types"
  89          "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)"
  90          2))
  91
  92   "Imenu generic expression for Lisp mode.  See `imenu-generic-expression'.")
  93
  94 (defun lisp-mode-variables (lisp-syntax)
  95   (cond (lisp-syntax
  96           (set-syntax-table lisp-mode-syntax-table)))
  97   (setq local-abbrev-table lisp-mode-abbrev-table)
  98   (make-local-variable 'paragraph-start)
  99   (setq paragraph-start (concat page-delimiter "\\|$" ))
 100   (make-local-variable 'paragraph-separate)
 101   (setq paragraph-separate paragraph-start)
 102   (make-local-variable 'paragraph-ignore-fill-prefix)
 103   (setq paragraph-ignore-fill-prefix t)
 104   (make-local-variable 'fill-paragraph-function)
 105   (setq fill-paragraph-function 'lisp-fill-paragraph)
 106   ;; Adaptive fill mode gets in the way of auto-fill,
 107   ;; and should make no difference for explicit fill
 108   ;; because lisp-fill-paragraph should do the job.
 109   (make-local-variable 'adaptive-fill-mode)
 110   (setq adaptive-fill-mode nil)
 111   (make-local-variable 'indent-line-function)
 112   (setq indent-line-function 'lisp-indent-line)
 113   (make-local-variable 'indent-region-function)
 114   (setq indent-region-function 'lisp-indent-region)
 115   (make-local-variable 'parse-sexp-ignore-comments)
 116   (setq parse-sexp-ignore-comments t)
 117   (make-local-variable 'outline-regexp)
 118   (setq outline-regexp ";;; \\|(....")
 119   (make-local-variable 'comment-start)
 120   (setq comment-start ";")
 121   (make-local-variable 'comment-start-skip)
 122   ;; Look within the line for a ; following an even number of backslashes
 123   ;; after either a non-backslash or the line beginning.
 124   (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
 125   (make-local-variable 'comment-column)
 126   (setq comment-column 40)
 127   (make-local-variable 'comment-indent-function)
 128   (setq comment-indent-function 'lisp-comment-indent)
 129   (make-local-variable 'imenu-generic-expression)
 130   (setq imenu-generic-expression lisp-imenu-generic-expression))
 131 \f
 132 (defvar shared-lisp-mode-map ()
 133   "Keymap for commands shared by all sorts of Lisp modes.")
 134
 135 (if shared-lisp-mode-map
 136     ()
 137    (setq shared-lisp-mode-map (make-sparse-keymap))
 138    (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)
 139    (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify))
 140
 141 (defvar emacs-lisp-mode-map ()
 142   "Keymap for Emacs Lisp mode.
 143 All commands in `shared-lisp-mode-map' are inherited by this map.")
 144
 145 (if emacs-lisp-mode-map
 146     ()
 147   (let ((map (make-sparse-keymap "Emacs-Lisp")))
 148     (setq emacs-lisp-mode-map
 149           (nconc (make-sparse-keymap) shared-lisp-mode-map))
 150     (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
 151     (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
 152     (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
 153     (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
 154       (cons "Emacs-Lisp" map))
 155     (define-key map [edebug-defun]
 156       '("Instrument Function for Debugging" . edebug-defun))
 157     (define-key map [byte-recompile]
 158       '("Byte-recompile Directory..." . byte-recompile-directory))
 159     (define-key map [emacs-byte-compile-and-load]
 160       '("Byte-compile And Load" . emacs-lisp-byte-compile-and-load))
 161     (define-key map [byte-compile]
 162       '("Byte-compile This File" . emacs-lisp-byte-compile))
 163     (define-key map [separator-eval] '("--"))
 164     (define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer))
 165     (define-key map [eval-region] '("Evaluate Region" . eval-region))
 166     (define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp))
 167     (define-key map [separator-format] '("--"))
 168     (define-key map [comment-region] '("Comment Out Region" . comment-region))
 169     (define-key map [indent-region] '("Indent Region" . indent-region))
 170     (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
 171     (put 'eval-region 'menu-enable 'mark-active)
 172     (put 'comment-region 'menu-enable 'mark-active)
 173     (put 'indent-region 'menu-enable 'mark-active)))
 174
 175 (defun emacs-lisp-byte-compile ()
 176   "Byte compile the file containing the current buffer."
 177   (interactive)
 178   (if buffer-file-name
 179       (byte-compile-file buffer-file-name)
 180     (error "The buffer must be saved in a file first")))
 181
 182 (defun emacs-lisp-byte-compile-and-load ()
 183   "Byte-compile the current file (if it has changed), then load compiled code."
 184   (interactive)
 185   (or buffer-file-name
 186       (error "The buffer must be saved in a file first"))
 187   (require 'bytecomp)
 188   ;; Recompile if file or buffer has changed since last compilation.
 189   (if (and (buffer-modified-p)
 190            (y-or-n-p (format "save buffer %s first? " (buffer-name))))
 191       (save-buffer))
 192   (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))
 193     (if (file-newer-than-file-p compiled-file-name buffer-file-name)
 194         (load-file compiled-file-name)
 195       (byte-compile-file buffer-file-name t))))
 196
 197 (defun emacs-lisp-mode ()
 198   "Major mode for editing Lisp code to run in Emacs.
 199 Commands:
 200 Delete converts tabs to spaces as it moves back.
 201 Blank lines separate paragraphs.  Semicolons start comments.
 202 \\{emacs-lisp-mode-map}
 203 Entry to this mode calls the value of `emacs-lisp-mode-hook'
 204 if that value is non-nil."
 205   (interactive)
 206   (kill-all-local-variables)
 207   (use-local-map emacs-lisp-mode-map)
 208   (set-syntax-table emacs-lisp-mode-syntax-table)
 209   (setq major-mode 'emacs-lisp-mode)
 210   (setq mode-name "Emacs-Lisp")
 211   (lisp-mode-variables nil)
 212   (run-hooks 'emacs-lisp-mode-hook))
 213
 214 (defvar lisp-mode-map ()
 215   "Keymap for ordinary Lisp mode.
 216 All commands in `shared-lisp-mode-map' are inherited by this map.")
 217
 218 (if lisp-mode-map
 219     ()
 220   (setq lisp-mode-map
 221         (nconc (make-sparse-keymap) shared-lisp-mode-map))
 222   (define-key lisp-mode-map "\e\C-x" 'lisp-eval-defun)
 223   (define-key lisp-mode-map "\C-c\C-z" 'run-lisp))
 224
 225 (defun lisp-mode ()
 226   "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
 227 Commands:
 228 Delete converts tabs to spaces as it moves back.
 229 Blank lines separate paragraphs.  Semicolons start comments.
 230 \\{lisp-mode-map}
 231 Note that `run-lisp' may be used either to start an inferior Lisp job
 232 or to switch back to an existing one.
 233
 234 Entry to this mode calls the value of `lisp-mode-hook'
 235 if that value is non-nil."
 236   (interactive)
 237   (kill-all-local-variables)
 238   (use-local-map lisp-mode-map)
 239   (setq major-mode 'lisp-mode)
 240   (setq mode-name "Lisp")
 241   (lisp-mode-variables t)
 242   (set-syntax-table lisp-mode-syntax-table)
 243   (run-hooks 'lisp-mode-hook))
 244
 245 ;; This will do unless shell.el is loaded.
 246 (defun lisp-eval-defun nil
 247   "Send the current defun to the Lisp process made by \\[run-lisp]."
 248   (interactive)
 249   (error "Process lisp does not exist"))
 250
 251 (defvar lisp-interaction-mode-map ()
 252   "Keymap for Lisp Interaction moe.
 253 All commands in `shared-lisp-mode-map' are inherited by this map.")
 254
 255 (if lisp-interaction-mode-map
 256     ()
 257   (setq lisp-interaction-mode-map
 258         (nconc (make-sparse-keymap) shared-lisp-mode-map))
 259   (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun)
 260   (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol)
 261   (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp))
 262
 263 (defun lisp-interaction-mode ()
 264   "Major mode for typing and evaluating Lisp forms.
 265 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
 266 before point, and prints its value into the buffer, advancing point.
 267
 268 Commands:
 269 Delete converts tabs to spaces as it moves back.
 270 Paragraphs are separated only by blank lines.
 271 Semicolons start comments.
 272 \\{lisp-interaction-mode-map}
 273 Entry to this mode calls the value of `lisp-interaction-mode-hook'
 274 if that value is non-nil."
 275   (interactive)
 276   (kill-all-local-variables)
 277   (use-local-map lisp-interaction-mode-map)
 278   (setq major-mode 'lisp-interaction-mode)
 279   (setq mode-name "Lisp Interaction")
 280   (set-syntax-table emacs-lisp-mode-syntax-table)
 281   (lisp-mode-variables nil)
 282   (run-hooks 'lisp-interaction-mode-hook))
 283
 284 (defun eval-print-last-sexp ()
 285   "Evaluate sexp before point; print value into current buffer."
 286   (interactive)
 287   (let ((standard-output (current-buffer)))
 288     (terpri)
 289     (eval-last-sexp t)
 290     (terpri)))
 291 \f
 292 (defun eval-last-sexp (eval-last-sexp-arg-internal)
 293   "Evaluate sexp before point; print value in minibuffer.
 294 With argument, print output into current buffer."
 295   (interactive "P")
 296   (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
 297         (opoint (point)))
 298     (prin1 (let ((stab (syntax-table)))
 299              (eval (unwind-protect
 300                        (save-excursion
 301                          (set-syntax-table emacs-lisp-mode-syntax-table)
 302                          (forward-sexp -1)
 303                          (save-restriction
 304                            (narrow-to-region (point-min) opoint)
 305                            (read (current-buffer))))
 306                      (set-syntax-table stab)))))))
 307
 308 (defun eval-defun (eval-defun-arg-internal)
 309   "Evaluate defun that point is in or before.
 310 Print value in minibuffer.
 311 With argument, insert value in current buffer after the defun."
 312   (interactive "P")
 313   (let ((standard-output (if eval-defun-arg-internal (current-buffer) t))
 314         (form (save-excursion
 315                 (end-of-defun)
 316                 (beginning-of-defun)
 317                 (read (current-buffer)))))
 318     (if (and (eq (car form) 'defvar)
 319              (cdr-safe (cdr-safe form)))
 320         (setq form (cons 'defconst (cdr form))))
 321     (prin1 (eval form))))
 322 \f
 323 (defun lisp-comment-indent ()
 324   (if (looking-at "\\s<\\s<\\s<")
 325       (current-column)
 326     (if (looking-at "\\s<\\s<")
 327         (let ((tem (calculate-lisp-indent)))
 328           (if (listp tem) (car tem) tem))
 329       (skip-chars-backward " \t")
 330       (max (if (bolp) 0 (1+ (current-column)))
 331            comment-column))))
 332
 333 (defconst lisp-indent-offset nil "")
 334 (defconst lisp-indent-function 'lisp-indent-function "")
 335
 336 (defun lisp-indent-line (&optional whole-exp)
 337   "Indent current line as Lisp code.
 338 With argument, indent any additional lines of the same expression
 339 rigidly along with this one."
 340   (interactive "P")
 341   (let ((indent (calculate-lisp-indent)) shift-amt beg end
 342         (pos (- (point-max) (point))))
 343     (beginning-of-line)
 344     (setq beg (point))
 345     (skip-chars-forward " \t")
 346     (if (looking-at "\\s<\\s<\\s<")
 347         ;; Don't alter indentation of a ;;; comment line.
 348         (goto-char (- (point-max) pos))
 349       (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
 350           ;; Single-semicolon comment lines should be indented
 351           ;; as comment lines, not as code.
 352           (progn (indent-for-comment) (forward-char -1))
 353         (if (listp indent) (setq indent (car indent)))
 354         (setq shift-amt (- indent (current-column)))
 355         (if (zerop shift-amt)
 356             nil
 357           (delete-region beg (point))
 358           (indent-to indent)))
 359       ;; If initial point was within line's indentation,
 360       ;; position after the indentation.  Else stay at same point in text.
 361       (if (> (- (point-max) pos) (point))
 362           (goto-char (- (point-max) pos)))
 363       ;; If desired, shift remaining lines of expression the same amount.
 364       (and whole-exp (not (zerop shift-amt))
 365            (save-excursion
 366              (goto-char beg)
 367              (forward-sexp 1)
 368              (setq end (point))
 369              (goto-char beg)
 370              (forward-line 1)
 371              (setq beg (point))
 372              (> end beg))
 373            (indent-code-rigidly beg end shift-amt)))))
 374
 375 (defvar calculate-lisp-indent-last-sexp)
 376
 377 (defun calculate-lisp-indent (&optional parse-start)
 378   "Return appropriate indentation for current line as Lisp code.
 379 In usual case returns an integer: the column to indent to.
 380 Can instead return a list, whose car is the column to indent to.
 381 This means that following lines at the same level of indentation
 382 should not necessarily be indented the same way.
 383 The second element of the list is the buffer position
 384 of the start of the containing expression."
 385   (save-excursion
 386     (beginning-of-line)
 387     (let ((indent-point (point))
 388           state paren-depth
 389           ;; setting this to a number inhibits calling hook
 390           (desired-indent nil)
 391           (retry t)
 392           calculate-lisp-indent-last-sexp containing-sexp)
 393       (if parse-start
 394           (goto-char parse-start)
 395           (beginning-of-defun))
 396       ;; Find outermost containing sexp
 397       (while (< (point) indent-point)
 398         (setq state (parse-partial-sexp (point) indent-point 0)))
 399       ;; Find innermost containing sexp
 400       (while (and retry
 401                   state
 402                   (> (setq paren-depth (elt state 0)) 0))
 403         (setq retry nil)
 404         (setq calculate-lisp-indent-last-sexp (elt state 2))
 405         (setq containing-sexp (elt state 1))
 406         ;; Position following last unclosed open.
 407         (goto-char (1+ containing-sexp))
 408         ;; Is there a complete sexp since then?
 409         (if (and calculate-lisp-indent-last-sexp
 410                  (> calculate-lisp-indent-last-sexp (point)))
 411             ;; Yes, but is there a containing sexp after that?
 412             (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
 413                                             indent-point 0)))
 414               (if (setq retry (car (cdr peek))) (setq state peek)))))
 415       (if retry
 416           nil
 417         ;; Innermost containing sexp found
 418         (goto-char (1+ containing-sexp))
 419         (if (not calculate-lisp-indent-last-sexp)
 420             ;; indent-point immediately follows open paren.
 421             ;; Don't call hook.
 422             (setq desired-indent (current-column))
 423           ;; Find the start of first element of containing sexp.
 424           (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 425           (cond ((looking-at "\\s(")
 426                  ;; First element of containing sexp is a list.
 427                  ;; Indent under that list.
 428                  )
 429                 ((> (save-excursion (forward-line 1) (point))
 430                     calculate-lisp-indent-last-sexp)
 431                  ;; This is the first line to start within the containing sexp.
 432                  ;; It's almost certainly a function call.
 433                  (if (= (point) calculate-lisp-indent-last-sexp)
 434                      ;; Containing sexp has nothing before this line
 435                      ;; except the first element.  Indent under that element.
 436                      nil
 437                    ;; Skip the first element, find start of second (the first
 438                    ;; argument of the function call) and indent under.
 439                    (progn (forward-sexp 1)
 440                           (parse-partial-sexp (point)
 441                                               calculate-lisp-indent-last-sexp
 442                                               0 t)))
 443                  (backward-prefix-chars))
 444                 (t
 445                  ;; Indent beneath first sexp on same line as
 446                  ;; calculate-lisp-indent-last-sexp.  Again, it's
 447                  ;; almost certainly a function call.
 448                  (goto-char calculate-lisp-indent-last-sexp)
 449                  (beginning-of-line)
 450                  (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
 451                                      0 t)
 452                  (backward-prefix-chars)))))
 453       ;; Point is at the point to indent under unless we are inside a string.
 454       ;; Call indentation hook except when overridden by lisp-indent-offset
 455       ;; or if the desired indentation has already been computed.
 456       (let ((normal-indent (current-column)))
 457         (cond ((elt state 3)
 458                ;; Inside a string, don't change indentation.
 459                (goto-char indent-point)
 460                (skip-chars-forward " \t")
 461                (current-column))
 462               ((and (integerp lisp-indent-offset) containing-sexp)
 463                ;; Indent by constant offset
 464                (goto-char containing-sexp)
 465                (+ (current-column) lisp-indent-offset))
 466               (desired-indent)
 467               ((and (boundp 'lisp-indent-function)
 468                     lisp-indent-function
 469                     (not retry))
 470                (or (funcall lisp-indent-function indent-point state)
 471                    normal-indent))
 472               (t
 473                normal-indent))))))
 474
 475 (defun lisp-indent-function (indent-point state)
 476   (let ((normal-indent (current-column)))
 477     (goto-char (1+ (elt state 1)))
 478     (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
 479     (if (and (elt state 2)
 480              (not (looking-at "\\sw\\|\\s_")))
 481         ;; car of form doesn't seem to be a a symbol
 482         (progn
 483           (if (not (> (save-excursion (forward-line 1) (point))
 484                       calculate-lisp-indent-last-sexp))
 485               (progn (goto-char calculate-lisp-indent-last-sexp)
 486                      (beginning-of-line)
 487                      (parse-partial-sexp (point)
 488                                          calculate-lisp-indent-last-sexp 0 t)))
 489           ;; Indent under the list or under the first sexp on the same
 490           ;; line as calculate-lisp-indent-last-sexp.  Note that first
 491           ;; thing on that line has to be complete sexp since we are
 492           ;; inside the innermost containing sexp.
 493           (backward-prefix-chars)
 494           (current-column))
 495       (let ((function (buffer-substring (point)
 496                                         (progn (forward-sexp 1) (point))))
 497             method)
 498         (setq method (or (get (intern-soft function) 'lisp-indent-function)
 499                          (get (intern-soft function) 'lisp-indent-hook)))
 500         (cond ((or (eq method 'defun)
 501                    (and (null method)
 502                         (> (length function) 3)
 503                         (string-match "\\`def" function)))
 504                (lisp-indent-defform state indent-point))
 505               ((integerp method)
 506                (lisp-indent-specform method state
 507                                      indent-point normal-indent))
 508               (method
 509                 (funcall method state indent-point)))))))
 510
 511 (defconst lisp-body-indent 2
 512   "Number of columns to indent the second line of a `(def...)' form.")
 513
 514 (defun lisp-indent-specform (count state indent-point normal-indent)
 515   (let ((containing-form-start (elt state 1))
 516         (i count)
 517         body-indent containing-form-column)
 518     ;; Move to the start of containing form, calculate indentation
 519     ;; to use for non-distinguished forms (> count), and move past the
 520     ;; function symbol.  lisp-indent-function guarantees that there is at
 521     ;; least one word or symbol character following open paren of containing
 522     ;; form.
 523     (goto-char containing-form-start)
 524     (setq containing-form-column (current-column))
 525     (setq body-indent (+ lisp-body-indent containing-form-column))
 526     (forward-char 1)
 527     (forward-sexp 1)
 528     ;; Now find the start of the last form.
 529     (parse-partial-sexp (point) indent-point 1 t)
 530     (while (and (< (point) indent-point)
 531                 (condition-case ()
 532                     (progn
 533                       (setq count (1- count))
 534                       (forward-sexp 1)
 535                       (parse-partial-sexp (point) indent-point 1 t))
 536                   (error nil))))
 537     ;; Point is sitting on first character of last (or count) sexp.
 538     (if (> count 0)
 539         ;; A distinguished form.  If it is the first or second form use double
 540         ;; lisp-body-indent, else normal indent.  With lisp-body-indent bound
 541         ;; to 2 (the default), this just happens to work the same with if as
 542         ;; the older code, but it makes unwind-protect, condition-case,
 543         ;; with-output-to-temp-buffer, et. al. much more tasteful.  The older,
 544         ;; less hacked, behavior can be obtained by replacing below with
 545         ;; (list normal-indent containing-form-start).
 546         (if (<= (- i count) 1)
 547             (list (+ containing-form-column (* 2 lisp-body-indent))
 548                   containing-form-start)
 549             (list normal-indent containing-form-start))
 550       ;; A non-distinguished form.  Use body-indent if there are no
 551       ;; distinguished forms and this is the first undistinguished form,
 552       ;; or if this is the first undistinguished form and the preceding
 553       ;; distinguished form has indentation at least as great as body-indent.
 554       (if (or (and (= i 0) (= count 0))
 555               (and (= count 0) (<= body-indent normal-indent)))
 556           body-indent
 557           normal-indent))))
 558
 559 (defun lisp-indent-defform (state indent-point)
 560   (goto-char (car (cdr state)))
 561   (forward-line 1)
 562   (if (> (point) (car (cdr (cdr state))))
 563       (progn
 564         (goto-char (car (cdr state)))
 565         (+ lisp-body-indent (current-column)))))
 566
 567 \f
 568 ;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
 569 ;; like defun if the first form is placed on the next line, otherwise
 570 ;; it is indented like any other form (i.e. forms line up under first).
 571
 572 (put 'lambda 'lisp-indent-function 'defun)
 573 (put 'autoload 'lisp-indent-function 'defun)
 574 (put 'progn 'lisp-indent-function 0)
 575 (put 'prog1 'lisp-indent-function 1)
 576 (put 'prog2 'lisp-indent-function 2)
 577 (put 'save-excursion 'lisp-indent-function 0)
 578 (put 'save-window-excursion 'lisp-indent-function 0)
 579 (put 'save-selected-window 'lisp-indent-function 0)
 580 (put 'save-restriction 'lisp-indent-function 0)
 581 (put 'save-match-data 'lisp-indent-function 0)
 582 (put 'let 'lisp-indent-function 1)
 583 (put 'let* 'lisp-indent-function 1)
 584 (put 'while 'lisp-indent-function 1)
 585 (put 'if 'lisp-indent-function 2)
 586 (put 'catch 'lisp-indent-function 1)
 587 (put 'condition-case 'lisp-indent-function 2)
 588 (put 'unwind-protect 'lisp-indent-function 1)
 589 (put 'with-output-to-temp-buffer 'lisp-indent-function 1)
 590
 591 (defun indent-sexp (&optional endpos)
 592   "Indent each line of the list starting just after point.
 593 If optional arg ENDPOS is given, indent each line, stopping when
 594 ENDPOS is encountered."
 595   (interactive)
 596   (let ((indent-stack (list nil))
 597         (next-depth 0)
 598         ;; If ENDPOS is non-nil, use nil as STARTING-POINT
 599         ;; so that calculate-lisp-indent will find the beginning of
 600         ;; the defun we are in.
 601         ;; If ENDPOS is nil, it is safe not to scan before point
 602         ;; since every line we indent is more deeply nested than point is.
 603         (starting-point (if endpos nil (point)))
 604         (last-point (point))
 605         last-depth bol outer-loop-done inner-loop-done state this-indent)
 606     (or endpos
 607         ;; Get error now if we don't have a complete sexp after point.
 608         (save-excursion (forward-sexp 1)))
 609     (save-excursion
 610       (setq outer-loop-done nil)
 611       (while (if endpos (< (point) endpos)
 612                (not outer-loop-done))
 613         (setq last-depth next-depth
 614               inner-loop-done nil)
 615         ;; Parse this line so we can learn the state
 616         ;; to indent the next line.
 617         ;; This inner loop goes through only once
 618         ;; unless a line ends inside a string.
 619         (while (and (not inner-loop-done)
 620                     (not (setq outer-loop-done (eobp))))
 621           (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
 622                                           nil nil state))
 623           (setq next-depth (car state))
 624           ;; If the line contains a comment other than the sort
 625           ;; that is indented like code,
 626           ;; indent it now with indent-for-comment.
 627           ;; Comments indented like code are right already.
 628           ;; In any case clear the in-comment flag in the state
 629           ;; because parse-partial-sexp never sees the newlines.
 630           (if (car (nthcdr 4 state))
 631               (progn (indent-for-comment)
 632                      (end-of-line)
 633                      (setcar (nthcdr 4 state) nil)))
 634           ;; If this line ends inside a string,
 635           ;; go straight to next line, remaining within the inner loop,
 636           ;; and turn off the \-flag.
 637           (if (car (nthcdr 3 state))
 638               (progn
 639                 (forward-line 1)
 640                 (setcar (nthcdr 5 state) nil))
 641             (setq inner-loop-done t)))
 642         (and endpos
 643              (<= next-depth 0)
 644              (progn
 645                (setq indent-stack (append indent-stack
 646                                           (make-list (- next-depth) nil))
 647                      last-depth (- last-depth next-depth)
 648                      next-depth 0)))
 649         (or outer-loop-done endpos
 650             (setq outer-loop-done (<= next-depth 0)))
 651         (if outer-loop-done
 652             (forward-line 1)
 653           (while (> last-depth next-depth)
 654             (setq indent-stack (cdr indent-stack)
 655                   last-depth (1- last-depth)))
 656           (while (< last-depth next-depth)
 657             (setq indent-stack (cons nil indent-stack)
 658                   last-depth (1+ last-depth)))
 659           ;; Now go to the next line and indent it according
 660           ;; to what we learned from parsing the previous one.
 661           (forward-line 1)
 662           (setq bol (point))
 663           (skip-chars-forward " \t")
 664           ;; But not if the line is blank, or just a comment
 665           ;; (except for double-semi comments; indent them as usual).
 666           (if (or (eobp) (looking-at "\\s<\\|\n"))
 667               nil
 668             (if (and (car indent-stack)
 669                      (>= (car indent-stack) 0))
 670                 (setq this-indent (car indent-stack))
 671               (let ((val (calculate-lisp-indent
 672                           (if (car indent-stack) (- (car indent-stack))
 673                             starting-point))))
 674                 (if (integerp val)
 675                     (setcar indent-stack
 676                             (setq this-indent val))
 677                   (setcar indent-stack (- (car (cdr val))))
 678                   (setq this-indent (car val)))))
 679             (if (/= (current-column) this-indent)
 680                 (progn (delete-region bol (point))
 681                        (indent-to this-indent)))))
 682         (or outer-loop-done
 683             (setq outer-loop-done (= (point) last-point))
 684             (setq last-point (point)))))))
 685
 686 ;; Indent every line whose first char is between START and END inclusive.
 687 (defun lisp-indent-region (start end)
 688   (save-excursion
 689     (let ((endmark (copy-marker end)))
 690       (goto-char start)
 691       (and (bolp) (not (eolp))
 692            (lisp-indent-line))
 693       (indent-sexp endmark)
 694       (set-marker endmark nil))))
 695 \f
 696 ;;;; Lisp paragraph filling commands.
 697
 698 (defun lisp-fill-paragraph (&optional justify)
 699   "Like \\[fill-paragraph], but handle Emacs Lisp comments.
 700 If any of the current line is a comment, fill the comment or the
 701 paragraph of it that point is in, preserving the comment's indentation
 702 and initial semicolons."
 703   (interactive "P")
 704   (let (
 705         ;; Non-nil if the current line contains a comment.
 706         has-comment
 707
 708         ;; Non-nil if the current line contains code and a comment.
 709         has-code-and-comment
 710
 711         ;; If has-comment, the appropriate fill-prefix for the comment.
 712         comment-fill-prefix
 713         )
 714
 715     ;; Figure out what kind of comment we are looking at.
 716     (save-excursion
 717       (beginning-of-line)
 718       (cond
 719
 720        ;; A line with nothing but a comment on it?
 721        ((looking-at "[ \t]*;[; \t]*")
 722         (setq has-comment t
 723               comment-fill-prefix (buffer-substring (match-beginning 0)
 724                                                     (match-end 0))))
 725
 726        ;; A line with some code, followed by a comment?  Remember that the
 727        ;; semi which starts the comment shouldn't be part of a string or
 728        ;; character.
 729        ((condition-case nil
 730             (save-restriction
 731               (narrow-to-region (point-min)
 732                                 (save-excursion (end-of-line) (point)))
 733               (while (not (looking-at ";\\|$"))
 734                 (skip-chars-forward "^;\n\"\\\\?")
 735                 (cond
 736                  ((eq (char-after (point)) ?\\) (forward-char 2))
 737                  ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
 738               (looking-at ";+[\t ]*"))
 739           (error nil))
 740         (setq has-comment t has-code-and-comment t)
 741         (setq comment-fill-prefix
 742               (concat (make-string (/ (current-column) 8) ?\t)
 743                       (make-string (% (current-column) 8) ?\ )
 744                       (buffer-substring (match-beginning 0) (match-end 0)))))))
 745
 746     (if (not has-comment)
 747         (fill-paragraph justify)
 748
 749       ;; Narrow to include only the comment, and then fill the region.
 750       (save-excursion
 751         (save-restriction
 752           (beginning-of-line)
 753           (narrow-to-region
 754            ;; Find the first line we should include in the region to fill.
 755            (save-excursion
 756              (while (and (zerop (forward-line -1))
 757                          (looking-at "^[ \t]*;")))
 758              ;; We may have gone too far.  Go forward again.
 759              (or (looking-at ".*;")
 760                  (forward-line 1))
 761              (point))
 762            ;; Find the beginning of the first line past the region to fill.
 763            (save-excursion
 764              (while (progn (forward-line 1)
 765                            (looking-at "^[ \t]*;")))
 766              (point)))
 767
 768           ;; Lines with only semicolons on them can be paragraph boundaries.
 769           (let* ((paragraph-start (concat paragraph-start "\\|[ \t;]*$"))
 770                  (paragraph-separate (concat paragraph-start "\\|[ \t;]*$"))
 771                  (paragraph-ignore-fill-prefix nil)
 772                  (fill-prefix comment-fill-prefix)
 773                  (after-line (if has-code-and-comment
 774                                  (save-excursion
 775                                    (forward-line 1) (point))))
 776                  (end (progn
 777                         (forward-paragraph)
 778                         (or (bolp) (newline 1))
 779                         (point)))
 780                  ;; If this comment starts on a line with code,
 781                  ;; include that like in the filling.
 782                  (beg (progn (backward-paragraph)
 783                              (if (eq (point) after-line)
 784                                  (forward-line -1))
 785                              (point))))
 786             (fill-region-as-paragraph beg end
 787                                       justify nil
 788                                       (save-excursion
 789                                         (goto-char beg)
 790                                         (if (looking-at fill-prefix)
 791                                             nil
 792                                           (re-search-forward comment-start-skip)
 793                                           (point))))))))
 794     t))
 795 \f
 796 (defun indent-code-rigidly (start end arg &optional nochange-regexp)
 797   "Indent all lines of code, starting in the region, sideways by ARG columns.
 798 Does not affect lines starting inside comments or strings, assuming that
 799 the start of the region is not inside them.
 800
 801 Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
 802 The last is a regexp which, if matched at the beginning of a line,
 803 means don't indent that line."
 804   (interactive "r\np")
 805   (let (state)
 806     (save-excursion
 807       (goto-char end)
 808       (setq end (point-marker))
 809       (goto-char start)
 810       (or (bolp)
 811           (setq state (parse-partial-sexp (point)
 812                                           (progn
 813                                             (forward-line 1) (point))
 814                                           nil nil state)))
 815       (while (< (point) end)
 816         (or (car (nthcdr 3 state))
 817             (and nochange-regexp
 818                  (looking-at nochange-regexp))
 819             ;; If line does not start in string, indent it
 820             (let ((indent (current-indentation)))
 821               (delete-region (point) (progn (skip-chars-forward " \t") (point)))
 822               (or (eolp)
 823                   (indent-to (max 0 (+ indent arg)) 0))))
 824         (setq state (parse-partial-sexp (point)
 825                                         (progn
 826                                           (forward-line 1) (point))
 827                                         nil nil state))))))
 828
 829 (provide 'lisp-mode)
 830
 831 ;;; lisp-mode.el ends here