* net/tramp-sh.el (tramp-sh-handle-copy-directory):

* net/tramp-smb.el (tramp-smb-handle-copy-directory):
Handle COPY-CONTENTS.  (Bug#15737)

3 files changed, 158 insertions, 138 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index aac29e86ad6..34ac8ffd5e5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2013-10-28  Michael Albinus  <michael.albinus@gmx.de>
+
+        * net/tramp-sh.el (tramp-sh-handle-copy-directory):
+        * net/tramp-smb.el (tramp-smb-handle-copy-directory):
+        Handle COPY-CONTENTS.  (Bug#15737)
+
 2013-10-28  Daiki Ueno  <ueno@gnu.org>
 
         * epa-file.el
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 147113ba5a1..f69859ddb10 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -1831,18 +1831,20 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
      'copy-file (list filename newname ok-if-already-exists keep-date)))))
 
 (defun tramp-sh-handle-copy-directory
-  (dirname newname &optional keep-date parents _copy-contents)
+  (dirname newname &optional keep-date parents copy-contents)
   "Like `copy-directory' for Tramp files."
   (let ((t1 (tramp-tramp-file-p dirname))
         (t2 (tramp-tramp-file-p newname)))
     (with-parsed-tramp-file-name (if t1 dirname newname) nil
-      (if (and (tramp-get-method-parameter method 'tramp-copy-recursive)
+      (if (and (not copy-contents)
+               (tramp-get-method-parameter method 'tramp-copy-recursive)
                ;; When DIRNAME and NEWNAME are remote, they must have
                ;; the same method.
                (or (null t1) (null t2)
                    (string-equal
                     (tramp-file-name-method (tramp-dissect-file-name dirname))
-                    (tramp-file-name-method (tramp-dissect-file-name newname)))))
+                    (tramp-file-name-method
+                     (tramp-dissect-file-name newname)))))
           ;; scp or rsync DTRT.
           (progn
             (setq dirname (directory-file-name (expand-file-name dirname))
@@ -1859,7 +1861,10 @@ tramp-sh-handle-file-name-all-completions: internal error accessing `%s': `%s'"
              'copy dirname newname keep-date))
         ;; We must do it file-wise.
         (tramp-run-real-handler
-         'copy-directory (list dirname newname keep-date parents)))
+         'copy-directory
+         (if copy-contents
+             (list dirname newname keep-date parents copy-contents)
+           (list dirname newname keep-date parents))))
 
       ;; When newname did exist, we have wrong cached values.
       (when t2
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index fe7097edbde..4f294050bb9 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -387,141 +387,150 @@ pass to the OPERATION."
         (throw 'tramp-action 'ok)))))
 
 (defun tramp-smb-handle-copy-directory
-  (dirname newname &optional keep-date parents _copy-contents)
+  (dirname newname &optional keep-date parents copy-contents)
   "Like `copy-directory' for Tramp files."
-  (setq dirname (expand-file-name dirname)
-        newname (expand-file-name newname))
-  (let ((t1 (tramp-tramp-file-p dirname))
-        (t2 (tramp-tramp-file-p newname)))
-    (with-parsed-tramp-file-name (if t1 dirname newname) nil
-      (with-tramp-progress-reporter
-          v 0 (format "Copying %s to %s" dirname newname)
-      (cond
-       ;; We must use a local temporary directory.
-       ((and t1 t2)
-        (let ((tmpdir
-               (make-temp-name
-                (expand-file-name
-                 tramp-temp-name-prefix
-                 (tramp-compat-temporary-file-directory)))))
-          (unwind-protect
-              (progn
-                (tramp-compat-copy-directory dirname tmpdir keep-date parents)
-                (tramp-compat-copy-directory tmpdir newname keep-date parents))
-            (tramp-compat-delete-directory tmpdir 'recursive))))
-
-       ;; We can copy recursively.
-       ((or t1 t2)
-        (when (and (file-directory-p newname)
-                   (not (string-equal (file-name-nondirectory dirname)
-                                      (file-name-nondirectory newname))))
-          (setq newname
-                (expand-file-name
-                 (file-name-nondirectory dirname) newname))
-          (if t2 (setq v (tramp-dissect-file-name newname))))
-        (if (not (file-directory-p newname))
-            (make-directory newname parents))
-
-        (setq tramp-current-method (tramp-file-name-method v)
-              tramp-current-user (tramp-file-name-user v)
-              tramp-current-host (tramp-file-name-real-host v))
-
-        (let* ((real-user (tramp-file-name-real-user v))
-               (real-host (tramp-file-name-real-host v))
-               (domain    (tramp-file-name-domain v))
-               (port      (tramp-file-name-port v))
-               (share     (tramp-smb-get-share v))
-               (localname (file-name-as-directory
-                           (tramp-compat-replace-regexp-in-string
-                            "\\\\" "/" (tramp-smb-get-localname v))))
-               (tmpdir    (make-temp-name
-                           (expand-file-name
-                            tramp-temp-name-prefix
-                            (tramp-compat-temporary-file-directory))))
-               (args      (list tramp-smb-program
-                                (concat "//" real-host "/" share) "-E")))
-
-          (if (not (zerop (length real-user)))
-              (setq args (append args (list "-U" real-user)))
-            (setq args (append args (list "-N"))))
-
-          (when domain (setq args (append args (list "-W" domain))))
-          (when port   (setq args (append args (list "-p" port))))
-          (when tramp-smb-conf
-            (setq args (append args (list "-s" tramp-smb-conf))))
-          (setq args
-                (if t1
-                    ;; Source is remote.
-                    (append args
-                            (list "-D" (shell-quote-argument localname)
-                                  "-c" (shell-quote-argument "tar qc - *")
-                                  "|" "tar" "xfC" "-"
-                                  (shell-quote-argument tmpdir)))
-                  ;; Target is remote.
-                  (append (list "tar" "cfC" "-" (shell-quote-argument dirname)
-                                "." "|")
-                          args
-                          (list "-D" (shell-quote-argument localname)
-                                "-c" (shell-quote-argument "tar qx -")))))
-
-          (unwind-protect
-              (with-temp-buffer
-                ;; Set the transfer process properties.
-                (tramp-set-connection-property
-                 v "process-name" (buffer-name (current-buffer)))
-                (tramp-set-connection-property
-                 v "process-buffer" (current-buffer))
-
-                (when t1
-                  ;; The smbclient tar command creates always complete
-                  ;; paths.  We must emulate the directory structure,
-                  ;; and symlink to the real target.
-                  (make-directory
-                   (expand-file-name ".." (concat tmpdir localname)) 'parents)
-                  (make-symbolic-link
-                   newname (directory-file-name (concat tmpdir localname))))
-
-                ;; Use an asynchronous processes.  By this, password
-                ;; can be handled.
-                (let* ((default-directory tmpdir)
-                       (p (start-process-shell-command
-                           (tramp-get-connection-name v)
-                           (tramp-get-connection-buffer v)
-                           (mapconcat 'identity args " "))))
-
-                  (tramp-message
-                   v 6 "%s" (mapconcat 'identity (process-command p) " "))
-                  (tramp-set-connection-property p "vector" v)
-                  (tramp-compat-set-process-query-on-exit-flag p nil)
-                  (tramp-process-actions p v nil tramp-smb-actions-with-tar)
-
-                  (while (memq (process-status p) '(run open))
-                    (sit-for 0.1))
-                  (tramp-message v 6 "\n%s" (buffer-string))))
-
-            ;; Reset the transfer process properties.
-            (tramp-set-connection-property v "process-name" nil)
-            (tramp-set-connection-property v "process-buffer" nil)
-            (when t1 (delete-directory tmpdir 'recurse))))
-
-        ;; Handle KEEP-DATE argument.
-        (when keep-date
-          (set-file-times newname (nth 5 (file-attributes dirname))))
-
-        ;; Set the mode.
-        (unless keep-date
-          (set-file-modes newname (tramp-default-file-modes dirname)))
-
-        ;; When newname did exist, we have wrong cached values.
-        (when t2
-          (with-parsed-tramp-file-name newname nil
-            (tramp-flush-file-property v (file-name-directory localname))
-            (tramp-flush-file-property v localname))))
-
-       ;; We must do it file-wise.
-       (t
-        (tramp-run-real-handler
-         'copy-directory (list dirname newname keep-date parents))))))))
+  (if copy-contents
+      ;; We must do it file-wise.
+      (tramp-run-real-handler
+       'copy-directory (list dirname newname keep-date parents copy-contents))
+
+    (setq dirname (expand-file-name dirname)
+          newname (expand-file-name newname))
+    (let ((t1 (tramp-tramp-file-p dirname))
+          (t2 (tramp-tramp-file-p newname)))
+      (with-parsed-tramp-file-name (if t1 dirname newname) nil
+        (with-tramp-progress-reporter
+            v 0 (format "Copying %s to %s" dirname newname)
+          (cond
+           ;; We must use a local temporary directory.
+           ((and t1 t2)
+            (let ((tmpdir
+                   (make-temp-name
+                    (expand-file-name
+                     tramp-temp-name-prefix
+                     (tramp-compat-temporary-file-directory)))))
+              (unwind-protect
+                  (progn
+                    (tramp-compat-copy-directory
+                     dirname tmpdir keep-date parents)
+                    (tramp-compat-copy-directory
+                     tmpdir newname keep-date parents))
+                (tramp-compat-delete-directory tmpdir 'recursive))))
+
+           ;; We can copy recursively.
+           ((or t1 t2)
+            (when (and (file-directory-p newname)
+                       (not (string-equal (file-name-nondirectory dirname)
+                                          (file-name-nondirectory newname))))
+              (setq newname
+                    (expand-file-name
+                     (file-name-nondirectory dirname) newname))
+              (if t2 (setq v (tramp-dissect-file-name newname))))
+            (if (not (file-directory-p newname))
+                (make-directory newname parents))
+
+            (setq tramp-current-method (tramp-file-name-method v)
+                  tramp-current-user (tramp-file-name-user v)
+                  tramp-current-host (tramp-file-name-real-host v))
+
+            (let* ((real-user (tramp-file-name-real-user v))
+                   (real-host (tramp-file-name-real-host v))
+                   (domain    (tramp-file-name-domain v))
+                   (port      (tramp-file-name-port v))
+                   (share     (tramp-smb-get-share v))
+                   (localname (file-name-as-directory
+                               (tramp-compat-replace-regexp-in-string
+                                "\\\\" "/" (tramp-smb-get-localname v))))
+                   (tmpdir    (make-temp-name
+                               (expand-file-name
+                                tramp-temp-name-prefix
+                                (tramp-compat-temporary-file-directory))))
+                   (args      (list tramp-smb-program
+                                    (concat "//" real-host "/" share) "-E")))
+
+              (if (not (zerop (length real-user)))
+                  (setq args (append args (list "-U" real-user)))
+                (setq args (append args (list "-N"))))
+
+              (when domain (setq args (append args (list "-W" domain))))
+              (when port   (setq args (append args (list "-p" port))))
+              (when tramp-smb-conf
+                (setq args (append args (list "-s" tramp-smb-conf))))
+              (setq args
+                    (if t1
+                        ;; Source is remote.
+                        (append args
+                                (list "-D" (shell-quote-argument localname)
+                                      "-c" (shell-quote-argument "tar qc - *")
+                                      "|" "tar" "xfC" "-"
+                                      (shell-quote-argument tmpdir)))
+                      ;; Target is remote.
+                      (append (list "tar" "cfC" "-"
+                                    (shell-quote-argument dirname) "." "|")
+                              args
+                              (list "-D" (shell-quote-argument localname)
+                                    "-c" (shell-quote-argument "tar qx -")))))
+
+              (unwind-protect
+                  (with-temp-buffer
+                    ;; Set the transfer process properties.
+                    (tramp-set-connection-property
+                     v "process-name" (buffer-name (current-buffer)))
+                    (tramp-set-connection-property
+                     v "process-buffer" (current-buffer))
+
+                    (when t1
+                      ;; The smbclient tar command creates always
+                      ;; complete paths.  We must emulate the
+                      ;; directory structure, and symlink to the real
+                      ;; target.
+                      (make-directory
+                       (expand-file-name
+                        ".." (concat tmpdir localname)) 'parents)
+                      (make-symbolic-link
+                       newname (directory-file-name (concat tmpdir localname))))
+
+                    ;; Use an asynchronous processes.  By this,
+                    ;; password can be handled.
+                    (let* ((default-directory tmpdir)
+                           (p (start-process-shell-command
+                               (tramp-get-connection-name v)
+                               (tramp-get-connection-buffer v)
+                               (mapconcat 'identity args " "))))
+
+                      (tramp-message
+                       v 6 "%s" (mapconcat 'identity (process-command p) " "))
+                      (tramp-set-connection-property p "vector" v)
+                      (tramp-compat-set-process-query-on-exit-flag p nil)
+                      (tramp-process-actions p v nil tramp-smb-actions-with-tar)
+
+                      (while (memq (process-status p) '(run open))
+                        (sit-for 0.1))
+                      (tramp-message v 6 "\n%s" (buffer-string))))
+
+                ;; Reset the transfer process properties.
+                (tramp-set-connection-property v "process-name" nil)
+                (tramp-set-connection-property v "process-buffer" nil)
+                (when t1 (delete-directory tmpdir 'recurse))))
+
+            ;; Handle KEEP-DATE argument.
+            (when keep-date
+              (set-file-times newname (nth 5 (file-attributes dirname))))
+
+            ;; Set the mode.
+            (unless keep-date
+              (set-file-modes newname (tramp-default-file-modes dirname)))
+
+            ;; When newname did exist, we have wrong cached values.
+            (when t2
+              (with-parsed-tramp-file-name newname nil
+                (tramp-flush-file-property v (file-name-directory localname))
+                (tramp-flush-file-property v localname))))
+
+           ;; We must do it file-wise.
+           (t
+            (tramp-run-real-handler
+             'copy-directory (list dirname newname keep-date parents)))))))))
 
 (defun tramp-smb-handle-copy-file
   (filename newname &optional ok-if-already-exists keep-date