1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, processes
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software: you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation, either version 3 of the License, or
14 ;; (at your option) any later version.
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.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
26 ;; Tramp's main Emacs version for development is GNU Emacs 24. This
27 ;; package provides compatibility functions for GNU Emacs 22, GNU
28 ;; Emacs 23 and XEmacs 21.4+.
32 (require 'tramp-loaddefs
)
36 ;; Pacify byte-compiler.
43 (require 'format-spec
)
45 ;; As long as password.el is not part of (X)Emacs, it shouldn't be
47 (if (featurep 'xemacs
)
48 (load "password" 'noerror
)
49 (or (require 'password-cache nil
'noerror
)
50 (require 'password nil
'noerror
))) ; Part of contrib.
52 ;; auth-source is relatively new.
53 (if (featurep 'xemacs
)
54 (load "auth-source" 'noerror
)
55 (require 'auth-source nil
'noerror
))
57 ;; Load the appropriate timer package.
58 (if (featurep 'xemacs
)
59 (require 'timer-funcs
)
62 ;; We check whether `start-file-process' is bound.
63 (unless (fboundp 'start-file-process
)
65 ;; tramp-util offers integration into other (X)Emacs packages like
66 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
67 (eval-after-load "tramp"
68 '(require 'tramp-util
))
70 ;; Make sure that we get integration with the VC package. When it
71 ;; is loaded, we need to pull in the integration module. Not
72 ;; necessary in Emacs 23.
74 (eval-after-load "tramp"
75 '(require 'tramp-vc
))))
77 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
78 ;; Currently, XEmacs supports this.
79 (when (featurep 'xemacs
)
80 (unless (boundp 'byte-compile-default-warnings
)
81 (defvar byte-compile-default-warnings nil
))
82 (delq 'unused-vars byte-compile-default-warnings
))
84 ;; `last-coding-system-used' is unknown in XEmacs.
85 (unless (boundp 'last-coding-system-used
)
86 (defvar last-coding-system-used nil
))
88 ;; `directory-sep-char' is an obsolete variable in Emacs. But it is
89 ;; used in XEmacs, so we set it here and there. The following is
90 ;; needed to pacify Emacs byte-compiler.
91 (unless (boundp 'byte-compile-not-obsolete-var
)
92 (defvar byte-compile-not-obsolete-var nil
))
93 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
95 (unless (boundp 'byte-compile-not-obsolete-vars
)
96 (defvar byte-compile-not-obsolete-vars nil
))
97 (setq byte-compile-not-obsolete-vars
'(directory-sep-char))
99 ;; For not existing functions, or functions with a changed argument
100 ;; list, there are compiler warnings. We want to avoid them in
101 ;; cases we know what we do.
102 (defmacro tramp-compat-funcall
(function &rest arguments
)
103 (if (featurep 'xemacs
)
104 `(funcall (symbol-function ,function
) ,@arguments
)
105 `(when (or (subrp ,function
) (functionp ,function
))
106 (with-no-warnings (funcall ,function
,@arguments
)))))
108 ;; `set-buffer-multibyte' comes from Emacs Leim.
109 (unless (fboundp 'set-buffer-multibyte
)
110 (defalias 'set-buffer-multibyte
'ignore
))
112 ;; The following functions cannot be aliases of the corresponding
113 ;; `tramp-handle-*' functions, because this would bypass the locking
116 ;; `file-remote-p' has been introduced with Emacs 22. The version
117 ;; of XEmacs is not a magic file name function (yet); this is
118 ;; corrected in tramp-util.el. Here it is sufficient if the
120 (unless (fboundp 'file-remote-p
)
121 (defalias 'file-remote-p
122 (lambda (file &optional identification connected
)
123 (when (tramp-tramp-file-p file
)
124 (tramp-file-name-handler
125 'file-remote-p file identification connected
)))))
127 ;; `process-file' does not exist in XEmacs.
128 (unless (fboundp 'process-file
)
129 (defalias 'process-file
130 (lambda (program &optional infile buffer display
&rest args
)
131 (when (tramp-tramp-file-p default-directory
)
133 'tramp-file-name-handler
134 'process-file program infile buffer display args
)))))
136 ;; `start-file-process' is new in Emacs 23.
137 (unless (fboundp 'start-file-process
)
138 (defalias 'start-file-process
139 (lambda (name buffer program
&rest program-args
)
140 (when (tramp-tramp-file-p default-directory
)
142 'tramp-file-name-handler
143 'start-file-process name buffer program program-args
)))))
145 ;; `set-file-times' is also new in Emacs 23.
146 (unless (fboundp 'set-file-times
)
147 (defalias 'set-file-times
148 (lambda (filename &optional time
)
149 (when (tramp-tramp-file-p filename
)
150 (tramp-file-name-handler
151 'set-file-times filename time
)))))
153 ;; We currently use "[" and "]" in the filename format for IPv6
154 ;; hosts of GNU Emacs. This means, that Emacs wants to expand
155 ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
156 ;; because no expansion could be found. We detect this situation
157 ;; and do something really awful: we have `file-expand-wildcards'
158 ;; return the original filename if it can't expand anything. Let's
159 ;; just hope that this doesn't break anything else.
160 ;; It is not needed anymore since GNU Emacs 23.2.
161 (unless (or (featurep 'xemacs
)
162 ;; `featurep' has only one argument in XEmacs.
163 (funcall 'featurep
'files
'remote-wildcards
))
164 (defadvice file-expand-wildcards
165 (around tramp-advice-file-expand-wildcards activate
)
166 (let ((name (ad-get-arg 0)))
167 ;; If it's a Tramp file, look if wildcards need to be expanded
170 (tramp-tramp-file-p name
)
172 "[[*?]" (tramp-compat-funcall
173 'file-remote-p name
'localname
))))
174 (setq ad-return-value
(list name
))
175 ;; Otherwise, just run the original function.
181 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
182 (ad-activate 'file-expand-wildcards
)))))
184 ;; `with-temp-message' does not exists in XEmacs.
185 (if (fboundp 'with-temp-message
)
186 (defalias 'tramp-compat-with-temp-message
'with-temp-message
)
187 (defmacro tramp-compat-with-temp-message
(message &rest body
)
188 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
191 ;; `font-lock-add-keywords' does not exist in XEmacs.
192 (defun tramp-compat-font-lock-add-keywords (mode keywords
&optional how
)
193 "Add highlighting KEYWORDS for MODE."
195 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
197 (defsubst tramp-compat-line-beginning-position
()
198 "Return point at beginning of line (compat function).
199 Calls `line-beginning-position' or `point-at-bol' if defined, else
202 ((fboundp 'line-beginning-position
)
203 (tramp-compat-funcall 'line-beginning-position
))
204 ((fboundp 'point-at-bol
) (tramp-compat-funcall 'point-at-bol
))
205 (t (save-excursion (beginning-of-line) (point)))))
207 (defsubst tramp-compat-line-end-position
()
208 "Return point at end of line (compat function).
209 Calls `line-end-position' or `point-at-eol' if defined, else
212 ((fboundp 'line-end-position
) (tramp-compat-funcall 'line-end-position
))
213 ((fboundp 'point-at-eol
) (tramp-compat-funcall 'point-at-eol
))
214 (t (save-excursion (end-of-line) (point)))))
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'."
221 ((boundp 'temporary-file-directory
) (symbol-value 'temporary-file-directory
))
222 ((fboundp 'temp-directory
) (tramp-compat-funcall 'temp-directory
))
223 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
224 (file-name-as-directory (getenv "TEMP")))
225 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
226 (file-name-as-directory (getenv "TMP")))
227 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
228 (file-name-as-directory (getenv "TMPDIR")))
229 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
230 (t (message (concat "Neither `temporary-file-directory' nor "
231 "`temp-directory' is defined -- using /tmp."))
232 (file-name-as-directory "/tmp"))))
234 ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
235 ;; implementation with `make-temp-name', creating the temporary file
236 ;; immediately in order to avoid a security hole.
237 (defsubst tramp-compat-make-temp-file
(filename &optional dir-flag
)
238 "Create a temporary file (compat function).
239 Add the extension of FILENAME, if existing."
240 (let* (file-name-handler-alist
241 (prefix (expand-file-name
242 (symbol-value 'tramp-temp-name-prefix
)
243 (tramp-compat-temporary-file-directory)))
244 (extension (file-name-extension filename t
))
248 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
250 ;; We use our own implementation, taken from files.el.
254 (setq result
(concat (make-temp-name prefix
) extension
))
256 (make-directory result
)
257 (write-region "" nil result nil
'silent
))
259 (file-already-exists t
))
260 ;; The file was somehow created by someone else between
261 ;; `make-temp-name' and `write-region', let's try again.
265 ;; `most-positive-fixnum' does not exist in XEmacs.
266 (defsubst tramp-compat-most-positive-fixnum
()
267 "Return largest positive integer value (compat function)."
269 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
270 ;; Default value in XEmacs.
273 (defun tramp-compat-decimal-to-octal (i)
274 "Return a string consisting of the octal digits of I.
275 Not actually used. Use `(format \"%o\" i)' instead?"
276 (cond ((< i
0) (error "Cannot convert negative number to octal"))
277 ((not (integerp i
)) (error "Cannot convert non-integer to octal"))
279 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
280 (number-to-string (% i
8))))))
282 ;; Kudos to Gerd Moellmann for this suggestion.
283 (defun tramp-compat-octal-to-decimal (ostr)
284 "Given a string of octal digits, return a decimal number."
285 (let ((x (or ostr
"")))
286 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
287 (unless (string-match "\\`[0-7]*\\'" x
)
288 (error "Non-octal junk in string `%s'" x
))
289 (string-to-number ostr
8)))
291 ;; ID-FORMAT does not exists in XEmacs.
292 (defun tramp-compat-file-attributes (filename &optional id-format
)
293 "Like `file-attributes' for Tramp files (compat function)."
295 ((or (null id-format
) (eq id-format
'integer
))
296 (file-attributes filename
))
297 ((tramp-tramp-file-p filename
)
298 (tramp-file-name-handler 'file-attributes filename id-format
))
299 (t (condition-case nil
300 (tramp-compat-funcall 'file-attributes filename id-format
)
301 (wrong-number-of-arguments (file-attributes filename
))))))
303 ;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
304 ;; hurt to ignore it for other (X)Emacs versions.
305 ;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.
306 (defun tramp-compat-copy-file
307 (filename newname
&optional ok-if-already-exists keep-date
308 preserve-uid-gid preserve-selinux-context
)
309 "Like `copy-file' for Tramp files (compat function)."
311 (preserve-selinux-context
312 (tramp-compat-funcall
313 'copy-file filename newname ok-if-already-exists keep-date
314 preserve-uid-gid preserve-selinux-context
))
316 (tramp-compat-funcall
317 'copy-file filename newname ok-if-already-exists keep-date
320 (copy-file filename newname ok-if-already-exists keep-date
))))
322 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
323 ;; is taken from there.
324 (defun tramp-compat-copy-directory
325 (directory newname
&optional keep-time parents
)
326 "Make a copy of DIRECTORY (compat function)."
327 (if (fboundp 'copy-directory
)
328 (tramp-compat-funcall 'copy-directory directory newname keep-time parents
)
330 ;; If `default-directory' is a remote directory, make sure we find
331 ;; its `copy-directory' handler.
332 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
333 (find-file-name-handler newname
'copy-directory
))))
335 (funcall handler
'copy-directory directory newname keep-time parents
)
337 ;; Compute target name.
338 (setq directory
(directory-file-name (expand-file-name directory
))
339 newname
(directory-file-name (expand-file-name newname
)))
340 (if (and (file-directory-p newname
)
341 (not (string-equal (file-name-nondirectory directory
)
342 (file-name-nondirectory newname
))))
345 (file-name-nondirectory directory
) newname
)))
346 (if (not (file-directory-p newname
)) (make-directory newname parents
))
351 (if (file-directory-p file
)
352 (tramp-compat-copy-directory file newname keep-time parents
)
353 (copy-file file newname t keep-time
)))
354 ;; We do not want to delete "." and "..".
356 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
358 ;; Set directory attributes.
359 (set-file-modes newname
(file-modes directory
))
361 (set-file-times newname
(nth 5 (file-attributes directory
))))))))
363 ;; TRASH has been introduced with Emacs 24.1.
364 (defun tramp-compat-delete-file (filename &optional trash
)
365 "Like `delete-file' for Tramp files (compat function)."
367 (tramp-compat-funcall 'delete-file filename trash
)
368 ;; This Emacs version does not support the TRASH flag.
369 (wrong-number-of-arguments
370 (let ((delete-by-moving-to-trash
371 (and (boundp 'delete-by-moving-to-trash
)
372 (symbol-value 'delete-by-moving-to-trash
)
374 (delete-file filename
)))))
376 ;; RECURSIVE has been introduced with Emacs 23.2.
377 (defun tramp-compat-delete-directory (directory &optional recursive
)
378 "Like `delete-directory' for Tramp files (compat function)."
380 (delete-directory directory
)
382 (tramp-compat-funcall 'delete-directory directory recursive
)
383 ;; This Emacs version does not support the RECURSIVE flag. We
384 ;; use the implementation from Emacs 23.2.
385 (wrong-number-of-arguments
386 (setq directory
(directory-file-name (expand-file-name directory
)))
387 (if (not (file-symlink-p directory
))
389 (if (eq t
(car (file-attributes file
)))
390 (tramp-compat-delete-directory file recursive
)
393 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
394 (delete-directory directory
)))))
396 ;; `number-sequence' does not exist in XEmacs. Implementation is
397 ;; taken from Emacs 23.
398 (defun tramp-compat-number-sequence (from &optional to inc
)
399 "Return a sequence of numbers from FROM to TO as a list (compat function)."
400 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
401 (tramp-compat-funcall 'number-sequence from to inc
)
402 (if (or (not to
) (= from to
))
404 (or inc
(setq inc
1))
405 (when (zerop inc
) (error "The increment can not be zero"))
406 (let (seq (n 0) (next from
))
409 (setq seq
(cons next seq
)
411 next
(+ from
(* n inc
))))
413 (setq seq
(cons next seq
)
415 next
(+ from
(* n inc
)))))
418 (defun tramp-compat-split-string (string pattern
)
419 "Like `split-string' but omit empty strings.
420 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
421 This is, the first, empty, element is omitted. In XEmacs, the first
422 element is not omitted."
423 (delete "" (split-string string pattern
)))
425 (defun tramp-compat-call-process
426 (program &optional infile destination display
&rest args
)
427 "Calls `call-process' on the local host.
428 This is needed because for some Emacs flavors Tramp has
429 defadviced `call-process' to behave like `process-file'. The
430 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
431 (let ((default-directory
432 (if (file-remote-p default-directory
)
433 (tramp-compat-temporary-file-directory)
435 (if (executable-find program
)
436 (apply 'call-process program infile destination display args
)
439 (defun tramp-compat-process-running-p (process-name)
440 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
441 (when (stringp process-name
)
443 ;; GNU Emacs 22 on w32.
444 ((fboundp 'w32-window-exists-p
)
445 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
448 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
450 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
451 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
452 (when (and (string-equal
453 (cdr (assoc 'user attributes
)) (user-login-name))
454 (let ((comm (cdr (assoc 'comm attributes
))))
455 ;; The returned command name could be truncated
456 ;; to 15 characters. Therefore, we cannot check
457 ;; for `string-equal'.
458 (and comm
(string-match
459 (concat "^" (regexp-quote comm
))
463 ;; Fallback, if there is no Lisp support yet.
464 (t (let ((default-directory
465 (if (file-remote-p default-directory
)
466 (tramp-compat-temporary-file-directory)
468 (unix95 (getenv "UNIX95"))
470 (setenv "UNIX95" "1")
473 (tramp-compat-split-string
474 (shell-command-to-string
475 (format "ps -C %s -o user=" process-name
))
478 (setenv "UNIX95" unix95
)
481 ;; The following functions do not exist in XEmacs. We ignore this;
482 ;; they are used for checking a remote tty.
483 (defun tramp-compat-process-get (process propname
)
484 "Return the value of PROCESS' PROPNAME property.
485 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
486 (ignore-errors (tramp-compat-funcall 'process-get process propname
)))
488 (defun tramp-compat-process-put (process propname value
)
489 "Change PROCESS' PROPNAME property to VALUE.
490 It can be retrieved with `(process-get PROCESS PROPNAME)'."
491 (ignore-errors (tramp-compat-funcall 'process-put process propname value
)))
493 (add-hook 'tramp-unload-hook
495 (unload-feature 'tramp-compat
'force
)))
497 (provide 'tramp-compat
)
501 ;; arch-tag: 0e724b18-6699-4f87-ad96-640b272e5c85
502 ;;; tramp-compat.el ends here