bug#30073: 27.0.50; dired-do-delete ignores customization for short answers

[Juri Linkov]

>> What is worse, it doesn't work at all - setting dired-deletion-confirmer
>> to y-or-n-p has no effect on the question “Recursively delete ...? ”.
>> It still expects “[yes, no, all, quit, help]” answers, not short ones
>> like “y/n/!/q/?”.
>
> If you want to use y-or-n-p there, you will have to replace
> dired--yes-no-all-quit-help with your own function.

Thanks for the idea.  Here is the first version of its implementation:

diff --git a/lisp/dired.el b/lisp/dired.el
index b853d64..e6a7eeb 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2997,6 +2998,8 @@ dired-recursive-deletes
 ;; Match anything but `.' and `..'.
 (defvar dired-re-no-dot "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")
 
+(defvar dired-recursive-deletion-confirmer 'dired--yes-no-all-quit-help) ;; or 
'dired--y-n-!-q-?
+
 (defconst dired-delete-help
   "Type:
 `yes' to delete recursively the current directory,
@@ -3005,6 +3008,14 @@ dired-delete-help
 `quit' to exit,
 `help' to show this help message.")
 
+(defconst dired-delete-help-short
+  "Type:
+`y' to delete recursively the current directory,
+`n' to skip to next,
+`!' to delete all remaining directories with no more questions,
+`q' to exit,
+`?' to show this help message.")
+
 (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? '.
@@ -3028,6 +3039,56 @@ dired--yes-no-all-quit-help
       (setq answer (funcall input-fn)))
     answer))
 
+(defvar read-short-answers
+  '(("y" "yes")
+    ("n" "no")
+    ("!" "all")
+    ("q" "quit")
+    ("?" "help")))
+
+(defvar read-short-answer-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-map)
+    (dolist (answer read-short-answers)
+      (define-key map (car answer)
+        (lambda ()
+          (interactive)
+          (delete-minibuffer-contents)
+          (insert (cadr answer))
+          (exit-minibuffer))))
+    (define-key map [remap self-insert-command]
+      (lambda ()
+        (interactive)
+        (delete-minibuffer-contents)
+        (beep)
+        (message "Please answer `y' or `n' or `!' or `q'")
+        (sleep-for 2)))
+    map)
+  "Keymap used for non-blocking reading of short one-character answers.")
+
+(defun dired--y-n-!-q-? (prompt &optional help-msg)
+  "Ask a question with valid answers: y, n, !, q, ?.
+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 '?'.  Otherwise, default to `dired-delete-help-short'."
+  (let ((valid-answers (list "yes" "no" "all" "quit"))
+        (answer "")
+        (input-fn (lambda ()
+                    (read-from-minibuffer
+                     (format "%s [y, n, !, q, ?] " prompt) nil 
read-short-answer-map))))
+    (setq answer (funcall input-fn))
+    (when (string= answer "help")
+      (with-help-window "*Help*"
+        (with-current-buffer "*Help*"
+          (insert (or help-msg dired-delete-help-short)))))
+    (while (not (member answer valid-answers))
+      (unless (string= answer "help")
+        (beep)
+        (message "Please answer `y' or `n' or `!' or `q'")
+        (sleep-for 2))
+      (setq answer (funcall input-fn)))
+    answer))
+
 ;; Delete file, possibly delete a directory and all its files.
 ;; This function is useful outside of dired.  One could change its name
 ;; to e.g. recursive-delete-file and put it somewhere else.
@@ -3057,7 +3118,7 @@ dired-delete-file
                                    "trash"
                                  "delete")
                                (dired-make-relative file))))
-                   (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
+                   (pcase (apply dired-recursive-deletion-confirmer (list 
prompt)) ; Prompt user.
                      ('"all" (setq recursive 'always dired-recursive-deletes 
recursive))
                      ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
                      ('"no" (setq recursive nil))
                      ('"no" (setq recursive nil))



PS: and here is not a patch, but a diff that shows the difference
between two functions to help to combine them into one later:

@@ -1,22 +1,22 @@
-(defun dired--yes-no-all-quit-help (prompt &optional help-msg)
-  "Ask a question with valid answers: yes, no, all, quit, help.
+(defun dired--y-n-!-q-? (prompt &optional help-msg)
+  "Ask a question with valid answers: y, n, !, q, ?.
 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'."
+the user answers '?'.  Otherwise, default to `dired-delete-help-short'."
   (let ((valid-answers (list "yes" "no" "all" "quit"))
         (answer "")
         (input-fn (lambda ()
-                    (read-string
-                     (format "%s [yes, no, all, quit, help] " prompt)))))
+                    (read-from-minibuffer
+                     (format "%s [y, n, !, q, ?] " prompt) nil 
read-short-answer-map))))
     (setq answer (funcall input-fn))
     (when (string= answer "help")
       (with-help-window "*Help*"
         (with-current-buffer "*Help*"
-          (insert (or help-msg dired-delete-help)))))
+          (insert (or help-msg dired-delete-help-short)))))
     (while (not (member answer valid-answers))
       (unless (string= answer "help")
         (beep)
-        (message "Please answer `yes' or `no' or `all' or `quit'")
+        (message "Please answer `y' or `n' or `!' or `q'")
         (sleep-for 2))
       (setq answer (funcall input-fn)))
     answer))