master a26a8cc: 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer (bug#38076)

[Juri Linkov]

branch: master
commit a26a8cc1c85f29fb11209c16d53a8ae4e4ab7ced
Author: Juri Linkov <address@hidden>
Commit: Juri Linkov <address@hidden>

    'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer (bug#38076)
    
    * doc/lispref/minibuf.texi (Yes-or-No Queries): Update the fact
    that y-or-n-p uses the minibuffer.
    
    * lisp/subr.el (y-or-n-p-history-variable): New variable.
    (y-or-n-p-map): New keymap.
    (y-or-n-p-insert-y, y-or-n-p-insert-n, y-or-n-p-insert-other):
    New commands.
    (y-or-n-p): Rewrite to use read-from-minibuffer and make-composed-keymap
    with y-or-n-p-map and query-replace-map.
---
 doc/lispref/minibuf.texi |  36 +++++++----------
 etc/NEWS                 |   3 ++
 lisp/subr.el             | 103 +++++++++++++++++++++++++++++++----------------
 3 files changed, 87 insertions(+), 55 deletions(-)

diff --git a/doc/lispref/minibuf.texi b/doc/lispref/minibuf.texi
index 49add3f..41c87ce 100644
--- a/doc/lispref/minibuf.texi
+++ b/doc/lispref/minibuf.texi
@@ -2020,29 +2020,27 @@ uses keyboard input.  You can force use either of the 
mouse or of keyboard
 input by binding @code{last-nonmenu-event} to a suitable value around
 the call.
 
-  Strictly speaking, @code{yes-or-no-p} uses the minibuffer and
-@code{y-or-n-p} does not; but it seems best to describe them together.
+  Both @code{yes-or-no-p} and @code{y-or-n-p} use the minibuffer.
 
 @defun y-or-n-p prompt
-This function asks the user a question, expecting input in the echo
-area.  It returns @code{t} if the user types @kbd{y}, @code{nil} if the
-user types @kbd{n}.  This function also accepts @key{SPC} to mean yes
-and @key{DEL} to mean no.  It accepts @kbd{C-]} to quit, like
-@kbd{C-g}, because the question might look like a minibuffer and for
-that reason the user might try to use @kbd{C-]} to get out.  The answer
-is a single character, with no @key{RET} needed to terminate it.  Upper
-and lower case are equivalent.
-
-``Asking the question'' means printing @var{prompt} in the echo area,
+This function asks the user a question, expecting input in the minibuffer.
+It returns @code{t} if the user types @kbd{y}, @code{nil} if the user
+types @kbd{n}.  This function also accepts @key{SPC} to mean yes and
+@key{DEL} to mean no.  It accepts @kbd{C-]} and @kbd{C-g} to quit,
+because the question uses the minibuffer and for that reason the user
+might try to use @kbd{C-]} to get out.  The answer is a single
+character, with no @key{RET} needed to terminate it.  Upper and lower
+case are equivalent.
+
+``Asking the question'' means printing @var{prompt} in the minibuffer,
 followed by the string @w{@samp{(y or n) }}.  If the input is not one of
 the expected answers (@kbd{y}, @kbd{n}, @kbd{@key{SPC}},
 @kbd{@key{DEL}}, or something that quits), the function responds
 @samp{Please answer y or n.}, and repeats the request.
 
-This function does not actually use the minibuffer, since it does not
-allow editing of the answer.  It actually uses the echo area (@pxref{The
-Echo Area}), which uses the same screen space as the minibuffer.  The
-cursor moves to the echo area while the question is being asked.
+This function actually uses the minibuffer, but does not allow editing
+of the answer.  The cursor moves to the minibuffer while the question
+is being asked.
 
 The answers and their meanings, even @samp{y} and @samp{n}, are not
 hardwired, and are specified by the keymap @code{query-replace-map}
@@ -2053,10 +2051,6 @@ special responses @code{recenter}, @code{scroll-up},
 @kbd{C-v}, @kbd{M-v}, @kbd{C-M-v} and @kbd{C-M-S-v} in
 @code{query-replace-map}), this function performs the specified window
 recentering or scrolling operation, and poses the question again.
-
-@noindent
-We show successive lines of echo area messages, but only one actually
-appears on the screen at a time.
 @end defun
 
 @defun y-or-n-p-with-timeout prompt seconds default
@@ -2072,7 +2066,7 @@ minibuffer.  It returns @code{t} if the user enters 
@samp{yes},
 @code{nil} if the user types @samp{no}.  The user must type @key{RET} to
 finalize the response.  Upper and lower case are equivalent.
 
-@code{yes-or-no-p} starts by displaying @var{prompt} in the echo area,
+@code{yes-or-no-p} starts by displaying @var{prompt} in the minibuffer,
 followed by @w{@samp{(yes or no) }}.  The user must type one of the
 expected responses; otherwise, the function responds @samp{Please answer
 yes or no.}, waits about two seconds and repeats the request.
diff --git a/etc/NEWS b/etc/NEWS
index 4e6a70f..f2685a1 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -723,6 +723,9 @@ the minibuffer.  If non-nil, point will move to the end of 
the prompt
 *** Minibuffer now uses 'minibuffer-message' to display error messages
 at the end of the active minibuffer.
 
++++
+*** 'y-or-n-p' now uses the minibuffer to read 'y' or 'n' answer.
+
 ** map.el
 *** Now also understands plists.
 *** Now defined via generic functions that can be extended via 'cl-defmethod'.
diff --git a/lisp/subr.el b/lisp/subr.el
index 85e7187..8ac2f86 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2668,6 +2668,66 @@ floating point support."
 ;; 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)
+
+    (dolist (symbol '(act act-and-show act-and-exit automatic))
+      (define-key map (vector 'remap symbol) 'y-or-n-p-insert-y))
+
+    (define-key map [remap skip] 'y-or-n-p-insert-n)
+
+    (dolist (symbol '(help backup undo undo-all edit edit-replacement
+                      delete-and-edit ignore self-insert-command))
+      (define-key map (vector 'remap symbol) 'y-or-n-p-insert-other))
+
+    (define-key map [remap recenter] 'minibuffer-recenter-top-bottom)
+    (define-key map [remap scroll-up] 'minibuffer-scroll-up-command)
+    (define-key map [remap scroll-down] '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 [escape] 'abort-recursive-edit)
+    (dolist (symbol '(quit exit exit-prefix))
+      (define-key map (vector 'remap symbol) 'abort-recursive-edit))
+
+    ;; FIXME: try catch-all instead of explicit bindings:
+    ;; (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 previous input before inserting and exiting the minibuffer."
+  (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 previous input before inserting and exiting the minibuffer."
+  (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'.
+Display an error on trying to insert a disallowed character.
+Also discard all previous input in the minibuffer."
+  (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 +2743,13 @@ documentation of that variable for more information.  
In this
 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 +2775,14 @@ is nil and `use-dialog-box' is non-nil."
            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)))