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) | |
9d3f707c | 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 |
af9ff9e8 MA |
316 | (condition-case nil |
317 | (tramp-compat-funcall | |
318 | 'copy-file filename newname ok-if-already-exists keep-date | |
319 | preserve-uid-gid preserve-extended-attributes) | |
320 | (wrong-number-of-arguments | |
321 | (tramp-compat-copy-file | |
322 | filename newname ok-if-already-exists keep-date preserve-uid-gid)))) | |
0d5852cf | 323 | (preserve-uid-gid |
af9ff9e8 MA |
324 | (condition-case nil |
325 | (tramp-compat-funcall | |
326 | 'copy-file filename newname ok-if-already-exists keep-date | |
327 | preserve-uid-gid) | |
328 | (wrong-number-of-arguments | |
329 | (tramp-compat-copy-file | |
330 | filename newname ok-if-already-exists keep-date)))) | |
0d5852cf MA |
331 | (t |
332 | (copy-file filename newname ok-if-already-exists keep-date)))) | |
9e6ab520 | 333 | |
c2770957 MA |
334 | ;; `copy-directory' is a new function in Emacs 23.2. Implementation |
335 | ;; is taken from there. | |
336 | (defun tramp-compat-copy-directory | |
2fe4b125 | 337 | (directory newname &optional keep-time parents copy-contents) |
c2770957 | 338 | "Make a copy of DIRECTORY (compat function)." |
2fe4b125 MA |
339 | (condition-case nil |
340 | (tramp-compat-funcall | |
341 | 'copy-directory directory newname keep-time parents copy-contents) | |
342 | ||
343 | ;; `copy-directory' is either not implemented, or it does not | |
344 | ;; support the the COPY-CONTENTS flag. For the time being, we | |
345 | ;; ignore COPY-CONTENTS as well. | |
346 | ||
347 | (error | |
348 | ;; If `default-directory' is a remote directory, make sure we | |
349 | ;; find its `copy-directory' handler. | |
350 | (let ((handler (or (find-file-name-handler directory 'copy-directory) | |
351 | (find-file-name-handler newname 'copy-directory)))) | |
352 | (if handler | |
353 | (funcall handler 'copy-directory directory newname keep-time parents) | |
354 | ||
355 | ;; Compute target name. | |
356 | (setq directory (directory-file-name (expand-file-name directory)) | |
357 | newname (directory-file-name (expand-file-name newname))) | |
358 | (if (and (file-directory-p newname) | |
359 | (not (string-equal (file-name-nondirectory directory) | |
360 | (file-name-nondirectory newname)))) | |
361 | (setq newname | |
362 | (expand-file-name | |
363 | (file-name-nondirectory directory) newname))) | |
364 | (if (not (file-directory-p newname)) (make-directory newname parents)) | |
365 | ||
366 | ;; Copy recursively. | |
367 | (mapc | |
368 | (lambda (file) | |
369 | (if (file-directory-p file) | |
370 | (tramp-compat-copy-directory file newname keep-time parents) | |
371 | (copy-file file newname t keep-time))) | |
372 | ;; We do not want to delete "." and "..". | |
373 | (directory-files | |
374 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) | |
375 | ||
376 | ;; Set directory attributes. | |
377 | (set-file-modes newname (file-modes directory)) | |
378 | (if keep-time | |
379 | (set-file-times newname (nth 5 (file-attributes directory))))))))) | |
c2770957 | 380 | |
f1a5d776 CY |
381 | ;; TRASH has been introduced with Emacs 24.1. |
382 | (defun tramp-compat-delete-file (filename &optional trash) | |
66bdc868 | 383 | "Like `delete-file' for Tramp files (compat function)." |
f1a5d776 CY |
384 | (condition-case nil |
385 | (tramp-compat-funcall 'delete-file filename trash) | |
386 | ;; This Emacs version does not support the TRASH flag. | |
387 | (wrong-number-of-arguments | |
388 | (let ((delete-by-moving-to-trash | |
389 | (and (boundp 'delete-by-moving-to-trash) | |
eba082a2 | 390 | (symbol-value 'delete-by-moving-to-trash) |
f1a5d776 CY |
391 | trash))) |
392 | (delete-file filename))))) | |
66bdc868 | 393 | |
11f4d68f MA |
394 | ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been |
395 | ;; introduced with Emacs 24.1. | |
396 | (defun tramp-compat-delete-directory (directory &optional recursive trash) | |
c2770957 | 397 | "Like `delete-directory' for Tramp files (compat function)." |
11f4d68f MA |
398 | (condition-case nil |
399 | (cond | |
400 | (trash | |
401 | (tramp-compat-funcall 'delete-directory directory recursive trash)) | |
402 | (recursive | |
403 | (tramp-compat-funcall 'delete-directory directory recursive)) | |
404 | (t | |
405 | (delete-directory directory))) | |
406 | ;; This Emacs version does not support the RECURSIVE or TRASH flag. We | |
407 | ;; use the implementation from Emacs 23.2. | |
408 | (wrong-number-of-arguments | |
409 | (setq directory (directory-file-name (expand-file-name directory))) | |
410 | (if (not (file-symlink-p directory)) | |
411 | (mapc (lambda (file) | |
412 | (if (eq t (car (file-attributes file))) | |
413 | (tramp-compat-delete-directory file recursive trash) | |
414 | (tramp-compat-delete-file file trash))) | |
415 | (directory-files | |
416 | directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))) | |
417 | (delete-directory directory)))) | |
b533bc97 MA |
418 | |
419 | ;; `number-sequence' does not exist in XEmacs. Implementation is | |
420 | ;; taken from Emacs 23. | |
e5aa47f9 MA |
421 | (defun tramp-compat-number-sequence (from &optional to inc) |
422 | "Return a sequence of numbers from FROM to TO as a list (compat function)." | |
423 | (if (or (subrp 'number-sequence) (symbol-file 'number-sequence)) | |
0d5852cf | 424 | (tramp-compat-funcall 'number-sequence from to inc) |
e5aa47f9 MA |
425 | (if (or (not to) (= from to)) |
426 | (list from) | |
427 | (or inc (setq inc 1)) | |
428 | (when (zerop inc) (error "The increment can not be zero")) | |
429 | (let (seq (n 0) (next from)) | |
430 | (if (> inc 0) | |
431 | (while (<= next to) | |
432 | (setq seq (cons next seq) | |
433 | n (1+ n) | |
434 | next (+ from (* n inc)))) | |
435 | (while (>= next to) | |
436 | (setq seq (cons next seq) | |
437 | n (1+ n) | |
438 | next (+ from (* n inc))))) | |
439 | (nreverse seq))))) | |
440 | ||
b41b828a MA |
441 | (defun tramp-compat-split-string (string pattern) |
442 | "Like `split-string' but omit empty strings. | |
443 | In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\"). | |
444 | This is, the first, empty, element is omitted. In XEmacs, the first | |
445 | element is not omitted." | |
446 | (delete "" (split-string string pattern))) | |
447 | ||
448 | (defun tramp-compat-process-running-p (process-name) | |
449 | "Returns `t' if system process PROCESS-NAME is running for `user-login-name'." | |
450 | (when (stringp process-name) | |
451 | (cond | |
452 | ;; GNU Emacs 22 on w32. | |
453 | ((fboundp 'w32-window-exists-p) | |
0d5852cf | 454 | (tramp-compat-funcall 'w32-window-exists-p process-name process-name)) |
b41b828a MA |
455 | |
456 | ;; GNU Emacs 23. | |
457 | ((and (fboundp 'list-system-processes) (fboundp 'process-attributes)) | |
458 | (let (result) | |
0d5852cf MA |
459 | (dolist (pid (tramp-compat-funcall 'list-system-processes) result) |
460 | (let ((attributes (tramp-compat-funcall 'process-attributes pid))) | |
f58f7520 SS |
461 | (when (and (string-equal |
462 | (cdr (assoc 'user attributes)) (user-login-name)) | |
463 | (let ((comm (cdr (assoc 'comm attributes)))) | |
464 | ;; The returned command name could be truncated | |
465 | ;; to 15 characters. Therefore, we cannot check | |
466 | ;; for `string-equal'. | |
467 | (and comm (string-match | |
468 | (concat "^" (regexp-quote comm)) | |
469 | process-name)))) | |
b41b828a MA |
470 | (setq result t)))))) |
471 | ||
472 | ;; Fallback, if there is no Lisp support yet. | |
473 | (t (let ((default-directory | |
4c1f03ef | 474 | (if (tramp-tramp-file-p default-directory) |
b41b828a MA |
475 | (tramp-compat-temporary-file-directory) |
476 | default-directory)) | |
477 | (unix95 (getenv "UNIX95")) | |
478 | result) | |
479 | (setenv "UNIX95" "1") | |
480 | (when (member | |
481 | (user-login-name) | |
482 | (tramp-compat-split-string | |
483 | (shell-command-to-string | |
484 | (format "ps -C %s -o user=" process-name)) | |
485 | "[ \f\t\n\r\v]+")) | |
486 | (setq result t)) | |
487 | (setenv "UNIX95" unix95) | |
488 | result))))) | |
489 | ||
6139f995 MA |
490 | ;; The following functions do not exist in XEmacs. We ignore this; |
491 | ;; they are used for checking a remote tty. | |
492 | (defun tramp-compat-process-get (process propname) | |
493 | "Return the value of PROCESS' PROPNAME property. | |
494 | This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'." | |
495 | (ignore-errors (tramp-compat-funcall 'process-get process propname))) | |
496 | ||
497 | (defun tramp-compat-process-put (process propname value) | |
498 | "Change PROCESS' PROPNAME property to VALUE. | |
499 | It can be retrieved with `(process-get PROCESS PROPNAME)'." | |
500 | (ignore-errors (tramp-compat-funcall 'process-put process propname value))) | |
501 | ||
bd8fadca MA |
502 | (defun tramp-compat-set-process-query-on-exit-flag (process flag) |
503 | "Specify if query is needed for process when Emacs is exited. | |
504 | If the second argument flag is non-nil, Emacs will query the user before | |
505 | exiting if process is running." | |
506 | (if (fboundp 'set-process-query-on-exit-flag) | |
507 | (tramp-compat-funcall 'set-process-query-on-exit-flag process flag) | |
508 | (tramp-compat-funcall 'process-kill-without-query process flag))) | |
509 | ||
1cdd2a1b | 510 | ;; There exist different implementations for this function. |
bd8fadca MA |
511 | (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type) |
512 | "Return a coding system like CODING-SYSTEM but with given EOL-TYPE. | |
513 | EOL-TYPE can be one of `dos', `unix', or `mac'." | |
514 | (cond ((fboundp 'coding-system-change-eol-conversion) | |
515 | (tramp-compat-funcall | |
516 | 'coding-system-change-eol-conversion coding-system eol-type)) | |
517 | ((fboundp 'subsidiary-coding-system) | |
518 | (tramp-compat-funcall | |
519 | 'subsidiary-coding-system coding-system | |
520 | (cond ((eq eol-type 'dos) 'crlf) | |
521 | ((eq eol-type 'unix) 'lf) | |
522 | ((eq eol-type 'mac) 'cr) | |
523 | (t | |
524 | (error "Unknown EOL-TYPE `%s', must be %s" | |
525 | eol-type | |
526 | "`dos', `unix', or `mac'"))))) | |
527 | (t (error "Can't change EOL conversion -- is MULE missing?")))) | |
528 | ||
af9ff9e8 MA |
529 | ;; `replace-regexp-in-string' does not exist in XEmacs. |
530 | ;; Implementation is taken from Emacs 24. | |
531 | (if (fboundp 'replace-regexp-in-string) | |
532 | (defalias 'tramp-compat-replace-regexp-in-string 'replace-regexp-in-string) | |
533 | (defun tramp-compat-replace-regexp-in-string | |
534 | (regexp rep string &optional fixedcase literal subexp start) | |
535 | "Replace all matches for REGEXP with REP in STRING. | |
536 | ||
537 | Return a new string containing the replacements. | |
538 | ||
539 | Optional arguments FIXEDCASE, LITERAL and SUBEXP are like the | |
540 | arguments with the same names of function `replace-match'. If START | |
541 | is non-nil, start replacements at that index in STRING. | |
542 | ||
543 | REP is either a string used as the NEWTEXT arg of `replace-match' or a | |
544 | function. If it is a function, it is called with the actual text of each | |
545 | match, and its value is used as the replacement text. When REP is called, | |
546 | the match data are the result of matching REGEXP against a substring | |
547 | of STRING. | |
548 | ||
549 | To replace only the first match (if any), make REGEXP match up to \\' | |
550 | and replace a sub-expression, e.g. | |
551 | (replace-regexp-in-string \"\\\\(foo\\\\).*\\\\'\" \"bar\" \" foo foo\" nil nil 1) | |
552 | => \" bar foo\"" | |
553 | ||
554 | (let ((l (length string)) | |
555 | (start (or start 0)) | |
556 | matches str mb me) | |
557 | (save-match-data | |
558 | (while (and (< start l) (string-match regexp string start)) | |
559 | (setq mb (match-beginning 0) | |
560 | me (match-end 0)) | |
561 | ;; If we matched the empty string, make sure we advance by one char | |
562 | (when (= me mb) (setq me (min l (1+ mb)))) | |
563 | ;; Generate a replacement for the matched substring. | |
564 | ;; Operate only on the substring to minimize string consing. | |
565 | ;; Set up match data for the substring for replacement; | |
566 | ;; presumably this is likely to be faster than munging the | |
567 | ;; match data directly in Lisp. | |
568 | (string-match regexp (setq str (substring string mb me))) | |
569 | (setq matches | |
570 | (cons (replace-match (if (stringp rep) | |
571 | rep | |
572 | (funcall rep (match-string 0 str))) | |
573 | fixedcase literal str subexp) | |
574 | (cons (substring string start mb) ; unmatched prefix | |
575 | matches))) | |
576 | (setq start me)) | |
577 | ;; Reconstruct a string from the pieces. | |
578 | (setq matches (cons (substring string start l) matches)) ; leftover | |
579 | (apply #'concat (nreverse matches)))))) | |
580 | ||
1cdd2a1b MA |
581 | (add-hook 'tramp-unload-hook |
582 | (lambda () | |
583 | (unload-feature 'tramp-compat 'force))) | |
584 | ||
9e6ab520 MA |
585 | (provide 'tramp-compat) |
586 | ||
587 | ;;; TODO: | |
588 | ||
589 | ;;; tramp-compat.el ends here |