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
)
56 (require 'tramp-loaddefs
)
58 ;; As long as password.el is not part of (X)Emacs, it shouldn't be
60 (if (featurep 'xemacs
)
61 (load "password" 'noerror
)
62 (or (require 'password-cache nil
'noerror
)
63 (require 'password nil
'noerror
))) ; Part of contrib.
65 ;; auth-source is relatively new.
66 (if (featurep 'xemacs
)
67 (load "auth-source" 'noerror
)
68 (require 'auth-source nil
'noerror
))
70 ;; Load the appropriate timer package.
71 (if (featurep 'xemacs
)
72 (require 'timer-funcs
)
75 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
76 ;; Currently, XEmacs supports this.
77 (when (featurep 'xemacs
)
78 (unless (boundp 'byte-compile-default-warnings
)
79 (defvar byte-compile-default-warnings nil
))
80 (delq 'unused-vars byte-compile-default-warnings
))
82 ;; `last-coding-system-used' is unknown in XEmacs.
83 (unless (boundp 'last-coding-system-used
)
84 (defvar last-coding-system-used nil
))
86 ;; `directory-sep-char' is an obsolete variable in Emacs. But it is
87 ;; used in XEmacs, so we set it here and there. The following is
88 ;; needed to pacify Emacs byte-compiler.
89 ;; Note that it was removed altogether in Emacs 24.1.
90 (when (boundp 'directory-sep-char
)
91 (defvar byte-compile-not-obsolete-var nil
)
92 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
94 (defvar byte-compile-not-obsolete-vars nil
)
95 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
97 ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
98 ;; Besides `t', `nil', and integer, we use also timestamps (as
99 ;; returned by `current-time') internally.
100 (unless (boundp 'remote-file-name-inhibit-cache
)
101 (defvar remote-file-name-inhibit-cache nil
))
103 ;; For not existing functions, or functions with a changed argument
104 ;; list, there are compiler warnings. We want to avoid them in
105 ;; cases we know what we do.
106 (defmacro tramp-compat-funcall
(function &rest arguments
)
107 (if (featurep 'xemacs
)
108 `(funcall (symbol-function ,function
) ,@arguments
)
109 `(when (or (subrp ,function
) (functionp ,function
))
110 (with-no-warnings (funcall ,function
,@arguments
)))))
112 ;; `set-buffer-multibyte' comes from Emacs Leim.
113 (unless (fboundp 'set-buffer-multibyte
)
114 (defalias 'set-buffer-multibyte
'ignore
))
116 ;; The following functions cannot be aliases of the corresponding
117 ;; `tramp-handle-*' functions, because this would bypass the locking
120 ;; `file-remote-p' has been introduced with Emacs 22. The version
121 ;; of XEmacs is not a magic file name function (yet).
122 (unless (fboundp 'file-remote-p
)
123 (defalias 'file-remote-p
124 (lambda (file &optional identification connected
)
125 (when (tramp-tramp-file-p file
)
126 (tramp-compat-funcall
127 'tramp-file-name-handler
128 'file-remote-p file identification connected
)))))
130 ;; `process-file' does not exist in XEmacs.
131 (unless (fboundp 'process-file
)
132 (defalias 'process-file
133 (lambda (program &optional infile buffer display
&rest args
)
134 (when (tramp-tramp-file-p default-directory
)
136 'tramp-file-name-handler
137 'process-file program infile buffer display args
)))))
139 ;; `start-file-process' is new in Emacs 23.
140 (unless (fboundp 'start-file-process
)
141 (defalias 'start-file-process
142 (lambda (name buffer program
&rest program-args
)
143 (when (tramp-tramp-file-p default-directory
)
145 'tramp-file-name-handler
146 'start-file-process name buffer program program-args
)))))
148 ;; `set-file-times' is also new in Emacs 23.
149 (unless (fboundp 'set-file-times
)
150 (defalias 'set-file-times
151 (lambda (filename &optional time
)
152 (when (tramp-tramp-file-p filename
)
153 (tramp-compat-funcall
154 'tramp-file-name-handler
'set-file-times filename time
)))))
156 ;; We currently use "[" and "]" in the filename format for IPv6
157 ;; hosts of GNU Emacs. This means that Emacs wants to expand
158 ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
159 ;; because no expansion could be found. We detect this situation
160 ;; and do something really awful: we have `file-expand-wildcards'
161 ;; return the original filename if it can't expand anything. Let's
162 ;; just hope that this doesn't break anything else.
163 ;; It is not needed anymore since GNU Emacs 23.2.
164 (unless (or (featurep 'xemacs
)
165 ;; `featurep' has only one argument in XEmacs.
166 (funcall 'featurep
'files
'remote-wildcards
))
167 (defadvice file-expand-wildcards
168 (around tramp-advice-file-expand-wildcards activate
)
169 (let ((name (ad-get-arg 0)))
170 ;; If it's a Tramp file, look if wildcards need to be expanded
173 (tramp-tramp-file-p name
)
175 "[[*?]" (tramp-compat-funcall
176 'file-remote-p name
'localname
))))
177 (setq ad-return-value
(list name
))
178 ;; Otherwise, just run the original function.
184 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
185 (ad-activate 'file-expand-wildcards
)))))
187 ;; `with-temp-message' does not exists in XEmacs.
188 (if (fboundp 'with-temp-message
)
189 (defalias 'tramp-compat-with-temp-message
'with-temp-message
)
190 (defmacro tramp-compat-with-temp-message
(message &rest body
)
191 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
194 ;; `condition-case-unless-debug' is introduced with Emacs 24.
195 (if (fboundp 'condition-case-unless-debug
)
196 (defalias 'tramp-compat-condition-case-unless-debug
197 'condition-case-unless-debug
)
198 (defmacro tramp-compat-condition-case-unless-debug
199 (var bodyform
&rest handlers
)
200 "Like `condition-case' except that it does not catch anything when debugging."
201 (declare (debug condition-case
) (indent 2))
202 (let ((bodysym (make-symbol "body")))
203 `(let ((,bodysym
(lambda () ,bodyform
)))
210 ;; `font-lock-add-keywords' does not exist in XEmacs.
211 (defun tramp-compat-font-lock-add-keywords (mode keywords
&optional how
)
212 "Add highlighting KEYWORDS for MODE."
214 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
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'."
220 (let (file-name-handler-alist)
221 ;; We must return a local directory. If it is remote, we could
222 ;; run into an infloop.
224 ((and (boundp 'temporary-file-directory
)
225 (eval (car (get 'temporary-file-directory
'standard-value
)))))
226 ((fboundp 'temp-directory
) (tramp-compat-funcall 'temp-directory
))
227 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
228 (file-name-as-directory (getenv "TEMP")))
229 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
230 (file-name-as-directory (getenv "TMP")))
231 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
232 (file-name-as-directory (getenv "TMPDIR")))
233 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
234 (t (message (concat "Neither `temporary-file-directory' nor "
235 "`temp-directory' is defined -- using /tmp."))
236 (file-name-as-directory "/tmp")))))
238 ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
239 ;; implementation with `make-temp-name', creating the temporary file
240 ;; immediately in order to avoid a security hole.
241 (defsubst tramp-compat-make-temp-file
(filename &optional dir-flag
)
242 "Create a temporary file (compat function).
243 Add the extension of FILENAME, if existing."
244 (let* (file-name-handler-alist
245 (prefix (expand-file-name
246 (symbol-value 'tramp-temp-name-prefix
)
247 (tramp-compat-temporary-file-directory)))
248 (extension (file-name-extension filename t
))
252 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
254 ;; We use our own implementation, taken from files.el.
258 (setq result
(concat (make-temp-name prefix
) extension
))
260 (make-directory result
)
261 (write-region "" nil result nil
'silent
))
263 (file-already-exists t
))
264 ;; The file was somehow created by someone else between
265 ;; `make-temp-name' and `write-region', let's try again.
269 ;; `most-positive-fixnum' does not exist in XEmacs.
270 (defsubst tramp-compat-most-positive-fixnum
()
271 "Return largest positive integer value (compat function)."
273 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
274 ;; Default value in XEmacs.
277 (defun tramp-compat-decimal-to-octal (i)
278 "Return a string consisting of the octal digits of I.
279 Not actually used. Use `(format \"%o\" i)' instead?"
280 (cond ((< i
0) (error "Cannot convert negative number to octal"))
281 ((not (integerp i
)) (error "Cannot convert non-integer to octal"))
283 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
284 (number-to-string (% i
8))))))
286 ;; Kudos to Gerd Moellmann for this suggestion.
287 (defun tramp-compat-octal-to-decimal (ostr)
288 "Given a string of octal digits, return a decimal number."
289 (let ((x (or ostr
"")))
290 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
291 (unless (string-match "\\`[0-7]*\\'" x
)
292 (error "Non-octal junk in string `%s'" x
))
293 (string-to-number ostr
8)))
295 ;; ID-FORMAT does not exists in XEmacs.
296 (defun tramp-compat-file-attributes (filename &optional id-format
)
297 "Like `file-attributes' for Tramp files (compat function)."
299 ((or (null id-format
) (eq id-format
'integer
))
300 (file-attributes filename
))
301 ((tramp-tramp-file-p filename
)
302 (tramp-compat-funcall
303 'tramp-file-name-handler
'file-attributes filename id-format
))
304 (t (condition-case nil
305 (tramp-compat-funcall 'file-attributes filename id-format
)
306 (wrong-number-of-arguments (file-attributes filename
))))))
308 ;; PRESERVE-UID-GID does not exist in XEmacs.
309 ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
310 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
311 (defun tramp-compat-copy-file
312 (filename newname
&optional ok-if-already-exists keep-date
313 preserve-uid-gid preserve-extended-attributes
)
314 "Like `copy-file' for Tramp files (compat function)."
316 (preserve-extended-attributes
317 (tramp-compat-funcall
318 'copy-file filename newname ok-if-already-exists keep-date
319 preserve-uid-gid preserve-extended-attributes
))
321 (tramp-compat-funcall
322 'copy-file filename newname ok-if-already-exists keep-date
325 (copy-file filename newname ok-if-already-exists keep-date
))))
327 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
328 ;; is taken from there.
329 (defun tramp-compat-copy-directory
330 (directory newname
&optional keep-time parents copy-contents
)
331 "Make a copy of DIRECTORY (compat function)."
333 (tramp-compat-funcall
334 'copy-directory directory newname keep-time parents copy-contents
)
336 ;; `copy-directory' is either not implemented, or it does not
337 ;; support the the COPY-CONTENTS flag. For the time being, we
338 ;; ignore COPY-CONTENTS as well.
341 ;; If `default-directory' is a remote directory, make sure we
342 ;; find its `copy-directory' handler.
343 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
344 (find-file-name-handler newname
'copy-directory
))))
346 (funcall handler
'copy-directory directory newname keep-time parents
)
348 ;; Compute target name.
349 (setq directory
(directory-file-name (expand-file-name directory
))
350 newname
(directory-file-name (expand-file-name newname
)))
351 (if (and (file-directory-p newname
)
352 (not (string-equal (file-name-nondirectory directory
)
353 (file-name-nondirectory newname
))))
356 (file-name-nondirectory directory
) newname
)))
357 (if (not (file-directory-p newname
)) (make-directory newname parents
))
362 (if (file-directory-p file
)
363 (tramp-compat-copy-directory file newname keep-time parents
)
364 (copy-file file newname t keep-time
)))
365 ;; We do not want to delete "." and "..".
367 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
369 ;; Set directory attributes.
370 (set-file-modes newname
(file-modes directory
))
372 (set-file-times newname
(nth 5 (file-attributes directory
)))))))))
374 ;; TRASH has been introduced with Emacs 24.1.
375 (defun tramp-compat-delete-file (filename &optional trash
)
376 "Like `delete-file' for Tramp files (compat function)."
378 (tramp-compat-funcall 'delete-file filename trash
)
379 ;; This Emacs version does not support the TRASH flag.
380 (wrong-number-of-arguments
381 (let ((delete-by-moving-to-trash
382 (and (boundp 'delete-by-moving-to-trash
)
383 (symbol-value 'delete-by-moving-to-trash
)
385 (delete-file filename
)))))
387 ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been
388 ;; introduced with Emacs 24.1.
389 (defun tramp-compat-delete-directory (directory &optional recursive trash
)
390 "Like `delete-directory' for Tramp files (compat function)."
394 (tramp-compat-funcall 'delete-directory directory recursive trash
))
396 (tramp-compat-funcall 'delete-directory directory recursive
))
398 (delete-directory directory
)))
399 ;; This Emacs version does not support the RECURSIVE or TRASH flag. We
400 ;; use the implementation from Emacs 23.2.
401 (wrong-number-of-arguments
402 (setq directory
(directory-file-name (expand-file-name directory
)))
403 (if (not (file-symlink-p directory
))
405 (if (eq t
(car (file-attributes file
)))
406 (tramp-compat-delete-directory file recursive trash
)
407 (tramp-compat-delete-file file trash
)))
409 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
410 (delete-directory directory
))))
412 ;; `number-sequence' does not exist in XEmacs. Implementation is
413 ;; taken from Emacs 23.
414 (defun tramp-compat-number-sequence (from &optional to inc
)
415 "Return a sequence of numbers from FROM to TO as a list (compat function)."
416 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
417 (tramp-compat-funcall 'number-sequence from to inc
)
418 (if (or (not to
) (= from to
))
420 (or inc
(setq inc
1))
421 (when (zerop inc
) (error "The increment can not be zero"))
422 (let (seq (n 0) (next from
))
425 (setq seq
(cons next seq
)
427 next
(+ from
(* n inc
))))
429 (setq seq
(cons next seq
)
431 next
(+ from
(* n inc
)))))
434 (defun tramp-compat-split-string (string pattern
)
435 "Like `split-string' but omit empty strings.
436 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
437 This is, the first, empty, element is omitted. In XEmacs, the first
438 element is not omitted."
439 (delete "" (split-string string pattern
)))
441 (defun tramp-compat-call-process
442 (program &optional infile destination display
&rest args
)
443 "Calls `call-process' on the local host.
444 This is needed because for some Emacs flavors Tramp has
445 defadvised `call-process' to behave like `process-file'. The
446 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
447 (let ((default-directory
448 (if (file-remote-p default-directory
)
449 (tramp-compat-temporary-file-directory)
451 (if (executable-find program
)
452 (apply 'call-process program infile destination display args
)
455 (defun tramp-compat-process-running-p (process-name)
456 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
457 (when (stringp process-name
)
459 ;; GNU Emacs 22 on w32.
460 ((fboundp 'w32-window-exists-p
)
461 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
464 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
466 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
467 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
468 (when (and (string-equal
469 (cdr (assoc 'user attributes
)) (user-login-name))
470 (let ((comm (cdr (assoc 'comm attributes
))))
471 ;; The returned command name could be truncated
472 ;; to 15 characters. Therefore, we cannot check
473 ;; for `string-equal'.
474 (and comm
(string-match
475 (concat "^" (regexp-quote comm
))
479 ;; Fallback, if there is no Lisp support yet.
480 (t (let ((default-directory
481 (if (file-remote-p default-directory
)
482 (tramp-compat-temporary-file-directory)
484 (unix95 (getenv "UNIX95"))
486 (setenv "UNIX95" "1")
489 (tramp-compat-split-string
490 (shell-command-to-string
491 (format "ps -C %s -o user=" process-name
))
494 (setenv "UNIX95" unix95
)
497 ;; The following functions do not exist in XEmacs. We ignore this;
498 ;; they are used for checking a remote tty.
499 (defun tramp-compat-process-get (process propname
)
500 "Return the value of PROCESS' PROPNAME property.
501 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
502 (ignore-errors (tramp-compat-funcall 'process-get process propname
)))
504 (defun tramp-compat-process-put (process propname value
)
505 "Change PROCESS' PROPNAME property to VALUE.
506 It can be retrieved with `(process-get PROCESS PROPNAME)'."
507 (ignore-errors (tramp-compat-funcall 'process-put process propname value
)))
509 (defun tramp-compat-set-process-query-on-exit-flag (process flag
)
510 "Specify if query is needed for process when Emacs is exited.
511 If the second argument flag is non-nil, Emacs will query the user before
512 exiting if process is running."
513 (if (fboundp 'set-process-query-on-exit-flag
)
514 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag
)
515 (tramp-compat-funcall 'process-kill-without-query process flag
)))
517 ;; There exist different implementations for this function.
518 (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type
)
519 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
520 EOL-TYPE can be one of `dos', `unix', or `mac'."
521 (cond ((fboundp 'coding-system-change-eol-conversion
)
522 (tramp-compat-funcall
523 'coding-system-change-eol-conversion coding-system eol-type
))
524 ((fboundp 'subsidiary-coding-system
)
525 (tramp-compat-funcall
526 'subsidiary-coding-system coding-system
527 (cond ((eq eol-type
'dos
) 'crlf
)
528 ((eq eol-type
'unix
) 'lf
)
529 ((eq eol-type
'mac
) 'cr
)
531 (error "Unknown EOL-TYPE `%s', must be %s"
533 "`dos', `unix', or `mac'")))))
534 (t (error "Can't change EOL conversion -- is MULE missing?"))))
536 (add-hook 'tramp-unload-hook
538 (unload-feature 'tramp-compat
'force
)))
540 (provide 'tramp-compat
)
544 ;;; tramp-compat.el ends here