[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
bug#28834: 25.1; dired-do-copy: allow to copy into a nonexistent directo
From: |
Tino Calancha |
Subject: |
bug#28834: 25.1; dired-do-copy: allow to copy into a nonexistent directory |
Date: |
Mon, 16 Oct 2017 12:47:06 +0900 |
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.0.50 (gnu/linux) |
Drew Adams <drew.adams@oracle.com> writes:
> The enhancement request is "It would be good if Emacs CAN
> autocreate not exist directory when copy/move files."
>
> The operative word here is "CAN".
> This can be done in various ways:
>
> 1. Have a different command, which users can bind in
> place of the existing command.
>
> 2. Have a user option that controls whether Dired creates
> missing dirs by default, i.e., without confirmation.
>
> 3. Have Dired ask whether to create missing directories.
>
> I think probably 2+3 would be good: have Dired prompt
> when dirs are missing, but have an option that lets
> users who never want to be prompted bypass prompting.
> The option could be 3-valued: `always-prompt',
> `always-create', `never-create' (or other names).
Thank you for the explanation. Let's discuss the updated patch:
--8<-----------------------------cut here---------------start------------->8---
commit b656651e9268f5dd646933b992bd37771c3e99ca
Author: Tino Calancha <tino.calancha@gmail.com>
Date: Mon Oct 16 12:41:41 2017 +0900
Allow to copy/rename file into a non-existent dir
* lisp/dired-aux.el (dired-create-destination-dirs): New option.
(dired--create-nonexistent-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 db5dea329b..0f37ac60ac 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -646,6 +646,16 @@ Operating on Files
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}.
+The option @var{dired-create-destination-dirs} controls whether Dired
+should create non-existent directories in @var{new}.
+
+@videnx 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{never} means Dired
+never creates such missing directories; the value @code{always},
+means Dired automatically creates them; the value @code{prompt}
+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
@@ -678,6 +688,9 @@ Operating on Files
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 @var{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 716b0309a5..e5cec45426 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -56,6 +56,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' must create non-existent
+directories in the destination.
+
** Edebug
+++
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7e2252fcf1..0e415b7738 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1548,6 +1548,26 @@ dired-copy-file
(declare-function make-symbolic-link "fileio.c")
+(defcustom dired-create-destination-dirs 'never
+ "Whether Dired should create destination dirs when copying/removing files.
+If never, don't create them.
+If always, create them without ask.
+If prompt, ask for user confirmation."
+ :type '(choice (const :tag "Never create non-existent dirs" never)
+ (const :tag "Always create non-existent dirs" always)
+ (const :tag "Ask for user confirmation" prompt))
+ :group 'dired
+ :version "27.1")
+
+(defun dired--create-dirs (dir)
+ (unless (file-exists-p dir)
+ (pcase dired-create-destination-dirs
+ ('never nil)
+ ('always (dired-create-directory dir))
+ ('prompt
+ (when (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 +1584,7 @@ dired-copy-file-recursive
(if (stringp (car attrs))
;; It is a symlink
(make-symbolic-link (car attrs) to ok-flag)
+ (dired--create-dirs (file-name-directory to))
(copy-file from to ok-flag preserve-time))
(file-date-error
(push (dired-make-relative from)
@@ -1573,6 +1594,7 @@ dired-copy-file-recursive
;;;###autoload
(defun dired-rename-file (file newname ok-if-already-exists)
(dired-handle-overwrite newname)
+ (dired--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 d41feb1592..7778db0ea4 100644
--- a/test/lisp/dired-aux-tests.el
+++ b/test/lisp/dired-aux-tests.el
@@ -40,5 +40,34 @@
(should-not (dired-do-shell-command "ls ? ./`?`" nil files)))
(delete-file foo))))
+(ert-deftest dired-test-bug28834 ()
+ "test for https://debbugs.gnu.org/28834 ."
+ (let* ((from (make-temp-file "from"))
+ (foo (make-temp-file "foo" 'dir))
+ (bar (file-name-as-directory (expand-file-name "bar" foo)))
+ (qux (file-name-as-directory (expand-file-name "qux" foo)))
+ (tmpdir temporary-file-directory)
+ (to-cp (expand-file-name "foo-cp" bar))
+ (to-mv (expand-file-name "foo-mv" qux))
+ (dired-create-destination-dirs 'always))
+ (unwind-protect
+ (progn
+ (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))
+ ;; Repeat the same with `dired-create-destination-dirs' set to
'never.
+ (dired-rename-file to-mv from nil)
+ (delete-file to-cp)
+ (delete-directory bar)
+ (delete-directory qux)
+ (let ((dired-create-destination-dirs 'never))
+ (should-error (dired-copy-file-recursive from to-cp nil))
+ (should-error (dired-rename-file from to-mv nil))))
+ ;; clean up
+ (delete-directory foo 'recursive)
+ (delete-file from))))
+
+
(provide 'dired-aux-tests)
;; dired-aux-tests.el ends here
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 11, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-10-16
Repository revision: eed3a3d9e95d2c5346a23c9d92ca4e5848330183