tramp-compat.el 11.5 KB
Newer Older
Michael Albinus's avatar
Michael Albinus committed
1
;;; tramp-compat.el --- Tramp compatibility functions  -*- lexical-binding:t -*-
2

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 2007-2019 Free Software Foundation, Inc.
4 5 6

;; Author: Michael Albinus <michael.albinus@gmx.de>
;; Keywords: comm, processes
7
;; Package: tramp
8 9 10

;; 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 14
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
15 16 17 18 19 20 21

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
22
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
23 24 25

;;; Commentary:

26 27 28
;; Tramp's main Emacs version for development is Emacs 27.  This
;; package provides compatibility functions for Emacs 24, Emacs 25 and
;; Emacs 26.
29 30 31

;;; Code:

32 33 34 35 36
;; In Emacs 24 and 25, `tramp-unload-file-name-handlers' is not
;; autoloaded.  So we declare it here in order to avoid recursive
;; load.  This will be overwritten in tramp.el.
(defun tramp-unload-file-name-handlers ())

37 38
(require 'auth-source)
(require 'advice)
Michael Albinus's avatar
Michael Albinus committed
39
(require 'cl-lib)
40 41
(require 'custom)
(require 'format-spec)
Michael Albinus's avatar
Michael Albinus committed
42
(require 'parse-time)
43 44 45 46 47
(require 'password-cache)
(require 'shell)
(require 'timer)
(require 'ucs-normalize)

48 49 50
;; For not existing functions, obsolete functions, or functions with a
;; changed argument list, there are compiler warnings.  We want to
;; avoid them in cases we know what we do.
51
(defmacro tramp-compat-funcall (function &rest arguments)
52
  "Call FUNCTION if it exists.  Do not raise compiler warnings."
53
  `(when (functionp ,function)
54 55
     (with-no-warnings (funcall ,function ,@arguments))))

