Package: emacs;
Reported by: 積丹尼 Dan Jacobson <jidanni <at> jidanni.org>
Date: Fri, 4 Aug 2017 00:38:01 UTC
Severity: wishlist
Done: Tino Calancha <tino.calancha <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Tino Calancha <tino.calancha <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 27940 <at> debbugs.gnu.org, jidanni <at> jidanni.org Subject: bug#27940: Recursively delete dir34? (yes, no, all, quit) Date: Fri, 04 Aug 2017 18:29:41 +0900
Eli Zaretskii <eliz <at> gnu.org> writes:
>> From: Tino Calancha <tino.calancha <at> gmail.com>
>> Cc: 27940 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org>
>> Date: Fri, 04 Aug 2017 17:25:49 +0900
>>
>> > dired-do-flagged-delete and me interaction:
>> > Recursively delete dcepc? (yes or no) yes
>> > Recursively delete emmpc? (yes or no) yes
>> > Recursively delete zpspc? (yes or no) yes
>> > Recursively delete dgcpc? (yes or no) yes
>> >
>> > Wouldn't it be nice if there was instead:
>> > Recursively delete dgcpc? (yes, no, all, quit)
>> >
>> > Yes, if before we started we set the variables we needn't be asked all
>> > those questions.
>> >
>> > But now *midway* through the list, we decide we would like no more
>> > question, there should be a way, without needing to quit and start over,
>> > even if doing that isn't so bad.
>> Thanks for the suggestion.
>> You can already quit with '\C-g'.
>> Concerning accept 'all' in the prompt, i am not sure:
>> it's a bit dangerous operation.
>>
>> In the other hand:
>> 1) Customize `dired-recursive-deletes' to value 'always.
>> 2) Do the deletion.
>> 3) Set back `dired-recursive-deletes' to its original value.
>
> Actually, I think the value he wants is 'top'.
The he would be prompted the 34 times all over. I think the OP
wants 'always (like Bon Jovi).
> I don't object to accepting something like "!" to mean "all", I
> believe we already have a few features that do this, and the
> implementation should be simple, I think. (Creeping featurism, I
> know, but what else did you expect from users who have no real bugs to
> report? ;-)
>
>> How about if `dired-do-delete' called interactively with 2 prefices
>> performs recursive deletions?
>> Eli?
>
> Sounds too cumbersome to me.
Updated patch. Now it accepts answers: y, n, !, q
(as the OP suggested)
--8<-----------------------------cut here---------------start------------->8---
commit 90e4eb9fa1b708bab87844160371ec9ce439ab91
Author: Tino Calancha <tino.calancha <at> gmail.com>
Date: Fri Aug 4 18:17:51 2017 +0900
dired-do-delete: Allow to delete dirs recursively
* lisp/dired.el (dired-delete-file): Accept 2 additional answers:
'!', to delete all directories recursively and no prompt anymore.
'q', to cancel the directry deletions (Bug#27940).
(dired-do-flagged-delete): Bind locally dired-recursive-deletes
so that we can overwrite its global value.
Wrapp the loop within a catch '--delete-cancel to catch when
the user abort the directtry deletion.
diff --git a/lisp/dired.el b/lisp/dired.el
index 24759c6c9b..278acc2cf5 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2990,23 +2990,33 @@ dired-delete-file
TRASH non-nil means to trash the file instead of deleting, provided
`delete-by-moving-to-trash' (which see) is non-nil."
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (not (eq t (car (file-attributes file))))
- (delete-file file trash)
- (if (and recursive
- (directory-files file t dired-re-no-dot) ; Not empty.
- (or (eq recursive 'always)
- (yes-or-no-p (format "Recursively %s %s? "
- (if (and trash
- delete-by-moving-to-trash)
- "trash"
- "delete")
- (dired-make-relative file)))))
- (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
- (setq recursive nil))
- (delete-directory file recursive trash)))
+ ;; This test is equivalent to
+ ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
+ ;; but more efficient
+ (if (not (eq t (car (file-attributes file))))
+ (delete-file file trash)
+ (let* ((valid-answers (list "y" "n" "!" "q"))
+ (answer "")
+ (input-fn (lambda ()
+ (setq answer
+ (completing-read (format "Recursively %s %s? [y, n, !, q] "
+ (if (and trash
+ delete-by-moving-to-trash)
+ "trash"
+ "delete")
+ (dired-make-relative file))
+ valid-answers nil t)))))
+ (if (and recursive
+ (directory-files file t dired-re-no-dot) ; Not empty.
+ (eq recursive 'always))
+ (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
+ ;; Otherwise prompt user:
+ (while (string= "" answer) (funcall input-fn))
+ (pcase answer
+ ('"!" (setq recursive 'always dired-recursive-deletes recursive))
+ ('"y" (if (eq recursive 'top) (setq recursive 'always)))
+ ('"q" (keyboard-quit))))
+ (delete-directory file recursive trash))))
(defun dired-do-flagged-delete (&optional nomessage)
"In Dired, delete the files flagged for deletion.
@@ -3055,6 +3065,9 @@ dired-internal-do-deletions
(let* ((files (mapcar #'car l))
(count (length l))
(succ 0)
+ ;; Bind `dired-recursive-deletes' so that we can change it
+ ;; locally according with the user answer within `dired-delete-file'.
+ (dired-recursive-deletes dired-recursive-deletes)
(trashing (and trash delete-by-moving-to-trash)))
;; canonicalize file list for pop up
(setq files (nreverse (mapcar #'dired-make-relative files)))
@@ -3064,6 +3077,7 @@ dired-internal-do-deletions
(if trashing "Trash" "Delete")
(dired-mark-prompt arg files)))
(save-excursion
+ (catch '--delete-cancel
(let ((progress-reporter
(make-progress-reporter
(if trashing "Trashing..." "Deleting...")
@@ -3081,6 +3095,7 @@ dired-internal-do-deletions
(dired-fun-in-all-buffers
(file-name-directory fn) (file-name-nondirectory fn)
#'dired-delete-entry fn))
+ (quit (throw '--delete-cancel (message "OK, canceled")))
(error ;; catch errors from failed deletions
(dired-log "%s\n" err)
(setq failures (cons (car (car l)) failures)))))
@@ -3091,7 +3106,7 @@ dired-internal-do-deletions
(format "%d of %d deletion%s failed"
(length failures) count
(dired-plural-s count))
- failures))))
+ failures)))))
(message "(No deletions performed)")))
(dired-move-to-filename))
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-08-04
Repository revision: db5d38ddb0de83d8f920b7a128fe3fd5156fdf85
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.