diff options
Diffstat (limited to 'lisp/emacs-lisp/lisp.el')
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 436 |
1 files changed, 271 insertions, 165 deletions
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 26428af4555..2495277ba23 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -55,7 +55,7 @@ This affects `insert-parentheses' and `insert-pair'." "If non-nil, `forward-sexp' delegates to this function. Should take the same arguments and behave similarly to `forward-sexp'.") -(defun forward-sexp (&optional arg) +(defun forward-sexp (&optional arg interactive) "Move forward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move backward across N balanced expressions. This command assumes @@ -64,23 +64,32 @@ point is not in a string or comment. Calls If unable to move over a sexp, signal `scan-error' with three arguments: a message, the start of the obstacle (usually a parenthesis or list marker of some kind), and end of the -obstacle." - (interactive "^p") - (or arg (setq arg 1)) - (if forward-sexp-function - (funcall forward-sexp-function arg) - (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) - (if (< arg 0) (backward-prefix-chars)))) - -(defun backward-sexp (&optional arg) +obstacle. If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (forward-sexp arg nil) + (scan-error (user-error (if (> arg 0) + "No next sexp" + "No previous sexp")))) + (or arg (setq arg 1)) + (if forward-sexp-function + (funcall forward-sexp-function arg) + (goto-char (or (scan-sexps (point) arg) (buffer-end arg))) + (if (< arg 0) (backward-prefix-chars))))) + +(defun backward-sexp (&optional arg interactive) "Move backward across one balanced expression (sexp). With ARG, do it that many times. Negative arg -N means move forward across N balanced expressions. This command assumes point is not in a string or comment. -Uses `forward-sexp' to do the work." - (interactive "^p") +Uses `forward-sexp' to do the work. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") (or arg (setq arg 1)) - (forward-sexp (- arg))) + (forward-sexp (- arg) interactive)) (defun mark-sexp (&optional arg allow-extend) "Set mark ARG sexps from point. @@ -99,50 +108,78 @@ This command assumes point is not in a string or comment." (set-mark (save-excursion (goto-char (mark)) - (forward-sexp arg) + (condition-case error + (forward-sexp arg) + (scan-error + (user-error (if (equal (cadr error) + "Containing expression ends prematurely") + "No more sexp to select" + (cadr error))))) (point)))) (t (push-mark (save-excursion - (forward-sexp (prefix-numeric-value arg)) + (condition-case error + (forward-sexp (prefix-numeric-value arg)) + (scan-error + (user-error (if (equal (cadr error) + "Containing expression ends prematurely") + "No sexp to select" + (cadr error))))) (point)) nil t)))) -(defun forward-list (&optional arg) +(defun forward-list (&optional arg interactive) "Move forward across one balanced group of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do it that many times. Negative arg -N means move backward across N groups of parentheses. -This command assumes point is not in a string or comment." - (interactive "^p") - (or arg (setq arg 1)) - (goto-char (or (scan-lists (point) arg 0) (buffer-end arg)))) - -(defun backward-list (&optional arg) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (forward-list arg nil) + (scan-error (user-error (if (> arg 0) + "No next group" + "No previous group")))) + (or arg (setq arg 1)) + (goto-char (or (scan-lists (point) arg 0) (buffer-end arg))))) + +(defun backward-list (&optional arg interactive) "Move backward across one balanced group of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do it that many times. Negative arg -N means move forward across N groups of parentheses. -This command assumes point is not in a string or comment." - (interactive "^p") +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") (or arg (setq arg 1)) - (forward-list (- arg))) + (forward-list (- arg) interactive)) -(defun down-list (&optional arg) +(defun down-list (&optional arg interactive) "Move forward down one level of parentheses. This command will also work on other parentheses-like expressions defined by the current language mode. With ARG, do this that many times. A negative argument means move backward but still go down a level. -This command assumes point is not in a string or comment." - (interactive "^p") - (or arg (setq arg 1)) - (let ((inc (if (> arg 0) 1 -1))) - (while (/= arg 0) - (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) - (setq arg (- arg inc))))) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case _ + (down-list arg nil) + (scan-error (user-error "At bottom level"))) + (or arg (setq arg 1)) + (let ((inc (if (> arg 0) 1 -1))) + (while (/= arg 0) + (goto-char (or (scan-lists (point) inc -1) (buffer-end arg))) + (setq arg (- arg inc)))))) (defun backward-up-list (&optional arg escape-strings no-syntax-crossing) "Move backward out of one level of parentheses. @@ -229,26 +266,39 @@ point is unspecified." (or (< inc 0) (forward-comment 1)) (setf arg (+ arg inc))) - (signal (car err) (cdr err)))))) + (if no-syntax-crossing + ;; Assume called interactively; don't signal an error. + (user-error "At top level") + (signal (car err) (cdr err))))))) (setq arg (- arg inc))))) -(defun kill-sexp (&optional arg) +(defun kill-sexp (&optional arg interactive) "Kill the sexp (balanced expression) following point. With ARG, kill that many sexps after point. Negative arg -N means kill N sexps before point. -This command assumes point is not in a string or comment." - (interactive "p") - (let ((opoint (point))) - (forward-sexp (or arg 1)) - (kill-region opoint (point)))) - -(defun backward-kill-sexp (&optional arg) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "p\nd") + (if interactive + (condition-case _ + (kill-sexp arg nil) + (scan-error (user-error (if (> arg 0) + "No next sexp" + "No previous sexp")))) + (let ((opoint (point))) + (forward-sexp (or arg 1)) + (kill-region opoint (point))))) + +(defun backward-kill-sexp (&optional arg interactive) "Kill the sexp (balanced expression) preceding point. With ARG, kill that many sexps before point. Negative arg -N means kill N sexps after point. -This command assumes point is not in a string or comment." - (interactive "p") - (kill-sexp (- (or arg 1)))) +This command assumes point is not in a string or comment. +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "p\nd") + (kill-sexp (- (or arg 1)) interactive)) ;; After Zmacs: (defun kill-backward-up-list (&optional arg) @@ -453,7 +503,7 @@ If ARG is positive, that's the end of the buffer. Otherwise, that's the beginning of the buffer." (if (> arg 0) (point-max) (point-min))) -(defun end-of-defun (&optional arg) +(defun end-of-defun (&optional arg interactive) "Move forward to next end of defun. With argument, do it that many times. Negative argument -N means move back to Nth preceding end of defun. @@ -463,128 +513,145 @@ matches the open-parenthesis that starts a defun; see function `beginning-of-defun'. If variable `end-of-defun-function' is non-nil, its value -is called as a function to find the defun's end." - (interactive "^p") - (or (not (eq this-command 'end-of-defun)) - (eq last-command 'end-of-defun) - (and transient-mark-mode mark-active) - (push-mark)) - (if (or (null arg) (= arg 0)) (setq arg 1)) - (let ((pos (point)) - (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))) - (skip (lambda () - ;; When comparing point against pos, we want to consider that if - ;; point was right after the end of the function, it's still - ;; considered as "in that function". - ;; E.g. `eval-defun' from right after the last close-paren. - (unless (bolp) - (skip-chars-forward " \t") - (if (looking-at "\\s<\\|\n") - (forward-line 1)))))) - (funcall end-of-defun-function) - (funcall skip) - (cond - ((> arg 0) - ;; Moving forward. - (if (> (point) pos) - ;; We already moved forward by one because we started from - ;; within a function. - (setq arg (1- arg)) - ;; We started from after the end of the previous function. - (goto-char pos)) - (unless (zerop arg) - (beginning-of-defun-raw (- arg)) - (funcall end-of-defun-function))) - ((< arg 0) - ;; Moving backward. - (if (< (point) pos) - ;; We already moved backward because we started from between - ;; two functions. - (setq arg (1+ arg)) - ;; We started from inside a function. - (goto-char beg)) - (unless (zerop arg) +is called as a function to find the defun's end. + +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "^p\nd") + (if interactive + (condition-case e + (end-of-defun arg nil) + (scan-error (user-error (cadr e)))) + (or (not (eq this-command 'end-of-defun)) + (eq last-command 'end-of-defun) + (and transient-mark-mode mark-active) + (push-mark)) + (if (or (null arg) (= arg 0)) (setq arg 1)) + (let ((pos (point)) + (beg (progn (end-of-line 1) (beginning-of-defun-raw 1) (point))) + (skip (lambda () + ;; When comparing point against pos, we want to consider that + ;; if point was right after the end of the function, it's + ;; still considered as "in that function". + ;; E.g. `eval-defun' from right after the last close-paren. + (unless (bolp) + (skip-chars-forward " \t") + (if (looking-at "\\s<\\|\n") + (forward-line 1)))))) + (funcall end-of-defun-function) + (when (<= arg 1) + (funcall skip)) + (cond + ((> arg 0) + ;; Moving forward. + (if (> (point) pos) + ;; We already moved forward by one because we started from + ;; within a function. + (setq arg (1- arg)) + ;; We started from after the end of the previous function. + (goto-char pos)) + (unless (zerop arg) + (beginning-of-defun-raw (- arg)) + (funcall end-of-defun-function))) + ((< arg 0) + ;; Moving backward. + (if (< (point) pos) + ;; We already moved backward because we started from between + ;; two functions. + (setq arg (1+ arg)) + ;; We started from inside a function. + (goto-char beg)) + (unless (zerop arg) + (beginning-of-defun-raw (- arg)) + (setq beg (point)) + (funcall end-of-defun-function)))) + (funcall skip) + (while (and (< arg 0) (>= (point) pos)) + ;; We intended to move backward, but this ended up not doing so: + ;; Try harder! + (goto-char beg) (beginning-of-defun-raw (- arg)) - (setq beg (point)) - (funcall end-of-defun-function)))) - (funcall skip) - (while (and (< arg 0) (>= (point) pos)) - ;; We intended to move backward, but this ended up not doing so: - ;; Try harder! - (goto-char beg) - (beginning-of-defun-raw (- arg)) - (if (>= (point) beg) - (setq arg 0) - (setq beg (point)) - (funcall end-of-defun-function) - (funcall skip))))) - -(defun mark-defun (&optional arg) + (if (>= (point) beg) + (setq arg 0) + (setq beg (point)) + (funcall end-of-defun-function) + (funcall skip)))))) + +(defun mark-defun (&optional arg interactive) "Put mark at end of this defun, point at beginning. The defun marked is the one that contains point or follows point. With positive ARG, mark this and that many next defuns; with negative ARG, change the direction of marking. If the mark is active, it marks the next or previous defun(s) after -the one(s) already marked." - (interactive "p") - (setq arg (or arg 1)) - ;; There is no `mark-defun-back' function - see - ;; https://lists.gnu.org/r/bug-gnu-emacs/2016-11/msg00079.html - ;; for explanation - (when (eq last-command 'mark-defun-back) - (setq arg (- arg))) - (when (< arg 0) - (setq this-command 'mark-defun-back)) - (cond ((use-region-p) - (if (>= arg 0) - (set-mark - (save-excursion - (goto-char (mark)) - ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed - (dotimes (_ignore arg) - (end-of-defun)) - (point))) - (beginning-of-defun-comments (- arg)))) - (t - (let ((opoint (point)) - beg end) - (push-mark opoint) - ;; Try first in this order for the sake of languages with nested - ;; functions where several can end at the same place as with the - ;; offside rule, e.g. Python. - (beginning-of-defun-comments) - (setq beg (point)) - (end-of-defun) - (setq end (point)) - (when (or (and (<= (point) opoint) - (> arg 0)) - (= beg (point-min))) ; we were before the first defun! - ;; beginning-of-defun moved back one defun so we got the wrong - ;; one. If ARG < 0, however, we actually want to go back. - (goto-char opoint) - (end-of-defun) - (setq end (point)) - (beginning-of-defun-comments) - (setq beg (point))) - (goto-char beg) - (cond ((> arg 0) - ;; change the dotimes below to (end-of-defun arg) once bug #24427 is fixed +the one(s) already marked. + +If INTERACTIVE is non-nil, as it is interactively, +report errors as appropriate for this kind of usage." + (interactive "p\nd") + (if interactive + (condition-case e + (mark-defun arg nil) + (scan-error (user-error (cadr e)))) + (setq arg (or arg 1)) + ;; There is no `mark-defun-back' function - see + ;; https://lists.gnu.org/r/bug-gnu-emacs/2016-11/msg00079.html + ;; for explanation + (when (eq last-command 'mark-defun-back) + (setq arg (- arg))) + (when (< arg 0) + (setq this-command 'mark-defun-back)) + (cond ((use-region-p) + (if (>= arg 0) + (set-mark + (save-excursion + (goto-char (mark)) + ;; change the dotimes below to (end-of-defun arg) + ;; once bug #24427 is fixed (dotimes (_ignore arg) (end-of-defun)) - (setq end (point)) - (push-mark end nil t) - (goto-char beg)) - (t - (goto-char beg) - (unless (= arg -1) ; beginning-of-defun behaves - ; strange with zero arg - see - ; https://lists.gnu.org/r/bug-gnu-emacs/2017-02/msg00196.html - (beginning-of-defun (1- (- arg)))) - (push-mark end nil t)))))) - (skip-chars-backward "[:space:]\n") - (unless (bobp) - (forward-line 1))) + (point))) + (beginning-of-defun-comments (- arg)))) + (t + (let ((opoint (point)) + beg end) + (push-mark opoint) + ;; Try first in this order for the sake of languages with nested + ;; functions where several can end at the same place as with the + ;; offside rule, e.g. Python. + (beginning-of-defun-comments) + (setq beg (point)) + (end-of-defun) + (setq end (point)) + (when (or (and (<= (point) opoint) + (> arg 0)) + (= beg (point-min))) ; we were before the first defun! + ;; beginning-of-defun moved back one defun so we got the wrong + ;; one. If ARG < 0, however, we actually want to go back. + (goto-char opoint) + (end-of-defun) + (setq end (point)) + (beginning-of-defun-comments) + (setq beg (point))) + (goto-char beg) + (cond ((> arg 0) + ;; change the dotimes below to (end-of-defun arg) + ;; once bug #24427 is fixed + (dotimes (_ignore arg) + (end-of-defun)) + (setq end (point)) + (push-mark end nil t) + (goto-char beg)) + (t + (goto-char beg) + (unless (= arg -1) + ;; beginning-of-defun behaves strange with zero arg - see + ;; lists.gnu.org/r/bug-gnu-emacs/2017-02/msg00196.html + (beginning-of-defun (1- (- arg)))) + (push-mark end nil t)))))) + (skip-chars-backward "[:space:]\n") + (unless (bobp) + (forward-line 1)))) (defvar narrow-to-defun-include-comments nil "If non-nil, `narrow-to-defun' will also show comments preceding the defun.") @@ -733,13 +800,52 @@ This command assumes point is not in a string or comment." (interactive "P") (insert-pair arg ?\( ?\))) +(defcustom delete-pair-blink-delay blink-matching-delay + "Time in seconds to delay after showing a paired character to delete. +It's used by the command `delete-pair'. The value 0 disables blinking." + :type 'number + :group 'lisp + :version "28.1") + (defun delete-pair (&optional arg) - "Delete a pair of characters enclosing ARG sexps following point. -A negative ARG deletes a pair of characters around preceding ARG sexps." - (interactive "p") - (unless arg (setq arg 1)) - (save-excursion (forward-sexp arg) (delete-char (if (> arg 0) -1 1))) - (delete-char (if (> arg 0) 1 -1))) + "Delete a pair of characters enclosing ARG sexps that follow point. +A negative ARG deletes a pair around the preceding ARG sexps instead. +The option `delete-pair-blink-delay' can disable blinking." + (interactive "P") + (if arg + (setq arg (prefix-numeric-value arg)) + (setq arg 1)) + (if (< arg 0) + (save-excursion + (skip-chars-backward " \t") + (save-excursion + (let ((close-char (char-before))) + (forward-sexp arg) + (unless (member (list (char-after) close-char) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not after matching pair")) + (when (and (numberp delete-pair-blink-delay) + (> delete-pair-blink-delay 0)) + (sit-for delete-pair-blink-delay)) + (delete-char 1))) + (delete-char -1)) + (save-excursion + (skip-chars-forward " \t") + (save-excursion + (let ((open-char (char-after))) + (forward-sexp arg) + (unless (member (list open-char (char-before)) + (mapcar (lambda (p) + (if (= (length p) 3) (cdr p) p)) + insert-pair-alist)) + (error "Not before matching pair")) + (when (and (numberp delete-pair-blink-delay) + (> delete-pair-blink-delay 0)) + (sit-for delete-pair-blink-delay)) + (delete-char -1))) + (delete-char 1)))) (defun raise-sexp (&optional arg) "Raise ARG sexps higher up the tree." |