Allow scrolling while querying multiple choice

* lisp/subr.el (read-multiple-choice): Allow scrolling the
buffer while querying (bug#22827).

diff --git a/lisp/subr.el b/lisp/subr.el
index 6eea54f2a32cfb2892d7fc1c20c6f0d68080b226..7b0850f463ff8ca4d736b42bd305cdb39a32006d 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2244,6 +2244,14 @@ might be shortened), and the third, optional entry is a longer
 explanation that will be displayed in a help buffer if the user
 requests more help.
 
+This function translates user input into responses by consulting
+the bindings in `query-replace-map'; see the documentation of
+that variable for more information.  In this case, the useful
+bindings are `recenter', `scroll-up', and `scroll-down'.  If the
+user enters `recenter', `scroll-up', or `scroll-down' responses,
+perform the requested window recentering or scrolling and ask
+again.
+
 The return value is the matching entry from the CHOICES list.
 
 Usage example:
@@ -2314,9 +2322,27 @@ Usage example:
                       (let ((cursor-in-echo-area t))
                         (read-char))
                     (error nil))))
+          (setq answer (lookup-key query-replace-map (vector tchar) t))
+          (setq tchar
+                (cond
+                 ((eq answer 'recenter)
+                  (recenter) t)
+                 ((eq answer 'scroll-up)
+                  (ignore-errors (scroll-up-command)) t)
+                 ((eq answer 'scroll-down)
+                  (ignore-errors (scroll-down-command)) t)
+                 ((eq answer 'scroll-other-window)
+                  (ignore-errors (scroll-other-window)) t)
+                 ((eq answer 'scroll-other-window-down)
+                  (ignore-errors (scroll-other-window-down)) t)
+                 (t tchar)))
+          (when (eq tchar t)
+            (setq wrong-char nil
+                  tchar nil))
           ;; The user has entered an invalid choice, so display the
           ;; help messages.
-         (when (not (assq tchar choices))
+          (when (and (not (eq tchar nil))
+                     (not (assq tchar choices)))
            (setq wrong-char (not (memq tchar '(?? ?\C-h)))
                   tchar nil)
             (when wrong-char