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