(best_matching_font): Abort for best == NULL before we start to use it.
[bpt/emacs.git] / lisp / emacs-lisp / lisp-mode.el
CommitLineData
55535639 1;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands
6594deb0 2
3731a850 3;; Copyright (C) 1985, 1986, 1999, 2000, 2001, 2002, 2003, 2004,
ceb4c4d3 4;; 2005, 2006 Free Software Foundation, Inc.
3a801d0c 5
e5167999 6;; Maintainer: FSF
fd7fa35a 7;; Keywords: lisp, languages
e5167999 8
a90256cc
BP
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
e5167999 13;; the Free Software Foundation; either version 2, or (at your option)
a90256cc
BP
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267 22;; along with GNU Emacs; see the file COPYING. If not, write to the
3a35cf56
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
a90256cc 25
e41b2db1
ER
26;;; Commentary:
27
28;; The base major mode for editing Lisp code (used also for Emacs Lisp).
535eadac 29;; This mode is documented in the Emacs manual.
e41b2db1
ER
30
31;;; Code:
32
e0f58980
JB
33(defvar font-lock-comment-face)
34(defvar font-lock-doc-face)
35(defvar font-lock-keywords-case-fold-search)
36(defvar font-lock-string-face)
37
535eadac 38(defvar lisp-mode-abbrev-table nil)
a90256cc 39
535eadac
DL
40(defvar emacs-lisp-mode-syntax-table
41 (let ((table (make-syntax-table)))
a90256cc 42 (let ((i 0))
a90256cc 43 (while (< i ?0)
535eadac 44 (modify-syntax-entry i "_ " table)
a90256cc
BP
45 (setq i (1+ i)))
46 (setq i (1+ ?9))
47 (while (< i ?A)
535eadac 48 (modify-syntax-entry i "_ " table)
a90256cc
BP
49 (setq i (1+ i)))
50 (setq i (1+ ?Z))
51 (while (< i ?a)
535eadac 52 (modify-syntax-entry i "_ " table)
a90256cc
BP
53 (setq i (1+ i)))
54 (setq i (1+ ?z))
55 (while (< i 128)
535eadac 56 (modify-syntax-entry i "_ " table)
a90256cc 57 (setq i (1+ i)))
e0f58980 58 (modify-syntax-entry ?\s " " table)
535eadac
DL
59 (modify-syntax-entry ?\t " " table)
60 (modify-syntax-entry ?\f " " table)
61 (modify-syntax-entry ?\n "> " table)
d95af087
SM
62 ;; This is probably obsolete since nowadays such features use overlays.
63 ;; ;; Give CR the same syntax as newline, for selective-display.
64 ;; (modify-syntax-entry ?\^m "> " table)
535eadac
DL
65 (modify-syntax-entry ?\; "< " table)
66 (modify-syntax-entry ?` "' " table)
67 (modify-syntax-entry ?' "' " table)
68 (modify-syntax-entry ?, "' " table)
592060ab 69 (modify-syntax-entry ?@ "' " table)
a90256cc 70 ;; Used to be singlequote; changed for flonums.
535eadac
DL
71 (modify-syntax-entry ?. "_ " table)
72 (modify-syntax-entry ?# "' " table)
73 (modify-syntax-entry ?\" "\" " table)
74 (modify-syntax-entry ?\\ "\\ " table)
75 (modify-syntax-entry ?\( "() " table)
76 (modify-syntax-entry ?\) ")( " table)
77 (modify-syntax-entry ?\[ "(] " table)
1d3529b6 78 (modify-syntax-entry ?\] ")[ " table))
535eadac
DL
79 table))
80
81(defvar lisp-mode-syntax-table
82 (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
535eadac
DL
83 (modify-syntax-entry ?\[ "_ " table)
84 (modify-syntax-entry ?\] "_ " table)
d95af087
SM
85 (modify-syntax-entry ?# "' 14b" table)
86 (modify-syntax-entry ?| "\" 23bn" table)
535eadac 87 table))
ecca85de 88
a90256cc
BP
89(define-abbrev-table 'lisp-mode-abbrev-table ())
90
6c2cf866 91(defvar lisp-imenu-generic-expression
535eadac 92 (list
ca2ddd8e 93 (list nil
d7f519ed
GM
94 (purecopy (concat "^\\s-*("
95 (eval-when-compile
96 (regexp-opt
97 '("defun" "defun*" "defsubst" "defmacro"
98 "defadvice" "define-skeleton"
3cbdd0c1
JL
99 "define-minor-mode" "define-global-minor-mode"
100 "define-derived-mode" "define-generic-mode"
d7f519ed
GM
101 "define-compiler-macro" "define-modify-macro"
102 "defsetf" "define-setf-expander"
103 "define-method-combination"
63b74e64 104 "defgeneric" "defmethod") t))
d20a1ebb 105 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
d7f519ed 106 2)
ca2ddd8e 107 (list (purecopy "Variables")
d7f519ed
GM
108 (purecopy (concat "^\\s-*("
109 (eval-when-compile
110 (regexp-opt
111 '("defvar" "defconst" "defconstant" "defcustom"
63b74e64 112 "defparameter" "define-symbol-macro") t))
d20a1ebb 113 "\\s-+\\(\\(\\sw\\|\\s_\\)+\\)"))
d7f519ed 114 2)
ca2ddd8e 115 (list (purecopy "Types")
d7f519ed
GM
116 (purecopy (concat "^\\s-*("
117 (eval-when-compile
118 (regexp-opt
e2cd29bd
JPW
119 '("defgroup" "deftheme" "deftype" "defstruct"
120 "defclass" "define-condition" "define-widget"
121 "defface" "defpackage") t))
d20a1ebb 122 "\\s-+'?\\(\\(\\sw\\|\\s_\\)+\\)"))
6c2cf866
KH
123 2))
124
125 "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
126
d7f519ed
GM
127;; This was originally in autoload.el and is still used there.
128(put 'autoload 'doc-string-elt 3)
129(put 'defun 'doc-string-elt 3)
130(put 'defun* 'doc-string-elt 3)
131(put 'defvar 'doc-string-elt 3)
132(put 'defcustom 'doc-string-elt 3)
e2cd29bd 133(put 'deftheme 'doc-string-elt 2)
d7f519ed
GM
134(put 'defconst 'doc-string-elt 3)
135(put 'defmacro 'doc-string-elt 3)
52c9b141 136(put 'defmacro* 'doc-string-elt 3)
d7f519ed 137(put 'defsubst 'doc-string-elt 3)
590bc48b 138(put 'defstruct 'doc-string-elt 2)
d7f519ed
GM
139(put 'define-skeleton 'doc-string-elt 2)
140(put 'define-derived-mode 'doc-string-elt 4)
2b0e738a 141(put 'define-compilation-mode 'doc-string-elt 3)
d7f519ed
GM
142(put 'easy-mmode-define-minor-mode 'doc-string-elt 2)
143(put 'define-minor-mode 'doc-string-elt 2)
3cbdd0c1
JL
144(put 'easy-mmode-define-global-mode 'doc-string-elt 2)
145(put 'define-global-minor-mode 'doc-string-elt 2)
d7f519ed 146(put 'define-generic-mode 'doc-string-elt 7)
e2cd29bd 147(put 'define-ibuffer-filter 'doc-string-elt 2)
f767db5b 148(put 'define-ibuffer-op 'doc-string-elt 3)
e2cd29bd 149(put 'define-ibuffer-sorter 'doc-string-elt 2)
f8ab1947 150(put 'lambda 'doc-string-elt 2)
8c6fac61
SM
151(put 'defalias 'doc-string-elt 3)
152(put 'defvaralias 'doc-string-elt 3)
153(put 'define-category 'doc-string-elt 2)
f8ab1947
SM
154
155(defvar lisp-doc-string-elt-property 'doc-string-elt
156 "The symbol property that holds the docstring position info.")
d7f519ed
GM
157
158(defun lisp-font-lock-syntactic-face-function (state)
159 (if (nth 3 state)
d95af087
SM
160 ;; This might be a (doc)string or a |...| symbol.
161 (let ((startpos (nth 8 state)))
162 (if (eq (char-after startpos) ?|)
163 ;; This is not a string, but a |...| symbol.
164 nil
165 (let* ((listbeg (nth 1 state))
166 (firstsym (and listbeg
167 (save-excursion
168 (goto-char listbeg)
169 (and (looking-at "([ \t\n]*\\(\\(\\sw\\|\\s_\\)+\\)")
170 (match-string 1)))))
171 (docelt (and firstsym (get (intern-soft firstsym)
172 lisp-doc-string-elt-property))))
173 (if (and docelt
174 ;; It's a string in a form that can have a docstring.
175 ;; Check whether it's in docstring position.
176 (save-excursion
177 (when (functionp docelt)
178 (goto-char (match-end 1))
179 (setq docelt (funcall docelt)))
180 (goto-char listbeg)
181 (forward-char 1)
182 (condition-case nil
183 (while (and (> docelt 0) (< (point) startpos)
184 (progn (forward-sexp 1) t))
185 (setq docelt (1- docelt)))
186 (error nil))
187 (and (zerop docelt) (<= (point) startpos)
188 (progn (forward-comment (point-max)) t)
189 (= (point) (nth 8 state)))))
190 font-lock-doc-face
191 font-lock-string-face))))
d7f519ed
GM
192 font-lock-comment-face))
193
194;; The LISP-SYNTAX argument is used by code in inf-lisp.el and is
195;; (uselessly) passed from pp.el, chistory.el, gnus-kill.el and score-mode.el
196(defun lisp-mode-variables (&optional lisp-syntax)
63b74e64
SM
197 (when lisp-syntax
198 (set-syntax-table lisp-mode-syntax-table))
a90256cc 199 (setq local-abbrev-table lisp-mode-abbrev-table)
a90256cc
BP
200 (make-local-variable 'paragraph-ignore-fill-prefix)
201 (setq paragraph-ignore-fill-prefix t)
35d132a8
RS
202 (make-local-variable 'fill-paragraph-function)
203 (setq fill-paragraph-function 'lisp-fill-paragraph)
c13ce396
SM
204 ;; Adaptive fill mode gets the fill wrong for a one-line paragraph made of
205 ;; a single docstring. Let's fix it here.
206 (set (make-local-variable 'adaptive-fill-function)
207 (lambda () (if (looking-at "\\s-+\"[^\n\"]+\"\\s-*$") "")))
3272c162
RS
208 ;; Adaptive fill mode gets in the way of auto-fill,
209 ;; and should make no difference for explicit fill
210 ;; because lisp-fill-paragraph should do the job.
63b74e64
SM
211 ;; I believe that newcomment's auto-fill code properly deals with it -stef
212 ;;(set (make-local-variable 'adaptive-fill-mode) nil)
a90256cc
BP
213 (make-local-variable 'indent-line-function)
214 (setq indent-line-function 'lisp-indent-line)
215 (make-local-variable 'indent-region-function)
216 (setq indent-region-function 'lisp-indent-region)
217 (make-local-variable 'parse-sexp-ignore-comments)
218 (setq parse-sexp-ignore-comments t)
5847f861 219 (make-local-variable 'outline-regexp)
43817a75 220 (setq outline-regexp ";;;\\(;* [^ \t\n]\\|###autoload\\)\\|(")
a8050bff
GM
221 (make-local-variable 'outline-level)
222 (setq outline-level 'lisp-outline-level)
a90256cc
BP
223 (make-local-variable 'comment-start)
224 (setq comment-start ";")
225 (make-local-variable 'comment-start-skip)
e56a043b
MB
226 ;; Look within the line for a ; following an even number of backslashes
227 ;; after either a non-backslash or the line beginning.
228 (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+ *")
76f41479
RS
229 (make-local-variable 'font-lock-comment-start-skip)
230 ;; Font lock mode uses this only when it KNOWS a comment is starting.
590bc48b 231 (setq font-lock-comment-start-skip ";+ *")
3f0c3d8b
SM
232 (make-local-variable 'comment-add)
233 (setq comment-add 1) ;default to `;;' in comment-region
a90256cc
BP
234 (make-local-variable 'comment-column)
235 (setq comment-column 40)
d8a8cbe2
SM
236 ;; Don't get confused by `;' in doc strings when paragraph-filling.
237 (set (make-local-variable 'comment-use-global-state) t)
6c2cf866 238 (make-local-variable 'imenu-generic-expression)
1d3529b6
KH
239 (setq imenu-generic-expression lisp-imenu-generic-expression)
240 (make-local-variable 'multibyte-syntax-as-symbol)
1594a23a 241 (setq multibyte-syntax-as-symbol t)
52cf5c37 242 (set (make-local-variable 'syntax-begin-function) 'beginning-of-defun)
1594a23a
SM
243 (setq font-lock-defaults
244 '((lisp-font-lock-keywords
245 lisp-font-lock-keywords-1 lisp-font-lock-keywords-2)
1b1556b1 246 nil nil (("+-*/.<>=!?$%_&~^:@" . "w")) nil
d7f519ed
GM
247 (font-lock-mark-block-function . mark-defun)
248 (font-lock-syntactic-face-function
249 . lisp-font-lock-syntactic-face-function))))
a8050bff
GM
250
251(defun lisp-outline-level ()
252 "Lisp mode `outline-level' function."
43817a75
LK
253 (let ((len (- (match-end 0) (match-beginning 0))))
254 (if (looking-at "(\\|;;;###autoload")
255 1000
256 len)))
ca2ddd8e 257
1594a23a
SM
258(defvar lisp-mode-shared-map
259 (let ((map (make-sparse-keymap)))
a25e82a8 260 (define-key map "\t" 'lisp-indent-line)
1594a23a
SM
261 (define-key map "\e\C-q" 'indent-sexp)
262 (define-key map "\177" 'backward-delete-char-untabify)
c1acacc4
EZ
263 ;; This gets in the way when viewing a Lisp file in view-mode. As
264 ;; long as [backspace] is mapped into DEL via the
265 ;; function-key-map, this should remain disabled!!
266 ;;;(define-key map [backspace] 'backward-delete-char-untabify)
1594a23a 267 map)
a90256cc
BP
268 "Keymap for commands shared by all sorts of Lisp modes.")
269
a90256cc
BP
270(defvar emacs-lisp-mode-map ()
271 "Keymap for Emacs Lisp mode.
99ec65b3 272All commands in `lisp-mode-shared-map' are inherited by this map.")
a90256cc
BP
273
274(if emacs-lisp-mode-map
275 ()
b3a3cb63 276 (let ((map (make-sparse-keymap "Emacs-Lisp")))
b8bc6df2 277 (setq emacs-lisp-mode-map (make-sparse-keymap))
99ec65b3 278 (set-keymap-parent emacs-lisp-mode-map lisp-mode-shared-map)
b3a3cb63
KH
279 (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
280 (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun)
889bfc7d 281 (define-key emacs-lisp-mode-map "\e\C-q" 'indent-pp-sexp)
b3a3cb63
KH
282 (define-key emacs-lisp-mode-map [menu-bar] (make-sparse-keymap))
283 (define-key emacs-lisp-mode-map [menu-bar emacs-lisp]
284 (cons "Emacs-Lisp" map))
285 (define-key map [edebug-defun]
286 '("Instrument Function for Debugging" . edebug-defun))
287 (define-key map [byte-recompile]
288 '("Byte-recompile Directory..." . byte-recompile-directory))
00e40cc9 289 (define-key map [emacs-byte-compile-and-load]
eaec854f 290 '("Byte-compile And Load" . emacs-lisp-byte-compile-and-load))
b3a3cb63
KH
291 (define-key map [byte-compile]
292 '("Byte-compile This File" . emacs-lisp-byte-compile))
293 (define-key map [separator-eval] '("--"))
294 (define-key map [eval-buffer] '("Evaluate Buffer" . eval-current-buffer))
295 (define-key map [eval-region] '("Evaluate Region" . eval-region))
296 (define-key map [eval-sexp] '("Evaluate Last S-expression" . eval-last-sexp))
297 (define-key map [separator-format] '("--"))
298 (define-key map [comment-region] '("Comment Out Region" . comment-region))
299 (define-key map [indent-region] '("Indent Region" . indent-region))
4b619eca
SM
300 (define-key map [indent-line] '("Indent Line" . lisp-indent-line))
301 (put 'eval-region 'menu-enable 'mark-active)
302 (put 'comment-region 'menu-enable 'mark-active)
303 (put 'indent-region 'menu-enable 'mark-active)))
b3a3cb63
KH
304
305(defun emacs-lisp-byte-compile ()
306 "Byte compile the file containing the current buffer."
307 (interactive)
308 (if buffer-file-name
309 (byte-compile-file buffer-file-name)
767a1151
KH
310 (error "The buffer must be saved in a file first")))
311
eaec854f 312(defun emacs-lisp-byte-compile-and-load ()
767a1151
KH
313 "Byte-compile the current file (if it has changed), then load compiled code."
314 (interactive)
315 (or buffer-file-name
316 (error "The buffer must be saved in a file first"))
317 (require 'bytecomp)
318 ;; Recompile if file or buffer has changed since last compilation.
eaec854f 319 (if (and (buffer-modified-p)
535eadac 320 (y-or-n-p (format "Save buffer %s first? " (buffer-name))))
eaec854f
SM
321 (save-buffer))
322 (let ((compiled-file-name (byte-compile-dest-file buffer-file-name)))
323 (if (file-newer-than-file-p compiled-file-name buffer-file-name)
324 (load-file compiled-file-name)
325 (byte-compile-file buffer-file-name t))))
a90256cc 326
e596094d
DL
327(defcustom emacs-lisp-mode-hook nil
328 "Hook run when entering Emacs Lisp mode."
535eadac 329 :options '(turn-on-eldoc-mode imenu-add-menubar-index checkdoc-minor-mode)
e596094d
DL
330 :type 'hook
331 :group 'lisp)
332
333(defcustom lisp-mode-hook nil
334 "Hook run when entering Lisp mode."
335 :options '(imenu-add-menubar-index)
336 :type 'hook
337 :group 'lisp)
338
339(defcustom lisp-interaction-mode-hook nil
340 "Hook run when entering Lisp Interaction mode."
341 :options '(turn-on-eldoc-mode)
342 :type 'hook
343 :group 'lisp)
344
dda7c010 345(defun emacs-lisp-mode ()
a90256cc
BP
346 "Major mode for editing Lisp code to run in Emacs.
347Commands:
348Delete converts tabs to spaces as it moves back.
349Blank lines separate paragraphs. Semicolons start comments.
350\\{emacs-lisp-mode-map}
351Entry to this mode calls the value of `emacs-lisp-mode-hook'
352if that value is non-nil."
dda7c010
RS
353 (interactive)
354 (kill-all-local-variables)
355 (use-local-map emacs-lisp-mode-map)
356 (set-syntax-table emacs-lisp-mode-syntax-table)
357 (setq major-mode 'emacs-lisp-mode)
358 (setq mode-name "Emacs-Lisp")
d7f519ed 359 (lisp-mode-variables)
dda7c010 360 (setq imenu-case-fold-search nil)
fb16e932 361 (run-mode-hooks 'emacs-lisp-mode-hook))
c689a61d 362(put 'emacs-lisp-mode 'custom-mode-group 'lisp)
a90256cc 363
535eadac
DL
364(defvar lisp-mode-map
365 (let ((map (make-sparse-keymap)))
99ec65b3 366 (set-keymap-parent map lisp-mode-shared-map)
535eadac
DL
367 (define-key map "\e\C-x" 'lisp-eval-defun)
368 (define-key map "\C-c\C-z" 'run-lisp)
369 map)
a90256cc 370 "Keymap for ordinary Lisp mode.
99ec65b3 371All commands in `lisp-mode-shared-map' are inherited by this map.")
a90256cc 372
dda7c010 373(defun lisp-mode ()
a90256cc
BP
374 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
375Commands:
376Delete converts tabs to spaces as it moves back.
377Blank lines separate paragraphs. Semicolons start comments.
378\\{lisp-mode-map}
379Note that `run-lisp' may be used either to start an inferior Lisp job
380or to switch back to an existing one.
381
382Entry to this mode calls the value of `lisp-mode-hook'
383if that value is non-nil."
dda7c010
RS
384 (interactive)
385 (kill-all-local-variables)
386 (use-local-map lisp-mode-map)
387 (setq major-mode 'lisp-mode)
388 (setq mode-name "Lisp")
d7f519ed 389 (lisp-mode-variables)
dda7c010
RS
390 (make-local-variable 'comment-start-skip)
391 (setq comment-start-skip
d7f519ed 392 "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\)\\(;+\\|#|\\) *")
dda7c010
RS
393 (make-local-variable 'font-lock-keywords-case-fold-search)
394 (setq font-lock-keywords-case-fold-search t)
395 (setq imenu-case-fold-search t)
396 (set-syntax-table lisp-mode-syntax-table)
fb16e932 397 (run-mode-hooks 'lisp-mode-hook))
59de4ad0
SS
398(put 'lisp-mode 'find-tag-default-function 'lisp-find-tag-default)
399
400(defun lisp-find-tag-default ()
401 (let ((default (find-tag-default)))
402 (when (stringp default)
403 (if (string-match ":+" default)
404 (substring default (match-end 0))
ea2e9f8d 405 default))))
a90256cc 406
60b2e60d
DL
407;; Used in old LispM code.
408(defalias 'common-lisp-mode 'lisp-mode)
409
5e871da0
DL
410;; This will do unless inf-lisp.el is loaded.
411(defun lisp-eval-defun (&optional and-go)
a90256cc
BP
412 "Send the current defun to the Lisp process made by \\[run-lisp]."
413 (interactive)
414 (error "Process lisp does not exist"))
415
535eadac
DL
416(defvar lisp-interaction-mode-map
417 (let ((map (make-sparse-keymap)))
99ec65b3 418 (set-keymap-parent map lisp-mode-shared-map)
535eadac 419 (define-key map "\e\C-x" 'eval-defun)
889bfc7d 420 (define-key map "\e\C-q" 'indent-pp-sexp)
535eadac
DL
421 (define-key map "\e\t" 'lisp-complete-symbol)
422 (define-key map "\n" 'eval-print-last-sexp)
423 map)
bacd83a7 424 "Keymap for Lisp Interaction mode.
99ec65b3 425All commands in `lisp-mode-shared-map' are inherited by this map.")
a90256cc 426
52cf5c37 427(defvar lisp-interaction-mode-abbrev-table lisp-mode-abbrev-table)
1594a23a 428(define-derived-mode lisp-interaction-mode emacs-lisp-mode "Lisp Interaction"
a90256cc
BP
429 "Major mode for typing and evaluating Lisp forms.
430Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
431before point, and prints its value into the buffer, advancing point.
c9be79b0 432Note that printing is controlled by `eval-expression-print-length'
94f8f5d3 433and `eval-expression-print-level'.
a90256cc
BP
434
435Commands:
436Delete converts tabs to spaces as it moves back.
437Paragraphs are separated only by blank lines.
438Semicolons start comments.
439\\{lisp-interaction-mode-map}
440Entry to this mode calls the value of `lisp-interaction-mode-hook'
52cf5c37 441if that value is non-nil.")
a90256cc 442
121f0d57 443(defun eval-print-last-sexp ()
343462ed
EZ
444 "Evaluate sexp before point; print value into current buffer.
445
a8d78e0d
RS
446If `eval-expression-debug-on-error' is non-nil, which is the default,
447this command arranges for all errors to enter the debugger.
448
343462ed
EZ
449Note that printing the result is controlled by the variables
450`eval-expression-print-length' and `eval-expression-print-level',
451which see."
121f0d57 452 (interactive)
f798d950
JB
453 (let ((standard-output (current-buffer)))
454 (terpri)
455 (eval-last-sexp t)
456 (terpri)))
ca2ddd8e 457
5f096255 458
cb79ea64
GM
459(defun last-sexp-setup-props (beg end value alt1 alt2)
460 "Set up text properties for the output of `eval-last-sexp-1'.
461BEG and END are the start and end of the output in current-buffer.
a1506d29 462VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
cb79ea64
GM
463alternative printed representations that can be displayed."
464 (let ((map (make-sparse-keymap)))
465 (define-key map "\C-m" 'last-sexp-toggle-display)
466 (define-key map [down-mouse-2] 'mouse-set-point)
467 (define-key map [mouse-2] 'last-sexp-toggle-display)
468 (add-text-properties
a1506d29 469 beg end
cb79ea64 470 `(printed-value (,value ,alt1 ,alt2)
a1506d29 471 mouse-face highlight
cb79ea64
GM
472 keymap ,map
473 help-echo "RET, mouse-2: toggle abbreviated display"
474 rear-nonsticky (mouse-face keymap help-echo
475 printed-value)))))
476
477
98996d89 478(defun last-sexp-toggle-display (&optional arg)
cb79ea64 479 "Toggle between abbreviated and unabbreviated printed representations."
98996d89 480 (interactive "P")
3b8d36f1
RS
481 (save-restriction
482 (widen)
98996d89
RS
483 (let ((value (get-text-property (point) 'printed-value)))
484 (when value
485 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
486 'printed-value)
487 (point)))
488 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
489 (standard-output (current-buffer))
490 (point (point)))
491 (delete-region beg end)
492 (insert (nth 1 value))
493 (last-sexp-setup-props beg (point)
494 (nth 0 value)
495 (nth 2 value)
496 (nth 1 value))
497 (goto-char (min (point-max) point)))))))
5f096255 498
c689a61d
SM
499(defun prin1-char (char)
500 "Return a string representing CHAR as a character rather than as an integer.
501If CHAR is not a character, return nil."
502 (and (integerp char)
7a439904 503 (eventp char)
87fdf320 504 (let ((c (event-basic-type char))
4f4ce597
RS
505 (mods (event-modifiers char))
506 string)
87fdf320
RS
507 ;; Prevent ?A from turning into ?\S-a.
508 (if (and (memq 'shift mods)
4f4ce597 509 (zerop (logand char ?\S-\^@))
87fdf320
RS
510 (not (let ((case-fold-search nil))
511 (char-equal c (upcase c)))))
512 (setq c (upcase c) mods nil))
4f4ce597
RS
513 ;; What string are we considering using?
514 (condition-case nil
515 (setq string
516 (concat
517 "?"
518 (mapconcat
519 (lambda (modif)
520 (cond ((eq modif 'super) "\\s-")
521 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
522 mods "")
523 (cond
524 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
525 ((eq c 127) "\\C-?")
526 (t
527 (string c)))))
528 (error nil))
529 ;; Verify the string reads a CHAR, not to some other character.
530 ;; If it doesn't, return nil instead.
531 (and string
532 (= (car (read-from-string string)) char)
533 string))))
2b0e738a 534
c689a61d 535
99c6d63b 536(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
a90256cc
BP
537 "Evaluate sexp before point; print value in minibuffer.
538With argument, print output into current buffer."
99c6d63b 539 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
efb195f0
RS
540 (let ((value
541 (eval (let ((stab (syntax-table))
361721f2 542 (opoint (point))
05e94d32 543 ignore-quotes
361721f2 544 expr)
c4e2d791
RS
545 (save-excursion
546 (with-syntax-table emacs-lisp-mode-syntax-table
547 ;; If this sexp appears to be enclosed in `...'
548 ;; then ignore the surrounding quotes.
549 (setq ignore-quotes
550 (or (eq (following-char) ?\')
551 (eq (preceding-char) ?\')))
552 (forward-sexp -1)
553 ;; If we were after `?\e' (or similar case),
554 ;; use the whole thing, not just the `e'.
555 (when (eq (preceding-char) ?\\)
556 (forward-char -1)
557 (when (eq (preceding-char) ??)
558 (forward-char -1)))
559
560 ;; Skip over `#N='s.
561 (when (eq (preceding-char) ?=)
562 (let (labeled-p)
563 (save-excursion
564 (skip-chars-backward "0-9#=")
565 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
566 (when labeled-p
567 (forward-sexp -1))))
568
569 (save-restriction
570 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
571 ;; `variable' so that the value is returned, not the
572 ;; name
573 (if (and ignore-quotes
574 (eq (following-char) ?`))
575 (forward-char))
576 (narrow-to-region (point-min) opoint)
577 (setq expr (read (current-buffer)))
578 ;; If it's an (interactive ...) form, it's more
579 ;; useful to show how an interactive call would
580 ;; use it.
581 (and (consp expr)
582 (eq (car expr) 'interactive)
583 (setq expr
584 (list 'call-interactively
585 (list 'quote
586 (list 'lambda
587 '(&rest args)
588 expr
589 'args)))))
590 expr)))))))
606f5e75
RS
591 (eval-last-sexp-print-value value))))
592
593(defun eval-last-sexp-print-value (value)
594 (let ((unabbreviated (let ((print-length nil) (print-level nil))
595 (prin1-to-string value)))
596 (print-length eval-expression-print-length)
597 (print-level eval-expression-print-level)
606f5e75
RS
598 (beg (point))
599 end)
600 (prog1
601 (prin1 value)
152472ba
RS
602 (let ((str (eval-expression-print-format value)))
603 (if str (princ str)))
606f5e75
RS
604 (setq end (point))
605 (when (and (bufferp standard-output)
606 (or (not (null print-length))
607 (not (null print-level)))
608 (not (string= unabbreviated
609 (buffer-substring-no-properties beg end))))
610 (last-sexp-setup-props beg end value
611 unabbreviated
612 (buffer-substring-no-properties beg end))
613 ))))
5f096255 614
a90256cc 615
06f308a7
RS
616(defvar eval-last-sexp-fake-value (make-symbol "t"))
617
99c6d63b
GM
618(defun eval-last-sexp (eval-last-sexp-arg-internal)
619 "Evaluate sexp before point; print value in minibuffer.
a8d78e0d
RS
620Interactively, with prefix argument, print output into current buffer.
621
622If `eval-expression-debug-on-error' is non-nil, which is the default,
623this command arranges for all errors to enter the debugger."
99c6d63b
GM
624 (interactive "P")
625 (if (null eval-expression-debug-on-error)
626 (eval-last-sexp-1 eval-last-sexp-arg-internal)
06f308a7 627 (let ((old-value eval-last-sexp-fake-value) new-value value)
99c6d63b
GM
628 (let ((debug-on-error old-value))
629 (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
630 (setq new-value debug-on-error))
631 (unless (eq old-value new-value)
632 (setq debug-on-error new-value))
633 value)))
ca2ddd8e 634
151a410a 635(defun eval-defun-1 (form)
217297f8
JL
636 "Treat some expressions specially.
637Reset the `defvar' and `defcustom' variables to the initial value.
638Reinitialize the face according to the `defface' specification."
99ec65b3
DL
639 ;; The code in edebug-defun should be consistent with this, but not
640 ;; the same, since this gets a macroexpended form.
726e8778
RS
641 (cond ((not (listp form))
642 form)
643 ((and (eq (car form) 'defvar)
c689a61d
SM
644 (cdr-safe (cdr-safe form))
645 (boundp (cadr form)))
646 ;; Force variable to be re-set.
647 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
f9475d97 648 (setq-default ,(nth 1 form) ,(nth 2 form))))
5e871da0
DL
649 ;; `defcustom' is now macroexpanded to
650 ;; `custom-declare-variable' with a quoted value arg.
535eadac
DL
651 ((and (eq (car form) 'custom-declare-variable)
652 (default-boundp (eval (nth 1 form))))
151a410a 653 ;; Force variable to be bound.
5e871da0 654 (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
151a410a 655 form)
217297f8
JL
656 ;; `defface' is macroexpanded to `custom-declare-face'.
657 ((eq (car form) 'custom-declare-face)
658 ;; Reset the face.
217297f8
JL
659 (setq face-new-frame-defaults
660 (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
a416b892
JL
661 (put (eval (nth 1 form)) 'face-defface-spec nil)
662 ;; Setting `customized-face' to the new spec after calling
663 ;; the form, but preserving the old saved spec in `saved-face',
664 ;; imitates the situation when the new face spec is set
665 ;; temporarily for the current session in the customize
666 ;; buffer, thus allowing `face-user-default-spec' to use the
667 ;; new customized spec instead of the saved spec.
668 ;; Resetting `saved-face' temporarily to nil is needed to let
669 ;; `defface' change the spec, regardless of a saved spec.
670 (prog1 `(prog1 ,form
2a0c538b 671 (put ,(nth 1 form) 'saved-face
a416b892 672 ',(get (eval (nth 1 form)) 'saved-face))
2a0c538b
JL
673 (put ,(nth 1 form) 'customized-face
674 ,(nth 2 form)))
a416b892 675 (put (eval (nth 1 form)) 'saved-face nil)))
151a410a
RS
676 ((eq (car form) 'progn)
677 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
678 (t form)))
679
105d6be1 680(defun eval-defun-2 ()
121f0d57 681 "Evaluate defun that point is in or before.
ebc03d28
KH
682The value is displayed in the minibuffer.
683If the current defun is actually a call to `defvar',
684then reset the variable using the initial value expression
685even if the variable already has some other value.
686\(Normally `defvar' does not change the variable's value
687if it already has a value.\)
688
2298f9f7
KH
689With argument, insert value in current buffer after the defun.
690Return the result of evaluation."
a90256cc 691 (interactive "P")
efb195f0
RS
692 (let ((debug-on-error eval-expression-debug-on-error)
693 (print-length eval-expression-print-length)
694 (print-level eval-expression-print-level))
695 (save-excursion
696 ;; Arrange for eval-region to "read" the (possibly) altered form.
697 ;; eval-region handles recording which file defines a function or
698 ;; variable. Re-written using `apply' to avoid capturing
699 ;; variables like `end'.
700 (apply
ca2ddd8e 701 #'eval-region
105d6be1 702 (let ((standard-output t)
efb195f0
RS
703 beg end form)
704 ;; Read the form from the buffer, and record where it ends.
705 (save-excursion
706 (end-of-defun)
707 (beginning-of-defun)
708 (setq beg (point))
709 (setq form (read (current-buffer)))
710 (setq end (point)))
217297f8 711 ;; Alter the form if necessary.
efb195f0
RS
712 (setq form (eval-defun-1 (macroexpand form)))
713 (list beg end standard-output
714 `(lambda (ignore)
715 ;; Skipping to the end of the specified region
716 ;; will make eval-region return.
717 (goto-char ,end)
718 ',form))))))
713c3fb1
DL
719 ;; The result of evaluation has been put onto VALUES. So return it.
720 (car values))
99c6d63b 721
105d6be1
GM
722(defun eval-defun (edebug-it)
723 "Evaluate the top-level form containing point, or after point.
99c6d63b 724
46f90d0f
RS
725If the current defun is actually a call to `defvar' or `defcustom',
726evaluating it this way resets the variable using its initial value
727expression even if the variable already has some other value.
728\(Normally `defvar' and `defcustom' do not alter the value if there
729already is one.)
105d6be1 730
a8d78e0d
RS
731If `eval-expression-debug-on-error' is non-nil, which is the default,
732this command arranges for all errors to enter the debugger.
733
105d6be1
GM
734With a prefix argument, instrument the code for Edebug.
735
736If acting on a `defun' for FUNCTION, and the function was
737instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
738instrumented, just FUNCTION is printed.
739
740If not acting on a `defun', the result of evaluation is displayed in
343462ed
EZ
741the minibuffer. This display is controlled by the variables
742`eval-expression-print-length' and `eval-expression-print-level',
743which see."
99c6d63b 744 (interactive "P")
105d6be1
GM
745 (cond (edebug-it
746 (require 'edebug)
747 (eval-defun (not edebug-all-defs)))
748 (t
749 (if (null eval-expression-debug-on-error)
750 (eval-defun-2)
751 (let ((old-value (make-symbol "t")) new-value value)
752 (let ((debug-on-error old-value))
753 (setq value (eval-defun-2))
754 (setq new-value debug-on-error))
755 (unless (eq old-value new-value)
756 (setq debug-on-error new-value))
757 value)))))
5a3859e6
SM
758
759;; May still be used by some external Lisp-mode variant.
760(define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default)
a90256cc 761
63b74e64
SM
762;; This function just forces a more costly detection of comments (using
763;; parse-partial-sexp from beginning-of-defun). I.e. It avoids the problem of
764;; taking a `;' inside a string started on another line for a comment starter.
4f9d8764
SM
765;; Note: `newcomment' gets it right now since we set comment-use-global-state
766;; so we could get rid of it. -stef
7eb67d79
RS
767(defun lisp-mode-auto-fill ()
768 (if (> (current-column) (current-fill-column))
769 (if (save-excursion
52cf5c37 770 (nth 4 (syntax-ppss (point))))
7eb67d79 771 (do-auto-fill)
52cf5c37
SM
772 (unless (and (boundp 'comment-auto-fill-only-comments)
773 comment-auto-fill-only-comments)
774 (let ((comment-start nil) (comment-start-skip nil))
775 (do-auto-fill))))))
7eb67d79 776
cada28bb
EZ
777(defvar lisp-indent-offset nil
778 "If non-nil, indent second line of expressions that many more columns.")
535eadac 779(defvar lisp-indent-function 'lisp-indent-function)
a90256cc
BP
780
781(defun lisp-indent-line (&optional whole-exp)
782 "Indent current line as Lisp code.
783With argument, indent any additional lines of the same expression
784rigidly along with this one."
785 (interactive "P")
d7f519ed
GM
786 (let ((indent (calculate-lisp-indent)) shift-amt end
787 (pos (- (point-max) (point)))
788 (beg (progn (beginning-of-line) (point))))
a90256cc 789 (skip-chars-forward " \t")
531cbff1
RS
790 (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
791 ;; Don't alter indentation of a ;;; comment line
792 ;; or a line that starts in a string.
328561fc 793 (goto-char (- (point-max) pos))
a90256cc
BP
794 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
795 ;; Single-semicolon comment lines should be indented
796 ;; as comment lines, not as code.
797 (progn (indent-for-comment) (forward-char -1))
798 (if (listp indent) (setq indent (car indent)))
799 (setq shift-amt (- indent (current-column)))
800 (if (zerop shift-amt)
801 nil
802 (delete-region beg (point))
803 (indent-to indent)))
804 ;; If initial point was within line's indentation,
805 ;; position after the indentation. Else stay at same point in text.
806 (if (> (- (point-max) pos) (point))
807 (goto-char (- (point-max) pos)))
808 ;; If desired, shift remaining lines of expression the same amount.
809 (and whole-exp (not (zerop shift-amt))
810 (save-excursion
811 (goto-char beg)
812 (forward-sexp 1)
813 (setq end (point))
814 (goto-char beg)
815 (forward-line 1)
816 (setq beg (point))
817 (> end beg))
818 (indent-code-rigidly beg end shift-amt)))))
819
22486a7f 820(defvar calculate-lisp-indent-last-sexp)
c0df1d61 821
a90256cc
BP
822(defun calculate-lisp-indent (&optional parse-start)
823 "Return appropriate indentation for current line as Lisp code.
824In usual case returns an integer: the column to indent to.
531cbff1
RS
825If the value is nil, that means don't change the indentation
826because the line starts inside a string.
827
828The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).
a90256cc 829This means that following lines at the same level of indentation
531cbff1
RS
830should not necessarily be indented the same as this line.
831Then COLUMN is the column to indent to, and CONTAINING-SEXP-START
832is the buffer position of the start of the containing expression."
a90256cc
BP
833 (save-excursion
834 (beginning-of-line)
835 (let ((indent-point (point))
836 state paren-depth
837 ;; setting this to a number inhibits calling hook
838 (desired-indent nil)
839 (retry t)
c0df1d61 840 calculate-lisp-indent-last-sexp containing-sexp)
a90256cc
BP
841 (if parse-start
842 (goto-char parse-start)
843 (beginning-of-defun))
844 ;; Find outermost containing sexp
845 (while (< (point) indent-point)
846 (setq state (parse-partial-sexp (point) indent-point 0)))
847 ;; Find innermost containing sexp
848 (while (and retry
849 state
850 (> (setq paren-depth (elt state 0)) 0))
851 (setq retry nil)
c0df1d61 852 (setq calculate-lisp-indent-last-sexp (elt state 2))
a90256cc
BP
853 (setq containing-sexp (elt state 1))
854 ;; Position following last unclosed open.
855 (goto-char (1+ containing-sexp))
856 ;; Is there a complete sexp since then?
c0df1d61
RS
857 (if (and calculate-lisp-indent-last-sexp
858 (> calculate-lisp-indent-last-sexp (point)))
a90256cc 859 ;; Yes, but is there a containing sexp after that?
c0df1d61
RS
860 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
861 indent-point 0)))
a90256cc
BP
862 (if (setq retry (car (cdr peek))) (setq state peek)))))
863 (if retry
864 nil
865 ;; Innermost containing sexp found
866 (goto-char (1+ containing-sexp))
c0df1d61 867 (if (not calculate-lisp-indent-last-sexp)
a90256cc
BP
868 ;; indent-point immediately follows open paren.
869 ;; Don't call hook.
870 (setq desired-indent (current-column))
871 ;; Find the start of first element of containing sexp.
c0df1d61 872 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
a90256cc
BP
873 (cond ((looking-at "\\s(")
874 ;; First element of containing sexp is a list.
875 ;; Indent under that list.
876 )
877 ((> (save-excursion (forward-line 1) (point))
c0df1d61 878 calculate-lisp-indent-last-sexp)
a90256cc
BP
879 ;; This is the first line to start within the containing sexp.
880 ;; It's almost certainly a function call.
c0df1d61 881 (if (= (point) calculate-lisp-indent-last-sexp)
a90256cc
BP
882 ;; Containing sexp has nothing before this line
883 ;; except the first element. Indent under that element.
884 nil
885 ;; Skip the first element, find start of second (the first
886 ;; argument of the function call) and indent under.
887 (progn (forward-sexp 1)
c0df1d61
RS
888 (parse-partial-sexp (point)
889 calculate-lisp-indent-last-sexp
890 0 t)))
a90256cc
BP
891 (backward-prefix-chars))
892 (t
c0df1d61 893 ;; Indent beneath first sexp on same line as
535eadac 894 ;; `calculate-lisp-indent-last-sexp'. Again, it's
c0df1d61
RS
895 ;; almost certainly a function call.
896 (goto-char calculate-lisp-indent-last-sexp)
a90256cc 897 (beginning-of-line)
c0df1d61
RS
898 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
899 0 t)
a90256cc
BP
900 (backward-prefix-chars)))))
901 ;; Point is at the point to indent under unless we are inside a string.
eb8c3be9 902 ;; Call indentation hook except when overridden by lisp-indent-offset
a90256cc
BP
903 ;; or if the desired indentation has already been computed.
904 (let ((normal-indent (current-column)))
905 (cond ((elt state 3)
906 ;; Inside a string, don't change indentation.
531cbff1 907 nil)
a90256cc
BP
908 ((and (integerp lisp-indent-offset) containing-sexp)
909 ;; Indent by constant offset
910 (goto-char containing-sexp)
911 (+ (current-column) lisp-indent-offset))
912 (desired-indent)
913 ((and (boundp 'lisp-indent-function)
914 lisp-indent-function
915 (not retry))
916 (or (funcall lisp-indent-function indent-point state)
917 normal-indent))
918 (t
f30ff39f 919 normal-indent))))))
a90256cc
BP
920
921(defun lisp-indent-function (indent-point state)
9fefa08b
RS
922 "This function is the normal value of the variable `lisp-indent-function'.
923It is used when indenting a line within a function call, to see if the
924called function says anything special about how to indent the line.
925
926INDENT-POINT is the position where the user typed TAB, or equivalent.
927Point is located at the point to indent under (for default indentation);
928STATE is the `parse-partial-sexp' state for that position.
929
930If the current line is in a call to a Lisp function
931which has a non-nil property `lisp-indent-function',
932that specifies how to do the indentation. The property value can be
933* `defun', meaning indent `defun'-style;
934* an integer N, meaning indent the first N arguments specially
b961eb0e
TTN
935 like ordinary function arguments and then indent any further
936 arguments like a body;
9fefa08b 937* a function to call just as this function was called.
cc08f5b2
TTN
938 If that function returns nil, that means it doesn't specify
939 the indentation.
9fefa08b
RS
940
941This function also returns nil meaning don't specify the indentation."
a90256cc
BP
942 (let ((normal-indent (current-column)))
943 (goto-char (1+ (elt state 1)))
c0df1d61 944 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
a90256cc
BP
945 (if (and (elt state 2)
946 (not (looking-at "\\sw\\|\\s_")))
4696802b 947 ;; car of form doesn't seem to be a symbol
a90256cc
BP
948 (progn
949 (if (not (> (save-excursion (forward-line 1) (point))
c0df1d61 950 calculate-lisp-indent-last-sexp))
c689a61d
SM
951 (progn (goto-char calculate-lisp-indent-last-sexp)
952 (beginning-of-line)
953 (parse-partial-sexp (point)
954 calculate-lisp-indent-last-sexp 0 t)))
955 ;; Indent under the list or under the first sexp on the same
956 ;; line as calculate-lisp-indent-last-sexp. Note that first
957 ;; thing on that line has to be complete sexp since we are
c0df1d61 958 ;; inside the innermost containing sexp.
a90256cc
BP
959 (backward-prefix-chars)
960 (current-column))
961 (let ((function (buffer-substring (point)
962 (progn (forward-sexp 1) (point))))
963 method)
2dab7802
RS
964 (setq method (or (get (intern-soft function) 'lisp-indent-function)
965 (get (intern-soft function) 'lisp-indent-hook)))
a90256cc
BP
966 (cond ((or (eq method 'defun)
967 (and (null method)
968 (> (length function) 3)
969 (string-match "\\`def" function)))
970 (lisp-indent-defform state indent-point))
971 ((integerp method)
972 (lisp-indent-specform method state
973 indent-point normal-indent))
974 (method
cc08f5b2 975 (funcall method indent-point state)))))))
a90256cc 976
d7fa5aa2 977(defvar lisp-body-indent 2
ab69b2fb 978 "Number of columns to indent the second line of a `(def...)' form.")
a90256cc
BP
979
980(defun lisp-indent-specform (count state indent-point normal-indent)
981 (let ((containing-form-start (elt state 1))
982 (i count)
983 body-indent containing-form-column)
984 ;; Move to the start of containing form, calculate indentation
985 ;; to use for non-distinguished forms (> count), and move past the
986 ;; function symbol. lisp-indent-function guarantees that there is at
987 ;; least one word or symbol character following open paren of containing
988 ;; form.
989 (goto-char containing-form-start)
990 (setq containing-form-column (current-column))
991 (setq body-indent (+ lisp-body-indent containing-form-column))
992 (forward-char 1)
993 (forward-sexp 1)
994 ;; Now find the start of the last form.
995 (parse-partial-sexp (point) indent-point 1 t)
996 (while (and (< (point) indent-point)
997 (condition-case ()
998 (progn
999 (setq count (1- count))
1000 (forward-sexp 1)
1001 (parse-partial-sexp (point) indent-point 1 t))
1002 (error nil))))
1003 ;; Point is sitting on first character of last (or count) sexp.
1004 (if (> count 0)
1005 ;; A distinguished form. If it is the first or second form use double
1006 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound
1007 ;; to 2 (the default), this just happens to work the same with if as
1008 ;; the older code, but it makes unwind-protect, condition-case,
1009 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,
1010 ;; less hacked, behavior can be obtained by replacing below with
1011 ;; (list normal-indent containing-form-start).
1012 (if (<= (- i count) 1)
1013 (list (+ containing-form-column (* 2 lisp-body-indent))
1014 containing-form-start)
1015 (list normal-indent containing-form-start))
1016 ;; A non-distinguished form. Use body-indent if there are no
1017 ;; distinguished forms and this is the first undistinguished form,
1018 ;; or if this is the first undistinguished form and the preceding
1019 ;; distinguished form has indentation at least as great as body-indent.
1020 (if (or (and (= i 0) (= count 0))
1021 (and (= count 0) (<= body-indent normal-indent)))
1022 body-indent
1023 normal-indent))))
1024
1025(defun lisp-indent-defform (state indent-point)
1026 (goto-char (car (cdr state)))
1027 (forward-line 1)
1028 (if (> (point) (car (cdr (cdr state))))
1029 (progn
1030 (goto-char (car (cdr state)))
1031 (+ lisp-body-indent (current-column)))))
1032
ca2ddd8e 1033
a90256cc
BP
1034;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
1035;; like defun if the first form is placed on the next line, otherwise
1036;; it is indented like any other form (i.e. forms line up under first).
1037
1038(put 'lambda 'lisp-indent-function 'defun)
1039(put 'autoload 'lisp-indent-function 'defun)
1040(put 'progn 'lisp-indent-function 0)
1041(put 'prog1 'lisp-indent-function 1)
1042(put 'prog2 'lisp-indent-function 2)
1043(put 'save-excursion 'lisp-indent-function 0)
1044(put 'save-window-excursion 'lisp-indent-function 0)
4b619eca 1045(put 'save-selected-window 'lisp-indent-function 0)
a90256cc 1046(put 'save-restriction 'lisp-indent-function 0)
cfe158ab 1047(put 'save-match-data 'lisp-indent-function 0)
38f16fe1 1048(put 'save-current-buffer 'lisp-indent-function 0)
54c014f0 1049(put 'with-current-buffer 'lisp-indent-function 1)
488a0b05 1050(put 'combine-after-change-calls 'lisp-indent-function 0)
38f16fe1 1051(put 'with-output-to-string 'lisp-indent-function 0)
08adb099 1052(put 'with-temp-file 'lisp-indent-function 1)
e0119683 1053(put 'with-temp-buffer 'lisp-indent-function 0)
bacd83a7 1054(put 'with-temp-message 'lisp-indent-function 1)
83c8f461 1055(put 'with-syntax-table 'lisp-indent-function 1)
a90256cc
BP
1056(put 'let 'lisp-indent-function 1)
1057(put 'let* 'lisp-indent-function 1)
1058(put 'while 'lisp-indent-function 1)
1059(put 'if 'lisp-indent-function 2)
0a88ae7b 1060(put 'read-if 'lisp-indent-function 2)
a90256cc
BP
1061(put 'catch 'lisp-indent-function 1)
1062(put 'condition-case 'lisp-indent-function 2)
1063(put 'unwind-protect 'lisp-indent-function 1)
1064(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
b6b4c8bd 1065(put 'eval-after-load 'lisp-indent-function 1)
05c71036
DL
1066(put 'dolist 'lisp-indent-function 1)
1067(put 'dotimes 'lisp-indent-function 1)
1068(put 'when 'lisp-indent-function 1)
1069(put 'unless 'lisp-indent-function 1)
a90256cc
BP
1070
1071(defun indent-sexp (&optional endpos)
1072 "Indent each line of the list starting just after point.
1073If optional arg ENDPOS is given, indent each line, stopping when
1074ENDPOS is encountered."
1075 (interactive)
daa37602
JB
1076 (let ((indent-stack (list nil))
1077 (next-depth 0)
33f268ec
RS
1078 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
1079 ;; so that calculate-lisp-indent will find the beginning of
1080 ;; the defun we are in.
1081 ;; If ENDPOS is nil, it is safe not to scan before point
1082 ;; since every line we indent is more deeply nested than point is.
1083 (starting-point (if endpos nil (point)))
daa37602
JB
1084 (last-point (point))
1085 last-depth bol outer-loop-done inner-loop-done state this-indent)
33f268ec
RS
1086 (or endpos
1087 ;; Get error now if we don't have a complete sexp after point.
1088 (save-excursion (forward-sexp 1)))
a90256cc
BP
1089 (save-excursion
1090 (setq outer-loop-done nil)
1091 (while (if endpos (< (point) endpos)
1092 (not outer-loop-done))
1093 (setq last-depth next-depth
1094 inner-loop-done nil)
1095 ;; Parse this line so we can learn the state
1096 ;; to indent the next line.
1097 ;; This inner loop goes through only once
1098 ;; unless a line ends inside a string.
1099 (while (and (not inner-loop-done)
1100 (not (setq outer-loop-done (eobp))))
1101 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
1102 nil nil state))
1103 (setq next-depth (car state))
1104 ;; If the line contains a comment other than the sort
1105 ;; that is indented like code,
1106 ;; indent it now with indent-for-comment.
1107 ;; Comments indented like code are right already.
1108 ;; In any case clear the in-comment flag in the state
1109 ;; because parse-partial-sexp never sees the newlines.
1110 (if (car (nthcdr 4 state))
1111 (progn (indent-for-comment)
1112 (end-of-line)
1113 (setcar (nthcdr 4 state) nil)))
1114 ;; If this line ends inside a string,
1115 ;; go straight to next line, remaining within the inner loop,
1116 ;; and turn off the \-flag.
1117 (if (car (nthcdr 3 state))
1118 (progn
1119 (forward-line 1)
1120 (setcar (nthcdr 5 state) nil))
1121 (setq inner-loop-done t)))
1122 (and endpos
daa37602
JB
1123 (<= next-depth 0)
1124 (progn
99ec65b3
DL
1125 (setq indent-stack (nconc indent-stack
1126 (make-list (- next-depth) nil))
daa37602
JB
1127 last-depth (- last-depth next-depth)
1128 next-depth 0)))
33f268ec 1129 (or outer-loop-done endpos
a90256cc
BP
1130 (setq outer-loop-done (<= next-depth 0)))
1131 (if outer-loop-done
1f5038b5 1132 (forward-line 1)
a90256cc
BP
1133 (while (> last-depth next-depth)
1134 (setq indent-stack (cdr indent-stack)
1135 last-depth (1- last-depth)))
1136 (while (< last-depth next-depth)
1137 (setq indent-stack (cons nil indent-stack)
1138 last-depth (1+ last-depth)))
1139 ;; Now go to the next line and indent it according
1140 ;; to what we learned from parsing the previous one.
1141 (forward-line 1)
1142 (setq bol (point))
1143 (skip-chars-forward " \t")
1144 ;; But not if the line is blank, or just a comment
1145 ;; (except for double-semi comments; indent them as usual).
1146 (if (or (eobp) (looking-at "\\s<\\|\n"))
1147 nil
1148 (if (and (car indent-stack)
1149 (>= (car indent-stack) 0))
1150 (setq this-indent (car indent-stack))
1151 (let ((val (calculate-lisp-indent
1152 (if (car indent-stack) (- (car indent-stack))
daa37602 1153 starting-point))))
531cbff1
RS
1154 (if (null val)
1155 (setq this-indent val)
1156 (if (integerp val)
1157 (setcar indent-stack
1158 (setq this-indent val))
1159 (setcar indent-stack (- (car (cdr val))))
1160 (setq this-indent (car val))))))
1161 (if (and this-indent (/= (current-column) this-indent))
a90256cc
BP
1162 (progn (delete-region bol (point))
1163 (indent-to this-indent)))))
1164 (or outer-loop-done
1165 (setq outer-loop-done (= (point) last-point))
1166 (setq last-point (point)))))))
1167
a90256cc 1168(defun lisp-indent-region (start end)
535eadac 1169 "Indent every line whose first char is between START and END inclusive."
a90256cc 1170 (save-excursion
a90256cc 1171 (let ((endmark (copy-marker end)))
33f268ec
RS
1172 (goto-char start)
1173 (and (bolp) (not (eolp))
1174 (lisp-indent-line))
a90256cc
BP
1175 (indent-sexp endmark)
1176 (set-marker endmark nil))))
ca2ddd8e 1177
889bfc7d 1178(defun indent-pp-sexp (&optional arg)
5a77048a
RS
1179 "Indent each line of the list starting just after point, or prettyprint it.
1180A prefix argument specifies pretty-printing."
889bfc7d
JL
1181 (interactive "P")
1182 (if arg
1183 (save-excursion
1184 (save-restriction
1185 (narrow-to-region (point) (progn (forward-sexp 1) (point)))
1186 (pp-buffer)
1187 (goto-char (point-max))
1188 (if (eq (char-before) ?\n)
1189 (delete-char -1)))))
1190 (indent-sexp))
1191
6338c7ba
JB
1192;;;; Lisp paragraph filling commands.
1193
3e8737bf
MS
1194(defcustom emacs-lisp-docstring-fill-column 65
1195 "Value of `fill-column' to use when filling a docstring.
1196Any non-integer value means do not use a different value of
1197`fill-column' when filling docstrings."
1198 :type '(choice (integer)
1199 (const :tag "Use the current `fill-column'" t))
1200 :group 'lisp)
1201
6338c7ba 1202(defun lisp-fill-paragraph (&optional justify)
3e8737bf 1203 "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
6338c7ba
JB
1204If any of the current line is a comment, fill the comment or the
1205paragraph of it that point is in, preserving the comment's indentation
1206and initial semicolons."
1207 (interactive "P")
833815e8 1208 (or (fill-comment-paragraph justify)
cd9d9561
SM
1209 ;; Since fill-comment-paragraph returned nil, that means we're not in
1210 ;; a comment: Point is on a program line; we are interested
3e8737bf
MS
1211 ;; particularly in docstring lines.
1212 ;;
1213 ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They
1214 ;; are buffer-local, but we avoid changing them so that they can be set
1215 ;; to make `forward-paragraph' and friends do something the user wants.
1216 ;;
1217 ;; `paragraph-start': The `(' in the character alternative and the
1218 ;; left-singlequote plus `(' sequence after the \\| alternative prevent
1219 ;; sexps and backquoted sexps that follow a docstring from being filled
1220 ;; with the docstring. This setting has the consequence of inhibiting
1221 ;; filling many program lines that are not docstrings, which is sensible,
1222 ;; because the user probably asked to fill program lines by accident, or
1223 ;; expecting indentation (perhaps we should try to do indenting in that
1224 ;; case). The `;' and `:' stop the paragraph being filled at following
1225 ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are
1226 ;; escaped to keep font-locking, filling, & paren matching in the source
1227 ;; file happy.
1228 ;;
1229 ;; `paragraph-separate': A clever regexp distinguishes the first line of
1230 ;; a docstring and identifies it as a paragraph separator, so that it
1231 ;; won't be filled. (Since the first line of documentation stands alone
1232 ;; in some contexts, filling should not alter the contents the author has
1233 ;; chosen.) Only the first line of a docstring begins with whitespace
1234 ;; and a quotation mark and ends with a period or (rarely) a comma.
1235 ;;
1236 ;; The `fill-column' is temporarily bound to
1237 ;; `emacs-lisp-docstring-fill-column' if that value is an integer.
833815e8 1238 (let ((paragraph-start (concat paragraph-start
cd9d9561 1239 "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
833815e8 1240 (paragraph-separate
3e8737bf
MS
1241 (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
1242 (fill-column (if (integerp emacs-lisp-docstring-fill-column)
1243 emacs-lisp-docstring-fill-column
1244 fill-column)))
833815e8
SM
1245 (fill-paragraph justify))
1246 ;; Never return nil.
1247 t))
ca2ddd8e 1248
a90256cc
BP
1249(defun indent-code-rigidly (start end arg &optional nochange-regexp)
1250 "Indent all lines of code, starting in the region, sideways by ARG columns.
1251Does not affect lines starting inside comments or strings, assuming that
1252the start of the region is not inside them.
1253
1254Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
1255The last is a regexp which, if matched at the beginning of a line,
1256means don't indent that line."
1257 (interactive "r\np")
1258 (let (state)
1259 (save-excursion
1260 (goto-char end)
1261 (setq end (point-marker))
1262 (goto-char start)
1263 (or (bolp)
1264 (setq state (parse-partial-sexp (point)
1265 (progn
1266 (forward-line 1) (point))
1267 nil nil state)))
1268 (while (< (point) end)
1269 (or (car (nthcdr 3 state))
1270 (and nochange-regexp
1271 (looking-at nochange-regexp))
1272 ;; If line does not start in string, indent it
1273 (let ((indent (current-indentation)))
1274 (delete-region (point) (progn (skip-chars-forward " \t") (point)))
1275 (or (eolp)
1276 (indent-to (max 0 (+ indent arg)) 0))))
1277 (setq state (parse-partial-sexp (point)
1278 (progn
1279 (forward-line 1) (point))
1280 nil nil state))))))
49116ac0
JB
1281
1282(provide 'lisp-mode)
1283
cd9d9561 1284;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
6594deb0 1285;;; lisp-mode.el ends here