--- Begin Message ---
|
Subject: |
26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p |
|
Date: |
Wed, 20 Sep 2017 18:51:52 +0900 |
X-Debbugs-CC: address@hidden
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 <address@hidden>
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
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers |
|
Date: |
Sun, 21 Jan 2018 23:46:01 +0200 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (x86_64-pc-linux-gnu) |
>> Thanks for working on this.
>
> Here is a quite final patch I believe. At least, it works
> without noticed problems in my tests.
Done.
--- End Message ---