tramp-compat.el 10 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-2018 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
(require 'auth-source)
(require 'advice)
Michael Albinus's avatar
Michael Albinus committed
34
(require 'cl-lib)
35 36
(require 'custom)
(require 'format-spec)
Michael Albinus's avatar
Michael Albinus committed
37
(require 'parse-time)
38 39 40 41 42 43 44
(require 'password-cache)
(require 'shell)
(require 'timer)
(require 'ucs-normalize)

(require 'tramp-loaddefs)

45 46 47
;; 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.
48
(defmacro tramp-compat-funcall (function &rest arguments)
49
  "Call FUNCTION if it exists.  Do not raise compiler warnings."
50
  `(when (functionp ,function)
51 52
     (with-no-warnings (funcall ,function ,@arguments))))

53
(defsubst tramp-compat-temporary-file-directory ()
54 55 56 57 58 59
  "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))))

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

70
;; `temporary-file-directory' as function is introduced with Emacs 26.1.
71 72 73 74 75
(defalias 'tramp-compat-temporary-file-directory-function
  (if (fboundp 'temporary-file-directory)
      'temporary-file-directory
    'tramp-handle-temporary-file-directory))

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

     ;; GNU Emacs 23.
     ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
      (let (result)
87
	(dolist (pid (tramp-compat-funcall 'list-system-processes) result)
88
	  (let ((attributes (process-attributes pid)))
89 90 91 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'.
                         (and comm (string-match
                                    (concat "^" (regexp-quote comm))
                                    process-name))))
98
	      (setq result t)))))))))
99

100 101 102 103
;; `default-toplevel-value' has been declared in Emacs 24.4.
(unless (fboundp 'default-toplevel-value)
  (defalias 'default-toplevel-value 'symbol-value))

104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144
;; `file-attribute-*' are introduced in Emacs 25.1.

(if (fboundp 'file-attribute-type)
    (defalias 'tramp-compat-file-attribute-type 'file-attribute-type)
  (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
      'file-attribute-link-number)
  (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)
    (defalias 'tramp-compat-file-attribute-user-id 'file-attribute-user-id)
  (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)
    (defalias 'tramp-compat-file-attribute-group-id 'file-attribute-group-id)
  (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
      'file-attribute-modification-time)
  (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
145
is a Lisp timestamp in the style of `current-time'."
146 147 148 149 150 151
    (nth 5 attributes)))

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

(if (fboundp 'file-attribute-modes)
    (defalias 'tramp-compat-file-attribute-modes 'file-attribute-modes)
  (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)))

163
;; `format-message' is new in Emacs 25.1.
164
(unless (fboundp 'format-message)
165
  (defalias 'format-message 'format))
166

167 168 169 170 171 172 173 174 175 176 177 178 179
;; `directory-name-p' is new in Emacs 25.1.
(if (fboundp 'directory-name-p)
    (defalias 'tramp-compat-directory-name-p 'directory-name-p)
  (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 ?\\))))))

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

185 186
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
;; introduced in Emacs 26.
Michael Albinus's avatar
Michael Albinus committed
187 188 189 190 191
(eval-and-compile
  (if (fboundp 'file-name-quoted-p)
      (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p)
    (defsubst tramp-compat-file-name-quoted-p (name)
      "Whether NAME is quoted with prefix \"/:\".
192
If NAME is a remote file name, check the local part of NAME."
Michael Albinus's avatar
Michael Albinus committed
193
      (string-match "^/:" (or (file-remote-p name 'localname) name))))
194

Michael Albinus's avatar
Michael Albinus committed
195 196 197 198
  (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.
199
If NAME is a remote file name, the local part of NAME is quoted."
Michael Albinus's avatar
Michael Albinus committed
200 201 202 203
      (if (tramp-compat-file-name-quoted-p name)
	  name
	(concat
	 (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))))
204

Michael Albinus's avatar
Michael Albinus committed
205 206 207 208
  (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.
209
If NAME is a remote file name, the local part of NAME is unquoted."
Michael Albinus's avatar
Michael Albinus committed
210 211 212 213 214 215 216 217
      (save-match-data
	(let ((localname (or (file-remote-p name 'localname) name)))
	  (when (tramp-compat-file-name-quoted-p localname)
	    (setq
	     localname
	     (replace-match
	      (if (= (length localname) 2) "/" "") nil t localname)))
	  (concat (file-remote-p name) localname))))))
218

Michael Albinus's avatar
Michael Albinus committed
219 220 221 222 223 224 225 226
;; `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'."
  (cond ((eq tramp-syntax 'ftp) 'default)
	((eq tramp-syntax 'sep) 'separate)
	(t tramp-syntax)))

227 228 229 230 231 232
;; `cl-struct-slot-info' has been introduced with Emacs 25.
(defmacro tramp-compat-tramp-file-name-slots ()
  (if (fboundp 'cl-struct-slot-info)
      `(cdr (mapcar 'car (cl-struct-slot-info 'tramp-file-name)))
    `(cdr (mapcar 'car (get 'tramp-file-name 'cl-struct-slots)))))

233 234 235 236 237 238
;; 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.")

239 240 241 242 243 244 245 246 247 248 249
;; `exec-path' is new in Emacs 27.1.
(eval-and-compile
  (if (fboundp 'exec-path)
      (defalias 'tramp-compat-exec-path 'exec-path)
    (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)))))

250 251 252 253 254
(add-hook 'tramp-unload-hook
	  (lambda ()
	    (unload-feature 'tramp-loaddefs 'force)
	    (unload-feature 'tramp-compat 'force)))

255 256 257 258 259
(provide 'tramp-compat)

;;; TODO:

;;; tramp-compat.el ends here