[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 1167253: Don't signal scan-error in interactive sexp-based comman
|
From: |
Mattias Engdegård |
|
Subject: |
master 1167253: Don't signal scan-error in interactive sexp-based commands |
|
Date: |
Fri, 30 Apr 2021 11:33:50 -0400 (EDT) |
branch: master
commit 1167253f75badf9e7df1bf983c2ebeb2d37d3881
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Don't signal scan-error in interactive sexp-based commands
This takes care of unfinished business from df0f32f04850 (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.
---
lisp/emacs-lisp/lisp.el | 246 ++++++++++++++++++++++++++----------------------
lisp/reposition.el | 232 +++++++++++++++++++++++----------------------
lisp/simple.el | 73 +++++++-------
3 files changed, 291 insertions(+), 260 deletions(-)
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el
index 46ca948..2495277 100644
--- a/lisp/emacs-lisp/lisp.el
+++ b/lisp/emacs-lisp/lisp.el
@@ -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)
+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.")
diff --git a/lisp/reposition.el b/lisp/reposition.el
index 008fa00..02bee41 100644
--- a/lisp/reposition.el
+++ b/lisp/reposition.el
@@ -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.
-
- (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.
-
- (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
-
- ((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")
- )
-
- (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")
- ))))
+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")
+ )
+
+ ((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")
+ )
+
+ ;; 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 (> (+ 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.
+
+ ;; 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
diff --git a/lisp/simple.el b/lisp/simple.el
index 26eb8ca..6c51553 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -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.
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 1167253: Don't signal scan-error in interactive sexp-based commands,
Mattias Engdegård <=