Remove duplicate Lisp definitions of define-minor-mode variables defined in C.
[bpt/emacs.git] / lisp / emacs-lisp / lisp.el
CommitLineData
6594deb0
ER
1;;; lisp.el --- Lisp editing commands for Emacs
2
d59c3137 3;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004,
114f9c96 4;; 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
9750e079 5
e5167999 6;; Maintainer: FSF
e9571d2a 7;; Keywords: lisp, languages
bd78fa1d 8;; Package: emacs
e5167999 9
b73b9811 10;; This file is part of GNU Emacs.
11
d6cba7ae 12;; GNU Emacs is free software: you can redistribute it and/or modify
b73b9811 13;; it under the terms of the GNU General Public License as published by
d6cba7ae
GM
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
b73b9811 16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
d6cba7ae 23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
b73b9811 24
e41b2db1
ER
25;;; Commentary:
26
e50c4203
DL
27;; Lisp editing commands to go with Lisp major mode. More-or-less
28;; applicable in other modes too.
e41b2db1 29
e5167999 30;;; Code:
b73b9811 31
7fe78b07 32;; Note that this variable is used by non-lisp modes too.
30e19aee 33(defcustom defun-prompt-regexp nil
cb711556 34 "If non-nil, a regexp to ignore before a defun.
7fe78b07 35This is only necessary if the opening paren or brace is not in column 0.
a64dc1a4 36See function `beginning-of-defun'."
ba6b3a2a
RS
37 :type '(choice (const nil)
38 regexp)
30e19aee 39 :group 'lisp)
24ff5498 40(make-variable-buffer-local 'defun-prompt-regexp)
b73b9811 41
30e19aee 42(defcustom parens-require-spaces t
becc6788
CY
43 "If non-nil, add whitespace as needed when inserting parentheses.
44This affects `insert-parentheses' and `insert-pair'."
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.
50Should 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 54With ARG, do it that many times. Negative arg -N means
8fc2ac41
AM
55move backward across N balanced expressions.
56This command assumes point is not in a string or comment."
61eee794 57 (interactive "^p")
b73b9811 58 (or arg (setq arg 1))
11ae6c5d
SM
59 (if forward-sexp-function
60 (funcall forward-sexp-function arg)
61 (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
62 (if (< arg 0) (backward-prefix-chars))))
b73b9811 63
64(defun backward-sexp (&optional arg)
65 "Move backward across one balanced expression (sexp).
c6eeec65 66With ARG, do it that many times. Negative arg -N means
8fc2ac41
AM
67move forward across N balanced expressions.
68This command assumes point is not in a string or comment."
61eee794 69 (interactive "^p")
b73b9811 70 (or arg (setq arg 1))
71 (forward-sexp (- arg)))
72
afb62fdd 73(defun mark-sexp (&optional arg allow-extend)
b73b9811 74 "Set mark ARG sexps from point.
e3f99b91 75The place mark goes is the same place \\[forward-sexp] would
f07493e7 76move to with the same argument.
afb62fdd 77Interactively, if this command is repeated
a64dc1a4 78or (in Transient Mark mode) if the mark is active,
8fc2ac41
AM
79it marks the next ARG sexps after the ones already marked.
80This command assumes point is not in a string or comment."
afb62fdd
RS
81 (interactive "P\np")
82 (cond ((and allow-extend
83 (or (and (eq last-command this-command) (mark t))
84 (and transient-mark-mode mark-active)))
3610d3c9 85 (setq arg (if arg (prefix-numeric-value arg)
967e1a52 86 (if (< (mark) (point)) -1 1)))
cad113ae
KG
87 (set-mark
88 (save-excursion
967e1a52
JL
89 (goto-char (mark))
90 (forward-sexp arg)
91 (point))))
cad113ae
KG
92 (t
93 (push-mark
94 (save-excursion
3610d3c9 95 (forward-sexp (prefix-numeric-value arg))
cad113ae
KG
96 (point))
97 nil t))))
b73b9811 98
99(defun forward-list (&optional arg)
100 "Move forward across one balanced group of parentheses.
c6eeec65 101With ARG, do it that many times.
8fc2ac41
AM
102Negative arg -N means move backward across N groups of parentheses.
103This command assumes point is not in a string or comment."
61eee794 104 (interactive "^p")
b73b9811 105 (or arg (setq arg 1))
106 (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
107
108(defun backward-list (&optional arg)
109 "Move backward across one balanced group of parentheses.
c6eeec65 110With ARG, do it that many times.
8fc2ac41
AM
111Negative arg -N means move forward across N groups of parentheses.
112This command assumes point is not in a string or comment."
61eee794 113 (interactive "^p")
b73b9811 114 (or arg (setq arg 1))
115 (forward-list (- arg)))
116
e50c4203 117(defun down-list (&optional arg)
b73b9811 118 "Move forward down one level of parentheses.
c6eeec65 119With ARG, do this that many times.
8fc2ac41
AM
120A negative argument means move backward but still go down a level.
121This command assumes point is not in a string or comment."
61eee794 122 (interactive "^p")
e50c4203 123 (or arg (setq arg 1))
b73b9811 124 (let ((inc (if (> arg 0) 1 -1)))
125 (while (/= arg 0)
126 (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
127 (setq arg (- arg inc)))))
128
e50c4203 129(defun backward-up-list (&optional arg)
b73b9811 130 "Move backward out of one level of parentheses.
c6eeec65 131With ARG, do this that many times.
8fc2ac41
AM
132A negative argument means move forward but still to a less deep spot.
133This command assumes point is not in a string or comment."
61eee794 134 (interactive "^p")
e50c4203 135 (up-list (- (or arg 1))))
b73b9811 136
e50c4203 137(defun up-list (&optional arg)
b73b9811 138 "Move forward out of one level of parentheses.
c6eeec65 139With ARG, do this that many times.
8fc2ac41
AM
140A negative argument means move backward but still to a less deep spot.
141This command assumes point is not in a string or comment."
61eee794 142 (interactive "^p")
e50c4203 143 (or arg (setq arg 1))
984edd22
SM
144 (let ((inc (if (> arg 0) 1 -1))
145 pos)
b73b9811 146 (while (/= arg 0)
984edd22
SM
147 (if (null forward-sexp-function)
148 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
afa22f7c 149 (condition-case err
984edd22 150 (while (progn (setq pos (point))
afa22f7c
SM
151 (forward-sexp inc)
152 (/= (point) pos)))
153 (scan-error (goto-char (nth 2 err))))
984edd22
SM
154 (if (= (point) pos)
155 (signal 'scan-error
156 (list "Unbalanced parentheses" (point) (point)))))
b73b9811 157 (setq arg (- arg inc)))))
158
e50c4203 159(defun kill-sexp (&optional arg)
dd60a465
RS
160 "Kill the sexp (balanced expression) following point.
161With ARG, kill that many sexps after point.
8fc2ac41
AM
162Negative arg -N means kill N sexps before point.
163This command assumes point is not in a string or comment."
b73b9811 164 (interactive "p")
165 (let ((opoint (point)))
e50c4203 166 (forward-sexp (or arg 1))
b73b9811 167 (kill-region opoint (point))))
168
e50c4203 169(defun backward-kill-sexp (&optional arg)
dd60a465
RS
170 "Kill the sexp (balanced expression) preceding point.
171With ARG, kill that many sexps before point.
8fc2ac41
AM
172Negative arg -N means kill N sexps after point.
173This command assumes point is not in a string or comment."
b73b9811 174 (interactive "p")
e50c4203 175 (kill-sexp (- (or arg 1))))
de6d64b2
EZ
176
177;; After Zmacs:
178(defun kill-backward-up-list (&optional arg)
179 "Kill the form containing the current sexp, leaving the sexp itself.
180A prefix argument ARG causes the relevant number of surrounding
8fc2ac41
AM
181forms to be removed.
182This command assumes point is not in a string or comment."
de6d64b2
EZ
183 (interactive "*p")
184 (let ((current-sexp (thing-at-point 'sexp)))
185 (if current-sexp
186 (save-excursion
187 (backward-up-list arg)
188 (kill-sexp)
189 (insert current-sexp))
190 (error "Not at a sexp"))))
b73b9811 191\f
ab22ee53 192(defvar beginning-of-defun-function nil
c6eeec65
DL
193 "If non-nil, function for `beginning-of-defun-raw' to call.
194This is used to find the beginning of the defun instead of using the
ab22ee53
RS
195normal recipe (see `beginning-of-defun'). Major modes can define this
196if defining `defun-prompt-regexp' is not sufficient to handle the mode's
197needs.
c6eeec65 198
50bfa18a
SM
199The function takes the same argument as `beginning-of-defun' and should
200behave similarly, returning non-nil if it found the beginning of a defun.
201Ideally it should move to a point right before an open-paren which encloses
202the body of the defun.")
c6eeec65 203
b73b9811 204(defun beginning-of-defun (&optional arg)
205 "Move backward to the beginning of a defun.
6957495d
CY
206With ARG, do it that many times. Negative ARG means move forward
207to the ARGth following beginning of defun.
208
209If search is successful, return t; point ends up at the beginning
210of the line where the search succeeded. Otherwise, return nil.
211
212When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
213is assumed to start where there is a char with open-parenthesis
214syntax at the beginning of a line. If `defun-prompt-regexp' is
215non-nil, then a string which matches that regexp may also precede
216the open-parenthesis. If `defun-prompt-regexp' and
217`open-paren-in-column-0-is-defun-start' are both nil, this
218function instead finds an open-paren at the outermost level.
219
220If the variable `beginning-of-defun-function' is non-nil, its
221value is called as a function, with argument ARG, to find the
222defun's beginning.
223
224Regardless of the values of `defun-prompt-regexp' and
225`beginning-of-defun-function', point always moves to the
226beginning of the line whenever the search is successful."
61eee794 227 (interactive "^p")
90c08845 228 (or (not (eq this-command 'beginning-of-defun))
967e1a52
JL
229 (eq last-command 'beginning-of-defun)
230 (and transient-mark-mode mark-active)
231 (push-mark))
afa995e1
KH
232 (and (beginning-of-defun-raw arg)
233 (progn (beginning-of-line) t)))
234
235(defun beginning-of-defun-raw (&optional arg)
236 "Move point to the character that starts a defun.
c6eeec65
DL
237This is identical to function `beginning-of-defun', except that point
238does not move to the beginning of the line when `defun-prompt-regexp'
239is non-nil.
240
ab22ee53
RS
241If variable `beginning-of-defun-function' is non-nil, its value
242is called as a function to find the defun's beginning."
61eee794 243 (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG
4df5698c
CY
244 ; to beginning-of-defun-function.
245 (unless arg (setq arg 1))
6cb54822
AM
246 (cond
247 (beginning-of-defun-function
50bfa18a
SM
248 (condition-case nil
249 (funcall beginning-of-defun-function arg)
250 ;; We used to define beginning-of-defun-function as taking no argument
251 ;; but that makes it impossible to implement correct forward motion:
252 ;; we used to use end-of-defun for that, but it's not supposed to do
253 ;; the same thing (it moves to the end of a defun not to the beginning
254 ;; of the next).
255 ;; In case the beginning-of-defun-function uses the old calling
256 ;; convention, fallback on the old implementation.
257 (wrong-number-of-arguments
258 (if (> arg 0)
259 (dotimes (i arg)
260 (funcall beginning-of-defun-function))
261 ;; Better not call end-of-defun-function directly, in case
262 ;; it's not defined.
263 (end-of-defun (- arg))))))
6cb54822
AM
264
265 ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
266 (and (< arg 0) (not (eobp)) (forward-char 1))
c6eeec65 267 (and (re-search-backward (if defun-prompt-regexp
418d645c
GM
268 (concat (if open-paren-in-column-0-is-defun-start
269 "^\\s(\\|" "")
b5ed9def 270 "\\(?:" defun-prompt-regexp "\\)\\s(")
c6eeec65 271 "^\\s(")
6cb54822 272 nil 'move arg)
4114bc49
SM
273 (progn (goto-char (1- (match-end 0)))
274 t)))
6cb54822 275
4df5698c
CY
276 ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
277 ;; are both nil, column 0 has no significance - so scan forward
278 ;; from BOB to see how nested point is, then carry on from there.
279 ;;
280 ;; It is generally not a good idea to land up here, because the
281 ;; call to scan-lists below can be extremely slow. This is because
282 ;; back_comment in syntax.c may have to scan from bob to find the
283 ;; beginning of each comment. Fixing this is not trivial -- cyd.
284
285 ((eq arg 0))
6cb54822 286 (t
4df5698c
CY
287 (let ((floor (point-min))
288 (ceiling (point-max))
289 (arg-+ve (> arg 0)))
6cb54822
AM
290 (save-restriction
291 (widen)
4df5698c
CY
292 (let ((ppss (let (syntax-begin-function
293 font-lock-beginning-of-syntax-function)
294 (syntax-ppss)))
295 ;; position of least enclosing paren, or nil.
296 encl-pos)
297 ;; Back out of any comment/string, so that encl-pos will always
298 ;; become nil if we're at top-level.
299 (when (nth 8 ppss)
300 (goto-char (nth 8 ppss))
301 (setq ppss (syntax-ppss))) ; should be fast, due to cache.
302 (setq encl-pos (syntax-ppss-toplevel-pos ppss))
303 (if encl-pos (goto-char encl-pos))
304
305 (and encl-pos arg-+ve (setq arg (1- arg)))
306 (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s("))
307 (setq arg (1+ arg)))
308
309 (condition-case nil ; to catch crazy parens.
310 (progn
311 (goto-char (scan-lists (point) (- arg) 0))
312 (if arg-+ve
313 (if (>= (point) floor)
314 t
315 (goto-char floor)
316 nil)
317 ;; forward to next (, or trigger the c-c
318 (goto-char (1- (scan-lists (point) 1 -1)))
319 (if (<= (point) ceiling)
320 t
321 (goto-char ceiling)
322 nil)))
323 (error
324 (goto-char (if arg-+ve floor ceiling))
325 nil))))))))
c6eeec65 326
7bbab3e0
SM
327(defvar end-of-defun-function
328 (lambda () (forward-sexp 1))
61e21607 329 "Function for `end-of-defun' to call.
6d3e4d22 330This is used to find the end of the defun at point.
61e21607 331It is called with no argument, right after calling `beginning-of-defun-raw'.
6d3e4d22
SM
332So the function can assume that point is at the beginning of the defun body.
333It should move point to the first position after the defun.")
b73b9811 334
335(defun buffer-end (arg)
a64dc1a4 336 "Return the \"far end\" position of the buffer, in direction ARG.
03deb635
RS
337If ARG is positive, that's the end of the buffer.
338Otherwise, that's the beginning of the buffer."
b73b9811 339 (if (> arg 0) (point-max) (point-min)))
340
341(defun end-of-defun (&optional arg)
a64dc1a4
LT
342 "Move forward to next end of defun.
343With argument, do it that many times.
b73b9811 344Negative argument -N means move back to Nth preceding end of defun.
345
c6eeec65
DL
346An end of a defun occurs right after the close-parenthesis that
347matches the open-parenthesis that starts a defun; see function
ab22ee53
RS
348`beginning-of-defun'.
349
350If variable `end-of-defun-function' is non-nil, its value
351is called as a function to find the defun's end."
61eee794 352 (interactive "^p")
90c08845 353 (or (not (eq this-command 'end-of-defun))
967e1a52
JL
354 (eq last-command 'end-of-defun)
355 (and transient-mark-mode mark-active)
356 (push-mark))
44b254cc 357 (if (or (null arg) (= arg 0)) (setq arg 1))
f9f34ece
SM
358 (let ((pos (point))
359 (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))))
360 (funcall end-of-defun-function)
f2a8252a
SM
361 ;; When comparing point against pos, we want to consider that if
362 ;; point was right after the end of the function, it's still
363 ;; considered as "in that function".
364 ;; E.g. `eval-defun' from right after the last close-paren.
365 (unless (bolp)
366 (skip-chars-forward " \t")
367 (if (looking-at "\\s<\\|\n")
368 (forward-line 1)))
f9f34ece
SM
369 (cond
370 ((> arg 0)
371 ;; Moving forward.
372 (if (> (point) pos)
373 ;; We already moved forward by one because we started from
374 ;; within a function.
375 (setq arg (1- arg))
376 ;; We started from after the end of the previous function.
377 (goto-char pos))
378 (unless (zerop arg)
379 (beginning-of-defun-raw (- arg))
380 (funcall end-of-defun-function)))
381 ((< arg 0)
382 ;; Moving backward.
383 (if (< (point) pos)
384 ;; We already moved backward because we started from between
385 ;; two functions.
386 (setq arg (1+ arg))
387 ;; We started from inside a function.
388 (goto-char beg))
389 (unless (zerop arg)
390 (beginning-of-defun-raw (- arg))
391 (funcall end-of-defun-function))))
392 (unless (bolp)
393 (skip-chars-forward " \t")
394 (if (looking-at "\\s<\\|\n")
395 (forward-line 1)))))
b73b9811 396
afb62fdd 397(defun mark-defun (&optional allow-extend)
b73b9811 398 "Put mark at end of this defun, point at beginning.
cad113ae 399The defun marked is the one that contains point or follows point.
afb62fdd
RS
400
401Interactively, if this command is repeated
a64dc1a4 402or (in Transient Mark mode) if the mark is active,
afb62fdd
RS
403it marks the next defun after the ones already marked."
404 (interactive "p")
405 (cond ((and allow-extend
406 (or (and (eq last-command this-command) (mark t))
407 (and transient-mark-mode mark-active)))
be0d25b6
KG
408 (set-mark
409 (save-excursion
410 (goto-char (mark))
411 (end-of-defun)
412 (point))))
413 (t
d3d6bc9b
RS
414 (let ((opoint (point))
415 beg end)
416 (push-mark opoint)
417 ;; Try first in this order for the sake of languages with nested
418 ;; functions where several can end at the same place as with
419 ;; the offside rule, e.g. Python.
420 (beginning-of-defun)
421 (setq beg (point))
422 (end-of-defun)
423 (setq end (point))
424 (while (looking-at "^\n")
425 (forward-line 1))
426 (if (> (point) opoint)
427 (progn
428 ;; We got the right defun.
429 (push-mark beg nil t)
430 (goto-char end)
431 (exchange-point-and-mark))
432 ;; beginning-of-defun moved back one defun
433 ;; so we got the wrong one.
434 (goto-char opoint)
435 (end-of-defun)
436 (push-mark (point) nil t)
437 (beginning-of-defun))
438 (re-search-backward "^\n" (- (point) 1) t)))))
b73b9811 439
3f7e952d
RS
440(defun narrow-to-defun (&optional arg)
441 "Make text outside current defun invisible.
c6eeec65
DL
442The defun visible is the one that contains point or follows point.
443Optional ARG is ignored."
3f7e952d
RS
444 (interactive)
445 (save-excursion
446 (widen)
d3d6bc9b
RS
447 (let ((opoint (point))
448 beg end)
449 ;; Try first in this order for the sake of languages with nested
450 ;; functions where several can end at the same place as with
451 ;; the offside rule, e.g. Python.
452 (beginning-of-defun)
453 (setq beg (point))
750e563f 454 (end-of-defun)
d3d6bc9b
RS
455 (setq end (point))
456 (while (looking-at "^\n")
457 (forward-line 1))
458 (unless (> (point) opoint)
459 ;; beginning-of-defun moved back one defun
460 ;; so we got the wrong one.
461 (goto-char opoint)
462 (end-of-defun)
463 (setq end (point))
464 (beginning-of-defun)
465 (setq beg (point)))
466 (goto-char end)
467 (re-search-backward "^\n" (- (point) 1) t)
468 (narrow-to-region beg end))))
3f7e952d 469
d97c8198
JL
470(defvar insert-pair-alist
471 '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
472 "Alist of paired characters inserted by `insert-pair'.
473Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
474OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
475of the pair whose key is equal to the last input character with
476or without modifiers, are inserted by `insert-pair'.")
477
478(defun insert-pair (&optional arg open close)
5891bf24
JL
479 "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
480Leave point after the first character.
e3ac26cb 481A negative ARG encloses the preceding ARG sexps instead.
5891bf24
JL
482No argument is equivalent to zero: just insert characters
483and leave point between.
d5bfe076 484If `parens-require-spaces' is non-nil, this command also inserts a space
5891bf24 485before and after, depending on the surrounding characters.
d97c8198
JL
486If region is active, insert enclosing characters at region boundaries.
487
488If arguments OPEN and CLOSE are nil, the character pair is found
489from the variable `insert-pair-alist' according to the last input
490character with or without modifiers. If no character pair is
491found in the variable `insert-pair-alist', then the last input
8fc2ac41
AM
492character is inserted ARG times.
493
494This command assumes point is not in a string or comment."
b73b9811 495 (interactive "P")
d97c8198 496 (if (not (and open close))
61a846fb 497 (let ((pair (or (assq last-command-event insert-pair-alist)
d97c8198
JL
498 (assq (event-basic-type last-command-event)
499 insert-pair-alist))))
500 (if pair
501 (if (nth 2 pair)
502 (setq open (nth 1 pair) close (nth 2 pair))
503 (setq open (nth 0 pair) close (nth 1 pair))))))
504 (if (and open close)
505 (if (and transient-mark-mode mark-active)
506 (progn
507 (save-excursion (goto-char (region-end)) (insert close))
508 (save-excursion (goto-char (region-beginning)) (insert open)))
509 (if arg (setq arg (prefix-numeric-value arg))
510 (setq arg 0))
511 (cond ((> arg 0) (skip-chars-forward " \t"))
512 ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
513 (and parens-require-spaces
514 (not (bobp))
515 (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
516 (insert " "))
517 (insert open)
518 (save-excursion
519 (or (eq arg 0) (forward-sexp arg))
520 (insert close)
521 (and parens-require-spaces
522 (not (eobp))
523 (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
524 (insert " "))))
525 (insert-char (event-basic-type last-command-event)
526 (prefix-numeric-value arg))))
527
528(defun insert-parentheses (&optional arg)
a64dc1a4
LT
529 "Enclose following ARG sexps in parentheses.
530Leave point after open-paren.
5891bf24
JL
531A negative ARG encloses the preceding ARG sexps instead.
532No argument is equivalent to zero: just insert `()' and leave point between.
533If `parens-require-spaces' is non-nil, this command also inserts a space
534before and after, depending on the surrounding characters.
8fc2ac41
AM
535If region is active, insert enclosing characters at region boundaries.
536
537This command assumes point is not in a string or comment."
5891bf24
JL
538 (interactive "P")
539 (insert-pair arg ?\( ?\)))
b73b9811 540
d97c8198
JL
541(defun delete-pair ()
542 "Delete a pair of characters enclosing the sexp that follows point."
543 (interactive)
544 (save-excursion (forward-sexp 1) (delete-char -1))
545 (delete-char 1))
546
547(defun raise-sexp (&optional arg)
548 "Raise ARG sexps higher up the tree."
549 (interactive "p")
550 (let ((s (if (and transient-mark-mode mark-active)
551 (buffer-substring (region-beginning) (region-end))
552 (buffer-substring
553 (point)
554 (save-excursion (forward-sexp arg) (point))))))
555 (backward-up-list 1)
556 (delete-region (point) (save-excursion (forward-sexp 1) (point)))
557 (save-excursion (insert s))))
558
b73b9811 559(defun move-past-close-and-reindent ()
560 "Move past next `)', delete indentation before it, then indent after it."
561 (interactive)
562 (up-list 1)
563 (forward-char -1)
564 (while (save-excursion ; this is my contribution
565 (let ((before-paren (point)))
566 (back-to-indentation)
adce3b5f
RS
567 (and (= (point) before-paren)
568 (progn
569 ;; Move to end of previous line.
570 (beginning-of-line)
571 (forward-char -1)
572 ;; Verify it doesn't end within a string or comment.
573 (let ((end (point))
574 state)
575 (beginning-of-line)
576 ;; Get state at start of line.
c6eeec65 577 (setq state (list 0 nil nil
adce3b5f
RS
578 (null (calculate-lisp-indent))
579 nil nil nil nil
580 nil))
581 ;; Parse state across the line to get state at end.
582 (setq state (parse-partial-sexp (point) end nil nil
583 state))
584 ;; Check not in string or comment.
585 (and (not (elt state 3)) (not (elt state 4))))))))
b73b9811 586 (delete-indentation))
587 (forward-char 1)
588 (newline-and-indent))
c6eeec65
DL
589
590(defun check-parens () ; lame name?
591 "Check for unbalanced parentheses in the current buffer.
592More accurately, check the narrowed part of the buffer for unbalanced
593expressions (\"sexps\") in general. This is done according to the
594current syntax table and will find unbalanced brackets or quotes as
7bc10886 595appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is
8ad8cfa5 596found, an error is signaled and point is left at the first unbalanced
7bc10886 597character."
c6eeec65
DL
598 (interactive)
599 (condition-case data
600 ;; Buffer can't have more than (point-max) sexps.
601 (scan-sexps (point-min) (point-max))
602 (scan-error (goto-char (nth 2 data))
603 ;; Could print (nth 1 data), which is either
604 ;; "Containing expression ends prematurely" or
605 ;; "Unbalanced parentheses", but those may not be so
606 ;; accurate/helpful, e.g. quotes may actually be
607 ;; mismatched.
61e21607 608 (error "Unmatched bracket or quote"))))
b73b9811 609\f
61e21607 610(defun field-complete (table &optional predicate)
73ebf88f
SM
611 (let ((minibuffer-completion-table table)
612 (minibuffer-completion-predicate predicate)
613 ;; This made sense for lisp-complete-symbol, but for
614 ;; field-complete, this is out of place. --Stef
615 ;; (completion-annotate-function
616 ;; (unless (eq predicate 'fboundp)
617 ;; (lambda (str)
618 ;; (if (fboundp (intern-soft str)) " <f>"))))
619 )
620 (call-interactively 'minibuffer-complete)))
61e21607 621
e50c4203 622(defun lisp-complete-symbol (&optional predicate)
2eb9adab
RS
623 "Perform completion on Lisp symbol preceding point.
624Compare that symbol against the known Lisp symbols.
1fa1cb1b
RS
625If no characters can be completed, display a list of possible completions.
626Repeating the command at that point scrolls the list.
2eb9adab 627
e50c4203
DL
628When called from a program, optional arg PREDICATE is a predicate
629determining which symbols are considered, e.g. `commandp'.
630If PREDICATE is nil, the context determines which symbols are
631considered. If the symbol starts just after an open-parenthesis, only
632symbols with function definitions are considered. Otherwise, all
633symbols with function definitions, values or properties are
634considered."
b73b9811 635 (interactive)
51ef56c4
SM
636 (let* ((data (lisp-completion-at-point predicate))
637 (plist (nthcdr 3 data)))
ccaa4765
SM
638 (if (null data)
639 (minibuffer-message "Nothing to complete")
640 (let ((completion-annotate-function
641 (plist-get plist :annotate-function)))
51ef56c4 642 (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
ccaa4765 643 (plist-get plist :predicate))))))
0ca12598 644
51ef56c4
SM
645
646(defun lisp-completion-at-point (&optional predicate)
0ca12598 647 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
51ef56c4 648 ;; FIXME: the `end' could be after point?
4c528197 649 (with-syntax-table emacs-lisp-mode-syntax-table
4c14013d
JB
650 (let* ((pos (point))
651 (beg (condition-case nil
652 (save-excursion
653 (backward-sexp 1)
654 (skip-syntax-forward "'")
655 (point))
656 (scan-error pos)))
657 (predicate
658 (or predicate
659 (save-excursion
660 (goto-char beg)
661 (if (not (eq (char-before) ?\())
662 (lambda (sym) ;why not just nil ? -sm
663 (or (boundp sym) (fboundp sym)
664 (symbol-plist sym)))
665 ;; Looks like a funcall position. Let's double check.
666 (if (condition-case nil
667 (progn (up-list -2) (forward-char 1)
668 (eq (char-after) ?\())
669 (error nil))
670 ;; If the first element of the parent list is an open
671 ;; paren we are probably not in a funcall position.
672 ;; Maybe a `let' varlist or something.
673 nil
674 ;; Else, we assume that a function name is expected.
675 'fboundp)))))
676 (end
677 (unless (or (eq beg (point-max))
678 (member (char-syntax (char-after beg)) '(?\" ?\( ?\))))
679 (condition-case nil
680 (save-excursion
681 (goto-char beg)
682 (forward-sexp 1)
683 (when (>= (point) pos)
684 (point)))
685 (scan-error pos)))))
686 (when end
687 (list beg end obarray
688 :predicate predicate
689 :annotate-function
690 (unless (eq predicate 'fboundp)
691 (lambda (str) (if (fboundp (intern-soft str)) " <f>"))))))))
6594deb0 692
398de718 693;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
6594deb0 694;;; lisp.el ends here