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