Line data Source code
1 : ;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1985-1986, 1994, 2000-2017 Free Software Foundation,
4 : ;; Inc.
5 :
6 : ;; Maintainer: emacs-devel@gnu.org
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 : ;; FIXME:
50 : ;; - for some uses, we may want a "sexp-only" version, which only
51 : ;; jumps over a well-formed sexp, rather than some dwimish thing
52 : ;; like jumping from an "else" back up to its "if".
53 : ;; - for up-list, we could use the "sexp-only" behavior as well
54 : ;; to treat the dwimish halfsexp as a form of "up-list" step.
55 : "If non-nil, `forward-sexp' delegates to this function.
56 : Should take the same arguments and behave similarly to `forward-sexp'.")
57 :
58 : (defun forward-sexp (&optional arg)
59 : "Move forward across one balanced expression (sexp).
60 : With ARG, do it that many times. Negative arg -N means move
61 : backward across N balanced expressions. This command assumes
62 : point is not in a string or comment. Calls
63 : `forward-sexp-function' to do the work, if that is non-nil. If
64 : unable to move over a sexp, signal `scan-error' with three
65 : arguments: a message, the start of the obstacle (usually a
66 : parenthesis or list marker of some kind), and end of the
67 : obstacle."
68 : (interactive "^p")
69 0 : (or arg (setq arg 1))
70 0 : (if forward-sexp-function
71 0 : (funcall forward-sexp-function arg)
72 0 : (goto-char (or (scan-sexps (point) arg) (buffer-end arg)))
73 0 : (if (< arg 0) (backward-prefix-chars))))
74 :
75 : (defun backward-sexp (&optional arg)
76 : "Move backward across one balanced expression (sexp).
77 : With ARG, do it that many times. Negative arg -N means
78 : move forward across N balanced expressions.
79 : This command assumes point is not in a string or comment.
80 : Uses `forward-sexp' to do the work."
81 : (interactive "^p")
82 0 : (or arg (setq arg 1))
83 0 : (forward-sexp (- arg)))
84 :
85 : (defun mark-sexp (&optional arg allow-extend)
86 : "Set mark ARG sexps from point.
87 : The place mark goes is the same place \\[forward-sexp] would
88 : move to with the same argument.
89 : Interactively, if this command is repeated
90 : or (in Transient Mark mode) if the mark is active,
91 : it marks the next ARG sexps after the ones already marked.
92 : This command assumes point is not in a string or comment."
93 : (interactive "P\np")
94 0 : (cond ((and allow-extend
95 0 : (or (and (eq last-command this-command) (mark t))
96 0 : (and transient-mark-mode mark-active)))
97 0 : (setq arg (if arg (prefix-numeric-value arg)
98 0 : (if (< (mark) (point)) -1 1)))
99 0 : (set-mark
100 0 : (save-excursion
101 0 : (goto-char (mark))
102 0 : (forward-sexp arg)
103 0 : (point))))
104 : (t
105 0 : (push-mark
106 0 : (save-excursion
107 0 : (forward-sexp (prefix-numeric-value arg))
108 0 : (point))
109 0 : nil t))))
110 :
111 : (defun forward-list (&optional arg)
112 : "Move forward across one balanced group of parentheses.
113 : This command will also work on other parentheses-like expressions
114 : defined by the current language mode.
115 : With ARG, do it that many times.
116 : Negative arg -N means move backward across N groups of parentheses.
117 : This command assumes point is not in a string or comment."
118 : (interactive "^p")
119 0 : (or arg (setq arg 1))
120 0 : (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))
121 :
122 : (defun backward-list (&optional arg)
123 : "Move backward across one balanced group of parentheses.
124 : This command will also work on other parentheses-like expressions
125 : defined by the current language mode.
126 : With ARG, do it that many times.
127 : Negative arg -N means move forward across N groups of parentheses.
128 : This command assumes point is not in a string or comment."
129 : (interactive "^p")
130 0 : (or arg (setq arg 1))
131 0 : (forward-list (- arg)))
132 :
133 : (defun down-list (&optional arg)
134 : "Move forward down one level of parentheses.
135 : This command will also work on other parentheses-like expressions
136 : defined by the current language mode.
137 : With ARG, do this that many times.
138 : A negative argument means move backward but still go down a level.
139 : This command assumes point is not in a string or comment."
140 : (interactive "^p")
141 0 : (or arg (setq arg 1))
142 0 : (let ((inc (if (> arg 0) 1 -1)))
143 0 : (while (/= arg 0)
144 0 : (goto-char (or (scan-lists (point) inc -1) (buffer-end arg)))
145 0 : (setq arg (- arg inc)))))
146 :
147 : (defun backward-up-list (&optional arg escape-strings no-syntax-crossing)
148 : "Move backward out of one level of parentheses.
149 : This command will also work on other parentheses-like expressions
150 : defined by the current language mode. With ARG, do this that
151 : many times. A negative argument means move forward but still to
152 : a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
153 : interactively), move out of enclosing strings as well. If
154 : NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
155 : break out of any enclosing string instead of moving to the start
156 : of a list broken across multiple strings. On error, location of
157 : point is unspecified."
158 : (interactive "^p\nd\nd")
159 0 : (up-list (- (or arg 1)) escape-strings no-syntax-crossing))
160 :
161 : (defun up-list (&optional arg escape-strings no-syntax-crossing)
162 : "Move forward out of one level of parentheses.
163 : This command will also work on other parentheses-like expressions
164 : defined by the current language mode. With ARG, do this that
165 : many times. A negative argument means move backward but still to
166 : a less deep spot. If ESCAPE-STRINGS is non-nil (as it is
167 : interactively), move out of enclosing strings as well. If
168 : NO-SYNTAX-CROSSING is non-nil (as it is interactively), prefer to
169 : break out of any enclosing string instead of moving to the start
170 : of a list broken across multiple strings. On error, location of
171 : point is unspecified."
172 : (interactive "^p\nd\nd")
173 0 : (or arg (setq arg 1))
174 0 : (let ((inc (if (> arg 0) 1 -1))
175 : (pos nil))
176 0 : (while (/= arg 0)
177 0 : (condition-case err
178 0 : (save-restriction
179 : ;; If we've been asked not to cross string boundaries
180 : ;; and we're inside a string, narrow to that string so
181 : ;; that scan-lists doesn't find a match in a different
182 : ;; string.
183 0 : (when no-syntax-crossing
184 0 : (let* ((syntax (syntax-ppss))
185 0 : (string-comment-start (nth 8 syntax)))
186 0 : (when string-comment-start
187 0 : (save-excursion
188 0 : (goto-char string-comment-start)
189 0 : (narrow-to-region
190 0 : (point)
191 0 : (if (nth 3 syntax) ; in string
192 0 : (condition-case nil
193 0 : (progn (forward-sexp) (point))
194 0 : (scan-error (point-max)))
195 0 : (forward-comment 1)
196 0 : (point)))))))
197 0 : (if (null forward-sexp-function)
198 0 : (goto-char (or (scan-lists (point) inc 1)
199 0 : (buffer-end arg)))
200 0 : (condition-case err
201 0 : (while (progn (setq pos (point))
202 0 : (forward-sexp inc)
203 0 : (/= (point) pos)))
204 0 : (scan-error (goto-char (nth (if (> arg 0) 3 2) err))))
205 0 : (if (= (point) pos)
206 0 : (signal 'scan-error
207 0 : (list "Unbalanced parentheses" (point) (point))))))
208 : (scan-error
209 0 : (let ((syntax nil))
210 0 : (or
211 : ;; If we bumped up against the end of a list, see whether
212 : ;; we're inside a string: if so, just go to the beginning
213 : ;; or end of that string.
214 0 : (and escape-strings
215 0 : (or syntax (setf syntax (syntax-ppss)))
216 0 : (nth 3 syntax)
217 0 : (goto-char (nth 8 syntax))
218 0 : (progn (when (> inc 0)
219 0 : (forward-sexp))
220 0 : t))
221 : ;; If we narrowed to a comment above and failed to escape
222 : ;; it, the error might be our fault, not an indication
223 : ;; that we're out of syntax. Try again from beginning or
224 : ;; end of the comment.
225 0 : (and no-syntax-crossing
226 0 : (or syntax (setf syntax (syntax-ppss)))
227 0 : (nth 4 syntax)
228 0 : (goto-char (nth 8 syntax))
229 0 : (or (< inc 0)
230 0 : (forward-comment 1))
231 0 : (setf arg (+ arg inc)))
232 0 : (signal (car err) (cdr err))))))
233 0 : (setq arg (- arg inc)))))
234 :
235 : (defun kill-sexp (&optional arg)
236 : "Kill the sexp (balanced expression) following point.
237 : With ARG, kill that many sexps after point.
238 : Negative arg -N means kill N sexps before point.
239 : This command assumes point is not in a string or comment."
240 : (interactive "p")
241 0 : (let ((opoint (point)))
242 0 : (forward-sexp (or arg 1))
243 0 : (kill-region opoint (point))))
244 :
245 : (defun backward-kill-sexp (&optional arg)
246 : "Kill the sexp (balanced expression) preceding point.
247 : With ARG, kill that many sexps before point.
248 : Negative arg -N means kill N sexps after point.
249 : This command assumes point is not in a string or comment."
250 : (interactive "p")
251 0 : (kill-sexp (- (or arg 1))))
252 :
253 : ;; After Zmacs:
254 : (defun kill-backward-up-list (&optional arg)
255 : "Kill the form containing the current sexp, leaving the sexp itself.
256 : A prefix argument ARG causes the relevant number of surrounding
257 : forms to be removed.
258 : This command assumes point is not in a string or comment."
259 : (interactive "*p")
260 0 : (let ((current-sexp (thing-at-point 'sexp)))
261 0 : (if current-sexp
262 0 : (save-excursion
263 0 : (backward-up-list arg)
264 0 : (kill-sexp)
265 0 : (insert current-sexp))
266 0 : (user-error "Not at a sexp"))))
267 :
268 : (defvar beginning-of-defun-function nil
269 : "If non-nil, function for `beginning-of-defun-raw' to call.
270 : This is used to find the beginning of the defun instead of using the
271 : normal recipe (see `beginning-of-defun'). Major modes can define this
272 : if defining `defun-prompt-regexp' is not sufficient to handle the mode's
273 : needs.
274 :
275 : The function takes the same argument as `beginning-of-defun' and should
276 : behave similarly, returning non-nil if it found the beginning of a defun.
277 : Ideally it should move to a point right before an open-paren which encloses
278 : the body of the defun.")
279 :
280 : (defun beginning-of-defun (&optional arg)
281 : "Move backward to the beginning of a defun.
282 : With ARG, do it that many times. Negative ARG means move forward
283 : to the ARGth following beginning of defun.
284 :
285 : If search is successful, return t; point ends up at the beginning
286 : of the line where the search succeeded. Otherwise, return nil.
287 :
288 : When `open-paren-in-column-0-is-defun-start' is non-nil, a defun
289 : is assumed to start where there is a char with open-parenthesis
290 : syntax at the beginning of a line. If `defun-prompt-regexp' is
291 : non-nil, then a string which matches that regexp may also precede
292 : the open-parenthesis. If `defun-prompt-regexp' and
293 : `open-paren-in-column-0-is-defun-start' are both nil, this
294 : function instead finds an open-paren at the outermost level.
295 :
296 : If the variable `beginning-of-defun-function' is non-nil, its
297 : value is called as a function, with argument ARG, to find the
298 : defun's beginning.
299 :
300 : Regardless of the values of `defun-prompt-regexp' and
301 : `beginning-of-defun-function', point always moves to the
302 : beginning of the line whenever the search is successful."
303 : (interactive "^p")
304 0 : (or (not (eq this-command 'beginning-of-defun))
305 0 : (eq last-command 'beginning-of-defun)
306 0 : (and transient-mark-mode mark-active)
307 0 : (push-mark))
308 0 : (and (beginning-of-defun-raw arg)
309 0 : (progn (beginning-of-line) t)))
310 :
311 : (defun beginning-of-defun-raw (&optional arg)
312 : "Move point to the character that starts a defun.
313 : This is identical to function `beginning-of-defun', except that point
314 : does not move to the beginning of the line when `defun-prompt-regexp'
315 : is non-nil.
316 :
317 : If variable `beginning-of-defun-function' is non-nil, its value
318 : is called as a function to find the defun's beginning."
319 : (interactive "^p") ; change this to "P", maybe, if we ever come to pass ARG
320 : ; to beginning-of-defun-function.
321 0 : (unless arg (setq arg 1))
322 0 : (cond
323 0 : (beginning-of-defun-function
324 0 : (condition-case nil
325 0 : (funcall beginning-of-defun-function arg)
326 : ;; We used to define beginning-of-defun-function as taking no argument
327 : ;; but that makes it impossible to implement correct forward motion:
328 : ;; we used to use end-of-defun for that, but it's not supposed to do
329 : ;; the same thing (it moves to the end of a defun not to the beginning
330 : ;; of the next).
331 : ;; In case the beginning-of-defun-function uses the old calling
332 : ;; convention, fallback on the old implementation.
333 : (wrong-number-of-arguments
334 0 : (if (> arg 0)
335 0 : (dotimes (_ arg)
336 0 : (funcall beginning-of-defun-function))
337 0 : (dotimes (_ (- arg))
338 0 : (funcall end-of-defun-function))))))
339 :
340 0 : ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start)
341 0 : (and (< arg 0) (not (eobp)) (forward-char 1))
342 0 : (and (re-search-backward (if defun-prompt-regexp
343 0 : (concat (if open-paren-in-column-0-is-defun-start
344 0 : "^\\s(\\|" "")
345 0 : "\\(?:" defun-prompt-regexp "\\)\\s(")
346 0 : "^\\s(")
347 0 : nil 'move arg)
348 0 : (progn (goto-char (1- (match-end 0)))
349 0 : t)))
350 :
351 : ;; If open-paren-in-column-0-is-defun-start and defun-prompt-regexp
352 : ;; are both nil, column 0 has no significance - so scan forward
353 : ;; from BOB to see how nested point is, then carry on from there.
354 : ;;
355 : ;; It is generally not a good idea to land up here, because the
356 : ;; call to scan-lists below can be extremely slow. This is because
357 : ;; back_comment in syntax.c may have to scan from bob to find the
358 : ;; beginning of each comment. Fixing this is not trivial -- cyd.
359 :
360 0 : ((eq arg 0))
361 : (t
362 0 : (let ((floor (point-min))
363 0 : (ceiling (point-max))
364 0 : (arg-+ve (> arg 0)))
365 0 : (save-restriction
366 0 : (widen)
367 0 : (let ((ppss (let (syntax-begin-function)
368 0 : (syntax-ppss)))
369 : ;; position of least enclosing paren, or nil.
370 : encl-pos)
371 : ;; Back out of any comment/string, so that encl-pos will always
372 : ;; become nil if we're at top-level.
373 0 : (when (nth 8 ppss)
374 0 : (goto-char (nth 8 ppss))
375 0 : (setq ppss (syntax-ppss))) ; should be fast, due to cache.
376 0 : (setq encl-pos (syntax-ppss-toplevel-pos ppss))
377 0 : (if encl-pos (goto-char encl-pos))
378 :
379 0 : (and encl-pos arg-+ve (setq arg (1- arg)))
380 0 : (and (not encl-pos) (not arg-+ve) (not (looking-at "\\s("))
381 0 : (setq arg (1+ arg)))
382 :
383 0 : (condition-case nil ; to catch crazy parens.
384 0 : (progn
385 0 : (goto-char (scan-lists (point) (- arg) 0))
386 0 : (if arg-+ve
387 0 : (if (>= (point) floor)
388 : t
389 0 : (goto-char floor)
390 0 : nil)
391 : ;; forward to next (, or trigger the c-c
392 0 : (goto-char (1- (scan-lists (point) 1 -1)))
393 0 : (if (<= (point) ceiling)
394 : t
395 0 : (goto-char ceiling)
396 0 : nil)))
397 : (error
398 0 : (goto-char (if arg-+ve floor ceiling))
399 0 : nil))))))))
400 :
401 : (defun beginning-of-defun--in-emptyish-line-p ()
402 : "Return non-nil if the point is in an \"emptyish\" line.
403 : This means a line that consists entirely of comments and/or
404 : whitespace."
405 : ;; See http://lists.gnu.org/archive/html/help-gnu-emacs/2016-08/msg00141.html
406 0 : (save-excursion
407 0 : (forward-line 0)
408 0 : (< (line-end-position)
409 0 : (let ((ppss (syntax-ppss)))
410 0 : (when (nth 4 ppss)
411 0 : (goto-char (nth 8 ppss)))
412 0 : (forward-comment (point-max))
413 0 : (point)))))
414 :
415 : (defun beginning-of-defun-comments (&optional arg)
416 : "Move to the beginning of ARGth defun, including comments."
417 : (interactive "^p")
418 0 : (unless arg (setq arg 1))
419 0 : (beginning-of-defun arg)
420 0 : (let (first-line-p)
421 0 : (while (let ((ppss (progn (setq first-line-p (= (forward-line -1) -1))
422 0 : (syntax-ppss (line-end-position)))))
423 0 : (while (and (nth 4 ppss) ; If eol is in a line-spanning comment,
424 0 : (< (nth 8 ppss) (line-beginning-position)))
425 0 : (goto-char (nth 8 ppss)) ; skip to comment start.
426 0 : (setq ppss (syntax-ppss (line-end-position))))
427 0 : (and (not first-line-p)
428 0 : (progn (skip-syntax-backward
429 0 : "-" (line-beginning-position))
430 0 : (not (bolp))) ; Check for blank line.
431 0 : (progn (parse-partial-sexp
432 0 : (line-beginning-position) (line-end-position)
433 0 : nil t (syntax-ppss (line-beginning-position)))
434 0 : (eolp))))) ; Check for non-comment text.
435 0 : (forward-line (if first-line-p 0 1))))
436 :
437 : (defvar end-of-defun-function
438 : (lambda () (forward-sexp 1))
439 : "Function for `end-of-defun' to call.
440 : This is used to find the end of the defun at point.
441 : It is called with no argument, right after calling `beginning-of-defun-raw'.
442 : So the function can assume that point is at the beginning of the defun body.
443 : It should move point to the first position after the defun.")
444 :
445 : (defun buffer-end (arg)
446 : "Return the \"far end\" position of the buffer, in direction ARG.
447 : If ARG is positive, that's the end of the buffer.
448 : Otherwise, that's the beginning of the buffer."
449 0 : (if (> arg 0) (point-max) (point-min)))
450 :
451 : (defun end-of-defun (&optional arg)
452 : "Move forward to next end of defun.
453 : With argument, do it that many times.
454 : Negative argument -N means move back to Nth preceding end of defun.
455 :
456 : An end of a defun occurs right after the close-parenthesis that
457 : matches the open-parenthesis that starts a defun; see function
458 : `beginning-of-defun'.
459 :
460 : If variable `end-of-defun-function' is non-nil, its value
461 : is called as a function to find the defun's end."
462 : (interactive "^p")
463 0 : (or (not (eq this-command 'end-of-defun))
464 0 : (eq last-command 'end-of-defun)
465 0 : (and transient-mark-mode mark-active)
466 0 : (push-mark))
467 0 : (if (or (null arg) (= arg 0)) (setq arg 1))
468 0 : (let ((pos (point))
469 0 : (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point)))
470 : (skip (lambda ()
471 : ;; When comparing point against pos, we want to consider that if
472 : ;; point was right after the end of the function, it's still
473 : ;; considered as "in that function".
474 : ;; E.g. `eval-defun' from right after the last close-paren.
475 0 : (unless (bolp)
476 0 : (skip-chars-forward " \t")
477 0 : (if (looking-at "\\s<\\|\n")
478 0 : (forward-line 1))))))
479 0 : (funcall end-of-defun-function)
480 0 : (funcall skip)
481 0 : (cond
482 0 : ((> arg 0)
483 : ;; Moving forward.
484 0 : (if (> (point) pos)
485 : ;; We already moved forward by one because we started from
486 : ;; within a function.
487 0 : (setq arg (1- arg))
488 : ;; We started from after the end of the previous function.
489 0 : (goto-char pos))
490 0 : (unless (zerop arg)
491 0 : (beginning-of-defun-raw (- arg))
492 0 : (funcall end-of-defun-function)))
493 0 : ((< arg 0)
494 : ;; Moving backward.
495 0 : (if (< (point) pos)
496 : ;; We already moved backward because we started from between
497 : ;; two functions.
498 0 : (setq arg (1+ arg))
499 : ;; We started from inside a function.
500 0 : (goto-char beg))
501 0 : (unless (zerop arg)
502 0 : (beginning-of-defun-raw (- arg))
503 0 : (setq beg (point))
504 0 : (funcall end-of-defun-function))))
505 0 : (funcall skip)
506 0 : (while (and (< arg 0) (>= (point) pos))
507 : ;; We intended to move backward, but this ended up not doing so:
508 : ;; Try harder!
509 0 : (goto-char beg)
510 0 : (beginning-of-defun-raw (- arg))
511 0 : (if (>= (point) beg)
512 0 : (setq arg 0)
513 0 : (setq beg (point))
514 0 : (funcall end-of-defun-function)
515 0 : (funcall skip)))))
516 :
517 : (defun mark-defun (&optional arg)
518 : "Put mark at end of this defun, point at beginning.
519 : The defun marked is the one that contains point or follows point.
520 : With positive ARG, mark this and that many next defuns; with negative
521 : ARG, change the direction of marking.
522 :
523 : If the mark is active, it marks the next or previous defun(s) after
524 : the one(s) already marked."
525 : (interactive "p")
526 0 : (setq arg (or arg 1))
527 : ;; There is no `mark-defun-back' function - see
528 : ;; https://lists.gnu.org/archive/html/bug-gnu-emacs/2016-11/msg00079.html
529 : ;; for explanation
530 0 : (when (eq last-command 'mark-defun-back)
531 0 : (setq arg (- arg)))
532 0 : (when (< arg 0)
533 0 : (setq this-command 'mark-defun-back))
534 0 : (cond ((use-region-p)
535 0 : (if (>= arg 0)
536 0 : (set-mark
537 0 : (save-excursion
538 0 : (goto-char (mark))
539 : ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
540 0 : (dotimes (_ignore arg)
541 0 : (end-of-defun))
542 0 : (point)))
543 0 : (beginning-of-defun-comments (- arg))))
544 : (t
545 0 : (let ((opoint (point))
546 : beg end)
547 0 : (push-mark opoint)
548 : ;; Try first in this order for the sake of languages with nested
549 : ;; functions where several can end at the same place as with the
550 : ;; offside rule, e.g. Python.
551 0 : (beginning-of-defun-comments)
552 0 : (setq beg (point))
553 0 : (end-of-defun)
554 0 : (setq end (point))
555 0 : (when (or (and (<= (point) opoint)
556 0 : (> arg 0))
557 0 : (= beg (point-min))) ; we were before the first defun!
558 : ;; beginning-of-defun moved back one defun so we got the wrong
559 : ;; one. If ARG < 0, however, we actually want to go back.
560 0 : (goto-char opoint)
561 0 : (end-of-defun)
562 0 : (setq end (point))
563 0 : (beginning-of-defun-comments)
564 0 : (setq beg (point)))
565 0 : (goto-char beg)
566 0 : (cond ((> arg 0)
567 : ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed
568 0 : (dotimes (_ignore arg)
569 0 : (end-of-defun))
570 0 : (setq end (point))
571 0 : (push-mark end nil t)
572 0 : (goto-char beg))
573 : (t
574 0 : (goto-char beg)
575 0 : (unless (= arg -1) ; beginning-of-defun behaves
576 : ; strange with zero arg - see
577 : ; https://lists.gnu.org/archive/html/bug-gnu-emacs/2017-02/msg00196.html
578 0 : (beginning-of-defun (1- (- arg))))
579 0 : (push-mark end nil t))))))
580 0 : (skip-chars-backward "[:space:]\n")
581 0 : (unless (bobp)
582 0 : (forward-line 1)))
583 :
584 : (defvar narrow-to-defun-include-comments nil
585 : "If non-nil, `narrow-to-defun' will also show comments preceding the defun.")
586 :
587 : (defun narrow-to-defun (&optional include-comments)
588 : "Make text outside current defun invisible.
589 : The current defun is the one that contains point or follows point.
590 : Preceding comments are included if INCLUDE-COMMENTS is non-nil.
591 : Interactively, the behavior depends on `narrow-to-defun-include-comments'."
592 0 : (interactive (list narrow-to-defun-include-comments))
593 0 : (save-excursion
594 0 : (widen)
595 0 : (let ((opoint (point))
596 : beg end)
597 : ;; Try first in this order for the sake of languages with nested
598 : ;; functions where several can end at the same place as with
599 : ;; the offside rule, e.g. Python.
600 :
601 : ;; Finding the start of the function is a bit problematic since
602 : ;; `beginning-of-defun' when we are on the first character of
603 : ;; the function might go to the previous function.
604 : ;;
605 : ;; Therefore we first move one character forward and then call
606 : ;; `beginning-of-defun'. However now we must check that we did
607 : ;; not move into the next function.
608 0 : (let ((here (point)))
609 0 : (unless (eolp)
610 0 : (forward-char))
611 0 : (beginning-of-defun)
612 0 : (when (< (point) here)
613 0 : (goto-char here)
614 0 : (beginning-of-defun)))
615 0 : (setq beg (point))
616 0 : (end-of-defun)
617 0 : (setq end (point))
618 0 : (while (looking-at "^\n")
619 0 : (forward-line 1))
620 0 : (unless (> (point) opoint)
621 : ;; beginning-of-defun moved back one defun
622 : ;; so we got the wrong one.
623 0 : (goto-char opoint)
624 0 : (end-of-defun)
625 0 : (setq end (point))
626 0 : (beginning-of-defun)
627 0 : (setq beg (point)))
628 0 : (when include-comments
629 0 : (goto-char beg)
630 : ;; Move back past all preceding comments (and whitespace).
631 0 : (when (forward-comment -1)
632 0 : (while (forward-comment -1))
633 : ;; Move forwards past any page breaks within these comments.
634 0 : (when (and page-delimiter (not (string= page-delimiter "")))
635 0 : (while (re-search-forward page-delimiter beg t)))
636 : ;; Lastly, move past any empty lines.
637 0 : (skip-chars-forward "[:space:]\n")
638 0 : (beginning-of-line)
639 0 : (setq beg (point))))
640 0 : (goto-char end)
641 0 : (re-search-backward "^\n" (- (point) 1) t)
642 0 : (narrow-to-region beg end))))
643 :
644 : (defvar insert-pair-alist
645 : '((?\( ?\)) (?\[ ?\]) (?\{ ?\}) (?\< ?\>) (?\" ?\") (?\' ?\') (?\` ?\'))
646 : "Alist of paired characters inserted by `insert-pair'.
647 : Each element looks like (OPEN-CHAR CLOSE-CHAR) or (COMMAND-CHAR
648 : OPEN-CHAR CLOSE-CHAR). The characters OPEN-CHAR and CLOSE-CHAR
649 : of the pair whose key is equal to the last input character with
650 : or without modifiers, are inserted by `insert-pair'.
651 :
652 : If COMMAND-CHAR is specified, it is a character that triggers the
653 : insertion of the open/close pair, and COMMAND-CHAR itself isn't
654 : inserted.")
655 :
656 : (defun insert-pair (&optional arg open close)
657 : "Enclose following ARG sexps in a pair of OPEN and CLOSE characters.
658 : Leave point after the first character.
659 : A negative ARG encloses the preceding ARG sexps instead.
660 : No argument is equivalent to zero: just insert characters
661 : and leave point between.
662 : If `parens-require-spaces' is non-nil, this command also inserts a space
663 : before and after, depending on the surrounding characters.
664 : If region is active, insert enclosing characters at region boundaries.
665 :
666 : If arguments OPEN and CLOSE are nil, the character pair is found
667 : from the variable `insert-pair-alist' according to the last input
668 : character with or without modifiers. If no character pair is
669 : found in the variable `insert-pair-alist', then the last input
670 : character is inserted ARG times.
671 :
672 : This command assumes point is not in a string or comment."
673 : (interactive "P")
674 0 : (if (not (and open close))
675 0 : (let ((pair (or (assq last-command-event insert-pair-alist)
676 0 : (assq (event-basic-type last-command-event)
677 0 : insert-pair-alist))))
678 0 : (if pair
679 0 : (if (nth 2 pair)
680 0 : (setq open (nth 1 pair) close (nth 2 pair))
681 0 : (setq open (nth 0 pair) close (nth 1 pair))))))
682 0 : (if (and open close)
683 0 : (if (and transient-mark-mode mark-active)
684 0 : (progn
685 0 : (save-excursion
686 0 : (goto-char (region-end))
687 0 : (insert close))
688 0 : (goto-char (region-beginning))
689 0 : (insert open))
690 0 : (if arg (setq arg (prefix-numeric-value arg))
691 0 : (setq arg 0))
692 0 : (cond ((> arg 0) (skip-chars-forward " \t"))
693 0 : ((< arg 0) (forward-sexp arg) (setq arg (- arg))))
694 0 : (and parens-require-spaces
695 0 : (not (bobp))
696 0 : (memq (char-syntax (preceding-char)) (list ?w ?_ (char-syntax close)))
697 0 : (insert " "))
698 0 : (insert open)
699 0 : (save-excursion
700 0 : (or (eq arg 0) (forward-sexp arg))
701 0 : (insert close)
702 0 : (and parens-require-spaces
703 0 : (not (eobp))
704 0 : (memq (char-syntax (following-char)) (list ?w ?_ (char-syntax open)))
705 0 : (insert " "))))
706 0 : (insert-char (event-basic-type last-command-event)
707 0 : (prefix-numeric-value arg))))
708 :
709 : (defun insert-parentheses (&optional arg)
710 : "Enclose following ARG sexps in parentheses.
711 : Leave point after open-paren.
712 : A negative ARG encloses the preceding ARG sexps instead.
713 : No argument is equivalent to zero: just insert `()' and leave point between.
714 : If `parens-require-spaces' is non-nil, this command also inserts a space
715 : before and after, depending on the surrounding characters.
716 : If region is active, insert enclosing characters at region boundaries.
717 :
718 : This command assumes point is not in a string or comment."
719 : (interactive "P")
720 0 : (insert-pair arg ?\( ?\)))
721 :
722 : (defun delete-pair ()
723 : "Delete a pair of characters enclosing the sexp that follows point."
724 : (interactive)
725 0 : (save-excursion (forward-sexp 1) (delete-char -1))
726 0 : (delete-char 1))
727 :
728 : (defun raise-sexp (&optional arg)
729 : "Raise ARG sexps higher up the tree."
730 : (interactive "p")
731 0 : (let ((s (if (and transient-mark-mode mark-active)
732 0 : (buffer-substring (region-beginning) (region-end))
733 0 : (buffer-substring
734 0 : (point)
735 0 : (save-excursion (forward-sexp arg) (point))))))
736 0 : (backward-up-list 1)
737 0 : (delete-region (point) (save-excursion (forward-sexp 1) (point)))
738 0 : (save-excursion (insert s))))
739 :
740 : (defun move-past-close-and-reindent ()
741 : "Move past next `)', delete indentation before it, then indent after it."
742 : (interactive)
743 0 : (up-list 1)
744 0 : (forward-char -1)
745 0 : (while (save-excursion ; this is my contribution
746 0 : (let ((before-paren (point)))
747 0 : (back-to-indentation)
748 0 : (and (= (point) before-paren)
749 0 : (progn
750 : ;; Move to end of previous line.
751 0 : (beginning-of-line)
752 0 : (forward-char -1)
753 : ;; Verify it doesn't end within a string or comment.
754 0 : (let ((end (point))
755 : state)
756 0 : (beginning-of-line)
757 : ;; Get state at start of line.
758 0 : (setq state (list 0 nil nil
759 0 : (null (calculate-lisp-indent))
760 : nil nil nil nil
761 0 : nil))
762 : ;; Parse state across the line to get state at end.
763 0 : (setq state (parse-partial-sexp (point) end nil nil
764 0 : state))
765 : ;; Check not in string or comment.
766 0 : (and (not (elt state 3)) (not (elt state 4))))))))
767 0 : (delete-indentation))
768 0 : (forward-char 1)
769 0 : (newline-and-indent))
770 :
771 : (defun check-parens () ; lame name?
772 : "Check for unbalanced parentheses in the current buffer.
773 : More accurately, check the narrowed part of the buffer for unbalanced
774 : expressions (\"sexps\") in general. This is done according to the
775 : current syntax table and will find unbalanced brackets or quotes as
776 : appropriate. (See Info node `(emacs)Parentheses'.) If imbalance is
777 : found, an error is signaled and point is left at the first unbalanced
778 : character."
779 : (interactive)
780 0 : (condition-case data
781 : ;; Buffer can't have more than (point-max) sexps.
782 0 : (scan-sexps (point-min) (point-max))
783 0 : (scan-error (push-mark)
784 0 : (goto-char (nth 2 data))
785 : ;; Could print (nth 1 data), which is either
786 : ;; "Containing expression ends prematurely" or
787 : ;; "Unbalanced parentheses", but those may not be so
788 : ;; accurate/helpful, e.g. quotes may actually be
789 : ;; mismatched.
790 0 : (user-error "Unmatched bracket or quote"))))
791 :
792 : (defun field-complete (table &optional predicate)
793 : (declare (obsolete completion-in-region "24.4"))
794 0 : (let ((minibuffer-completion-table table)
795 0 : (minibuffer-completion-predicate predicate)
796 : ;; This made sense for lisp-complete-symbol, but for
797 : ;; field-complete, this is out of place. --Stef
798 : ;; (completion-annotate-function
799 : ;; (unless (eq predicate 'fboundp)
800 : ;; (lambda (str)
801 : ;; (if (fboundp (intern-soft str)) " <f>"))))
802 : )
803 0 : (call-interactively 'minibuffer-complete)))
804 :
805 : (defun lisp-complete-symbol (&optional _predicate)
806 : "Perform completion on Lisp symbol preceding point.
807 : Compare that symbol against the known Lisp symbols.
808 : If no characters can be completed, display a list of possible completions.
809 : Repeating the command at that point scrolls the list.
810 :
811 : The context determines which symbols are considered. If the
812 : symbol starts just after an open-parenthesis, only symbols with
813 : function definitions are considered. Otherwise, all symbols with
814 : function definitions, values or properties are considered."
815 : (declare (obsolete completion-at-point "24.4")
816 : (advertised-calling-convention () "25.1"))
817 : (interactive)
818 0 : (let* ((data (elisp-completion-at-point))
819 0 : (plist (nthcdr 3 data)))
820 0 : (if (null data)
821 0 : (minibuffer-message "Nothing to complete")
822 0 : (let ((completion-extra-properties plist))
823 0 : (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data)
824 0 : (plist-get plist :predicate))))))
825 :
826 : ;;; lisp.el ends here
|