Package: emacs;
Reported by: "alexei28" <alexei28 <at> gmail.com>
Date: Sat, 14 Oct 2017 14:53:01 UTC
Severity: wishlist
Tags: patch
Found in version 25.1
Done: Tino Calancha <tino.calancha <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Tino Calancha <tino.calancha <at> gmail.com> To: Eli Zaretskii <eliz <at> gnu.org> Cc: 28834 <at> debbugs.gnu.org, drew.adams <at> oracle.com Subject: bug#28834: 25.1; dired-do-copy: allow to copy into a nonexistent directory Date: Tue, 17 Oct 2017 13:49:34 +0900
Eli Zaretskii <eliz <at> gnu.org> writes:
Thank you for the comments.
* I have changed the new function name to `dired-maybe-create-dirs'
as Drew suggested.
* I think I have addressed all your comments as well.
>> +The option @var{dired-create-destination-dirs} controls whether Dired
>> +should create non-existent directories in @var{new}.
>
> This sentence is redundant (repeated right after it), and also uses
> @var incorrectly.
Removed that entence.
>> +@videnx dired-create-destination-dirs
> ^^^^^^^
> A typo.
Fixed.
>> +means Dired automatically creates them; the value @code{prompt}
>> +means Dired asks you for confirmation before creating them.
>
> I think we generally use 'ask', not 'prompt' in these cases.
Changed to 'ask.
>> +** Dired
>> +
>> +---
>
> Since you've updated the manual, this should be "+++", not "---".
OK.
>> +'dired-do-copy' and 'dired-rename-file' must create non-existent
> ^^^^
> "Should", not "must".
OK.
>> +If never, don't create them.
>> +If always, create them without ask.
>> +If prompt, ask for user confirmation."
>
> The symbols should be quoted: `never', `always', etc.
OK.
> Btw, perhaps it's better to use nil instead of 'never'.
Changed never ---> nil.
>> +(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))))))
>
> Is use of pcase really justified here?
I rewrote the function: now it loooks more simple.
>> +(ert-deftest dired-test-bug28834 ()
>> + "test for https://debbugs.gnu.org/28834 ."
> This doesn't test the 3rd value. Why is that?
Laziness? Bad memory? Busy? Stomach problems? Other not listed here?
Updated the test: now it run all cases.
--8<-----------------------------cut here---------------start------------->8---
commit fb91d159f241a6eeecc41c4101472f145a00c0d1
Author: Tino Calancha <tino.calancha <at> gmail.com>
Date: Tue Oct 17 13:48:59 2017 +0900
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 db5dea329b..9348ef5042 100644
--- a/doc/emacs/dired.texi
+++ b/doc/emacs/dired.texi
@@ -647,6 +647,14 @@ Operating on Files
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 @@ 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 @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 716b0309a5..acfc52ab52 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' should create non-existent
+directories in the destination.
+
** Edebug
+++
diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 7e2252fcf1..5e92c58d12 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1548,6 +1548,24 @@ dired-copy-file
(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 with `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 @@ dired-copy-file-recursive
(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 @@ dired-copy-file-recursive
;;;###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 d41feb1592..9316217dd2 100644
--- 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
--8<-----------------------------cut here---------------end--------------->8---
In GNU Emacs 27.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11)
of 2017-10-17
Repository revision: 94281c9a1cc0f756841fdc9b266657853df94a29
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.