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.
32 ;; Pacify byte-compiler.
38 ;; Some packages must be required for XEmacs, because we compile
39 ;; with -no-autoloads.
40 (when (featurep 'xemacs
)
47 (require 'regexp-opt
))
51 (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 (unless (boundp 'remote-file-name-inhibit-cache
)
100 (defvar remote-file-name-inhibit-cache nil
))
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
)))))
111 ;; `set-buffer-multibyte' comes from Emacs Leim.
112 (unless (fboundp 'set-buffer-multibyte
)
113 (defalias 'set-buffer-multibyte
'ignore
))
115 ;; The following functions cannot be aliases of the corresponding
116 ;; `tramp-handle-*' functions, because this would bypass the locking
119 ;; `file-remote-p' has been introduced with Emacs 22. The version
120 ;; of XEmacs is not a magic file name function (yet).
121 (unless (fboundp 'file-remote-p
)
122 (defalias 'file-remote-p
123 (lambda (file &optional identification connected
)
124 (when (tramp-tramp-file-p file
)
125 (tramp-compat-funcall
126 'tramp-file-name-handler
127 'file-remote-p file identification connected
)))))
129 ;; `process-file' does not exist in XEmacs.
130 (unless (fboundp 'process-file
)
131 (defalias 'process-file
132 (lambda (program &optional infile buffer display
&rest args
)
133 (when (tramp-tramp-file-p default-directory
)
135 'tramp-file-name-handler
136 'process-file program infile buffer display args
)))))
138 ;; `start-file-process' is new in Emacs 23.
139 (unless (fboundp 'start-file-process
)
140 (defalias 'start-file-process
141 (lambda (name buffer program
&rest program-args
)
142 (when (tramp-tramp-file-p default-directory
)
144 'tramp-file-name-handler
145 'start-file-process name buffer program program-args
)))))
147 ;; `set-file-times' is also new in Emacs 23.
148 (unless (fboundp 'set-file-times
)
149 (defalias 'set-file-times
150 (lambda (filename &optional time
)
151 (when (tramp-tramp-file-p filename
)
152 (tramp-compat-funcall
153 'tramp-file-name-handler
'set-file-times filename time
)))))
155 ;; We currently use "[" and "]" in the filename format for IPv6
156 ;; hosts of GNU Emacs. This means that Emacs wants to expand
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.
163 (unless (or (featurep 'xemacs
)
164 ;; `featurep' has only one argument in XEmacs.
165 (funcall 'featurep
'files
'remote-wildcards
))
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
172 (tramp-tramp-file-p name
)
174 "[[*?]" (tramp-compat-funcall
175 'file-remote-p name
'localname
))))
176 (setq ad-return-value
(list name
))
177 ;; Otherwise, just run the original function.
183 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
184 (ad-activate 'file-expand-wildcards
)))))
186 ;; `with-temp-message' does not exist in XEmacs.
187 (if (fboundp 'with-temp-message
)
188 (defalias 'tramp-compat-with-temp-message
'with-temp-message
)
189 (defmacro tramp-compat-with-temp-message
(message &rest body
)
190 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
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
)))
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."
213 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
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'."
219 (let (file-name-handler-alist)
220 ;; We must return a local directory. If it is remote, we could
221 ;; run into an infloop.
223 ((and (boundp 'temporary-file-directory
)
224 (eval (car (get 'temporary-file-directory
'standard-value
)))))
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")))))
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.
240 (defsubst tramp-compat-make-temp-file
(f &optional dir-flag
)
241 "Create a temporary file (compat function).
242 Add the extension of F, if existing."
243 (let* (file-name-handler-alist
244 (prefix (expand-file-name
245 (symbol-value 'tramp-temp-name-prefix
)
246 (tramp-compat-temporary-file-directory)))
247 (extension (file-name-extension f t
))
251 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
253 ;; We use our own implementation, taken from files.el.
257 (setq result
(concat (make-temp-name prefix
) extension
))
259 (make-directory result
)
260 (write-region "" nil result nil
'silent
))
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.
268 ;; `most-positive-fixnum' does not exist in XEmacs.
269 (defsubst tramp-compat-most-positive-fixnum
()
270 "Return largest positive integer value (compat function)."
272 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
273 ;; Default value in XEmacs.
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"))
282 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
283 (number-to-string (% i
8))))))
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)))
294 ;; ID-FORMAT does not exist in XEmacs.
295 (defun tramp-compat-file-attributes (filename &optional id-format
)
296 "Like `file-attributes' for Tramp files (compat function)."
298 ((or (null id-format
) (eq id-format
'integer
))
299 (file-attributes filename
))
300 ((tramp-tramp-file-p filename
)
301 (tramp-compat-funcall
302 'tramp-file-name-handler
'file-attributes filename id-format
))
303 (t (condition-case nil
304 (tramp-compat-funcall 'file-attributes filename id-format
)
305 (wrong-number-of-arguments (file-attributes filename
))))))
307 ;; PRESERVE-UID-GID does not exist in XEmacs.
308 ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
309 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
310 (defun tramp-compat-copy-file
311 (filename newname
&optional ok-if-already-exists keep-date
312 preserve-uid-gid preserve-extended-attributes
)
313 "Like `copy-file' for Tramp files (compat function)."
315 (preserve-extended-attributes
316 (tramp-compat-funcall
317 'copy-file filename newname ok-if-already-exists keep-date
318 preserve-uid-gid preserve-extended-attributes
))
320 (tramp-compat-funcall
321 'copy-file filename newname ok-if-already-exists keep-date
324 (copy-file filename newname ok-if-already-exists keep-date
))))
326 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
327 ;; is taken from there.
328 (defun tramp-compat-copy-directory
329 (directory newname
&optional keep-time parents copy-contents
)
330 "Make a copy of DIRECTORY (compat function)."
332 (tramp-compat-funcall
333 'copy-directory directory newname keep-time parents copy-contents
)
335 ;; `copy-directory' is either not implemented, or it does not
336 ;; support the the COPY-CONTENTS flag. For the time being, we
337 ;; ignore COPY-CONTENTS as well.
340 ;; If `default-directory' is a remote directory, make sure we
341 ;; find its `copy-directory' handler.
342 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
343 (find-file-name-handler newname
'copy-directory
))))
345 (funcall handler
'copy-directory directory newname keep-time parents
)
347 ;; Compute target name.
348 (setq directory
(directory-file-name (expand-file-name directory
))
349 newname
(directory-file-name (expand-file-name newname
)))
350 (if (and (file-directory-p newname
)
351 (not (string-equal (file-name-nondirectory directory
)
352 (file-name-nondirectory newname
))))
355 (file-name-nondirectory directory
) newname
)))
356 (if (not (file-directory-p newname
)) (make-directory newname parents
))
361 (if (file-directory-p file
)
362 (tramp-compat-copy-directory file newname keep-time parents
)
363 (copy-file file newname t keep-time
)))
364 ;; We do not want to delete "." and "..".
366 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
368 ;; Set directory attributes.
369 (set-file-modes newname
(file-modes directory
))
371 (set-file-times newname
(nth 5 (file-attributes directory
)))))))))
373 ;; TRASH has been introduced with Emacs 24.1.
374 (defun tramp-compat-delete-file (filename &optional trash
)
375 "Like `delete-file' for Tramp files (compat function)."
377 (tramp-compat-funcall 'delete-file filename trash
)
378 ;; This Emacs version does not support the TRASH flag.
379 (wrong-number-of-arguments
380 (let ((delete-by-moving-to-trash
381 (and (boundp 'delete-by-moving-to-trash
)
382 (symbol-value 'delete-by-moving-to-trash
)
384 (delete-file filename
)))))
386 ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been
387 ;; introduced with Emacs 24.1.
388 (defun tramp-compat-delete-directory (directory &optional recursive trash
)
389 "Like `delete-directory' for Tramp files (compat function)."
393 (tramp-compat-funcall 'delete-directory directory recursive trash
))
395 (tramp-compat-funcall 'delete-directory directory recursive
))
397 (delete-directory directory
)))
398 ;; This Emacs version does not support the RECURSIVE or TRASH flag. We
399 ;; use the implementation from Emacs 23.2.
400 (wrong-number-of-arguments
401 (setq directory
(directory-file-name (expand-file-name directory
)))
402 (if (not (file-symlink-p directory
))
404 (if (eq t
(car (file-attributes file
)))
405 (tramp-compat-delete-directory file recursive trash
)
406 (tramp-compat-delete-file file trash
)))
408 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
409 (delete-directory directory
))))
411 ;; `number-sequence' does not exist in XEmacs. Implementation is
412 ;; taken from Emacs 23.
413 (defun tramp-compat-number-sequence (from &optional to inc
)
414 "Return a sequence of numbers from FROM to TO as a list (compat function)."
415 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
416 (tramp-compat-funcall 'number-sequence from to inc
)
417 (if (or (not to
) (= from to
))
419 (or inc
(setq inc
1))
420 (when (zerop inc
) (error "The increment can not be zero"))
421 (let (seq (n 0) (next from
))
424 (setq seq
(cons next seq
)
426 next
(+ from
(* n inc
))))
428 (setq seq
(cons next seq
)
430 next
(+ from
(* n inc
)))))
433 (defun tramp-compat-split-string (string pattern
)
434 "Like `split-string' but omit empty strings.
435 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
436 This is, the first, empty, element is omitted. In XEmacs, the first
437 element is not omitted."
438 (delete "" (split-string string pattern
)))
440 (defun tramp-compat-process-running-p (process-name)
441 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
442 (when (stringp process-name
)
444 ;; GNU Emacs 22 on w32.
445 ((fboundp 'w32-window-exists-p
)
446 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
449 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
451 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
452 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
453 (when (and (string-equal
454 (cdr (assoc 'user attributes
)) (user-login-name))
455 (let ((comm (cdr (assoc 'comm attributes
))))
456 ;; The returned command name could be truncated
457 ;; to 15 characters. Therefore, we cannot check
458 ;; for `string-equal'.
459 (and comm
(string-match
460 (concat "^" (regexp-quote comm
))
464 ;; Fallback, if there is no Lisp support yet.
465 (t (let ((default-directory
466 (if (file-remote-p default-directory
)
467 (tramp-compat-temporary-file-directory)
469 (unix95 (getenv "UNIX95"))
471 (setenv "UNIX95" "1")
474 (tramp-compat-split-string
475 (shell-command-to-string
476 (format "ps -C %s -o user=" process-name
))
479 (setenv "UNIX95" unix95
)
482 ;; The following functions do not exist in XEmacs. We ignore this;
483 ;; they are used for checking a remote tty.
484 (defun tramp-compat-process-get (process propname
)
485 "Return the value of PROCESS' PROPNAME property.
486 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
487 (ignore-errors (tramp-compat-funcall 'process-get process propname
)))
489 (defun tramp-compat-process-put (process propname value
)
490 "Change PROCESS' PROPNAME property to VALUE.
491 It can be retrieved with `(process-get PROCESS PROPNAME)'."
492 (ignore-errors (tramp-compat-funcall 'process-put process propname value
)))
494 (defun tramp-compat-set-process-query-on-exit-flag (process flag
)
495 "Specify if query is needed for process when Emacs is exited.
496 If the second argument flag is non-nil, Emacs will query the user before
497 exiting if process is running."
498 (if (fboundp 'set-process-query-on-exit-flag
)
499 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag
)
500 (tramp-compat-funcall 'process-kill-without-query process flag
)))
502 ;; There exist different implementations for this function.
503 (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type
)
504 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
505 EOL-TYPE can be one of `dos', `unix', or `mac'."
506 (cond ((fboundp 'coding-system-change-eol-conversion
)
507 (tramp-compat-funcall
508 'coding-system-change-eol-conversion coding-system eol-type
))
509 ((fboundp 'subsidiary-coding-system
)
510 (tramp-compat-funcall
511 'subsidiary-coding-system coding-system
512 (cond ((eq eol-type
'dos
) 'crlf
)
513 ((eq eol-type
'unix
) 'lf
)
514 ((eq eol-type
'mac
) 'cr
)
516 (error "Unknown EOL-TYPE `%s', must be %s"
518 "`dos', `unix', or `mac'")))))
519 (t (error "Can't change EOL conversion -- is MULE missing?"))))
521 ;; `user-error' has been added to Emacs 24.3.
522 (defun tramp-compat-user-error (format &rest args
)
523 "Signal a pilot error."
524 (apply (if (fboundp 'user-error
) 'user-error
'error
) format args
))
526 (add-hook 'tramp-unload-hook
528 (unload-feature 'tramp-compat
'force
)))
530 (provide 'tramp-compat
)
534 ;;; tramp-compat.el ends here