Line data Source code
1 : ;;; tramp-compat.el --- Tramp compatibility functions -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 : ;; Keywords: comm, processes
7 : ;; Package: tramp
8 :
9 : ;; This file is part of GNU Emacs.
10 :
11 : ;; GNU Emacs is free software: you can redistribute it and/or modify
12 : ;; it under the terms of the GNU General Public License as published by
13 : ;; the Free Software Foundation, either version 3 of the License, or
14 : ;; (at your option) any later version.
15 :
16 : ;; GNU Emacs is distributed in the hope that it will be useful,
17 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 : ;; GNU General Public License for more details.
20 :
21 : ;; You should have received a copy of the GNU General Public License
22 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 :
24 : ;;; Commentary:
25 :
26 : ;; Tramp's main Emacs version for development is Emacs 26. This
27 : ;; package provides compatibility functions for Emacs 24 and Emacs 25.
28 :
29 : ;;; Code:
30 :
31 : (require 'auth-source)
32 : (require 'advice)
33 : (require 'cl-lib)
34 : (require 'custom)
35 : (require 'format-spec)
36 : (require 'parse-time)
37 : (require 'password-cache)
38 : (require 'shell)
39 : (require 'timer)
40 : (require 'ucs-normalize)
41 :
42 : (require 'trampver)
43 : (require 'tramp-loaddefs)
44 :
45 : ;; For not existing functions, obsolete functions, or functions with a
46 : ;; changed argument list, there are compiler warnings. We want to
47 : ;; avoid them in cases we know what we do.
48 : (defmacro tramp-compat-funcall (function &rest arguments)
49 : "Call FUNCTION if it exists. Do not raise compiler warnings."
50 23 : `(when (functionp ,function)
51 23 : (with-no-warnings (funcall ,function ,@arguments))))
52 :
53 : ;; We currently use "[" and "]" in the filename format for IPv6 hosts
54 : ;; of GNU Emacs. This means that Emacs wants to expand wildcards if
55 : ;; `find-file-wildcards' is non-nil, and then barfs because no
56 : ;; expansion could be found. We detect this situation and do
57 : ;; something really awful: we have `file-expand-wildcards' return the
58 : ;; original filename if it can't expand anything. Let's just hope
59 : ;; that this doesn't break anything else. It is not needed anymore
60 : ;; since GNU Emacs 23.2.
61 : (unless (featurep 'files 'remote-wildcards)
62 : (defadvice file-expand-wildcards
63 : (around tramp-advice-file-expand-wildcards activate)
64 : (let ((name (ad-get-arg 0)))
65 : ;; If it's a Tramp file, look if wildcards need to be expanded
66 : ;; at all.
67 : (if (and
68 : (tramp-tramp-file-p name)
69 : (not (string-match "[[*?]" (file-remote-p name 'localname))))
70 : (setq ad-return-value (list name))
71 : ;; Otherwise, just run the original function.
72 : ad-do-it)))
73 : (add-hook
74 : 'tramp-unload-hook
75 : (lambda ()
76 : (ad-remove-advice
77 : 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
78 : (ad-activate 'file-expand-wildcards))))
79 :
80 : (defsubst tramp-compat-temporary-file-directory ()
81 : "Return name of directory for temporary files.
82 : It is the default value of `temporary-file-directory'."
83 : ;; We must return a local directory. If it is remote, we could run
84 : ;; into an infloop.
85 27169 : (eval (car (get 'temporary-file-directory 'standard-value))))
86 :
87 : (defsubst tramp-compat-make-temp-file (f &optional dir-flag)
88 : "Create a local temporary file (compat function).
89 : Add the extension of F, if existing."
90 675 : (let* (file-name-handler-alist
91 675 : (prefix (expand-file-name
92 675 : (symbol-value 'tramp-temp-name-prefix)
93 675 : (tramp-compat-temporary-file-directory)))
94 675 : (extension (file-name-extension f t)))
95 675 : (make-temp-file prefix dir-flag extension)))
96 :
97 : ;; `temporary-file-directory' as function is introduced with Emacs 26.1.
98 : (defalias 'tramp-compat-temporary-file-directory-function
99 : (if (fboundp 'temporary-file-directory)
100 : 'temporary-file-directory
101 : 'tramp-handle-temporary-file-directory))
102 :
103 : (defun tramp-compat-process-running-p (process-name)
104 : "Returns t if system process PROCESS-NAME is running for `user-login-name'."
105 0 : (when (stringp process-name)
106 0 : (cond
107 : ;; GNU Emacs 22 on w32.
108 0 : ((fboundp 'w32-window-exists-p)
109 0 : (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
110 :
111 : ;; GNU Emacs 23.
112 0 : ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
113 0 : (let (result)
114 0 : (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
115 0 : (let ((attributes (process-attributes pid)))
116 0 : (when (and (string-equal
117 0 : (cdr (assoc 'user attributes)) (user-login-name))
118 0 : (let ((comm (cdr (assoc 'comm attributes))))
119 : ;; The returned command name could be truncated
120 : ;; to 15 characters. Therefore, we cannot check
121 : ;; for `string-equal'.
122 0 : (and comm (string-match
123 0 : (concat "^" (regexp-quote comm))
124 0 : process-name))))
125 0 : (setq result t)))))))))
126 :
127 : ;; `user-error' has appeared in Emacs 24.3.
128 : (defsubst tramp-compat-user-error (vec-or-proc format &rest args)
129 : "Signal a pilot error."
130 2 : (apply
131 2 : 'tramp-error vec-or-proc
132 2 : (if (fboundp 'user-error) 'user-error 'error) format args))
133 :
134 : ;; `file-attribute-*' are introduced in Emacs 25.1.
135 :
136 : (if (fboundp 'file-attribute-type)
137 : (defalias 'tramp-compat-file-attribute-type 'file-attribute-type)
138 : (defsubst tramp-compat-file-attribute-type (attributes)
139 : "The type field in ATTRIBUTES returned by `file-attributes'.
140 : The value is either t for directory, string (name linked to) for
141 : symbolic link, or nil."
142 : (nth 0 attributes)))
143 :
144 : (if (fboundp 'file-attribute-link-number)
145 : (defalias 'tramp-compat-file-attribute-link-number
146 : 'file-attribute-link-number)
147 : (defsubst tramp-compat-file-attribute-link-number (attributes)
148 : "Return the number of links in ATTRIBUTES returned by `file-attributes'."
149 : (nth 1 attributes)))
150 :
151 : (if (fboundp 'file-attribute-user-id)
152 : (defalias 'tramp-compat-file-attribute-user-id 'file-attribute-user-id)
153 : (defsubst tramp-compat-file-attribute-user-id (attributes)
154 : "The UID field in ATTRIBUTES returned by `file-attributes'.
155 : This is either a string or a number. If a string value cannot be
156 : looked up, a numeric value, either an integer or a float, is
157 : returned."
158 : (nth 2 attributes)))
159 :
160 : (if (fboundp 'file-attribute-group-id)
161 : (defalias 'tramp-compat-file-attribute-group-id 'file-attribute-group-id)
162 : (defsubst tramp-compat-file-attribute-group-id (attributes)
163 : "The GID field in ATTRIBUTES returned by `file-attributes'.
164 : This is either a string or a number. If a string value cannot be
165 : looked up, a numeric value, either an integer or a float, is
166 : returned."
167 : (nth 3 attributes)))
168 :
169 : (if (fboundp 'file-attribute-modification-time)
170 : (defalias 'tramp-compat-file-attribute-modification-time
171 : 'file-attribute-modification-time)
172 : (defsubst tramp-compat-file-attribute-modification-time (attributes)
173 : "The modification time in ATTRIBUTES returned by `file-attributes'.
174 : This is the time of the last change to the file's contents, and
175 : is a list of integers (HIGH LOW USEC PSEC) in the same style
176 : as (current-time)."
177 : (nth 5 attributes)))
178 :
179 : (if (fboundp 'file-attribute-size)
180 : (defalias 'tramp-compat-file-attribute-size 'file-attribute-size)
181 : (defsubst tramp-compat-file-attribute-size (attributes)
182 : "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
183 : This is a floating point number if the size is too large for an integer."
184 : (nth 7 attributes)))
185 :
186 : (if (fboundp 'file-attribute-modes)
187 : (defalias 'tramp-compat-file-attribute-modes 'file-attribute-modes)
188 : (defsubst tramp-compat-file-attribute-modes (attributes)
189 : "The file modes in ATTRIBUTES returned by `file-attributes'.
190 : This is a string of ten letters or dashes as in ls -l."
191 : (nth 8 attributes)))
192 :
193 : ;; `default-toplevel-value' has been declared in Emacs 24.4.
194 : (unless (fboundp 'default-toplevel-value)
195 : (defalias 'default-toplevel-value 'symbol-value))
196 :
197 : ;; `format-message' is new in Emacs 25.1.
198 : (unless (fboundp 'format-message)
199 : (defalias 'format-message 'format))
200 :
201 : ;; `file-missing' is introduced in Emacs 26.1.
202 : (defconst tramp-file-missing
203 : (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
204 : "The error symbol for the `file-missing' error.")
205 :
206 : (add-hook 'tramp-unload-hook
207 : (lambda ()
208 : (unload-feature 'tramp-loaddefs 'force)
209 : (unload-feature 'tramp-compat 'force)))
210 :
211 : ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
212 : ;; introduced in Emacs 26.
213 : (eval-and-compile
214 : (if (fboundp 'file-name-quoted-p)
215 : (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p)
216 : (defsubst tramp-compat-file-name-quoted-p (name)
217 : "Whether NAME is quoted with prefix \"/:\".
218 : If NAME is a remote file name, check the local part of NAME."
219 : (string-match "^/:" (or (file-remote-p name 'localname) name))))
220 :
221 : (if (fboundp 'file-name-quote)
222 : (defalias 'tramp-compat-file-name-quote 'file-name-quote)
223 : (defsubst tramp-compat-file-name-quote (name)
224 : "Add the quotation prefix \"/:\" to file NAME.
225 : If NAME is a remote file name, the local part of NAME is quoted."
226 : (concat
227 : (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))
228 :
229 : (if (fboundp 'file-name-unquote)
230 : (defalias 'tramp-compat-file-name-unquote 'file-name-unquote)
231 : (defsubst tramp-compat-file-name-unquote (name)
232 : "Remove quotation prefix \"/:\" from file NAME.
233 : If NAME is a remote file name, the local part of NAME is unquoted."
234 : (save-match-data
235 : (let ((localname (or (file-remote-p name 'localname) name)))
236 : (when (tramp-compat-file-name-quoted-p localname)
237 : (setq
238 : localname
239 : (replace-match
240 : (if (= (length localname) 2) "/" "") nil t localname)))
241 : (concat (file-remote-p name) localname))))))
242 :
243 : ;; `tramp-syntax' has changed its meaning in Emacs 26. We still
244 : ;; support old settings.
245 : (defsubst tramp-compat-tramp-syntax ()
246 : "Return proper value of `tramp-syntax'."
247 22224892 : (cond ((eq tramp-syntax 'ftp) 'default)
248 22224892 : ((eq tramp-syntax 'sep) 'separate)
249 22224892 : (t tramp-syntax)))
250 :
251 : ;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
252 : (eval-after-load 'tramp
253 : '(unless
254 : (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
255 : (tramp-compat-funcall
256 : (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
257 :
258 : (provide 'tramp-compat)
259 :
260 : ;;; TODO:
261 :
262 : ;;; tramp-compat.el ends here
|