Commit cb29f416 authored by Tino Calancha's avatar Tino Calancha

Allow to copy/rename file into a non-existent dir

* lisp/dired-aux.el (dired-create-destination-dirs): New option.
(dired-maybe-create-dirs): New defun.
(dired-copy-file-recursive, dired-rename-file): Use it (Bug#28834).
* lisp/dired-aux-tests.el (dired-test-bug28834): Add test.
* doc/emacs/dired.texi (Operating on Files): Update manual.
* etc/NEWS (Changes in Specialized Modes and Packages in Emacs 27.1)
Announce this change.
parent c75f505d
......@@ -647,6 +647,14 @@ Copy the specified files (@code{dired-do-copy}). The argument @var{new}
is the directory to copy into, or (if copying a single file) the new
name. This is like the shell command @code{cp}.
@vindex dired-create-destination-dirs
The option @code{dired-create-destination-dirs} controls whether Dired
should create non-existent directories in the destination while
copying/renaming files. The default value @code{nil} means Dired
never creates such missing directories; the value @code{always},
means Dired automatically creates them; the value @code{ask}
means Dired asks you for confirmation before creating them.
@vindex dired-copy-preserve-time
If @code{dired-copy-preserve-time} is non-@code{nil}, then copying
with this command preserves the modification time of the old file in
......@@ -678,6 +686,9 @@ single file, the argument @var{new} is the new name of the file. If
you rename several files, the argument @var{new} is the directory into
which to move the files (this is like the shell command @command{mv}).
The option @code{dired-create-destination-dirs} controls whether Dired
should create non-existent directories in @var{new}.
Dired automatically changes the visited file name of buffers associated
with renamed files so that they refer to the new names.
......
......@@ -55,6 +55,13 @@ whether '"' is also replaced in 'electric-quote-mode'. If non-nil,
* Changes in Specialized Modes and Packages in Emacs 27.1
** Dired
+++
*** The new user option 'dired-create-destination-dirs' controls whether
'dired-do-copy' and 'dired-rename-file' should create non-existent
directories in the destination.
** Ibuffer
---
......
......@@ -1548,6 +1548,24 @@ Special value `always' suppresses confirmation."
(declare-function make-symbolic-link "fileio.c")
(defcustom dired-create-destination-dirs nil
"Whether Dired should create destination dirs when copying/removing files.
If nil, don't create them.
If `always', create them without ask.
If `ask', ask for user confirmation."
:type '(choice (const :tag "Never create non-existent dirs" nil)
(const :tag "Always create non-existent dirs" always)
(const :tag "Ask for user confirmation" ask))
:group 'dired
:version "27.1")
(defun dired-maybe-create-dirs (dir)
"Create DIR if doesn't exist according to `dired-create-destination-dirs'."
(when (and dired-create-destination-dirs (not (file-exists-p dir)))
(if (or (eq dired-create-destination-dirs 'always)
(yes-or-no-p (format "Create destination dir `%s'? " dir)))
(dired-create-directory dir))))
(defun dired-copy-file-recursive (from to ok-flag &optional
preserve-time top recursive)
(when (and (eq t (car (file-attributes from)))
......@@ -1564,6 +1582,7 @@ Special value `always' suppresses confirmation."
(if (stringp (car attrs))
;; It is a symlink
(make-symbolic-link (car attrs) to ok-flag)
(dired-maybe-create-dirs (file-name-directory to))
(copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
......@@ -1573,6 +1592,7 @@ Special value `always' suppresses confirmation."
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
(dired-handle-overwrite newname)
(dired-maybe-create-dirs (file-name-directory newname))
(rename-file file newname ok-if-already-exists) ; error is caught in -create-files
;; Silently rename the visited file of any buffer visiting this file.
(and (get-file-buffer file)
......
......@@ -20,7 +20,7 @@
;;; Code:
(require 'ert)
(require 'dired-aux)
(eval-when-compile (require 'cl-lib))
(ert-deftest dired-test-bug27496 ()
"Test for https://debbugs.gnu.org/27496 ."
......@@ -40,5 +40,59 @@
(should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
(delete-file foo))))
;; Auxiliar macro for `dired-test-bug28834': it binds
;; `dired-create-destination-dirs' to CREATE-DIRS and execute BODY.
;; If YES-OR-NO is non-nil, it binds `yes-or-no-p' to
;; to avoid the prompt.
(defmacro with-dired-bug28834-test (create-dirs yes-or-no &rest body)
(declare ((debug form symbolp body)))
(let ((foo (make-symbol "foo")))
`(let* ((,foo (make-temp-file "foo" 'dir))
(dired-create-destination-dirs ,create-dirs))
(setq from (make-temp-file "from"))
(setq to-cp
(expand-file-name
"foo-cp" (file-name-as-directory (expand-file-name "bar" ,foo))))
(setq to-mv
(expand-file-name
"foo-mv" (file-name-as-directory (expand-file-name "qux" ,foo))))
(unwind-protect
(if ,yes-or-no
(cl-letf (((symbol-function 'yes-or-no-p)
(lambda (prompt) (eq ,yes-or-no 'yes))))
,@body)
,@body)
;; clean up
(delete-directory ,foo 'recursive)
(delete-file from)))))
(ert-deftest dired-test-bug28834 ()
"test for https://debbugs.gnu.org/28834 ."
(let (from to-cp to-mv)
;; `dired-create-destination-dirs' set to 'always.
(with-dired-bug28834-test
'always nil
(dired-copy-file-recursive from to-cp nil)
(should (file-exists-p to-cp))
(dired-rename-file from to-mv nil)
(should (file-exists-p to-mv)))
;; `dired-create-destination-dirs' set to nil.
(with-dired-bug28834-test
nil nil
(should-error (dired-copy-file-recursive from to-cp nil))
(should-error (dired-rename-file from to-mv nil)))
;; `dired-create-destination-dirs' set to 'ask.
(with-dired-bug28834-test
'ask 'yes ; Answer `yes'
(dired-copy-file-recursive from to-cp nil)
(should (file-exists-p to-cp))
(dired-rename-file from to-mv nil)
(should (file-exists-p to-mv)))
(with-dired-bug28834-test
'ask 'no ; Answer `no'
(should-error (dired-copy-file-recursive from to-cp nil))
(should-error (dired-rename-file from to-mv nil)))))
(provide 'dired-aux-tests)
;; dired-aux-tests.el ends here
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment