[Emacs-diffs] trunk r114832: * net/tramp-sh.el (tramp-sh-handle-copy-directory):

[Michael Albinus]

------------------------------------------------------------
revno: 114832
revision-id: address@hidden
parent: address@hidden
committer: Michael Albinus <address@hidden>
branch nick: trunk
timestamp: Mon 2013-10-28 20:30:40 +0100
message:
  * net/tramp-sh.el (tramp-sh-handle-copy-directory):
  * net/tramp-smb.el (tramp-smb-handle-copy-directory):
  Handle COPY-CONTENTS.  (Bug#15737)
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/tramp-sh.el           trampsh.el-20100913133439-a1faifh29eqoi4nh-1
  lisp/net/tramp-smb.el          
trampsmb.el-20091113204419-o5vbwnq5f7feedwu-2515

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-10-28 08:04:48 +0000
+++ b/lisp/ChangeLog    2013-10-28 19:30:40 +0000
@@ -1,3 +1,9 @@
+2013-10-28  Michael Albinus  <address@hidden>
+
+       * 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  <address@hidden>
 
        * epa-file.el

=== modified file 'lisp/net/tramp-sh.el'
--- a/lisp/net/tramp-sh.el      2013-10-17 19:39:22 +0000
+++ b/lisp/net/tramp-sh.el      2013-10-28 19:30:40 +0000
@@ -1831,18 +1831,20 @@
      '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 @@
             '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

=== modified file 'lisp/net/tramp-smb.el'
--- a/lisp/net/tramp-smb.el     2013-10-18 10:22:02 +0000
+++ b/lisp/net/tramp-smb.el     2013-10-28 19:30:40 +0000
@@ -387,141 +387,150 @@
        (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