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