bug#28525: 26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p

[Tino Calancha]

Eli Zaretskii <eliz@gnu.org> writes:

>> dired-do-delete: Allow to delete dirs recursively without prompts
>> (cbea38e5c4af5386192fb9a48ef4fca5080d6561)
>> 
>> doesn't consider the case when an user has aliased 'yes-or-no-p'
>> to 'y-or-n-p'.  That's annoying if you are used to the previous
>> behaviour.
>
> People who make such aliases will have to change their aliases to
> support the 3rd option, right.  What function would they use for that?
> Does such a function exist?  If it doesn't exist, then what is the
> complaint wrt this change, exactly?
In my previous patch i checked if `yes-or-no-p' is aliased to
`y-or-n-p'.
A more general way is to add new functions `yes-or-no-or-else-p',
`y-or-n-or-else-p': they ask the question and
accept additional answers according with an optional argument.


Then we could rewrite the feature using `yes-or-no-or-else-p'.
Users might do:
(fset 'yes-or-no-or-else-p 'y-or-n-or-else-p)
so that they can answer just 'y' or 'n' as before, or even answer '!' to
accept all.

(yes-or-no-or-else-p "Do it? " '((! . automatic) (\? . help)))
(y-or-n-or-else-p "Do it? " '((! . automatic) (\? . help)))

The former accepts answers: yes, no, automatic, help
The latter accepts: y, n, !, ?

> We can be asked to do one of the following:
>
>   . continue supporting y-or-n-p as a defalias of yes-or-no-p, with
>     the understanding that the users who do that will not have a way
>     to use the new functionality; or
>   . allow users to specify a function that accepts single-key
>     responses, like y-or-n-p, but also allows to select the new
>     functionality, e.g., with '!'

> The solution in each of these cases is different.  So we should first
> decide which problem are we trying to solve.
I prefer the second option.  I guess it must be easy to write using 
`yes-or-no-or-else-p'.

--8<-----------------------------cut here---------------start------------->8---
commit 47164987830769282f690a3c3fd9ee36772d5d12
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Sat Sep 30 21:51:55 2017 +0900

    New functions: yes-or-no-or-else-p and y-or-n-or-else-p
    
    * src/fns.c (yes-or-no-else-p): New defun.
    (yes-or-no-p): Use it.
    * lisp/subr.el (y-or-n-or-else-p): Like y-or-n-p with
    more possible answers specified by arg OTHERS.
    (y-or-n-p): Use it.

diff --git a/lisp/subr.el b/lisp/subr.el
index cf15ec287f..6f3f5dabfd 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2484,73 +2484,65 @@ sit-for
 ;; Behind display-popup-menus-p test.
 (declare-function x-popup-dialog "menu.c" (position contents &optional header))
 
