Subject: Re: bug#31692: Emacs sometimes drops key events

From: Eli Zaretskii <[email-masked]>
Date: Thu, 07 Jun 2018 18:20:04 +0300

> From: Michael Heerdegen <[email-masked]>
> Cc: [email-masked],  [email-masked]
> Date: Thu, 07 Jun 2018 00:50:00 +0200
> 
> > But in your case while-no-input was the top-level form, no?  So where
> > else can a quit throw?
> 
> There should be no quit at all.  `throw-on-input' uses a special value
> `quit-flag' internally to implement what it does, but AFAIU signaling a
> real quit is not intended.

It is not intended, but it can (and did) happen.  See below.

> In my example, `test' was the top-level form, and I would expect that
> `while-no-input' completes normally, which it doesn't in this case.

That's not what I see.  while-no-input does "complete normally" (for
some value of "normally"), but then we immediately quit to top-level
after while-no-input returns.

> This case is the only one I know of where `while-no-input' is left with
> an nonlocal exit.

Then I guess you just were lucky.  After reading the details below,
I'm sure you will be able to concoct any number of use cases where
similar things happen.

> AFAIU `while-no-input' is also not meant to consume user input, and
> `sit-for' also should not do this.  Only the combination of the two
> shows this behavior.

It's not while-no-input that swallows the input.  It's the quit to
top-level executed after while-no-input returns that discards it.

How do we end up quitting to top-level?  Well, that's because sit-for
exits due to keyboard input, and while-no-input then also exits, since
its BODY finished.  However, quit-flag, which was set when keyboard
input processing noticed that we are inside while-no-input, is still
set to a non-nil value.  It is true that quit-flag's value is set to
the symbol created by while-no-input, but the let-binding inside
while-no-input which was supposed to catch that special kind of
"quitting" is already gone, since we are outside of while-no-input.
And a non-nil value of quit-flag without any valid catcher always
quits.  So that is what we get, and discarding pending input is just
one side effect of doing that.

Once upon a time, when while-no-input was written, Emacs tested
quit-flag in the signal handler which processed input, and we then
would throw to the while-no-input's catcher right out of the signal
handler.  But nowadays we no longer jump out of the signal handler, we
only set a flag there, which is tested "when it's safe", i.e. when
Emacs calls maybe_quit.  And the code run by sit-for doesn't call
maybe_quit, so the flag is never tested, until after sit-for and
while-no-input return, and we are about to call 'message'.  sit-for
stashes input it read in unread-command-events, but when we quit, we
discard any events in unread-command-events.

IOW, any BODY of while-no-input that never calls maybe_quit will
produce the same effect of quitting to top-level.  And that is indeed
not expected by callers of while-no-input.

So with that in mind, I propose the following patch to while-no-input
(and CC Stefan who messed with the related code and with sit-for much
more than I did):

--- lisp/subr.el~0	2018-03-14 06:40:04.000000000 +0200
+++ lisp/subr.el	2018-06-07 17:59:40.229348300 +0300
@@ -3511,9 +3511,25 @@
   (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
+            ;; If quit-flag is equal to throw-on-input, it means BODY
+            ;; didn't test quit-flag, and therefore ran to completion
+            ;; even though input arrived before it finished.  In that
+            ;; case, we must throw manually, because otherwise
+            ;; quit-flag will remain set, and we get Quit to
+            ;; top-level, which has undesirable consequences, such as
+            ;; discarding input etc.
+            ((eq quit-flag throw-on-input)
+             (throw 'throw-on-input t))
+            ;; This is in case the user actually quits while BODY runs.
+            (quit-flag
+             nil)
+            (t val)))))))
 
 (defmacro condition-case-unless-debug (var bodyform &rest handlers)
   "Like `condition-case' except that it does not prevent debugging.