LCOV - code coverage report
Current view: top level - lisp/net - tramp-compat.el (source / functions) Hit Total Coverage
Test: tramp-tests-after.info Lines: 15 30 50.0 %
Date: 2017-08-30 10:12:24 Functions: 5 6 83.3 %

          Line data    Source code
       1             : ;;; tramp-compat.el --- Tramp compatibility functions  -*- lexical-binding:t -*-
       2             : 
       3             : ;; Copyright (C) 2007-2017 Free Software Foundation, Inc.
       4             : 
       5             : ;; Author: Michael Albinus <michael.albinus@gmx.de>
       6             : ;; Keywords: comm, processes
       7             : ;; Package: tramp
       8             : 
       9             : ;; This file is part of GNU Emacs.
      10             : 
      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.
      15             : 
      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.
      20             : 
      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/>.
      23             : 
      24             : ;;; Commentary:
      25             : 
      26             : ;; Tramp's main Emacs version for development is Emacs 26.  This
      27             : ;; package provides compatibility functions for Emacs 24 and Emacs 25.
      28             : 
      29             : ;;; Code:
      30             : 
      31             : (require 'auth-source)
      32             : (require 'advice)
      33             : (require 'cl-lib)
      34             : (require 'custom)
      35             : (require 'format-spec)
      36             : (require 'parse-time)
      37             : (require 'password-cache)
      38             : (require 'shell)
      39             : (require 'timer)
      40             : (require 'ucs-normalize)
      41             : 
      42             : (require 'trampver)
      43             : (require 'tramp-loaddefs)
      44             : 
      45             : ;; For not existing functions, obsolete functions, or functions with a
      46             : ;; changed argument list, there are compiler warnings.  We want to
      47             : ;; 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          23 :   `(when (functionp ,function)
      51          23 :      (with-no-warnings (funcall ,function ,@arguments))))
      52             : 
      53             : ;; We currently use "[" and "]" in the filename format for IPv6 hosts
      54             : ;; of GNU Emacs.  This means that Emacs wants to expand wildcards if
      55             : ;; `find-file-wildcards' is non-nil, and then barfs because no
      56             : ;; expansion could be found.  We detect this situation and do
      57             : ;; something really awful: we have `file-expand-wildcards' return the
      58             : ;; original filename if it can't expand anything.  Let's just hope
      59             : ;; that this doesn't break anything else.  It is not needed anymore
      60             : ;; since GNU Emacs 23.2.
      61             : (unless (featurep 'files 'remote-wildcards)
      62             :   (defadvice file-expand-wildcards
      63             :       (around tramp-advice-file-expand-wildcards activate)
      64             :     (let ((name (ad-get-arg 0)))
      65             :       ;; If it's a Tramp file, look if wildcards need to be expanded
      66             :       ;; at all.
      67             :       (if (and
      68             :            (tramp-tramp-file-p name)
      69             :            (not (string-match "[[*?]" (file-remote-p name 'localname))))
      70             :           (setq ad-return-value (list name))
      71             :         ;; Otherwise, just run the original function.
      72             :         ad-do-it)))
      73             :   (add-hook
      74             :    'tramp-unload-hook
      75             :    (lambda ()
      76             :      (ad-remove-advice
      77             :       'file-expand-wildcards 'around 'tramp-advice-file-expand-wildcards)
      78             :      (ad-activate 'file-expand-wildcards))))
      79             : 
      80             : (defsubst tramp-compat-temporary-file-directory ()
      81             :   "Return name of directory for temporary files.
      82             : It is the default value of `temporary-file-directory'."
      83             :   ;; We must return a local directory.  If it is remote, we could run
      84             :   ;; into an infloop.
      85       27531 :   (eval (car (get 'temporary-file-directory 'standard-value))))
      86             : 
      87             : (defsubst tramp-compat-make-temp-file (f &optional dir-flag)
      88             :   "Create a local temporary file (compat function).
      89             : Add the extension of F, if existing."
      90         675 :   (let* (file-name-handler-alist
      91         675 :          (prefix (expand-file-name
      92         675 :                   (symbol-value 'tramp-temp-name-prefix)
      93         675 :                   (tramp-compat-temporary-file-directory)))
      94         675 :          (extension (file-name-extension f t)))
      95         675 :     (make-temp-file prefix dir-flag extension)))
      96             : 
      97             : ;; `temporary-file-directory' as function is introduced with Emacs 26.1.
      98             : (defalias 'tramp-compat-temporary-file-directory-function
      99             :   (if (fboundp 'temporary-file-directory)
     100             :       'temporary-file-directory
     101             :     'tramp-handle-temporary-file-directory))
     102             : 
     103             : (defun tramp-compat-process-running-p (process-name)
     104             :   "Returns t if system process PROCESS-NAME is running for `user-login-name'."
     105           0 :   (when (stringp process-name)
     106           0 :     (cond
     107             :      ;; GNU Emacs 22 on w32.
     108           0 :      ((fboundp 'w32-window-exists-p)
     109           0 :       (tramp-compat-funcall 'w32-window-exists-p process-name process-name))
     110             : 
     111             :      ;; GNU Emacs 23.
     112           0 :      ((and (fboundp 'list-system-processes) (fboundp 'process-attributes))
     113           0 :       (let (result)
     114           0 :         (dolist (pid (tramp-compat-funcall 'list-system-processes) result)
     115           0 :           (let ((attributes (process-attributes pid)))
     116           0 :             (when (and (string-equal
     117           0 :                         (cdr (assoc 'user attributes)) (user-login-name))
     118           0 :                        (let ((comm (cdr (assoc 'comm attributes))))
     119             :                          ;; The returned command name could be truncated
     120             :                          ;; to 15 characters.  Therefore, we cannot check
     121             :                          ;; for `string-equal'.
     122           0 :                          (and comm (string-match
     123           0 :                                     (concat "^" (regexp-quote comm))
     124           0 :                                     process-name))))
     125           0 :               (setq result t)))))))))
     126             : 
     127             : ;; `user-error' has appeared in Emacs 24.3.
     128             : (defsubst tramp-compat-user-error (vec-or-proc format &rest args)
     129             :   "Signal a pilot error."
     130           2 :   (apply
     131           2 :    'tramp-error vec-or-proc
     132           2 :    (if (fboundp 'user-error) 'user-error 'error) format args))
     133             : 
     134             : ;; `file-attribute-*' are introduced in Emacs 25.1.
     135             : 
     136             : (if (fboundp 'file-attribute-type)
     137             :     (defalias 'tramp-compat-file-attribute-type 'file-attribute-type)
     138             :   (defsubst tramp-compat-file-attribute-type (attributes)
     139             :     "The type field in ATTRIBUTES returned by `file-attributes'.
     140             : The value is either t for directory, string (name linked to) for
     141             : symbolic link, or nil."
     142             :     (nth 0 attributes)))
     143             : 
     144             : (if (fboundp 'file-attribute-link-number)
     145             :     (defalias 'tramp-compat-file-attribute-link-number
     146             :       'file-attribute-link-number)
     147             :   (defsubst tramp-compat-file-attribute-link-number (attributes)
     148             :     "Return the number of links in ATTRIBUTES returned by `file-attributes'."
     149             :     (nth 1 attributes)))
     150             : 
     151             : (if (fboundp 'file-attribute-user-id)
     152             :     (defalias 'tramp-compat-file-attribute-user-id 'file-attribute-user-id)
     153             :   (defsubst tramp-compat-file-attribute-user-id (attributes)
     154             :     "The UID field in ATTRIBUTES returned by `file-attributes'.
     155             : This is either a string or a number.  If a string value cannot be
     156             : looked up, a numeric value, either an integer or a float, is
     157             : returned."
     158             :     (nth 2 attributes)))
     159             : 
     160             : (if (fboundp 'file-attribute-group-id)
     161             :     (defalias 'tramp-compat-file-attribute-group-id 'file-attribute-group-id)
     162             :   (defsubst tramp-compat-file-attribute-group-id (attributes)
     163             :     "The GID field in ATTRIBUTES returned by `file-attributes'.
     164             : This is either a string or a number.  If a string value cannot be
     165             : looked up, a numeric value, either an integer or a float, is
     166             : returned."
     167             :     (nth 3 attributes)))
     168             : 
     169             : (if (fboundp 'file-attribute-modification-time)
     170             :     (defalias 'tramp-compat-file-attribute-modification-time
     171             :       'file-attribute-modification-time)
     172             :   (defsubst tramp-compat-file-attribute-modification-time (attributes)
     173             :     "The modification time in ATTRIBUTES returned by `file-attributes'.
     174             : This is the time of the last change to the file's contents, and
     175             : is a list of integers (HIGH LOW USEC PSEC) in the same style
     176             : as (current-time)."
     177             :     (nth 5 attributes)))
     178             : 
     179             : (if (fboundp 'file-attribute-size)
     180             :     (defalias 'tramp-compat-file-attribute-size 'file-attribute-size)
     181             :   (defsubst tramp-compat-file-attribute-size (attributes)
     182             :     "The size (in bytes) in ATTRIBUTES returned by `file-attributes'.
     183             : This is a floating point number if the size is too large for an integer."
     184             :     (nth 7 attributes)))
     185             : 
     186             : (if (fboundp 'file-attribute-modes)
     187             :     (defalias 'tramp-compat-file-attribute-modes 'file-attribute-modes)
     188             :   (defsubst tramp-compat-file-attribute-modes (attributes)
     189             :     "The file modes in ATTRIBUTES returned by `file-attributes'.
     190             : This is a string of ten letters or dashes as in ls -l."
     191             :     (nth 8 attributes)))
     192             : 
     193             : ;; `default-toplevel-value' has been declared in Emacs 24.4.
     194             : (unless (fboundp 'default-toplevel-value)
     195             :   (defalias 'default-toplevel-value 'symbol-value))
     196             : 
     197             : ;; `format-message' is new in Emacs 25.1.
     198             : (unless (fboundp 'format-message)
     199             :   (defalias 'format-message 'format))
     200             : 
     201             : ;; `file-missing' is introduced in Emacs 26.1.
     202             : (defconst tramp-file-missing
     203             :   (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
     204             :   "The error symbol for the `file-missing' error.")
     205             : 
     206             : (add-hook 'tramp-unload-hook
     207             :           (lambda ()
     208             :             (unload-feature 'tramp-loaddefs 'force)
     209             :             (unload-feature 'tramp-compat 'force)))
     210             : 
     211             : ;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
     212             : ;; introduced in Emacs 26.
     213             : (eval-and-compile
     214             :   (if (fboundp 'file-name-quoted-p)
     215             :       (defalias 'tramp-compat-file-name-quoted-p 'file-name-quoted-p)
     216             :     (defsubst tramp-compat-file-name-quoted-p (name)
     217             :       "Whether NAME is quoted with prefix \"/:\".
     218             : If NAME is a remote file name, check the local part of NAME."
     219             :       (string-match "^/:" (or (file-remote-p name 'localname) name))))
     220             : 
     221             :   (if (fboundp 'file-name-quote)
     222             :       (defalias 'tramp-compat-file-name-quote 'file-name-quote)
     223             :     (defsubst tramp-compat-file-name-quote (name)
     224             :       "Add the quotation prefix \"/:\" to file NAME.
     225             : If NAME is a remote file name, the local part of NAME is quoted."
     226             :       (concat
     227             :        (file-remote-p name) "/:" (or (file-remote-p name 'localname) name))))
     228             : 
     229             :   (if (fboundp 'file-name-unquote)
     230             :       (defalias 'tramp-compat-file-name-unquote 'file-name-unquote)
     231             :     (defsubst tramp-compat-file-name-unquote (name)
     232             :       "Remove quotation prefix \"/:\" from file NAME.
     233             : If NAME is a remote file name, the local part of NAME is unquoted."
     234             :       (save-match-data
     235             :         (let ((localname (or (file-remote-p name 'localname) name)))
     236             :           (when (tramp-compat-file-name-quoted-p localname)
     237             :             (setq
     238             :              localname
     239             :              (replace-match
     240             :               (if (= (length localname) 2) "/" "") nil t localname)))
     241             :           (concat (file-remote-p name) localname))))))
     242             : 
     243             : ;; `tramp-syntax' has changed its meaning in Emacs 26.  We still
     244             : ;; support old settings.
     245             : (defsubst tramp-compat-tramp-syntax ()
     246             :   "Return proper value of `tramp-syntax'."
     247     2882601 :   (cond ((eq tramp-syntax 'ftp) 'default)
     248     2882601 :         ((eq tramp-syntax 'sep) 'separate)
     249     2882601 :         (t tramp-syntax)))
     250             : 
     251             : ;; Older Emacsen keep incompatible autoloaded values of `tramp-syntax'.
     252             : (eval-after-load 'tramp
     253             :   '(unless
     254             :        (memq tramp-syntax (tramp-compat-funcall (quote tramp-syntax-values)))
     255             :      (tramp-compat-funcall
     256             :       (quote tramp-change-syntax) (tramp-compat-tramp-syntax))))
     257             : 
     258             : (provide 'tramp-compat)
     259             : 
     260             : ;;; TODO:
     261             : 
     262             : ;;; tramp-compat.el ends here

Generated by: LCOV version 1.12