56
(defsubst tramp-compat-temporary-file-directory ()
57 58 59 60 61 62
  "Return name of directory for temporary files.
It is the default value of `temporary-file-directory'."
  ;; We must return a local directory.  If it is remote, we could run
  ;; into an infloop.
  (eval (car (get 'temporary-file-directory 'standard-value))))

63
(defsubst tramp-compat-make-temp-file (f &optional dir-flag)
64
  "Create a local temporary file (compat function).
65
Add the extension of F, if existing."
66 67 68 69
  (let* (file-name-handler-alist
	 (prefix (expand-file-name
		  (symbol-value 'tramp-temp-name-prefix)
		  (tramp-compat-temporary-file-directory)))
70 71 72
	 (extension (file-name-extension f t)))
    (make-temp-file prefix dir-flag extension)))

73
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
74 75
(defalias 'tramp-compat-temporary-file-directory-function
  (if (fboundp 'temporary-file-directory)
76
      #'temporary-file-directory
77 78
    'tramp-handle-temporary-file-directory))

79
(defun tramp-compat-process-running-p (process-name)
80
  "Returns t if system process PROCESS-NAME is running for `user-login-name'."
81 82 83 84
  (when (stringp process-name)
    (cond
     ;; GNU Emacs 22 on w32.
     ((fboundp 'w32-window-exists-p)
85
      (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
86 87 88 89

     ;; GNU Emacs 23.
     ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
      (let (result)
90
	(dolist (pid (tramp-compat-funcall 'list-system-processes) result)
91
	  (let ((attributes (process-attributes pid)))
92 93 94 95 96 97
	    (when (and (string-equal
                        (cdr (assoc 'user attributes)) (user-login-name))
                       (let ((comm (cdr (assoc 'comm attributes))))
                         ;; The returned command name could be truncated
                         ;; to 15 characters.  Therefore, we cannot check
                         ;; for `string-equal'.
98
                         (and comm (string-match-p
99 100
                                    (concat "^" (regexp-quote comm))
                                    process-name))))
101
	      (setq result t)))))))))
102

103 104
;; `default-toplevel-value' has been declared in Emacs 24.4.
(unless (fboundp 'default-toplevel-value)
105
  (defalias 'default-toplevel-value #'symbol-value))
106

107 108 109
;; `file-attribute-*' are introduced in Emacs 25.1.

(if (fboundp 'file-attribute-type)
110
    (defalias 'tramp-compat-file-attribute-type #'file-attribute-type)
111 112 113 114 115 116 117 118
  (defsubst tramp-compat-file-attribute-type (attributes)
    "The type field in ATTRIBUTES returned by `file-attributes'.
The value is either t for directory, string (name linked to) for
symbolic link, or nil."
    (nth 0 attributes)))

(if (fboundp 'file-attribute-link-number)
    (defalias 'tramp-compat-file-attribute-link-number
119
      #'file-attribute-link-number)
120 121 122 123 124
  (defsubst tramp-compat-file-attribute-link-number (attributes)
    "Return the number of links in ATTRIBUTES returned by `file-attributes'."
    (nth 1 attributes)))

(if (fboundp 'file-attribute-user-id)
125
    (defalias 'tramp-compat-file-attribute-user-id #'file-attribute-user-id)
126 127 128 129 130 131 132 133
  (defsubst tramp-compat-file-attribute-user-id (attributes)
    "The UID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number.  If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
    (nth 2 attributes)))

(if (fboundp 'file-attribute-group-id)
134
    (defalias 'tramp-compat-file-attribute-group-id #'file-attribute-group-id)
135 136 137 138 139 140 141 142 143
  (defsubst tramp-compat-file-attribute-group-id (attributes)
    "The GID field in ATTRIBUTES returned by `file-attributes'.
This is either a string or a number.  If a string value cannot be
looked up, a numeric value, either an integer or a float, is
returned."
    (nth 3 attributes)))

(if (fboundp 'file-attribute-modification-time)
    (defalias 'tramp-compat-file-attribute-modification-time
144
      #'file-attribute-modification-time)
145 146 147
  (defsubst tramp-compat-file-attribute-modification-time (attributes)
    "The modification time in ATTRIBUTES returned by `file-attributes'.
This is the time of the last change to the file's contents, and
Paul Eggert's avatar
Paul Eggert committed
148
is a Lisp timestamp in the style of `current-time'."
149 150 151
    (nth 5 attributes)))

(if (fboundp 'file-attribute-size)
152
    (defalias 'tramp-compat-file-attribute-size #'file-attribute-size)
153 154
  (defsubst tramp-compat-file-attribute-size (attributes)
    "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
Paul Eggert's avatar
Paul Eggert committed
155 156
If the size is too large for a fixnum, this is a bignum in Emacs 27
and later, and is a float in Emacs 26 and earlier."
157 158 159
    (nth 7 attributes)))

(if (fboundp 'file-attribute-modes)
160
    (defalias 'tramp-compat-file-attribute-modes #'file-attribute-modes)
161 162 163 164 165
  (defsubst tramp-compat-file-attribute-modes (attributes)
    "The file modes in ATTRIBUTES returned by `file-attributes'.
This is a string of ten letters or dashes as in ls -l."
    (nth 8 attributes)))

166
;; `format-message' is new in Emacs 25.1.
167
(unless (fboundp 'format-message)
168
  (defalias 'format-message #'format))
169

170 171
;; `directory-name-p' is new in Emacs 25.1.
(if (fboundp 'directory-name-p)
172
    (defalias 'tramp-compat-directory-name-p #'directory-name-p)
173 174 175 176 177 178 179 180 181 182
  (defsubst tramp-compat-directory-name-p (name)
    "Return non-nil if NAME ends with a directory separator character."
    (let ((len (length name))
          (lastc ?.))
      (if (> len 0)
          (setq lastc (aref name (1- len))))
      (or (= lastc ?/)
          (and (memq system-type '(windows-nt ms-dos))
               (= lastc ?\\))))))

183
;; `file-missing' is introduced in Emacs 26.1.
Michael Albinus's avatar
Michael Albinus committed
184 185 186 187
(defconst tramp-file-missing
  (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
  "The error symbol for the `file-missing' error.")

188 189
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
;; `file-name-unquote' are introduced in Emacs 26.
Michael Albinus's avatar
Michael Albinus committed
190
(eval-and-compile
191
  (if (fboundp 'file-local-name)
192
      (defalias 'tramp-compat-file-local-name #'file-local-name)
193 194 195 196 197 198
    (defsubst tramp-compat-file-local-name (name)
      "Return the local name component of NAME.
It returns a file name which can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
      (or (file-remote-p name 'localname) name)))

Michael Albinus's avatar
Michael Albinus committed
199
  (if (fboundp 'file-name-quoted-p)
200
      (defalias 'tramp-compat-file-name-quoted-p #'file-name-quoted-p)
Michael Albinus's avatar
Michael Albinus committed
201 202
    (defsubst tramp-compat-file-name-quoted-p (name)
      "Whether NAME is quoted with prefix \"/:\".
203
If NAME is a remote file name, check the local part of NAME."
204
      (string-prefix-p "/:" (tramp-compat-file-local-name name))))
205

Michael Albinus's avatar
Michael Albinus committed
206
  (if (fboundp 'file-name-quote)
207
      (defalias 'tramp-compat-file-name-quote #'file-name-quote)
Michael Albinus's avatar
Michael Albinus committed
208 209
    (defsubst tramp-compat-file-name-quote (name)
      "Add the quotation prefix \"/:\" to file NAME.
210
If NAME is a remote file name, the local part of NAME is quoted."
Michael Albinus's avatar
Michael Albinus committed
211 212 213
      (if (tramp-compat-file-name-quoted-p name)
	  name
	(concat
214
	 (file-remote-p name) "/:" (tramp-compat-file-local-name name)))))
215

Michael Albinus's avatar
Michael Albinus committed
216
  (if (fboundp 'file-name-unquote)
217
      (defalias 'tramp-compat-file-name-unquote #'file-name-unquote)
Michael Albinus's avatar
Michael Albinus committed
218 219
    (defsubst tramp-compat-file-name-unquote (name)
      "Remove quotation prefix \"/:\" from file NAME.
220
If NAME is a remote file name, the local part of NAME is unquoted."
221
      (let ((localname (tramp-compat-file-local-name name)))
222 223 224 225
	(when (tramp-compat-file-name-quoted-p localname)
	  (setq
	   localname (if (= (length localname) 2) "/" (substring localname 2))))
	(concat (file-remote-p name) localname)))))
226

Michael Albinus's avatar
Michael Albinus committed
227 228 229 230
;; `tramp-syntax' has changed its meaning in Emacs 26.  We still
;; support old settings.
(defsubst tramp-compat-tramp-syntax ()
  "Return proper value of `tramp-syntax'."
231
  (defvar tramp-syntax)
Michael Albinus's avatar
Michael Albinus committed
232 233 234 235
  (cond ((eq tramp-syntax 'ftp) 'default)
	((eq tramp-syntax 'sep) 'separate)
	(t tramp-syntax)))

236 237 238
;; `cl-struct-slot-info' has been introduced with Emacs 25.
(defmacro tramp-compat-tramp-file-name-slots ()
  (if (fboundp 'cl-struct-slot-info)
239 240
      '(cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))
    '(cdr (mapcar #'car (get 'tramp-file-name 'cl-struct-slots)))))
241

242 243 244 245 246 247
;; The signature of `tramp-make-tramp-file-name' has been changed.
;; Therefore, we cannot us `url-tramp-convert-url-to-tramp' prior
;; Emacs 26.1.  We use `temporary-file-directory' as indicator.
(defconst tramp-compat-use-url-tramp-p (fboundp 'temporary-file-directory)
  "Whether to use url-tramp.el.")

248 249 250
;; `exec-path' is new in Emacs 27.1.
(eval-and-compile
  (if (fboundp 'exec-path)
251
      (defalias 'tramp-compat-exec-path #'exec-path)
252 253 254 255 256 257 258
    (defun tramp-compat-exec-path ()
      "List of directories to search programs to run in remote subprocesses."
      (let ((handler (find-file-name-handler default-directory 'exec-path)))
	(if handler
	    (funcall handler 'exec-path)
	  exec-path)))))

259 260
;; `time-equal-p' has appeared in Emacs 27.1.
(if (fboundp 'time-equal-p)
261
    (defalias 'tramp-compat-time-equal-p #'time-equal-p)
262 263 264 265 266
  (defsubst tramp-compat-time-equal-p (t1 t2)
    "Return non-nil if time value T1 is equal to time value T2.
A nil value for either argument stands for the current time."
    (equal (or t1 (current-time)) (or t2 (current-time)))))

Michael Albinus's avatar
Michael Albinus committed
267
;; `flatten-tree' has appeared in Emacs 27.1.
Michael Albinus's avatar
Michael Albinus committed
268
(if (fboundp 'flatten-tree)
269
    (defalias 'tramp-compat-flatten-tree #'flatten-tree)
Michael Albinus's avatar
Michael Albinus committed
270 271 272 273 274 275 276 277 278 279 280 281
  (defun tramp-compat-flatten-tree (tree)
    "Take TREE and \"flatten\" it."
    (let (elems)
      (setq tree (list tree))
      (while (let ((elem (pop tree)))
               (cond ((consp elem)
                      (setq tree (cons (car elem) (cons (cdr elem) tree))))
                     (elem
                      (push elem elems)))
               tree))
      (nreverse elems))))

282 283 284 285 286
(add-hook 'tramp-unload-hook
	  (lambda ()
	    (unload-feature 'tramp-loaddefs 'force)
	    (unload-feature 'tramp-compat 'force)))

287 288 289 290
(provide 'tramp-compat)

;;; TODO:

291
;; * When we get rid of Emacs 24, replace "(mapconcat #'identity" by
Michael Albinus's avatar
Michael Albinus committed
292 293
;;   "(string-join".

294
;;; tramp-compat.el ends here