Re: patch-copy-dir-with-stefan-changes

[Thierry Volpiatto]

Stefan Monnier <address@hidden> writes:

>> here another approach to fix copy-directory and dired.
>
> Looks good.
>
> I'm not sure how it can get away with removing dired-do-create-files
> without removing any call to it,
OOPS! Of course we need it! It wouldn't work without it.
I remove it in the patch by error, sorry.
Here it is:

---
 lisp/dired-aux.el |    5 +++++
 lisp/files.el     |   53 ++++++++++++++++++++++-------------------------------
 2 files changed, 27 insertions(+), 31 deletions(-)

diff --git a/lisp/dired-aux.el b/lisp/dired-aux.el
index 28b285f..7c991b7 100644
--- a/lisp/dired-aux.el
+++ b/lisp/dired-aux.el
@@ -1345,6 +1345,7 @@ Special value `always' suppresses confirmation."
        (when cons (setcar cons cur-dir))))))
 
 ;; The basic function for half a dozen variations on cp/mv/ln/ln -s.
+
 (defun dired-create-files (file-creator operation fn-list name-constructor
                                        &optional marker-char)
 
@@ -1403,6 +1404,8 @@ ESC or `q' to not overwrite any of the remaining files,
                   (cond  ((integerp marker-char) marker-char)
                          (marker-char (dired-file-marker from)) ; slow
                          (t nil))))
+            (when (and (file-directory-p from) (eq file-creator 
'dired-copy-file))
+              (setq to (file-name-directory to)))
             (condition-case err
                 (progn
                   (funcall file-creator from to dired-overwrite-confirmed)
@@ -1445,7 +1448,9 @@ ESC or `q' to not overwrite any of the remaining files,
       (message "%s: %s file%s"
               operation success-count (dired-plural-s success-count)))))
   (dired-move-to-filename))
+
 
+
 (defun dired-do-create-files (op-symbol file-creator operation arg
                                        &optional marker-char op1
                                        how-to)
diff --git a/lisp/files.el b/lisp/files.el
index 7ac88f8..d896020 100644
--- a/lisp/files.el
+++ b/lisp/files.el
@@ -4723,23 +4723,21 @@ 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-as-subdir)
+(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.
+
 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.
+A prefix arg makes KEEP-TIME non-nil.
 
-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."
+Noninteractively, the last argument PARENTS says whether to
+create parent directories if they don't exist.  Interactively,
+this happens by default."
   (interactive
    (let ((dir (read-directory-name
               "Copy directory: " default-directory default-directory t nil)))
@@ -4747,7 +4745,7 @@ When called interactively, copy into a subdirectory by 
default."
           (read-file-name
            (format "Copy directory %s to: " dir)
            default-directory default-directory nil nil)
-          current-prefix-arg t t)))
+          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)
@@ -4759,17 +4757,12 @@ When called interactively, copy into a subdirectory by 
default."
       (setq directory (directory-file-name (expand-file-name directory))
            newname   (directory-file-name (expand-file-name newname)))
 
-      (unless (file-directory-p directory)
-       (error "%s is not a directory" directory))
-
-      (cond
-       ((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))
-       (copy-as-subdir
-       ;; If NEWNAME is an existing directory, and we are copying as
-       ;; a subdirectory, the target is NEWNAME/[DIRECTORY-BASENAME].
+      (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))
@@ -4778,22 +4771,20 @@ When called interactively, copy into a subdirectory by 
default."
             (not (file-directory-p newname))
             (error "Cannot overwrite non-directory %s with a directory"
                    newname))
-       (make-directory newname t)))
+       (make-directory newname t))
 
       ;; Copy recursively.
       (dolist (file
               ;; We do not want to copy "." and "..".
               (directory-files directory 'full
                                directory-files-no-dot-files-regexp))
-       (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 nil))
-               ((stringp (car attrs)) ; Symbolic link
-                (make-symbolic-link (car attrs) target t))
-               (t
-                (copy-file file target t keep-time)))))
+       (if (file-directory-p file)
+           (copy-directory file newname keep-time parents)
+         (let ((target (expand-file-name (file-name-nondirectory file) 
newname))
+               (attrs (file-attributes file)))
+           (if (stringp (car attrs)) ; Symbolic link
+               (make-symbolic-link (car attrs) target t)
+             (copy-file file target t keep-time)))))
 
       ;; Set directory attributes.
       (set-file-modes newname (file-modes directory))

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