bug#27979: tab completion for "(yes or no)?"

[Drew Adams <drew.adams@oracle.com>]

[-- Attachment #1: Type: text/plain, Size: 1528 bytes --]

> We could perhaps give users a way to say, "From now on,
> for this particular prompting (i.e., in this particular
> function/context), use `y-or-n-p', not `yes-or-no-p'.

Here's a rough bit along those lines (attached), to play with.
Just something quick & dirty, unfinished (doc etc.) and only
summarily tested.  (I did nothing with the code for dialog
boxes and `noninteractive'.)

What it does:

1. Add a CALLER optional arg to `yes-or-no-p' and `y-or-n-p'.
   It is the symbol for the function that is calling the
   confirmation-prompt function.  If CALLER is not present,
   the behavior is the same as now.

   If something like this were adopted then we would presumably
   add CALLER to calls of these functions.  For example, in the
   definition of `help-mode-revert-buffer' we would use this:
   (yes-or-no-p "Revert help buffer? " 'help-mode-revert-buffer)

2. For `yes-or-no-p', if CALLER is present then: 

   * If CALLER has non-nil property `use-y-or-n-p' then
     use `y-or-n-p' (in place of the rest of `yes-or-no-p').

   * Otherwise, `use-y-or-n-p' is a possible user input.
     If this is the input then `(put CALLER 'use-y-or-n-p t)'
     and prompt again, but with `y-or-n-p'.

3. For `y-or-n-p', if CALLER is present then:

   * Input of `e' (bound to `edit-replacement' in the keymap)
     does `(put CALLER 'use-y-or-n-p nil)', then prompts again,
     but with `yes-or-no-p'.

Let me know if you find a problem.  (BTW, why is `yes-or-no-p'
defined in C code?)

[-- Attachment #2: throw-yes-no.el --]
[-- Type: application/octet-stream, Size: 6298 bytes --]

;;; TEST:
;;; (yes-or-no-p "Agreed? ")
;;; (yes-or-no-p "Agreed? " 'help-mode-revert-buffer)
;;; (y-or-n-p "Agreed? " 'help-mode-revert-buffer)

(defun yes-or-no-p (prompt &optional caller)
  "Ask user a yes-or-no question.
Return t if answer is `yes', and nil if the answer is `no'.

If CALLER is non-nil then it is the symbol of a function that calls
`yes-or-no-p'.  In this case, the answer can also be `use-y-or-n-p',
meaning from now on use `y-or-n-p' instead of `yes-or-no-p' for
CALLER.  (In this case, `y-or-n-p' is called immediately.)

PROMPT is the string to display to ask the question.  It should end in
a space; `yes-or-no-p' adds \"(yes or no) \" to it.

The user must confirm the answer with `RET', and can edit the
input until using `RET'.

If dialog boxes are supported, a dialog box will be used
if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil."
  (if (and caller  (get caller 'use-y-or-n-p))
      (y-or-n-p prompt caller)
    (let* ((input   (intern (read-from-minibuffer (concat prompt "(yes or no) "))))
           (nogood  (not (memq input (if caller '(yes no use-y-or-n-p) '(yes no))))))
      (cond (nogood
             (message "Please answer `yes'%s"
                      (if caller ", `no', or `use-y-or-n-p'." " or `no'."))
             (sit-for 2.0)
             (yes-or-no-p prompt caller))
            ((eq input 'yes) t)
            ((eq input 'use-y-or-n-p)
             (message "`y-or-n-p' will be used here from now on.")
             (sit-for 2.0)
             (put caller 'use-y-or-n-p t)
             (y-or-n-p prompt caller))))))

(defun y-or-n-p (prompt &optional caller)
  "Ask user a \"y or n\" question.
Return t if answer is \"y\" and nil if it is \"n\".
PROMPT is the string to display to ask the question.  It should
end in a space; `y-or-n-p' adds \"(y or n) \" to it.

If CALLER is non-nil then it is the symbol of a function that calls
`y-or-n-p'.  In this case, the answer can also be \"e\", meaning from
now on use `yes-or-no-p' instead of`y-or-n-p', for CALLER.  (In this
case, `yes-or-no-p' is called immediately.)

No confirmation of the answer is requested; a single character is
enough.  SPC also means yes, and DEL means no.

To be precise, 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 `act', `skip', `recenter', `scroll-up', `scroll-down',
`quit', and `edit-replacement' (bound to \"e\").  An `act' response
means yes, and a `skip' response means no.  A `quit' response means to
invoke `keyboard-quit'.  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)
        (oprompt prompt)                ; @@@
        (padded (lambda (prompt &optional dialog)
                  (let ((l (length prompt)))
                    (concat prompt
                            (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
                                "" " ")
                            (if dialog "" "(y or n) "))))))
    (cond
      (noninteractive
       (setq prompt (funcall padded prompt))
       (let ((temp-prompt prompt))
         (while (not (memq answer '(act skip)))
           (let ((str (read-string temp-prompt)))
             (cond ((member str '("y" "Y")) (setq answer 'act))
                   ((member str '("n" "N")) (setq answer 'skip))
                   (t (setq temp-prompt (concat "Please answer y or n.  "
                                                prompt))))))))
      ((and (display-popup-menus-p)
            last-input-event            ; not during startup
            (listp last-nonmenu-event)
            use-dialog-box)
       (setq prompt (funcall padded prompt t)
             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 (or (memq answer scroll-actions)
                                                   (eq answer 'edit-replacement))
                                               prompt
                                             (concat "Please answer y or n.  " prompt))
                                           'face 'minibuffer-prompt)))))
             (unless (eq answer 'edit-replacement)
               (setq answer (lookup-key query-replace-map (vector key) t)))
             (cond
               ((and caller  (eq answer 'edit-replacement))
                (put caller 'use-y-or-n-p nil)
                (message "`yes-or-no-p' will be used here from now on.")
                (sit-for 2.0)
                (setq answer  'exit)
                (yes-or-no-p oprompt caller))
               ((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))))
    (let ((ret (eq answer 'act)))
      (unless noninteractive
        (message "%s%c" prompt (if ret ?y ?n)))
      ret)))