[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#30073: 27.0.50; dired-do-delete ignores customization for short answ
From: |
Juri Linkov |
Subject: |
bug#30073: 27.0.50; dired-do-delete ignores customization for short answers |
Date: |
Thu, 18 Jan 2018 00:56:57 +0200 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (x86_64-pc-linux-gnu) |
>> Regarding a new multiple options reading function ‘read-answer’, I'm
>> not sure where to put it.
>
> How many callers does it have now, and which callers are those?
Currently it will have just one caller in ‘dired-delete-file’,
but it's possible to gradually replace all callers that are using
‘yes-or-no-p’ and ‘y-or-n-p’ with equivalent calls of ‘read-answer’
with the argument
'(("yes" ?y)
("no" ?n))
that will accept either long or short answer depending on the new
customizable variable.
In this patch I placed new code to map-ynp.el because in loadup.el
"emacs-lisp/map-ynp" is loaded immediately after loading "custom",
so map-ynp.el is the first file that allows using defcustom.
Most importantly, a new function is logically related to map-y-or-n-p,
and grouping related functions in one file is much better than polluting
file namespace with separate files such as map-ynp.el, rmc.el, crm.el...
diff --git a/lisp/emacs-lisp/map-ynp.el b/lisp/emacs-lisp/map-ynp.el
index 2a7edde..85ed9e0 100644
--- a/lisp/emacs-lisp/map-ynp.el
+++ b/lisp/emacs-lisp/map-ynp.el
@@ -256,4 +256,86 @@ map-y-or-n-p
;; Return the number of actions that were taken.
actions))
+
+;; For backward compatibility check if short y/n answers are preferred.
+(defcustom read-answer-short (eq (symbol-function 'yes-or-no-p) 'y-or-n-p)
+ "If non-nil, accept short answers to the question."
+ :type 'boolean
+ :version "27.1"
+ :group 'minibuffer)
+
+(defun read-answer (question answers)
+ "Read an answer either as a complete word or its character abbreviation.
+Ask QUESTION and accept an answer from the list of possible ANSWERS.
+This list contains lists in the following format:
+ (LONG-ANSWER SHORT-ANSWER HELP-MESSAGE)
+where
+ LONG-ANSWER is a complete answer,
+ SHORT-ANSWER is an abbreviated one-letter answer,
+ HELP-MESSAGE is a string describing the meaning of the answer.
+
+Example:
+ '((\"yes\" ?y \"perform the action\")
+ (\"no\" ?n \"skip to the next\")
+ (\"all\" ?! \"accept all remaining without more questions\")
+ (\"quit\" ?q \"exit\"))
+
+When `read-answer-short' is non-nil, accept short answers.
+
+Return a long answer even in case of accepting short ones."
+ (custom-reevaluate-setting 'read-answer-short)
+ (let* ((short read-answer-short)
+ (answers-with-help (append answers '(("help" ?? "show this help
message"))))
+ (prompt (format "%s(%s) " question
+ (mapconcat (lambda (a)
+ (if short (format "%c=%s" (nth 1 a) (nth
0 a)) (nth 0 a)))
+ answers-with-help ", ")))
+ (message (format "Please answer %s."
+ (mapconcat (lambda (a)
+ (format "`%s'" (if short (string (nth 1
a)) (nth 0 a))))
+ answers-with-help " or ")))
+ (short-answer-map (when short
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (dolist (answer answers-with-help)
+ (define-key map (vector (nth 1 answer))
+ (lambda ()
+ (interactive)
+ (delete-minibuffer-contents)
+ (insert (nth 0 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 (cond (short
+ (read-from-minibuffer
+ prompt nil short-answer-map))
+ (t
+ (read-from-minibuffer
+ prompt nil nil nil
+ 'yes-or-no-p-history))))
+ answers))
+ (if (string= answer "help")
+ (with-help-window "*Help*"
+ (with-current-buffer "*Help*"
+ (insert "Type:\n"
+ (mapconcat (lambda (a)
+ (format "`%s' to %s"
+ (if short
+ (format "%c (%s)" (nth 1 a)
(nth 0 a))
+ (nth 0 a))
+ (nth 2 a)))
+ answers-with-help ",\n")
+ ".\n")))
+ (beep)
+ (message message)
+ (sleep-for 2)))
+ answer))
+
;;; map-ynp.el ends here
diff --git a/lisp/dired.el b/lisp/dired.el
index b853d64..9a412d0 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2997,37 +2998,6 @@ 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--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))
-
;; 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,11 +3027,17 @@ dired-delete-file
"trash"
"delete")
(dired-make-relative file))))
- (pcase (dired--yes-no-all-quit-help prompt) ; Prompt user.
+ (pcase (read-answer
+ prompt
+ '(("yes" ?y "delete recursively the current
directory")
+ ("no" ?n "skip to next")
+ ("all" ?! "delete all remaining directories with
no more questions")
+ ("quit" ?q "exit")))
('"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))))
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index c024213..bb0e1bc 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -384,9 +384,9 @@ dired-test-with-temp-dirs
(dired-test-with-temp-dirs
'just-empty-dirs
(let (asked)
- (advice-add 'dired--yes-no-all-quit-help
+ (advice-add 'read-answer
:override
- (lambda (_) (setq asked t) "")
+ (lambda (_q _a) (setq asked t) "")
'((name . dired-test-bug27940-advice)))
(dired default-directory)
(dired-toggle-marks)
@@ -395,44 +395,44 @@ dired-test-with-temp-dirs
(progn
(should-not asked)
(should-not (dired-get-marked-files))) ; All dirs deleted.
- (advice-remove 'dired--yes-no-all-quit-help
'dired-test-bug27940-advice))))
+ (advice-remove 'read-answer 'dired-test-bug27940-advice))))
;; Answer yes
(dired-test-with-temp-dirs
nil
- (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes")
+ (advice-add 'read-answer :override (lambda (_q _a) "yes")
'((name . dired-test-bug27940-advice)))
(dired default-directory)
(dired-toggle-marks)
(dired-do-delete nil)
(unwind-protect
(should-not (dired-get-marked-files)) ; All dirs deleted.
- (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+ (advice-remove 'read-answer 'dired-test-bug27940-advice)))
;; Answer no
(dired-test-with-temp-dirs
nil
- (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no")
+ (advice-add 'read-answer :override (lambda (_q _a) "no")
'((name . dired-test-bug27940-advice)))
(dired default-directory)
(dired-toggle-marks)
(dired-do-delete nil)
(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)))
+ (advice-remove 'read-answer 'dired-test-bug27940-advice)))
;; Answer all
(dired-test-with-temp-dirs
nil
- (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all")
+ (advice-add 'read-answer :override (lambda (_q _a) "all")
'((name . dired-test-bug27940-advice)))
(dired default-directory)
(dired-toggle-marks)
(dired-do-delete nil)
(unwind-protect
(should-not (dired-get-marked-files)) ; All dirs deleted.
- (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+ (advice-remove 'read-answer 'dired-test-bug27940-advice)))
;; Answer quit
(dired-test-with-temp-dirs
nil
- (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit")
+ (advice-add 'read-answer :override (lambda (_q _a) "quit")
'((name . dired-test-bug27940-advice)))
(dired default-directory)
(dired-toggle-marks)
@@ -440,7 +440,7 @@ dired-test-with-temp-dirs
(dired-do-delete nil))
(unwind-protect
(should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but
zeta-empty-dir deleted.
- (advice-remove 'dired--yes-no-all-quit-help
'dired-test-bug27940-advice))))
+ (advice-remove 'read-answer 'dired-test-bug27940-advice))))
(provide 'dired-tests)
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, (continued)
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Basil L. Contovounesios, 2018/01/11
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/11
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/11
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Eli Zaretskii, 2018/01/12
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/13
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Tino Calancha, 2018/01/14
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/14
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Eli Zaretskii, 2018/01/15
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/15
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Eli Zaretskii, 2018/01/16
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers,
Juri Linkov <=
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/18
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Drew Adams, 2018/01/15
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/15
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Drew Adams, 2018/01/15
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/17
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Eli Zaretskii, 2018/01/17
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/18
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/21
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Drew Adams, 2018/01/25
- bug#30073: 27.0.50; dired-do-delete ignores customization for short answers, Juri Linkov, 2018/01/25