1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007, 2008, 2009 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")
48 ;; tramp-util offers integration into other (X)Emacs packages like
49 ;; compile.el, gud.el etc. Not necessary in Emacs 23.
50 (eval-after-load "tramp"
51 ;; We check whether `start-file-process' is an alias.
52 '(when (or (not (fboundp 'start-file-process
))
53 (symbolp (symbol-function 'start-file-process
)))
55 (add-hook 'tramp-unload-hook
57 (when (featurep 'tramp-util
)
58 (unload-feature 'tramp-util
'force
))))))
60 ;; Make sure that we get integration with the VC package. When it
61 ;; is loaded, we need to pull in the integration module. Not
62 ;; necessary in Emacs 23.
64 (eval-after-load "tramp"
65 ;; We check whether `start-file-process' is an alias.
66 '(when (or (not (fboundp 'start-file-process
))
67 (symbolp (symbol-function 'start-file-process
)))
69 (add-hook 'tramp-unload-hook
71 (when (featurep 'tramp-vc
)
72 (unload-feature 'tramp-vc
'force
)))))))
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 (unless (boundp 'byte-compile-not-obsolete-var
)
89 (defvar byte-compile-not-obsolete-var nil
))
90 (setq byte-compile-not-obsolete-var
'directory-sep-char
)
91 (if (boundp 'byte-compile-not-obsolete-vars
) ; Emacs 23.2
92 (setq byte-compile-not-obsolete-vars
'(directory-sep-char)))
94 ;; `with-temp-message' does not exists in XEmacs.
96 (with-temp-message (current-message) nil
)
97 (error (defmacro with-temp-message
(message &rest body
) `(progn ,@body
))))
99 ;; `set-buffer-multibyte' comes from Emacs Leim.
100 (unless (fboundp 'set-buffer-multibyte
)
101 (defalias 'set-buffer-multibyte
'ignore
))
103 ;; `font-lock-add-keywords' does not exist in XEmacs.
104 (unless (fboundp 'font-lock-add-keywords
)
105 (defalias 'font-lock-add-keywords
'ignore
))
107 ;; The following functions cannot be aliases of the corresponding
108 ;; `tramp-handle-*' functions, because this would bypass the locking
111 ;; `file-remote-p' has been introduced with Emacs 22. The version
112 ;; of XEmacs is not a magic file name function (yet); this is
113 ;; corrected in tramp-util.el. Here it is sufficient if the
115 (unless (fboundp 'file-remote-p
)
116 (defalias 'file-remote-p
117 (lambda (file &optional identification connected
)
118 (when (tramp-tramp-file-p file
)
119 (tramp-file-name-handler
120 'file-remote-p file identification connected
)))))
122 ;; `process-file' exists since Emacs 22.
123 (unless (fboundp 'process-file
)
124 (defalias 'process-file
125 (lambda (program &optional infile buffer display
&rest args
)
126 (when (tramp-tramp-file-p default-directory
)
128 'tramp-file-name-handler
129 'process-file program infile buffer display args
)))))
131 ;; `start-file-process' is new in Emacs 23.
132 (unless (fboundp 'start-file-process
)
133 (defalias 'start-file-process
134 (lambda (name buffer program
&rest program-args
)
135 (when (tramp-tramp-file-p default-directory
)
137 'tramp-file-name-handler
138 'start-file-process name buffer program program-args
)))))
140 ;; `set-file-times' is also new in Emacs 23.
141 (unless (fboundp 'set-file-times
)
142 (defalias 'set-file-times
143 (lambda (filename &optional time
)
144 (when (tramp-tramp-file-p filename
)
145 (tramp-file-name-handler
146 'set-file-times filename time
))))))
148 (defsubst tramp-compat-line-beginning-position
()
149 "Return point at beginning of line (compat function).
150 Calls `line-beginning-position' or `point-at-bol' if defined, else
153 ((fboundp 'line-beginning-position
)
154 (funcall (symbol-function 'line-beginning-position
)))
155 ((fboundp 'point-at-bol
) (funcall (symbol-function 'point-at-bol
)))
156 (t (save-excursion (beginning-of-line) (point)))))
158 (defsubst tramp-compat-line-end-position
()
159 "Return point at end of line (compat function).
160 Calls `line-end-position' or `point-at-eol' if defined, else
163 ((fboundp 'line-end-position
) (funcall (symbol-function 'line-end-position
)))
164 ((fboundp 'point-at-eol
) (funcall (symbol-function 'point-at-eol
)))
165 (t (save-excursion (end-of-line) (point)))))
167 (defsubst tramp-compat-temporary-file-directory
()
168 "Return name of directory for temporary files (compat function).
169 For Emacs, this is the variable `temporary-file-directory', for XEmacs
170 this is the function `temp-directory'."
172 ((boundp 'temporary-file-directory
) (symbol-value 'temporary-file-directory
))
173 ((fboundp 'temp-directory
) (funcall (symbol-function 'temp-directory
)))
174 ((let ((d (getenv "TEMP"))) (and d
(file-directory-p d
)))
175 (file-name-as-directory (getenv "TEMP")))
176 ((let ((d (getenv "TMP"))) (and d
(file-directory-p d
)))
177 (file-name-as-directory (getenv "TMP")))
178 ((let ((d (getenv "TMPDIR"))) (and d
(file-directory-p d
)))
179 (file-name-as-directory (getenv "TMPDIR")))
180 ((file-exists-p "c:/temp") (file-name-as-directory "c:/temp"))
181 (t (message (concat "Neither `temporary-file-directory' nor "
182 "`temp-directory' is defined -- using /tmp."))
183 (file-name-as-directory "/tmp"))))
185 ;; `make-temp-file' exists in Emacs only. The third parameter SUFFIX
186 ;; has been introduced with Emacs 22. We try it, if it fails, we fall
187 ;; back to `make-temp-name', creating the temporary file immediately
188 ;; in order to avoid a security hole.
189 (defsubst tramp-compat-make-temp-file
(filename)
190 "Create a temporary file (compat function).
191 Add the extension of FILENAME, if existing."
192 (let* (file-name-handler-alist
193 (prefix (expand-file-name
194 (symbol-value 'tramp-temp-name-prefix
)
195 (tramp-compat-temporary-file-directory)))
196 (extension (file-name-extension filename t
))
200 (funcall (symbol-function 'make-temp-file
) prefix nil extension
))
202 ;; We use our own implementation, taken from files.el.
206 (setq result
(concat (make-temp-name prefix
) extension
))
208 "" nil result nil
'silent nil
209 ;; 7th parameter is MUSTBENEW in Emacs, and
210 ;; CODING-SYSTEM in XEmacs. It is not a security
211 ;; hole in XEmacs if we cannot use this parameter,
212 ;; because XEmacs uses a user-specific subdirectory
213 ;; with 0700 permissions.
214 (when (not (featurep 'xemacs
)) 'excl
))
216 (file-already-exists t
))
217 ;; The file was somehow created by someone else between
218 ;; `make-temp-name' and `write-region', let's try again.
222 ;; `most-positive-fixnum' arrived in Emacs 22. Before, and in XEmacs,
223 ;; it is a fixed value.
224 (defsubst tramp-compat-most-positive-fixnum
()
225 "Return largest positive integer value (compat function)."
227 ((boundp 'most-positive-fixnum
) (symbol-value 'most-positive-fixnum
))
228 ;; Default value in XEmacs and Emacs 21.
231 ;; ID-FORMAT exists since Emacs 22.
232 (defun tramp-compat-file-attributes (filename &optional id-format
)
233 "Like `file-attributes' for Tramp files (compat function)."
235 ((or (null id-format
) (eq id-format
'integer
))
236 (file-attributes filename
))
237 ((tramp-tramp-file-p filename
)
238 (tramp-file-name-handler 'file-attributes filename id-format
))
239 (t (condition-case nil
240 (funcall (symbol-function 'file-attributes
) filename id-format
)
241 (error (file-attributes filename
))))))
243 ;; PRESERVE-UID-GID has been introduced with Emacs 23. It does not
244 ;; hurt to ignore it for other (X)Emacs versions.
245 (defun tramp-compat-copy-file
246 (filename newname
&optional ok-if-already-exists keep-date preserve-uid-gid
)
247 "Like `copy-file' for Tramp files (compat function)."
250 (symbol-function 'copy-file
)
251 filename newname ok-if-already-exists keep-date preserve-uid-gid
)
252 (copy-file filename newname ok-if-already-exists keep-date
)))
254 ;; `copy-directory' is a new function in Emacs 23.2. Implementation
255 ;; is taken from there.
256 (defun tramp-compat-copy-directory
257 (directory newname
&optional keep-time parents
)
258 "Make a copy of DIRECTORY (compat function)."
259 (if (fboundp 'copy-directory
)
261 (symbol-function 'copy-directory
) directory newname keep-time parents
)
263 ;; If default-directory is a remote directory, make sure we find
264 ;; its copy-directory handler.
265 (let ((handler (or (find-file-name-handler directory
'copy-directory
)
266 (find-file-name-handler newname
'copy-directory
))))
268 (funcall handler
'copy-directory directory newname keep-time parents
)
270 ;; Compute target name.
271 (setq directory
(directory-file-name (expand-file-name directory
))
272 newname
(directory-file-name (expand-file-name newname
)))
273 (if (and (file-directory-p newname
)
274 (not (string-equal (file-name-nondirectory directory
)
275 (file-name-nondirectory newname
))))
278 (file-name-nondirectory directory
) newname
)))
279 (if (not (file-directory-p newname
)) (make-directory newname parents
))
284 (if (file-directory-p file
)
285 (tramp-compat-copy-directory file newname keep-time parents
)
286 (copy-file file newname t keep-time
)))
287 ;; We do not want to delete "." and "..".
289 directory
'full
"^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
291 ;; Set directory attributes.
292 (set-file-modes newname
(file-modes directory
))
294 (set-file-times newname
(nth 5 (file-attributes directory
))))))))
296 ;; `copy-tree' is a built-in function in XEmacs. In Emacs 21, it is
297 ;; an autoloaded function in cl-extra.el. Since Emacs 22, it is part
298 ;; of subr.el. There are problems when autoloading, therefore we test
299 ;; for `subrp' and `symbol-file'. Implementation is taken from Emacs 23.
300 (defun tramp-compat-copy-tree (tree)
301 "Make a copy of TREE (compat function)."
302 (if (or (subrp 'copy-tree
) (symbol-file 'copy-tree
))
303 (funcall (symbol-function 'copy-tree
) tree
)
306 (let ((newcar (car tree
)))
307 (if (consp (car tree
))
308 (setq newcar
(tramp-compat-copy-tree (car tree
))))
309 (push newcar result
))
310 (setq tree
(cdr tree
)))
311 (nconc (nreverse result
) tree
))))
313 ;; RECURSIVE has been introduced with Emacs 23.2.
314 (defun tramp-compat-delete-directory (directory &optional recursive
)
315 "Like `delete-directory' for Tramp files (compat function)."
317 (funcall (symbol-function 'delete-directory
) directory recursive
)
318 (delete-directory directory
)))
320 ;; `number-sequence' has been introduced in Emacs 22. Implementation
321 ;; is taken from Emacs 23.
322 (defun tramp-compat-number-sequence (from &optional to inc
)
323 "Return a sequence of numbers from FROM to TO as a list (compat function)."
324 (if (or (subrp 'number-sequence
) (symbol-file 'number-sequence
))
325 (funcall (symbol-function 'number-sequence
) from to inc
)
326 (if (or (not to
) (= from to
))
328 (or inc
(setq inc
1))
329 (when (zerop inc
) (error "The increment can not be zero"))
330 (let (seq (n 0) (next from
))
333 (setq seq
(cons next seq
)
335 next
(+ from
(* n inc
))))
337 (setq seq
(cons next seq
)
339 next
(+ from
(* n inc
)))))
342 (defun tramp-compat-split-string (string pattern
)
343 "Like `split-string' but omit empty strings.
344 In Emacs, (split-string \"/foo/bar\" \"/\") returns (\"foo\" \"bar\").
345 This is, the first, empty, element is omitted. In XEmacs, the first
346 element is not omitted."
347 (delete "" (split-string string pattern
)))
349 (defun tramp-compat-process-running-p (process-name)
350 "Returns `t' if system process PROCESS-NAME is running for `user-login-name'."
351 (when (stringp process-name
)
353 ;; GNU Emacs 22 on w32.
354 ((fboundp 'w32-window-exists-p
)
355 (funcall (symbol-function 'w32-window-exists-p
)
356 process-name process-name
))
359 ((and (fboundp 'list-system-processes
) (fboundp 'process-attributes
))
361 (dolist (pid (funcall (symbol-function 'list-system-processes
)) result
)
363 (funcall (symbol-function 'process-attributes
) pid
)))
364 (when (and (string-equal
365 (cdr (assoc 'user attributes
)) (user-login-name))
366 (let ((comm (cdr (assoc 'comm attributes
))))
367 ;; The returned command name could be truncated
368 ;; to 15 characters. Therefore, we cannot check
369 ;; for `string-equal'.
370 (and comm
(string-match
371 (concat "^" (regexp-quote comm
))
375 ;; Fallback, if there is no Lisp support yet.
376 (t (let ((default-directory
377 (if (file-remote-p default-directory
)
378 (tramp-compat-temporary-file-directory)
380 (unix95 (getenv "UNIX95"))
382 (setenv "UNIX95" "1")
385 (tramp-compat-split-string
386 (shell-command-to-string
387 (format "ps -C %s -o user=" process-name
))
390 (setenv "UNIX95" unix95
)
393 (provide 'tramp-compat
)
397 ;; arch-tag: 0e724b18-6699-4f87-ad96-640b272e5c85
398 ;;; tramp-compat.el ends here