code.delx.au - gnu-emacs/blob - lisp/net/tramp-compat.el

   1 ;;; tramp-compat.el --- Tramp compatibility functions
   2
   3 ;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
   4
   5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
   6 ;; Keywords: comm, processes
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs is free software: you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation, either version 3 of the License, or
  13 ;; (at your option) any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Tramp's main Emacs version for development is GNU Emacs 23.  This
  26 ;; package provides compatibility functions for GNU Emacs 21, GNU
  27 ;; Emacs 22 and XEmacs 21.4+.
  28
  29 ;;; Code:
  30
  31 (eval-when-compile
  32
  33   ;; Pacify byte-compiler.
  34   (require 'cl))
  35
  36 (eval-and-compile
  37
  38   (require 'custom)
  39
  40   ;; Load the appropriate timer package.
  41   (if (featurep 'xemacs)
  42       (require 'timer-funcs)
  43     (require 'timer))
  44
  45   ;; tramp-util offers integration into other (X)Emacs packages like
  46   ;; compile.el, gud.el etc.  Not necessary in Emacs 23.
  47   (eval-after-load "tramp"
  48     ;; We check whether `start-file-process' is an alias.
  49     '(when (or (not (fboundp 'start-file-process))
  50                (symbolp (symbol-function 'start-file-process)))
  51        (require 'tramp-util)
  52        (add-hook 'tramp-unload-hook
  53                  '(lambda ()
  54                     (when (featurep 'tramp-util)
  55                       (unload-feature 'tramp-util 'force))))))
  56
  57   ;; Make sure that we get integration with the VC package.  When it
  58   ;; is loaded, we need to pull in the integration module.  Not
  59   ;; necessary in Emacs 23.
  60   (eval-after-load "vc"
  61     (eval-after-load "tramp"
  62       ;; We check whether `start-file-process' is an alias.
  63       '(when (or (not (fboundp 'start-file-process))
  64                  (symbolp (symbol-function 'start-file-process)))
  65          (require 'tramp-vc)
  66          (add-hook 'tramp-unload-hook
  67                    '(lambda ()
  68                       (when (featurep 'tramp-vc)
  69                         (unload-feature 'tramp-vc 'force)))))))
  70
  71   ;; Avoid byte-compiler warnings if the byte-compiler supports this.
  72   ;; Currently, XEmacs supports this.
  73   (when (featurep 'xemacs)
  74     (unless (boundp 'byte-compile-default-warnings)
  75       (defvar byte-compile-default-warnings nil))
  76     (delq 'unused-vars byte-compile-default-warnings))
  77
  78   ;; `last-coding-system-used' is unknown in XEmacs.
  79   (unless (boundp 'last-coding-system-used)
  80     (defvar last-coding-system-used nil))
  81
  82   ;; `directory-sep-char' is an obsolete variable in Emacs.  But it is
  83   ;; used in XEmacs, so we set it here and there.  The following is
  84   ;; needed to pacify Emacs byte-compiler.
  85   (unless (boundp 'byte-compile-not-obsolete-var)
  86     (defvar byte-compile-not-obsolete-var nil))
  87   (setq byte-compile-not-obsolete-var 'directory-sep-char)
  88
  89   ;; `with-temp-message' does not exists in XEmacs.
  90   (condition-case nil
  91       (with-temp-message (current-message) nil)
  92     (error (defmacro with-temp-message (message &rest body) `(progn ,@body))))
  93
  94   ;; `set-buffer-multibyte' comes from Emacs Leim.
  95   (unless (fboundp 'set-buffer-multibyte)
  96     (defalias 'set-buffer-multibyte 'ignore))
  97
  98   ;; `font-lock-add-keywords' does not exist in XEmacs.
  99   (unless (fboundp 'font-lock-add-keywords)
 100     (defalias 'font-lock-add-keywords 'ignore))
 101
 102   ;; `file-remote-p' has been introduced with Emacs 22.  The version
 103   ;; of XEmacs is not a magic file name function (yet); this is
 104   ;; corrected in tramp-util.el.  Here it is sufficient if the
 105   ;; function exists.
 106   (unless (fboundp 'file-remote-p)
 107     (defalias 'file-remote-p 'tramp-handle-file-remote-p))
 108
 109   ;; `process-file' exists since Emacs 22.
 110   (unless (fboundp 'process-file)
 111     (defalias 'process-file 'tramp-handle-process-file))
 112
 113   ;; `start-file-process' is new in Emacs 23.
 114   (unless (fboundp 'start-file-process)
 115     (defalias 'start-file-process 'tramp-handle-start-file-process))
 116
 117   ;; `set-file-times' is also new in Emacs 23.
 118   (unless (fboundp 'set-file-times)
 119     (defalias 'set-file-times 'tramp-handle-set-file-times)))
 120
 121 (defsubst tramp-compat-line-end-position ()
 122   "Return point at end of line (compat function).
 123 Calls `line-end-position' or `point-at-eol' if defined, else
 124 own implementation."
 125   (cond
 126    ((fboundp 'line-end-position) (funcall (symbol-function 'line-end-position)))
 127    ((fboundp 'point-at-eol)      (funcall (symbol-function 'point-at-eol)))
 128    (t (save-excursion (end-of-line) (point)))))
 129
 130 (defsubst tramp-compat-temporary-file-directory ()
 131   "Return name of directory for temporary files (compat function).
 132 For Emacs, this is the variable `temporary-file-directory', for XEmacs
 133 this is the function `temp-directory'."
 134   (cond
 135    ((boundp 'temporary-file-directory) (symbol-value 'temporary-file-directory))
 136    ((fboundp 'temp-directory) (funcall (symbol-function 'temp-directory)))
 137    ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
 138     (file-name-as-directory (getenv "TEMP")))
 139    ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
 140     (file-name-as-directory (getenv "TMP")))
 141    ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
 142     (file-name-as-directory (getenv "TMPDIR")))
 143    ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
 144    (t (message (concat "Neither `temporary-file-directory' nor "
 145                        "`temp-directory' is defined -- using /tmp."))
 146       (file-name-as-directory "/tmp"))))
 147
 148 ;; `make-temp-file' exists in Emacs only.  The third parameter SUFFIX
 149 ;; has been introduced with Emacs 22.  We try it, if it fails, we fall
 150 ;; back to `make-temp-name', creating the temporary file immediately
 151 ;; in order to avoid a security hole.
 152 (defsubst tramp-compat-make-temp-file (filename)
 153   "Create a temporary file (compat function).
 154 Add the extension of FILENAME, if existing."
 155   (let* (file-name-handler-alist
 156          (prefix (expand-file-name
 157                   (symbol-value 'tramp-temp-name-prefix)
 158                   (tramp-compat-temporary-file-directory)))
 159          (extension (file-name-extension filename t))
 160          result)
 161     (condition-case nil
 162         (setq result
 163               (funcall (symbol-function 'make-temp-file) prefix nil extension))
 164       (error
 165        ;; We use our own implementation, taken from files.el.
 166        (while
 167            (condition-case ()
 168                (progn
 169                  (setq result (concat (make-temp-name prefix) extension))
 170                  (write-region
 171                   "" nil result nil 'silent nil
 172                   ;; 7th parameter is MUSTBENEW in Emacs, and
 173                   ;; CODING-SYSTEM in XEmacs.  It is not a security
 174                   ;; hole in XEmacs if we cannot use this parameter,
 175                   ;; because XEmacs uses a user-specific subdirectory
 176                   ;; with 0700 permissions.
 177                   (when (not (featurep 'xemacs)) 'excl))
 178                  nil)
 179              (file-already-exists t))
 180          ;; The file was somehow created by someone else between
 181          ;; `make-temp-name' and `write-region', let's try again.
 182          nil)))
 183     result))
 184
 185 ;; `most-positive-fixnum' arrived in Emacs 22.  Before, and in XEmacs,
 186 ;; it is a fixed value.
 187 (defsubst tramp-compat-most-positive-fixnum ()
 188   "Return largest positive integer value (compat function)."
 189   (cond
 190    ((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum))
 191    ;; Default value in XEmacs and Emacs 21.
 192    (t 134217727)))
 193
 194 ;; ID-FORMAT exists since Emacs 22.
 195 (defun tramp-compat-file-attributes (filename &optional id-format)
 196   "Like `file-attributes' for Tramp files (compat function)."
 197   (cond
 198    ((or (null id-format) (eq id-format 'integer))
 199     (file-attributes filename))
 200    ;; FIXME: shouldn't that be tramp-file-p or somesuch?
 201    ((file-remote-p filename)
 202     (funcall (symbol-function 'tramp-handle-file-attributes)
 203              filename id-format))
 204    (t (condition-case nil
 205           (funcall (symbol-function 'file-attributes) filename id-format)
 206         (error (file-attributes filename))))))
 207
 208 ;; PRESERVE-UID-GID has been introduced with Emacs 23.  It does not
 209 ;; hurt to ignore it for other (X)Emacs versions.
 210 (defun tramp-compat-copy-file
 211   (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
 212   "Like `copy-file' for Tramp files (compat function)."
 213   (if preserve-uid-gid
 214       (funcall
 215        (symbol-function 'copy-file)
 216        filename newname ok-if-already-exists keep-date preserve-uid-gid)
 217     (copy-file filename newname ok-if-already-exists keep-date)))
 218
 219 ;; `copy-tree' is a built-in function in XEmacs.  In Emacs 21, it is
 220 ;; an autoloaded function in cl-extra.el.  Since Emacs 22, it is part
 221 ;; of subr.el.  There are problems when autoloading, therefore we test
 222 ;; for `subrp' and `symbol-file'.  Implementation is taken from Emacs23.
 223 (defun tramp-compat-copy-tree (tree)
 224   "Make a copy of TREE (compat function)."
 225   (if (or (subrp 'copy-tree) (symbol-file 'copy-tree))
 226       (funcall (symbol-function 'copy-tree) tree)
 227     (let (result)
 228       (while (consp tree)
 229         (let ((newcar (car tree)))
 230           (if (consp (car tree))
 231               (setq newcar (tramp-compat-copy-tree (car tree))))
 232           (push newcar result))
 233         (setq tree (cdr tree)))
 234       (nconc (nreverse result) tree))))
 235
 236 (provide 'tramp-compat)
 237
 238 ;;; TODO:
 239
 240 ;; arch-tag: 0e724b18-6699-4f87-ad96-640b272e5c85
 241 ;;; tramp-compat.el ends here