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.
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 ;; We check whether `start-file-process' is bound.
75 ;; Note: we deactivate this. There are problems, at least in SXEmacs.
76 (unless t
;(fboundp 'start-file-process)
78 ;; tramp-util offers integration into other (X)Emacs packages like
79 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
80 (eval-after-load "tramp"
81 '(require 'tramp-util
))
83 ;; Make sure that we get integration with the VC package. When it
84 ;; is loaded, we need to pull in the integration module. Not
85 ;; necessary in Emacs 23.
87 (eval-after-load "tramp"
88 '(require 'tramp-vc
))))
90 ;; Avoid byte-compiler warnings if the byte-compiler supports this.
91 ;; Currently, XEmacs supports this.
92 (when (featurep 'xemacs
)
93 (unless (boundp 'byte-compile-default-warnings
)
94 (defvar byte-compile-default-warnings nil
))
95 (delq 'unused-vars byte-compile-default-warnings
))
97 ;; `last-coding-system-used' is unknown in XEmacs.
98 (unless (boundp 'last-coding-system-used
)
99 (defvar last-coding-system-used nil
))
101 ;; `directory-sep-char' is an obsolete variable in Emacs. But it is
102 ;; used in XEmacs, so we set it here and there. The following is
103 ;; needed to pacify Emacs byte-compiler.
104 ;; Note that it was removed altogether in Emacs 24.1.
105 (when (boundp 'directory-sep-char
)
106 (defvar byte-compile-not-obsolete-var nil
)
107 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
109 (defvar byte-compile-not-obsolete-vars nil
)
110 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
112 ;; `remote-file-name-inhibit-cache' has been introduced with Emacs 24.1.
113 ;; Besides `t', `nil', and integer, we use also timestamps (as
114 ;; returned by `current-time') internally.
115 (defvar remote-file-name-inhibit-cache nil
)
117 ;; For not existing functions, or functions with a changed argument
118 ;; list, there are compiler warnings. We want to avoid them in
119 ;; cases we know what we do.
120 (defmacro tramp-compat-funcall
(function &rest arguments
)
121 (if (featurep 'xemacs
)
122 `(funcall (symbol-function ,function
) ,@arguments
)
123 `(when (or (subrp ,function
) (functionp ,function
))
124 (with-no-warnings (funcall ,function
,@arguments
)))))
126 ;; `set-buffer-multibyte' comes from Emacs Leim.
127 (unless (fboundp 'set-buffer-multibyte
)
128 (defalias 'set-buffer-multibyte
'ignore
))
130 ;; The following functions cannot be aliases of the corresponding
131 ;; `tramp-handle-*' functions, because this would bypass the locking
134 ;; `file-remote-p' has been introduced with Emacs 22. The version
135 ;; of XEmacs is not a magic file name function (yet); this is
136 ;; corrected in tramp-util.el. Here it is sufficient if the
138 (unless (fboundp 'file-remote-p
)
139 (defalias 'file-remote-p
140 (lambda (file &optional identification connected
)
141 (when (tramp-tramp-file-p file
)
142 (tramp-compat-funcall
143 'tramp-file-name-handler
144 'file-remote-p file identification connected
)))))
146 ;; `process-file' does not exist in XEmacs.
147 (unless (fboundp 'process-file
)
148 (defalias 'process-file
149 (lambda (program &optional infile buffer display
&rest args
)
150 (when (tramp-tramp-file-p default-directory
)
152 'tramp-file-name-handler
153 'process-file program infile buffer display args
)))))
155 ;; `start-file-process' is new in Emacs 23.
156 (unless (fboundp 'start-file-process
)
157 (defalias 'start-file-process
158 (lambda (name buffer program
&rest program-args
)
159 (when (tramp-tramp-file-p default-directory
)
161 'tramp-file-name-handler
162 'start-file-process name buffer program program-args
)))))
164 ;; `set-file-times' is also new in Emacs 23.
165 (unless (fboundp 'set-file-times
)
166 (defalias 'set-file-times
167 (lambda (filename &optional time
)
168 (when (tramp-tramp-file-p filename
)
169 (tramp-compat-funcall
170 'tramp-file-name-handler
'set-file-times filename time
)))))
172 ;; We currently use "[" and "]" in the filename format for IPv6
173 ;; hosts of GNU Emacs. This means that Emacs wants to expand
174 ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
175 ;; because no expansion could be found. We detect this situation
176 ;; and do something really awful: we have `file-expand-wildcards'
177 ;; return the original filename if it can't expand anything. Let's
178 ;; just hope that this doesn't break anything else.
179 ;; It is not needed anymore since GNU Emacs 23.2.
180 (unless (or (featurep 'xemacs
)
181 ;; `featurep' has only one argument in XEmacs.
182 (funcall 'featurep
'files
'remote-wildcards
))
183 (defadvice file-expand-wildcards
184 (around tramp-advice-file-expand-wildcards activate
)
185 (let ((name (ad-get-arg 0)))
186 ;; If it's a Tramp file, look if wildcards need to be expanded
189 (tramp-tramp-file-p name
)
191 "[[*?]" (tramp-compat-funcall
192 'file-remote-p name
'localname
))))
193 (setq ad-return-value
(list name
))
194 ;; Otherwise, just run the original function.
200 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
201 (ad-activate 'file-expand-wildcards
)))))
203 ;; `with-temp-message' does not exists in XEmacs.
204 (if (fboundp 'with-temp-message
)
205 (defalias 'tramp-compat-with-temp-message
'with-temp-message
)
206 (defmacro tramp-compat-with-temp-message
(message &rest body
)
207 "Display MESSAGE temporarily if non-nil while BODY is evaluated."
210 ;; `condition-case-unless-debug' is introduced with Emacs 24.
211 (if (fboundp 'condition-case-unless-debug
)
212 (defalias 'tramp-compat-condition-case-unless-debug
213 'condition-case-unless-debug
)
214 (defmacro tramp-compat-condition-case-unless-debug
215 (var bodyform
&rest handlers
)
216 "Like `condition-case' except that it does not catch anything when debugging."
217 (declare (debug condition-case
) (indent 2))
218 (let ((bodysym (make-symbol "body")))
219 `(let ((,bodysym
(lambda () ,bodyform
)))
226 ;; `font-lock-add-keywords' does not exist in XEmacs.
227 (defun tramp-compat-font-lock-add-keywords (mode keywords
&optional how
)
228 "Add highlighting KEYWORDS for MODE."
230 (tramp-compat-funcall 'font-lock-add-keywords mode keywords how
)))
232 (defsubst tramp-compat-temporary-file-directory
()
233 "Return name of directory for temporary files (compat function).
234 For Emacs, this is the variable `temporary-file-directory', for XEmacs
235 this is the function `temp-directory'."
236 (let (file-name-handler-alist)
237 ;; We must return a local directory. If it is remote, we could
238 ;; run into an infloop.
240 ((and (boundp 'temporary-file-directory
)
241 (eval (car (get 'temporary-file-directory
'standard-value
)))))
242 ((fboundp 'temp-directory
) (tramp-compat-funcall 'temp-directory
))
243 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
244 (file-name-as-directory (getenv "TEMP")))
245 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
246 (file-name-as-directory (getenv "TMP")))
247 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
248 (file-name-as-directory (getenv "TMPDIR")))
249 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
250 (t (message (concat "Neither `temporary-file-directory' nor "
251 "`temp-directory' is defined -- using /tmp."))
252 (file-name-as-directory "/tmp")))))
254 ;; `make-temp-file' exists in Emacs only. On XEmacs, we use our own
255 ;; implementation with `make-temp-name', creating the temporary file
256 ;; immediately in order to avoid a security hole.
257 (defsubst tramp-compat-make-temp-file
(filename &optional dir-flag
)
258 "Create a temporary file (compat function).
259 Add the extension of FILENAME, if existing."
260 (let* (file-name-handler-alist
261 (prefix (expand-file-name
262 (symbol-value 'tramp-temp-name-prefix
)
263 (tramp-compat-temporary-file-directory)))
264 (extension (file-name-extension filename t
))
268 (tramp-compat-funcall 'make-temp-file prefix dir-flag extension
))
270 ;; We use our own implementation, taken from files.el.
274 (setq result
(concat (make-temp-name prefix
) extension
))
276 (make-directory result
)
277 (write-region "" nil result nil
'silent
))
279 (file-already-exists t
))
280 ;; The file was somehow created by someone else between
281 ;; `make-temp-name' and `write-region', let's try again.
285 ;; `most-positive-fixnum' does not exist in XEmacs.
286 (defsubst tramp-compat-most-positive-fixnum
()
287 "Return largest positive integer value (compat function)."
289 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
290 ;; Default value in XEmacs.
293 (defun tramp-compat-decimal-to-octal (i)
294 "Return a string consisting of the octal digits of I.
295 Not actually used. Use `(format \"%o\" i)' instead?"
296 (cond ((< i
0) (error "Cannot convert negative number to octal"))
297 ((not (integerp i
)) (error "Cannot convert non-integer to octal"))
299 (t (concat (tramp-compat-decimal-to-octal (/ i
8))
300 (number-to-string (% i
8))))))
302 ;; Kudos to Gerd Moellmann for this suggestion.
303 (defun tramp-compat-octal-to-decimal (ostr)
304 "Given a string of octal digits, return a decimal number."
305 (let ((x (or ostr
"")))
306 ;; `save-match' is in `tramp-mode-string-to-int' which calls this.
307 (unless (string-match "\\`[0-7]*\\'" x
)
308 (error "Non-octal junk in string `%s'" x
))
309 (string-to-number ostr
8)))
311 ;; ID-FORMAT does not exists in XEmacs.
312 (defun tramp-compat-file-attributes (filename &optional id-format
)
313 "Like `file-attributes' for Tramp files (compat function)."
315 ((or (null id-format
) (eq id-format
'integer
))
316 (file-attributes filename
))
317 ((tramp-tramp-file-p filename
)
318 (tramp-compat-funcall
319 'tramp-file-name-handler
'file-attributes filename id-format
))
320 (t (condition-case nil
321 (tramp-compat-funcall 'file-attributes filename id-format
)
322 (wrong-number-of-arguments (file-attributes filename
))))))
324 ;; PRESERVE-UID-GID does not exist in XEmacs.
325 ;; PRESERVE-SELINUX-CONTEXT has been introduced with Emacs 24.1.
326 (defun tramp-compat-copy-file
327 (filename newname
&optional ok-if-already-exists keep-date
328 preserve-uid-gid preserve-selinux-context
)
329 "Like `copy-file' for Tramp files (compat function)."
331 (preserve-selinux-context
332 (tramp-compat-funcall
333 'copy-file filename newname ok-if-already-exists keep-date
334 preserve-uid-gid preserve-selinux-context
))
336 (tramp-compat-funcall
337 'copy-file filename newname ok-if-already-exists keep-date
340 (copy-file filename newname ok-if-already-exists keep-date
))))
342 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
343 ;; is taken from there.
344 (defun tramp-compat-copy-directory
345 (directory newname
&optional keep-time parents copy-contents
)
346 "Make a copy of DIRECTORY (compat function)."
348 (tramp-compat-funcall
349 'copy-directory directory newname keep-time parents copy-contents
)
351 ;; `copy-directory' is either not implemented, or it does not
352 ;; support the the COPY-CONTENTS flag. For the time being, we
353 ;; ignore COPY-CONTENTS as well.
356 ;; If `default-directory' is a remote directory, make sure we
357 ;; find its `copy-directory' handler.
358 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
359 (find-file-name-handler newname
'copy-directory
))))
361 (funcall handler
'copy-directory directory newname keep-time parents
)
363 ;; Compute target name.
364 (setq directory
(directory-file-name (expand-file-name directory
))
365 newname
(directory-file-name (expand-file-name newname
)))
366 (if (and (file-directory-p newname
)
367 (not (string-equal (file-name-nondirectory directory
)
368 (file-name-nondirectory newname
))))
371 (file-name-nondirectory directory
) newname
)))
372 (if (not (file-directory-p newname
)) (make-directory newname parents
))
377 (if (file-directory-p file
)
378 (tramp-compat-copy-directory file newname keep-time parents
)
379 (copy-file file newname t keep-time
)))
380 ;; We do not want to delete "." and "..".
382 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
384 ;; Set directory attributes.
385 (set-file-modes newname
(file-modes directory
))
387 (set-file-times newname
(nth 5 (file-attributes directory
)))))))))
389 ;; TRASH has been introduced with Emacs 24.1.
390 (defun tramp-compat-delete-file (filename &optional trash
)
391 "Like `delete-file' for Tramp files (compat function)."
393 (tramp-compat-funcall 'delete-file filename trash
)
394 ;; This Emacs version does not support the TRASH flag.
395 (wrong-number-of-arguments
396 (let ((delete-by-moving-to-trash
397 (and (boundp 'delete-by-moving-to-trash
)
398 (symbol-value 'delete-by-moving-to-trash
)
400 (delete-file filename
)))))
402 ;; RECURSIVE has been introduced with Emacs 23.2.
403 (defun tramp-compat-delete-directory (directory &optional recursive
)
404 "Like `delete-directory' for Tramp files (compat function)."
406 (delete-directory directory
)
408 (tramp-compat-funcall 'delete-directory directory recursive
)
409 ;; This Emacs version does not support the RECURSIVE flag. We
410 ;; use the implementation from Emacs 23.2.
411 (wrong-number-of-arguments
412 (setq directory
(directory-file-name (expand-file-name directory
)))
413 (if (not (file-symlink-p directory
))
415 (if (eq t
(car (file-attributes file
)))
416 (tramp-compat-delete-directory file recursive
)
419 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
420 (delete-directory directory
)))))
422 ;; `number-sequence' does not exist in XEmacs. Implementation is
423 ;; taken from Emacs 23.
424 (defun tramp-compat-number-sequence (from &optional to inc
)
425 "Return a sequence of numbers from FROM to TO as a list (compat function)."
426 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
427 (tramp-compat-funcall 'number-sequence from to inc
)
428 (if (or (not to
) (= from to
))
430 (or inc
(setq inc
1))
431 (when (zerop inc
) (error "The increment can not be zero"))
432 (let (seq (n 0) (next from
))
435 (setq seq
(cons next seq
)
437 next
(+ from
(* n inc
))))
439 (setq seq
(cons next seq
)
441 next
(+ from
(* n inc
)))))
444 (defun tramp-compat-split-string (string pattern
)
445 "Like `split-string' but omit empty strings.
446 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
447 This is, the first, empty, element is omitted. In XEmacs, the first
448 element is not omitted."
449 (delete "" (split-string string pattern
)))
451 (defun tramp-compat-call-process
452 (program &optional infile destination display
&rest args
)
453 "Calls `call-process' on the local host.
454 This is needed because for some Emacs flavors Tramp has
455 defadvised `call-process' to behave like `process-file'. The
456 Lisp error raised when PROGRAM is nil is trapped also, returning 1."
457 (let ((default-directory
458 (if (file-remote-p default-directory
)
459 (tramp-compat-temporary-file-directory)
461 (if (executable-find program
)
462 (apply 'call-process program infile destination display args
)
465 (defun tramp-compat-process-running-p (process-name)
466 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
467 (when (stringp process-name
)
469 ;; GNU Emacs 22 on w32.
470 ((fboundp 'w32-window-exists-p
)
471 (tramp-compat-funcall 'w32-window-exists-p process-name process-name
))
474 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
476 (dolist (pid (tramp-compat-funcall 'list-system-processes
) result
)
477 (let ((attributes (tramp-compat-funcall 'process-attributes pid
)))
478 (when (and (string-equal
479 (cdr (assoc 'user attributes
)) (user-login-name))
480 (let ((comm (cdr (assoc 'comm attributes
))))
481 ;; The returned command name could be truncated
482 ;; to 15 characters. Therefore, we cannot check
483 ;; for `string-equal'.
484 (and comm
(string-match
485 (concat "^" (regexp-quote comm
))
489 ;; Fallback, if there is no Lisp support yet.
490 (t (let ((default-directory
491 (if (file-remote-p default-directory
)
492 (tramp-compat-temporary-file-directory)
494 (unix95 (getenv "UNIX95"))
496 (setenv "UNIX95" "1")
499 (tramp-compat-split-string
500 (shell-command-to-string
501 (format "ps -C %s -o user=" process-name
))
504 (setenv "UNIX95" unix95
)
507 ;; The following functions do not exist in XEmacs. We ignore this;
508 ;; they are used for checking a remote tty.
509 (defun tramp-compat-process-get (process propname
)
510 "Return the value of PROCESS' PROPNAME property.
511 This is the last value stored with `(process-put PROCESS PROPNAME VALUE)'."
512 (ignore-errors (tramp-compat-funcall 'process-get process propname
)))
514 (defun tramp-compat-process-put (process propname value
)
515 "Change PROCESS' PROPNAME property to VALUE.
516 It can be retrieved with `(process-get PROCESS PROPNAME)'."
517 (ignore-errors (tramp-compat-funcall 'process-put process propname value
)))
519 (defun tramp-compat-set-process-query-on-exit-flag (process flag
)
520 "Specify if query is needed for process when Emacs is exited.
521 If the second argument flag is non-nil, Emacs will query the user before
522 exiting if process is running."
523 (if (fboundp 'set-process-query-on-exit-flag
)
524 (tramp-compat-funcall 'set-process-query-on-exit-flag process flag
)
525 (tramp-compat-funcall 'process-kill-without-query process flag
)))
527 ;; There exist different implementations for this function.
528 (defun tramp-compat-coding-system-change-eol-conversion (coding-system eol-type
)
529 "Return a coding system like CODING-SYSTEM but with given EOL-TYPE.
530 EOL-TYPE can be one of `dos', `unix', or `mac'."
531 (cond ((fboundp 'coding-system-change-eol-conversion
)
532 (tramp-compat-funcall
533 'coding-system-change-eol-conversion coding-system eol-type
))
534 ((fboundp 'subsidiary-coding-system
)
535 (tramp-compat-funcall
536 'subsidiary-coding-system coding-system
537 (cond ((eq eol-type
'dos
) 'crlf
)
538 ((eq eol-type
'unix
) 'lf
)
539 ((eq eol-type
'mac
) 'cr
)
541 (error "Unknown EOL-TYPE `%s', must be %s"
543 "`dos', `unix', or `mac'")))))
544 (t (error "Can't change EOL conversion -- is MULE missing?"))))
546 (add-hook 'tramp-unload-hook
548 (unload-feature 'tramp-compat
'force
)))
550 (provide 'tramp-compat
)
554 ;;; tramp-compat.el ends here