* net/tramp-compat.el (tramp-compat-copy-directory)

(tramp-compat-delete-directory): New defuns.

1 files changed, 49 insertions, 0 deletions

diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 57f23df94f3..266a3de0c70 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -251,6 +251,48 @@ Add the extension of FILENAME, if existing."
        filename newname ok-if-already-exists keep-date preserve-uid-gid)
     (copy-file filename newname ok-if-already-exists keep-date)))
 
+;; `copy-directory' is a new function in Emacs 23.2.  Implementation
+;; is taken from there.
+(defun tramp-compat-copy-directory
+  (directory newname &optional keep-time parents)
+  "Make a copy of DIRECTORY (compat function)."
+  (if (fboundp 'copy-directory)
+      (funcall
+       (symbol-function 'copy-directory) directory newname keep-time parents)
+
+    ;; 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))))
+      (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 (and (file-directory-p newname)
+                 (not (string-equal (file-name-nondirectory directory)
+                                    (file-name-nondirectory newname))))
+            (setq newname
+                  (expand-file-name
+                   (file-name-nondirectory directory) newname)))
+        (if (not (file-directory-p newname)) (make-directory newname parents))
+
+        ;; Copy recursively.
+        (mapc
+         (lambda (file)
+           (if (file-directory-p file)
+               (tramp-compat-copy-directory file newname keep-time parents)
+             (copy-file file newname t keep-time)))
+         ;; We do not want to delete "." and "..".
+         (directory-files
+          directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
+
+        ;; Set directory attributes.
+        (set-file-modes newname (file-modes directory))
+        (if keep-time
+            (set-file-times newname (nth 5 (file-attributes directory))))))))
+
 ;; `copy-tree' is a built-in function in XEmacs.  In Emacs 21, it is
 ;; an autoloaded function in cl-extra.el.  Since Emacs 22, it is part
 ;; of subr.el.  There are problems when autoloading, therefore we test
@@ -268,6 +310,13 @@ Add the extension of FILENAME, if existing."
         (setq tree (cdr tree)))
       (nconc (nreverse result) tree))))
 
+;; RECURSIVE has been introduced with Emacs 23.2.
+(defun tramp-compat-delete-directory (directory &optional recursive)
+  "Like `delete-directory' for Tramp files (compat function)."
+  (if recursive
+      (funcall (symbol-function 'delete-directory) directory recursive)
+    (delete-directory directory)))
+
 ;; `number-sequence' has been introduced in Emacs 22.  Implementation
 ;; is taken from Emacs 23.
 (defun tramp-compat-number-sequence (from &optional to inc)