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

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]

X-Debbugs-CC: npostavs@users.sourceforge.net
Tags: patch

The following commit

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.  I do.
Recently, I had a private communication with an user whom
complained about this recent change.

Not sure about the ideal fix.  The following patch work
around the issue adding a new function
'dired-y-or-n-or-a-p', which is called when yes-or-no-p is aliased to
y-or-n-p.  This function is y-or-n-p with an additional
possible answer '!' (aka, automatic), as in query-replace.

--8<-----------------------------cut here---------------start------------->8---
commit d764d51c311a8bf6517f558bbdd5f11dff41a0ba
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Wed Sep 20 18:28:52 2017 +0900

    dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p
    
    Some users like to redefine yes-or-no-p as an alias of
    y-or-n-p.  For backward compatibility 'dired-delete-file' must
    behave as usual in that case.
    * lisp/dired.el (defun dired-y-or-n-or-a-p): New defun.
    (dired--yes-no-all-quit-help): If yes-or-no-p is fset to y-or-n-p
    then call defun dired-y-or-n-or-a-p.
    (dired-delete-file): Update the pcase: it must handle
    3 inputs (symbols): 'automatic, t or nil.
    (dired-delete-help): Delete variable.
    * test/lisp/dired-tests.el (dired-test-bug27940): Update test.

