comparison lisp/net/tramp-compat.el @ 84985:f7642749252b

* net/tramp-compat.el: New file. * net/tramp.el: * net/tramp-fish.el: * net/tramp-smb.el: * net/tramp-uu.el: * net/trampver.el: Move compatibility code to tramp-compat.el. Apply `mapc' instead of `mapcar' when the code needs side effects only. Move utf-8 coding cookie to the second line.
author Michael Albinus <michael.albinus@gmx.de>
date Sun, 30 Sep 2007 16:43:07 +0000
parents
children 5a1966aded2d
comparison
equal deleted inserted replaced
84984:8aa48ea4b5cb 84985:f7642749252b
1 ;;; tramp-gw.el --- Tramp compatibility functions
2
3 ;; Copyright (C) 2007 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, or (at your option)
13 ;; 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; see the file COPYING. If not, see
22 ;; <http://www.gnu.org/licenses/>.
23
24 ;;; Commentary:
25
26 ;; Tramp's main Emacs version for development is GNU Emacs 23. This
27 ;; package provides compatibility functions for GNU Emacs 21, GNU
28 ;; Emacs 22 and XEmacs 21.4+.
29
30 ;;; Code:
31
32 ;; Pacify byte-compiler
33 (eval-when-compile
34 (require 'cl)
35 (require 'custom))
36
37 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
38 ;; Currently, XEmacs supports this.
39 ;(eval-when-compile
40 ; (when (featurep 'xemacs)
41 ; (byte-compiler-options (warnings (- unused-vars)))))
42
43 ;; `last-coding-system-used' is unknown in XEmacs.
44 (eval-when-compile
45 (unless (boundp 'last-coding-system-used)
46 (defvar last-coding-system-used nil)))
47
48 ;; `directory-sep-char' is an obsolete variable in Emacs. But it is
49 ;; used in XEmacs, so we set it here and there. The following is needed
50 ;; to pacify Emacs byte-compiler.
51 (eval-when-compile
52 (unless (boundp 'byte-compile-not-obsolete-var)
53 (defvar byte-compile-not-obsolete-var nil))
54 (setq byte-compile-not-obsolete-var 'directory-sep-char))
55
56 ;; `with-temp-message' does not exists in XEmacs.
57 (eval-and-compile
58 (condition-case nil
59 (with-temp-message (current-message) nil)
60 (error (defmacro with-temp-message (message &rest body) `(progn ,@body)))))
61
62 ;; `set-buffer-multibyte' comes from Emacs Leim.
63 (eval-and-compile
64 (unless (fboundp 'set-buffer-multibyte)
65 (defalias 'set-buffer-multibyte 'ignore)))
66
67 ;; `font-lock-add-keywords' does not exist in XEmacs.
68 (eval-and-compile
69 (unless (fboundp 'font-lock-add-keywords)
70 (defalias 'font-lock-add-keywords 'ignore)))
71
72 (defsubst tramp-compat-line-end-position ()
73 "Return point at end of line (compat function).
74 Calls `line-end-position' or `point-at-eol' if defined, else
75 own implementation."
76 (cond
77 ((fboundp 'line-end-position) (funcall (symbol-function 'line-end-position)))
78 ((fboundp 'point-at-eol) (funcall (symbol-function 'point-at-eol)))
79 (t (save-excursion (end-of-line) (point)))))
80
81 (defsubst tramp-compat-temporary-file-directory ()
82 "Return name of directory for temporary files (compat function).
83 For Emacs, this is the variable `temporary-file-directory', for XEmacs
84 this is the function `temp-directory'."
85 (cond
86 ((boundp 'temporary-file-directory)
87 (symbol-value 'temporary-file-directory))
88 ((fboundp 'temp-directory)
89 (funcall (symbol-function 'temp-directory))) ;pacify byte-compiler
90 ((let ((d (getenv "TEMP"))) (and d (file-directory-p d)))
91 (file-name-as-directory (getenv "TEMP")))
92 ((let ((d (getenv "TMP"))) (and d (file-directory-p d)))
93 (file-name-as-directory (getenv "TMP")))
94 ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d)))
95 (file-name-as-directory (getenv "TMPDIR")))
96 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
97 (t (message (concat "Neither `temporary-file-directory' nor "
98 "`temp-directory' is defined -- using /tmp."))
99 (file-name-as-directory "/tmp"))))
100
101 ;; `most-positive-fixnum' arrived in Emacs 22.
102 (defsubst tramp-compat-most-positive-fixnum ()
103 "Return largest positive integer value (compat function)."
104 (cond ((boundp 'most-positive-fixnum)
105 (symbol-value 'most-positive-fixnum))
106 (t 134217727)))
107
108 ;; ID-FORMAT exists since Emacs 22.
109 (defun tramp-compat-file-attributes (filename &optional id-format)
110 "Like `file-attributes' for Tramp files (compat function)."
111 (cond
112 ((or (null id-format) (eq id-format 'integer))
113 (file-attributes filename))
114 ((file-remote-p filename)
115 (funcall (symbol-function 'tramp-handle-file-attributes)
116 filename id-format))
117 (t (condition-case nil
118 (funcall (symbol-function 'file-attributes) filename id-format)
119 (error (file-attributes filename))))))
120
121 ;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
122 ;; hurt to ignore it for other (X)Emacs versions.
123 (defun tramp-compat-copy-file
124 (filename newname &optional ok-if-already-exists keep-date preserve-uid-gid)
125 "Like `copy-file' for Tramp files (compat function)."
126 (if preserve-uid-gid
127 (funcall
128 (symbol-function 'copy-file)
129 filename newname ok-if-already-exists keep-date preserve-uid-gid)
130 (copy-file filename newname ok-if-already-exists keep-date)))
131
132 ;; `copy-tree' is introduced with Emacs 22. We've adapted the
133 ;; implementation from Emacs 23.
134 (defun tramp-compat-copy-tree (tree)
135 "Make a copy of TREE (compat function)."
136 (if (functionp 'copy-tree)
137 (funcall (symbol-function 'copy-tree) tree)
138 (let (result)
139 (while (consp tree)
140 (let ((newcar (car tree)))
141 (if (consp (car tree))
142 (setq newcar (tramp-compat-copy-tree (car tree))))
143 (push newcar result))
144 (setq tree (cdr tree)))
145 (nconc (nreverse result) tree))))
146
147 (eval-and-compile
148 (unless (fboundp 'file-remote-p)
149 (defalias 'file-remote-p 'tramp-handle-file-remote-p))
150
151 (unless (fboundp 'process-file)
152 (defalias 'process-file 'tramp-handle-process-file))
153
154 (unless (fboundp 'start-file-process)
155 (defalias 'start-file-process 'tramp-handle-start-file-process))
156
157 (unless (fboundp 'set-file-times)
158 (defalias 'set-file-times 'tramp-handle-set-file-times)))
159
160 (provide 'tramp-compat)
161
162 ;;; TODO:
163
164 ;;; tramp-compat.el ends here