From: Tino Calancha Date: Thu, 5 Apr 2018 03:15:54 +0000 (+0900) Subject: Honor dired-create-destination-dirs if copying/renaming >1 files X-Git-Tag: emacs-27.0.90~5323 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=0b690a83f674a160ccbaa9f374226b1fcfb2d535;p=emacs.git Honor dired-create-destination-dirs if copying/renaming >1 files Check `dired-create-destination-dirs' when the user wants to copy/rename several files. * lisp/dired-aux.el (dired-do-create-files): Call `dired-maybe-create-dirs' right before bind `into-dir' (Bug#30624). * test/lisp/dired-aux-tests.el (dired-test-bug30624): Add test. --- diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el index e8b5e6755ea..821b7d79759 100644 --- a/lisp/dired-aux.el +++ b/lisp/dired-aux.el @@ -1864,28 +1864,31 @@ Optional arg HOW-TO determines how to treat the target. (dired-mark-read-file-name (concat (if dired-one-file op1 operation) " %s to: ") target-dir op-symbol arg rfn-list default)))) - (into-dir (cond ((null how-to) - ;; Allow users to change the letter case of - ;; a directory on a case-insensitive - ;; filesystem. If we don't test these - ;; conditions up front, file-directory-p - ;; below will return t on a case-insensitive - ;; filesystem, and Emacs will try to move - ;; foo -> foo/foo, which fails. - (if (and (file-name-case-insensitive-p (car fn-list)) - (eq op-symbol 'move) - dired-one-file - (string= (downcase - (expand-file-name (car fn-list))) - (downcase - (expand-file-name target))) - (not (string= - (file-name-nondirectory (car fn-list)) - (file-name-nondirectory target)))) - nil - (file-directory-p target))) - ((eq how-to t) nil) - (t (funcall how-to target))))) + (into-dir + (progn + (unless dired-one-file (dired-maybe-create-dirs target)) + (cond ((null how-to) + ;; Allow users to change the letter case of + ;; a directory on a case-insensitive + ;; filesystem. If we don't test these + ;; conditions up front, file-directory-p + ;; below will return t on a case-insensitive + ;; filesystem, and Emacs will try to move + ;; foo -> foo/foo, which fails. + (if (and (file-name-case-insensitive-p (car fn-list)) + (eq op-symbol 'move) + dired-one-file + (string= (downcase + (expand-file-name (car fn-list))) + (downcase + (expand-file-name target))) + (not (string= + (file-name-nondirectory (car fn-list)) + (file-name-nondirectory target)))) + nil + (file-directory-p target))) + ((eq how-to t) nil) + (t (funcall how-to target)))))) (if (and (consp into-dir) (functionp (car into-dir))) (apply (car into-dir) operation rfn-list fn-list target (cdr into-dir)) (if (not (or dired-one-file into-dir)) diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el index ab6d1cb0564..daf60f760e0 100644 --- a/test/lisp/dired-aux-tests.el +++ b/test/lisp/dired-aux-tests.el @@ -93,6 +93,27 @@ (should-error (dired-copy-file-recursive from to-cp nil)) (should-error (dired-rename-file from to-mv nil))))) +(ert-deftest dired-test-bug30624 () + "test for https://debbugs.gnu.org/30624 ." + (cl-letf* ((target-dir (make-temp-file "target" 'dir)) + ((symbol-function 'dired-mark-read-file-name) + (lambda (&rest _) target-dir)) + (inhibit-message t)) + ;; Delete target-dir: `dired-do-create-files' must recreate it. + (delete-directory target-dir) + (let ((file1 (make-temp-file "bug30624_file1")) + (file2 (make-temp-file "bug30624_file2")) + (dired-create-destination-dirs 'always) + (buf (dired temporary-file-directory))) + (unwind-protect + (progn + (dired-revert) + (dired-mark-files-regexp "bug30624_file") + (should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil))) + (delete-directory target-dir 'recursive) + (mapc #'delete-file `(,file1 ,file2)) + (kill-buffer buf))))) + (provide 'dired-aux-tests) ;; dired-aux-tests.el ends here