1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007-2012 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 Emacs 24. This
27 ;; package provides compatibility functions for Emacs 22, Emacs 23,
28 ;; XEmacs 21.4+ and SXEmacs 22.
32 (require 'tramp-loaddefs
)
36 ;; Pacify byte-compiler.
43 (require 'format-spec
)
46 ;; As long as password.el is not part of (X)Emacs, it shouldn't be
48 (if (featurep 'xemacs
)
49 (load "password" 'noerror
)
50 (or (require 'password-cache nil
'noerror
)
51 (require 'password nil
'noerror
))) ; Part of contrib.
53 ;; auth-source is relatively new.
54 (if (featurep 'xemacs
)
55 (load "auth-source" 'noerror
)
56 (require 'auth-source nil
'noerror
))
58 ;; Load the appropriate timer package.
59 (if (featurep 'xemacs
)
60 (require 'timer-funcs
)
63 ;; We check whether `start-file-process' is bound.
64 (unless (fboundp 'start-file-process
)
66 ;; tramp-util offers integration into other (X)Emacs packages like
67 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
68 (eval-after-load "tramp"
69 '(require 'tramp-util
))
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.
75 (eval-after-load "tramp"
76 '(require 'tramp-vc
))))
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
))
85 ;; `last-coding-system-used' is unknown in XEmacs.
86 (unless (boundp 'last-coding-system-used
)
87 (defvar last-coding-system-used nil
))
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.
92 ;; Note that it was removed altogether in Emacs 24.1.
93 (when (boundp 'directory-sep-char
)
94 (defvar byte-compile-not-obsolete-var nil
)
95 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
97 (defvar byte-compile-not-obsolete-vars nil
)
98 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
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
)
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
)))))
114 ;; `set-buffer-multibyte' comes from Emacs Leim.
115 (unless (fboundp 'set-buffer-multibyte
)
116 (defalias 'set-buffer-multibyte
'ignore
))
118 ;; The following functions cannot be aliases of the corresponding
119 ;; `tramp-handle-*' functions, because this would bypass the locking
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
126 (unless (fboundp 'file-remote-p
)
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
)))))
133 ;; `process-file' does not exist in XEmacs.
134 (unless (fboundp 'process-file
)
135 (defalias 'process-file
136 (lambda (program &optional infile buffer display
&rest args
)
137 (when (tramp-tramp-file-p default-directory
)
139 'tramp-file-name-handler
140 'process-file program infile buffer display args
)))))
142 ;; `start-file-process' is new in Emacs 23.
143 (unless (fboundp 'start-file-process
)
144 (defalias 'start-file-process
145 (lambda (name buffer program
&rest program-args
)
146 (when (tramp-tramp-file-p default-directory
)
148 'tramp-file-name-handler
149 'start-file-process name buffer program program-args
)))))
151 ;; `set-file-times' is also new in Emacs 23.
152 (unless (fboundp 'set-file-times
)
153 (defalias 'set-file-times
154 (lambda (filename &optional time
)
155 (when (tramp-tramp-file-p filename
)
156 (tramp-file-name-handler
157 'set-file-times filename time
)))))
159 ;; We currently use "[" and "]" in the filename format for IPv6
160 ;; hosts of GNU Emacs. This means that Emacs wants to expand
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.
167 (unless (or (featurep 'xemacs
)
168 ;; `featurep' has only one argument in XEmacs.
169 (funcall 'featurep
'files
'remote-wildcards
))
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
176 (tramp-tramp-file-p name
)
178 "[[*?]" (tramp-compat-funcall
179 'file-remote-p name
'localname
))))
180 (setq ad-return-value
(list name
))
181 ;; Otherwise, just run the original function.
187 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
188 (ad-activate 'file-expand-wildcards
)))))
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
)
193 (defmacro tramp-compat-with-temp-message
(message &rest body
)
194 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
197 ;; `condition-case-unless-debug' is introduced with Emacs 24.
198 (if (fboundp 'condition-case-unless-debug
)
199 (defalias 'tramp-compat-condition-case-unless-debug
200 'condition-case-unless-debug
)
201 (defmacro tramp-compat-condition-case-unless-debug
202 (var bodyform
&rest handlers
)
203 "Like `condition-case' except that it does not catch anything when debugging."
204 (declare (debug condition-case
) (indent 2))
205 (let ((bodysym (make-symbol "body")))
206 `(let ((,bodysym
(lambda () ,bodyform
)))
213 ;; `font-lock-add-keywords' does not exist in XEmacs.
214 (defun tramp-compat-font-lock-add-keywords (mode keywords
&optional how
)
215 "Add highlighting KEYWORDS for MODE."
217 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
219 (defsubst tramp-compat-temporary-file-directory
()
220 "Return name of directory for temporary files (compat function).
221 For Emacs, this is the variable `temporary-file-directory', for XEmacs
222 this is the function `temp-directory'."
223 (let (file-name-handler-alist)
225 ;; We must return a local directory. If it is remote, we could
226 ;; run into an infloop.
227 ((boundp 'temporary-file-directory
)
228 (eval (car (get 'temporary-file-directory
'standard-value
))))
229 ((fboundp 'temp-directory
) (tramp-compat-funcall 'temp-directory
))
230 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
231 (file-name-as-directory (getenv "TEMP")))
232 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
233 (file-name-as-directory (getenv "TMP")))
234 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
235 (file-name-as-directory (getenv "TMPDIR")))
236 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
237 (t (message (concat "Neither `temporary-file-directory' nor "
238 "`temp-directory' is defined -- using /tmp."))
239 (file-name-as-directory "/tmp")))))
241 ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
242 ;; implementation with `make-temp-name', creating the temporary file
243 ;; immediately in order to avoid a security hole.
244 (defsubst tramp-compat-make-temp-file
(filename &optional dir-flag
)
245 "Create a temporary file (compat function).
246 Add the extension of FILENAME, if existing."
247 (let* (file-name-handler-alist
248 (prefix (expand-file-name
249 (symbol-value 'tramp-temp-name-prefix
)
250 (tramp-compat-temporary-file-directory)))
251 (extension (file-name-extension filename t
))
255 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
257 ;; We use our own implementation, taken from files.el.
261 (setq result
(concat (make-temp-name prefix
) extension
))
263 (make-directory result
)
264 (write-region "" nil result nil
'silent
))
266 (file-already-exists t
))
267 ;; The file was somehow created by someone else between
268 ;; `make-temp-name' and `write-region', let's try again.
272 ;; `most-positive-fixnum' does not exist in XEmacs.
273 (defsubst tramp-compat-most-positive-fixnum
()
274 "Return largest positive integer value (compat function)."
276 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
277 ;; Default value in XEmacs.
280 (defun tramp-compat-decimal-to-octal (i)
281 "Return a string consisting of the octal digits of I.
282 Not actually used. Use `(format \"%o\" i)' instead?"
283 (cond ((< i
0) (error "Cannot convert negative number to octal"))
284 ((not (integerp i
)) (error "Cannot convert non-integer to octal"))
286 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
287 (number-to-string (% i
8))))))
289 ;; Kudos to Gerd Moellmann for this suggestion.
290 (defun tramp-compat-octal-to-decimal (ostr)
291 "Given a string of octal digits, return a decimal number."
292 (let ((x (or ostr
"")))
293 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
294 (unless (string-match "\\`[0-7]*\\'" x
)
295 (error "Non-octal junk in string `%s'" x
))
296 (string-to-number ostr
8)))
298 ;; ID-FORMAT does not exists in XEmacs.
299 (defun tramp-compat-file-attributes (filename &optional id-format
)
300 "Like `file-attributes' for Tramp files (compat function)."
302 ((or (null id-format
) (eq id-format
'integer
))
303 (file-attributes filename
))
304 ((tramp-tramp-file-p filename
)
305 (tramp-file-name-handler 'file-attributes filename id-format
))
306 (t (condition-case nil
307 (tramp-compat-funcall 'file-attributes filename id-format
)
308 (wrong-number-of-arguments (file-attributes filename
))))))
310 ;; PRESERVE-UID-GID does not exist in XEmacs.
311 ;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1.
312 (defun tramp-compat-copy-file
313 (filename newname
&optional ok-if-already-exists keep-date
314 preserve-uid-gid preserve-selinux-context
)
315 "Like `copy-file' for Tramp files (compat function)."
317 (preserve-selinux-context
318 (tramp-compat-funcall
319 'copy-file filename newname ok-if-already-exists keep-date
320 preserve-uid-gid preserve-selinux-context
))
322 (tramp-compat-funcall
323 'copy-file filename newname ok-if-already-exists keep-date
326 (copy-file filename newname ok-if-already-exists keep-date
))))
328 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
329 ;; is taken from there.
330 (defun tramp-compat-copy-directory
331 (directory newname
&optional keep-time parents copy-contents
)
332 "Make a copy of DIRECTORY (compat function)."
334 (tramp-compat-funcall
335 'copy-directory directory newname keep-time parents copy-contents
)
337 ;; `copy-directory' is either not implemented, or it does not
338 ;; support the the COPY-CONTENTS flag. For the time being, we
339 ;; ignore COPY-CONTENTS as well.
342 ;; If `default-directory' is a remote directory, make sure we
343 ;; find its `copy-directory' handler.
344 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
345 (find-file-name-handler newname
'copy-directory
))))
347 (funcall handler
'copy-directory directory newname keep-time parents
)
349 ;; Compute target name.
350 (setq directory
(directory-file-name (expand-file-name directory
))
351 newname
(directory-file-name (expand-file-name newname
)))
352 (if (and (file-directory-p newname
)
353 (not (string-equal (file-name-nondirectory directory
)
354 (file-name-nondirectory newname
))))
357 (file-name-nondirectory directory
) newname
)))
358 (if (not (file-directory-p newname
)) (make-directory newname parents
))
363 (if (file-directory-p file
)
364 (tramp-compat-copy-directory file newname keep-time parents
)
365 (copy-file file newname t keep-time
)))
366 ;; We do not want to delete "." and "..".
368 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
370 ;; Set directory attributes.
371 (set-file-modes newname
(file-modes directory
))
373 (set-file-times newname
(nth 5 (file-attributes directory
)))))))))
375 ;; TRASH has been introduced with Emacs 24.1.
376 (defun tramp-compat-delete-file (filename &optional trash
)
377 "Like `delete-file' for Tramp files (compat function)."
379 (tramp-compat-funcall 'delete-file filename trash
)
380 ;; This Emacs version does not support the TRASH flag.
381 (wrong-number-of-arguments
382 (let ((delete-by-moving-to-trash
383 (and (boundp 'delete-by-moving-to-trash
)
384 (symbol-value 'delete-by-moving-to-trash
)
386 (delete-file filename
)))))
388 ;; RECURSIVE has been introduced with Emacs 23.2.
389 (defun tramp-compat-delete-directory (directory &optional recursive
)
390 "Like `delete-directory' for Tramp files (compat function)."
392 (delete-directory directory
)
394 (tramp-compat-funcall 'delete-directory directory recursive
)
395 ;; This Emacs version does not support the RECURSIVE flag. We
396 ;; use the implementation from Emacs 23.2.
397 (wrong-number-of-arguments
398 (setq directory
(directory-file-name (expand-file-name directory
)))
399 (if (not (file-symlink-p directory
))
401 (if (eq t
(car (file-attributes file
)))
402 (tramp-compat-delete-directory file recursive
)
405 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
406 (delete-directory directory
)))))
408 ;; `number-sequence' does not exist in XEmacs. Implementation is
409 ;; taken from Emacs 23.
410 (defun tramp-compat-number-sequence (from &optional to inc
)
411 "Return a sequence of numbers from FROM to TO as a list (compat function)."
412 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
413 (tramp-compat-funcall 'number-sequence from to inc
)
414 (if (or (not to
) (= from to
))
416 (or inc
(setq inc
1))
417 (when (zerop inc
) (error "The increment can not be zero"))
418 (let (seq (n 0) (next from
))
421 (setq seq
(cons next seq
)
423 next
(+ from
(* n inc
))))
425 (setq seq
(cons next seq
)
427 next
(+ from
(* n inc
)))))
430 (defun tramp-compat-split-string (string pattern
)
431 "Like `split-string' but omit empty strings.
432 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
433 This is, the first, empty, element is omitted. In XEmacs, the first
434 element is not omitted."
435 (delete "" (split-string string pattern
)))
437 (defun tramp-compat-call-process
438 (program &optional infile destination display
&rest args
)
439 "Calls `call-process' on the local host.
440 This is needed because for some Emacs flavors Tramp has
441 defadvised `call-process' to behave like `process-file'. The
442 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
443 (let ((default-directory
444 (if (file-remote-p default-directory
)
445 (tramp-compat-temporary-file-directory)
447 (if (executable-find program
)
448 (apply 'call-process program infile destination display args
)
451 (defun tramp-compat-process-running-p (process-name)
452 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
453 (when (stringp process-name
)
455 ;; GNU Emacs 22 on w32.
456 ((fboundp 'w32-window-exists-p
)
457 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
460 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
462 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
463 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
464 (when (and (string-equal
465 (cdr (assoc 'user attributes
)) (user-login-name))
466 (let ((comm (cdr (assoc 'comm attributes
))))
467 ;; The returned command name could be truncated
468 ;; to 15 characters. Therefore, we cannot check
469 ;; for `string-equal'.
470 (and comm
(string-match
471 (concat "^" (regexp-quote comm
))
475 ;; Fallback, if there is no Lisp support yet.
476 (t (let ((default-directory
477 (if (file-remote-p default-directory
)
478 (tramp-compat-temporary-file-directory)
480 (unix95 (getenv "UNIX95"))
482 (setenv "UNIX95" "1")
485 (tramp-compat-split-string
486 (shell-command-to-string
487 (format "ps -C %s -o user=" process-name
))
490 (setenv "UNIX95" unix95
)
493 ;; The following functions do not exist in XEmacs. We ignore this;
494 ;; they are used for checking a remote tty.
495 (defun tramp-compat-process-get (process propname
)
496 "Return the value of PROCESS' PROPNAME property.
497 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
498 (ignore-errors (tramp-compat-funcall 'process-get process propname
)))
500 (defun tramp-compat-process-put (process propname value
)
501 "Change PROCESS' PROPNAME property to VALUE.
502 It can be retrieved with `(process-get PROCESS PROPNAME)'."
503 (ignore-errors (tramp-compat-funcall 'process-put process propname value
)))
505 (defun tramp-compat-set-process-query-on-exit-flag (process flag
)
506 "Specify if query is needed for process when Emacs is exited.
507 If the second argument flag is non-nil, Emacs will query the user before
508 exiting if process is running."
509 (if (fboundp 'set-process-query-on-exit-flag
)
510 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag
)
511 (tramp-compat-funcall 'process-kill-without-query process flag
)))
513 ;; There exist different implementations for this function.
514 (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type
)
515 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
516 EOL-TYPE can be one of `dos', `unix', or `mac'."
517 (cond ((fboundp 'coding-system-change-eol-conversion
)
518 (tramp-compat-funcall
519 'coding-system-change-eol-conversion coding-system eol-type
))
520 ((fboundp 'subsidiary-coding-system
)
521 (tramp-compat-funcall
522 'subsidiary-coding-system coding-system
523 (cond ((eq eol-type
'dos
) 'crlf
)
524 ((eq eol-type
'unix
) 'lf
)
525 ((eq eol-type
'mac
) 'cr
)
527 (error "Unknown EOL-TYPE `%s', must be %s"
529 "`dos', `unix', or `mac'")))))
530 (t (error "Can't change EOL conversion -- is MULE missing?"))))
532 (add-hook 'tramp-unload-hook
534 (unload-feature 'tramp-compat
'force
)))
536 (provide 'tramp-compat
)
540 ;;; tramp-compat.el ends here