Re: bug in copy-directory

[Thierry Volpiatto]

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