[Emacs-diffs] emacs/lisp/net tramp-compat.el

[Michael Albinus]

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Michael Albinus <albinus>       09/11/07 23:51:17

Modified files:
        lisp/net       : tramp-compat.el 

Log message:
        * net/tramp-compat.el (tramp-compat-copy-directory)
        (tramp-compat-delete-directory): New defuns.

CVSWeb URLs:
http://cvs.savannah.gnu.org/viewcvs/emacs/lisp/net/tramp-compat.el?cvsroot=emacs&r1=1.17&r2=1.18

Patches:
Index: tramp-compat.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/net/tramp-compat.el,v
retrieving revision 1.17
retrieving revision 1.18
diff -u -b -r1.17 -r1.18
--- tramp-compat.el     6 Oct 2009 19:52:20 -0000       1.17
+++ tramp-compat.el     7 Nov 2009 23:51:17 -0000       1.18
@@ -251,6 +251,48 @@
        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 @@
        (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)