Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Don't signal scan-error in interactive sexp-based commands

Browse source 
This takes care of unfinished business from df0f32f048 (bug#43489).

* lisp/emacs-lisp/lisp.el (end-of-defun, mark-defun):
* lisp/reposition.el (reposition-window):
* lisp/simple.el (transpose-sexps): Convert nasty-looking scan-error
into a human-readable message.
This commit is contained in:
Mattias Engdegård 2021-04-30 17:09:21 +02:00
parent ab7a61e0ef
commit 1167253f75
3 changed files with 283 additions and 252 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

246
lisp/emacs-lisp/lisp.el
View file

@ -503,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.
@ -513,129 +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)
(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))
(if (>= (point) beg)
(setq arg 0)
(setq beg (point))
(funcall end-of-defun-function)
(funcall skip)))))
is called as a function to find the defun's end.
(defun mark-defun (&optional arg)
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))
(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.")

216
lisp/reposition.el
View file

@ -38,7 +38,7 @@
;;; Code:
;;;###autoload
(defun reposition-window (&optional arg)
(defun reposition-window (&optional arg interactive)
"Make the current definition and/or comment visible.
Further invocations move it to the top of the window or toggle the
visibility of comments that precede it.
@ -55,118 +55,124 @@ the comment lines.
visible (if only part could otherwise be made so), to make the defun line
visible (if point is in code and it could not be made so, or if only
comments, including the first comment line, are visible), or to make the
first comment line visible (if point is in a comment)."
(interactive "P")
(let* (;; (here (line-beginning-position))
(here (point))
;; change this name once I've gotten rid of references to ht.
;; this is actually the number of the last screen line
(ht (- (window-height) 2))
(line (repos-count-screen-lines (window-start) (point)))
(comment-height
;; The call to max deals with the case of cursor between defuns.
(max 0
(repos-count-screen-lines-signed
;; the beginning of the preceding comment
(save-excursion
(if (not (eobp)) (forward-char 1))
(end-of-defun -1)
;; Skip whitespace, newlines, and form feeds.
(if (re-search-forward "[^ \t\n\f]" nil t)
(backward-char 1))
(point))
here)))
(defun-height
(repos-count-screen-lines-signed
(save-excursion
(end-of-defun 1) ; so comments associate with following defuns
(beginning-of-defun 1)
(point))
here))
;; This must be positive, so don't use the signed version.
(defun-depth (repos-count-screen-lines here
(save-excursion
(end-of-defun 1)
(point))))
(defun-line-onscreen-p
(and (<= defun-height line)
(<= (- line defun-height) ht))))
(cond ((or (= comment-height line)
(and (= line ht)
(> comment-height line)
;; if defun line offscreen, we should be in case 4
defun-line-onscreen-p))
;; Either first comment line is at top of screen or (point at
;; bottom of screen, defun line onscreen, and first comment line
;; off top of screen). That is, it looks like we just did
;; recenter-definition, trying to fit as much of the comment
;; onscreen as possible. Put defun line at top of screen; that
;; is, show as much code, and as few comments, as possible.
first comment line visible (if point is in a 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 e
(reposition-window arg nil)
(scan-error (user-error (cadr e))))
(let* (;; (here (line-beginning-position))
(here (point))
;; change this name once I've gotten rid of references to ht.
;; this is actually the number of the last screen line
(ht (- (window-height) 2))
(line (repos-count-screen-lines (window-start) (point)))
(comment-height
;; The call to max deals with the case of cursor between defuns.
(max 0
(repos-count-screen-lines-signed
;; the beginning of the preceding comment
(save-excursion
(if (not (eobp)) (forward-char 1))
(end-of-defun -1)
;; Skip whitespace, newlines, and form feeds.
(if (re-search-forward "[^ \t\n\f]" nil t)
(backward-char 1))
(point))
here)))
(defun-height
(repos-count-screen-lines-signed
(save-excursion
(end-of-defun 1) ; so comments associate with following defuns
(beginning-of-defun 1)
(point))
here))
;; This must be positive, so don't use the signed version.
(defun-depth (repos-count-screen-lines here
(save-excursion
(end-of-defun 1)
(point))))
(defun-line-onscreen-p
(and (<= defun-height line)
(<= (- line defun-height) ht))))
(cond ((or (= comment-height line)
(and (= line ht)
(> comment-height line)
;; if defun line offscreen, we should be in case 4
defun-line-onscreen-p))
;; Either first comment line is at top of screen or (point at
;; bottom of screen, defun line onscreen, and first comment line
;; off top of screen). That is, it looks like we just did
;; recenter-definition, trying to fit as much of the comment
;; onscreen as possible. Put defun line at top of screen; that
;; is, show as much code, and as few comments, as possible.
(if (and arg (> defun-depth (1+ ht)))
;; Can't fit whole defun onscreen without moving point.
(progn (end-of-defun) (beginning-of-defun) (recenter 0))
(recenter (max defun-height 0)))
;;(repos-debug-macro "1")
)
(if (and arg (> defun-depth (1+ ht)))
;; Can't fit whole defun onscreen without moving point.
(progn (end-of-defun) (beginning-of-defun) (recenter 0))
(recenter (max defun-height 0)))
;;(repos-debug-macro "1")
)
((or (= defun-height line)
(= line 0)
(and (< line comment-height)
(< defun-height 0)))
;; Defun line or cursor at top of screen, OR cursor in comment
;; whose first line is offscreen.
;; Avoid moving definition up even if defun runs offscreen;
;; we care more about getting the comment onscreen.
((or (= defun-height line)
(= line 0)
(and (< line comment-height)
(< defun-height 0)))
;; Defun line or cursor at top of screen, OR cursor in comment
;; whose first line is offscreen.
;; Avoid moving definition up even if defun runs offscreen;
;; we care more about getting the comment onscreen.
(cond ((= line ht)
;; cursor on last screen line (and so in a comment)
(if arg (progn (end-of-defun) (beginning-of-defun)))
(recenter 0)
;;(repos-debug-macro "2a")
)
(cond ((= line ht)
;; cursor on last screen line (and so in a comment)
(if arg (progn (end-of-defun) (beginning-of-defun)))
(recenter 0)
;;(repos-debug-macro "2a")
)
;; This condition, copied from case 4, may not be quite right
;; This condition, copied from case 4, may not be quite right
((and arg (< ht comment-height))
;; Can't get first comment line onscreen.
;; Go there and try again.
(forward-line (- comment-height))
(beginning-of-line)
;; was (reposition-window)
(recenter 0)
;;(repos-debug-macro "2b")
)
(t
(recenter (min ht comment-height))
;;(repos-debug-macro "2c")
))
;; (recenter (min ht comment-height))
)
((and arg (< ht comment-height))
;; Can't get first comment line onscreen.
;; Go there and try again.
(forward-line (- comment-height))
(beginning-of-line)
;; was (reposition-window)
(recenter 0)
;;(repos-debug-macro "2b")
)
(t
(recenter (min ht comment-height))
;;(repos-debug-macro "2c")
))
;; (recenter (min ht comment-height))
)
((and (> (+ line defun-depth -1) ht)
defun-line-onscreen-p)
;; Defun runs off the bottom of the screen and the defun line
;; is onscreen.
;; Move the defun up.
(recenter (max 0 (1+ (- ht defun-depth)) defun-height))
;;(repos-debug-macro "3")
)
((and (> (+ line defun-depth -1) ht)
defun-line-onscreen-p)
;; Defun runs off the bottom of the screen and the defun line
;; is onscreen.
;; Move the defun up.
(recenter (max 0 (1+ (- ht defun-depth)) defun-height))
;;(repos-debug-macro "3")
)
(t
;; If on the bottom line and comment start is offscreen
;; then just move all comments offscreen, or at least as
;; far as they'll go.
(t
;; If on the bottom line and comment start is offscreen
;; then just move all comments offscreen, or at least as
;; far as they'll go.
;; Try to get as much of the comments onscreen as possible.
(if (and arg (< ht comment-height))
;; Can't get defun line onscreen; go there and try again.
(progn (forward-line (- defun-height))
(beginning-of-line)
(reposition-window))
(recenter (min ht comment-height)))
;;(repos-debug-macro "4")
))))
;; Try to get as much of the comments onscreen as possible.
(if (and arg (< ht comment-height))
;; Can't get defun line onscreen; go there and try again.
(progn (forward-line (- defun-height))
(beginning-of-line)
(reposition-window))
(recenter (min ht comment-height)))
;;(repos-debug-macro "4")
)))))
;;; Auxiliary functions

