1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
5 ;; Author: Michael Albinus <michael.albinus@gmx.de>
6 ;; Keywords: comm, processes
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software: you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;; Tramp's main Emacs version for development is GNU Emacs 23. This
26 ;; package provides compatibility functions for GNU Emacs 21, GNU
27 ;; Emacs 22 and XEmacs 21.4+.
33 ;; Pacify byte-compiler.
40 ;; Load the appropriate timer package.
41 (if (featurep 'xemacs
)
42 (require 'timer-funcs
)
45 (autoload 'tramp-tramp-file-p
"tramp")
46 (autoload 'tramp-file-name-handler
"tramp")
47 (autoload 'tramp-handle-file-remote-p
"tramp")
49 ;; tramp-util offers integration into other (X)Emacs packages like
50 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
51 (eval-after-load "tramp"
52 ;; We check whether `start-file-process' is an alias.
53 '(when (or (not (fboundp 'start-file-process
))
54 (symbolp (symbol-function 'start-file-process
)))
56 (add-hook 'tramp-unload-hook
58 (when (featurep 'tramp-util
)
59 (unload-feature 'tramp-util
'force
))))))
61 ;; Make sure that we get integration with the VC package. When it
62 ;; is loaded, we need to pull in the integration module. Not
63 ;; necessary in Emacs 23.
65 (eval-after-load "tramp"
66 ;; We check whether `start-file-process' is an alias.
67 '(when (or (not (fboundp 'start-file-process
))
68 (symbolp (symbol-function 'start-file-process
)))
70 (add-hook 'tramp-unload-hook
72 (when (featurep 'tramp-vc
)
73 (unload-feature 'tramp-vc
'force
)))))))
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 (unless (boundp 'byte-compile-not-obsolete-var
)
90 (defvar byte-compile-not-obsolete-var nil
))
91 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
92 (if (boundp 'byte-compile-not-obsolete-vars
) ; Emacs 23.2
93 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
95 ;; `with-temp-message' does not exists in XEmacs.
97 (with-temp-message (current-message) nil
)
98 (error (defmacro with-temp-message
(message &rest body
) `(progn ,@body
))))
100 ;; `set-buffer-multibyte' comes from Emacs Leim.
101 (unless (fboundp 'set-buffer-multibyte
)
102 (defalias 'set-buffer-multibyte
'ignore
))
104 ;; `font-lock-add-keywords' does not exist in XEmacs.
105 (unless (fboundp 'font-lock-add-keywords
)
106 (defalias 'font-lock-add-keywords
'ignore
))
108 ;; The following functions cannot be aliases of the corresponding
109 ;; `tramp-handle-*' functions, because this would bypass the locking
112 ;; `file-remote-p' has been introduced with Emacs 22. The version
113 ;; of XEmacs is not a magic file name function (yet); this is
114 ;; corrected in tramp-util.el. Here it is sufficient if the
116 (unless (fboundp 'file-remote-p
)
117 (defalias 'file-remote-p
118 (lambda (file &optional identification connected
)
119 (when (tramp-tramp-file-p file
)
120 (tramp-file-name-handler
121 'file-remote-p file identification connected
)))))
123 ;; `process-file' exists since Emacs 22.
124 (unless (fboundp 'process-file
)
125 (defalias 'process-file
126 (lambda (program &optional infile buffer display
&rest args
)
127 (when (tramp-tramp-file-p default-directory
)
129 'tramp-file-name-handler
130 'process-file program infile buffer display args
)))))
132 ;; `start-file-process' is new in Emacs 23.
133 (unless (fboundp 'start-file-process
)
134 (defalias 'start-file-process
135 (lambda (name buffer program
&rest program-args
)
136 (when (tramp-tramp-file-p default-directory
)
138 'tramp-file-name-handler
139 'start-file-process name buffer program program-args
)))))
141 ;; `set-file-times' is also new in Emacs 23.
142 (unless (fboundp 'set-file-times
)
143 (defalias 'set-file-times
144 (lambda (filename &optional time
)
145 (when (tramp-tramp-file-p filename
)
146 (tramp-file-name-handler
147 'set-file-times filename time
)))))
149 ;; We currently use "[" and "]" in the filename format for IPv6
150 ;; hosts of GNU Emacs. This means, that Emacs wants to expand
151 ;; wildcards if `find-file-wildcards' is non-nil, and then barfs
152 ;; because no expansion could be found. We detect this situation
153 ;; and do something really awful: we have `file-expand-wildcards'
154 ;; return the original filename if it can't expand anything. Let's
155 ;; just hope that this doesn't break anything else.
156 ;; It is not needed anymore since GNU Emacs 23.2.
157 (unless (or (featurep 'xemacs
) (featurep 'files
'remote-wildcards
))
158 (defadvice file-expand-wildcards
159 (around tramp-advice-file-expand-wildcards activate
)
160 (let ((name (ad-get-arg 0)))
161 ;; If it's a Tramp file, look if wildcards need to be expanded
164 (tramp-tramp-file-p name
)
166 "[[*?]" (tramp-handle-file-remote-p name
'localname
))))
167 (setq ad-return-value
(list name
))
168 ;; Otherwise, just run the original function.
174 'file-expand-wildcards
'around
'tramp-advice-file-expand-wildcards
)
175 (ad-activate 'file-expand-wildcards
)))))
177 (defsubst tramp-compat-line-beginning-position
()
178 "Return point at beginning of line (compat function).
179 Calls `line-beginning-position' or `point-at-bol' if defined, else
182 ((fboundp 'line-beginning-position
)
183 (funcall (symbol-function 'line-beginning-position
)))
184 ((fboundp 'point-at-bol
) (funcall (symbol-function 'point-at-bol
)))
185 (t (save-excursion (beginning-of-line) (point)))))
187 (defsubst tramp-compat-line-end-position
()
188 "Return point at end of line (compat function).
189 Calls `line-end-position' or `point-at-eol' if defined, else
192 ((fboundp 'line-end-position
) (funcall (symbol-function 'line-end-position
)))
193 ((fboundp 'point-at-eol
) (funcall (symbol-function 'point-at-eol
)))
194 (t (save-excursion (end-of-line) (point)))))
196 (defsubst tramp-compat-temporary-file-directory
()
197 "Return name of directory for temporary files (compat function).
198 For Emacs, this is the variable `temporary-file-directory', for XEmacs
199 this is the function `temp-directory'."
201 ((boundp 'temporary-file-directory
) (symbol-value 'temporary-file-directory
))
202 ((fboundp 'temp-directory
) (funcall (symbol-function 'temp-directory
)))
203 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
204 (file-name-as-directory (getenv "TEMP")))
205 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
206 (file-name-as-directory (getenv "TMP")))
207 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
208 (file-name-as-directory (getenv "TMPDIR")))
209 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
210 (t (message (concat "Neither `temporary-file-directory' nor "
211 "`temp-directory' is defined -- using /tmp."))
212 (file-name-as-directory "/tmp"))))
214 ;; `make-temp-file' exists in Emacs only. The third parameter SUFFIX
215 ;; has been introduced with Emacs 22. We try it, if it fails, we fall
216 ;; back to `make-temp-name', creating the temporary file immediately
217 ;; in order to avoid a security hole.
218 (defsubst tramp-compat-make-temp-file
(filename)
219 "Create a temporary file (compat function).
220 Add the extension of FILENAME, if existing."
221 (let* (file-name-handler-alist
222 (prefix (expand-file-name
223 (symbol-value 'tramp-temp-name-prefix
)
224 (tramp-compat-temporary-file-directory)))
225 (extension (file-name-extension filename t
))
229 (funcall (symbol-function 'make-temp-file
) prefix nil extension
))
231 ;; We use our own implementation, taken from files.el.
235 (setq result
(concat (make-temp-name prefix
) extension
))
237 "" nil result nil
'silent nil
238 ;; 7th parameter is MUSTBENEW in Emacs, and
239 ;; CODING-SYSTEM in XEmacs. It is not a security
240 ;; hole in XEmacs if we cannot use this parameter,
241 ;; because XEmacs uses a user-specific subdirectory
242 ;; with 0700 permissions.
243 (when (not (featurep 'xemacs
)) 'excl
))
245 (file-already-exists t
))
246 ;; The file was somehow created by someone else between
247 ;; `make-temp-name' and `write-region', let's try again.
251 ;; `most-positive-fixnum' arrived in Emacs 22. Before, and in XEmacs,
252 ;; it is a fixed value.
253 (defsubst tramp-compat-most-positive-fixnum
()
254 "Return largest positive integer value (compat function)."
256 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
257 ;; Default value in XEmacs and Emacs 21.
260 ;; ID-FORMAT exists since Emacs 22.
261 (defun tramp-compat-file-attributes (filename &optional id-format
)
262 "Like `file-attributes' for Tramp files (compat function)."
264 ((or (null id-format
) (eq id-format
'integer
))
265 (file-attributes filename
))
266 ((tramp-tramp-file-p filename
)
267 (tramp-file-name-handler 'file-attributes filename id-format
))
268 (t (condition-case nil
269 (funcall (symbol-function 'file-attributes
) filename id-format
)
270 (error (file-attributes filename
))))))
272 ;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
273 ;; hurt to ignore it for other (X)Emacs versions.
274 (defun tramp-compat-copy-file
275 (filename newname
&optional ok-if-already-exists keep-date preserve-uid-gid
)
276 "Like `copy-file' for Tramp files (compat function)."
279 (symbol-function 'copy-file
)
280 filename newname ok-if-already-exists keep-date preserve-uid-gid
)
281 (copy-file filename newname ok-if-already-exists keep-date
)))
283 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
284 ;; is taken from there.
285 (defun tramp-compat-copy-directory
286 (directory newname
&optional keep-time parents
)
287 "Make a copy of DIRECTORY (compat function)."
288 (if (fboundp 'copy-directory
)
290 (symbol-function 'copy-directory
) directory newname keep-time parents
)
292 ;; If default-directory is a remote directory, make sure we find
293 ;; its copy-directory handler.
294 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
295 (find-file-name-handler newname
'copy-directory
))))
297 (funcall handler
'copy-directory directory newname keep-time parents
)
299 ;; Compute target name.
300 (setq directory
(directory-file-name (expand-file-name directory
))
301 newname
(directory-file-name (expand-file-name newname
)))
302 (if (and (file-directory-p newname
)
303 (not (string-equal (file-name-nondirectory directory
)
304 (file-name-nondirectory newname
))))
307 (file-name-nondirectory directory
) newname
)))
308 (if (not (file-directory-p newname
)) (make-directory newname parents
))
313 (if (file-directory-p file
)
314 (tramp-compat-copy-directory file newname keep-time parents
)
315 (copy-file file newname t keep-time
)))
316 ;; We do not want to delete "." and "..".
318 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
320 ;; Set directory attributes.
321 (set-file-modes newname
(file-modes directory
))
323 (set-file-times newname
(nth 5 (file-attributes directory
))))))))
325 ;; `copy-tree' is a built-in function in XEmacs. In Emacs 21, it is
326 ;; an autoloaded function in cl-extra.el. Since Emacs 22, it is part
327 ;; of subr.el. There are problems when autoloading, therefore we test
328 ;; for `subrp' and `symbol-file'. Implementation is taken from Emacs 23.
329 (defun tramp-compat-copy-tree (tree)
330 "Make a copy of TREE (compat function)."
331 (if (or (subrp 'copy-tree
) (symbol-file 'copy-tree
))
332 (funcall (symbol-function 'copy-tree
) tree
)
335 (let ((newcar (car tree
)))
336 (if (consp (car tree
))
337 (setq newcar
(tramp-compat-copy-tree (car tree
))))
338 (push newcar result
))
339 (setq tree
(cdr tree
)))
340 (nconc (nreverse result
) tree
))))
342 ;; RECURSIVE has been introduced with Emacs 23.2.
343 (defun tramp-compat-delete-directory (directory &optional recursive
)
344 "Like `delete-directory' for Tramp files (compat function)."
346 (funcall (symbol-function 'delete-directory
) directory recursive
)
347 (delete-directory directory
)))
349 ;; `number-sequence' has been introduced in Emacs 22. Implementation
350 ;; is taken from Emacs 23.
351 (defun tramp-compat-number-sequence (from &optional to inc
)
352 "Return a sequence of numbers from FROM to TO as a list (compat function)."
353 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
354 (funcall (symbol-function 'number-sequence
) from to inc
)
355 (if (or (not to
) (= from to
))
357 (or inc
(setq inc
1))
358 (when (zerop inc
) (error "The increment can not be zero"))
359 (let (seq (n 0) (next from
))
362 (setq seq
(cons next seq
)
364 next
(+ from
(* n inc
))))
366 (setq seq
(cons next seq
)
368 next
(+ from
(* n inc
)))))
371 (defun tramp-compat-split-string (string pattern
)
372 "Like `split-string' but omit empty strings.
373 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
374 This is, the first, empty, element is omitted. In XEmacs, the first
375 element is not omitted."
376 (delete "" (split-string string pattern
)))
378 (defun tramp-compat-process-running-p (process-name)
379 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
380 (when (stringp process-name
)
382 ;; GNU Emacs 22 on w32.
383 ((fboundp 'w32-window-exists-p
)
384 (funcall (symbol-function 'w32-window-exists-p
)
385 process-name process-name
))
388 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
390 (dolist (pid (funcall (symbol-function 'list-system-processes
)) result
)
392 (funcall (symbol-function 'process-attributes
) pid
)))
393 (when (and (string-equal
394 (cdr (assoc 'user attributes
)) (user-login-name))
395 (let ((comm (cdr (assoc 'comm attributes
))))
396 ;; The returned command name could be truncated
397 ;; to 15 characters. Therefore, we cannot check
398 ;; for `string-equal'.
399 (and comm
(string-match
400 (concat "^" (regexp-quote comm
))
404 ;; Fallback, if there is no Lisp support yet.
405 (t (let ((default-directory
406 (if (file-remote-p default-directory
)
407 (tramp-compat-temporary-file-directory)
409 (unix95 (getenv "UNIX95"))
411 (setenv "UNIX95" "1")
414 (tramp-compat-split-string
415 (shell-command-to-string
416 (format "ps -C %s -o user=" process-name
))
419 (setenv "UNIX95" unix95
)
422 (provide 'tramp-compat
)
426 ;; arch-tag: 0e724b18-6699-4f87-ad96-640b272e5c85
427 ;;; tramp-compat.el ends here