]> code.delx.au - gnu-emacs/blob - lisp/emacs-lisp/lisp.el
Merge from emacs-23
[gnu-emacs] / lisp / emacs-lisp / lisp.el
1 ;;; lisp.el --- Lisp editing commands for Emacs
2
3 ;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004,
4 ;; 2005, 2006, 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
5
6 ;; Maintainer: FSF
7 ;; Keywords: lisp, languages
8 ;; Package: emacs
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
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
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; Lisp editing commands to go with Lisp major mode. More-or-less
28 ;; applicable in other modes too.
29
30 ;;; Code:
31
32 ;; Note that this variable is used by non-lisp modes too.
33 (defcustom defun-prompt-regexp nil
34 "If non-nil, a regexp to ignore before a defun.
35 This is only necessary if the opening paren or brace is not in column 0.
36 See function `beginning-of-defun'."
37 :type '(choice (const nil)
38 regexp)
39 :group 'lisp)
40 (make-variable-buffer-local 'defun-prompt-regexp)
41
42 (defcustom parens-require-spaces t
43 "If non-nil, add whitespace as needed when inserting parentheses.
44 This affects `insert-parentheses' and `insert-pair'."
45 :type 'boolean
46 :group 'lisp)
47
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
52 (defun forward-sexp (&optional arg)
53 "Move forward across one balanced expression (sexp).
54 With ARG, do it that many times. Negative arg -N means
55 move backward across N balanced expressions.
56 This command assumes point is not in a string or comment."
57 (interactive "^p")
58 (or arg (setq arg 1))
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))))
63
64 (defun backward-sexp (&optional arg)
65 "Move backward across one balanced expression (sexp).
66 With ARG, do it that many times. Negative arg -N means
67 move forward across N balanced expressions.
68 This command assumes point is not in a string or comment."
69 (interactive "^p")
70 (or arg (setq arg 1))
71 (forward-sexp (- arg)))
72
73 (defun mark-sexp (&optional arg allow-extend)
74 "Set mark ARG sexps from point.
75 The place mark goes is the same place \\[forward-sexp] would
76 move to with the same argument.
77 Interactively, if this command is repeated
78 or (in Transient Mark mode) if the mark is active,
79 it marks the next ARG sexps after the ones already marked.
80 This command assumes point is not in a string or comment."
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)))
85 (setq arg (if arg (prefix-numeric-value arg)
86 (if (< (mark) (point)) -1 1)))
87 (set-mark
88 (save-excursion
89 (goto-char (mark))
90 (forward-sexp arg)
91 (point))))
92 (t
93 (push-mark
94 (save-excursion
95 (forward-sexp (prefix-numeric-value arg))
96 (point))
97 nil t))))
98
99 (defun forward-list (&optional arg)
100 "Move forward across one balanced group of parentheses.
101 With ARG, do it that many times.
102 Negative arg -N means move backward across N groups of parentheses.
103 This command assumes point is not in a string or comment."
104 (interactive "^p")
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.
110 With ARG, do it that many times.
111 Negative arg -N means move forward across N groups of parentheses.
112 This command assumes point is not in a string or comment."
113 (interactive "^p")
114 (or arg (setq arg 1))
115 (forward-list (- arg)))
116
117 (defun down-list (&optional arg)
118 "Move forward down one level of parentheses.
119 With ARG, do this that many times.
120 A negative argument means move backward but still go down a level.
121 This command assumes point is not in a string or comment."
122 (interactive "^p")
123 (or arg (setq arg 1))
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
129 (defun backward-up-list (&optional arg)
130 "Move backward out of one level of parentheses.
131 With ARG, do this that many times.
132 A negative argument means move forward but still to a less deep spot.
133 This command assumes point is not in a string or comment."
134 (interactive "^p")
135 (up-list (- (or arg 1))))
136
137 (defun up-list (&optional arg)
138 "Move forward out of one level of parentheses.
139 With ARG, do this that many times.
140 A negative argument means move backward but still to a less deep spot.
141 This command assumes point is not in a string or comment."
142 (interactive "^p")
143 (or arg (setq arg 1))
144 (let ((inc (if (> arg 0) 1 -1))
145 pos)
146 (while (/= arg 0)
147 (if (null forward-sexp-function)
148 (goto-char (or (scan-lists (point) inc 1) (buffer-end arg)))
149 (condition-case err
150 (while (progn (setq pos (point))
151 (forward-sexp inc)
152 (/= (point) pos)))
153 (scan-error (goto-char (nth 2 err))))
154 (if (= (point) pos)
155 (signal 'scan-error
156 (list "Unbalanced parentheses" (point) (point)))))
157 (setq arg (- arg inc)))))
158
159 (defun kill-sexp (&optional arg)
160 "Kill the sexp (balanced expression) following point.
161 With ARG, kill that many sexps after point.
162 Negative arg -N means kill N sexps before point.
163 This command assumes point is not in a string or comment."
164 (interactive "p")
165 (let ((opoint (point)))
166 (forward-sexp (or arg 1))
167 (kill-region opoint (point))))
168
169 (defun backward-kill-sexp (&optional arg)
170 "Kill the sexp (balanced expression) preceding point.
171 With ARG, kill that many sexps before point.
172 Negative arg -N means kill N sexps after point.
173 This command assumes point is not in a string or comment."
174 (interactive "p")
175 (kill-sexp (- (or arg 1))))
176
177 ;; After Zmacs:
178 (defun kill-backward-up-list (&optional arg)
179 "Kill the form containing the current sexp, leaving the sexp itself.
180 A prefix argument ARG causes the relevant number of surrounding
181 forms to be removed.
182 This command assumes point is not in a string or comment."
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"))))
191 \f
192 (defvar beginning-of-defun-function nil
193 "If non-nil, function for `beginning-of-defun-raw' to call.
194 This is used to find the beginning of the defun instead of using the
195 normal recipe (see `beginning-of-defun'). Major modes can define this
196 if defining `defun-prompt-regexp' is not sufficient to handle the mode's
197 needs.
198
199 The function takes the same argument as `beginning-of-defun' and should
200 behave similarly, returning non-nil if it found the beginning of a defun.
201 Ideally it should move to a point right before an open-paren which encloses
202 the body of the defun.")
203
204 (defun beginning-of-defun (&optional arg)
205 "Move backward to the beginning of a defun.
206 With ARG, do it that many times. Negative ARG means move forward
207 to the ARGth following beginning of defun.
208
209 If search is successful, return t; point ends up at the beginning
210 of the line where the search succeeded. Otherwise, return nil.
211
212 When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
213 is assumed to start where there is a char with open-parenthesis
214 syntax at the beginning of a line. If `defun-prompt-regexp' is
215 non-nil, then a string which matches that regexp may also precede
216 the open-parenthesis. If `defun-prompt-regexp' and
217 `open-paren-in-column-0-is-defun-start' are both nil, this
218 function instead finds an open-paren at the outermost level.
219
220 If the variable `beginning-of-defun-function' is non-nil, its
221 value is called as a function, with argument ARG, to find the
222 defun's beginning.
223
224 Regardless of the values of `defun-prompt-regexp' and
225 `beginning-of-defun-function', point always moves to the
226 beginning of the line whenever the search is successful."
227 (interactive "^p")
228 (or (not (eq this-command 'beginning-of-defun))
229 (eq last-command 'beginning-of-defun)
230 (and transient-mark-mode mark-active)
231 (push-mark))
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.
237 This is identical to function `beginning-of-defun', except that point
238 does not move to the beginning of the line when `defun-prompt-regexp'
239 is non-nil.
240
241 If variable `beginning-of-defun-function' is non-nil, its value
242 is called as a function to find the defun's beginning."
243 (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG
244 ; to beginning-of-defun-function.
245 (unless arg (setq arg 1))
246 (cond
247 (beginning-of-defun-function
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))))))
264
265 ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
266 (and (< arg 0) (not (eobp)) (forward-char 1))
267 (and (re-search-backward (if defun-prompt-regexp
268 (concat (if open-paren-in-column-0-is-defun-start
269 "^\\s(\\|" "")
270 "\\(?:" defun-prompt-regexp "\\)\\s(")
271 "^\\s(")
272 nil 'move arg)
273 (progn (goto-char (1- (match-end 0)))
274 t)))
275
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))
286 (t
287 (let ((floor (point-min))
288 (ceiling (point-max))
289 (arg-+ve (> arg 0)))
290 (save-restriction
291 (widen)
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))))))))
326
327 (defvar end-of-defun-function
328 (lambda () (forward-sexp 1))
329 "Function for `end-of-defun' to call.
330 This is used to find the end of the defun at point.
331 It is called with no argument, right after calling `beginning-of-defun-raw'.
332 So the function can assume that point is at the beginning of the defun body.
333 It should move point to the first position after the defun.")
334
335 (defun buffer-end (arg)
336 "Return the \"far end\" position of the buffer, in direction ARG.
337 If ARG is positive, that's the end of the buffer.
338 Otherwise, that's the beginning of the buffer."
339 (if (> arg 0) (point-max) (point-min)))
340
341 (defun end-of-defun (&optional arg)
342 "Move forward to next end of defun.
343 With argument, do it that many times.
344 Negative argument -N means move back to Nth preceding end of defun.
345
346 An end of a defun occurs right after the close-parenthesis that
347 matches the open-parenthesis that starts a defun; see function
348 `beginning-of-defun'.
349
350 If variable `end-of-defun-function' is non-nil, its value
351 is called as a function to find the defun's end."
352 (interactive "^p")
353 (or (not (eq this-command 'end-of-defun))
354 (eq last-command 'end-of-defun)
355 (and transient-mark-mode mark-active)
356 (push-mark))
357 (if (or (null arg) (= arg 0)) (setq arg 1))
358 (let ((pos (point))
359 (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))))
360 (funcall end-of-defun-function)
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)))
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)))))
396
397 (defun mark-defun (&optional allow-extend)
398 "Put mark at end of this defun, point at beginning.
399 The defun marked is the one that contains point or follows point.
400
401 Interactively, if this command is repeated
402 or (in Transient Mark mode) if the mark is active,
403 it 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)))
408 (set-mark
409 (save-excursion
410 (goto-char (mark))
411 (end-of-defun)
412 (point))))
413 (t
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)))))
439
440 (defun narrow-to-defun (&optional arg)
441 "Make text outside current defun invisible.
442 The defun visible is the one that contains point or follows point.
443 Optional ARG is ignored."
444 (interactive)
445 (save-excursion
446 (widen)
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))
454 (end-of-defun)
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))))
469
470 (defvar insert-pair-alist
471 '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
472 "Alist of paired characters inserted by `insert-pair'.
473 Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
474 OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
475 of the pair whose key is equal to the last input character with
476 or without modifiers, are inserted by `insert-pair'.")
477
478 (defun insert-pair (&optional arg open close)
479 "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
480 Leave point after the first character.
481 A negative ARG encloses the preceding ARG sexps instead.
482 No argument is equivalent to zero: just insert characters
483 and leave point between.
484 If `parens-require-spaces' is non-nil, this command also inserts a space
485 before and after, depending on the surrounding characters.
486 If region is active, insert enclosing characters at region boundaries.
487
488 If arguments OPEN and CLOSE are nil, the character pair is found
489 from the variable `insert-pair-alist' according to the last input
490 character with or without modifiers. If no character pair is
491 found in the variable `insert-pair-alist', then the last input
492 character is inserted ARG times.
493
494 This command assumes point is not in a string or comment."
495 (interactive "P")
496 (if (not (and open close))
497 (let ((pair (or (assq last-command-event insert-pair-alist)
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)
529 "Enclose following ARG sexps in parentheses.
530 Leave point after open-paren.
531 A negative ARG encloses the preceding ARG sexps instead.
532 No argument is equivalent to zero: just insert `()' and leave point between.
533 If `parens-require-spaces' is non-nil, this command also inserts a space
534 before and after, depending on the surrounding characters.
535 If region is active, insert enclosing characters at region boundaries.
536
537 This command assumes point is not in a string or comment."
538 (interactive "P")
539 (insert-pair arg ?\( ?\)))
540
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
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)
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.
577 (setq state (list 0 nil nil
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))))))))
586 (delete-indentation))
587 (forward-char 1)
588 (newline-and-indent))
589
590 (defun check-parens () ; lame name?
591 "Check for unbalanced parentheses in the current buffer.
592 More accurately, check the narrowed part of the buffer for unbalanced
593 expressions (\"sexps\") in general. This is done according to the
594 current syntax table and will find unbalanced brackets or quotes as
595 appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is
596 found, an error is signaled and point is left at the first unbalanced
597 character."
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.
608 (error "Unmatched bracket or quote"))))
609 \f
610 (defun field-complete (table &optional predicate)
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)))
621
622 (defun lisp-complete-symbol (&optional predicate)
623 "Perform completion on Lisp symbol preceding point.
624 Compare that symbol against the known Lisp symbols.
625 If no characters can be completed, display a list of possible completions.
626 Repeating the command at that point scrolls the list.
627
628 When called from a program, optional arg PREDICATE is a predicate
629 determining which symbols are considered, e.g. `commandp'.
630 If PREDICATE is nil, the context determines which symbols are
631 considered. If the symbol starts just after an open-parenthesis, only
632 symbols with function definitions are considered. Otherwise, all
633 symbols with function definitions, values or properties are
634 considered."
635 (interactive)
636 (let* ((data (lisp-completion-at-point predicate))
637 (plist (nthcdr 3 data)))
638 (if (null data)
639 (minibuffer-message "Nothing to complete")
640 (let ((completion-annotate-function
641 (plist-get plist :annotate-function)))
642 (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
643 (plist-get plist :predicate))))))
644
645
646 (defun lisp-completion-at-point (&optional predicate)
647 "Function used for `completion-at-point-functions' in `emacs-lisp-mode'."
648 ;; FIXME: the `end' could be after point?
649 (with-syntax-table emacs-lisp-mode-syntax-table
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>"))))))))
692
693 ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
694 ;;; lisp.el ends here