comparison lisp/modes/lisp-mode.el @ 0:376386a54a3c r19-14

Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children ac2d302a0011
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
1 ;;; lisp-mode.el --- Lisp mode, and its idiosyncratic commands.
2
3 ;; Copyright (C) 1985, 1993, 1994 Free Software Foundation, Inc.
4 ;; Copyright (C) 1995 Tinker Systems
5
6 ;; Maintainer: FSF
7 ;; Keywords: lisp, languages
8
9 ;; This file is part of XEmacs.
10
11 ;; XEmacs is free software; you can redistribute it and/or modify it
12 ;; under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
14 ;; any later version.
15
16 ;; XEmacs is distributed in the hope that it will be useful, but
17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
19 ;; General Public License for more details.
20
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with XEmacs; see the file COPYING. If not, write to the Free
23 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
24
25 ;;; Synched up with: FSF 19.30.
26
27 ;;; Commentary:
28
29 ;; The base major mode for editing Lisp code (used also for Emacs Lisp).
30 ;; This mode is documented in the Emacs manual
31
32 ;;; Code:
33
34 (defvar lisp-mode-syntax-table nil "")
35 (defvar emacs-lisp-mode-syntax-table nil "")
36 (defvar lisp-mode-abbrev-table nil "")
37
38 (defvar lisp-interaction-mode-popup-menu
39 (purecopy '("Lisp Interaction Menu"
40 ["Evaluate Last S-expression" eval-last-sexp t]
41 ["Evaluate Entire Buffer" eval-current-buffer t]
42 ["Evaluate Region" eval-region (region-exists-p)]
43 "---"
44 ["Evaluate This Defun" eval-defun t]
45 ;; FSF says "Instrument Function for Debugging"
46 ["Debug This Defun" edebug-defun t]
47 "---"
48 ["Trace a Function" trace-function-background t]
49 ["Untrace All Functions" untrace-all (fboundp 'untrace-all)]
50 "---"
51 ["Comment Out Region" comment-region (region-exists-p)]
52 ["Indent Region" indent-region (region-exists-p)]
53 ["Indent Line" lisp-indent-line t]
54 "---"
55 ["Debug On Error" (setq debug-on-error (not debug-on-error))
56 :style toggle :selected debug-on-error]
57 ["Debug On Quit" (setq debug-on-quit (not debug-on-quit))
58 :style toggle :selected debug-on-quit]
59 )))
60
61 (defvar emacs-lisp-mode-popup-menu
62 (purecopy
63 (nconc
64 '("Emacs-Lisp Menu"
65 ["Byte-compile This File" emacs-lisp-byte-compile t]
66 ["Byte-recompile Directory..." byte-recompile-directory t]
67 "---")
68 (cdr lisp-interaction-mode-popup-menu))))
69
70 ;Don't have a menubar entry in Lisp Interaction mode. Otherwise, the
71 ;*scratch* buffer has a Lisp menubar item! Very confusing.
72 ;(defvar lisp-interaction-mode-menubar-menu
73 ; (purecopy (cons "Lisp" (cdr lisp-interaction-mode-popup-menu))))
74
75 (defvar emacs-lisp-mode-menubar-menu
76 (purecopy (cons "Lisp" (cdr emacs-lisp-mode-popup-menu))))
77
78 (if (not emacs-lisp-mode-syntax-table)
79 (let ((i 0))
80 (setq emacs-lisp-mode-syntax-table (make-syntax-table))
81 (while (< i ?0)
82 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table)
83 (setq i (1+ i)))
84 (setq i (1+ ?9))
85 (while (< i ?A)
86 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table)
87 (setq i (1+ i)))
88 (setq i (1+ ?Z))
89 (while (< i ?a)
90 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table)
91 (setq i (1+ i)))
92 (setq i (1+ ?z))
93 (while (< i 128)
94 (modify-syntax-entry i "_ " emacs-lisp-mode-syntax-table)
95 (setq i (1+ i)))
96 (modify-syntax-entry ? " " emacs-lisp-mode-syntax-table)
97 (modify-syntax-entry ?\t " " emacs-lisp-mode-syntax-table)
98 (modify-syntax-entry ?\n "> " emacs-lisp-mode-syntax-table)
99 ;; Give CR the same syntax as newline, for selective-display.
100 (modify-syntax-entry ?\^m "> " emacs-lisp-mode-syntax-table)
101 ;; Treat ^L as whitespace.
102 (modify-syntax-entry ?\f " " emacs-lisp-mode-syntax-table)
103 (modify-syntax-entry ?\; "< " emacs-lisp-mode-syntax-table)
104 (modify-syntax-entry ?` "' " emacs-lisp-mode-syntax-table)
105 (modify-syntax-entry ?' "' " emacs-lisp-mode-syntax-table)
106 (modify-syntax-entry ?, "' " emacs-lisp-mode-syntax-table)
107 ;; Used to be singlequote; changed for flonums.
108 (modify-syntax-entry ?. "_ " emacs-lisp-mode-syntax-table)
109 (modify-syntax-entry ?# "' " emacs-lisp-mode-syntax-table)
110 (modify-syntax-entry ?\" "\" " emacs-lisp-mode-syntax-table)
111 (modify-syntax-entry ?\\ "\\ " emacs-lisp-mode-syntax-table)
112 (modify-syntax-entry ?\( "() " emacs-lisp-mode-syntax-table)
113 (modify-syntax-entry ?\) ")( " emacs-lisp-mode-syntax-table)
114 (modify-syntax-entry ?\[ "(] " emacs-lisp-mode-syntax-table)
115 (modify-syntax-entry ?\] ")[ " emacs-lisp-mode-syntax-table)))
116
117 (if (not lisp-mode-syntax-table)
118 (progn (setq lisp-mode-syntax-table
119 (copy-syntax-table emacs-lisp-mode-syntax-table))
120 (modify-syntax-entry ?\[ "_ " lisp-mode-syntax-table)
121 (modify-syntax-entry ?\] "_ " lisp-mode-syntax-table)
122 ;;
123 ;; If emacs was compiled with NEW_SYNTAX, then do
124 ;; CL's #| |# block comments.
125 (if (= 8 (length (parse-partial-sexp (point) (point))))
126 (progn
127 (modify-syntax-entry ?# "' 58" lisp-mode-syntax-table)
128 (modify-syntax-entry ?| ". 67" lisp-mode-syntax-table))
129 ;; else, old style
130 (modify-syntax-entry ?\| "\" " lisp-mode-syntax-table))))
131
132 (define-abbrev-table 'lisp-mode-abbrev-table ())
133
134 ;(defvar lisp-imenu-generic-expression
135 ; '(
136 ; (nil
137 ; "^\\s-*(def\\(un\\|subst\\|macro\\|advice\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
138 ; ("Variables"
139 ; "^\\s-*(def\\(var\\|const\\)\\s-+\\([-A-Za-z0-9+]+\\)" 2)
140 ; ("Types"
141 ; "^\\s-*(def\\(type\\|struct\\|class\\|ine-condition\\)\\s-+\\([-A-Za-z0-9+]+\\)"
142 ; 2))
143 ;
144 ; "Imenu generic expression for Lisp mode. See `imenu-generic-expression'.")
145
146 (defun lisp-mode-variables (lisp-syntax)
147 (if lisp-syntax
148 (set-syntax-table lisp-mode-syntax-table))
149 (setq local-abbrev-table lisp-mode-abbrev-table)
150 (make-local-variable 'paragraph-start)
151 (setq paragraph-start (concat page-delimiter "\\|$" ))
152 (make-local-variable 'paragraph-separate)
153 (setq paragraph-separate paragraph-start)
154 (make-local-variable 'paragraph-ignore-fill-prefix)
155 (setq paragraph-ignore-fill-prefix t)
156 (make-local-variable 'fill-paragraph-function)
157 (setq fill-paragraph-function 'lisp-fill-paragraph)
158 (make-local-variable 'indent-line-function)
159 (setq indent-line-function 'lisp-indent-line)
160 (make-local-variable 'indent-region-function)
161 (setq indent-region-function 'lisp-indent-region)
162 (make-local-variable 'parse-sexp-ignore-comments)
163 (setq parse-sexp-ignore-comments t)
164 (make-local-variable 'outline-regexp)
165 (setq outline-regexp ";;; \\|(....")
166 (set (make-local-variable 'comment-start) ";")
167 (set (make-local-variable 'block-comment-start) ";;")
168 (make-local-variable 'comment-start-skip)
169 (setq comment-start-skip ";+[ \t]*")
170 (make-local-variable 'comment-column)
171 (setq comment-column 40)
172 (make-local-variable 'comment-indent-function)
173 (setq comment-indent-function 'lisp-comment-indent)
174 ; (make-local-variable 'imenu-generic-expression)
175 ; (setq imenu-generic-expression lisp-imenu-generic-expression)
176 (set (make-local-variable 'dabbrev-case-fold-search) nil)
177 (set (make-local-variable 'dabbrev-case-replace) nil)
178 )
179
180
181 (defvar shared-lisp-mode-map ()
182 "Keymap for commands shared by all sorts of Lisp modes.")
183
184 (if shared-lisp-mode-map
185 ()
186 (setq shared-lisp-mode-map (make-sparse-keymap))
187 (set-keymap-name shared-lisp-mode-map 'shared-lisp-mode-map)
188 (define-key shared-lisp-mode-map "\e\C-q" 'indent-sexp)
189 (define-key shared-lisp-mode-map "\177" 'backward-delete-char-untabify)
190 (define-key shared-lisp-mode-map "\M-;" 'lisp-indent-for-comment))
191
192 (defvar emacs-lisp-mode-map ()
193 "Keymap for Emacs Lisp mode.
194 All commands in `shared-lisp-mode-map' are inherited by this map.")
195
196 (if emacs-lisp-mode-map
197 ()
198 (setq emacs-lisp-mode-map (make-sparse-keymap))
199 (set-keymap-name emacs-lisp-mode-map 'emacs-lisp-mode-map)
200 (set-keymap-parents emacs-lisp-mode-map (list shared-lisp-mode-map))
201 (define-key emacs-lisp-mode-map "\e\t" 'lisp-complete-symbol)
202 (define-key emacs-lisp-mode-map "\e\C-x" 'eval-defun))
203
204 (defun emacs-lisp-byte-compile ()
205 "Byte compile the file containing the current buffer."
206 (interactive)
207 (if buffer-file-name
208 (progn
209 (save-buffer)
210 (byte-compile-file buffer-file-name))
211 (error "The buffer must be saved in a file first.")))
212
213 (defun emacs-lisp-mode ()
214 "Major mode for editing Lisp code to run in Emacs.
215 Commands:
216 Delete converts tabs to spaces as it moves back.
217 Blank lines separate paragraphs. Semicolons start comments.
218 \\{emacs-lisp-mode-map}
219 Entry to this mode calls the value of `emacs-lisp-mode-hook'
220 if that value is non-nil."
221 (interactive)
222 (kill-all-local-variables)
223 (use-local-map emacs-lisp-mode-map)
224 (set-syntax-table emacs-lisp-mode-syntax-table)
225 (setq major-mode 'emacs-lisp-mode
226 mode-popup-menu emacs-lisp-mode-popup-menu
227 mode-name "Emacs-Lisp")
228 (if (and (featurep 'menubar)
229 current-menubar)
230 (progn
231 ;; make a local copy of the menubar, so our modes don't
232 ;; change the global menubar
233 (set-buffer-menubar current-menubar)
234 (add-submenu nil emacs-lisp-mode-menubar-menu)))
235 (lisp-mode-variables nil)
236 (run-hooks 'emacs-lisp-mode-hook))
237
238 (defvar lisp-mode-map ()
239 "Keymap for ordinary Lisp mode.
240 All commands in `shared-lisp-mode-map' are inherited by this map.")
241
242 (if lisp-mode-map
243 ()
244 (setq lisp-mode-map (make-sparse-keymap))
245 (set-keymap-name lisp-mode-map 'lisp-mode-map)
246 (set-keymap-parents lisp-mode-map (list shared-lisp-mode-map))
247 (define-key lisp-mode-map "\e\C-x" 'lisp-send-defun)
248 ;; gag, no. use ilisp. -jwz
249 ;; (define-key lisp-mode-map "\C-c\C-z" 'run-lisp)
250 )
251
252 (defun lisp-mode ()
253 "Major mode for editing Lisp code for Lisps other than GNU Emacs Lisp.
254 Commands:
255 Delete converts tabs to spaces as it moves back.
256 Blank lines separate paragraphs. Semicolons start comments.
257 \\{lisp-mode-map}
258 Note that `run-lisp' may be used either to start an inferior Lisp job
259 or to switch back to an existing one.
260
261 Entry to this mode calls the value of `lisp-mode-hook'
262 if that value is non-nil."
263 (interactive)
264 (kill-all-local-variables)
265 (use-local-map lisp-mode-map)
266 (setq major-mode 'lisp-mode)
267 (setq mode-name "Lisp")
268 (lisp-mode-variables t)
269 (set-syntax-table lisp-mode-syntax-table)
270 (run-hooks 'lisp-mode-hook))
271
272 ;; This will do unless shell.el is loaded.
273 (defun lisp-send-defun ()
274 "Send the current defun to the Lisp process made by \\[run-lisp]."
275 (interactive)
276 (error "Process lisp does not exist"))
277
278 ;; XEmacs change: emacs-lisp-mode-map is a more appropriate parent.
279 (defvar lisp-interaction-mode-map nil
280 "Keymap for Lisp Interaction moe.
281 All commands in `emacs-lisp-mode-map' are inherited by this map.")
282
283 (if lisp-interaction-mode-map
284 ()
285 (setq lisp-interaction-mode-map (make-sparse-keymap))
286 (set-keymap-name lisp-interaction-mode-map 'lisp-interaction-mode-map)
287 (set-keymap-parents lisp-interaction-mode-map (list emacs-lisp-mode-map))
288 (define-key lisp-interaction-mode-map "\e\C-x" 'eval-defun)
289 (define-key lisp-interaction-mode-map "\e\t" 'lisp-complete-symbol)
290 (define-key lisp-interaction-mode-map "\n" 'eval-print-last-sexp))
291
292 (defun lisp-interaction-mode ()
293 "Major mode for typing and evaluating Lisp forms.
294 Like Lisp mode except that \\[eval-print-last-sexp] evals the Lisp expression
295 before point, and prints its value into the buffer, advancing point.
296
297 Commands:
298 Delete converts tabs to spaces as it moves back.
299 Paragraphs are separated only by blank lines. Semicolons start comments.
300 \\{lisp-interaction-mode-map}
301 Entry to this mode calls the value of `lisp-interaction-mode-hook'
302 if that value is non-nil."
303 (interactive)
304 (kill-all-local-variables)
305 (use-local-map lisp-interaction-mode-map)
306 (setq major-mode 'lisp-interaction-mode
307 mode-popup-menu lisp-interaction-mode-popup-menu
308 mode-name "Lisp Interaction")
309 (set-syntax-table emacs-lisp-mode-syntax-table)
310 (lisp-mode-variables nil)
311 (run-hooks 'lisp-interaction-mode-hook))
312
313 (defun eval-print-last-sexp ()
314 "Evaluate sexp before point; print value into current buffer."
315 (interactive)
316 (let ((standard-output (current-buffer)))
317 (terpri)
318 (eval-last-sexp t)
319 (terpri)))
320
321 (defun eval-interactive (expr)
322 "Like `eval' except that it transforms defvars to defconsts."
323 ;; by Stig@hackvan.com
324 (if (and (consp expr)
325 (eq (car expr) 'defvar)
326 (> (length expr) 2))
327 (progn (eval (cons 'defconst (cdr expr)))
328 (message "defvar treated as defconst")
329 (sit-for 1)
330 (message ""))
331 (eval expr)))
332
333 (defun eval-last-sexp (eval-last-sexp-arg-internal) ;dynamic scoping wonderment
334 "Evaluate sexp before point; print value in minibuffer.
335 With argument, print output into current buffer."
336 (interactive "P")
337 (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
338 (opoint (point)))
339 (prin1 (let ((stab (syntax-table)))
340 (eval-interactive (unwind-protect
341 (save-excursion
342 (set-syntax-table emacs-lisp-mode-syntax-table)
343 (forward-sexp -1)
344 (save-restriction
345 (narrow-to-region (point-min) opoint)
346 (read (current-buffer))))
347 (set-syntax-table stab)))))))
348
349 (defun eval-defun (eval-defun-arg-internal) ;dynamic scoping wonderment
350 "Evaluate defun that point is in or before.
351 Print value in minibuffer.
352 With argument, insert value in current buffer after the defun."
353 (interactive "P")
354 (let ((standard-output (if eval-defun-arg-internal (current-buffer) t)))
355 (prin1 (eval-interactive (save-excursion
356 (end-of-defun)
357 (beginning-of-defun)
358 (read (current-buffer)))))))
359
360 (defun lisp-comment-indent ()
361 (if (looking-at "\\s<\\s<\\s<")
362 (current-column)
363 (if (looking-at "\\s<\\s<")
364 (let ((tem (calculate-lisp-indent)))
365 (if (listp tem) (car tem) tem))
366 (skip-chars-backward " \t")
367 (max (if (bolp) 0 (1+ (current-column)))
368 comment-column))))
369
370 (defun lisp-indent-for-comment ()
371 "Indent this line's comment appropriately, or insert an empty comment.
372 If adding a new comment on a blank line, use `block-comment-start' instead
373 of `comment-start' to open the comment."
374 ;; by Stig@hackvan.com
375 ;; #### - This functionality, the recognition of block-comment-{start,end},
376 ;; will perhaps be standardized across modes and move to indent-for-comment.
377 (interactive)
378 (if (and block-comment-start
379 (save-excursion (beginning-of-line) (looking-at "^[ \t]*$")))
380 (insert block-comment-start))
381 (indent-for-comment))
382
383 (defconst lisp-indent-offset nil "")
384 (defconst lisp-indent-function 'lisp-indent-function "")
385
386 (defun lisp-indent-line (&optional whole-exp)
387 "Indent current line as Lisp code.
388 With argument, indent any additional lines of the same expression
389 rigidly along with this one."
390 (interactive "P")
391 (let ((indent (calculate-lisp-indent)) shift-amt beg end
392 (pos (- (point-max) (point))))
393 (beginning-of-line)
394 (setq beg (point))
395 (skip-chars-forward " \t")
396 (if (looking-at "\\s<\\s<\\s<")
397 ;; Don't alter indentation of a ;;; comment line.
398 (goto-char (- (point-max) pos))
399 (if (and (looking-at "\\s<") (not (looking-at "\\s<\\s<")))
400 ;; Single-semicolon comment lines should be indented
401 ;; as comment lines, not as code.
402 (progn (indent-for-comment) (forward-char -1))
403 (if (listp indent) (setq indent (car indent)))
404 (setq shift-amt (- indent (current-column)))
405 (if (zerop shift-amt)
406 nil
407 (delete-region beg (point))
408 (indent-to indent)))
409 ;; If initial point was within line's indentation,
410 ;; position after the indentation. Else stay at same point in text.
411 (if (> (- (point-max) pos) (point))
412 (goto-char (- (point-max) pos)))
413 ;; If desired, shift remaining lines of expression the same amount.
414 (and whole-exp (not (zerop shift-amt))
415 (save-excursion
416 (goto-char beg)
417 (forward-sexp 1)
418 (setq end (point))
419 (goto-char beg)
420 (forward-line 1)
421 (setq beg (point))
422 (> end beg))
423 (indent-code-rigidly beg end shift-amt)))))
424
425 (defvar calculate-lisp-indent-last-sexp)
426
427 (defun calculate-lisp-indent (&optional parse-start)
428 "Return appropriate indentation for current line as Lisp code.
429 In usual case returns an integer: the column to indent to.
430 Can instead return a list, whose car is the column to indent to.
431 This means that following lines at the same level of indentation
432 should not necessarily be indented the same way.
433 The second element of the list is the buffer position
434 of the start of the containing expression."
435 (save-excursion
436 (beginning-of-line)
437 (let ((indent-point (point))
438 state ;;paren-depth
439 ;; setting this to a number inhibits calling hook
440 (desired-indent nil)
441 (retry t)
442 calculate-lisp-indent-last-sexp containing-sexp)
443 (if parse-start
444 (goto-char parse-start)
445 (beginning-of-defun))
446 ;; Find outermost containing sexp
447 (while (< (point) indent-point)
448 (setq state (parse-partial-sexp (point) indent-point 0)))
449 ;; Find innermost containing sexp
450 (while (and retry
451 state
452 (> ;;(setq paren-depth (elt state 0))
453 (elt state 0)
454 0))
455 (setq retry nil)
456 (setq calculate-lisp-indent-last-sexp (elt state 2))
457 (setq containing-sexp (elt state 1))
458 ;; Position following last unclosed open.
459 (goto-char (1+ containing-sexp))
460 ;; Is there a complete sexp since then?
461 (if (and calculate-lisp-indent-last-sexp
462 (> calculate-lisp-indent-last-sexp (point)))
463 ;; Yes, but is there a containing sexp after that?
464 (let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
465 indent-point 0)))
466 (if (setq retry (car (cdr peek))) (setq state peek)))))
467 (if retry
468 nil
469 ;; Innermost containing sexp found
470 (goto-char (1+ containing-sexp))
471 (if (not calculate-lisp-indent-last-sexp)
472 ;; indent-point immediately follows open paren.
473 ;; Don't call hook.
474 (setq desired-indent (current-column))
475 ;; Find the start of first element of containing sexp.
476 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
477 (cond ((looking-at "\\s(")
478 ;; First element of containing sexp is a list.
479 ;; Indent under that list.
480 )
481 ((> (save-excursion (forward-line 1) (point))
482 calculate-lisp-indent-last-sexp)
483 ;; This is the first line to start within the containing sexp.
484 ;; It's almost certainly a function call.
485 (if (= (point) calculate-lisp-indent-last-sexp)
486 ;; Containing sexp has nothing before this line
487 ;; except the first element. Indent under that element.
488 nil
489 ;; Skip the first element, find start of second (the first
490 ;; argument of the function call) and indent under.
491 (progn (forward-sexp 1)
492 (parse-partial-sexp (point)
493 calculate-lisp-indent-last-sexp
494 0 t)))
495 (backward-prefix-chars))
496 (t
497 ;; Indent beneath first sexp on same line as
498 ;; calculate-lisp-indent-last-sexp. Again, it's
499 ;; almost certainly a function call.
500 (goto-char calculate-lisp-indent-last-sexp)
501 (beginning-of-line)
502 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp
503 0 t)
504 (backward-prefix-chars)))))
505 ;; Point is at the point to indent under unless we are inside a string.
506 ;; Call indentation hook except when overridden by lisp-indent-offset
507 ;; or if the desired indentation has already been computed.
508 (let ((normal-indent (current-column)))
509 (cond ((elt state 3)
510 ;; Inside a string, don't change indentation.
511 (goto-char indent-point)
512 (skip-chars-forward " \t")
513 (current-column))
514 (desired-indent)
515 ((and (boundp 'lisp-indent-function)
516 lisp-indent-function
517 (not retry))
518 (or (funcall lisp-indent-function indent-point state)
519 normal-indent))
520 ;; lisp-indent-offset shouldn't override lisp-indent-function !
521 ((and (integerp lisp-indent-offset) containing-sexp)
522 ;; Indent by constant offset
523 (goto-char containing-sexp)
524 (+ normal-indent lisp-indent-offset))
525 (t
526 normal-indent))))))
527
528 (defun lisp-indent-function (indent-point state)
529 ;; free reference to `calculate-lisp-indent-last-sexp'
530 ;; in #'calculate-lisp-indent
531 (let ((normal-indent (current-column)))
532 (goto-char (1+ (elt state 1)))
533 (parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
534 (if (and (elt state 2)
535 (not (looking-at "\\sw\\|\\s_")))
536 ;; car of form doesn't seem to be a a symbol
537 (progn
538 (if (not (> (save-excursion (forward-line 1) (point))
539 calculate-lisp-indent-last-sexp))
540 (progn (goto-char calculate-lisp-indent-last-sexp)
541 (beginning-of-line)
542 (parse-partial-sexp (point)
543 calculate-lisp-indent-last-sexp 0 t)))
544 ;; Indent under the list or under the first sexp on the same
545 ;; line as calculate-lisp-indent-last-sexp. Note that first
546 ;; thing on that line has to be complete sexp since we are
547 ;; inside the innermost containing sexp.
548 (backward-prefix-chars)
549 (current-column))
550 (let ((function (buffer-substring (point)
551 (progn (forward-sexp 1) (point))))
552 method)
553 (setq method (or (get (intern-soft function) 'lisp-indent-function)
554 (get (intern-soft function) 'lisp-indent-hook)))
555 (cond ((or (eq method 'defun)
556 (and (null method)
557 (> (length function) 3)
558 (string-match "\\`def" function)))
559 (lisp-indent-defform state indent-point))
560 ((integerp method)
561 (lisp-indent-specform method state
562 indent-point normal-indent))
563 (method
564 (funcall method state indent-point)))))))
565
566 (defconst lisp-body-indent 2
567 "Number of columns to indent the second line of a `(def...)' form.")
568
569 (defun lisp-indent-specform (count state indent-point normal-indent)
570 (let ((containing-form-start (elt state 1))
571 (i count)
572 body-indent containing-form-column)
573 ;; Move to the start of containing form, calculate indentation
574 ;; to use for non-distinguished forms (> count), and move past the
575 ;; function symbol. lisp-indent-function guarantees that there is at
576 ;; least one word or symbol character following open paren of containing
577 ;; form.
578 (goto-char containing-form-start)
579 (setq containing-form-column (current-column))
580 (setq body-indent (+ lisp-body-indent containing-form-column))
581 (forward-char 1)
582 (forward-sexp 1)
583 ;; Now find the start of the last form.
584 (parse-partial-sexp (point) indent-point 1 t)
585 (while (and (< (point) indent-point)
586 (condition-case ()
587 (progn
588 (setq count (1- count))
589 (forward-sexp 1)
590 (parse-partial-sexp (point) indent-point 1 t))
591 (error nil))))
592 ;; Point is sitting on first character of last (or count) sexp.
593 (if (> count 0)
594 ;; A distinguished form. If it is the first or second form use double
595 ;; lisp-body-indent, else normal indent. With lisp-body-indent bound
596 ;; to 2 (the default), this just happens to work the same with if as
597 ;; the older code, but it makes unwind-protect, condition-case,
598 ;; with-output-to-temp-buffer, et. al. much more tasteful. The older,
599 ;; less hacked, behavior can be obtained by replacing below with
600 ;; (list normal-indent containing-form-start).
601 (if (<= (- i count) 1)
602 (list (+ containing-form-column (* 2 lisp-body-indent))
603 containing-form-start)
604 (list normal-indent containing-form-start))
605 ;; A non-distinguished form. Use body-indent if there are no
606 ;; distinguished forms and this is the first undistinguished form,
607 ;; or if this is the first undistinguished form and the preceding
608 ;; distinguished form has indentation at least as great as body-indent.
609 (if (or (and (= i 0) (= count 0))
610 (and (= count 0) (<= body-indent normal-indent)))
611 body-indent
612 normal-indent))))
613
614 (defun lisp-indent-defform (state indent-point)
615 (goto-char (car (cdr state)))
616 (forward-line 1)
617 (if (> (point) (car (cdr (cdr state))))
618 (progn
619 (goto-char (car (cdr state)))
620 (+ lisp-body-indent (current-column)))))
621
622
623 ;; (put 'progn 'lisp-indent-function 0), say, causes progn to be indented
624 ;; like defun if the first form is placed on the next line, otherwise
625 ;; it is indented like any other form (i.e. forms line up under first).
626
627 (put 'lambda 'lisp-indent-function 'defun)
628 (put 'autoload 'lisp-indent-function 'defun)
629 (put 'progn 'lisp-indent-function 0)
630 (put 'prog1 'lisp-indent-function 1)
631 (put 'prog2 'lisp-indent-function 2)
632 (put 'save-excursion 'lisp-indent-function 0)
633 (put 'save-window-excursion 'lisp-indent-function 0)
634 (put 'save-selected-window 'lisp-indent-function 0)
635 (put 'save-restriction 'lisp-indent-function 0)
636 (put 'save-match-data 'lisp-indent-function 0)
637 (put 'let 'lisp-indent-function 1)
638 (put 'let* 'lisp-indent-function 1)
639 (put 'while 'lisp-indent-function 1)
640 (put 'if 'lisp-indent-function 2)
641 (put 'catch 'lisp-indent-function 1)
642 (put 'condition-case 'lisp-indent-function 2)
643 (put 'unwind-protect 'lisp-indent-function 1)
644 (put 'with-output-to-temp-buffer 'lisp-indent-function 1)
645
646 (defun indent-sexp (&optional endpos)
647 "Indent each line of the list starting just after point.
648 If optional arg ENDPOS is given, indent each line, stopping when
649 ENDPOS is encountered."
650 (interactive)
651 (let ((indent-stack (list nil))
652 (next-depth 0)
653 ;; If ENDPOS is non-nil, use nil as STARTING-POINT
654 ;; so that calculate-lisp-indent will find the beginning of
655 ;; the defun we are in.
656 ;; If ENDPOS is nil, it is safe not to scan before point
657 ;; since every line we indent is more deeply nested than point is.
658 (starting-point (if endpos nil (point)))
659 (last-point (point))
660 last-depth
661 bol
662 (outer-loop-done nil)
663 inner-loop-done
664 state
665 this-indent)
666 ;; Get error now if we don't have a complete sexp after point.
667 (or endpos
668 ;; Get error now if we don't have a complete sexp after point.
669 (save-excursion (forward-sexp 1)))
670 (save-excursion
671 (setq outer-loop-done nil)
672 (while (if endpos (< (point) endpos)
673 (not outer-loop-done))
674 (setq last-depth next-depth
675 inner-loop-done nil)
676 ;; Parse this line so we can learn the state
677 ;; to indent the next line.
678 ;; This inner loop goes through only once
679 ;; unless a line ends inside a string.
680 (while (and (not inner-loop-done)
681 (not (setq outer-loop-done (eobp))))
682 (setq state (parse-partial-sexp (point) (progn (end-of-line) (point))
683 nil nil state))
684 (setq next-depth (car state))
685 ;; If the line contains a comment other than the sort
686 ;; that is indented like code,
687 ;; indent it now with indent-for-comment.
688 ;; Comments indented like code are right already.
689 ;; In any case clear the in-comment flag in the state
690 ;; because parse-partial-sexp never sees the newlines.
691 (if (car (nthcdr 4 state))
692 (progn (indent-for-comment)
693 (end-of-line)
694 (setcar (nthcdr 4 state) nil)))
695 ;; If this line ends inside a string,
696 ;; go straight to next line, remaining within the inner loop,
697 ;; and turn off the \-flag.
698 (if (car (nthcdr 3 state))
699 (progn
700 (forward-line 1)
701 (setcar (nthcdr 5 state) nil))
702 (setq inner-loop-done t)))
703 ; Chuck had a comment here saying that the alternate code
704 ; (the next sexp after this one) led to an infine loop.
705 ; Since merging some changes in from FSF 19.30, I'm going
706 ; to try going the FSF way and see what happens.
707 ; (and endpos
708 ; (while (<= next-depth 0) ;XEmacs change
709 ; (setq indent-stack (append indent-stack (list nil)))
710 ; (setq next-depth (1+ next-depth))
711 ; (setq last-depth (1+ last-depth))))
712 (and endpos
713 (<= next-depth 0)
714 (progn
715 (setq indent-stack (append indent-stack
716 (make-list (- next-depth) nil))
717 last-depth (- last-depth next-depth)
718 next-depth 0)))
719 (or outer-loop-done endpos
720 (setq outer-loop-done (<= next-depth 0)))
721 (if outer-loop-done
722 (forward-line 1)
723 (while (> last-depth next-depth)
724 (setq indent-stack (cdr indent-stack)
725 last-depth (1- last-depth)))
726 (while (< last-depth next-depth)
727 (setq indent-stack (cons nil indent-stack)
728 last-depth (1+ last-depth)))
729 ;; Now go to the next line and indent it according
730 ;; to what we learned from parsing the previous one.
731 (forward-line 1)
732 (setq bol (point))
733 (skip-chars-forward " \t")
734 ;; But not if the line is blank, or just a comment
735 ;; (except for double-semi comments; indent them as usual).
736 (if (or (eobp) (looking-at "\\s<\\|\n"))
737 nil
738 (if (and (car indent-stack)
739 (>= (car indent-stack) 0))
740 (setq this-indent (car indent-stack))
741 (let ((val (calculate-lisp-indent
742 (if (car indent-stack)
743 (- (car indent-stack))
744 starting-point))))
745 (if (integerp val)
746 (setcar indent-stack
747 (setq this-indent val))
748 (setcar indent-stack (- (car (cdr val))))
749 (setq this-indent (car val)))))
750 (if (/= (current-column) this-indent)
751 (progn (delete-region bol (point))
752 (indent-to this-indent)))))
753 (or outer-loop-done
754 (setq outer-loop-done (= (point) last-point))
755 (setq last-point (point)))))))
756
757 ;; Indent every line whose first char is between START and END inclusive.
758 (defun lisp-indent-region (start end)
759 (save-excursion
760 (let ((endmark (copy-marker end)))
761 (goto-char start)
762 (and (bolp) (not (eolp))
763 (lisp-indent-line))
764 (indent-sexp endmark)
765 (set-marker endmark nil))))
766
767
768 ;;;; Lisp paragraph filling commands.
769
770 (defun lisp-fill-paragraph (&optional justify)
771 "Like \\[fill-paragraph], but handle Emacs Lisp comments.
772 If any of the current line is a comment, fill the comment or the
773 paragraph of it that point is in, preserving the comment's indentation
774 and initial semicolons."
775 (interactive "P")
776 (let (
777 ;; Non-nil if the current line contains a comment.
778 has-comment
779
780 ;; If has-comment, the appropriate fill-prefix for the comment.
781 comment-fill-prefix
782 )
783
784 ;; Figure out what kind of comment we are looking at.
785 (save-excursion
786 (beginning-of-line)
787 (cond
788
789 ;; A line with nothing but a comment on it?
790 ((looking-at "[ \t]*;[; \t]*")
791 (setq has-comment t
792 comment-fill-prefix (buffer-substring (match-beginning 0)
793 (match-end 0))))
794
795 ;; A line with some code, followed by a comment? Remember that the
796 ;; semi which starts the comment shouldn't be part of a string or
797 ;; character.
798 ((progn
799 (while (not (looking-at ";\\|$"))
800 (skip-chars-forward "^;\n\"\\\\?")
801 (cond
802 ((eq (char-after (point)) ?\\) (forward-char 2))
803 ((memq (char-after (point)) '(?\" ??)) (forward-sexp 1))))
804 (looking-at ";+[\t ]*"))
805 (setq has-comment t)
806 (setq comment-fill-prefix
807 (concat (make-string (current-column) ? )
808 (buffer-substring (match-beginning 0) (match-end 0)))))))
809
810 (if (not has-comment)
811 (fill-paragraph justify)
812
813 ;; Narrow to include only the comment, and then fill the region.
814 (save-restriction
815 (narrow-to-region
816 ;; Find the first line we should include in the region to fill.
817 (save-excursion
818 (while (and (zerop (forward-line -1))
819 (looking-at "^[ \t]*;")))
820 ;; We may have gone to far. Go forward again.
821 (or (looking-at "^[ \t]*;")
822 (forward-line 1))
823 (point))
824 ;; Find the beginning of the first line past the region to fill.
825 (save-excursion
826 (while (progn (forward-line 1)
827 (looking-at "^[ \t]*;")))
828 (point)))
829
830 ;; Lines with only semicolons on them can be paragraph boundaries.
831 (let ((paragraph-start (concat paragraph-start "\\|[ \t;]*$"))
832 (paragraph-separate (concat paragraph-start "\\|[ \t;]*$"))
833 (fill-prefix comment-fill-prefix))
834 (fill-paragraph justify))))
835 t))
836
837
838 (defun indent-code-rigidly (start end arg &optional nochange-regexp)
839 "Indent all lines of code, starting in the region, sideways by ARG columns.
840 Does not affect lines starting inside comments or strings,
841 assuming that the start of the region is not inside them.
842 Called from a program, takes args START, END, COLUMNS and NOCHANGE-REGEXP.
843 The last is a regexp which, if matched at the beginning of a line,
844 means don't indent that line."
845 (interactive "r\np")
846 (let (state)
847 (save-excursion
848 (goto-char end)
849 (setq end (point-marker))
850 (goto-char start)
851 (or (bolp)
852 (setq state (parse-partial-sexp (point)
853 (progn
854 (forward-line 1) (point))
855 nil nil state)))
856 (while (< (point) end)
857 (or (car (nthcdr 3 state))
858 (and nochange-regexp
859 (looking-at nochange-regexp))
860 ;; If line does not start in string, indent it
861 (let ((indent (current-indentation)))
862 (delete-region (point) (progn (skip-chars-forward " \t") (point)))
863 (or (eolp)
864 (indent-to (max 0 (+ indent arg)) 0))))
865 (setq state (parse-partial-sexp (point)
866 (progn
867 (forward-line 1) (point))
868 nil nil state))))))
869
870 (provide 'lisp-mode)
871
872 ;;; lisp-mode.el ends here