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.

diff --git a/doc/emacs/dired.texi b/doc/emacs/dired.texi
index db5dea329b5069f90236c349a84fffb35b9735d5..9348ef5042dd237df3806666d98b4bd31fd492f1 100644 (file)
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -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.
 

diff --git a/etc/NEWS b/etc/NEWS
index d38781c9961e56b09641533896275af3bb00deb9..267d98839274be6a3c7fd1bb27ce4fca62073938 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -55,6 +55,13 @@ whether '"' is also replaced in 'electric-quote-mode'.  If non-nil,
 \f
 * 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
 
 ---

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7e2252fcf1b1387ab42f59d499d1551c357e3d21..7813b20b78d220db939aada21b570ba58afa785f 100644 (file)
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -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)

diff --git a/test/lisp/dired-aux-tests.el b/test/lisp/dired-aux-tests.el
index d41feb1592fc2d14ed31f1060fc0a014da53bf5f..9316217dd2a700f5493e17d1fc87ef2d42e5475e 100644 (file)
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -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