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