dired-delete-file: Dont't ask for empty dirs

* lisp/dired.el (dired--yes-no-all-quit-help): New defun.
(dired-delete-file): Use it.  Dont't ask for empty dirs (Bug#27940).

* test/lisp/dired-tests.el (dired-test-with-temp-dirs):
New auxiliar macro.
(dired-test-bug27940): Add new test.

2 files changed, 123 insertions, 33 deletions

diff --git a/lisp/dired.el b/lisp/dired.el
index 2e5b847f9b2..0455f3d1378 100644
--- a/lisp/dired.el
+++ b/lisp/dired.el
@@ -2989,6 +2989,29 @@ Any other value means to ask for each directory."
 `quit' to exit,
 `help' to show this help message.")
 
+(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))
+
 ;; 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.
@@ -3009,39 +3032,21 @@ TRASH non-nil means to trash the file instead of deleting, provided
        ;; 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
-                         (read-string
-                          (format "Recursively %s %s? [yes, no, all, quit, help] "
-                                  (if (and trash
-                                           delete-by-moving-to-trash)
-                                      "trash"
-                                    "delete")
-                                  (dired-make-relative file))))
-                   (when (string= answer "help")
-                     (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:
-             (funcall input-fn)
-             (while (not (member answer valid-answers))
-               (unless (string= answer "help")
-                 (beep)
-                 (message "Please answer `yes' or `no' or `all' or `quit'")
-                 (sleep-for 2))
-               (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))))
+         (let* ((empty-dir-p (null (directory-files file t dired-re-no-dot))))
+           (if (and recursive (not empty-dir-p))
+               (unless (eq recursive 'always)
+                 (let ((prompt
+                        (format "Recursively %s %s? "
+                                (if (and trash delete-by-moving-to-trash)
+                                    "trash"
+                                  "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)))))
+             (setq recursive nil)) ; Empty dir or recursive is nil.
            (delete-directory file recursive trash))))
 
 (defun dired-do-flagged-delete (&optional nomessage)
diff --git a/test/lisp/dired-tests.el b/test/lisp/dired-tests.el
index 981afdd929e..3c460d0151e 100644
--- a/test/lisp/dired-tests.el
+++ b/test/lisp/dired-tests.el
@@ -358,5 +358,90 @@
           (should (equal "subdir" (dired-get-filename 'local t))))
       (delete-directory top-dir t))))
 
+
+(defmacro dired-test-with-temp-dirs (just-empty-dirs &rest body)
+  "Helper macro for Bug#27940 test."
+  (declare (indent 1) (debug body))
+  (let ((dir (make-symbol "dir"))
+        (ignore-funcs (make-symbol "ignore-funcs")))
+    `(let* ((,dir (make-temp-file "bug27940" t))
+            (dired-deletion-confirmer (lambda (_) "yes")) ; Suppress prompts.
+            (inhibit-message t)
+            (default-directory ,dir))
+       (dotimes (i 5) (make-directory (format "empty-dir-%d" i)))
+       (unless ,just-empty-dirs
+         (dotimes (i 5) (make-directory (format "non-empty-%d/foo" i) 'parents)))
+       (make-directory "zeta-empty-dir")
+       (unwind-protect
+           (progn
+             ,@body)
+         (delete-directory ,dir t)
+         (kill-buffer (current-buffer))))))
+
+(ert-deftest dired-test-bug27940 ()
+  "Test for http://debbugs.gnu.org/27940 ."
+  ;; If just empty dirs we shouln't be prompted.
+  (dired-test-with-temp-dirs
+   'just-empty-dirs
+   (let (asked)
+     (advice-add 'dired--yes-no-all-quit-help
+                 :override
+                 (lambda (_) (setq asked t) "")
+                 '((name . dired-test-bug27940-advice)))
+     (dired default-directory)
+     (dired-toggle-marks)
+     (dired-do-delete nil)
+     (unwind-protect
+         (progn
+           (should-not asked)
+           (should-not (dired-get-marked-files))) ; All dirs deleted.
+       (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))))
+  ;; Answer yes
+  (dired-test-with-temp-dirs
+   nil
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "yes")
+               '((name . dired-test-bug27940-advice)))
+   (dired default-directory)
+   (dired-toggle-marks)
+   (dired-do-delete nil)
+   (unwind-protect
+       (should-not (dired-get-marked-files)) ; All dirs deleted.
+     (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+  ;; Answer no
+  (dired-test-with-temp-dirs
+   nil
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "no")
+               '((name . dired-test-bug27940-advice)))
+   (dired default-directory)
+   (dired-toggle-marks)
+   (dired-do-delete nil)
+   (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
+  (dired-test-with-temp-dirs
+   nil
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "all")
+               '((name . dired-test-bug27940-advice)))
+   (dired default-directory)
+   (dired-toggle-marks)
+   (dired-do-delete nil)
+   (unwind-protect
+       (should-not (dired-get-marked-files)) ; All dirs deleted.
+     (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice)))
+  ;; Answer quit
+  (dired-test-with-temp-dirs
+   nil
+   (advice-add 'dired--yes-no-all-quit-help :override (lambda (_) "quit")
+               '((name . dired-test-bug27940-advice)))
+   (dired default-directory)
+   (dired-toggle-marks)
+   (let ((inhibit-message t))
+     (dired-do-delete nil))
+   (unwind-protect
+       (should (= 6 (length (dired-get-marked-files)))) ; All empty dirs but zeta-empty-dir deleted.
+     (advice-remove 'dired--yes-no-all-quit-help 'dired-test-bug27940-advice))))
+
+
 (provide 'dired-tests)
 ;; dired-tests.el ends here