tramp-compat.el 9.59 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-2017 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 45
(require 'password-cache)
(require 'shell)
(require 'timer)
(require 'ucs-normalize)

(require 'trampver)
(require 'tramp-loaddefs)

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

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

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

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

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

     ;; GNU Emacs 23.
     ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
      (let (result)
88
	(dolist (pid (tramp-compat-funcall 'list-system-processes) result)
89
	  (let ((attributes (process-attributes pid)))
90 91 92 93 94 95 96 97 98
	    (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))))
99
	      (setq result t)))))))))
100

Michael Albinus's avatar
Michael Albinus committed
101 102 103 104 105 106 107
;; `user-error' has appeared in Emacs 24.3.
(defsubst tramp-compat-user-error (vec-or-proc format &rest args)
  "Signal a pilot error."
  (apply
   'tramp-error vec-or-proc
   (if (fboundp 'user-error) 'user-error 'error) format args))

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

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 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
;; `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
is a list of integers (HIGH LOW USEC PSEC) in the same style
as (current-time)."
    (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'.
This is a floating point number if the size is too large for an integer."
    (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)))

171
;; `format-message' is new in Emacs 25.1.
172
(unless (fboundp 'format-message)
173
  (defalias 'format-message 'format))
174

175 176 177 178 179 180 181 182 183 184 185 186 187
;; `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 ?\\))))))

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

193 194
(add-hook 'tramp-unload-hook
	  (lambda ()
195
	    (unload-feature 'tramp-loaddefs 'force)
196 197
	    (unload-feature 'tramp-compat 'force)))

198 199
;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
;; introduced in Emacs 26.
Michael Albinus's avatar
Michael Albinus committed
200 201 202 203 204
(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 \"/:\".
205
If NAME is a remote file name, check the local part of NAME."
Michael Albinus's avatar
Michael Albinus committed
206
      (string-match "^/:" (or (file-remote-p name 'localname) name))))
207

Michael Albinus's avatar
Michael Albinus committed
208 209 210 211
  (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.
212
If NAME is a remote file name, the local part of NAME is quoted."
Michael Albinus's avatar
Michael Albinus committed
213 214 215 216
      (if (tramp-compat-file-name-quoted-p name)
	  name
	(concat
	 (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))))
217

Michael Albinus's avatar
Michael Albinus committed
218 219 220 221
  (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.
222
If NAME is a remote file name, the local part of NAME is unquoted."
Michael Albinus's avatar
Michael Albinus committed
223 224 225 226 227 228 229 230
      (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))))))
231

Michael Albinus's avatar
Michael Albinus committed
232 233 234 235 236 237 238 239
;; `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)))

240 241 242 243 244 245
;; `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)))))

246 247 248 249 250
(provide 'tramp-compat)

;;; TODO:

;;; tramp-compat.el ends here