Re: bug in copy-directory

[Thierry Volpiatto]

Michael Albinus <address@hidden> writes:

> Thierry Volpiatto <address@hidden> writes:
>
>> What we could do also is create a function copy-directory-contents, that
>> reuse the code of precedent version of copy-directory (but not
>> interactive this time) and call this function in
>> dired-copy-file-recursive instead of copy-directory.
>>
>> In this case we could rewrite copy-directory to avoid duplicate code,
>> possibly: (no urge in this case as actual copy-directory works fine) 
>>
>> 1) Writing copy-directory-contents (or whatever name) to allow
>> creating the structure like actual copy-directory, or not like ancient
>> version leaving this job to dired-create-files.
>>
>> 2) Writing a copy-directory that reuse dired code (i.e dired-create-files).
>> In this case it would have all interactive messages, ask etc..
>>
>> WDYT?
>
> I would prefer option 2). There is no need to have an extra dired
> implementation, now we have copy-directory.

So i made first steps:

- Create new function copy-directory-contents based on old
copy-directory code.

- Use it in dired-copy-file-recursive instead of copy-directory.

Seems to work fine.

---
 lisp/dired-aux.el |    2 +-
 lisp/files.el     |   47 +++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 48 insertions(+), 1 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28b285f..f7a356d 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-directory-contents 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 d896020..526372e 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,6 +4723,53 @@ 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-contents (directory newname &optional keep-time parents)
+  "Copy DIRECTORY contents to NEWNAME.  Both args must be strings.
+If NEWNAME names an existing directory, copy DIRECTORY contents as 
subdirectory there.
+
+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.)
+
+The last argument PARENTS says whether to
+create parent directories if they don't exist."
+
+  ;; 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)
+                    (find-file-name-handler newname 'copy-directory))))
+    (if handler
+       (funcall handler 'copy-directory directory newname keep-time parents)
+
+      ;; Compute target name.
+      (setq directory (directory-file-name (expand-file-name directory))
+           newname   (directory-file-name (expand-file-name newname)))
+      (when (not (file-directory-p newname))
+        (make-directory newname parents))
+
+      ;; Copy recursively.
+      (mapc
+       (lambda (file)
+        (let ((target (expand-file-name
+                       (file-name-nondirectory file) newname))
+              (attrs  (file-attributes file)))
+          (cond ((file-directory-p file)
+                 (copy-directory file newname keep-time parents))
+                ((stringp (car attrs)) ; Symbolic link
+                 (make-symbolic-link (car attrs) target t))
+                (t
+                 (copy-file file target t keep-time)))))
+       ;; We do not want to copy "." and "..".
+       (directory-files        directory 'full 
directory-files-no-dot-files-regexp))
+
+      ;; Set directory attributes.
+      (set-file-modes newname (file-modes directory))
+      (when 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.
 If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.



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