GNU bug report logs - #30073
27.0.50; dired-do-delete ignores customization for short answers

Previous Next

Full log

View this message in rfc822 format

From: Juri Linkov <juri <at> linkov.net>
To: Tino Calancha <tino.calancha <at> gmail.com>
Cc: contovob <at> tcd.ie, Eli Zaretskii <eliz <at> gnu.org>, 30073 <at> debbugs.gnu.org
Subject: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers
Date: Mon, 15 Jan 2018 00:53:45 +0200

>> Thanks for the idea.  Here is the first version of its implementation:
> Thank you for the patch.  I like it.

But I don't like it :-)

Neither (fset 'yes-or-no-p 'y-or-n-p) nor
(advice-add 'yes-or-no-p :override #'y-or-n-p)
are good methods of customization, so dired-deletion-confirmer
and dired-recursive-deletion-confirmer are equally bad.

What I'm thinking about is introducing a boolean customizable variable
that would define whether abbreviated answers are preferred by the user.
Then a new minibuffer-reading function could accept a list of abbreviations
and map them to long full answers.

Something like ‘read-multiple-choice’ or ‘map-y-or-n-p’, but that
would allow either long or short answers depending on customization
like ‘rmail-confirm-expunge’, ‘url-confirmation-func’,
‘org-confirm-shell-link-function’, ‘org-confirm-elisp-link-function’,
or on its argument like ‘strong-query’ in ‘custom-command-apply’.

WDYT?

diff --git a/lisp/dired.el b/lisp/dired.el
index b853d64..0ce24d0 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -3005,27 +3006,60 @@ dired-delete-help
 `quit' to exit,
 `help' 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? '.
-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")
+(defcustom read-answers-short nil
+  "If non-nil, accept short answers to the question."
+  :version "27.1"
+  :type 'boolean)
+
+(defun read-answers (prompt answers &optional help-msg short)
+  (let* ((short (or short read-answers-short))
+         (prompt (format "%s [%s] " prompt
+                         (mapconcat (lambda (a)
+                                      (if short (cadr a) (car a)))
+                                    answers ", ")))
+         (message (format "Please answer %s"
+                          (mapconcat (lambda (a)
+                                       (format "`%s'" (if short (cadr a) (car a))))
+                                     answers " or ")))
+         (short-answer-map (when short
+                             (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 message)
+                                   (sleep-for 2)))
+                               map)))
+         answer)
+    (while (not (assoc (setq answer
+                             (if short
+                                 (read-from-minibuffer
+                                  prompt nil short-answer-map)
+                               (read-string prompt)))
+                       answers))
+      (if (and (string= answer "help") (stringp help-msg))
+          (with-help-window "*Help*"
+            (with-current-buffer "*Help*"
+              (insert (if short
+                          (seq-reduce (lambda (msg a)
+                                        (replace-regexp-in-string
+                                         (format "`%s'" (car a))
+                                         (format "`%s'" (cadr a))
+                                         msg nil t))
+                                      answers help-msg)
+                        help-msg))))
         (beep)
-        (message "Please answer `yes' or `no' or `all' or `quit'")
-        (sleep-for 2))
-      (setq answer (funcall input-fn)))
+        (message message)
+        (sleep-for 2)))
     answer))
 
 ;; Delete file, possibly delete a directory and all its files.
@@ -3057,11 +3091,16 @@ dired-delete-file
 				    "trash"
 				  "delete")
 				(dired-make-relative file))))
-                   (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
+                   (pcase (read-answers prompt '(("yes" "y")
+                                                 ("no" "n")
+                                                 ("all" "!")
+                                                 ("quit" "q"))
+                                        dired-delete-help)
                      ('"all" (setq recursive 'always dired-recursive-deletes recursive))
                      ('"yes" (if (eq recursive 'top) (setq recursive 'always)))
                      ('"no" (setq recursive nil))
-                     ('"quit" (keyboard-quit)))))
+                     ('"quit" (keyboard-quit))
+                     (_ (keyboard-quit))))) ; catch all unknown answers
              (setq recursive nil)) ; Empty dir or recursive is nil.
            (delete-directory file recursive trash))))
 

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.