From cbea38e5c4af5386192fb9a48ef4fca5080d6561 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Sun, 6 Aug 2017 13:46:51 +0900 Subject: [PATCH] dired-do-delete: Allow to delete dirs recursively without prompts * lisp/dired.el (dired-delete-file): Accept 2 additional answers: 'all', to delete all directories recursively and no prompt anymore. 'quit', to cancel directory deletions (Bug#27940). Show help message when user inputs 'help'. (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. * doc/emacs/dired.texi (Dired Deletion): Update manual. * etc/NEWS (Changes in Specialized Modes and Packages in Emacs 26.1): Announce this change. --- doc/emacs/dired.texi | 8 ++++++ etc/NEWS | 4 +++ lisp/dired.el | 66 ++++++++++++++++++++++++++++++++------------ 3 files changed, 60 insertions(+), 18 deletions(-) diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi index 150ac8427ab..c1cc2f8cf96 100644 --- a/doc/emacs/dired.texi +++ b/doc/emacs/dired.texi @@ -236,6 +236,14 @@ Dired cannot delete directories that are nonempty. If the variable @code{dired-recursive-deletes} is non-@code{nil}, then Dired can delete nonempty directories including all their contents. That can be somewhat risky. +Even if you have set @code{dired-recursive-deletes} to @code{nil}, +you might want sometimes to delete recursively directories +without being asked for confirmation for all of them. This is handy +when you have marked many directories for deletion and you are very +sure that all of them can safely being deleted. For every nonempty +directory you are asked for confirmation; if you answer @code{all}, +then all the remaining directories will be deleted without more +questions. @vindex delete-by-moving-to-trash If you change the variable @code{delete-by-moving-to-trash} to diff --git a/etc/NEWS b/etc/NEWS index b72793dec08..b47bf959bed 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -610,6 +610,10 @@ paragraphs, for the purposes of bidirectional display. ** Dired ++++ +*** You can answer 'all' in 'dired-do-delete' to delete recursively all +remaining directories without more prompts. + +++ *** Dired supports wildcards in the directory part of the file names. diff --git a/lisp/dired.el b/lisp/dired.el index d04bd6fe037..0bad2562eb4 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -2981,6 +2981,14 @@ Any other value means to ask for each directory." ;; 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.") + ;; 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. @@ -2996,23 +3004,40 @@ its possible values is: 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 "yes" "no" "all" "quit" "help")) + (answer "") + (input-fn (lambda () + (setq answer + (completing-read + (format "Recursively %s %s? [yes, no, all, quit, help] " + (if (and trash + delete-by-moving-to-trash) + "trash" + "delete") + (dired-make-relative file)) + valid-answers nil t)) + (when (string= answer "help") + (setq answer "") + (with-help-window "*Help*" + (with-current-buffer "*Help*" (insert dired-delete-help)))) + answer))) + (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 + ('"all" (setq recursive 'always dired-recursive-deletes recursive)) + ('"yes" (if (eq recursive 'top) (setq recursive 'always))) + ('"no" (setq recursive nil)) + ('"quit" (keyboard-quit)))) + (delete-directory file recursive trash)))) (defun dired-do-flagged-delete (&optional nomessage) "In Dired, delete the files flagged for deletion. @@ -3061,6 +3086,9 @@ non-empty directories is allowed." (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))) @@ -3070,6 +3098,7 @@ non-empty directories is allowed." (if trashing "Trash" "Delete") (dired-mark-prompt arg files))) (save-excursion + (catch '--delete-cancel (let ((progress-reporter (make-progress-reporter (if trashing "Trashing..." "Deleting...") @@ -3087,6 +3116,7 @@ non-empty directories is allowed." (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))))) @@ -3097,7 +3127,7 @@ non-empty directories is allowed." (format "%d of %d deletion%s failed" (length failures) count (dired-plural-s count)) - failures)))) + failures))))) (message "(No deletions performed)"))) (dired-move-to-filename)) -- 2.39.5