Commit | Line | Data |
---|---|---|
6594deb0 ER |
1 | ;;; lisp.el --- Lisp editing commands for Emacs |
2 | ||
3731a850 | 3 | ;; Copyright (C) 1985, 1986, 1994, 2000, 2002, 2003, 2004, |
ceb4c4d3 | 4 | ;; 2005, 2006 Free Software Foundation, Inc. |
9750e079 | 5 | |
e5167999 | 6 | ;; Maintainer: FSF |
e9571d2a | 7 | ;; Keywords: lisp, languages |
e5167999 | 8 | |
b73b9811 | 9 | ;; This file is part of GNU Emacs. |
10 | ||
11 | ;; GNU Emacs is free software; you can redistribute it and/or modify | |
12 | ;; it under the terms of the GNU General Public License as published by | |
e5167999 | 13 | ;; the Free Software Foundation; either version 2, or (at your option) |
b73b9811 | 14 | ;; any later version. |
15 | ||
16 | ;; GNU Emacs is distributed in the hope that it will be useful, | |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
20 | ||
21 | ;; You should have received a copy of the GNU General Public License | |
b578f267 | 22 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
3a35cf56 LK |
23 | ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, |
24 | ;; Boston, MA 02110-1301, USA. | |
b73b9811 | 25 | |
e41b2db1 ER |
26 | ;;; Commentary: |
27 | ||
e50c4203 DL |
28 | ;; Lisp editing commands to go with Lisp major mode. More-or-less |
29 | ;; applicable in other modes too. | |
e41b2db1 | 30 | |
e5167999 | 31 | ;;; Code: |
b73b9811 | 32 | |
7fe78b07 | 33 | ;; Note that this variable is used by non-lisp modes too. |
30e19aee | 34 | (defcustom defun-prompt-regexp nil |
a64dc1a4 | 35 | "*If non-nil, a regexp to ignore before a defun. |
7fe78b07 | 36 | This is only necessary if the opening paren or brace is not in column 0. |
a64dc1a4 | 37 | See function `beginning-of-defun'." |
ba6b3a2a RS |
38 | :type '(choice (const nil) |
39 | regexp) | |
30e19aee | 40 | :group 'lisp) |
24ff5498 | 41 | (make-variable-buffer-local 'defun-prompt-regexp) |
b73b9811 | 42 | |
30e19aee | 43 | (defcustom parens-require-spaces t |
a64dc1a4 | 44 | "If non-nil, `insert-parentheses' inserts whitespace as needed." |
30e19aee RS |
45 | :type 'boolean |
46 | :group 'lisp) | |
44a53673 | 47 | |
11ae6c5d SM |
48 | (defvar forward-sexp-function nil |
49 | "If non-nil, `forward-sexp' delegates to this function. | |
50 | Should take the same arguments and behave similarly to `forward-sexp'.") | |
51 | ||
b73b9811 | 52 | (defun forward-sexp (&optional arg) |
53 | "Move forward across one balanced expression (sexp). | |
c6eeec65 | 54 | With ARG, do it that many times. Negative arg -N means |
e3f99b91 | 55 | move backward across N balanced expressions." |
b73b9811 | 56 | (interactive "p") |
57 | (or arg (setq arg 1)) | |
11ae6c5d SM |
58 | (if forward-sexp-function |
59 | (funcall forward-sexp-function arg) | |
60 | (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) | |
61 | (if (< arg 0) (backward-prefix-chars)))) | |
b73b9811 | 62 | |
63 | (defun backward-sexp (&optional arg) | |
64 | "Move backward across one balanced expression (sexp). | |
c6eeec65 | 65 | With ARG, do it that many times. Negative arg -N means |
e3f99b91 | 66 | move forward across N balanced expressions." |
b73b9811 | 67 | (interactive "p") |
68 | (or arg (setq arg 1)) | |
69 | (forward-sexp (- arg))) | |
70 | ||
afb62fdd | 71 | (defun mark-sexp (&optional arg allow-extend) |
b73b9811 | 72 | "Set mark ARG sexps from point. |
e3f99b91 | 73 | The place mark goes is the same place \\[forward-sexp] would |
f07493e7 | 74 | move to with the same argument. |
afb62fdd | 75 | Interactively, if this command is repeated |
a64dc1a4 | 76 | or (in Transient Mark mode) if the mark is active, |
967e1a52 | 77 | it marks the next ARG sexps after the ones already marked." |
afb62fdd RS |
78 | (interactive "P\np") |
79 | (cond ((and allow-extend | |
80 | (or (and (eq last-command this-command) (mark t)) | |
81 | (and transient-mark-mode mark-active))) | |
3610d3c9 | 82 | (setq arg (if arg (prefix-numeric-value arg) |
967e1a52 | 83 | (if (< (mark) (point)) -1 1))) |
cad113ae KG |
84 | (set-mark |
85 | (save-excursion | |
967e1a52 JL |
86 | (goto-char (mark)) |
87 | (forward-sexp arg) | |
88 | (point)))) | |
cad113ae KG |
89 | (t |
90 | (push-mark | |
91 | (save-excursion | |
3610d3c9 | 92 | (forward-sexp (prefix-numeric-value arg)) |
cad113ae KG |
93 | (point)) |
94 | nil t)))) | |
b73b9811 | 95 | |
96 | (defun forward-list (&optional arg) | |
97 | "Move forward across one balanced group of parentheses. | |
c6eeec65 | 98 | With ARG, do it that many times. |
b73b9811 | 99 | Negative arg -N means move backward across N groups of parentheses." |
100 | (interactive "p") | |
101 | (or arg (setq arg 1)) | |
102 | (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) | |
103 | ||
104 | (defun backward-list (&optional arg) | |
105 | "Move backward across one balanced group of parentheses. | |
c6eeec65 | 106 | With ARG, do it that many times. |
b73b9811 | 107 | Negative arg -N means move forward across N groups of parentheses." |
108 | (interactive "p") | |
109 | (or arg (setq arg 1)) | |
110 | (forward-list (- arg))) | |
111 | ||
e50c4203 | 112 | (defun down-list (&optional arg) |
b73b9811 | 113 | "Move forward down one level of parentheses. |
c6eeec65 | 114 | With ARG, do this that many times. |
b41c9501 | 115 | A negative argument means move backward but still go down a level." |
b73b9811 | 116 | (interactive "p") |
e50c4203 | 117 | (or arg (setq arg 1)) |
b73b9811 | 118 | (let ((inc (if (> arg 0) 1 -1))) |
119 | (while (/= arg 0) | |
120 | (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) | |
121 | (setq arg (- arg inc))))) | |
122 | ||
e50c4203 | 123 | (defun backward-up-list (&optional arg) |
b73b9811 | 124 | "Move backward out of one level of parentheses. |
c6eeec65 | 125 | With ARG, do this that many times. |
b41c9501 | 126 | A negative argument means move forward but still to a less deep spot." |
b73b9811 | 127 | (interactive "p") |
e50c4203 | 128 | (up-list (- (or arg 1)))) |
b73b9811 | 129 | |
e50c4203 | 130 | (defun up-list (&optional arg) |
b73b9811 | 131 | "Move forward out of one level of parentheses. |
c6eeec65 | 132 | With ARG, do this that many times. |
b41c9501 | 133 | A negative argument means move backward but still to a less deep spot." |
b73b9811 | 134 | (interactive "p") |
e50c4203 | 135 | (or arg (setq arg 1)) |
b73b9811 | 136 | (let ((inc (if (> arg 0) 1 -1))) |
137 | (while (/= arg 0) | |
138 | (goto-char (or (scan-lists (point) inc 1) (buffer-end arg))) | |
139 | (setq arg (- arg inc))))) | |
140 | ||
e50c4203 | 141 | (defun kill-sexp (&optional arg) |
dd60a465 RS |
142 | "Kill the sexp (balanced expression) following point. |
143 | With ARG, kill that many sexps after point. | |
144 | Negative arg -N means kill N sexps before point." | |
b73b9811 | 145 | (interactive "p") |
146 | (let ((opoint (point))) | |
e50c4203 | 147 | (forward-sexp (or arg 1)) |
b73b9811 | 148 | (kill-region opoint (point)))) |
149 | ||
e50c4203 | 150 | (defun backward-kill-sexp (&optional arg) |
dd60a465 RS |
151 | "Kill the sexp (balanced expression) preceding point. |
152 | With ARG, kill that many sexps before point. | |
153 | Negative arg -N means kill N sexps after point." | |
b73b9811 | 154 | (interactive "p") |
e50c4203 | 155 | (kill-sexp (- (or arg 1)))) |
de6d64b2 EZ |
156 | |
157 | ;; After Zmacs: | |
158 | (defun kill-backward-up-list (&optional arg) | |
159 | "Kill the form containing the current sexp, leaving the sexp itself. | |
160 | A prefix argument ARG causes the relevant number of surrounding | |
161 | forms to be removed." | |
162 | (interactive "*p") | |
163 | (let ((current-sexp (thing-at-point 'sexp))) | |
164 | (if current-sexp | |
165 | (save-excursion | |
166 | (backward-up-list arg) | |
167 | (kill-sexp) | |
168 | (insert current-sexp)) | |
169 | (error "Not at a sexp")))) | |
b73b9811 | 170 | \f |
ab22ee53 | 171 | (defvar beginning-of-defun-function nil |
c6eeec65 DL |
172 | "If non-nil, function for `beginning-of-defun-raw' to call. |
173 | This is used to find the beginning of the defun instead of using the | |
ab22ee53 RS |
174 | normal recipe (see `beginning-of-defun'). Major modes can define this |
175 | if defining `defun-prompt-regexp' is not sufficient to handle the mode's | |
176 | needs. | |
c6eeec65 | 177 | |
7a0e9874 DL |
178 | The function (of no args) should go to the line on which the current |
179 | defun starts, and return non-nil, or should return nil if it can't | |
180 | find the beginning.") | |
c6eeec65 | 181 | |
b73b9811 | 182 | (defun beginning-of-defun (&optional arg) |
183 | "Move backward to the beginning of a defun. | |
c6eeec65 | 184 | With ARG, do it that many times. Negative arg -N |
b73b9811 | 185 | means move forward to Nth following beginning of defun. |
186 | Returns t unless search stops due to beginning or end of buffer. | |
187 | ||
1269ae51 | 188 | Normally a defun starts when there is a char with open-parenthesis |
b73b9811 | 189 | syntax at the beginning of a line. If `defun-prompt-regexp' is |
190 | non-nil, then a string which matches that regexp may precede the | |
c6eeec65 DL |
191 | open-parenthesis, and point ends up at the beginning of the line. |
192 | ||
ab22ee53 RS |
193 | If variable `beginning-of-defun-function' is non-nil, its value |
194 | is called as a function to find the defun's beginning." | |
afa995e1 | 195 | (interactive "p") |
90c08845 | 196 | (or (not (eq this-command 'beginning-of-defun)) |
967e1a52 JL |
197 | (eq last-command 'beginning-of-defun) |
198 | (and transient-mark-mode mark-active) | |
199 | (push-mark)) | |
afa995e1 KH |
200 | (and (beginning-of-defun-raw arg) |
201 | (progn (beginning-of-line) t))) | |
202 | ||
203 | (defun beginning-of-defun-raw (&optional arg) | |
204 | "Move point to the character that starts a defun. | |
c6eeec65 DL |
205 | This is identical to function `beginning-of-defun', except that point |
206 | does not move to the beginning of the line when `defun-prompt-regexp' | |
207 | is non-nil. | |
208 | ||
ab22ee53 RS |
209 | If variable `beginning-of-defun-function' is non-nil, its value |
210 | is called as a function to find the defun's beginning." | |
b73b9811 | 211 | (interactive "p") |
ab22ee53 | 212 | (if beginning-of-defun-function |
44b254cc SM |
213 | (if (> (setq arg (or arg 1)) 0) |
214 | (dotimes (i arg) | |
215 | (funcall beginning-of-defun-function)) | |
216 | ;; Better not call end-of-defun-function directly, in case | |
217 | ;; it's not defined. | |
218 | (end-of-defun (- arg))) | |
c6eeec65 DL |
219 | (and arg (< arg 0) (not (eobp)) (forward-char 1)) |
220 | (and (re-search-backward (if defun-prompt-regexp | |
418d645c GM |
221 | (concat (if open-paren-in-column-0-is-defun-start |
222 | "^\\s(\\|" "") | |
b5ed9def | 223 | "\\(?:" defun-prompt-regexp "\\)\\s(") |
c6eeec65 DL |
224 | "^\\s(") |
225 | nil 'move (or arg 1)) | |
226 | (progn (goto-char (1- (match-end 0)))) t))) | |
227 | ||
ab22ee53 | 228 | (defvar end-of-defun-function nil |
c6eeec65 DL |
229 | "If non-nil, function for function `end-of-defun' to call. |
230 | This is used to find the end of the defun instead of using the normal | |
ab22ee53 RS |
231 | recipe (see `end-of-defun'). Major modes can define this if the |
232 | normal method is not appropriate.") | |
b73b9811 | 233 | |
234 | (defun buffer-end (arg) | |
a64dc1a4 | 235 | "Return the \"far end\" position of the buffer, in direction ARG. |
03deb635 RS |
236 | If ARG is positive, that's the end of the buffer. |
237 | Otherwise, that's the beginning of the buffer." | |
b73b9811 | 238 | (if (> arg 0) (point-max) (point-min))) |
239 | ||
240 | (defun end-of-defun (&optional arg) | |
a64dc1a4 LT |
241 | "Move forward to next end of defun. |
242 | With argument, do it that many times. | |
b73b9811 | 243 | Negative argument -N means move back to Nth preceding end of defun. |
244 | ||
c6eeec65 DL |
245 | An end of a defun occurs right after the close-parenthesis that |
246 | matches the open-parenthesis that starts a defun; see function | |
ab22ee53 RS |
247 | `beginning-of-defun'. |
248 | ||
249 | If variable `end-of-defun-function' is non-nil, its value | |
250 | is called as a function to find the defun's end." | |
b73b9811 | 251 | (interactive "p") |
90c08845 | 252 | (or (not (eq this-command 'end-of-defun)) |
967e1a52 JL |
253 | (eq last-command 'end-of-defun) |
254 | (and transient-mark-mode mark-active) | |
255 | (push-mark)) | |
44b254cc | 256 | (if (or (null arg) (= arg 0)) (setq arg 1)) |
ab22ee53 | 257 | (if end-of-defun-function |
44b254cc SM |
258 | (if (> arg 0) |
259 | (dotimes (i arg) | |
260 | (funcall end-of-defun-function)) | |
261 | ;; Better not call beginning-of-defun-function | |
262 | ;; directly, in case it's not defined. | |
263 | (beginning-of-defun (- arg))) | |
c6eeec65 DL |
264 | (let ((first t)) |
265 | (while (and (> arg 0) (< (point) (point-max))) | |
44b254cc | 266 | (let ((pos (point))) |
c6eeec65 DL |
267 | (while (progn |
268 | (if (and first | |
269 | (progn | |
270 | (end-of-line 1) | |
271 | (beginning-of-defun-raw 1))) | |
272 | nil | |
273 | (or (bobp) (forward-char -1)) | |
274 | (beginning-of-defun-raw -1)) | |
275 | (setq first nil) | |
276 | (forward-list 1) | |
277 | (skip-chars-forward " \t") | |
278 | (if (looking-at "\\s<\\|\n") | |
279 | (forward-line 1)) | |
280 | (<= (point) pos)))) | |
281 | (setq arg (1- arg))) | |
282 | (while (< arg 0) | |
283 | (let ((pos (point))) | |
284 | (beginning-of-defun-raw 1) | |
285 | (forward-sexp 1) | |
286 | (forward-line 1) | |
287 | (if (>= (point) pos) | |
288 | (if (beginning-of-defun-raw 2) | |
289 | (progn | |
290 | (forward-list 1) | |
291 | (skip-chars-forward " \t") | |
292 | (if (looking-at "\\s<\\|\n") | |
293 | (forward-line 1))) | |
294 | (goto-char (point-min))))) | |
295 | (setq arg (1+ arg)))))) | |
b73b9811 | 296 | |
afb62fdd | 297 | (defun mark-defun (&optional allow-extend) |
b73b9811 | 298 | "Put mark at end of this defun, point at beginning. |
cad113ae | 299 | The defun marked is the one that contains point or follows point. |
afb62fdd RS |
300 | |
301 | Interactively, if this command is repeated | |
a64dc1a4 | 302 | or (in Transient Mark mode) if the mark is active, |
afb62fdd RS |
303 | it marks the next defun after the ones already marked." |
304 | (interactive "p") | |
305 | (cond ((and allow-extend | |
306 | (or (and (eq last-command this-command) (mark t)) | |
307 | (and transient-mark-mode mark-active))) | |
be0d25b6 KG |
308 | (set-mark |
309 | (save-excursion | |
310 | (goto-char (mark)) | |
311 | (end-of-defun) | |
312 | (point)))) | |
313 | (t | |
d3d6bc9b RS |
314 | (let ((opoint (point)) |
315 | beg end) | |
316 | (push-mark opoint) | |
317 | ;; Try first in this order for the sake of languages with nested | |
318 | ;; functions where several can end at the same place as with | |
319 | ;; the offside rule, e.g. Python. | |
320 | (beginning-of-defun) | |
321 | (setq beg (point)) | |
322 | (end-of-defun) | |
323 | (setq end (point)) | |
324 | (while (looking-at "^\n") | |
325 | (forward-line 1)) | |
326 | (if (> (point) opoint) | |
327 | (progn | |
328 | ;; We got the right defun. | |
329 | (push-mark beg nil t) | |
330 | (goto-char end) | |
331 | (exchange-point-and-mark)) | |
332 | ;; beginning-of-defun moved back one defun | |
333 | ;; so we got the wrong one. | |
334 | (goto-char opoint) | |
335 | (end-of-defun) | |
336 | (push-mark (point) nil t) | |
337 | (beginning-of-defun)) | |
338 | (re-search-backward "^\n" (- (point) 1) t))))) | |
b73b9811 | 339 | |
3f7e952d RS |
340 | (defun narrow-to-defun (&optional arg) |
341 | "Make text outside current defun invisible. | |
c6eeec65 DL |
342 | The defun visible is the one that contains point or follows point. |
343 | Optional ARG is ignored." | |
3f7e952d RS |
344 | (interactive) |
345 | (save-excursion | |
346 | (widen) | |
d3d6bc9b RS |
347 | (let ((opoint (point)) |
348 | beg end) | |
349 | ;; Try first in this order for the sake of languages with nested | |
350 | ;; functions where several can end at the same place as with | |
351 | ;; the offside rule, e.g. Python. | |
352 | (beginning-of-defun) | |
353 | (setq beg (point)) | |
750e563f | 354 | (end-of-defun) |
d3d6bc9b RS |
355 | (setq end (point)) |
356 | (while (looking-at "^\n") | |
357 | (forward-line 1)) | |
358 | (unless (> (point) opoint) | |
359 | ;; beginning-of-defun moved back one defun | |
360 | ;; so we got the wrong one. | |
361 | (goto-char opoint) | |
362 | (end-of-defun) | |
363 | (setq end (point)) | |
364 | (beginning-of-defun) | |
365 | (setq beg (point))) | |
366 | (goto-char end) | |
367 | (re-search-backward "^\n" (- (point) 1) t) | |
368 | (narrow-to-region beg end)))) | |
3f7e952d | 369 | |
d97c8198 JL |
370 | (defvar insert-pair-alist |
371 | '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\')) | |
372 | "Alist of paired characters inserted by `insert-pair'. | |
373 | Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR | |
374 | OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR | |
375 | of the pair whose key is equal to the last input character with | |
376 | or without modifiers, are inserted by `insert-pair'.") | |
377 | ||
378 | (defun insert-pair (&optional arg open close) | |
5891bf24 JL |
379 | "Enclose following ARG sexps in a pair of OPEN and CLOSE characters. |
380 | Leave point after the first character. | |
e3ac26cb | 381 | A negative ARG encloses the preceding ARG sexps instead. |
5891bf24 JL |
382 | No argument is equivalent to zero: just insert characters |
383 | and leave point between. | |
d5bfe076 | 384 | If `parens-require-spaces' is non-nil, this command also inserts a space |
5891bf24 | 385 | before and after, depending on the surrounding characters. |
d97c8198 JL |
386 | If region is active, insert enclosing characters at region boundaries. |
387 | ||
388 | If arguments OPEN and CLOSE are nil, the character pair is found | |
389 | from the variable `insert-pair-alist' according to the last input | |
390 | character with or without modifiers. If no character pair is | |
391 | found in the variable `insert-pair-alist', then the last input | |
392 | character is inserted ARG times." | |
b73b9811 | 393 | (interactive "P") |
d97c8198 JL |
394 | (if (not (and open close)) |
395 | (let ((pair (or (assq last-command-char insert-pair-alist) | |
396 | (assq (event-basic-type last-command-event) | |
397 | insert-pair-alist)))) | |
398 | (if pair | |
399 | (if (nth 2 pair) | |
400 | (setq open (nth 1 pair) close (nth 2 pair)) | |
401 | (setq open (nth 0 pair) close (nth 1 pair)))))) | |
402 | (if (and open close) | |
403 | (if (and transient-mark-mode mark-active) | |
404 | (progn | |
405 | (save-excursion (goto-char (region-end)) (insert close)) | |
406 | (save-excursion (goto-char (region-beginning)) (insert open))) | |
407 | (if arg (setq arg (prefix-numeric-value arg)) | |
408 | (setq arg 0)) | |
409 | (cond ((> arg 0) (skip-chars-forward " \t")) | |
410 | ((< arg 0) (forward-sexp arg) (setq arg (- arg)))) | |
411 | (and parens-require-spaces | |
412 | (not (bobp)) | |
413 | (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close))) | |
414 | (insert " ")) | |
415 | (insert open) | |
416 | (save-excursion | |
417 | (or (eq arg 0) (forward-sexp arg)) | |
418 | (insert close) | |
419 | (and parens-require-spaces | |
420 | (not (eobp)) | |
421 | (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open))) | |
422 | (insert " ")))) | |
423 | (insert-char (event-basic-type last-command-event) | |
424 | (prefix-numeric-value arg)))) | |
425 | ||
426 | (defun insert-parentheses (&optional arg) | |
a64dc1a4 LT |
427 | "Enclose following ARG sexps in parentheses. |
428 | Leave point after open-paren. | |
5891bf24 JL |
429 | A negative ARG encloses the preceding ARG sexps instead. |
430 | No argument is equivalent to zero: just insert `()' and leave point between. | |
431 | If `parens-require-spaces' is non-nil, this command also inserts a space | |
432 | before and after, depending on the surrounding characters. | |
433 | If region is active, insert enclosing characters at region boundaries." | |
434 | (interactive "P") | |
435 | (insert-pair arg ?\( ?\))) | |
b73b9811 | 436 | |
d97c8198 JL |
437 | (defun delete-pair () |
438 | "Delete a pair of characters enclosing the sexp that follows point." | |
439 | (interactive) | |
440 | (save-excursion (forward-sexp 1) (delete-char -1)) | |
441 | (delete-char 1)) | |
442 | ||
443 | (defun raise-sexp (&optional arg) | |
444 | "Raise ARG sexps higher up the tree." | |
445 | (interactive "p") | |
446 | (let ((s (if (and transient-mark-mode mark-active) | |
447 | (buffer-substring (region-beginning) (region-end)) | |
448 | (buffer-substring | |
449 | (point) | |
450 | (save-excursion (forward-sexp arg) (point)))))) | |
451 | (backward-up-list 1) | |
452 | (delete-region (point) (save-excursion (forward-sexp 1) (point))) | |
453 | (save-excursion (insert s)))) | |
454 | ||
b73b9811 | 455 | (defun move-past-close-and-reindent () |
456 | "Move past next `)', delete indentation before it, then indent after it." | |
457 | (interactive) | |
458 | (up-list 1) | |
459 | (forward-char -1) | |
460 | (while (save-excursion ; this is my contribution | |
461 | (let ((before-paren (point))) | |
462 | (back-to-indentation) | |
adce3b5f RS |
463 | (and (= (point) before-paren) |
464 | (progn | |
465 | ;; Move to end of previous line. | |
466 | (beginning-of-line) | |
467 | (forward-char -1) | |
468 | ;; Verify it doesn't end within a string or comment. | |
469 | (let ((end (point)) | |
470 | state) | |
471 | (beginning-of-line) | |
472 | ;; Get state at start of line. | |
c6eeec65 | 473 | (setq state (list 0 nil nil |
adce3b5f RS |
474 | (null (calculate-lisp-indent)) |
475 | nil nil nil nil | |
476 | nil)) | |
477 | ;; Parse state across the line to get state at end. | |
478 | (setq state (parse-partial-sexp (point) end nil nil | |
479 | state)) | |
480 | ;; Check not in string or comment. | |
481 | (and (not (elt state 3)) (not (elt state 4)))))))) | |
b73b9811 | 482 | (delete-indentation)) |
483 | (forward-char 1) | |
484 | (newline-and-indent)) | |
c6eeec65 DL |
485 | |
486 | (defun check-parens () ; lame name? | |
487 | "Check for unbalanced parentheses in the current buffer. | |
488 | More accurately, check the narrowed part of the buffer for unbalanced | |
489 | expressions (\"sexps\") in general. This is done according to the | |
490 | current syntax table and will find unbalanced brackets or quotes as | |
7bc10886 | 491 | appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is |
8ad8cfa5 | 492 | found, an error is signaled and point is left at the first unbalanced |
7bc10886 | 493 | character." |
c6eeec65 DL |
494 | (interactive) |
495 | (condition-case data | |
496 | ;; Buffer can't have more than (point-max) sexps. | |
497 | (scan-sexps (point-min) (point-max)) | |
498 | (scan-error (goto-char (nth 2 data)) | |
499 | ;; Could print (nth 1 data), which is either | |
500 | ;; "Containing expression ends prematurely" or | |
501 | ;; "Unbalanced parentheses", but those may not be so | |
502 | ;; accurate/helpful, e.g. quotes may actually be | |
503 | ;; mismatched. | |
504 | (error "Unmatched bracket or quote")) | |
505 | (error (cond ((eq 'scan-error (car data)) | |
506 | (goto-char (nth 2 data)) | |
507 | (error "Unmatched bracket or quote")) | |
508 | (t (signal (car data) (cdr data))))))) | |
b73b9811 | 509 | \f |
e50c4203 | 510 | (defun lisp-complete-symbol (&optional predicate) |
2eb9adab RS |
511 | "Perform completion on Lisp symbol preceding point. |
512 | Compare that symbol against the known Lisp symbols. | |
1fa1cb1b RS |
513 | If no characters can be completed, display a list of possible completions. |
514 | Repeating the command at that point scrolls the list. | |
2eb9adab | 515 | |
e50c4203 DL |
516 | When called from a program, optional arg PREDICATE is a predicate |
517 | determining which symbols are considered, e.g. `commandp'. | |
518 | If PREDICATE is nil, the context determines which symbols are | |
519 | considered. If the symbol starts just after an open-parenthesis, only | |
520 | symbols with function definitions are considered. Otherwise, all | |
521 | symbols with function definitions, values or properties are | |
522 | considered." | |
b73b9811 | 523 | (interactive) |
1fa1cb1b RS |
524 | |
525 | (let ((window (get-buffer-window "*Completions*"))) | |
526 | (if (and (eq last-command this-command) | |
527 | window (window-live-p window) (window-buffer window) | |
528 | (buffer-name (window-buffer window))) | |
529 | ;; If this command was repeated, and | |
530 | ;; there's a fresh completion window with a live buffer, | |
531 | ;; and this command is repeated, scroll that window. | |
532 | (with-current-buffer (window-buffer window) | |
533 | (if (pos-visible-in-window-p (point-max) window) | |
534 | (set-window-start window (point-min)) | |
535 | (save-selected-window | |
536 | (select-window window) | |
537 | (scroll-up)))) | |
538 | ||
539 | ;; Do completion. | |
540 | (let* ((end (point)) | |
541 | (beg (with-syntax-table emacs-lisp-mode-syntax-table | |
542 | (save-excursion | |
543 | (backward-sexp 1) | |
544 | (while (= (char-syntax (following-char)) ?\') | |
545 | (forward-char 1)) | |
546 | (point)))) | |
547 | (pattern (buffer-substring-no-properties beg end)) | |
548 | (predicate | |
549 | (or predicate | |
550 | (save-excursion | |
551 | (goto-char beg) | |
552 | (if (not (eq (char-before) ?\()) | |
553 | (lambda (sym) ;why not just nil ? -sm | |
554 | (or (boundp sym) (fboundp sym) | |
555 | (symbol-plist sym))) | |
556 | ;; Looks like a funcall position. Let's double check. | |
557 | (if (condition-case nil | |
558 | (progn (up-list -2) (forward-char 1) | |
559 | (eq (char-after) ?\()) | |
560 | (error nil)) | |
561 | ;; If the first element of the parent list is an open | |
562 | ;; parenthesis we are probably not in a funcall position. | |
563 | ;; Maybe a `let' varlist or something. | |
564 | nil | |
565 | ;; Else, we assume that a function name is expected. | |
566 | 'fboundp))))) | |
567 | (completion (try-completion pattern obarray predicate))) | |
568 | (cond ((eq completion t)) | |
569 | ((null completion) | |
570 | (message "Can't find completion for \"%s\"" pattern) | |
571 | (ding)) | |
c1b5a260 SM |
572 | ((not (string= pattern completion)) |
573 | (delete-region beg end) | |
574 | (insert completion) | |
5e688290 RF |
575 | ;; Don't leave around a completions buffer that's out of date. |
576 | (let ((win (get-buffer-window "*Completions*" 0))) | |
577 | (if win (with-selected-window win (bury-buffer))))) | |
1fa1cb1b | 578 | (t |
5e688290 RF |
579 | (let ((minibuf-is-in-use |
580 | (eq (minibuffer-window) (selected-window)))) | |
581 | (unless minibuf-is-in-use | |
582 | (message "Making completion list...")) | |
583 | (let ((list (all-completions pattern obarray predicate))) | |
584 | (setq list (sort list 'string<)) | |
585 | (or (eq predicate 'fboundp) | |
586 | (let (new) | |
587 | (while list | |
588 | (setq new (cons (if (fboundp (intern (car list))) | |
589 | (list (car list) " <f>") | |
590 | (car list)) | |
591 | new)) | |
592 | (setq list (cdr list))) | |
593 | (setq list (nreverse new)))) | |
594 | (if (> (length list) 1) | |
595 | (with-output-to-temp-buffer "*Completions*" | |
596 | (display-completion-list list pattern)) | |
597 | ;; Don't leave around a completions buffer that's | |
598 | ;; out of date. | |
599 | (let ((win (get-buffer-window "*Completions*" 0))) | |
600 | (if win (with-selected-window win (bury-buffer)))))) | |
601 | (unless minibuf-is-in-use | |
602 | (message "Making completion list...%s" "done"))))))))) | |
6594deb0 | 603 | |
398de718 | 604 | ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e |
6594deb0 | 605 | ;;; lisp.el ends here |