Merged from emacs@sv.gnu.org
[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
446Note that printing the result is controlled by the variables
447`eval-expression-print-length' and `eval-expression-print-level',
448which see."
121f0d57 449 (interactive)
f798d950
JB
450 (let ((standard-output (current-buffer)))
451 (terpri)
452 (eval-last-sexp t)
453 (terpri)))
ca2ddd8e 454
5f096255 455
cb79ea64
GM
456(defun last-sexp-setup-props (beg end value alt1 alt2)
457 "Set up text properties for the output of `eval-last-sexp-1'.
458BEG and END are the start and end of the output in current-buffer.
a1506d29 459VALUE is the Lisp value printed, ALT1 and ALT2 are strings for the
cb79ea64
GM
460alternative printed representations that can be displayed."
461 (let ((map (make-sparse-keymap)))
462 (define-key map "\C-m" 'last-sexp-toggle-display)
463 (define-key map [down-mouse-2] 'mouse-set-point)
464 (define-key map [mouse-2] 'last-sexp-toggle-display)
465 (add-text-properties
a1506d29 466 beg end
cb79ea64 467 `(printed-value (,value ,alt1 ,alt2)
a1506d29 468 mouse-face highlight
cb79ea64
GM
469 keymap ,map
470 help-echo "RET, mouse-2: toggle abbreviated display"
471 rear-nonsticky (mouse-face keymap help-echo
472 printed-value)))))
473
474
98996d89 475(defun last-sexp-toggle-display (&optional arg)
cb79ea64 476 "Toggle between abbreviated and unabbreviated printed representations."
98996d89 477 (interactive "P")
3b8d36f1
RS
478 (save-restriction
479 (widen)
98996d89
RS
480 (let ((value (get-text-property (point) 'printed-value)))
481 (when value
482 (let ((beg (or (previous-single-property-change (min (point-max) (1+ (point)))
483 'printed-value)
484 (point)))
485 (end (or (next-single-char-property-change (point) 'printed-value) (point)))
486 (standard-output (current-buffer))
487 (point (point)))
488 (delete-region beg end)
489 (insert (nth 1 value))
490 (last-sexp-setup-props beg (point)
491 (nth 0 value)
492 (nth 2 value)
493 (nth 1 value))
494 (goto-char (min (point-max) point)))))))
5f096255 495
c689a61d
SM
496(defun prin1-char (char)
497 "Return a string representing CHAR as a character rather than as an integer.
498If CHAR is not a character, return nil."
499 (and (integerp char)
7a439904 500 (eventp char)
87fdf320 501 (let ((c (event-basic-type char))
4f4ce597
RS
502 (mods (event-modifiers char))
503 string)
87fdf320
RS
504 ;; Prevent ?A from turning into ?\S-a.
505 (if (and (memq 'shift mods)
4f4ce597 506 (zerop (logand char ?\S-\^@))
87fdf320
RS
507 (not (let ((case-fold-search nil))
508 (char-equal c (upcase c)))))
509 (setq c (upcase c) mods nil))
4f4ce597
RS
510 ;; What string are we considering using?
511 (condition-case nil
512 (setq string
513 (concat
514 "?"
515 (mapconcat
516 (lambda (modif)
517 (cond ((eq modif 'super) "\\s-")
518 (t (string ?\\ (upcase (aref (symbol-name modif) 0)) ?-))))
519 mods "")
520 (cond
521 ((memq c '(?\; ?\( ?\) ?\{ ?\} ?\[ ?\] ?\" ?\' ?\\)) (string ?\\ c))
522 ((eq c 127) "\\C-?")
523 (t
524 (string c)))))
525 (error nil))
526 ;; Verify the string reads a CHAR, not to some other character.
527 ;; If it doesn't, return nil instead.
528 (and string
529 (= (car (read-from-string string)) char)
530 string))))
2b0e738a 531
c689a61d 532
99c6d63b 533(defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
a90256cc
BP
534 "Evaluate sexp before point; print value in minibuffer.
535With argument, print output into current buffer."
99c6d63b 536 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
efb195f0
RS
537 (let ((value
538 (eval (let ((stab (syntax-table))
361721f2 539 (opoint (point))
05e94d32 540 ignore-quotes
361721f2 541 expr)
c4e2d791
RS
542 (save-excursion
543 (with-syntax-table emacs-lisp-mode-syntax-table
544 ;; If this sexp appears to be enclosed in `...'
545 ;; then ignore the surrounding quotes.
546 (setq ignore-quotes
547 (or (eq (following-char) ?\')
548 (eq (preceding-char) ?\')))
549 (forward-sexp -1)
550 ;; If we were after `?\e' (or similar case),
551 ;; use the whole thing, not just the `e'.
552 (when (eq (preceding-char) ?\\)
553 (forward-char -1)
554 (when (eq (preceding-char) ??)
555 (forward-char -1)))
556
557 ;; Skip over `#N='s.
558 (when (eq (preceding-char) ?=)
559 (let (labeled-p)
560 (save-excursion
561 (skip-chars-backward "0-9#=")
562 (setq labeled-p (looking-at "\\(#[0-9]+=\\)+")))
563 (when labeled-p
564 (forward-sexp -1))))
565
566 (save-restriction
567 ;; vladimir@cs.ualberta.ca 30-Jul-1997: skip ` in
568 ;; `variable' so that the value is returned, not the
569 ;; name
570 (if (and ignore-quotes
571 (eq (following-char) ?`))
572 (forward-char))
573 (narrow-to-region (point-min) opoint)
574 (setq expr (read (current-buffer)))
575 ;; If it's an (interactive ...) form, it's more
576 ;; useful to show how an interactive call would
577 ;; use it.
578 (and (consp expr)
579 (eq (car expr) 'interactive)
580 (setq expr
581 (list 'call-interactively
582 (list 'quote
583 (list 'lambda
584 '(&rest args)
585 expr
586 'args)))))
587 expr)))))))
606f5e75
RS
588 (eval-last-sexp-print-value value))))
589
590(defun eval-last-sexp-print-value (value)
591 (let ((unabbreviated (let ((print-length nil) (print-level nil))
592 (prin1-to-string value)))
593 (print-length eval-expression-print-length)
594 (print-level eval-expression-print-level)
606f5e75
RS
595 (beg (point))
596 end)
597 (prog1
598 (prin1 value)
152472ba
RS
599 (let ((str (eval-expression-print-format value)))
600 (if str (princ str)))
606f5e75
RS
601 (setq end (point))
602 (when (and (bufferp standard-output)
603 (or (not (null print-length))
604 (not (null print-level)))
605 (not (string= unabbreviated
606 (buffer-substring-no-properties beg end))))
607 (last-sexp-setup-props beg end value
608 unabbreviated
609 (buffer-substring-no-properties beg end))
610 ))))
5f096255 611
a90256cc 612
06f308a7
RS
613(defvar eval-last-sexp-fake-value (make-symbol "t"))
614
99c6d63b
GM
615(defun eval-last-sexp (eval-last-sexp-arg-internal)
616 "Evaluate sexp before point; print value in minibuffer.
0202508f 617Interactively, with prefix argument, print output into current buffer."
99c6d63b
GM
618 (interactive "P")
619 (if (null eval-expression-debug-on-error)
620 (eval-last-sexp-1 eval-last-sexp-arg-internal)
06f308a7 621 (let ((old-value eval-last-sexp-fake-value) new-value value)
99c6d63b
GM
622 (let ((debug-on-error old-value))
623 (setq value (eval-last-sexp-1 eval-last-sexp-arg-internal))
624 (setq new-value debug-on-error))
625 (unless (eq old-value new-value)
626 (setq debug-on-error new-value))
627 value)))
ca2ddd8e 628
151a410a 629(defun eval-defun-1 (form)
217297f8
JL
630 "Treat some expressions specially.
631Reset the `defvar' and `defcustom' variables to the initial value.
632Reinitialize the face according to the `defface' specification."
99ec65b3
DL
633 ;; The code in edebug-defun should be consistent with this, but not
634 ;; the same, since this gets a macroexpended form.
726e8778
RS
635 (cond ((not (listp form))
636 form)
637 ((and (eq (car form) 'defvar)
c689a61d
SM
638 (cdr-safe (cdr-safe form))
639 (boundp (cadr form)))
640 ;; Force variable to be re-set.
641 `(progn (defvar ,(nth 1 form) nil ,@(nthcdr 3 form))
f9475d97 642 (setq-default ,(nth 1 form) ,(nth 2 form))))
5e871da0
DL
643 ;; `defcustom' is now macroexpanded to
644 ;; `custom-declare-variable' with a quoted value arg.
535eadac
DL
645 ((and (eq (car form) 'custom-declare-variable)
646 (default-boundp (eval (nth 1 form))))
151a410a 647 ;; Force variable to be bound.
5e871da0 648 (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form))))
151a410a 649 form)
217297f8
JL
650 ;; `defface' is macroexpanded to `custom-declare-face'.
651 ((eq (car form) 'custom-declare-face)
652 ;; Reset the face.
217297f8
JL
653 (setq face-new-frame-defaults
654 (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults))
a416b892
JL
655 (put (eval (nth 1 form)) 'face-defface-spec nil)
656 ;; Setting `customized-face' to the new spec after calling
657 ;; the form, but preserving the old saved spec in `saved-face',
658 ;; imitates the situation when the new face spec is set
659 ;; temporarily for the current session in the customize
660 ;; buffer, thus allowing `face-user-default-spec' to use the
661 ;; new customized spec instead of the saved spec.
662 ;; Resetting `saved-face' temporarily to nil is needed to let
663 ;; `defface' change the spec, regardless of a saved spec.
664 (prog1 `(prog1 ,form
2a0c538b 665 (put ,(nth 1 form) 'saved-face
a416b892 666 ',(get (eval (nth 1 form)) 'saved-face))
2a0c538b
JL
667 (put ,(nth 1 form) 'customized-face
668 ,(nth 2 form)))
a416b892 669 (put (eval (nth 1 form)) 'saved-face nil)))
151a410a
RS
670 ((eq (car form) 'progn)
671 (cons 'progn (mapcar 'eval-defun-1 (cdr form))))
672 (t form)))
673
105d6be1 674(defun eval-defun-2 ()
121f0d57 675 "Evaluate defun that point is in or before.
ebc03d28
KH
676The value is displayed in the minibuffer.
677If the current defun is actually a call to `defvar',
678then reset the variable using the initial value expression
679even if the variable already has some other value.
680\(Normally `defvar' does not change the variable's value
681if it already has a value.\)
682
2298f9f7
KH
683With argument, insert value in current buffer after the defun.
684Return the result of evaluation."
a90256cc 685 (interactive "P")
efb195f0
RS
686 (let ((debug-on-error eval-expression-debug-on-error)
687 (print-length eval-expression-print-length)
688 (print-level eval-expression-print-level))
689 (save-excursion
690 ;; Arrange for eval-region to "read" the (possibly) altered form.
691 ;; eval-region handles recording which file defines a function or
692 ;; variable. Re-written using `apply' to avoid capturing
693 ;; variables like `end'.
694 (apply
ca2ddd8e 695 #'eval-region
105d6be1 696 (let ((standard-output t)
efb195f0
RS
697 beg end form)
698 ;; Read the form from the buffer, and record where it ends.
699 (save-excursion
700 (end-of-defun)
701 (beginning-of-defun)
702 (setq beg (point))
703 (setq form (read (current-buffer)))
704 (setq end (point)))
217297f8 705 ;; Alter the form if necessary.
efb195f0
RS
706 (setq form (eval-defun-1 (macroexpand form)))
707 (list beg end standard-output
708 `(lambda (ignore)
709 ;; Skipping to the end of the specified region
710 ;; will make eval-region return.
711 (goto-char ,end)
712 ',form))))))
713c3fb1
DL
713 ;; The result of evaluation has been put onto VALUES. So return it.
714 (car values))
99c6d63b 715
105d6be1
GM
716(defun eval-defun (edebug-it)
717 "Evaluate the top-level form containing point, or after point.
99c6d63b 718
46f90d0f
RS
719If the current defun is actually a call to `defvar' or `defcustom',
720evaluating it this way resets the variable using its initial value
721expression even if the variable already has some other value.
722\(Normally `defvar' and `defcustom' do not alter the value if there
723already is one.)
105d6be1
GM
724
725With a prefix argument, instrument the code for Edebug.
726
727If acting on a `defun' for FUNCTION, and the function was
728instrumented, `Edebug: FUNCTION' is printed in the minibuffer. If not
729instrumented, just FUNCTION is printed.
730
731If not acting on a `defun', the result of evaluation is displayed in
343462ed
EZ
732the minibuffer. This display is controlled by the variables
733`eval-expression-print-length' and `eval-expression-print-level',
734which see."
99c6d63b 735 (interactive "P")
105d6be1
GM
736 (cond (edebug-it
737 (require 'edebug)
738 (eval-defun (not edebug-all-defs)))
739 (t
740 (if (null eval-expression-debug-on-error)
741 (eval-defun-2)
742 (let ((old-value (make-symbol "t")) new-value value)
743 (let ((debug-on-error old-value))
744 (setq value (eval-defun-2))
745 (setq new-value debug-on-error))
746 (unless (eq old-value new-value)
747 (setq debug-on-error new-value))
748 value)))))
5a3859e6
SM
749
750;; May still be used by some external Lisp-mode variant.
751(define-obsolete-function-alias 'lisp-comment-indent 'comment-indent-default)
a90256cc 752
63b74e64
SM
753;; This function just forces a more costly detection of comments (using
754;; parse-partial-sexp from beginning-of-defun). I.e. It avoids the problem of
755;; taking a `;' inside a string started on another line for a comment starter.
4f9d8764
SM
756;; Note: `newcomment' gets it right now since we set comment-use-global-state
757;; so we could get rid of it. -stef
7eb67d79
RS
758(defun lisp-mode-auto-fill ()
759 (if (> (current-column) (current-fill-column))
760 (if (save-excursion
52cf5c37 761 (nth 4 (syntax-ppss (point))))
7eb67d79 762 (do-auto-fill)
52cf5c37
SM
763 (unless (and (boundp 'comment-auto-fill-only-comments)
764 comment-auto-fill-only-comments)
765 (let ((comment-start nil) (comment-start-skip nil))
766 (do-auto-fill))))))
7eb67d79 767
cada28bb
EZ
768(defvar lisp-indent-offset nil
769 "If non-nil, indent second line of expressions that many more columns.")
535eadac 770(defvar lisp-indent-function 'lisp-indent-function)
a90256cc
BP
771
772(defun lisp-indent-line (&optional whole-exp)
773 "Indent current line as Lisp code.
774With argument, indent any additional lines of the same expression
775rigidly along with this one."
776 (interactive "P")
d7f519ed
GM
777 (let ((indent (calculate-lisp-indent)) shift-amt end
778 (pos (- (point-max) (point)))
779 (beg (progn (beginning-of-line) (point))))
a90256cc 780 (skip-chars-forward " \t")
531cbff1
RS
781 (if (or (null indent) (looking-at "\\s<\\s<\\s<"))
782 ;; Don't alter indentation of a ;;; comment line
783 ;; or a line that starts in a string.
328561fc 784 (goto-char (- (point-max) pos))
a90256cc
BP
785 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
786 ;; Single-semicolon comment lines should be indented
787 ;; as comment lines, not as code.
788 (progn (indent-for-comment) (forward-char -1))
789 (if (listp indent) (setq indent (car indent)))
790 (setq shift-amt (- indent (current-column)))
791 (if (zerop shift-amt)
792 nil
793 (delete-region beg (point))
794 (indent-to indent)))
795 ;; If initial point was within line's indentation,
796 ;; position after the indentation. Else stay at same point in text.
797 (if (> (- (point-max) pos) (point))
798 (goto-char (- (point-max) pos)))
799 ;; If desired, shift remaining lines of expression the same amount.
800 (and whole-exp (not (zerop shift-amt))
801 (save-excursion
802 (goto-char beg)
803 (forward-sexp 1)
804 (setq end (point))
805 (goto-char beg)
806 (forward-line 1)
807 (setq beg (point))
808 (> end beg))
809 (indent-code-rigidly beg end shift-amt)))))
810
22486a7f 811(defvar calculate-lisp-indent-last-sexp)
c0df1d61 812
a90256cc
BP
813(defun calculate-lisp-indent (&optional parse-start)
814 "Return appropriate indentation for current line as Lisp code.
815In usual case returns an integer: the column to indent to.
531cbff1
RS
816If the value is nil, that means don't change the indentation
817because the line starts inside a string.
818
819The value can also be a list of the form (COLUMN CONTAINING-SEXP-START).
a90256cc 820This means that following lines at the same level of indentation
531cbff1
RS
821should not necessarily be indented the same as this line.
822Then COLUMN is the column to indent to, and CONTAINING-SEXP-START
823is the buffer position of the start of the containing expression."
a90256cc
BP
824 (save-excursion
825 (beginning-of-line)
826 (let ((indent-point (point))
827 state paren-depth
828 ;; setting this to a number inhibits calling hook
829 (desired-indent nil)
830 (retry t)
c0df1d61 831 calculate-lisp-indent-last-sexp containing-sexp)
a90256cc
BP
832 (if parse-start
833 (goto-char parse-start)
834 (beginning-of-defun))
835 ;; Find outermost containing sexp
836 (while (< (point) indent-point)
837 (setq state (parse-partial-sexp (point) indent-point 0)))
838 ;; Find innermost containing sexp
839 (while (and retry
840 state
841 (> (setq paren-depth (elt state 0)) 0))
842 (setq retry nil)
c0df1d61 843 (setq calculate-lisp-indent-last-sexp (elt state 2))
a90256cc
BP
844 (setq containing-sexp (elt state 1))
845 ;; Position following last unclosed open.
846 (goto-char (1+ containing-sexp))
847 ;; Is there a complete sexp since then?
c0df1d61
RS
848 (if (and calculate-lisp-indent-last-sexp
849 (> calculate-lisp-indent-last-sexp (point)))
a90256cc 850 ;; Yes, but is there a containing sexp after that?
c0df1d61
RS
851 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
852 indent-point 0)))
a90256cc
BP
853 (if (setq retry (car (cdr peek))) (setq state peek)))))
854 (if retry
855 nil
856 ;; Innermost containing sexp found
857 (goto-char (1+ containing-sexp))
c0df1d61 858 (if (not calculate-lisp-indent-last-sexp)
a90256cc
BP
859 ;; indent-point immediately follows open paren.
860 ;; Don't call hook.
861 (setq desired-indent (current-column))
862 ;; Find the start of first element of containing sexp.
c0df1d61 863 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
a90256cc
BP
864 (cond ((looking-at "\\s(")
865 ;; First element of containing sexp is a list.
866 ;; Indent under that list.
867 )
868 ((> (save-excursion (forward-line 1) (point))
c0df1d61 869 calculate-lisp-indent-last-sexp)
a90256cc
BP
870 ;; This is the first line to start within the containing sexp.
871 ;; It's almost certainly a function call.
c0df1d61 872 (if (= (point) calculate-lisp-indent-last-sexp)
a90256cc
BP
873 ;; Containing sexp has nothing before this line
874 ;; except the first element. Indent under that element.
875 nil
876 ;; Skip the first element, find start of second (the first
877 ;; argument of the function call) and indent under.
878 (progn (forward-sexp 1)
c0df1d61
RS
879 (parse-partial-sexp (point)
880 calculate-lisp-indent-last-sexp
881 0 t)))
a90256cc
BP
882 (backward-prefix-chars))
883 (t
c0df1d61 884 ;; Indent beneath first sexp on same line as
535eadac 885 ;; `calculate-lisp-indent-last-sexp'. Again, it's
c0df1d61
RS
886 ;; almost certainly a function call.
887 (goto-char calculate-lisp-indent-last-sexp)
a90256cc 888 (beginning-of-line)
c0df1d61
RS
889 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
890 0 t)
a90256cc
BP
891 (backward-prefix-chars)))))
892 ;; Point is at the point to indent under unless we are inside a string.
eb8c3be9 893 ;; Call indentation hook except when overridden by lisp-indent-offset
a90256cc
BP
894 ;; or if the desired indentation has already been computed.
895 (let ((normal-indent (current-column)))
896 (cond ((elt state 3)
897 ;; Inside a string, don't change indentation.
531cbff1 898 nil)
a90256cc
BP
899 ((and (integerp lisp-indent-offset) containing-sexp)
900 ;; Indent by constant offset
901 (goto-char containing-sexp)
902 (+ (current-column) lisp-indent-offset))
903 (desired-indent)
904 ((and (boundp 'lisp-indent-function)
905 lisp-indent-function
906 (not retry))
907 (or (funcall lisp-indent-function indent-point state)
908 normal-indent))
909 (t
f30ff39f 910 normal-indent))))))
a90256cc
BP
911
912(defun lisp-indent-function (indent-point state)
9fefa08b
RS
913 "This function is the normal value of the variable `lisp-indent-function'.
914It is used when indenting a line within a function call, to see if the
915called function says anything special about how to indent the line.
916
917INDENT-POINT is the position where the user typed TAB, or equivalent.
918Point is located at the point to indent under (for default indentation);
919STATE is the `parse-partial-sexp' state for that position.
920
921If the current line is in a call to a Lisp function
922which has a non-nil property `lisp-indent-function',
923that specifies how to do the indentation. The property value can be
924* `defun', meaning indent `defun'-style;
925* an integer N, meaning indent the first N arguments specially
b961eb0e
TTN
926 like ordinary function arguments and then indent any further
927 arguments like a body;
9fefa08b 928* a function to call just as this function was called.
cc08f5b2
TTN
929 If that function returns nil, that means it doesn't specify
930 the indentation.
9fefa08b
RS
931
932This function also returns nil meaning don't specify the indentation."
a90256cc
BP
933 (let ((normal-indent (current-column)))
934 (goto-char (1+ (elt state 1)))
c0df1d61 935 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
a90256cc
BP
936 (if (and (elt state 2)
937 (not (looking-at "\\sw\\|\\s_")))
4696802b 938 ;; car of form doesn't seem to be a symbol
a90256cc
BP
939 (progn
940 (if (not (> (save-excursion (forward-line 1) (point))
c0df1d61 941 calculate-lisp-indent-last-sexp))
c689a61d
SM
942 (progn (goto-char calculate-lisp-indent-last-sexp)
943 (beginning-of-line)
944 (parse-partial-sexp (point)
945 calculate-lisp-indent-last-sexp 0 t)))
946 ;; Indent under the list or under the first sexp on the same
947 ;; line as calculate-lisp-indent-last-sexp. Note that first
948 ;; thing on that line has to be complete sexp since we are
c0df1d61 949 ;; inside the innermost containing sexp.
a90256cc
BP
950 (backward-prefix-chars)
951 (current-column))
952 (let ((function (buffer-substring (point)
953 (progn (forward-sexp 1) (point))))
954 method)
2dab7802
RS
955 (setq method (or (get (intern-soft function) 'lisp-indent-function)
956 (get (intern-soft function) 'lisp-indent-hook)))
a90256cc
BP
957 (cond ((or (eq method 'defun)
958 (and (null method)
959 (> (length function) 3)
960 (string-match "\\`def" function)))
961 (lisp-indent-defform state indent-point))
962 ((integerp method)
963 (lisp-indent-specform method state
964 indent-point normal-indent))
965 (method
cc08f5b2 966 (funcall method indent-point state)))))))
a90256cc 967
d7fa5aa2 968(defvar lisp-body-indent 2
ab69b2fb 969 "Number of columns to indent the second line of a `(def...)' form.")
a90256cc
BP
970
971(defun lisp-indent-specform (count state indent-point normal-indent)
972 (let ((containing-form-start (elt state 1))
973 (i count)
974 body-indent containing-form-column)
975 ;; Move to the start of containing form, calculate indentation
976 ;; to use for non-distinguished forms (> count), and move past the
977 ;; function symbol. lisp-indent-function guarantees that there is at
978 ;; least one word or symbol character following open paren of containing
979 ;; form.
980 (goto-char containing-form-start)
981 (setq containing-form-column (current-column))
982 (setq body-indent (+ lisp-body-indent containing-form-column))
983 (forward-char 1)
984 (forward-sexp 1)
985 ;; Now find the start of the last form.
986 (parse-partial-sexp (point) indent-point 1 t)
987 (while (and (< (point) indent-point)
988 (condition-case ()
989 (progn
990 (setq count (1- count))
991 (forward-sexp 1)
992 (parse-partial-sexp (point) indent-point 1 t))
993 (error nil))))
994 ;; Point is sitting on first character of last (or count) sexp.
995 (if (> count 0)
996 ;; A distinguished form. If it is the first or second form use double
997 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound
998 ;; to 2 (the default), this just happens to work the same with if as
999 ;; the older code, but it makes unwind-protect, condition-case,
1000 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,
1001 ;; less hacked, behavior can be obtained by replacing below with
1002 ;; (list normal-indent containing-form-start).
1003 (if (<= (- i count) 1)
1004 (list (+ containing-form-column (* 2 lisp-body-indent))
1005 containing-form-start)
1006 (list normal-indent containing-form-start))
1007 ;; A non-distinguished form. Use body-indent if there are no
1008 ;; distinguished forms and this is the first undistinguished form,
1009 ;; or if this is the first undistinguished form and the preceding
1010 ;; distinguished form has indentation at least as great as body-indent.
1011 (if (or (and (= i 0) (= count 0))
1012 (and (= count 0) (<= body-indent normal-indent)))
1013 body-indent
1014 normal-indent))))
1015
1016(defun lisp-indent-defform (state indent-point)
1017 (goto-char (car (cdr state)))
1018 (forward-line 1)
1019 (if (> (point) (car (cdr (cdr state))))
1020 (progn
1021 (goto-char (car (cdr state)))
1022 (+ lisp-body-indent (current-column)))))
1023
ca2ddd8e 1024
a90256cc
BP
1025;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
1026;; like defun if the first form is placed on the next line, otherwise
1027;; it is indented like any other form (i.e. forms line up under first).
1028
1029(put 'lambda 'lisp-indent-function 'defun)
1030(put 'autoload 'lisp-indent-function 'defun)
1031(put 'progn 'lisp-indent-function 0)
1032(put 'prog1 'lisp-indent-function 1)
1033(put 'prog2 'lisp-indent-function 2)
1034(put 'save-excursion 'lisp-indent-function 0)
1035(put 'save-window-excursion 'lisp-indent-function 0)
4b619eca 1036(put 'save-selected-window 'lisp-indent-function 0)
a90256cc 1037(put 'save-restriction 'lisp-indent-function 0)
cfe158ab 1038(put 'save-match-data 'lisp-indent-function 0)
38f16fe1 1039(put 'save-current-buffer 'lisp-indent-function 0)
54c014f0 1040(put 'with-current-buffer 'lisp-indent-function 1)
488a0b05 1041(put 'combine-after-change-calls 'lisp-indent-function 0)
38f16fe1 1042(put 'with-output-to-string 'lisp-indent-function 0)
08adb099 1043(put 'with-temp-file 'lisp-indent-function 1)
e0119683 1044(put 'with-temp-buffer 'lisp-indent-function 0)
bacd83a7 1045(put 'with-temp-message 'lisp-indent-function 1)
83c8f461 1046(put 'with-syntax-table 'lisp-indent-function 1)
a90256cc
BP
1047(put 'let 'lisp-indent-function 1)
1048(put 'let* 'lisp-indent-function 1)
1049(put 'while 'lisp-indent-function 1)
1050(put 'if 'lisp-indent-function 2)
0a88ae7b 1051(put 'read-if 'lisp-indent-function 2)
a90256cc
BP
1052(put 'catch 'lisp-indent-function 1)
1053(put 'condition-case 'lisp-indent-function 2)
1054(put 'unwind-protect 'lisp-indent-function 1)
1055(put 'with-output-to-temp-buffer 'lisp-indent-function 1)
b6b4c8bd 1056(put 'eval-after-load 'lisp-indent-function 1)
05c71036
DL
1057(put 'dolist 'lisp-indent-function 1)
1058(put 'dotimes 'lisp-indent-function 1)
1059(put 'when 'lisp-indent-function 1)
1060(put 'unless 'lisp-indent-function 1)
a90256cc
BP
1061
1062(defun indent-sexp (&optional endpos)
1063 "Indent each line of the list starting just after point.
1064If optional arg ENDPOS is given, indent each line, stopping when
1065ENDPOS is encountered."
1066 (interactive)
daa37602
JB
1067 (let ((indent-stack (list nil))
1068 (next-depth 0)
33f268ec
RS
1069 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
1070 ;; so that calculate-lisp-indent will find the beginning of
1071 ;; the defun we are in.
1072 ;; If ENDPOS is nil, it is safe not to scan before point
1073 ;; since every line we indent is more deeply nested than point is.
1074 (starting-point (if endpos nil (point)))
daa37602
JB
1075 (last-point (point))
1076 last-depth bol outer-loop-done inner-loop-done state this-indent)
33f268ec
RS
1077 (or endpos
1078 ;; Get error now if we don't have a complete sexp after point.
1079 (save-excursion (forward-sexp 1)))
a90256cc
BP
1080 (save-excursion
1081 (setq outer-loop-done nil)
1082 (while (if endpos (< (point) endpos)
1083 (not outer-loop-done))
1084 (setq last-depth next-depth
1085 inner-loop-done nil)
1086 ;; Parse this line so we can learn the state
1087 ;; to indent the next line.
1088 ;; This inner loop goes through only once
1089 ;; unless a line ends inside a string.
1090 (while (and (not inner-loop-done)
1091 (not (setq outer-loop-done (eobp))))
1092 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
1093 nil nil state))
1094 (setq next-depth (car state))
1095 ;; If the line contains a comment other than the sort
1096 ;; that is indented like code,
1097 ;; indent it now with indent-for-comment.
1098 ;; Comments indented like code are right already.
1099 ;; In any case clear the in-comment flag in the state
1100 ;; because parse-partial-sexp never sees the newlines.
1101 (if (car (nthcdr 4 state))
1102 (progn (indent-for-comment)
1103 (end-of-line)
1104 (setcar (nthcdr 4 state) nil)))
1105 ;; If this line ends inside a string,
1106 ;; go straight to next line, remaining within the inner loop,
1107 ;; and turn off the \-flag.
1108 (if (car (nthcdr 3 state))
1109 (progn
1110 (forward-line 1)
1111 (setcar (nthcdr 5 state) nil))
1112 (setq inner-loop-done t)))
1113 (and endpos
daa37602
JB
1114 (<= next-depth 0)
1115 (progn
99ec65b3
DL
1116 (setq indent-stack (nconc indent-stack
1117 (make-list (- next-depth) nil))
daa37602
JB
1118 last-depth (- last-depth next-depth)
1119 next-depth 0)))
33f268ec 1120 (or outer-loop-done endpos
a90256cc
BP
1121 (setq outer-loop-done (<= next-depth 0)))
1122 (if outer-loop-done
1f5038b5 1123 (forward-line 1)
a90256cc
BP
1124 (while (> last-depth next-depth)
1125 (setq indent-stack (cdr indent-stack)
1126 last-depth (1- last-depth)))
1127 (while (< last-depth next-depth)
1128 (setq indent-stack (cons nil indent-stack)
1129 last-depth (1+ last-depth)))
1130 ;; Now go to the next line and indent it according
1131 ;; to what we learned from parsing the previous one.
1132 (forward-line 1)
1133 (setq bol (point))
1134 (skip-chars-forward " \t")
1135 ;; But not if the line is blank, or just a comment
1136 ;; (except for double-semi comments; indent them as usual).
1137 (if (or (eobp) (looking-at "\\s<\\|\n"))
1138 nil
1139 (if (and (car indent-stack)
1140 (>= (car indent-stack) 0))
1141 (setq this-indent (car indent-stack))
1142 (let ((val (calculate-lisp-indent
1143 (if (car indent-stack) (- (car indent-stack))
daa37602 1144 starting-point))))
531cbff1
RS
1145 (if (null val)
1146 (setq this-indent val)
1147 (if (integerp val)
1148 (setcar indent-stack
1149 (setq this-indent val))
1150 (setcar indent-stack (- (car (cdr val))))
1151 (setq this-indent (car val))))))
1152 (if (and this-indent (/= (current-column) this-indent))
a90256cc
BP
1153 (progn (delete-region bol (point))
1154 (indent-to this-indent)))))
1155 (or outer-loop-done
1156 (setq outer-loop-done (= (point) last-point))
1157 (setq last-point (point)))))))
1158
a90256cc 1159(defun lisp-indent-region (start end)
535eadac 1160 "Indent every line whose first char is between START and END inclusive."
a90256cc 1161 (save-excursion
a90256cc 1162 (let ((endmark (copy-marker end)))
33f268ec
RS
1163 (goto-char start)
1164 (and (bolp) (not (eolp))
1165 (lisp-indent-line))
a90256cc
BP
1166 (indent-sexp endmark)
1167 (set-marker endmark nil))))
ca2ddd8e 1168
889bfc7d 1169(defun indent-pp-sexp (&optional arg)
5a77048a
RS
1170 "Indent each line of the list starting just after point, or prettyprint it.
1171A prefix argument specifies pretty-printing."
889bfc7d
JL
1172 (interactive "P")
1173 (if arg
1174 (save-excursion
1175 (save-restriction
1176 (narrow-to-region (point) (progn (forward-sexp 1) (point)))
1177 (pp-buffer)
1178 (goto-char (point-max))
1179 (if (eq (char-before) ?\n)
1180 (delete-char -1)))))
1181 (indent-sexp))
1182
6338c7ba
JB
1183;;;; Lisp paragraph filling commands.
1184
3e8737bf
MS
1185(defcustom emacs-lisp-docstring-fill-column 65
1186 "Value of `fill-column' to use when filling a docstring.
1187Any non-integer value means do not use a different value of
1188`fill-column' when filling docstrings."
1189 :type '(choice (integer)
1190 (const :tag "Use the current `fill-column'" t))
1191 :group 'lisp)
1192
6338c7ba 1193(defun lisp-fill-paragraph (&optional justify)
3e8737bf 1194 "Like \\[fill-paragraph], but handle Emacs Lisp comments and docstrings.
6338c7ba
JB
1195If any of the current line is a comment, fill the comment or the
1196paragraph of it that point is in, preserving the comment's indentation
1197and initial semicolons."
1198 (interactive "P")
833815e8 1199 (or (fill-comment-paragraph justify)
cd9d9561
SM
1200 ;; Since fill-comment-paragraph returned nil, that means we're not in
1201 ;; a comment: Point is on a program line; we are interested
3e8737bf
MS
1202 ;; particularly in docstring lines.
1203 ;;
1204 ;; We bind `paragraph-start' and `paragraph-separate' temporarily. They
1205 ;; are buffer-local, but we avoid changing them so that they can be set
1206 ;; to make `forward-paragraph' and friends do something the user wants.
1207 ;;
1208 ;; `paragraph-start': The `(' in the character alternative and the
1209 ;; left-singlequote plus `(' sequence after the \\| alternative prevent
1210 ;; sexps and backquoted sexps that follow a docstring from being filled
1211 ;; with the docstring. This setting has the consequence of inhibiting
1212 ;; filling many program lines that are not docstrings, which is sensible,
1213 ;; because the user probably asked to fill program lines by accident, or
1214 ;; expecting indentation (perhaps we should try to do indenting in that
1215 ;; case). The `;' and `:' stop the paragraph being filled at following
1216 ;; comment lines and at keywords (e.g., in `defcustom'). Left parens are
1217 ;; escaped to keep font-locking, filling, & paren matching in the source
1218 ;; file happy.
1219 ;;
1220 ;; `paragraph-separate': A clever regexp distinguishes the first line of
1221 ;; a docstring and identifies it as a paragraph separator, so that it
1222 ;; won't be filled. (Since the first line of documentation stands alone
1223 ;; in some contexts, filling should not alter the contents the author has
1224 ;; chosen.) Only the first line of a docstring begins with whitespace
1225 ;; and a quotation mark and ends with a period or (rarely) a comma.
1226 ;;
1227 ;; The `fill-column' is temporarily bound to
1228 ;; `emacs-lisp-docstring-fill-column' if that value is an integer.
833815e8 1229 (let ((paragraph-start (concat paragraph-start
cd9d9561 1230 "\\|\\s-*\\([(;:\"]\\|`(\\|#'(\\)"))
833815e8 1231 (paragraph-separate
3e8737bf
MS
1232 (concat paragraph-separate "\\|\\s-*\".*[,\\.]$"))
1233 (fill-column (if (integerp emacs-lisp-docstring-fill-column)
1234 emacs-lisp-docstring-fill-column
1235 fill-column)))
833815e8
SM
1236 (fill-paragraph justify))
1237 ;; Never return nil.
1238 t))
ca2ddd8e 1239
a90256cc
BP
1240(defun indent-code-rigidly (start end arg &optional nochange-regexp)
1241 "Indent all lines of code, starting in the region, sideways by ARG columns.
1242Does not affect lines starting inside comments or strings, assuming that
1243the start of the region is not inside them.
1244
1245Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
1246The last is a regexp which, if matched at the beginning of a line,
1247means don't indent that line."
1248 (interactive "r\np")
1249 (let (state)
1250 (save-excursion
1251 (goto-char end)
1252 (setq end (point-marker))
1253 (goto-char start)
1254 (or (bolp)
1255 (setq state (parse-partial-sexp (point)
1256 (progn
1257 (forward-line 1) (point))
1258 nil nil state)))
1259 (while (< (point) end)
1260 (or (car (nthcdr 3 state))
1261 (and nochange-regexp
1262 (looking-at nochange-regexp))
1263 ;; If line does not start in string, indent it
1264 (let ((indent (current-indentation)))
1265 (delete-region (point) (progn (skip-chars-forward " \t") (point)))
1266 (or (eolp)
1267 (indent-to (max 0 (+ indent arg)) 0))))
1268 (setq state (parse-partial-sexp (point)
1269 (progn
1270 (forward-line 1) (point))
1271 nil nil state))))))
49116ac0
JB
1272
1273(provide 'lisp-mode)
1274
cd9d9561 1275;; arch-tag: 414c7f93-c245-4b77-8ed5-ed05ef7ff1bf
6594deb0 1276;;; lisp-mode.el ends here