;;; tramp-compat.el --- Tramp compatibility functions
-;; Copyright (C) 2007-2011 Free Software Foundation, Inc.
+;; Copyright (C) 2007-2013 Free Software Foundation, Inc.
;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
;;; Commentary:
-;; Tramp's main Emacs version for development is GNU Emacs 24. This
-;; package provides compatibility functions for GNU Emacs 22, GNU
-;; Emacs 23 and XEmacs 21.4+.
+;; Tramp's main Emacs version for development is Emacs 24. This
+;; package provides compatibility functions for Emacs 22, Emacs 23,
+;; XEmacs 21.4+ and SXEmacs 22.
;;; Code:
-(require 'tramp-loaddefs)
-
(eval-when-compile
;; Pacify byte-compiler.
(eval-and-compile
+ ;; Some packages must be required for XEmacs, because we compile
+ ;; with -no-autoloads.
+ (when (featurep 'xemacs)
+ (require 'cus-edit)
+ (require 'env)
+ (require 'executable)
+ (require 'outline)
+ (require 'passwd)
+ (require 'pp)
+ (require 'regexp-opt))
+
(require 'advice)
(require 'custom)
(require 'format-spec)
+ (require 'shell)
+
+ (require 'tramp-loaddefs)
;; As long as password.el is not part of (X)Emacs, it shouldn't be
;; mandatory.
(require 'timer-funcs)
(require 'timer))
- ;; We check whether `start-file-process' is bound.
- (unless (fboundp 'start-file-process)
-
- ;; tramp-util offers integration into other (X)Emacs packages like
- ;; compile.el, gud.el etc. Not necessary in Emacs 23.
- (eval-after-load "tramp"
- '(require 'tramp-util))
-
- ;; Make sure that we get integration with the VC package. When it
- ;; is loaded, we need to pull in the integration module. Not
- ;; necessary in Emacs 23.
- (eval-after-load "vc"
- (eval-after-load "tramp"
- '(require 'tramp-vc))))
-
;; Avoid byte-compiler warnings if the byte-compiler supports this.
;; Currently, XEmacs supports this.
(when (featurep 'xemacs)
;; mechanism.
;; `file-remote-p' has been introduced with Emacs 22. The version
- ;; of XEmacs is not a magic file name function (yet); this is
- ;; corrected in tramp-util.el. Here it is sufficient if the
- ;; function exists.
+ ;; of XEmacs is not a magic file name function (yet).
(unless (fboundp 'file-remote-p)
(defalias 'file-remote-p
(lambda (file &optional identification connected)
(when (tramp-tramp-file-p file)
- (tramp-file-name-handler
+ (tramp-compat-funcall
+ 'tramp-file-name-handler
'file-remote-p file identification connected)))))
;; `process-file' does not exist in XEmacs.
(defalias 'set-file-times
(lambda (filename &optional time)
(when (tramp-tramp-file-p filename)
- (tramp-file-name-handler
- 'set-file-times filename time)))))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler '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
"Display MESSAGE temporarily if non-nil while BODY is evaluated."
`(progn ,@body)))
+;; `condition-case-unless-debug' is introduced with Emacs 24.
+(if (fboundp 'condition-case-unless-debug)
+ (defalias 'tramp-compat-condition-case-unless-debug
+ 'condition-case-unless-debug)
+ (defmacro tramp-compat-condition-case-unless-debug
+ (var bodyform &rest handlers)
+ "Like `condition-case' except that it does not catch anything when debugging."
+ (declare (debug condition-case) (indent 2))
+ (let ((bodysym (make-symbol "body")))
+ `(let ((,bodysym (lambda () ,bodyform)))
+ (if debug-on-error
+ (funcall ,bodysym)
+ (condition-case ,var
+ (funcall ,bodysym)
+ ,@handlers))))))
+
;; `font-lock-add-keywords' does not exist in XEmacs.
(defun tramp-compat-font-lock-add-keywords (mode keywords &optional how)
"Add highlighting KEYWORDS for MODE."
"Return name of directory for temporary files (compat function).
For Emacs, this is the variable `temporary-file-directory', for XEmacs
this is the function `temp-directory'."
- (cond
- ((boundp 'temporary-file-directory) (symbol-value 'temporary-file-directory))
- ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
- ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TEMP")))
- ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMP")))
- ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
- (file-name-as-directory (getenv "TMPDIR")))
- ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
- (t (message (concat "Neither `temporary-file-directory' nor "
- "`temp-directory' is defined -- using /tmp."))
- (file-name-as-directory "/tmp"))))
+ (let (file-name-handler-alist)
+ ;; We must return a local directory. If it is remote, we could
+ ;; run into an infloop.
+ (cond
+ ((and (boundp 'temporary-file-directory)
+ (eval (car (get 'temporary-file-directory 'standard-value)))))
+ ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory))
+ ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TEMP")))
+ ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMP")))
+ ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
+ (file-name-as-directory (getenv "TMPDIR")))
+ ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
+ (t (message (concat "Neither `temporary-file-directory' nor "
+ "`temp-directory' is defined -- using /tmp."))
+ (file-name-as-directory "/tmp")))))
;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
;; implementation with `make-temp-name', creating the temporary file
((or (null id-format) (eq id-format 'integer))
(file-attributes filename))
((tramp-tramp-file-p filename)
- (tramp-file-name-handler 'file-attributes filename id-format))
+ (tramp-compat-funcall
+ 'tramp-file-name-handler 'file-attributes filename id-format))
(t (condition-case nil
(tramp-compat-funcall 'file-attributes filename id-format)
(wrong-number-of-arguments (file-attributes filename))))))
-;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
-;; hurt to ignore it for other (X)Emacs versions.
-;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.
+;; PRESERVE-UID-GID does not exist in XEmacs.
+;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
+;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
(defun tramp-compat-copy-file
(filename newname &optional ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context)
+ preserve-uid-gid preserve-extended-attributes)
"Like `copy-file' for Tramp files (compat function)."
(cond
- (preserve-selinux-context
+ (preserve-extended-attributes
(tramp-compat-funcall
'copy-file filename newname ok-if-already-exists keep-date
- preserve-uid-gid preserve-selinux-context))
+ preserve-uid-gid preserve-extended-attributes))
(preserve-uid-gid
(tramp-compat-funcall
'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)
+ (directory newname &optional keep-time parents copy-contents)
"Make a copy of DIRECTORY (compat function)."
- (if (fboundp 'copy-directory)
- (tramp-compat-funcall '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))))))))
+ (condition-case nil
+ (tramp-compat-funcall
+ 'copy-directory directory newname keep-time parents copy-contents)
+
+ ;; `copy-directory' is either not implemented, or it does not
+ ;; support the the COPY-CONTENTS flag. For the time being, we
+ ;; ignore COPY-CONTENTS as well.
+
+ (error
+ ;; 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)))))))))
;; TRASH has been introduced with Emacs 24.1.
(defun tramp-compat-delete-file (filename &optional trash)
(program &optional infile destination display &rest args)
"Calls `call-process' on the local host.
This is needed because for some Emacs flavors Tramp has
-defadviced `call-process' to behave like `process-file'. The
+defadvised `call-process' to behave like `process-file'. The
Lisp error raised when PROGRAM is nil is trapped also, returning 1."
(let ((default-directory
(if (file-remote-p default-directory)
(tramp-compat-funcall 'set-process-query-on-exit-flag process flag)
(tramp-compat-funcall 'process-kill-without-query process flag)))
-(add-hook 'tramp-unload-hook
- (lambda ()
- (unload-feature 'tramp-compat 'force)))
-
+;; There exist different implementations for this function.
(defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type)
"Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
EOL-TYPE can be one of `dos', `unix', or `mac'."
"`dos', `unix', or `mac'")))))
(t (error "Can't change EOL conversion -- is MULE missing?"))))
+(add-hook 'tramp-unload-hook
+ (lambda ()
+ (unload-feature 'tramp-compat 'force)))
+
(provide 'tramp-compat)
;;; TODO: