Commit | Line | Data |
---|---|---|
94be87e8 | 1 | ;;; tramp-compat.el --- Tramp compatibility functions |
9e6ab520 | 2 | |
ab422c4d | 3 | ;; Copyright (C) 2007-2013 Free Software Foundation, Inc. |
9e6ab520 MA |
4 | |
5 | ;; Author: Michael Albinus <michael.albinus@gmx.de> | |
6 | ;; Keywords: comm, processes | |
bd78fa1d | 7 | ;; Package: tramp |
9e6ab520 MA |
8 | |
9 | ;; This file is part of GNU Emacs. | |
10 | ||
874a927a | 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
9e6ab520 | 12 | ;; it under the terms of the GNU General Public License as published by |
874a927a GM |
13 | ;; the Free Software Foundation, either version 3 of the License, or |
14 | ;; (at your option) any later version. | |
9e6ab520 MA |
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 | |
874a927a | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
9e6ab520 MA |
23 | |
24 | ;;; Commentary: | |
25 | ||
1cdd2a1b MA |
26 | ;; Tramp's main Emacs version for development is Emacs 24. This |
27 | ;; package provides compatibility functions for Emacs 22, Emacs 23, | |
28 | ;; XEmacs 21.4+ and SXEmacs 22. | |
9e6ab520 MA |
29 | |
30 | ;;; Code: | |
31 | ||
b74f0d96 | 32 | ;; Pacify byte-compiler. |
9fa0d3aa | 33 | (eval-when-compile |
9fa0d3aa MA |
34 | (require 'cl)) |
35 | ||
36 | (eval-and-compile | |
37 | ||
957b3189 MA |
38 | ;; Some packages must be required for XEmacs, because we compile |
39 | ;; with -no-autoloads. | |
40 | (when (featurep 'xemacs) | |
41 | (require 'cus-edit) | |
42 | (require 'env) | |
43 | (require 'executable) | |
44 | (require 'outline) | |
45 | (require 'passwd) | |
46 | (require 'pp) | |
47 | (require 'regexp-opt)) | |
48 | ||
03c1ad43 | 49 | (require 'advice) |
94be87e8 | 50 | (require 'custom) |
03c1ad43 | 51 | (require 'format-spec) |
710dec63 | 52 | (require 'shell) |
03c1ad43 | 53 | |
61addbc2 | 54 | (require 'trampver) |
957b3189 MA |
55 | (require 'tramp-loaddefs) |
56 | ||
03c1ad43 MA |
57 | ;; As long as password.el is not part of (X)Emacs, it shouldn't be |
58 | ;; mandatory. | |
59 | (if (featurep 'xemacs) | |
60 | (load "password" 'noerror) | |
61 | (or (require 'password-cache nil 'noerror) | |
62 | (require 'password nil 'noerror))) ; Part of contrib. | |
63 | ||
64 | ;; auth-source is relatively new. | |
65 | (if (featurep 'xemacs) | |
66 | (load "auth-source" 'noerror) | |
67 | (require 'auth-source nil 'noerror)) | |
9e6ab520 | 68 | |
94be87e8 MA |
69 | ;; Load the appropriate timer package. |
70 | (if (featurep 'xemacs) | |
71 | (require 'timer-funcs) | |
72 | (require 'timer)) | |
9e6ab520 | 73 | |
94be87e8 MA |
74 | ;; Avoid byte-compiler warnings if the byte-compiler supports this. |
75 | ;; Currently, XEmacs supports this. | |
76 | (when (featurep 'xemacs) | |
77 | (unless (boundp 'byte-compile-default-warnings) | |
78 | (defvar byte-compile-default-warnings nil)) | |
79 | (delq 'unused-vars byte-compile-default-warnings)) | |
80 | ||
81 | ;; `last-coding-system-used' is unknown in XEmacs. | |
9e6ab520 | 82 | (unless (boundp 'last-coding-system-used) |
94be87e8 | 83 | (defvar last-coding-system-used nil)) |
9e6ab520 | 84 | |
94be87e8 MA |
85 | ;; `directory-sep-char' is an obsolete variable in Emacs. But it is |
86 | ;; used in XEmacs, so we set it here and there. The following is | |
87 | ;; needed to pacify Emacs byte-compiler. | |
77f38949 GM |
88 | ;; Note that it was removed altogether in Emacs 24.1. |
89 | (when (boundp 'directory-sep-char) | |
bd8fadca | 90 | (defvar byte-compile-not-obsolete-var nil) |
77f38949 GM |
91 | (setq byte-compile-not-obsolete-var 'directory-sep-char) |
92 | ;; Emacs 23.2. | |
bd8fadca | 93 | (defvar byte-compile-not-obsolete-vars nil) |
77f38949 | 94 | (setq byte-compile-not-obsolete-vars '(directory-sep-char))) |
9e6ab520 | 95 | |
4bc3c53d MA |
96 | ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1. |
97 | ;; Besides `t', `nil', and integer, we use also timestamps (as | |
98 | ;; returned by `current-time') internally. | |
f1f05871 MA |
99 | (unless (boundp 'remote-file-name-inhibit-cache) |
100 | (defvar remote-file-name-inhibit-cache nil)) | |
4bc3c53d | 101 | |
0d5852cf MA |
102 | ;; For not existing functions, or functions with a changed argument |
103 | ;; list, there are compiler warnings. We want to avoid them in | |
104 | ;; cases we know what we do. | |
105 | (defmacro tramp-compat-funcall (function &rest arguments) | |
106 | (if (featurep 'xemacs) | |
107 | `(funcall (symbol-function ,function) ,@arguments) | |
108 | `(when (or (subrp ,function) (functionp ,function)) | |
109 | (with-no-warnings (funcall ,function ,@arguments))))) | |
110 | ||
94be87e8 | 111 | ;; `set-buffer-multibyte' comes from Emacs Leim. |
9e6ab520 | 112 | (unless (fboundp 'set-buffer-multibyte) |
94be87e8 | 113 | (defalias 'set-buffer-multibyte 'ignore)) |
9e6ab520 | 114 | |
e5aa47f9 MA |
115 | ;; The following functions cannot be aliases of the corresponding |
116 | ;; `tramp-handle-*' functions, because this would bypass the locking | |
117 | ;; mechanism. | |
118 | ||
94be87e8 | 119 | ;; `file-remote-p' has been introduced with Emacs 22. The version |
5504e2c7 | 120 | ;; of XEmacs is not a magic file name function (yet). |
94be87e8 | 121 | (unless (fboundp 'file-remote-p) |
e5aa47f9 MA |
122 | (defalias 'file-remote-p |
123 | (lambda (file &optional identification connected) | |
124 | (when (tramp-tramp-file-p file) | |
957b3189 MA |
125 | (tramp-compat-funcall |
126 | 'tramp-file-name-handler | |
e5aa47f9 | 127 | 'file-remote-p file identification connected))))) |
94be87e8 | 128 | |
b533bc97 | 129 | ;; `process-file' does not exist in XEmacs. |
94be87e8 | 130 | (unless (fboundp 'process-file) |
e5aa47f9 MA |
131 | (defalias 'process-file |
132 | (lambda (program &optional infile buffer display &rest args) | |
133 | (when (tramp-tramp-file-p default-directory) | |
134 | (apply | |
135 | 'tramp-file-name-handler | |
136 | 'process-file program infile buffer display args))))) | |
94be87e8 MA |
137 | |
138 | ;; `start-file-process' is new in Emacs 23. | |
139 | (unless (fboundp 'start-file-process) | |
e5aa47f9 MA |
140 | (defalias 'start-file-process |
141 | (lambda (name buffer program &rest program-args) | |
142 | (when (tramp-tramp-file-p default-directory) | |
143 | (apply | |
144 | 'tramp-file-name-handler | |
145 | 'start-file-process name buffer program program-args))))) | |
94be87e8 MA |
146 | |
147 | ;; `set-file-times' is also new in Emacs 23. | |
148 | (unless (fboundp 'set-file-times) | |
e5aa47f9 MA |
149 | (defalias 'set-file-times |
150 | (lambda (filename &optional time) | |
151 | (when (tramp-tramp-file-p filename) | |
957b3189 MA |
152 | (tramp-compat-funcall |
153 | 'tramp-file-name-handler 'set-file-times filename time))))) | |
1f3611c6 MA |
154 | |
155 | ;; We currently use "[" and "]" in the filename format for IPv6 | |
2c68ca0e | 156 | ;; hosts of GNU Emacs. This means that Emacs wants to expand |
1f3611c6 MA |
157 | ;; wildcards if `find-file-wildcards' is non-nil, and then barfs |
158 | ;; because no expansion could be found. We detect this situation | |
159 | ;; and do something really awful: we have `file-expand-wildcards' | |
160 | ;; return the original filename if it can't expand anything. Let's | |
161 | ;; just hope that this doesn't break anything else. | |
162 | ;; It is not needed anymore since GNU Emacs 23.2. | |
b533bc97 MA |
163 | (unless (or (featurep 'xemacs) |
164 | ;; `featurep' has only one argument in XEmacs. | |
165 | (funcall 'featurep 'files 'remote-wildcards)) | |
1f3611c6 MA |
166 | (defadvice file-expand-wildcards |
167 | (around tramp-advice-file-expand-wildcards activate) | |
168 | (let ((name (ad-get-arg 0))) | |
169 | ;; If it's a Tramp file, look if wildcards need to be expanded | |
170 | ;; at all. | |
171 | (if (and | |
172 | (tramp-tramp-file-p name) | |
173 | (not (string-match | |
b81a0b56 MA |
174 | "[[*?]" (tramp-compat-funcall |
175 | 'file-remote-p name 'localname)))) | |
1f3611c6 MA |
176 | (setq ad-return-value (list name)) |
177 | ;; Otherwise, just run the original function. | |
178 | ad-do-it))) | |
179 | (add-hook | |
180 | 'tramp-unload-hook | |
181 | (lambda () | |
182 | (ad-remove-advice | |
183 | 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards) | |
184 | (ad-activate 'file-expand-wildcards))))) | |
9e6ab520 | 185 | |
8abee653 | 186 | ;; `with-temp-message' does not exist in XEmacs. |
6139f995 MA |
187 | (if (fboundp 'with-temp-message) |
188 | (defalias 'tramp-compat-with-temp-message 'with-temp-message) | |
1a9dc3b5 | 189 | (defmacro tramp-compat-with-temp-message (message &rest body) |
6139f995 MA |
190 | "Display MESSAGE temporarily if non-nil while BODY is evaluated." |
191 | `(progn ,@body))) | |
192 | ||
2fe4b125 MA |
193 | ;; `condition-case-unless-debug' is introduced with Emacs 24. |
194 | (if (fboundp 'condition-case-unless-debug) | |
195 | (defalias 'tramp-compat-condition-case-unless-debug | |
196 | 'condition-case-unless-debug) | |
197 | (defmacro tramp-compat-condition-case-unless-debug | |
198 | (var bodyform &rest handlers) | |
199 | "Like `condition-case' except that it does not catch anything when debugging." | |
200 | (declare (debug condition-case) (indent 2)) | |
201 | (let ((bodysym (make-symbol "body"))) | |
202 | `(let ((,bodysym (lambda () ,bodyform))) | |
203 | (if debug-on-error | |
204 | (funcall ,bodysym) | |
205 | (condition-case ,var | |
206 | (funcall ,bodysym) | |
207 | ,@handlers)))))) | |
208 | ||
6139f995 MA |
209 | ;; `font-lock-add-keywords' does not exist in XEmacs. |
210 | (defun tramp-compat-font-lock-add-keywords (mode keywords &optional how) | |
211 | "Add highlighting KEYWORDS for MODE." | |
212 | (ignore-errors | |
213 | (tramp-compat-funcall 'font-lock-add-keywords mode keywords how))) | |
214 | ||
9e6ab520 MA |
215 | (defsubst tramp-compat-temporary-file-directory () |
216 | "Return name of directory for temporary files (compat function). | |
217 | For Emacs, this is the variable `temporary-file-directory', for XEmacs | |
218 | this is the function `temp-directory'." | |
03310646 | 219 | (let (file-name-handler-alist) |
957b3189 MA |
220 | ;; We must return a local directory. If it is remote, we could |
221 | ;; run into an infloop. | |
03310646 | 222 | (cond |
957b3189 MA |
223 | ((and (boundp 'temporary-file-directory) |
224 | (eval (car (get 'temporary-file-directory 'standard-value))))) | |
03310646 MA |
225 | ((fboundp 'temp-directory) (tramp-compat-funcall 'temp-directory)) |
226 | ((let ((d (getenv "TEMP"))) (and d (file-directory-p d))) | |
227 | (file-name-as-directory (getenv "TEMP"))) | |
228 | ((let ((d (getenv "TMP"))) (and d (file-directory-p d))) | |
229 | (file-name-as-directory (getenv "TMP"))) | |
230 | ((let ((d (getenv "TMPDIR"))) (and d (file-directory-p d))) | |
231 | (file-name-as-directory (getenv "TMPDIR"))) | |
232 | ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp")) | |
233 | (t (message (concat "Neither `temporary-file-directory' nor " | |
234 | "`temp-directory' is defined -- using /tmp.")) | |
235 | (file-name-as-directory "/tmp"))))) | |
9e6ab520 | 236 | |
b533bc97 MA |
237 | ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own |
238 | ;; implementation with `make-temp-name', creating the temporary file | |
239 | ;; immediately in order to avoid a security hole. | |
5d89d9d2 | 240 | (defsubst tramp-compat-make-temp-file (f &optional dir-flag) |
258800f8 | 241 | "Create a temporary file (compat function). |
5d89d9d2 | 242 | Add the extension of F, if existing." |
87bdd2c7 MA |
243 | (let* (file-name-handler-alist |
244 | (prefix (expand-file-name | |
245 | (symbol-value 'tramp-temp-name-prefix) | |
246 | (tramp-compat-temporary-file-directory))) | |
5d89d9d2 | 247 | (extension (file-name-extension f t)) |
87bdd2c7 | 248 | result) |
b81a0b56 | 249 | (condition-case nil |
258800f8 | 250 | (setq result |
0d5852cf | 251 | (tramp-compat-funcall 'make-temp-file prefix dir-flag extension)) |
b81a0b56 MA |
252 | (error |
253 | ;; We use our own implementation, taken from files.el. | |
254 | (while | |
255 | (condition-case () | |
256 | (progn | |
257 | (setq result (concat (make-temp-name prefix) extension)) | |
258 | (if dir-flag | |
259 | (make-directory result) | |
260 | (write-region "" nil result nil 'silent)) | |
261 | nil) | |
262 | (file-already-exists t)) | |
263 | ;; The file was somehow created by someone else between | |
264 | ;; `make-temp-name' and `write-region', let's try again. | |
265 | nil))) | |
258800f8 MA |
266 | result)) |
267 | ||
b533bc97 | 268 | ;; `most-positive-fixnum' does not exist in XEmacs. |
9e6ab520 MA |
269 | (defsubst tramp-compat-most-positive-fixnum () |
270 | "Return largest positive integer value (compat function)." | |
94be87e8 MA |
271 | (cond |
272 | ((boundp 'most-positive-fixnum) (symbol-value 'most-positive-fixnum)) | |
b533bc97 | 273 | ;; Default value in XEmacs. |
94be87e8 | 274 | (t 134217727))) |
9e6ab520 | 275 | |
0f34aa77 MA |
276 | (defun tramp-compat-decimal-to-octal (i) |
277 | "Return a string consisting of the octal digits of I. | |
278 | Not actually used. Use `(format \"%o\" i)' instead?" | |
279 | (cond ((< i 0) (error "Cannot convert negative number to octal")) | |
280 | ((not (integerp i)) (error "Cannot convert non-integer to octal")) | |
281 | ((zerop i) "0") | |
282 | (t (concat (tramp-compat-decimal-to-octal (/ i 8)) | |
283 | (number-to-string (% i 8)))))) | |
284 | ||
285 | ;; Kudos to Gerd Moellmann for this suggestion. | |
286 | (defun tramp-compat-octal-to-decimal (ostr) | |
287 | "Given a string of octal digits, return a decimal number." | |
288 | (let ((x (or ostr ""))) | |
289 | ;; `save-match' is in `tramp-mode-string-to-int' which calls this. | |
290 | (unless (string-match "\\`[0-7]*\\'" x) | |
291 | (error "Non-octal junk in string `%s'" x)) | |
292 | (string-to-number ostr 8))) | |
293 | ||
8abee653 | 294 | ;; ID-FORMAT does not exist in XEmacs. |
9e6ab520 MA |
295 | (defun tramp-compat-file-attributes (filename &optional id-format) |
296 | "Like `file-attributes' for Tramp files (compat function)." | |
297 | (cond | |
298 | ((or (null id-format) (eq id-format 'integer)) | |
299 | (file-attributes filename)) | |
e5aa47f9 | 300 | ((tramp-tramp-file-p filename) |
957b3189 MA |
301 | (tramp-compat-funcall |
302 | 'tramp-file-name-handler 'file-attributes filename id-format)) | |
9e6ab520 | 303 | (t (condition-case nil |
0d5852cf | 304 | (tramp-compat-funcall 'file-attributes filename id-format) |
9566840f | 305 | (wrong-number-of-arguments (file-attributes filename)))))) |
9e6ab520 | 306 | |
1cdd2a1b | 307 | ;; PRESERVE-UID-GID does not exist in XEmacs. |
53b6a8b1 MA |
308 | ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1 |
309 | ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3. | |
9e6ab520 | 310 | (defun tramp-compat-copy-file |
0d5852cf | 311 | (filename newname &optional ok-if-already-exists keep-date |
53b6a8b1 | 312 | preserve-uid-gid preserve-extended-attributes) |
9e6ab520 | 313 | "Like `copy-file' for Tramp files (compat function)." |
0d5852cf | 314 | (cond |
53b6a8b1 | 315 | (preserve-extended-attributes |
0d5852cf MA |
316 | (tramp-compat-funcall |
317 | 'copy-file filename newname ok-if-already-exists keep-date | |
53b6a8b1 | 318 | preserve-uid-gid preserve-extended-attributes)) |
0d5852cf MA |
319 | (preserve-uid-gid |
320 | (tramp-compat-funcall | |
321 | 'copy-file filename newname ok-if-already-exists keep-date | |
322 | preserve-uid-gid)) | |
323 | (t | |
324 | (copy-file filename newname ok-if-already-exists keep-date)))) | |
9e6ab520 | 325 | |
c2770957 MA |
326 | ;; `copy-directory' is a new function in Emacs 23.2. Implementation |
327 | ;; is taken from there. | |
328 | (defun tramp-compat-copy-directory | |
2fe4b125 | 329 | (directory newname &optional keep-time parents copy-contents) |
c2770957 | 330 | "Make a copy of DIRECTORY (compat function)." |
2fe4b125 MA |
331 | (condition-case nil |
332 | (tramp-compat-funcall | |
333 | 'copy-directory directory newname keep-time parents copy-contents) | |
334 | ||
335 | ;; `copy-directory' is either not implemented, or it does not | |
336 | ;; support the the COPY-CONTENTS flag. For the time being, we | |
337 | ;; ignore COPY-CONTENTS as well. | |
338 | ||
339 | (error | |
340 | ;; If `default-directory' is a remote directory, make sure we | |
341 | ;; find its `copy-directory' handler. | |
342 | (let ((handler (or (find-file-name-handler directory 'copy-directory) | |
343 | (find-file-name-handler newname 'copy-directory)))) | |
344 | (if handler | |
345 | (funcall handler 'copy-directory directory newname keep-time parents) | |
346 | ||
347 | ;; Compute target name. | |
348 | (setq directory (directory-file-name (expand-file-name directory)) | |
349 | newname (directory-file-name (expand-file-name newname))) | |
350 | (if (and (file-directory-p newname) | |
351 | (not (string-equal (file-name-nondirectory directory) | |
352 | (file-name-nondirectory newname)))) | |
353 | (setq newname | |
354 | (expand-file-name | |
355 | (file-name-nondirectory directory) newname))) | |
356 | (if (not (file-directory-p newname)) (make-directory newname parents)) | |
357 | ||
358 | ;; Copy recursively. | |
359 | (mapc | |
360 | (lambda (file) | |
361 | (if (file-directory-p file) | |
362 | (tramp-compat-copy-directory file newname keep-time parents) | |
363 | (copy-file file newname t keep-time))) | |
364 | ;; We do not want to delete "." and "..". | |
365 | (directory-files | |
366 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) | |
367 | ||
368 | ;; Set directory attributes. | |
369 | (set-file-modes newname (file-modes directory)) | |
370 | (if keep-time | |
371 | (set-file-times newname (nth 5 (file-attributes directory))))))))) | |
c2770957 | 372 | |
f1a5d776 CY |
373 | ;; TRASH has been introduced with Emacs 24.1. |
374 | (defun tramp-compat-delete-file (filename &optional trash) | |
66bdc868 | 375 | "Like `delete-file' for Tramp files (compat function)." |
f1a5d776 CY |
376 | (condition-case nil |
377 | (tramp-compat-funcall 'delete-file filename trash) | |
378 | ;; This Emacs version does not support the TRASH flag. | |
379 | (wrong-number-of-arguments | |
380 | (let ((delete-by-moving-to-trash | |
381 | (and (boundp 'delete-by-moving-to-trash) | |
eba082a2 | 382 | (symbol-value 'delete-by-moving-to-trash) |
f1a5d776 CY |
383 | trash))) |
384 | (delete-file filename))))) | |
66bdc868 | 385 | |
11f4d68f MA |
386 | ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been |
387 | ;; introduced with Emacs 24.1. | |
388 | (defun tramp-compat-delete-directory (directory &optional recursive trash) | |
c2770957 | 389 | "Like `delete-directory' for Tramp files (compat function)." |
11f4d68f MA |
390 | (condition-case nil |
391 | (cond | |
392 | (trash | |
393 | (tramp-compat-funcall 'delete-directory directory recursive trash)) | |
394 | (recursive | |
395 | (tramp-compat-funcall 'delete-directory directory recursive)) | |
396 | (t | |
397 | (delete-directory directory))) | |
398 | ;; This Emacs version does not support the RECURSIVE or TRASH flag. We | |
399 | ;; use the implementation from Emacs 23.2. | |
400 | (wrong-number-of-arguments | |
401 | (setq directory (directory-file-name (expand-file-name directory))) | |
402 | (if (not (file-symlink-p directory)) | |
403 | (mapc (lambda (file) | |
404 | (if (eq t (car (file-attributes file))) | |
405 | (tramp-compat-delete-directory file recursive trash) | |
406 | (tramp-compat-delete-file file trash))) | |
407 | (directory-files | |
408 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | |
409 | (delete-directory directory)))) | |
b533bc97 MA |
410 | |
411 | ;; `number-sequence' does not exist in XEmacs. Implementation is | |
412 | ;; taken from Emacs 23. | |
e5aa47f9 MA |
413 | (defun tramp-compat-number-sequence (from &optional to inc) |
414 | "Return a sequence of numbers from FROM to TO as a list (compat function)." | |
415 | (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) | |
0d5852cf | 416 | (tramp-compat-funcall 'number-sequence from to inc) |
e5aa47f9 MA |
417 | (if (or (not to) (= from to)) |
418 | (list from) | |
419 | (or inc (setq inc 1)) | |
420 | (when (zerop inc) (error "The increment can not be zero")) | |
421 | (let (seq (n 0) (next from)) | |
422 | (if (> inc 0) | |
423 | (while (<= next to) | |
424 | (setq seq (cons next seq) | |
425 | n (1+ n) | |
426 | next (+ from (* n inc)))) | |
427 | (while (>= next to) | |
428 | (setq seq (cons next seq) | |
429 | n (1+ n) | |
430 | next (+ from (* n inc))))) | |
431 | (nreverse seq))))) | |
432 | ||
b41b828a MA |
433 | (defun tramp-compat-split-string (string pattern) |
434 | "Like `split-string' but omit empty strings. | |
435 | In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). | |
436 | This is, the first, empty, element is omitted. In XEmacs, the first | |
437 | element is not omitted." | |
438 | (delete "" (split-string string pattern))) | |
439 | ||
440 | (defun tramp-compat-process-running-p (process-name) | |
441 | "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." | |
442 | (when (stringp process-name) | |
443 | (cond | |
444 | ;; GNU Emacs 22 on w32. | |
445 | ((fboundp 'w32-window-exists-p) | |
0d5852cf | 446 | (tramp-compat-funcall 'w32-window-exists-p process-name process-name)) |
b41b828a MA |
447 | |
448 | ;; GNU Emacs 23. | |
449 | ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) | |
450 | (let (result) | |
0d5852cf MA |
451 | (dolist (pid (tramp-compat-funcall 'list-system-processes) result) |
452 | (let ((attributes (tramp-compat-funcall 'process-attributes pid))) | |
f58f7520 SS |
453 | (when (and (string-equal |
454 | (cdr (assoc 'user attributes)) (user-login-name)) | |
455 | (let ((comm (cdr (assoc 'comm attributes)))) | |
456 | ;; The returned command name could be truncated | |
457 | ;; to 15 characters. Therefore, we cannot check | |
458 | ;; for `string-equal'. | |
459 | (and comm (string-match | |
460 | (concat "^" (regexp-quote comm)) | |
461 | process-name)))) | |
b41b828a MA |
462 | (setq result t)))))) |
463 | ||
464 | ;; Fallback, if there is no Lisp support yet. | |
465 | (t (let ((default-directory | |
466 | (if (file-remote-p default-directory) | |
467 | (tramp-compat-temporary-file-directory) | |
468 | default-directory)) | |
469 | (unix95 (getenv "UNIX95")) | |
470 | result) | |
471 | (setenv "UNIX95" "1") | |
472 | (when (member | |
473 | (user-login-name) | |
474 | (tramp-compat-split-string | |
475 | (shell-command-to-string | |
476 | (format "ps -C %s -o user=" process-name)) | |
477 | "[ \f\t\n\r\v]+")) | |
478 | (setq result t)) | |
479 | (setenv "UNIX95" unix95) | |
480 | result))))) | |
481 | ||
6139f995 MA |
482 | ;; The following functions do not exist in XEmacs. We ignore this; |
483 | ;; they are used for checking a remote tty. | |
484 | (defun tramp-compat-process-get (process propname) | |
485 | "Return the value of PROCESS' PROPNAME property. | |
486 | This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." | |
487 | (ignore-errors (tramp-compat-funcall 'process-get process propname))) | |
488 | ||
489 | (defun tramp-compat-process-put (process propname value) | |
490 | "Change PROCESS' PROPNAME property to VALUE. | |
491 | It can be retrieved with `(process-get PROCESS PROPNAME)'." | |
492 | (ignore-errors (tramp-compat-funcall 'process-put process propname value))) | |
493 | ||
bd8fadca MA |
494 | (defun tramp-compat-set-process-query-on-exit-flag (process flag) |
495 | "Specify if query is needed for process when Emacs is exited. | |
496 | If the second argument flag is non-nil, Emacs will query the user before | |
497 | exiting if process is running." | |
498 | (if (fboundp 'set-process-query-on-exit-flag) | |
499 | (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) | |
500 | (tramp-compat-funcall 'process-kill-without-query process flag))) | |
501 | ||
1cdd2a1b | 502 | ;; There exist different implementations for this function. |
bd8fadca MA |
503 | (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) |
504 | "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. | |
505 | EOL-TYPE can be one of `dos', `unix', or `mac'." | |
506 | (cond ((fboundp 'coding-system-change-eol-conversion) | |
507 | (tramp-compat-funcall | |
508 | 'coding-system-change-eol-conversion coding-system eol-type)) | |
509 | ((fboundp 'subsidiary-coding-system) | |
510 | (tramp-compat-funcall | |
511 | 'subsidiary-coding-system coding-system | |
512 | (cond ((eq eol-type 'dos) 'crlf) | |
513 | ((eq eol-type 'unix) 'lf) | |
514 | ((eq eol-type 'mac) 'cr) | |
515 | (t | |
516 | (error "Unknown EOL-TYPE `%s', must be %s" | |
517 | eol-type | |
518 | "`dos', `unix', or `mac'"))))) | |
519 | (t (error "Can't change EOL conversion -- is MULE missing?")))) | |
520 | ||
64ab82d1 MA |
521 | ;; `user-error' has been added to Emacs 24.3. |
522 | (defun tramp-compat-user-error (format &rest args) | |
523 | "Signal a pilot error." | |
78fc2530 | 524 | ; (tramp-backtrace) |
64ab82d1 MA |
525 | (apply (if (fboundp 'user-error) 'user-error 'error) format args)) |
526 | ||
1cdd2a1b MA |
527 | (add-hook 'tramp-unload-hook |
528 | (lambda () | |
529 | (unload-feature 'tramp-compat 'force))) | |
530 | ||
9e6ab520 MA |
531 | (provide 'tramp-compat) |
532 | ||
533 | ;;; TODO: | |
534 | ||
535 | ;;; tramp-compat.el ends here |