73
lisp/simple.el
View file

@ -7691,44 +7691,53 @@ are interchanged."
(interactive "*p")
(transpose-subr 'forward-word arg))
(defun transpose-sexps (arg)
(defun transpose-sexps (arg &optional interactive)
"Like \\[transpose-chars] (`transpose-chars'), but applies to sexps.
Unlike `transpose-words', point must be between the two sexps and not
in the middle of a sexp to be transposed.
With non-zero prefix arg ARG, effect is to take the sexp before point
and drag it forward past ARG other sexps (backward if ARG is negative).
If ARG is zero, the sexps ending at or after point and at or after mark
are interchanged."
(interactive "*p")
(transpose-subr
(lambda (arg)
;; Here we should try to simulate the behavior of
;; (cons (progn (forward-sexp x) (point))
;; (progn (forward-sexp (- x)) (point)))
;; Except that we don't want to rely on the second forward-sexp
;; putting us back to where we want to be, since forward-sexp-function
;; might do funny things like infix-precedence.
(if (if (> arg 0)
(looking-at "\\sw\\|\\s_")
(and (not (bobp))
(save-excursion (forward-char -1) (looking-at "\\sw\\|\\s_"))))
;; Jumping over a symbol. We might be inside it, mind you.
(progn (funcall (if (> arg 0)
'skip-syntax-backward 'skip-syntax-forward)
"w_")
(cons (save-excursion (forward-sexp arg) (point)) (point)))
;; Otherwise, we're between sexps. Take a step back before jumping
;; to make sure we'll obey the same precedence no matter which direction
;; we're going.
(funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward) " .")
(cons (save-excursion (forward-sexp arg) (point))
(progn (while (or (forward-comment (if (> arg 0) 1 -1))
(not (zerop (funcall (if (> arg 0)
'skip-syntax-forward
'skip-syntax-backward)
".")))))
(point)))))
arg 'special))
are interchanged.
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 nil
(transpose-sexps arg nil)
(scan-error (user-error "Not between two complete sexps")))
(transpose-subr
(lambda (arg)
;; Here we should try to simulate the behavior of
;; (cons (progn (forward-sexp x) (point))
;; (progn (forward-sexp (- x)) (point)))
;; Except that we don't want to rely on the second forward-sexp
;; putting us back to where we want to be, since forward-sexp-function
;; might do funny things like infix-precedence.
(if (if (> arg 0)
(looking-at "\\sw\\|\\s_")
(and (not (bobp))
(save-excursion
(forward-char -1)
(looking-at "\\sw\\|\\s_"))))
;; Jumping over a symbol. We might be inside it, mind you.
(progn (funcall (if (> arg 0)
'skip-syntax-backward 'skip-syntax-forward)
"w_")
(cons (save-excursion (forward-sexp arg) (point)) (point)))
;; Otherwise, we're between sexps. Take a step back before jumping
;; to make sure we'll obey the same precedence no matter which
;; direction we're going.
(funcall (if (> arg 0) 'skip-syntax-backward 'skip-syntax-forward)
" .")
(cons (save-excursion (forward-sexp arg) (point))
(progn (while (or (forward-comment (if (> arg 0) 1 -1))
(not (zerop (funcall (if (> arg 0)
'skip-syntax-forward
'skip-syntax-backward)
".")))))
(point)))))
arg 'special)))
(defun transpose-lines (arg)
"Exchange current line and previous line, leaving point after both.