[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
Re: bug in copy-directory
From: |
Thierry Volpiatto |
Subject: |
Re: bug in copy-directory |
Date: |
Wed, 02 Feb 2011 21:48:53 +0100 |
User-agent: |
Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.92 (gnu/linux) |
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
- Re: bug in copy-directory, Michael Albinus, 2011/02/01
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/01
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/02
- Re: bug in copy-directory, Michael Albinus, 2011/02/02
- Re: bug in copy-directory,
Thierry Volpiatto <=
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/04
- Re: bug in copy-directory, Michael Albinus, 2011/02/04
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/04
- Re: bug in copy-directory, Michael Albinus, 2011/02/04
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/04
- Re: bug in copy-directory, Chong Yidong, 2011/02/06
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/06
- Re: bug in copy-directory, Michael Albinus, 2011/02/06
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/06
- Re: bug in copy-directory, Thierry Volpiatto, 2011/02/06