1 ;;; tramp-compat.el --- Tramp compatibility functions
3 ;; Copyright (C) 2007-2016 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 25. This
27 ;; package provides compatibility functions for Emacs 23 and Emacs 24.
31 ;; Pacify byte-compiler.
35 (require 'auth-source)
38 (require 'format-spec)
39 (require 'password-cache)
42 (require 'ucs-normalize)
45 (require 'tramp-loaddefs)
47 ;; `remote-file-name-inhibit-cache' has been introduced with Emacs
48 ;; 24.1. Besides t, nil, and integer, we use also timestamps (as
49 ;; returned by `current-time') internally.
50 (unless (boundp 'remote-file-name-inhibit-cache)
51 (defvar remote-file-name-inhibit-cache nil))
53 ;; For not existing functions, obsolete functions, or functions with a
54 ;; changed argument list, there are compiler warnings. We want to
55 ;; avoid them in cases we know what we do.
56 (defmacro tramp-compat-funcall (function &rest arguments)
57 `(when (or (subrp ,function) (functionp ,function))
58 (with-no-warnings (funcall ,function ,@arguments))))
60 ;; We currently use "[" and "]" in the filename format for IPv6 hosts
61 ;; of GNU Emacs. This means that Emacs wants to expand wildcards if
62 ;; `find-file-wildcards' is non-nil, and then barfs because no
63 ;; expansion could be found. We detect this situation and do
64 ;; something really awful: we have `file-expand-wildcards' return the
65 ;; original filename if it can't expand anything. Let's just hope
66 ;; that this doesn't break anything else. It is not needed anymore
67 ;; since GNU Emacs 23.2.
68 (unless (featurep 'files 'remote-wildcards)
69 (defadvice file-expand-wildcards
70 (around tramp-advice-file-expand-wildcards activate)
71 (let ((name (ad-get-arg 0)))
72 ;; If it's a Tramp file, look if wildcards need to be expanded
75 (tramp-tramp-file-p name)
76 (not (string-match "[[*?]" (file-remote-p name 'localname))))
77 (setq ad-return-value (list name))
78 ;; Otherwise, just run the original function.
84 'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
85 (ad-activate 'file-expand-wildcards))))
87 ;; `condition-case-unless-debug' is introduced with Emacs 24.
88 (if (fboundp 'condition-case-unless-debug)
89 (defalias 'tramp-compat-condition-case-unless-debug
90 'condition-case-unless-debug)
91 (defmacro tramp-compat-condition-case-unless-debug
92 (var bodyform &rest handlers)
93 "Like `condition-case' except that it does not catch anything when debugging."
94 (declare (debug condition-case) (indent 2))
95 (let ((bodysym (make-symbol "body")))
96 `(let ((,bodysym (lambda () ,bodyform)))
103 (defsubst tramp-compat-temporary-file-directory ()
104 "Return name of directory for temporary files.
105 It is the default value of `temporary-file-directory'."
106 ;; We must return a local directory. If it is remote, we could run
108 (eval (car (get 'temporary-file-directory 'standard-value))))
110 (defsubst tramp-compat-make-temp-file (f &optional dir-flag)
111 "Create a local temporary file (compat function).
112 Add the extension of F, if existing."
113 (let* (file-name-handler-alist
114 (prefix (expand-file-name
115 (symbol-value 'tramp-temp-name-prefix)
116 (tramp-compat-temporary-file-directory)))
117 (extension (file-name-extension f t)))
118 (make-temp-file prefix dir-flag extension)))
120 ;; PRESERVE-EXTENDED-ATTRIBUTES has been introduced with Emacs 24.1
121 ;; (as PRESERVE-SELINUX-CONTEXT), and renamed in Emacs 24.3.
122 (defun tramp-compat-copy-file
123 (filename newname &optional ok-if-already-exists keep-date
124 preserve-uid-gid preserve-extended-attributes)
125 "Like `copy-file' for Tramp files (compat function)."
127 (preserve-extended-attributes
129 (tramp-compat-funcall
130 'copy-file filename newname ok-if-already-exists keep-date
131 preserve-uid-gid preserve-extended-attributes)
132 (wrong-number-of-arguments
134 filename newname ok-if-already-exists keep-date preserve-uid-gid))))
137 filename newname ok-if-already-exists keep-date preserve-uid-gid))))
139 ;; COPY-CONTENTS has been introduced with Emacs 24.1.
140 (defun tramp-compat-copy-directory
141 (directory newname &optional keep-time parents copy-contents)
142 "Make a copy of DIRECTORY (compat function)."
144 (tramp-compat-funcall
145 'copy-directory directory newname keep-time parents copy-contents)
147 ;; `copy-directory' is either not implemented, or it does not
148 ;; support the the COPY-CONTENTS flag. For the time being, we
149 ;; ignore COPY-CONTENTS as well.
152 ;; If `default-directory' is a remote directory, make sure we
153 ;; find its `copy-directory' handler.
154 (let ((handler (or (find-file-name-handler directory 'copy-directory)
155 (find-file-name-handler newname 'copy-directory))))
157 (funcall handler 'copy-directory directory newname keep-time parents)
159 ;; Compute target name.
160 (setq directory (directory-file-name (expand-file-name directory))
161 newname (directory-file-name (expand-file-name newname)))
162 (if (and (file-directory-p newname)
163 (not (string-equal (file-name-nondirectory directory)
164 (file-name-nondirectory newname))))
167 (file-name-nondirectory directory) newname)))
168 (if (not (file-directory-p newname)) (make-directory newname parents))
173 (if (file-directory-p file)
174 (tramp-compat-copy-directory file newname keep-time parents)
175 (copy-file file newname t keep-time)))
176 ;; We do not want to delete "." and "..".
178 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
180 ;; Set directory attributes.
181 (set-file-modes newname (file-modes directory))
183 (set-file-times newname (nth 5 (file-attributes directory)))))))))
185 ;; TRASH has been introduced with Emacs 24.1.
186 (defun tramp-compat-delete-file (filename &optional trash)
187 "Like `delete-file' for Tramp files (compat function)."
189 (tramp-compat-funcall 'delete-file filename trash)
190 ;; This Emacs version does not support the TRASH flag.
191 (wrong-number-of-arguments
192 (let ((delete-by-moving-to-trash
193 (and (boundp 'delete-by-moving-to-trash)
194 (symbol-value 'delete-by-moving-to-trash)
196 (delete-file filename)))))
198 ;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been
199 ;; introduced with Emacs 24.1.
200 (defun tramp-compat-delete-directory (directory &optional recursive trash)
201 "Like `delete-directory' for Tramp files (compat function)."
205 (tramp-compat-funcall 'delete-directory directory recursive trash))
207 (delete-directory directory recursive)))
208 ;; This Emacs version does not support the TRASH flag. We use the
209 ;; implementation from Emacs 23.2.
210 (wrong-number-of-arguments
211 (setq directory (directory-file-name (expand-file-name directory)))
212 (if (not (file-symlink-p directory))
214 (if (eq t (car (file-attributes file)))
215 (tramp-compat-delete-directory file recursive trash)
216 (tramp-compat-delete-file file trash)))
218 directory 'full "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")))
219 (delete-directory directory))))
221 (defun tramp-compat-process-running-p (process-name)
222 "Returns t if system process PROCESS-NAME is running for `user-login-name'."
223 (when (stringp process-name)
225 ;; GNU Emacs 22 on w32.
226 ((fboundp 'w32-window-exists-p)
227 (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
230 ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
232 (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
233 (let ((attributes (process-attributes pid)))
234 (when (and (string-equal
235 (cdr (assoc 'user attributes)) (user-login-name))
236 (let ((comm (cdr (assoc 'comm attributes))))
237 ;; The returned command name could be truncated
238 ;; to 15 characters. Therefore, we cannot check
239 ;; for `string-equal'.
240 (and comm (string-match
241 (concat "^" (regexp-quote comm))
243 (setq result t)))))))))
245 ;; `default-toplevel-value' has been declared in Emacs 24.
246 (unless (fboundp 'default-toplevel-value)
247 (defalias 'default-toplevel-value 'symbol-value))
249 ;; `format-message' is new in Emacs 25.
250 (unless (fboundp 'format-message)
251 (defalias 'format-message 'format))
253 (add-hook 'tramp-unload-hook
255 (unload-feature 'tramp-loaddefs 'force)
256 (unload-feature 'tramp-compat 'force)))
258 (provide 'tramp-compat)
262 ;;; tramp-compat.el ends here