tramp-compat.el 11.9 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
(declare-function tramp-compat-file-local-name 'tramp-compat)
(declare-function tramp-compat-file-name-quoted-p 'tramp-compat)

51 52 53
;; 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.
54
(defmacro tramp-compat-funcall (function &rest arguments)
55
  "Call FUNCTION if it exists.  Do not raise compiler warnings."
56
  `(when (functionp ,function)
57 58
     (with-no-warnings (funcall ,function ,@arguments))))

59
(defsubst tramp-compat-temporary-file-directory ()
60 61 62 63 64 65
  "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))))

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

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

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

     ;; GNU Emacs 23.
     ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
      (let (result)
93
	(dolist (pid (tramp-compat-funcall 'list-system-processes) result)
94
	  (let ((attributes (process-attributes pid)))
95 96 97 98 99 100
	    (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'.
101
                         (and comm (string-match-p
102 103
                                    (concat "^" (regexp-quote comm))
                                    process-name))))
104
	      (setq result t)))))))))
105

106 107
;; `default-toplevel-value' has been declared in Emacs 24.4.
(unless (fboundp 'default-toplevel-value)
108
  (defalias 'default-toplevel-value #'symbol-value))
109

110 111 112
;; `file-attribute-*' are introduced in Emacs 25.1.

(if (fboundp 'file-attribute-type)
113
    (defalias 'tramp-compat-file-attribute-type #'file-attribute-type)
114 115 116 117 118 119 120 121
  (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
122
      #'file-attribute-link-number)
123 124 125 126 127
  (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)
128
    (defalias 'tramp-compat-file-attribute-user-id #'file-attribute-user-id)
129 130 131 132 133 134 135 136
  (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)
137
    (defalias 'tramp-compat-file-attribute-group-id #'file-attribute-group-id)
138 139 140 141 142 143 144 145 146
  (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
147
      #'file-attribute-modification-time)
148 149 150
  (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
151
is a Lisp timestamp in the style of `current-time'."
152 153 154
    (nth 5 attributes)))

(if (fboundp 'file-attribute-size)
155
    (defalias 'tramp-compat-file-attribute-size #'file-attribute-size)
156 157
  (defsubst tramp-compat-file-attribute-size (attributes)
    "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
Paul Eggert's avatar
Paul Eggert committed
158 159
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."
160 161 162
    (nth 7 attributes)))

(if (fboundp 'file-attribute-modes)
163
    (defalias 'tramp-compat-file-attribute-modes #'file-attribute-modes)
164 165 166 167 168
  (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)))

169
;; `format-message' is new in Emacs 25.1.
170
(unless (fboundp 'format-message)
171
  (defalias 'format-message #'format))
172

173 174
;; `directory-name-p' is new in Emacs 25.1.
(if (fboundp 'directory-name-p)
175
    (defalias 'tramp-compat-directory-name-p #'directory-name-p)
176 177 178 179 180 181 182 183 184 185
  (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 ?\\))))))

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

191 192
;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
;; `file-name-unquote' are introduced in Emacs 26.
193 194 195 196
(if (fboundp 'file-local-name)
    (defalias 'tramp-compat-file-local-name #'file-local-name)
  (defsubst tramp-compat-file-local-name (name)
    "Return the local name component of NAME.
197 198
It returns a file name which can be used directly as argument of
`process-file', `start-file-process', or `shell-command'."
199 200 201 202 203 204 205 206 207
    (or (file-remote-p name 'localname) name)))

;; `file-name-quoted-p' got a second argument in Emacs 27.1.
(if (and
     (fboundp 'file-name-quoted-p)
     (equal (tramp-compat-funcall 'func-arity #'file-name-quoted-p) '(1 . 2)))
    (defalias 'tramp-compat-file-name-quoted-p #'file-name-quoted-p)
  (defsubst tramp-compat-file-name-quoted-p (name &optional top)
    "Whether NAME is quoted with prefix \"/:\".
208
If NAME is a remote file name and TOP is nil, check the local part of NAME."
209 210
    (let ((file-name-handler-alist (unless top file-name-handler-alist)))
      (string-prefix-p "/:" (tramp-compat-file-local-name name)))))
211

212 213 214 215
(if (fboundp 'file-name-quote)
    (defalias 'tramp-compat-file-name-quote #'file-name-quote)
  (defsubst tramp-compat-file-name-quote (name)
    "Add the quotation prefix \"/:\" to file NAME.
216
If NAME is a remote file name, the local part of NAME is quoted."
217 218 219 220 221 222 223 224 225
    (if (tramp-compat-file-name-quoted-p name)
	name
      (concat
       (file-remote-p name) "/:" (tramp-compat-file-local-name name)))))

(if (fboundp 'file-name-unquote)
    (defalias 'tramp-compat-file-name-unquote #'file-name-unquote)
  (defsubst tramp-compat-file-name-unquote (name)
    "Remove quotation prefix \"/:\" from file NAME.
226
If NAME is a remote file name, the local part of NAME is unquoted."
227 228 229 230 231
    (let ((localname (tramp-compat-file-local-name name)))
      (when (tramp-compat-file-name-quoted-p localname)
	(setq
	 localname (if (= (length localname) 2) "/" (substring localname 2))))
      (concat (file-remote-p name) localname))))
232

Michael Albinus's avatar
Michael Albinus committed
233 234 235 236
;; `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'."
237
  (defvar tramp-syntax)
Michael Albinus's avatar
Michael Albinus committed
238 239 240 241
  (cond ((eq tramp-syntax 'ftp) 'default)
	((eq tramp-syntax 'sep) 'separate)
	(t tramp-syntax)))

242 243 244
;; `cl-struct-slot-info' has been introduced with Emacs 25.
(defmacro tramp-compat-tramp-file-name-slots ()
  (if (fboundp 'cl-struct-slot-info)
245 246
      '(cdr (mapcar #'car (cl-struct-slot-info 'tramp-file-name)))
    '(cdr (mapcar #'car (get 'tramp-file-name 'cl-struct-slots)))))
247

248
;; The signature of `tramp-make-tramp-file-name' has been changed.
249
;; Therefore, we cannot use `url-tramp-convert-url-to-tramp' prior
250 251 252 253
;; 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.")

254 255 256
;; `exec-path' is new in Emacs 27.1.
(eval-and-compile
  (if (fboundp 'exec-path)
257
      (defalias 'tramp-compat-exec-path #'exec-path)
258 259 260 261 262 263 264
    (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)))))

265 266
;; `time-equal-p' has appeared in Emacs 27.1.
(if (fboundp 'time-equal-p)
267
    (defalias 'tramp-compat-time-equal-p #'time-equal-p)
268 269 270 271 272
  (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
273
;; `flatten-tree' has appeared in Emacs 27.1.
Michael Albinus's avatar
Michael Albinus committed
274
(if (fboundp 'flatten-tree)
275
    (defalias 'tramp-compat-flatten-tree #'flatten-tree)
Michael Albinus's avatar
Michael Albinus committed
276 277 278 279 280 281 282 283 284 285 286 287
  (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))))

288 289 290 291 292
(add-hook 'tramp-unload-hook
	  (lambda ()
	    (unload-feature 'tramp-loaddefs 'force)
	    (unload-feature 'tramp-compat 'force)))

293 294 295 296
(provide 'tramp-compat)

;;; TODO:

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

300
;;; tramp-compat.el ends here