mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-07 15:21:46 +00:00
Code Issues Releases Activity

Honor dired-create-destination-dirs if copying/renaming >1 files

Browse Source 
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.
This commit is contained in:
Tino Calancha 2018-04-05 12:15:54 +09:00
parent 17788644e6
commit 0b690a83f6
2 changed files with 46 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

47
lisp/dired-aux.el
View 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))

21
test/lisp/dired-aux-tests.el
View File

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