mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-01 11:14:55 +00:00
Code Issues Releases Activity

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

Browse Source 
* 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.
This commit is contained in:
Tino Calancha 2017-08-09 14:47:15 +09:00
parent 9ecbdeeaa8
commit da4438e14f
2 changed files with 123 additions and 33 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

71
lisp/dired.el
View File

@ -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)

85
test/lisp/dired-tests.el
View File

@ -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