[Emacs-diffs] master cbea38e: dired-do-delete: Allow to delete dirs recursively without prompts

[Tino Calancha]

branch: master
commit cbea38e5c4af5386192fb9a48ef4fca5080d6561
Author: Tino Calancha <address@hidden>
Commit: Tino Calancha <address@hidden>

    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 150ac84..c1cc2f8 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 address@hidden, 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 b72793d..b47bf95 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -611,6 +611,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 d04bd6f..0bad256 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))