]> git.eshelyaron.com Git - emacs.git/commitdiff
Honor dired-create-destination-dirs if copying/renaming >1 files
authorTino Calancha <tino.calancha@gmail.com>
Thu, 5 Apr 2018 03:15:54 +0000 (12:15 +0900)
committerTino Calancha <tino.calancha@gmail.com>
Thu, 5 Apr 2018 03:15:54 +0000 (12:15 +0900)
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.

lisp/dired-aux.el
test/lisp/dired-aux-tests.el

index e8b5e6755ea8da339f2887f9e1925f8c4b4de60d..821b7d797599d74816e8c59a85e9a002b90591ef 100644 (file)
@@ -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))
index ab6d1cb0564cbbb80be8502fe1ba02a2dd0bfbe8..daf60f760e03706a671a99c953205faeb726b9b6 100644 (file)
      (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