Re: bug in copy-directory

[Thierry Volpiatto <thierry.volpiatto@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2537 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

>> If you want to be able to do:
>> (copy-directory "/tmp/test" "~/")
>> We will have to fallback to a function copy-directory1 used by dired and
>> a copy-directory function/command that ALWAYS use last arg of
>> copy-directory1.
>
> That sounds to me like the right thing to do (copy-directory already
> has many arguments, and adding one which will (almost) always need to
> be passed doesn't sound too attractive).
>
> But you say it in a tone that seems to imply it's undesirable: could you
> explain why you think it's undesirable?
No, i agree to use copy-directory without adding extra arguments.
i.e (copy-directory "/tmp/test" "~/")

The problem we have actually is to make something that:

- work in interactive call to copy-directory (M-x copy-directory)
- work non--interactively ==> (copy-directory "/tmp/test" "~/")
- work from dired.

If you have only one function copy-directory that work fine in case 2,
it will fail in dired because dired already does a part of the job of
this function (maybe because long time ago dired-create-files has been
wrote on this bug), and if you make it work in dired it will fail in
directs calls to copy-directory.

So to achieve the 3 cases above i propose:

- Make a copy-directory1 function that work with dired (like ancient
  code).
- call copy-directory1 in dired-copy-file-recursive.
- Make a copy-directory function/command that reuse copy-directory1
  without extra args (like it was before, last arg is parents).

This actually works and is IMHO the best solution.(see patch)

Otherwise you have to call in dired-do-copy dired-create-files something
like this:

,----
| (dired-create-files
|  fn (symbol-name action) files
|  ;; CANDIDATE is the destination.
|  (if (file-directory-p candidate)
|      ;; When CANDIDATE is a directory, build file-name in this directory.
|      ;; Else we use CANDIDATE.
|      #'(lambda (from)
|          (let ((target (expand-file-name (file-name-nondirectory from) candidate)))
|            (if (file-directory-p target) candidate target)))
|      #'(lambda (from) candidate))
|  marker)
`----

but in this case the NAME-CONSTRUCTOR returns wrong value for message,
but not for executing code (it does the right thing)

So in this case a rewrite (partial) of dired-create-files is needed in
addition of modification of dired-do-copy call to dired-create-files.
(with possible breakage of symlinking etc...)

-- 
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997 

[-- Attachment #2: patch-copy-dir5 --]
[-- Type: application/octet-stream, Size: 4332 bytes --]

patch-copy-dir5

From: Thierry Volpiatto <thierry.volpiatto@gmail.com>


---
 lisp/dired-aux.el |    2 +-
 lisp/files.el     |   54 ++++++++++++++++++++++++++++-------------------------
 2 files changed, 30 insertions(+), 26 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28b285f..b26ce0a 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1242,7 +1242,7 @@ Special value `always' suppresses confirmation."
 	     (or (eq recursive 'always)
 		 (yes-or-no-p (format "Recursive copies of %s? " from))))
 	;; This is a directory.
-	(copy-directory from to dired-copy-preserve-time)
+	(copy-directory1 from to dired-copy-preserve-time)
       ;; Not a directory.
       (or top (dired-handle-overwrite to))
       (condition-case err
diff --git a/lisp/files.el b/lisp/files.el
index 7ac88f8..32ce50b 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,31 +4723,8 @@ If RECURSIVE is non-nil, all files in DIRECTORY are deleted as well."
 		 directory 'full directory-files-no-dot-files-regexp)))
       (delete-directory-internal directory)))))
 
-(defun copy-directory (directory newname &optional keep-time
+(defun copy-directory1 (directory newname &optional keep-time
 				 parents copy-as-subdir)
-  "Copy DIRECTORY to NEWNAME.  Both args must be strings.
-This function always sets the file modes of the output files to match
-the corresponding input file.
-
-The third arg KEEP-TIME non-nil means give the output files the same
-last-modified time as the old ones.  (This works on only some systems.)
-A prefix arg makes KEEP-TIME non-nil.
-
-Optional arg PARENTS says whether to create parent directories if
-they don't exist.  When called interactively, PARENTS is t.
-
-When NEWNAME is an existing directory, copy DIRECTORY into a
-subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is
-non-nil, otherwise copy the contents of DIRECTORY into NEWNAME.
-When called interactively, copy into a subdirectory by default."
-  (interactive
-   (let ((dir (read-directory-name
-	       "Copy directory: " default-directory default-directory t nil)))
-     (list dir
-	   (read-file-name
-	    (format "Copy directory %s to: " dir)
-	    default-directory default-directory nil nil)
-	   current-prefix-arg t t)))
   ;; If default-directory is a remote directory, make sure we find its
   ;; copy-directory handler.
   (let ((handler (or (find-file-name-handler directory 'copy-directory)
@@ -4789,7 +4766,7 @@ When called interactively, copy into a subdirectory by default."
 		       (file-name-nondirectory file) newname))
 	      (attrs (file-attributes file)))
 	  (cond ((file-directory-p file)
-		 (copy-directory file target keep-time parents nil))
+		 (copy-directory1 file target keep-time parents nil))
 		((stringp (car attrs)) ; Symbolic link
 		 (make-symbolic-link (car attrs) target t))
 		(t
@@ -4799,6 +4776,33 @@ When called interactively, copy into a subdirectory by default."
       (set-file-modes newname (file-modes directory))
       (if keep-time
 	  (set-file-times newname (nth 5 (file-attributes directory)))))))
+
+(defun copy-directory (directory newname &optional keep-time parents)
+  "Copy DIRECTORY to NEWNAME.  Both args must be strings.
+This function always sets the file modes of the output files to match
+the corresponding input file.
+
+The third arg KEEP-TIME non-nil means give the output files the same
+last-modified time as the old ones.  (This works on only some systems.)
+A prefix arg makes KEEP-TIME non-nil.
+
+Optional arg PARENTS says whether to create parent directories if
+they don't exist.  When called interactively, PARENTS is t.
+
+When NEWNAME is an existing directory, copy DIRECTORY into a
+subdirectory of NEWNAME if optional arg COPY-AS-SUBDIR is
+non-nil, otherwise copy the contents of DIRECTORY into NEWNAME.
+When called interactively, copy into a subdirectory by default."
+  (interactive
+   (let ((dir (read-directory-name
+	       "Copy directory: " default-directory default-directory t nil)))
+     (list dir
+	   (read-file-name
+	    (format "Copy directory %s to: " dir)
+	    default-directory default-directory nil nil)
+	   current-prefix-arg t)))
+  (copy-directory1 directory newname keep-time parents 'copy-as-subdir))
+
 \f
 (put 'revert-buffer-function 'permanent-local t)
 (defvar revert-buffer-function nil