1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007-2013 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.
34 ;; Pacify byte-compiler.
39 ;; Some packages must be required for XEmacs, because we compile
40 ;; with -no-autoloads.
41 (when (featurep 'xemacs
)
48 (require 'regexp-opt
))
52 (require 'format-spec
)
55 (require 'tramp-loaddefs
)
57 ;; As long as password.el is not part of (X)Emacs, it shouldn't be
59 (if (featurep 'xemacs
)
60 (load "password" 'noerror
)
61 (or (require 'password-cache nil
'noerror
)
62 (require 'password nil
'noerror
))) ; Part of contrib.
64 ;; auth-source is relatively new.
65 (if (featurep 'xemacs
)
66 (load "auth-source" 'noerror
)
67 (require 'auth-source nil
'noerror
))
69 ;; Load the appropriate timer package.
70 (if (featurep 'xemacs
)
71 (require 'timer-funcs
)
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
))
81 ;; `last-coding-system-used' is unknown in XEmacs.
82 (unless (boundp 'last-coding-system-used
)
83 (defvar last-coding-system-used nil
))
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.
88 ;; Note that it was removed altogether in Emacs 24.1.
89 (when (boundp 'directory-sep-char
)
90 (defvar byte-compile-not-obsolete-var nil
)
91 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
93 (defvar byte-compile-not-obsolete-vars nil
)
94 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
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.
99 (defvar remote-file-name-inhibit-cache nil
)
101 ;; For not existing functions, or functions with a changed argument
102 ;; list, there are compiler warnings. We want to avoid them in
103 ;; cases we know what we do.
104 (defmacro tramp-compat-funcall
(function &rest arguments
)
105 (if (featurep 'xemacs
)
106 `(funcall (symbol-function ,function
) ,@arguments
)
107 `(when (or (subrp ,function
) (functionp ,function
))
108 (with-no-warnings (funcall ,function
,@arguments
)))))
110 ;; `set-buffer-multibyte' comes from Emacs Leim.
111 (unless (fboundp 'set-buffer-multibyte
)
112 (defalias 'set-buffer-multibyte
'ignore
))
114 ;; The following functions cannot be aliases of the corresponding
115 ;; `tramp-handle-*' functions, because this would bypass the locking
118 ;; `file-remote-p' has been introduced with Emacs 22. The version
119 ;; of XEmacs is not a magic file name function (yet).
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-compat-funcall
125 'tramp-file-name-handler
126 'file-remote-p file identification connected
)))))
128 ;; `process-file' does not exist in XEmacs.
129 (unless (fboundp 'process-file
)
130 (defalias 'process-file
131 (lambda (program &optional infile buffer display
&rest args
)
132 (when (tramp-tramp-file-p default-directory
)
134 'tramp-file-name-handler
135 'process-file program infile buffer display args
)))))
137 ;; `start-file-process' is new in Emacs 23.
138 (unless (fboundp 'start-file-process
)
139 (defalias 'start-file-process
140 (lambda (name buffer program
&rest program-args
)
141 (when (tramp-tramp-file-p default-directory
)
143 'tramp-file-name-handler
144 'start-file-process name buffer program program-args
)))))
146 ;; `set-file-times' is also new in Emacs 23.
147 (unless (fboundp 'set-file-times
)
148 (defalias 'set-file-times
149 (lambda (filename &optional time
)
150 (when (tramp-tramp-file-p filename
)
151 (tramp-compat-funcall
152 'tramp-file-name-handler
'set-file-times filename time
)))))
154 ;; We currently use "[" and "]" in the filename format for IPv6
155 ;; hosts of GNU Emacs. This means that Emacs wants to expand
156 ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
157 ;; because no expansion could be found. We detect this situation
158 ;; and do something really awful: we have `file-expand-wildcards'
159 ;; return the original filename if it can't expand anything. Let's
160 ;; just hope that this doesn't break anything else.
161 ;; It is not needed anymore since GNU Emacs 23.2.
162 (unless (or (featurep 'xemacs
)
163 ;; `featurep' has only one argument in XEmacs.
164 (funcall 'featurep
'files
'remote-wildcards
))
165 (defadvice file-expand-wildcards
166 (around tramp-advice-file-expand-wildcards activate
)
167 (let ((name (ad-get-arg 0)))
168 ;; If it's a Tramp file, look if wildcards need to be expanded
171 (tramp-tramp-file-p name
)
173 "[[*?]" (tramp-compat-funcall
174 'file-remote-p name
'localname
))))
175 (setq ad-return-value
(list name
))
176 ;; Otherwise, just run the original function.
182 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
183 (ad-activate 'file-expand-wildcards
)))))
185 ;; `with-temp-message' does not exists in XEmacs.
186 (if (fboundp 'with-temp-message
)
187 (defalias 'tramp-compat-with-temp-message
'with-temp-message
)
188 (defmacro tramp-compat-with-temp-message
(message &rest body
)
189 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
192 ;; `condition-case-unless-debug' is introduced with Emacs 24.
193 (if (fboundp 'condition-case-unless-debug
)
194 (defalias 'tramp-compat-condition-case-unless-debug
195 'condition-case-unless-debug
)
196 (defmacro tramp-compat-condition-case-unless-debug
197 (var bodyform
&rest handlers
)
198 "Like `condition-case' except that it does not catch anything when debugging."
199 (declare (debug condition-case
) (indent 2))
200 (let ((bodysym (make-symbol "body")))
201 `(let ((,bodysym
(lambda () ,bodyform
)))
208 ;; `font-lock-add-keywords' does not exist in XEmacs.
209 (defun tramp-compat-font-lock-add-keywords (mode keywords
&optional how
)
210 "Add highlighting KEYWORDS for MODE."
212 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
214 (defsubst tramp-compat-temporary-file-directory
()
215 "Return name of directory for temporary files (compat function).
216 For Emacs, this is the variable `temporary-file-directory', for XEmacs
217 this is the function `temp-directory'."
218 (let (file-name-handler-alist)
219 ;; We must return a local directory. If it is remote, we could
220 ;; run into an infloop.
222 ((and (boundp 'temporary-file-directory
)
223 (eval (car (get 'temporary-file-directory
'standard-value
)))))
224 ((fboundp 'temp-directory
) (tramp-compat-funcall 'temp-directory
))
225 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
226 (file-name-as-directory (getenv "TEMP")))
227 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
228 (file-name-as-directory (getenv "TMP")))
229 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
230 (file-name-as-directory (getenv "TMPDIR")))
231 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
232 (t (message (concat "Neither `temporary-file-directory' nor "
233 "`temp-directory' is defined -- using /tmp."))
234 (file-name-as-directory "/tmp")))))
236 ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
237 ;; implementation with `make-temp-name', creating the temporary file
238 ;; immediately in order to avoid a security hole.
239 (defsubst tramp-compat-make-temp-file
(filename &optional dir-flag
)
240 "Create a temporary file (compat function).
241 Add the extension of FILENAME, if existing."
242 (let* (file-name-handler-alist
243 (prefix (expand-file-name
244 (symbol-value 'tramp-temp-name-prefix
)
245 (tramp-compat-temporary-file-directory)))
246 (extension (file-name-extension filename t
))
250 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
252 ;; We use our own implementation, taken from files.el.
256 (setq result
(concat (make-temp-name prefix
) extension
))
258 (make-directory result
)
259 (write-region "" nil result nil
'silent
))
261 (file-already-exists t
))
262 ;; The file was somehow created by someone else between
263 ;; `make-temp-name' and `write-region', let's try again.
267 ;; `most-positive-fixnum' does not exist in XEmacs.
268 (defsubst tramp-compat-most-positive-fixnum
()
269 "Return largest positive integer value (compat function)."
271 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
272 ;; Default value in XEmacs.
275 (defun tramp-compat-decimal-to-octal (i)
276 "Return a string consisting of the octal digits of I.
277 Not actually used. Use `(format \"%o\" i)' instead?"
278 (cond ((< i
0) (error "Cannot convert negative number to octal"))
279 ((not (integerp i
)) (error "Cannot convert non-integer to octal"))
281 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
282 (number-to-string (% i
8))))))
284 ;; Kudos to Gerd Moellmann for this suggestion.
285 (defun tramp-compat-octal-to-decimal (ostr)
286 "Given a string of octal digits, return a decimal number."
287 (let ((x (or ostr
"")))
288 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
289 (unless (string-match "\\`[0-7]*\\'" x
)
290 (error "Non-octal junk in string `%s'" x
))
291 (string-to-number ostr
8)))
293 ;; ID-FORMAT does not exists in XEmacs.
294 (defun tramp-compat-file-attributes (filename &optional id-format
)
295 "Like `file-attributes' for Tramp files (compat function)."
297 ((or (null id-format
) (eq id-format
'integer
))
298 (file-attributes filename
))
299 ((tramp-tramp-file-p filename
)
300 (tramp-compat-funcall
301 'tramp-file-name-handler
'file-attributes filename id-format
))
302 (t (condition-case nil
303 (tramp-compat-funcall 'file-attributes filename id-format
)
304 (wrong-number-of-arguments (file-attributes filename
))))))
306 ;; PRESERVE-UID-GID does not exist in XEmacs.
307 ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
308 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
309 (defun tramp-compat-copy-file
310 (filename newname
&optional ok-if-already-exists keep-date
311 preserve-uid-gid preserve-extended-attributes
)
312 "Like `copy-file' for Tramp files (compat function)."
314 (preserve-extended-attributes
315 (tramp-compat-funcall
316 'copy-file filename newname ok-if-already-exists keep-date
317 preserve-uid-gid preserve-extended-attributes
))
319 (tramp-compat-funcall
320 'copy-file filename newname ok-if-already-exists keep-date
323 (copy-file filename newname ok-if-already-exists keep-date
))))
325 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
326 ;; is taken from there.
327 (defun tramp-compat-copy-directory
328 (directory newname
&optional keep-time parents copy-contents
)
329 "Make a copy of DIRECTORY (compat function)."
331 (tramp-compat-funcall
332 'copy-directory directory newname keep-time parents copy-contents
)
334 ;; `copy-directory' is either not implemented, or it does not
335 ;; support the the COPY-CONTENTS flag. For the time being, we
336 ;; ignore COPY-CONTENTS as well.
339 ;; If `default-directory' is a remote directory, make sure we
340 ;; find its `copy-directory' handler.
341 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
342 (find-file-name-handler newname
'copy-directory
))))
344 (funcall handler
'copy-directory directory newname keep-time parents
)
346 ;; Compute target name.
347 (setq directory
(directory-file-name (expand-file-name directory
))
348 newname
(directory-file-name (expand-file-name newname
)))
349 (if (and (file-directory-p newname
)
350 (not (string-equal (file-name-nondirectory directory
)
351 (file-name-nondirectory newname
))))
354 (file-name-nondirectory directory
) newname
)))
355 (if (not (file-directory-p newname
)) (make-directory newname parents
))
360 (if (file-directory-p file
)
361 (tramp-compat-copy-directory file newname keep-time parents
)
362 (copy-file file newname t keep-time
)))
363 ;; We do not want to delete "." and "..".
365 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
367 ;; Set directory attributes.
368 (set-file-modes newname
(file-modes directory
))
370 (set-file-times newname
(nth 5 (file-attributes directory
)))))))))
372 ;; TRASH has been introduced with Emacs 24.1.
373 (defun tramp-compat-delete-file (filename &optional trash
)
374 "Like `delete-file' for Tramp files (compat function)."
376 (tramp-compat-funcall 'delete-file filename trash
)
377 ;; This Emacs version does not support the TRASH flag.
378 (wrong-number-of-arguments
379 (let ((delete-by-moving-to-trash
380 (and (boundp 'delete-by-moving-to-trash
)
381 (symbol-value 'delete-by-moving-to-trash
)
383 (delete-file filename
)))))
385 ;; RECURSIVE has been introduced with Emacs 23.2.
386 (defun tramp-compat-delete-directory (directory &optional recursive
)
387 "Like `delete-directory' for Tramp files (compat function)."
389 (delete-directory directory
)
391 (tramp-compat-funcall 'delete-directory directory recursive
)
392 ;; This Emacs version does not support the RECURSIVE flag. We
393 ;; use the implementation from Emacs 23.2.
394 (wrong-number-of-arguments
395 (setq directory
(directory-file-name (expand-file-name directory
)))
396 (if (not (file-symlink-p directory
))
398 (if (eq t
(car (file-attributes file
)))
399 (tramp-compat-delete-directory file recursive
)
402 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
403 (delete-directory directory
)))))
405 ;; `number-sequence' does not exist in XEmacs. Implementation is
406 ;; taken from Emacs 23.
407 (defun tramp-compat-number-sequence (from &optional to inc
)
408 "Return a sequence of numbers from FROM to TO as a list (compat function)."
409 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
410 (tramp-compat-funcall 'number-sequence from to inc
)
411 (if (or (not to
) (= from to
))
413 (or inc
(setq inc
1))
414 (when (zerop inc
) (error "The increment can not be zero"))
415 (let (seq (n 0) (next from
))
418 (setq seq
(cons next seq
)
420 next
(+ from
(* n inc
))))
422 (setq seq
(cons next seq
)
424 next
(+ from
(* n inc
)))))
427 (defun tramp-compat-split-string (string pattern
)
428 "Like `split-string' but omit empty strings.
429 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
430 This is, the first, empty, element is omitted. In XEmacs, the first
431 element is not omitted."
432 (delete "" (split-string string pattern
)))
434 (defun tramp-compat-call-process
435 (program &optional infile destination display
&rest args
)
436 "Calls `call-process' on the local host.
437 This is needed because for some Emacs flavors Tramp has
438 defadvised `call-process' to behave like `process-file'. The
439 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
440 (let ((default-directory
441 (if (file-remote-p default-directory
)
442 (tramp-compat-temporary-file-directory)
444 (if (executable-find program
)
445 (apply 'call-process program infile destination display args
)
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
)
452 ;; GNU Emacs 22 on w32.
453 ((fboundp 'w32-window-exists-p
)
454 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
457 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
459 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
460 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
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
))
472 ;; Fallback, if there is no Lisp support yet.
473 (t (let ((default-directory
474 (if (file-remote-p default-directory
)
475 (tramp-compat-temporary-file-directory)
477 (unix95 (getenv "UNIX95"))
479 (setenv "UNIX95" "1")
482 (tramp-compat-split-string
483 (shell-command-to-string
484 (format "ps -C %s -o user=" process-name
))
487 (setenv "UNIX95" unix95
)
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
)))
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
)))
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
)))
510 ;; There exist different implementations for this function.
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
)
524 (error "Unknown EOL-TYPE `%s', must be %s"
526 "`dos', `unix', or `mac'")))))
527 (t (error "Can't change EOL conversion -- is MULE missing?"))))
529 (add-hook 'tramp-unload-hook
531 (unload-feature 'tramp-compat
'force
)))
533 (provide 'tramp-compat
)
537 ;;; tramp-compat.el ends here