;;; tramp-compat.el --- Tramp compatibility functions
-;; Copyright (C) 2007, 2008, 2009 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
(autoload 'tramp-tramp-file-p "tramp")
(autoload 'tramp-file-name-handler "tramp")
+ (autoload 'tramp-handle-file-remote-p "tramp")
;; tramp-util offers integration into other (X)Emacs packages like
;; compile.el, gud.el etc. Not necessary in Emacs 23.
(lambda (filename &optional time)
(when (tramp-tramp-file-p filename)
(tramp-file-name-handler
- 'set-file-times filename time))))))
+ 'set-file-times filename time)))))
+
+ ;; We currently use "[" and "]" in the filename format for IPv6
+ ;; hosts of GNU Emacs. This means, that Emacs wants to expand
+ ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
+ ;; because no expansion could be found. We detect this situation
+ ;; and do something really awful: we have `file-expand-wildcards'
+ ;; return the original filename if it can't expand anything. Let's
+ ;; just hope that this doesn't break anything else.
+ ;; It is not needed anymore since GNU Emacs 23.2.
+ (unless (or (featurep 'xemacs) (featurep 'files 'remote-wildcards))
+ (defadvice file-expand-wildcards
+ (around tramp-advice-file-expand-wildcards activate)
+ (let ((name (ad-get-arg 0)))
+ ;; If it's a Tramp file, look if wildcards need to be expanded
+ ;; at all.
+ (if (and
+ (tramp-tramp-file-p name)
+ (not (string-match
+ "[[*?]" (tramp-handle-file-remote-p name 'localname))))
+ (setq ad-return-value (list name))
+ ;; Otherwise, just run the original function.
+ ad-do-it)))
+ (add-hook
+ 'tramp-unload-hook
+ (lambda ()
+ (ad-remove-advice
+ 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
+ (ad-activate 'file-expand-wildcards)))))
(defsubst tramp-compat-line-beginning-position ()
"Return point at beginning of line (compat function).
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
(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)
(dolist (pid (funcall (symbol-function 'list-system-processes)) result)
(let ((attributes
(funcall (symbol-function 'process-attributes) pid)))
- (when
- (and (string-equal
- (cdr (assoc 'user attributes)) (user-login-name))
- ;; The returned command name could be truncated
- ;; to 15 characters. Therefore, we cannot check
- ;; for `string-equal'.
- (string-match
- (concat "^" (regexp-quote (cdr (assoc 'comm attributes))))
- process-name))
+ (when (and (string-equal
+ (cdr (assoc 'user attributes)) (user-login-name))
+ (let ((comm (cdr (assoc 'comm attributes))))
+ ;; The returned command name could be truncated
+ ;; to 15 characters. Therefore, we cannot check
+ ;; for `string-equal'.
+ (and comm (string-match
+ (concat "^" (regexp-quote comm))
+ process-name))))
(setq result t))))))
;; Fallback, if there is no Lisp support yet.
HCoop / bpt / emacs.git / blobdiff