-(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\".
-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.
-
-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', and `quit'.
-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)
-       (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) "))))))
+(defun y-or-n-or-else-p (prompt &optional others)
+  "Ask user a \"y or n or ...\" question.
+OTHERS is a list (INPUT . ACTION), with INPUT the user
+input, and ACTION determines how to proceed; both are symbols.
+For instance, SYMBOL might be '!' and ACTION 'automatic'.
+
+This is like `y-or-n-p' with the additional answers in OTHERS."
+  (let* ((answer 'recenter)
+         (options (mapcar #'car others))
+         (options-str (mapconcat #'identity
+                             (append (list "y" "n")
+                                     (mapcar (lambda (x) (symbol-name (car 
x))) others)) " or "))
+         (actions (append '(skip act) (mapcar #'cdr others)))
+        (padded (lambda (prompt &optional dialog)
+                  (let ((l (length prompt)))
+                    (concat prompt
+                            (if (or (zerop l) (eq ?\s (aref prompt (1- l))))
+                                "" " ")
+                            (if dialog "" (concat "(" options-str ")")))))))
     (cond
      (noninteractive
       (setq prompt (funcall padded prompt))
       (let ((temp-prompt prompt))
-       (while (not (memq answer '(act skip)))
+       (while (not (memq answer actions))
          (let ((str (read-string temp-prompt)))
            (cond ((member str '("y" "Y")) (setq answer 'act))
+                  ((assoc (intern str) others) (setq answer (cdr (assoc 
(intern str) others))))
                  ((member str '("n" "N")) (setq answer 'skip))
-                 (t (setq temp-prompt (concat "Please answer y or n.  "
+                 (t (setq temp-prompt (concat "Please answer " options-str ". "
                                               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)))))
+           answer
+            (x-popup-dialog
+             t
+             `(,prompt ("Yes" . act) ("No" . skip)
+                       (mapcar (lambda (x) (cons (symbol-name (car x)) (cdr 
x))) others)))))
      (t
       (setq prompt (funcall padded prompt))
       (while
           (let* ((scroll-actions '(recenter scroll-up scroll-down
-                                  scroll-other-window 
scroll-other-window-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))
+                                            (concat "Please answer " 
options-str ". " 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)
+            ((memq answer actions) nil)
+            ((member (intern (char-to-string key)) options)
+              (setq answer (cdr (assoc (intern (char-to-string key)) others))) 
nil)
+            ((eq answer 'recenter) (recenter) t)
             ((eq answer 'scroll-up)
              (ignore-errors (scroll-up-command)) t)
             ((eq answer 'scroll-down)
@@ -2564,11 +2556,43 @@ y-or-n-p
             (t t)))
         (ding)
         (discard-input))))
-    (let ((ret (eq answer 'act)))
+    (let ((ret (cond ((eq answer 'act))
+                     ((eq answer 'skip) nil)
+                     ((memq answer actions) answer))))
       (unless noninteractive
-        (message "%s%c" prompt (if ret ?y ?n)))
+        (message "%s%c" prompt (cond ((eq ret t) ?y)
+                                     ((null ret) ?n)
+                                     ((memq ret actions)
+                                      (string-to-char (symbol-name (car 
(rassoc ret others))))))))
       ret)))
 
+(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\".
+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.
+
+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', and `quit'.
+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.
+  (y-or-n-or-else-p prompt))
+

 ;;; Atomic change groups.
 
diff --git a/src/fns.c b/src/fns.c
index 4524ff9b26..5eee5d380f 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -2582,20 +2582,27 @@ do_yes_or_no_p (Lisp_Object prompt)
   return call1 (intern ("yes-or-no-p"), prompt);
 }
 
-DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
-       doc: /* Ask user a yes-or-no question.
-Return t if answer is yes, and nil if the answer is no.
+DEFUN ("yes-or-no-or-else-p", Fyes_or_no_or_else_p, Syes_or_no_or_else_p, 1, 
2, 0,
+       doc: /* Ask user a yes or no or ... question.
+OTHERS is a list (INPUT . ACTION), with INPUT the user
+input, and ACTION determines how to proceed; both are symbols.
+For instance, SYMBOL might be '!' and ACTION 'automatic'.
+
+Return t if answer is yes, nil if the answer is no or ACTION if the answer
+is ACTION.
 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.
+a space; `yes-or-no-or-else-p' adds \"(yes or no or ACTION1 or ACTION2 ...) \" 
to it.
 
 The user must confirm the answer with RET, and can edit it until it
 has been confirmed.
 
 If dialog boxes are supported, a dialog box will be used
-if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.  */)
-  (Lisp_Object prompt)
+if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.
+
+This function is like `yes-or-no-p' with the additional answers in OTHERS.  */)
+  (Lisp_Object prompt, Lisp_Object others)
 {
-  Lisp_Object ans;
+  Lisp_Object ans, yes_or_no, actions, str;
 
   CHECK_STRING (prompt);
 
@@ -2611,9 +2618,21 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is 
non-nil.  */)
       return obj;
     }
 
-  AUTO_STRING (yes_or_no, "(yes or no) ");
-  prompt = CALLN (Fconcat, prompt, yes_or_no);
-
+  if (!NILP (others)) {
+    actions = Fmapcar (intern ("symbol-name"), Fmapcar (Qcdr, others));
+    yes_or_no = Fmapconcat (Qidentity,
+                            CALLN (Fappend, list2 (build_string ("yes"),
+                                                   build_string ("no")),
+                                   actions),
+                            build_string (" or "));
+    yes_or_no = CALLN (Fconcat, build_string ("("), yes_or_no, build_string 
(")"));
+  }
+  else {
+        actions = Qnil;
+        yes_or_no = build_string ("(yes or no)");
+  }
+  prompt = CALLN (Fconcat, prompt, yes_or_no, build_string (" "));
+  str = CALLN (Fconcat, build_string ("Please answer "), yes_or_no, 
build_string ("."));
   while (1)
     {
       ans = Fdowncase (Fread_from_minibuffer (prompt, Qnil, Qnil, Qnil,
@@ -2623,13 +2642,31 @@ if `last-nonmenu-event' is nil, and `use-dialog-box' is 
non-nil.  */)
        return Qt;
       if (SCHARS (ans) == 2 && !strcmp (SSDATA (ans), "no"))
        return Qnil;
+      if (!NILP (Fmember (ans, actions)))
+        return Fcdr (Frassoc (intern (SSDATA (ans)), others));
 
       Fding (Qnil);
       Fdiscard_input ();
-      message1 ("Please answer yes or no.");
+      message1 (SSDATA (str));
       Fsleep_for (make_number (2), Qnil);
     }
 }
+
+DEFUN ("yes-or-no-p", Fyes_or_no_p, Syes_or_no_p, 1, 1, 0,
+       doc: /* Ask user a yes-or-no question.
+Return t if answer is yes, and nil if the answer is no.
+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 it until it
+has been confirmed.
+
+If dialog boxes are supported, a dialog box will be used
+if `last-nonmenu-event' is nil, and `use-dialog-box' is non-nil.  */)
+  (Lisp_Object prompt)
+{
+  return Fyes_or_no_or_else_p (prompt, Qnil);
+}

 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
        doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.
@@ -5273,6 +5310,7 @@ this variable.  */);
   defsubr (&Smapcan);
   defsubr (&Smapconcat);
   defsubr (&Syes_or_no_p);
+  defsubr (&Syes_or_no_or_else_p);
   defsubr (&Sload_average);
   defsubr (&Sfeaturep);
   defsubr (&Srequire);

--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-09-29
Repository revision: 20a09de953f437109a098fa8c4d380663d921481