Package: emacs;
Reported by: Juri Linkov <juri <at> linkov.net>
Date: Wed, 10 Jan 2018 21:45:02 UTC
Severity: normal
Tags: patch
Merged with 28525
Found in versions 26.0.60, 27.0.50
Done: Juri Linkov <juri <at> linkov.net>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: help-debbugs <at> gnu.org (GNU bug Tracking System) To: Tino Calancha <tino.calancha <at> gmail.com> Subject: bug#28525: closed (Re: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers) Date: Sun, 21 Jan 2018 21:48:03 +0000
[Message part 1 (text/plain, inline)]
Your bug report #30073: 26.0.60; dired-delete-file: Accept y/n if yes-or-no-p is aliased to y-or-n-p which was filed against the emacs package, has been closed. The explanation is attached below, along with your original report. If you require more details, please reply to 28525 <at> debbugs.gnu.org. -- 30073: http://debbugs.gnu.org/cgi/bugreport.cgi?bug=30073 GNU Bug Tracking System Contact help-debbugs <at> gnu.org with problems
[Message part 2 (message/rfc822, inline)]
From: Juri Linkov <juri <at> linkov.net> To: Eli Zaretskii <eliz <at> gnu.org> Cc: contovob <at> tcd.ie, 30073-done <at> debbugs.gnu.org, tino.calancha <at> gmail.com Subject: Re: bug#30073: 27.0.50; dired-do-delete ignores customization for short answers Date: Sun, 21 Jan 2018 23:46:01 +0200>> Thanks for working on this. > > Here is a quite final patch I believe. At least, it works > without noticed problems in my tests. Done.
[Message part 3 (message/rfc822, inline)]
From: Tino Calancha <tino.calancha <at> gmail.com> To: bug-gnu-emacs <at> gnu.org 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 +0900X-Debbugs-CC: npostavs <at> 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 <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.