From 2461266be1ea68a8c79af61abe850bb5a2c65040 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Sat, 16 Jun 2018 11:25:01 +0300 Subject: [PATCH] Prevent QUIT to top level inside 'while-no-input' * lisp/subr.el (while-no-input): Handle the case when BODY never tests quit-flag, and runs to completion even though input arrives while BODY executes. (Bug#31692) --- lisp/subr.el | 28 +++++++++++++++++++++++++--- 1 file changed, 25 insertions(+), 3 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 914112ccef5..4a2b797fa0c 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -3520,9 +3520,31 @@ If BODY finishes, `while-no-input' returns whatever value BODY produced." (let ((catch-sym (make-symbol "input"))) `(with-local-quit (catch ',catch-sym - (let ((throw-on-input ',catch-sym)) - (or (input-pending-p) - (progn ,@body))))))) + (let ((throw-on-input ',catch-sym) + val) + (setq val (or (input-pending-p) + (progn ,@body))) + (cond + ;; When input arrives while throw-on-input is non-nil, + ;; kbd_buffer_store_buffered_event sets quit-flag to the + ;; value of throw-on-input. If, when BODY finishes, + ;; quit-flag still has the same value as throw-on-input, it + ;; means BODY never tested quit-flag, and therefore ran to + ;; completion even though input did arrive before it + ;; finished. In that case, we must manually simulate what + ;; 'throw' in process_quit_flag would do, and we must + ;; reset quit-flag, because leaving it set will cause us + ;; quit to top-level, which has undesirable consequences, + ;; such as discarding input etc. We return t in that case + ;; because input did arrive during execution of BODY. + ((eq quit-flag throw-on-input) + (setq quit-flag nil) + t) + ;; This is for when the user actually QUITs during + ;; execution of BODY. + (quit-flag + nil) + (t val))))))) (defmacro condition-case-unless-debug (var bodyform &rest handlers) "Like `condition-case' except that it does not prevent debugging. -- 2.39.2