diff --git a/lisp/dired.el b/lisp/dired.el
index 782d8ffa51..80c2b9055f 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2994,36 +2994,110 @@ dired-recursive-deletes
 ;; Match anything but `.' and `..'.
 (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
 
-(defconst dired-delete-help
-  "Type:
-`yes' to delete recursively the current directory,
-`no' to skip to next,
-`all' to delete all remaining directories with no more questions,
-`quit' to exit,
-`help' to show this help message.")
+(defun dired-y-or-n-or-a-p (prompt)
+  "Ask user a \"y or n or a\" question.
+This is like `y-or-n-p' with an additional answer '!' to
+proceed automatically with no mre questions."
+  (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 or !) "))))))
+    (cond
+     (noninteractive
+      (setq prompt (funcall padded prompt))
+      (let ((temp-prompt prompt))
+	(while (not (memq answer '(act skip automatic)))
+	  (let ((str (read-string temp-prompt)))
+	    (cond ((member str '("y" "Y")) (setq answer 'act))
+                  ((member str '("!")) (setq answer 'automatic))
+		  ((member str '("n" "N")) (setq answer 'skip))
+		  (t (setq temp-prompt (concat "Please answer y or n or !.  "
+					       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) ("!" . automatic)))))
+     (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 or !.  "
+                                                    prompt))
+                                          'face 'minibuffer-prompt)))))
+            (setq answer (lookup-key query-replace-map (vector key) t))
+            (cond
+	     ((memq answer '(skip act automatic)) 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 (cond ((eq answer 'act))
+                     (t (and (eq answer 'automatic) 'automatic)))))
+      (unless noninteractive
+        (message "%s%c" prompt (cond ((eq ret 'automatic) ?!) (t (if ret ?y ?n)))))
+      ret)))
 
 (defun dired--yes-no-all-quit-help (prompt &optional help-msg)
   "Ask a question with valid answers: yes, no, all, quit, help.
 PROMPT must end with '? ', for instance, 'Delete it? '.
 If optional arg HELP-MSG is non-nil, then is a message to show when
 the user answers 'help'.  Otherwise, default to `dired-delete-help'."
-  (let ((valid-answers (list "yes" "no" "all" "quit"))
-        (answer "")
-        (input-fn (lambda ()
-                    (read-string
-	             (format "%s [yes, no, all, quit, help] " prompt)))))
-    (setq answer (funcall input-fn))
-    (when (string= answer "help")
-      (with-help-window "*Help*"
-        (with-current-buffer "*Help*"
-          (insert (or help-msg dired-delete-help)))))
-    (while (not (member answer valid-answers))
-      (unless (string= answer "help")
-        (beep)
-        (message "Please answer `yes' or `no' or `all' or `quit'")
-        (sleep-for 2))
-      (setq answer (funcall input-fn)))
-    answer))
+  ;; Some people redefine 'yes-or-no-p as 'y-or-n-p; for backward
+  ;; compatibility we must check if that is the case.
+  (if (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
+      (dired-y-or-n-or-a-p prompt)
+    (let* ((valid-answers (list 'act 'skip 'automatic))
+           (input-fn (lambda ()
+                       (let ((str
+                              (read-string
+	                       (format "%s [yes, no, automatic, help] " prompt))))
+                         (cond ((string-match "\\`yes\\'" str) 'act)
+                               ((string-match "\\`no\\'" str) 'skip)
+                               ((string-match "\\`automatic\\'" str) 'automatic)
+                               ((string-match "\\`help\\'" str) 'help)))))
+           (dired-delete-help
+            (format "Type:
+`%s' to delete recursively the current directory,
+`%s' to skip to next,
+`%s' to delete automatic remaining directories with no more questions,
+`%s' to show this help message."
+                    "yes" "no" "automatic" "help")))
+      (let ((answer (funcall input-fn)))
+        (when (eq answer 'help)
+          (with-help-window "*Help*"
+            (with-current-buffer "*Help*"
+              (insert (or help-msg dired-delete-help)))))
+        (while (not (member answer valid-answers))
+          (unless (eq answer 'help)
+            (beep)
+            (message "Please answer `yes' or `no' or `automatic'")
+            (sleep-for 2))
+          (setq answer (funcall input-fn)))
+        (cond ((eq answer 'act))
+              (t (and (eq answer 'automatic) 'automatic)))))))
 
 ;; Delete file, possibly delete a directory and all its files.
 ;; This function is useful outside of dired.  One could change its name
@@ -3055,10 +3129,9 @@ dired-delete-file
 				  "delete")
 				(dired-make-relative file))))
                    (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
-                     ('"all" (setq recursive 'always dired-recursive-deletes recursive))
-                     ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
-                     ('"no" (setq recursive nil))
-                     ('"quit" (keyboard-quit)))))
+                     ('automatic (setq recursive 'always dired-recursive-deletes recursive))
+                     ('t (if (eq recursive 'top) (setq recursive 'always)))
+                     ('nil (setq recursive nil)))))
              (setq recursive nil)) ; Empty dir or recursive is nil.
            (delete-directory file recursive trash))))
 
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 99006eca3e..fb9988ee06 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -399,7 +399,7 @@ dired-test-with-temp-dirs
   ;; Answer yes
   (dired-test-with-temp-dirs
    nil
-   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes")
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) t)
                '((name . dired-test-bug27940-advice)))
    (dired default-directory)
    (dired-toggle-marks)
@@ -410,7 +410,7 @@ dired-test-with-temp-dirs
   ;; Answer no
   (dired-test-with-temp-dirs
    nil
-   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no")
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) nil)
                '((name . dired-test-bug27940-advice)))
    (dired default-directory)
    (dired-toggle-marks)
@@ -418,10 +418,10 @@ dired-test-with-temp-dirs
    (unwind-protect
        (should (= 5 (length (dired-get-marked-files)))) ; Just the empty dirs deleted.
      (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
-  ;; Answer all
+  ;; Answer automatic
   (dired-test-with-temp-dirs
    nil
-   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all")
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) 'automatic)
                '((name . dired-test-bug27940-advice)))
    (dired default-directory)
    (dired-toggle-marks)
@@ -432,7 +432,7 @@ dired-test-with-temp-dirs
   ;; Answer quit
   (dired-test-with-temp-dirs
    nil
-   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit")
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) (signal 'quit nil))
                '((name . dired-test-bug27940-advice)))
    (dired default-directory)
    (dired-toggle-marks)
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 10, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
 of 2017-09-20 built on calancha-pc
Repository revision: b1f83c10df7d1bbb16f4e13d18119ad4aa1a2137

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

[Eli Zaretskii]

> From: Tino Calancha <tino.calancha@gmail.com>
> Date: Wed, 20 Sep 2017 18:51:52 +0900
> Cc: npostavs@users.sourceforge.net
> 
> The following commit
> 
> 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.  I do.
> Recently, I had a private communication with an user whom
> complained about this recent change.
> 
> Not sure about the ideal fix.  The following patch work
> around the issue adding a new function
> 'dired-y-or-n-or-a-p', which is called when yes-or-no-p is aliased to
> y-or-n-p.  This function is y-or-n-p with an additional
> possible answer '!' (aka, automatic), as in query-replace.

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?

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.

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))
+
 \f
 ;;; 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);
+}
 \f
 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

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]

Tino Calancha <tino.calancha@gmail.com> writes:

> 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.
Indeed, we don't need new functions just add an optional argument makes
the thing (see below patch).
In some cases it might be useful to allow more answers than just 'yes'
or 'no'.

(yes-or-no-p "Do it? ") ; Accepts 'yes' or 'no'

(yes-or-no-p "Do it? " '((l . later) (m . maybe)))
;; Also accepts 'later' and 'maybe'.

(y-or-n-p "Do it? " '((l . later) (m . maybe)))
;; Accepts: 'y', 'n', 'l' and 'm'.

This has the advantage that is backward compatible for users doing:
(fset 'yes-or-no-p 'y-or-n-p)

Then, these users can use the new feature answering '!', if
we write something like:
(yes-or-no-p "Recursively delete dir? " '((! . all) (q . quit) (h . help)))

--8<-----------------------------cut here---------------start------------->8---
commit 17b1d3715b3d07c487b5b9cc757fc2ce5e0a89a9
Author: Tino Calancha <tino.calancha@gmail.com>
Date:   Sun Oct 1 12:44:41 2017 +0900

    Accept more answers in yes-or-no-or-else-p and y-or-n-or-else-p
    
    * src/fns.c (yes-or-no-p)
    * lisp/subr.el (y-or-n-or-p):
    Add optional argument OTHERS.

diff --git a/lisp/subr.el b/lisp/subr.el
index cf15ec287f..1b11e84dd0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -2484,8 +2484,13 @@ 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.
+(defun y-or-n-p (prompt &optional others)
+  "Ask user a \"y or n r ...\" 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 \"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.
@@ -2509,48 +2514,58 @@ y-or-n-p
   ;; ¡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) "))))))
+  (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,9 +2579,14 @@ 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)))
 
 \f
diff --git a/src/fns.c b/src/fns.c
index 4524ff9b26..a9e1a864cd 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-p", Fyes_or_no_p, Syes_or_no_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,16 @@ 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);
     }
 }
+
 \f
 DEFUN ("load-average", Fload_average, Sload_average, 0, 1, 0,
        doc: /* Return list of 1 minute, 5 minute and 15 minute load averages.

--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-30
 Repository revision: 20a09de953f437109a098fa8c4d380663d921481

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

[Drew Adams]

FWIW: I don't think that Emacs should test for
function aliases and change its behavior accordingly.

I don't think users should be encouraged to alias
`yes-or-no-p' to `y-or-n-p'.  That's a bad idea
_in general_, IMO, even if it some users might
find it's appropriate for them.

I think that making Emacs code automatically
recognize such an alias just encourages such
(bad) practice on the part of users.

----

FWIW2: It can, however, be helpful to let users
override a design choice of `y-or-n-p' or
`yes-or-no-p' _for a given calling function_
(as opposed to globally).  I've written library
Yes-No, to provide such a feature.

https://www.emacswiki.org/emacs/Yes-No

`yes-no.el' provides no behavior change, except for
code that wants to let users decide.  For that, the
author just provides the symbol for the calling
function as an additional argument to the prompting
function.

For example, the behavior of this call from function
`foo' is unchanged: (yes-or-no-p "Agree? ").

But this call from function `foo' lets users decide:
(yes-or-no-p "Agree? " 'foo).

In the latter case, a user can answer `yes', `no',
or `use-y-or-n' (which is available with completion).
If the latter then the call immediately switches to
using `y-or-n-p', and all `yes-or-no-p' calls from
function `foo' from then on are redirected to use
`y-or-n-p' instead.

Similarly, this call from `bar' lets users decide:
(y-or-n-p "Agree? " 'bar).

Here, a user can answer using character `y', `n',
or `e'.  Answer `e' switches immediately to using
`yes-or-no-p', and all `y-or-n-p' calls from
function `bar' from then on are redirected to
`yes-or-no-p'.

When either redirection is in effect, a user can
of course redirect back again, to the original
behavior (programmer-defined).

And when either redirection is in effect, a user
can reset the call to use only the default behavior
from then on.

To reset a `yes-or-no-p' prompt (redirected from
`y-or-n-p') a user chooses input `reset-to-default'
(with completion).  To reset a `y-or-n-p' prompt
(redirected from `yes-or-no-p') a user uses character
`^'.

A user option lets a user turn off respect of the
optional CALLER arg.  If nil then there is no change
in behavior from vanilla Emacs: no other inputs are
allowed besides yes/no or y/n.  So even if a library
author provides CALLER, to let users decide on a
case-by-case basis, a user can choose not to allow
herself to do so.

(Obviously, a library that uses argument CALLER
must require library `yes-no.el'.)

The behavior is implemented by putting the symbol
for the prompting function to redirect to on the
symbol for the calling function, as the value of
property `yes/no-prompting'.  For example, if a
user chooses `use-y-or-n' from `yes-or-no-p'
called from `foo', we do this to redirect such
calls to prompt with `y-or-n-p':

(put 'foo 'yes/no-prompting 'y-or-n-p)

Resetting to the default behavior just puts
nil as the property value.

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]

On Sun, 1 Oct 2017, Drew Adams wrote:

> FWIW: I don't think that Emacs should test for
> function aliases and change its behavior accordingly.
>
> I don't think users should be encouraged to alias
> `yes-or-no-p' to `y-or-n-p'.  That's a bad idea
> _in general_, IMO, even if it some users might
> find it's appropriate for them.
>
> I think that making Emacs code automatically
> recognize such an alias just encourages such
> (bad) practice on the part of users.
>
> ----
>
> FWIW2: It can, however, be helpful to let users
> override a design choice of `y-or-n-p' or
> `yes-or-no-p' _for a given calling function_
> (as opposed to globally).  I've written library
> Yes-No, to provide such a feature.
>
> https://www.emacswiki.org/emacs/Yes-No

Thank you for the detailed answer.

Your library looks a good solution to add more control
where to allow aliasing 'yes-or-no-p to 'y-or-n-p.

Here, what i am trying to propose is different: extend the
'yes or no' functions (or add two new functions),
so that they accept more than 2 answers.
This is inpired in the way `query-replace' works:

M-% a RET o RET
This prompts to replace 'a' with 'o'.  In principle this
looks like a 'yes or no' question; actually  we can
provide additional answers: all possibilities are listed
if the user inputs 'h'.  For example, '!' performs all replacements
without further questions.

We find something similar in dired-delete-file: in addition
to 'yes', 'no', we can answer to delete all the dirs with
no more questions.

A function like 'yes-or-no-p' accepting more than 2 answers
might be used to handle the examples above, and future cases.

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

[Drew Adams]

> Here, what i am trying to propose is different: extend the
> 'yes or no' functions (or add two new functions),
> so that they accept more than 2 answers.

I see.  In that case, at least the bug Subject line (title)
seems wrong, no?

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

[Eli Zaretskii]

> From: Tino Calancha <tino.calancha@gmail.com>
> Cc: 28525@debbugs.gnu.org,  npostavs@users.sourceforge.net
> Date: Sun, 01 Oct 2017 13:06:32 +0900
> 
> Tino Calancha <tino.calancha@gmail.com> writes:
> 
> > 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.
> Indeed, we don't need new functions just add an optional argument makes
> the thing (see below patch).
> In some cases it might be useful to allow more answers than just 'yes'
> or 'no'.

On second thought, maybe we should simply ignore this issue, and let
users who want to override these functions write their own variants
for them?  Especially since packages do exist out there to do
something like that already.  We don't need to solve every single
problem with exotic customizations in the core.

WDYT?

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]

On Mon, 2 Oct 2017, Eli Zaretskii wrote:

>>> 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.
>> Indeed, we don't need new functions just add an optional argument makes
>> the thing (see below patch).
>> In some cases it might be useful to allow more answers than just 'yes'
>> or 'no'.
>
> On second thought, maybe we should simply ignore this issue, and let
> users who want to override these functions write their own variants
> for them?  Especially since packages do exist out there to do
> something like that already.  We don't need to solve every single
> problem with exotic customizations in the core.
Thank you for the comment.  That's also a sensible suggestion.

Even if we ignore this issue, the existance of a `questionp'
which ask a question and allow more than 2 answers
(and returns a symbol, easy to check in a `cond' block) might be
a useful addition; this is quite general and avoid the need to use
`read-string' in cases where the programmer prefers a symbol.

If we provide the possible answers as an argument, like
in my previous patch, it looks quite explicit.

Following the analogy with `yes-or-no-p', `y-or-n-p'
it might be a couple of functions so that fset lovers can do:
(fset 'questionp 'question-mini-p)

So that they can answer just with one key and without RET.

Just an idea in mind.  Sorry if it's a bad one.

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]

On Mon, 2 Oct 2017, Drew Adams wrote:

>> Here, what i am trying to propose is different: extend the
>> 'yes or no' functions (or add two new functions),
>> so that they accept more than 2 answers.
>
> I see.  In that case, at least the bug Subject line (title)
> seems wrong, no?
Of course.  Sorry, my bug reports sometimes are under development.

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

[Michael Heerdegen]

Tino Calancha <tino.calancha@gmail.com> writes:

> Even if we ignore this issue, the existance of a `questionp'
> which ask a question and allow more than 2 answers
> (and returns a symbol, easy to check in a `cond' block) might be
> a useful addition; this is quite general and avoid the need to use
> `read-string' in cases where the programmer prefers a symbol.

FWIW there is already something very similar in subr-x:
`read-multiple-choice'.  That one is controlled with keys, however.


Michael.