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