bug#38076: Using minibuffer for y-or-n-p

[Juri Linkov]

The previous patch fixes the problem with y-or-n-p reported in bug#17272.

But to fix the problem reported by Alan in
https://lists.gnu.org/archive/html/emacs-devel/2019-10/msg01020.html
for the prompt asking about local variables:

  Please type y, n, or !, or C-v to scroll:

requires using read-char-from-minibuffer instead of read-char-choice.
A new arg CHARS was added to read-char-from-minibuffer to make it
a drop-in replacement for read-char-choice.

Here is a complete tested patch that solves all reported problems
in bug#17272 and bug#19064.  More specific patches will be posted
now to these bug reports as well.

diff --git a/lisp/files.el b/lisp/files.el
index 7690357058..8f7c7c2d04 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -2120,7 +2120,7 @@ files--ask-user-about-large-file
                                       ("Yes" . ?y)
                                       ("No" . ?n)
                                       ("Open literally" . ?l)))
-                (read-char-choice
+                (read-char-from-minibuffer
                  (concat prompt " (y)es or (n)o or (l)iterally ")
                  '(?y ?Y ?n ?N ?l ?L)))))
         (cond ((memq choice '(?y ?Y)) nil)
@@ -3503,24 +3503,17 @@ hack-local-variables-confirm
       ;; Display the buffer and read a choice.
       (save-window-excursion
        (pop-to-buffer buf '(display-buffer--maybe-at-bottom))
-       (let* ((exit-chars '(?y ?n ?\s ?\C-g ?\C-v))
+       (let* ((exit-chars '(?y ?n ?\s))
               (prompt (format "Please type %s%s: "
                               (if offer-save "y, n, or !" "y or n")
                               (if (< (line-number-at-pos (point-max))
                                      (window-body-height))
                                   ""
-                                (push ?\C-v exit-chars)
-                                ", or C-v to scroll")))
+                                ", or C-v/M-v to scroll")))
               char)
          (if offer-save (push ?! exit-chars))
          (while (null char)
-           (setq char (read-char-choice prompt exit-chars t))
-           (when (eq char ?\C-v)
-             (condition-case nil
-                 (scroll-up)
-               (error (goto-char (point-min))
-                      (recenter 1)))
-             (setq char nil)))
+           (setq char (read-char-from-minibuffer prompt exit-chars)))
          (when (and offer-save (= char ?!) unsafe-vars)
            (customize-push-and-save 'safe-local-variable-values unsafe-vars))
          (prog1 (memq char '(?! ?\s ?y))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 43dd277a2e..741fab4f89 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -715,6 +715,11 @@ minibuffer-message
           (message "%s" message))
         (prog1 (sit-for (or minibuffer-message-timeout 1000000))
           (message nil)))
+    ;; Record message in the *Messages* buffer
+    (let ((inhibit-message t))
+      (if args
+          (apply #'message message args)
+        (message "%s" message)))
     ;; Clear out any old echo-area message to make way for our new thing.
     (message nil)
     (setq message (if (and (null args)
@@ -2236,6 +2241,13 @@ completion-help-at-point
 (let ((map minibuffer-local-map))
   (define-key map "\C-g" 'abort-recursive-edit)
   (define-key map "\M-<" 'minibuffer-beginning-of-buffer)
+
+  (define-key map [remap recenter-top-bottom] 'minibuffer-recenter-top-bottom)
+  (define-key map [remap scroll-up-command] 'minibuffer-scroll-up-command)
+  (define-key map [remap scroll-down-command] 'minibuffer-scroll-down-command)
+  (define-key map [remap scroll-other-window] 'minibuffer-scroll-other-window)
+  (define-key map [remap scroll-other-window-down] 
'minibuffer-scroll-other-window-down)
+
   (define-key map "\r" 'exit-minibuffer)
   (define-key map "\n" 'exit-minibuffer))
 
@@ -3670,6 +3682,46 @@ minibuffer-beginning-of-buffer
   (when (and arg (not (consp arg)))
     (forward-line 1)))
 
+(defmacro with-minibuffer-selected-window (&rest body)
+  "Execute the forms in BODY from the minibuffer in its original window.
+When used in a minibuffer window, select the window selected just before
+minibuffer window was selected, and execute the forms."
+  (declare (indent 0) (debug t))
+  `(let ((window (minibuffer-selected-window)))
+     (when window
+       (with-selected-window window
+         ,@body))))
+
+(defun minibuffer-recenter-top-bottom (&optional arg)
+  "Run `recenter-top-bottom' from minibuffer in original window."
+  (interactive "P")
+  (with-minibuffer-selected-window
+    (recenter-top-bottom arg)))
+
+(defun minibuffer-scroll-up-command (&optional arg)
+  "Run `scroll-up-command' from minibuffer in original window."
+  (interactive "^P")
+  (with-minibuffer-selected-window
+    (scroll-up-command arg)))
+
+(defun minibuffer-scroll-down-command (&optional arg)
+  "Run `scroll-down-command' from minibuffer in original window."
+  (interactive "^P")
+  (with-minibuffer-selected-window
+    (scroll-down-command arg)))
+
+(defun minibuffer-scroll-other-window (&optional arg)
+  "Run `scroll-other-window' from minibuffer in original window."
+  (interactive "P")
+  (with-minibuffer-selected-window
+    (scroll-other-window arg)))
+
+(defun minibuffer-scroll-other-window-down (&optional arg)
+  "Run `scroll-other-window-down' from minibuffer in original window."
+  (interactive "^P")
+  (with-minibuffer-selected-window
+    (scroll-other-window-down arg)))
+
 (provide 'minibuffer)
 
 ;;; minibuffer.el ends here
diff --git a/lisp/simple.el b/lisp/simple.el
index 10aecd651f..7ea6c73d3e 100644
--- a/lisp/simple.el
+++ b/lisp/simple.el
@@ -5171,46 +5171,84 @@ backward-delete-char-untabify
     ;; Avoid warning about delete-backward-char
     (with-no-warnings (delete-backward-char n killp))))
 
-(defvar read-char-from-minibuffer-history nil
+(defvar read-char-history nil
   "The default history for the `read-char-from-minibuffer' function.")
 
 (defvar read-char-from-minibuffer-map
   (let ((map (make-sparse-keymap)))
     (set-keymap-parent map minibuffer-local-map)
     (define-key map [remap self-insert-command]
-      'read-char-from-minibuffer-self-insert)
+      'read-char-from-minibuffer-insert-char)
     map)
   "Keymap for the `read-char-from-minibuffer' function.")
 
-(defun read-char-from-minibuffer-self-insert ()
-  "Insert the character you type in the minibuffer."
+(defconst read-char-from-minibuffer-map-hash
+  (make-hash-table :weakness 'key :test 'equal))
+
+(defun read-char-from-minibuffer-insert-char ()
+  "Insert the character you type in the minibuffer and exit.
+Discard all input in a minibuffer before inserting and exiting the minibuffer."
   (interactive)
   (delete-minibuffer-contents)
-  (insert (event-basic-type last-command-event))
+  (insert last-command-event)
   (exit-minibuffer))
 
-(defun read-char-from-minibuffer (prompt)
-  "Read a character from the minibuffer, prompting with string PROMPT.
-Like `read-char', but allows navigating in a history.  The navigation
-commands are `M-p' and `M-n', with `RET' to select a character from
-history."
-  (let ((result
-         (read-from-minibuffer prompt nil
-                               read-char-from-minibuffer-map nil
-                               'read-char-from-minibuffer-history)))
-    (if (> (length result) 0)
-        ;; We have a string (with one character), so return the first one.
-        (elt result 0)
-      ;; The default value is RET.
-      (push "\r" read-char-from-minibuffer-history)
-      ?\r)))
+(defun read-char-from-minibuffer-insert-other ()
+  "Insert the character you type in the minibuffer and exit.
+Discard all input in a minibuffer before inserting and exiting the minibuffer."
+  (interactive)
+  (delete-minibuffer-contents)
+  (beep)
+  (minibuffer-message "Wrong answer")
+  (sit-for 2))
+
+(defvar empty-history)
+
+(defun read-char-from-minibuffer (prompt &optional chars history)
+  "Read a character from the minibuffer, prompting for PROMPT.
+Like `read-char', but uses the minibuffer to read and return a character.
+When CHARS is non-nil, any input that is not one of CHARS is ignored.
+When HISTORY is a symbol, then allows navigating in a history.
+The navigation commands are `M-p' and `M-n', with `RET' to select
+a character from history."
+  (discard-input)
+  (let* ((empty-history '())
+         (map (if (consp chars)
+                  (or (gethash chars read-char-from-minibuffer-map-hash)
+                      (puthash chars
+                               (let ((map (make-sparse-keymap)))
+                                 (set-keymap-parent map 
read-char-from-minibuffer-map)
+                                 (dolist (char chars)
+                                   (define-key map (vector char)
+                                     'read-char-from-minibuffer-insert-char))
+                                 (define-key map [remap self-insert-command]
+                                   'read-char-from-minibuffer-insert-other)
+                                 ;; (define-key map [remap t]
+                                 ;;   'read-char-from-minibuffer-insert-other)
+                                 map)
+                               read-char-from-minibuffer-map-hash))
+                read-char-from-minibuffer-map))
+         (result
+          (read-from-minibuffer prompt nil map nil
+                                (or history 'empty-history)))
+         (char
+          (if (> (length result) 0)
+              ;; We have a string (with one character), so return the first 
one.
+              (elt result 0)
+            ;; The default value is RET.
+            (push "\r" read-char-history)
+            ?\r)))
+    ;; Display the question with the answer.
+    (message "%s%s" prompt (char-to-string char))
+    char))
 
 (defun zap-to-char (arg char)
   "Kill up to and including ARGth occurrence of CHAR.
 Case is ignored if `case-fold-search' is non-nil in the current buffer.
 Goes backward if ARG is negative; error if CHAR not found."
   (interactive (list (prefix-numeric-value current-prefix-arg)
-                    (read-char-from-minibuffer "Zap to char: ")))
+                    (read-char-from-minibuffer "Zap to char: "
+                                                nil 'read-char-history)))
   ;; Avoid "obsolete" warnings for translation-table-for-input.
   (with-no-warnings
     (if (char-table-p translation-table-for-input)
diff --git a/lisp/subr.el b/lisp/subr.el
index 03cf3da278..33464d6032 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2668,6 +2668,70 @@ sit-for
 ;; Behind display-popup-menus-p test.
 (declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
+(defvar y-or-n-p-history-variable nil
+  "History list symbol to add `y-or-n-p' answers to.")
+
+(defvar y-or-n-p-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+
+    ;; (define-key map [t] 'y-or-n-p-insert-other)
+
+    (define-key map [remap act] 'y-or-n-p-insert-y)
+    (define-key map [remap act-and-show] 'y-or-n-p-insert-y)
+    (define-key map [remap act-and-exit] 'y-or-n-p-insert-y)
+    (define-key map [remap automatic] 'y-or-n-p-insert-y)
+
+    (define-key map [remap skip] 'y-or-n-p-insert-n)
+
+    (define-key map [remap help] 'y-or-n-p-insert-other)
+    (define-key map [remap backup] 'y-or-n-p-insert-other)
+    (define-key map [remap undo] 'y-or-n-p-insert-other)
+    (define-key map [remap undo-all] 'y-or-n-p-insert-other)
+    (define-key map [remap edit] 'y-or-n-p-insert-other)
+    (define-key map [remap edit-replacement] 'y-or-n-p-insert-other)
+    (define-key map [remap delete-and-edit] 'y-or-n-p-insert-other)
+    (define-key map [remap ignore] 'y-or-n-p-insert-other)
+    (define-key map [remap self-insert-command] 'y-or-n-p-insert-other)
+
+    (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
+
+    (define-key map [remap quit] 'abort-recursive-edit)
+    (define-key map [remap exit] 'abort-recursive-edit)
+    (define-key map [remap exit-prefix] 'abort-recursive-edit)
+    (define-key map [escape] 'abort-recursive-edit)
+
+    ;; (define-key map [remap t] 'y-or-n-p-insert-other)
+
+    map)
+  "Keymap that defines additional bindings for `y-or-n-p' answers.")
+
+(defun y-or-n-p-insert-y ()
+  "Insert the answer \"y\" and exit the minibuffer of `y-or-n-p'.
+Discard all input in a minibuffer before inserting."
+  (interactive)
+  (delete-minibuffer-contents)
+  (insert "y")
+  (exit-minibuffer))
+
+(defun y-or-n-p-insert-n ()
+  "Insert the answer \"n\" and exit the minibuffer of `y-or-n-p'.
+Discard all input in a minibuffer before inserting."
+  (interactive)
+  (delete-minibuffer-contents)
+  (insert "n")
+  (exit-minibuffer))
+
+(defun y-or-n-p-insert-other ()
+  "Handle inserting of other answers in the minibuffer of `y-or-n-p'."
+  (interactive)
+  (delete-minibuffer-contents)
+  (ding)
+  (minibuffer-message "Please answer y or n")
+  (sit-for 2))
+
+(defvar empty-history)
+
 (defun y-or-n-p (prompt)
   "Ask user a \"y or n\" question.
 Return t if answer is \"y\" and nil if it is \"n\".
@@ -2683,16 +2747,13 @@ y-or-n-p
 case, the useful bindings are `act', `skip', `recenter',
 `scroll-up', `scroll-down', and `quit'.
 An `act' response means yes, and a `skip' response means no.
-A `quit' response means to invoke `keyboard-quit'.
+A `quit' response means to invoke `abort-recursive-edit'.
 If the user enters `recenter', `scroll-up', or `scroll-down'
 responses, perform the requested window recentering or scrolling
 and ask again.
 
 Under a windowing system a dialog box will be used if `last-nonmenu-event'
 is nil and `use-dialog-box' is non-nil."
-  ;; ¡Beware! when I tried to edebug this code, Emacs got into a weird state
-  ;; where all the keys were unbound (i.e. it somehow got triggered
-  ;; within read-key, apparently).  I had to kill it.
   (let ((answer 'recenter)
        (padded (lambda (prompt &optional dialog)
                  (let ((l (length prompt)))
@@ -2718,36 +2779,14 @@ y-or-n-p
            answer (x-popup-dialog t `(,prompt ("Yes" . act) ("No" . skip)))))
      (t
       (setq prompt (funcall padded prompt))
-      (while
-          (let* ((scroll-actions '(recenter scroll-up scroll-down
-                                  scroll-other-window 
scroll-other-window-down))
-                (key
-                  (let ((cursor-in-echo-area t))
-                    (when minibuffer-auto-raise
-                      (raise-frame (window-frame (minibuffer-window))))
-                    (read-key (propertize (if (memq answer scroll-actions)
-                                              prompt
-                                            (concat "Please answer y or n.  "
-                                                    prompt))
-                                          'face 'minibuffer-prompt)))))
-            (setq answer (lookup-key query-replace-map (vector key) t))
-            (cond
-            ((memq answer '(skip act)) nil)
-            ((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)
-            ((or (memq answer '(exit-prefix quit)) (eq key ?\e))
-             (signal 'quit nil) t)
-            (t t)))
-        (ding)
-        (discard-input))))
+      (discard-input)
+      (let* ((empty-history '())
+             (str (read-from-minibuffer
+                   prompt nil
+                   (make-composed-keymap y-or-n-p-map query-replace-map)
+                   nil
+                   (or y-or-n-p-history-variable 'empty-history))))
+        (setq answer (if (member str '("y" "Y")) 'act 'skip)))))
     (let ((ret (eq answer 'act)))
       (unless noninteractive
         (message "%s%c" prompt (if ret ?y ?n)))
diff --git a/lisp/userlock.el b/lisp/userlock.el
index 209768620c..1d3ac84584 100644
--- a/lisp/userlock.el
+++ b/lisp/userlock.el
@@ -152,7 +152,7 @@ ask-user-about-supersession-threat
        (message "%s" prompt)
        (error "Cannot resolve conflict in batch mode"))
       (while (null answer)
-       (setq answer (read-char-choice prompt choices))
+       (setq answer (read-char-from-minibuffer prompt choices))
        (cond ((memq answer '(?? ?\C-h))
               (ask-user-about-supersession-help)
               (setq answer nil))
diff --git a/src/window.c b/src/window.c
index 0fa0bdf7b9..c01f5c4aa3 100644
--- a/src/window.c
+++ b/src/window.c
@@ -6253,12 +6253,12 @@ DEFUN ("other-window-for-scrolling", 
Fother_window_for_scrolling, Sother_window_
     {
       /* Nothing specified; look for a neighboring window on the same
         frame.  */
-      window = Fnext_window (selected_window, Qnil, Qnil);
+      window = Fnext_window (selected_window, Qlambda, Qnil);
 
       if (EQ (window, selected_window))
        /* That didn't get us anywhere; look for a window on another
            visible frame on the current terminal.  */
-        window = Fnext_window (window, Qnil, Qvisible);
+        window = Fnext_window (window, Qlambda, Qvisible);
     }
 
   CHECK_LIVE_WINDOW (window);