[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: |
Sun, 30 Jan 2011 19:32:51 +0100 |
User-agent: |
Gnus/5.110011 (No Gnus v0.11) Emacs/23.2.92 (gnu/linux) |
Thierry Volpiatto <address@hidden> writes:
> Michael Albinus <address@hidden> writes:
>
>> Thierry Volpiatto <address@hidden> writes:
>>
>>>> Ah! yes didn't notice it create a third /test nested in the second one.
>>> Can you try this one now (interactively and not):
>>> It should work.
>>
>> I doesn't.
> Sorry, this one work now interactively and not.
Just a little error remaining when answering no for recursive copy of
dir.
It is now fixed, will send in next patch.
> ---
> lisp/files.el | 98
> ++++++++++++++++++++++++++++++++-------------------------
> 1 files changed, 55 insertions(+), 43 deletions(-)
>
> diff --git a/lisp/files.el b/lisp/files.el
> index 4659742..464f00a 100644
> --- a/lisp/files.el
> +++ b/lisp/files.el
> @@ -4723,6 +4723,7 @@ 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 parents)
> "Copy DIRECTORY to NEWNAME. Both args must be strings.
> If NEWNAME names an existing directory, copy DIRECTORY as subdirectory there.
> @@ -4748,50 +4749,61 @@ this happens by default."
> current-prefix-arg 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)
> - (find-file-name-handler newname 'copy-directory))))
> + (let ((handler (or (find-file-name-handler directory 'copy-directory)
> + (find-file-name-handler newname 'copy-directory)))
> + (dir-files (directory-files directory 'full
> directory-files-no-dot-files-regexp)))
> (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)))
> -
> - (if (not (file-directory-p newname))
> - ;; If NEWNAME is not an existing directory, create it; that
> - ;; is where we will copy the files of DIRECTORY.
> - (make-directory newname parents)
> - ;; If NEWNAME is an existing directory, we will copy into
> - ;; NEWNAME/[DIRECTORY-BASENAME].
> - (setq newname (expand-file-name
> - (file-name-nondirectory
> - (directory-file-name directory))
> - newname))
> - (if (and (file-exists-p newname)
> - (not (file-directory-p newname)))
> - (error "Cannot overwrite non-directory %s with a directory"
> - newname))
> - (make-directory newname t))
> -
> - ;; 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 target 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))
> - (if keep-time
> - (set-file-times newname (nth 5 (file-attributes directory)))))))
> + (funcall handler 'copy-directory directory newname keep-time parents)
> + ;; Else Compute target name.
> + (setq directory (directory-file-name (expand-file-name directory)))
> + (setq newname (directory-file-name
> + (if (file-directory-p newname)
> + (expand-file-name
> + (file-relative-name
> + directory (file-name-directory directory))
> + newname)
> + newname)))
> + (if (file-directory-p newname)
> + (if (interactive-p)
> + (if (y-or-n-p (format "Directory `%s' exists, overwrite? "
> + newname))
> + (progn
> + (delete-directory newname t)
> + (make-directory newname 'parents))
> + (error "Abort copying directory"))
> + (delete-directory newname t)
> + (make-directory newname 'parents))
> + (if (file-exists-p newname)
> + (error "Cannot overwrite non-directory %s with a directory"
> + newname)
> + (make-directory newname 'parents)))
> +
> + (when (> (length dir-files) 0)
> + (let ((allow-recurse (or (and (interactive-p)
> + (y-or-n-p
> + (format "Recursive copies of `%s'? "
> + directory)))
> + t))) ; always allow recursive copy in
> non--interactive calls.
> + (when allow-recurse
> + ;; 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 target keep-time parents))
> + ((stringp (car attrs)) ; Symbolic link
> + (make-symbolic-link (car attrs) target t))
> + (t
> + (copy-file file target t keep-time)))))
> + dir-files))))
> +
> + ;; Set directory attributes.
> + (set-file-modes newname (file-modes directory))
> + (when keep-time
> + (set-file-times newname (nth 5 (file-attributes directory)))))))
> +
>
> (put 'revert-buffer-function 'permanent-local t)
> (defvar revert-buffer-function nil
--
A+ Thierry
Get my Gnupg key:
gpg --keyserver pgp.mit.edu --recv-keys 59F29997
- Re: bug in copy-directory, (continued)
- Re: bug in copy-directory, Michael Albinus, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Michael Albinus, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Michael Albinus, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory,
Thierry Volpiatto <=
- Re: bug in copy-directory, Michael Albinus, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Thierry Volpiatto, 2011/01/30
- Re: bug in copy-directory, Chong Yidong, 2011/01/31