659
|
1 ;;; lisp.el --- Lisp editing commands for Emacs
|
|
2
|
74466
|
3 ;; Copyright (C) 1985, 1986, 1994, 2000, 2001, 2002, 2003, 2004,
|
75346
|
4 ;; 2005, 2006, 2007 Free Software Foundation, Inc.
|
845
|
5
|
807
|
6 ;; Maintainer: FSF
|
2247
|
7 ;; Keywords: lisp, languages
|
807
|
8
|
84
|
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
|
807
|
13 ;; the Free Software Foundation; either version 2, or (at your option)
|
84
|
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
|
14169
|
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
|
64085
|
23 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
|
|
24 ;; Boston, MA 02110-1301, USA.
|
84
|
25
|
2307
|
26 ;;; Commentary:
|
|
27
|
30979
|
28 ;; Lisp editing commands to go with Lisp major mode. More-or-less
|
|
29 ;; applicable in other modes too.
|
2307
|
30
|
807
|
31 ;;; Code:
|
84
|
32
|
6369
|
33 ;; Note that this variable is used by non-lisp modes too.
|
17665
|
34 (defcustom defun-prompt-regexp nil
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
35 "*If non-nil, a regexp to ignore before a defun.
|
6369
|
36 This is only necessary if the opening paren or brace is not in column 0.
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
37 See function `beginning-of-defun'."
|
19831
|
38 :type '(choice (const nil)
|
|
39 regexp)
|
17665
|
40 :group 'lisp)
|
6973
|
41 (make-variable-buffer-local 'defun-prompt-regexp)
|
84
|
42
|
17665
|
43 (defcustom parens-require-spaces t
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
44 "If non-nil, `insert-parentheses' inserts whitespace as needed."
|
17665
|
45 :type 'boolean
|
|
46 :group 'lisp)
|
3733
|
47
|
31982
|
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
|
84
|
52 (defun forward-sexp (&optional arg)
|
|
53 "Move forward across one balanced expression (sexp).
|
27190
|
54 With ARG, do it that many times. Negative arg -N means
|
215
|
55 move backward across N balanced expressions."
|
84
|
56 (interactive "p")
|
|
57 (or arg (setq arg 1))
|
31982
|
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))))
|
84
|
62
|
|
63 (defun backward-sexp (&optional arg)
|
|
64 "Move backward across one balanced expression (sexp).
|
27190
|
65 With ARG, do it that many times. Negative arg -N means
|
215
|
66 move forward across N balanced expressions."
|
84
|
67 (interactive "p")
|
|
68 (or arg (setq arg 1))
|
|
69 (forward-sexp (- arg)))
|
|
70
|
59177
|
71 (defun mark-sexp (&optional arg allow-extend)
|
84
|
72 "Set mark ARG sexps from point.
|
215
|
73 The place mark goes is the same place \\[forward-sexp] would
|
41291
|
74 move to with the same argument.
|
59177
|
75 Interactively, if this command is repeated
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
76 or (in Transient Mark mode) if the mark is active,
|
58918
|
77 it marks the next ARG sexps after the ones already marked."
|
59177
|
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)))
|
57457
|
82 (setq arg (if arg (prefix-numeric-value arg)
|
58918
|
83 (if (< (mark) (point)) -1 1)))
|
43301
|
84 (set-mark
|
|
85 (save-excursion
|
58918
|
86 (goto-char (mark))
|
|
87 (forward-sexp arg)
|
|
88 (point))))
|
43301
|
89 (t
|
|
90 (push-mark
|
|
91 (save-excursion
|
57457
|
92 (forward-sexp (prefix-numeric-value arg))
|
43301
|
93 (point))
|
|
94 nil t))))
|
84
|
95
|
|
96 (defun forward-list (&optional arg)
|
|
97 "Move forward across one balanced group of parentheses.
|
27190
|
98 With ARG, do it that many times.
|
84
|
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.
|
27190
|
106 With ARG, do it that many times.
|
84
|
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
|
30979
|
112 (defun down-list (&optional arg)
|
84
|
113 "Move forward down one level of parentheses.
|
27190
|
114 With ARG, do this that many times.
|
32456
|
115 A negative argument means move backward but still go down a level."
|
84
|
116 (interactive "p")
|
30979
|
117 (or arg (setq arg 1))
|
84
|
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
|
30979
|
123 (defun backward-up-list (&optional arg)
|
84
|
124 "Move backward out of one level of parentheses.
|
27190
|
125 With ARG, do this that many times.
|
32456
|
126 A negative argument means move forward but still to a less deep spot."
|
84
|
127 (interactive "p")
|
30979
|
128 (up-list (- (or arg 1))))
|
84
|
129
|
30979
|
130 (defun up-list (&optional arg)
|
84
|
131 "Move forward out of one level of parentheses.
|
27190
|
132 With ARG, do this that many times.
|
32456
|
133 A negative argument means move backward but still to a less deep spot."
|
84
|
134 (interactive "p")
|
30979
|
135 (or arg (setq arg 1))
|
84
|
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
|
30979
|
141 (defun kill-sexp (&optional arg)
|
59602
|
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."
|
84
|
145 (interactive "p")
|
|
146 (let ((opoint (point)))
|
30979
|
147 (forward-sexp (or arg 1))
|
84
|
148 (kill-region opoint (point))))
|
|
149
|
30979
|
150 (defun backward-kill-sexp (&optional arg)
|
59602
|
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."
|
84
|
154 (interactive "p")
|
30979
|
155 (kill-sexp (- (or arg 1))))
|
56924
|
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"))))
|
84
|
170
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
171 (defvar beginning-of-defun-function nil
|
27190
|
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
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
174 normal recipe (see `beginning-of-defun'). Major modes can define this
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
175 if defining `defun-prompt-regexp' is not sufficient to handle the mode's
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
176 needs.
|
27190
|
177
|
52287
|
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.")
|
27190
|
181
|
84
|
182 (defun beginning-of-defun (&optional arg)
|
|
183 "Move backward to the beginning of a defun.
|
27190
|
184 With ARG, do it that many times. Negative arg -N
|
84
|
185 means move forward to Nth following beginning of defun.
|
|
186 Returns t unless search stops due to beginning or end of buffer.
|
|
187
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
188 If variable `beginning-of-defun-function' is non-nil, its value
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
189 is called as a function to find the defun's beginning.
|
27190
|
190
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
191 Normally a defun is assumed to start where there is a char with
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
192 open-parenthesis syntax at the beginning of a line. If
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
193 `defun-prompt-regexp' is non-nil, then a string which matches
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
194 that regexp may precede the open-parenthesis, and point ends up
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
195 at the beginning of the line.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
196
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
197 If `defun-prompt-regexp' and `open-paren-in-column-0-is-defun-start'
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
198 are both nil, the function instead finds an open-paren at the
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
199 outermost level."
|
6397
|
200 (interactive "p")
|
58962
|
201 (or (not (eq this-command 'beginning-of-defun))
|
58918
|
202 (eq last-command 'beginning-of-defun)
|
|
203 (and transient-mark-mode mark-active)
|
|
204 (push-mark))
|
6397
|
205 (and (beginning-of-defun-raw arg)
|
|
206 (progn (beginning-of-line) t)))
|
|
207
|
|
208 (defun beginning-of-defun-raw (&optional arg)
|
|
209 "Move point to the character that starts a defun.
|
27190
|
210 This is identical to function `beginning-of-defun', except that point
|
|
211 does not move to the beginning of the line when `defun-prompt-regexp'
|
|
212 is non-nil.
|
|
213
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
214 If variable `beginning-of-defun-function' is non-nil, its value
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
215 is called as a function to find the defun's beginning."
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
216 (interactive "p") ; change this to "P", maybe, if we ever come to pass ARG
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
217 ; to beginning-of-defun-function.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
218 (unless arg (setq arg 1))
|
73832
|
219 (cond
|
|
220 (beginning-of-defun-function
|
|
221 (if (> arg 0)
|
|
222 (dotimes (i arg)
|
|
223 (funcall beginning-of-defun-function))
|
|
224 ;; Better not call end-of-defun-function directly, in case
|
|
225 ;; it's not defined.
|
|
226 (end-of-defun (- arg))))
|
|
227
|
|
228 ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
|
|
229 (and (< arg 0) (not (eobp)) (forward-char 1))
|
27190
|
230 (and (re-search-backward (if defun-prompt-regexp
|
28299
|
231 (concat (if open-paren-in-column-0-is-defun-start
|
|
232 "^\\s(\\|" "")
|
51084
|
233 "\\(?:" defun-prompt-regexp "\\)\\s(")
|
27190
|
234 "^\\s(")
|
73832
|
235 nil 'move arg)
|
|
236 (progn (goto-char (1- (match-end 0)))) t))
|
|
237
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
238 ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
239 ;; are both nil, column 0 has no significance - so scan forward
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
240 ;; from BOB to see how nested point is, then carry on from there.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
241 ;;
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
242 ;; It is generally not a good idea to land up here, because the
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
243 ;; call to scan-lists below can be extremely slow. This is because
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
244 ;; back_comment in syntax.c may have to scan from bob to find the
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
245 ;; beginning of each comment. Fixing this is not trivial -- cyd.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
246
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
247 ((eq arg 0))
|
73832
|
248 (t
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
249 (let ((floor (point-min))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
250 (ceiling (point-max))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
251 (arg-+ve (> arg 0)))
|
73832
|
252 (save-restriction
|
|
253 (widen)
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
254 (let ((ppss (let (syntax-begin-function
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
255 font-lock-beginning-of-syntax-function)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
256 (syntax-ppss)))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
257 ;; position of least enclosing paren, or nil.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
258 encl-pos)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
259 ;; Back out of any comment/string, so that encl-pos will always
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
260 ;; become nil if we're at top-level.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
261 (when (nth 8 ppss)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
262 (goto-char (nth 8 ppss))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
263 (setq ppss (syntax-ppss))) ; should be fast, due to cache.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
264 (setq encl-pos (syntax-ppss-toplevel-pos ppss))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
265 (if encl-pos (goto-char encl-pos))
|
73832
|
266
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
267 (and encl-pos arg-+ve (setq arg (1- arg)))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
268 (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s("))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
269 (setq arg (1+ arg)))
|
73832
|
270
|
74708
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
271 (condition-case nil ; to catch crazy parens.
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
272 (progn
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
273 (goto-char (scan-lists (point) (- arg) 0))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
274 (if arg-+ve
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
275 (if (>= (point) floor)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
276 t
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
277 (goto-char floor)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
278 nil)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
279 ;; forward to next (, or trigger the c-c
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
280 (goto-char (1- (scan-lists (point) 1 -1)))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
281 (if (<= (point) ceiling)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
282 t
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
283 (goto-char ceiling)
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
284 nil)))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
285 (error
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
286 (goto-char (if arg-+ve floor ceiling))
|
ba0b39efd315
(beginning-of-defun-raw): Optimise (for speed) the case when
Chong Yidong <cyd@stupidchicken.com>
diff
changeset
|
287 nil))))))))
|
27190
|
288
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
289 (defvar end-of-defun-function nil
|
27190
|
290 "If non-nil, function for function `end-of-defun' to call.
|
|
291 This is used to find the end of the defun instead of using the normal
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
292 recipe (see `end-of-defun'). Major modes can define this if the
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
293 normal method is not appropriate.")
|
84
|
294
|
|
295 (defun buffer-end (arg)
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
296 "Return the \"far end\" position of the buffer, in direction ARG.
|
59940
|
297 If ARG is positive, that's the end of the buffer.
|
|
298 Otherwise, that's the beginning of the buffer."
|
84
|
299 (if (> arg 0) (point-max) (point-min)))
|
|
300
|
|
301 (defun end-of-defun (&optional arg)
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
302 "Move forward to next end of defun.
|
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
303 With argument, do it that many times.
|
84
|
304 Negative argument -N means move back to Nth preceding end of defun.
|
|
305
|
27190
|
306 An end of a defun occurs right after the close-parenthesis that
|
|
307 matches the open-parenthesis that starts a defun; see function
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
308 `beginning-of-defun'.
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
309
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
310 If variable `end-of-defun-function' is non-nil, its value
|
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
311 is called as a function to find the defun's end."
|
84
|
312 (interactive "p")
|
58962
|
313 (or (not (eq this-command 'end-of-defun))
|
58918
|
314 (eq last-command 'end-of-defun)
|
|
315 (and transient-mark-mode mark-active)
|
|
316 (push-mark))
|
54876
|
317 (if (or (null arg) (= arg 0)) (setq arg 1))
|
27380
59243c413664
(beginning-of-defun-function): Variable renamed from beginning-of-defun.
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
318 (if end-of-defun-function
|
54876
|
319 (if (> arg 0)
|
|
320 (dotimes (i arg)
|
|
321 (funcall end-of-defun-function))
|
|
322 ;; Better not call beginning-of-defun-function
|
|
323 ;; directly, in case it's not defined.
|
|
324 (beginning-of-defun (- arg)))
|
27190
|
325 (let ((first t))
|
|
326 (while (and (> arg 0) (< (point) (point-max)))
|
54876
|
327 (let ((pos (point)))
|
27190
|
328 (while (progn
|
|
329 (if (and first
|
|
330 (progn
|
|
331 (end-of-line 1)
|
|
332 (beginning-of-defun-raw 1)))
|
|
333 nil
|
|
334 (or (bobp) (forward-char -1))
|
|
335 (beginning-of-defun-raw -1))
|
|
336 (setq first nil)
|
|
337 (forward-list 1)
|
|
338 (skip-chars-forward " \t")
|
|
339 (if (looking-at "\\s<\\|\n")
|
|
340 (forward-line 1))
|
|
341 (<= (point) pos))))
|
|
342 (setq arg (1- arg)))
|
|
343 (while (< arg 0)
|
|
344 (let ((pos (point)))
|
|
345 (beginning-of-defun-raw 1)
|
|
346 (forward-sexp 1)
|
|
347 (forward-line 1)
|
|
348 (if (>= (point) pos)
|
|
349 (if (beginning-of-defun-raw 2)
|
|
350 (progn
|
|
351 (forward-list 1)
|
|
352 (skip-chars-forward " \t")
|
|
353 (if (looking-at "\\s<\\|\n")
|
|
354 (forward-line 1)))
|
|
355 (goto-char (point-min)))))
|
|
356 (setq arg (1+ arg))))))
|
84
|
357
|
59177
|
358 (defun mark-defun (&optional allow-extend)
|
84
|
359 "Put mark at end of this defun, point at beginning.
|
43301
|
360 The defun marked is the one that contains point or follows point.
|
59177
|
361
|
|
362 Interactively, if this command is repeated
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
363 or (in Transient Mark mode) if the mark is active,
|
59177
|
364 it marks the next defun after the ones already marked."
|
|
365 (interactive "p")
|
|
366 (cond ((and allow-extend
|
|
367 (or (and (eq last-command this-command) (mark t))
|
|
368 (and transient-mark-mode mark-active)))
|
43384
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
369 (set-mark
|
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
370 (save-excursion
|
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
371 (goto-char (mark))
|
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
372 (end-of-defun)
|
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
373 (point))))
|
cc3ba2d0d471
* emacs-lisp/lisp.el (mark-defun): Don't leave multiple marks
Kai Großjohann <kgrossjo@eu.uu.net>
diff
changeset
|
374 (t
|
55727
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
375 (let ((opoint (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
376 beg end)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
377 (push-mark opoint)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
378 ;; Try first in this order for the sake of languages with nested
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
379 ;; functions where several can end at the same place as with
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
380 ;; the offside rule, e.g. Python.
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
381 (beginning-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
382 (setq beg (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
383 (end-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
384 (setq end (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
385 (while (looking-at "^\n")
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
386 (forward-line 1))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
387 (if (> (point) opoint)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
388 (progn
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
389 ;; We got the right defun.
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
390 (push-mark beg nil t)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
391 (goto-char end)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
392 (exchange-point-and-mark))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
393 ;; beginning-of-defun moved back one defun
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
394 ;; so we got the wrong one.
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
395 (goto-char opoint)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
396 (end-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
397 (push-mark (point) nil t)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
398 (beginning-of-defun))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
399 (re-search-backward "^\n" (- (point) 1) t)))))
|
84
|
400
|
15971
|
401 (defun narrow-to-defun (&optional arg)
|
|
402 "Make text outside current defun invisible.
|
27190
|
403 The defun visible is the one that contains point or follows point.
|
|
404 Optional ARG is ignored."
|
15971
|
405 (interactive)
|
|
406 (save-excursion
|
|
407 (widen)
|
55727
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
408 (let ((opoint (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
409 beg end)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
410 ;; Try first in this order for the sake of languages with nested
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
411 ;; functions where several can end at the same place as with
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
412 ;; the offside rule, e.g. Python.
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
413 (beginning-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
414 (setq beg (point))
|
53752
|
415 (end-of-defun)
|
55727
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
416 (setq end (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
417 (while (looking-at "^\n")
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
418 (forward-line 1))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
419 (unless (> (point) opoint)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
420 ;; beginning-of-defun moved back one defun
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
421 ;; so we got the wrong one.
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
422 (goto-char opoint)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
423 (end-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
424 (setq end (point))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
425 (beginning-of-defun)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
426 (setq beg (point)))
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
427 (goto-char end)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
428 (re-search-backward "^\n" (- (point) 1) t)
|
babf5161afd4
(mark-defun, narrow-to-defun): If moving back then fwd gets a defun
Richard M. Stallman <rms@gnu.org>
diff
changeset
|
429 (narrow-to-region beg end))))
|
15971
|
430
|
55807
|
431 (defvar insert-pair-alist
|
|
432 '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
|
|
433 "Alist of paired characters inserted by `insert-pair'.
|
|
434 Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
|
|
435 OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
|
|
436 of the pair whose key is equal to the last input character with
|
|
437 or without modifiers, are inserted by `insert-pair'.")
|
|
438
|
|
439 (defun insert-pair (&optional arg open close)
|
55277
|
440 "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
|
|
441 Leave point after the first character.
|
|
442 A negative ARG encloses the preceding ARG sexps instead.
|
|
443 No argument is equivalent to zero: just insert characters
|
|
444 and leave point between.
|
|
445 If `parens-require-spaces' is non-nil, this command also inserts a space
|
|
446 before and after, depending on the surrounding characters.
|
55807
|
447 If region is active, insert enclosing characters at region boundaries.
|
|
448
|
|
449 If arguments OPEN and CLOSE are nil, the character pair is found
|
|
450 from the variable `insert-pair-alist' according to the last input
|
|
451 character with or without modifiers. If no character pair is
|
|
452 found in the variable `insert-pair-alist', then the last input
|
|
453 character is inserted ARG times."
|
55277
|
454 (interactive "P")
|
55807
|
455 (if (not (and open close))
|
|
456 (let ((pair (or (assq last-command-char insert-pair-alist)
|
|
457 (assq (event-basic-type last-command-event)
|
|
458 insert-pair-alist))))
|
|
459 (if pair
|
|
460 (if (nth 2 pair)
|
|
461 (setq open (nth 1 pair) close (nth 2 pair))
|
|
462 (setq open (nth 0 pair) close (nth 1 pair))))))
|
|
463 (if (and open close)
|
|
464 (if (and transient-mark-mode mark-active)
|
|
465 (progn
|
|
466 (save-excursion (goto-char (region-end)) (insert close))
|
|
467 (save-excursion (goto-char (region-beginning)) (insert open)))
|
|
468 (if arg (setq arg (prefix-numeric-value arg))
|
|
469 (setq arg 0))
|
|
470 (cond ((> arg 0) (skip-chars-forward " \t"))
|
|
471 ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
|
|
472 (and parens-require-spaces
|
|
473 (not (bobp))
|
|
474 (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
|
|
475 (insert " "))
|
|
476 (insert open)
|
|
477 (save-excursion
|
|
478 (or (eq arg 0) (forward-sexp arg))
|
|
479 (insert close)
|
|
480 (and parens-require-spaces
|
|
481 (not (eobp))
|
|
482 (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
|
|
483 (insert " "))))
|
|
484 (insert-char (event-basic-type last-command-event)
|
|
485 (prefix-numeric-value arg))))
|
55277
|
486
|
55807
|
487 (defun insert-parentheses (&optional arg)
|
61401
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
488 "Enclose following ARG sexps in parentheses.
|
99b039f2f040
(defun-prompt-regexp, parens-require-spaces, buffer-end, end-of-defun)
Luc Teirlinck <teirllm@auburn.edu>
diff
changeset
|
489 Leave point after open-paren.
|
16410
454a13718b1f
(narrow-to-defun): Narrow to the same defun that `mark-defun' would make
Erik Naggum <erik@naggum.no>
diff
changeset
|
490 A negative ARG encloses the preceding ARG sexps instead.
|
3733
|
491 No argument is equivalent to zero: just insert `()' and leave point between.
|
5838
|
492 If `parens-require-spaces' is non-nil, this command also inserts a space
|
55277
|
493 before and after, depending on the surrounding characters.
|
|
494 If region is active, insert enclosing characters at region boundaries."
|
84
|
495 (interactive "P")
|
55277
|
496 (insert-pair arg ?\( ?\)))
|
84
|
497
|
55807
|
498 (defun delete-pair ()
|
|
499 "Delete a pair of characters enclosing the sexp that follows point."
|
|
500 (interactive)
|
|
501 (save-excursion (forward-sexp 1) (delete-char -1))
|
|
502 (delete-char 1))
|
|
503
|
|
504 (defun raise-sexp (&optional arg)
|
|
505 "Raise ARG sexps higher up the tree."
|
|
506 (interactive "p")
|
|
507 (let ((s (if (and transient-mark-mode mark-active)
|
|
508 (buffer-substring (region-beginning) (region-end))
|
|
509 (buffer-substring
|
|
510 (point)
|
|
511 (save-excursion (forward-sexp arg) (point))))))
|
|
512 (backward-up-list 1)
|
|
513 (delete-region (point) (save-excursion (forward-sexp 1) (point)))
|
|
514 (save-excursion (insert s))))
|
|
515
|
84
|
516 (defun move-past-close-and-reindent ()
|
|
517 "Move past next `)', delete indentation before it, then indent after it."
|
|
518 (interactive)
|
|
519 (up-list 1)
|
|
520 (forward-char -1)
|
|
521 (while (save-excursion ; this is my contribution
|
|
522 (let ((before-paren (point)))
|
|
523 (back-to-indentation)
|
19781
|
524 (and (= (point) before-paren)
|
|
525 (progn
|
|
526 ;; Move to end of previous line.
|
|
527 (beginning-of-line)
|
|
528 (forward-char -1)
|
|
529 ;; Verify it doesn't end within a string or comment.
|
|
530 (let ((end (point))
|
|
531 state)
|
|
532 (beginning-of-line)
|
|
533 ;; Get state at start of line.
|
27190
|
534 (setq state (list 0 nil nil
|
19781
|
535 (null (calculate-lisp-indent))
|
|
536 nil nil nil nil
|
|
537 nil))
|
|
538 ;; Parse state across the line to get state at end.
|
|
539 (setq state (parse-partial-sexp (point) end nil nil
|
|
540 state))
|
|
541 ;; Check not in string or comment.
|
|
542 (and (not (elt state 3)) (not (elt state 4))))))))
|
84
|
543 (delete-indentation))
|
|
544 (forward-char 1)
|
|
545 (newline-and-indent))
|
27190
|
546
|
|
547 (defun check-parens () ; lame name?
|
|
548 "Check for unbalanced parentheses in the current buffer.
|
|
549 More accurately, check the narrowed part of the buffer for unbalanced
|
|
550 expressions (\"sexps\") in general. This is done according to the
|
|
551 current syntax table and will find unbalanced brackets or quotes as
|
62455
|
552 appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is
|
63624
|
553 found, an error is signaled and point is left at the first unbalanced
|
62455
|
554 character."
|
27190
|
555 (interactive)
|
|
556 (condition-case data
|
|
557 ;; Buffer can't have more than (point-max) sexps.
|
|
558 (scan-sexps (point-min) (point-max))
|
|
559 (scan-error (goto-char (nth 2 data))
|
|
560 ;; Could print (nth 1 data), which is either
|
|
561 ;; "Containing expression ends prematurely" or
|
|
562 ;; "Unbalanced parentheses", but those may not be so
|
|
563 ;; accurate/helpful, e.g. quotes may actually be
|
|
564 ;; mismatched.
|
|
565 (error "Unmatched bracket or quote"))
|
|
566 (error (cond ((eq 'scan-error (car data))
|
|
567 (goto-char (nth 2 data))
|
|
568 (error "Unmatched bracket or quote"))
|
|
569 (t (signal (car data) (cdr data)))))))
|
84
|
570
|
30979
|
571 (defun lisp-complete-symbol (&optional predicate)
|
6004
|
572 "Perform completion on Lisp symbol preceding point.
|
|
573 Compare that symbol against the known Lisp symbols.
|
42658
|
574 If no characters can be completed, display a list of possible completions.
|
|
575 Repeating the command at that point scrolls the list.
|
6004
|
576
|
30979
|
577 When called from a program, optional arg PREDICATE is a predicate
|
|
578 determining which symbols are considered, e.g. `commandp'.
|
|
579 If PREDICATE is nil, the context determines which symbols are
|
|
580 considered. If the symbol starts just after an open-parenthesis, only
|
|
581 symbols with function definitions are considered. Otherwise, all
|
|
582 symbols with function definitions, values or properties are
|
|
583 considered."
|
84
|
584 (interactive)
|
42658
|
585
|
|
586 (let ((window (get-buffer-window "*Completions*")))
|
|
587 (if (and (eq last-command this-command)
|
|
588 window (window-live-p window) (window-buffer window)
|
|
589 (buffer-name (window-buffer window)))
|
|
590 ;; If this command was repeated, and
|
|
591 ;; there's a fresh completion window with a live buffer,
|
|
592 ;; and this command is repeated, scroll that window.
|
|
593 (with-current-buffer (window-buffer window)
|
|
594 (if (pos-visible-in-window-p (point-max) window)
|
|
595 (set-window-start window (point-min))
|
|
596 (save-selected-window
|
|
597 (select-window window)
|
|
598 (scroll-up))))
|
|
599
|
|
600 ;; Do completion.
|
|
601 (let* ((end (point))
|
|
602 (beg (with-syntax-table emacs-lisp-mode-syntax-table
|
|
603 (save-excursion
|
|
604 (backward-sexp 1)
|
|
605 (while (= (char-syntax (following-char)) ?\')
|
|
606 (forward-char 1))
|
|
607 (point))))
|
|
608 (pattern (buffer-substring-no-properties beg end))
|
|
609 (predicate
|
|
610 (or predicate
|
|
611 (save-excursion
|
|
612 (goto-char beg)
|
|
613 (if (not (eq (char-before) ?\())
|
|
614 (lambda (sym) ;why not just nil ? -sm
|
|
615 (or (boundp sym) (fboundp sym)
|
|
616 (symbol-plist sym)))
|
|
617 ;; Looks like a funcall position. Let's double check.
|
|
618 (if (condition-case nil
|
|
619 (progn (up-list -2) (forward-char 1)
|
|
620 (eq (char-after) ?\())
|
|
621 (error nil))
|
|
622 ;; If the first element of the parent list is an open
|
|
623 ;; parenthesis we are probably not in a funcall position.
|
|
624 ;; Maybe a `let' varlist or something.
|
|
625 nil
|
|
626 ;; Else, we assume that a function name is expected.
|
|
627 'fboundp)))))
|
|
628 (completion (try-completion pattern obarray predicate)))
|
|
629 (cond ((eq completion t))
|
|
630 ((null completion)
|
|
631 (message "Can't find completion for \"%s\"" pattern)
|
|
632 (ding))
|
67728
bffc4c57eda9
(lisp-complete-symbol): Mostly undo the change by Kevin Rodgers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
633 ((not (string= pattern completion))
|
bffc4c57eda9
(lisp-complete-symbol): Mostly undo the change by Kevin Rodgers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
634 (delete-region beg end)
|
bffc4c57eda9
(lisp-complete-symbol): Mostly undo the change by Kevin Rodgers.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
635 (insert completion)
|
67730
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
636 ;; Don't leave around a completions buffer that's out of date.
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
637 (let ((win (get-buffer-window "*Completions*" 0)))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
638 (if win (with-selected-window win (bury-buffer)))))
|
42658
|
639 (t
|
67730
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
640 (let ((minibuf-is-in-use
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
641 (eq (minibuffer-window) (selected-window))))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
642 (unless minibuf-is-in-use
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
643 (message "Making completion list..."))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
644 (let ((list (all-completions pattern obarray predicate)))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
645 (setq list (sort list 'string<))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
646 (or (eq predicate 'fboundp)
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
647 (let (new)
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
648 (while list
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
649 (setq new (cons (if (fboundp (intern (car list)))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
650 (list (car list) " <f>")
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
651 (car list))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
652 new))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
653 (setq list (cdr list)))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
654 (setq list (nreverse new))))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
655 (if (> (length list) 1)
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
656 (with-output-to-temp-buffer "*Completions*"
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
657 (display-completion-list list pattern))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
658 ;; Don't leave around a completions buffer that's
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
659 ;; out of date.
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
660 (let ((win (get-buffer-window "*Completions*" 0)))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
661 (if win (with-selected-window win (bury-buffer))))))
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
662 (unless minibuf-is-in-use
|
1ee1a77d8b03
(lisp-complete-symbol): Don't print progress messages if in the
Romain Francoise <romain@orebokech.com>
diff
changeset
|
663 (message "Making completion list...%s" "done")))))))))
|
659
|
664
|
67721
d372bc6eff1d
(lisp-complete-symbol): Don't call delete-windows-on with an inexistent buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
diff
changeset
|
665 ;; arch-tag: aa7fa8a4-2e6f-4e9b-9cd9-fef06340e67e
|
659
|
666 ;;; lisp.el ends here
|