emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] master 294b2c2: Refactor some Tramp functions


From: Michael Albinus
Subject: [Emacs-diffs] master 294b2c2: Refactor some Tramp functions
Date: Fri, 7 Dec 2018 11:21:14 -0500 (EST)

branch: master
commit 294b2c2bb71f1f7e7024a854d4a4ae43785d9594
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    Refactor some Tramp functions
    
    * lisp/net/tramp-compat.el (tramp-compat-file-local-name): New defsubst.
    (tramp-compat-file-name-quoted-p, tramp-compat-file-name-quote)
    (tramp-compat-file-name-unquote):
    * lisp/net/tramp.el (tramp-handle-file-name-case-insensitive-p)
    (tramp-handle-file-truename, tramp-get-remote-tmpdir):
    * lisp/net/tramp-adb.el (tramp-adb-handle-copy-file)
    (tramp-adb-handle-rename-file, tramp-adb-handle-exec-path):
    * lisp/net/tramp-sh.el (tramp-do-copy-or-rename-file-directly)
    (tramp-sh-handle-exec-path, tramp-find-inline-encoding)
    (tramp-get-remote-touch): Use it.
    
    * lisp/net/tramp-adb.el (tramp-adb-file-name-handler-alist):
    Use `tramp-handle-expand-file-name'.
    (tramp-adb-handle-expand-file-name): Move to tramp.el.
    (tramp-adb-handle-file-writable-p): Adapt docstring.
    
    * lisp/net/tramp-gvfs.el (tramp-gvfs-file-name-handler-alist):
    Use `tramp-handle-file-local-copy', `tramp-handle-file-writable-p'
    and `tramp-handle-write-region'.
    (tramp-gvfs-handle-file-local-copy)
    (tramp-gvfs-handle-file-writable-p)
    (tramp-gvfs-handle-write-region): Move to tramp.el.
    
    * lisp/net/tramp-rclone.el: Dont't require `tramp-adb' and
    `tramp-gvfs' anymore.
    (tramp-rclone-file-name-handler-alist):
    Use `tramp-handle-expand-file-name', `tramp-handle-file-local-copy',
    `tramp-handle-file-writable-p' and `tramp-handle-write-region'.
    (tramp-rclone-handle-directory-files): Simplify.
    
    * lisp/net/tramp.el (tramp-methods): Extend docstring.
    (tramp-parse-netrc): Require `netrc'.
    (tramp-handle-expand-file-name, tramp-handle-file-local-copy)
    (tramp-handle-file-writable-p, tramp-handle-write-region): New defuns.
---
 lisp/net/tramp-adb.el    |  36 +++----------
 lisp/net/tramp-compat.el |  18 +++++--
 lisp/net/tramp-gvfs.el   |  69 ++-----------------------
 lisp/net/tramp-rclone.el |  32 ++++--------
 lisp/net/tramp-sh.el     |  11 ++--
 lisp/net/tramp.el        | 130 +++++++++++++++++++++++++++++++++++++++++++++--
 lisp/net/zeroconf.el     |  33 +++++++-----
 7 files changed, 183 insertions(+), 146 deletions(-)

diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 76bcdf0..7906ec9 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -108,7 +108,7 @@ It is used for TCP/IP devices."
     (dired-compress-file . ignore)
     (dired-uncache . tramp-handle-dired-uncache)
     (exec-path . tramp-adb-handle-exec-path)
-    (expand-file-name . tramp-adb-handle-expand-file-name)
+    (expand-file-name . tramp-handle-expand-file-name)
     (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
     (file-acl . ignore)
     (file-attributes . tramp-adb-handle-file-attributes)
@@ -226,28 +226,6 @@ pass to the OPERATION."
         result)
        result))))
 
-(defun tramp-adb-handle-expand-file-name (name &optional dir)
-  "Like `expand-file-name' for Tramp files."
-  ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
-  (setq dir (or dir default-directory "/"))
-  ;; Unless NAME is absolute, concat DIR and NAME.
-  (unless (file-name-absolute-p name)
-    (setq name (concat (file-name-as-directory dir) name)))
-  ;; If NAME is not a Tramp file, run the real handler.
-  (if (not (tramp-tramp-file-p name))
-      (tramp-run-real-handler 'expand-file-name (list name nil))
-    ;; Dissect NAME.
-    (with-parsed-tramp-file-name name nil
-      (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
-       (setq localname (concat "/" localname)))
-      ;; Do normal `expand-file-name' (this does "/./" and "/../").
-      ;; `default-directory' is bound, because on Windows there would
-      ;; be problems with UNC shares or Cygwin mounts.
-      (let ((default-directory (tramp-compat-temporary-file-directory)))
-       (tramp-make-tramp-file-name
-        v (tramp-drop-volume-letter
-           (tramp-run-real-handler 'expand-file-name (list localname))))))))
-
 (defun tramp-adb-handle-file-system-info (filename)
   "Like `file-system-info' for Tramp files."
   (ignore-errors
@@ -640,7 +618,7 @@ Emacs dired can't find files."
       tmpfile)))
 
 (defun tramp-adb-handle-file-writable-p (filename)
-  "Like `tramp-sh-handle-file-writable-p'.
+  "Like `file-writable-p' for Tramp files.
 But handle the case, if the \"test\" command is not available."
   (with-parsed-tramp-file-name filename nil
     (with-tramp-file-property v localname "file-writable-p"
@@ -754,8 +732,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
            v 0 (format "Copying %s to %s" filename newname)
 
          (if (and t1 t2 (tramp-equal-remote filename newname))
-             (let ((l1 (file-remote-p filename 'localname))
-                   (l2 (file-remote-p newname 'localname)))
+             (let ((l1 (tramp-compat-file-local-name filename))
+                   (l2 (tramp-compat-file-local-name newname)))
                (when (and (not ok-if-already-exists)
                           (file-exists-p newname))
                  (tramp-error v 'file-already-exists newname))
@@ -835,8 +813,8 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
          (if (and t1 t2
                   (tramp-equal-remote filename newname)
                   (not (file-directory-p filename)))
-             (let ((l1 (file-remote-p filename 'localname))
-                   (l2 (file-remote-p newname 'localname)))
+             (let ((l1 (tramp-compat-file-local-name filename))
+                   (l2 (tramp-compat-file-local-name newname)))
                (when (and (not ok-if-already-exists)
                           (file-exists-p newname))
                  (tramp-error v 'file-already-exists newname))
@@ -1132,7 +1110,7 @@ PRESERVE-UID-GID and PRESERVE-EXTENDED-ATTRIBUTES are 
completely ignored."
          (read (current-buffer)))
        ":" 'omit)))
    ;; The equivalent to `exec-directory'.
-   `(,(file-remote-p default-directory 'localname))))
+   `(,(tramp-compat-file-local-name default-directory))))
 
 (defun tramp-adb-get-device (vec)
   "Return full host name from VEC to be used in shell execution.
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 9e02ebb..0137724 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -187,15 +187,23 @@ This is a string of ten letters or dashes as in ls -l."
   (if (get 'file-missing 'error-conditions) 'file-missing 'file-error)
   "The error symbol for the `file-missing' error.")
 
-;; `file-name-quoted-p', `file-name-quote' and `file-name-unquote' are
-;; introduced in Emacs 26.
+;; `file-local-name', `file-name-quoted-p', `file-name-quote' and
+;; `file-name-unquote' are introduced in Emacs 26.
 (eval-and-compile
+  (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.
+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)))
+
   (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 \"/:\".
 If NAME is a remote file name, check the local part of NAME."
-      (string-prefix-p "/:" (or (file-remote-p name 'localname) name))))
+      (string-prefix-p "/:" (tramp-compat-file-local-name name))))
 
   (if (fboundp 'file-name-quote)
       (defalias 'tramp-compat-file-name-quote 'file-name-quote)
@@ -205,14 +213,14 @@ If NAME is a remote file name, the local part of NAME is 
quoted."
       (if (tramp-compat-file-name-quoted-p name)
          name
        (concat
-        (file-remote-p name) "/:" (or (file-remote-p name 'localname) name)))))
+        (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.
 If NAME is a remote file name, the local part of NAME is unquoted."
-      (let ((localname (or (file-remote-p name 'localname) name)))
+      (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))))
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index 8211872..e034f7b 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -546,7 +546,7 @@ It has been changed in GVFS 1.14.")
     (file-executable-p . tramp-gvfs-handle-file-executable-p)
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
-    (file-local-copy . tramp-gvfs-handle-file-local-copy)
+    (file-local-copy . tramp-handle-file-local-copy)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-gvfs-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -567,7 +567,7 @@ It has been changed in GVFS 1.14.")
     (file-symlink-p . tramp-handle-file-symlink-p)
     (file-system-info . tramp-gvfs-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
-    (file-writable-p . tramp-gvfs-handle-file-writable-p)
+    (file-writable-p . tramp-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.
     (insert-directory . tramp-handle-insert-directory)
@@ -592,7 +592,7 @@ It has been changed in GVFS 1.14.")
     (unhandled-file-name-directory . ignore)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
-    (write-region . tramp-gvfs-handle-write-region))
+    (write-region . tramp-handle-write-region))
   "Alist of handler functions for Tramp GVFS method.
 Operations not mentioned here will be handled by the default Emacs 
primitives.")
 
@@ -1132,17 +1132,6 @@ If FILE-SYSTEM is non-nil, return file system 
attributes."
     (with-tramp-file-property v localname "file-executable-p"
       (tramp-check-cached-permissions v ?x))))
 
-(defun tramp-gvfs-handle-file-local-copy (filename)
-  "Like `file-local-copy' for Tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (unless (file-exists-p filename)
-      (tramp-error
-       v tramp-file-missing
-       "Cannot make local copy of non-existing file `%s'" filename))
-    (let ((tmpfile (tramp-compat-make-temp-file filename)))
-      (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
-      tmpfile)))
-
 (defun tramp-gvfs-handle-file-name-all-completions (filename directory)
   "Like `file-name-all-completions' for Tramp files."
   (unless (string-match-p "/" filename)
@@ -1280,16 +1269,6 @@ file-notify events."
              (- (string-to-number size) (string-to-number used))
              (string-to-number free))))))
 
-(defun tramp-gvfs-handle-file-writable-p (filename)
-  "Like `file-writable-p' for Tramp files."
-  (with-parsed-tramp-file-name filename nil
-    (with-tramp-file-property v localname "file-writable-p"
-      (if (file-exists-p filename)
-         (tramp-check-cached-permissions v ?w)
-       ;; If file doesn't exist, check if directory is writable.
-       (and (file-directory-p (file-name-directory filename))
-            (file-writable-p (file-name-directory filename)))))))
-
 (defun tramp-gvfs-handle-make-directory (dir &optional parents)
   "Like `make-directory' for Tramp files."
   (setq dir (directory-file-name (expand-file-name dir)))
@@ -1324,48 +1303,6 @@ file-notify events."
     (tramp-run-real-handler
      'rename-file (list filename newname ok-if-already-exists))))
 
-(defun tramp-gvfs-handle-write-region
-  (start end filename &optional append visit lockname mustbenew)
-  "Like `write-region' for Tramp files."
-  (setq filename (expand-file-name filename))
-  (with-parsed-tramp-file-name filename nil
-    (when (and mustbenew (file-exists-p filename)
-              (or (eq mustbenew 'excl)
-                  (not
-                   (y-or-n-p
-                    (format "File %s exists; overwrite anyway? " filename)))))
-      (tramp-error v 'file-already-exists filename))
-
-    (let ((tmpfile (tramp-compat-make-temp-file filename)))
-      (when (and append (file-exists-p filename))
-       (copy-file filename tmpfile 'ok))
-      ;; We say `no-message' here because we don't want the visited file
-      ;; modtime data to be clobbered from the temp file.  We call
-      ;; `set-visited-file-modtime' ourselves later on.
-      (tramp-run-real-handler
-       'write-region (list start end tmpfile append 'no-message lockname))
-      (condition-case nil
-         (rename-file tmpfile filename 'ok-if-already-exists)
-       (error
-        (delete-file tmpfile)
-        (tramp-error
-         v 'file-error "Couldn't write region to `%s'" filename))))
-
-    (tramp-flush-file-properties v (file-name-directory localname))
-    (tramp-flush-file-properties v localname)
-
-    ;; Set file modification time.
-    (when (or (eq visit t) (stringp visit))
-      (set-visited-file-modtime
-       (tramp-compat-file-attribute-modification-time
-       (file-attributes filename))))
-
-    ;; The end.
-    (when (and (null noninteractive)
-              (or (eq visit t) (null visit) (stringp visit)))
-      (tramp-message v 0 "Wrote %s" filename))
-    (run-hooks 'tramp-handle-write-region-hook)))
-
 
 ;; File name conversions.
 
diff --git a/lisp/net/tramp-rclone.el b/lisp/net/tramp-rclone.el
index 3f3cac8..5ea42c0 100644
--- a/lisp/net/tramp-rclone.el
+++ b/lisp/net/tramp-rclone.el
@@ -31,17 +31,13 @@
 ;; A remote file under rclone control has the form
 ;; "/rclone:<remote>:/path/to/file".  <remote> is the name of a
 ;; storage system in rclone's configuration.  Therefore, such a remote
-;; file name does not know any user or port specification.
+;; file name does not know of any user or port specification.
 
 ;;; Code:
 
 (eval-when-compile (require 'cl-lib))
 (require 'tramp)
 
-;; TODDDDDDDDDO: REPLACE
-(require 'tramp-adb)
-(require 'tramp-gvfs)
-
 ;;;###tramp-autoload
 (defconst tramp-rclone-method "rclone"
   "When this method name is used, forward all calls to rclone mounts.")
@@ -86,7 +82,7 @@
     (dired-compress-file . ignore)
     (dired-uncache . tramp-handle-dired-uncache)
     (exec-path . ignore)
-    (expand-file-name . tramp-adb-handle-expand-file-name)
+    (expand-file-name . tramp-handle-expand-file-name)
     (file-accessible-directory-p . tramp-handle-file-accessible-directory-p)
     (file-acl . ignore)
     (file-attributes . tramp-rclone-handle-file-attributes)
@@ -95,7 +91,7 @@
     (file-executable-p . tramp-rclone-handle-file-executable-p)
     (file-exists-p . tramp-handle-file-exists-p)
     (file-in-directory-p . tramp-handle-file-in-directory-p)
-    (file-local-copy . tramp-gvfs-handle-file-local-copy)
+    (file-local-copy . tramp-handle-file-local-copy)
     (file-modes . tramp-handle-file-modes)
     (file-name-all-completions . tramp-rclone-handle-file-name-all-completions)
     (file-name-as-directory . tramp-handle-file-name-as-directory)
@@ -116,7 +112,7 @@
     (file-symlink-p . tramp-handle-file-symlink-p)
     (file-system-info . tramp-rclone-handle-file-system-info)
     (file-truename . tramp-handle-file-truename)
-    (file-writable-p . tramp-gvfs-handle-file-writable-p)
+    (file-writable-p . tramp-handle-file-writable-p)
     (find-backup-file-name . tramp-handle-find-backup-file-name)
     ;; `get-file-buffer' performed by default handler.
     (insert-directory . tramp-handle-insert-directory)
@@ -141,7 +137,7 @@
     (unhandled-file-name-directory . ignore)
     (vc-registered . ignore)
     (verify-visited-file-modtime . tramp-handle-verify-visited-file-modtime)
-    (write-region . tramp-gvfs-handle-write-region))
+    (write-region . tramp-handle-write-region))
   "Alist of handler functions for Tramp RCLONE method.
 Operations not mentioned here will be handled by the default Emacs 
primitives.")
 
@@ -328,12 +324,10 @@ file names."
              (tramp-rclone-local-file-name directory) full match)))
        ;; Massage the result.
        (when full
-         (let* ((quoted (tramp-compat-file-name-quoted-p directory))
-                (local
-                 (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
-                (remote
-                 (funcall (if quoted 'tramp-compat-file-name-quote 'identity)
-                          (file-remote-p directory))))
+         (let ((local (concat "^" (regexp-quote (tramp-rclone-mount-point v))))
+               (remote (funcall (if (tramp-compat-file-name-quoted-p directory)
+                                    'tramp-compat-file-name-quote 'identity)
+                                (file-remote-p directory))))
            (setq result
                  (mapcar
                   (lambda (x) (replace-regexp-in-string local remote x))
@@ -427,8 +421,7 @@ file names."
         (insert-file-contents
          (tramp-rclone-local-file-name filename) visit beg end replace)))
     (prog1
-       (list (expand-file-name filename)
-             (cadr result))
+       (list (expand-file-name filename) (cadr result))
       (when visit (setq buffer-file-name filename)))))
 
 (defun tramp-rclone-handle-make-directory (dir &optional parents)
@@ -609,10 +602,7 @@ connection if a previous connection has died for some 
reason."
 
 ;;; TODO:
 
-;; * Refactor tramp-gvfs.el in order to move used functions to
-;;   tramp.el.
-;;
-;; * If possible, get rid of rclone mount.  Maybe it is more
+;; * If possible, get rid of "rclone mount".  Maybe it is more
 ;;   performant then.
 
 ;;; tramp-rclone.el ends here
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 3f426bb..a6e9d29 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -2192,8 +2192,8 @@ the uid and gid from FILENAME."
                            v 'file-error
                            "Unknown operation `%s', must be `copy' or `rename'"
                            op))))
-            (localname1 (if t1 (file-remote-p filename 'localname) filename))
-            (localname2 (if t2 (file-remote-p newname 'localname) newname))
+            (localname1 (tramp-compat-file-local-name filename))
+            (localname2 (tramp-compat-file-local-name newname))
             (prefix (file-remote-p (if t1 filename newname)))
              cmd-result)
        (when (and (eq op 'copy) (file-directory-p filename))
@@ -3087,7 +3087,7 @@ the result will be a local, non-Tramp, file name."
   (append
    (tramp-get-remote-path (tramp-dissect-file-name default-directory))
    ;; The equivalent to `exec-directory'.
-   `(,(file-remote-p default-directory 'localname))))
+   `(,(tramp-compat-file-local-name default-directory))))
 
 (defun tramp-sh-handle-file-local-copy (filename)
   "Like `file-local-copy' for Tramp files."
@@ -4448,8 +4448,7 @@ Goes through the list `tramp-local-coding-commands' and
                              (format-spec
                               value
                               (format-spec-make
-                               ?t
-                               (file-remote-p tmpfile 'localname)))))
+                               ?t (tramp-compat-file-local-name tmpfile)))))
                      (tramp-maybe-send-script vec value name)
                      (setq rem-dec name)))
                  (tramp-message
@@ -5531,7 +5530,7 @@ This command is returned only if 
`delete-by-moving-to-trash' is non-nil."
           "%s -t %s %s"
           result
           (format-time-string "%Y%m%d%H%M.%S")
-          (file-remote-p tmpfile 'localname))))
+          (tramp-compat-file-local-name tmpfile))))
        (delete-file tmpfile))
       result)))
 
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 02870fa..a44abfd 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -169,6 +169,7 @@ See the variable `tramp-encoding-shell' for more 
information."
 This is a list of entries of the form (NAME PARAM1 PARAM2 ...).
 Each NAME stands for a remote access method.  Each PARAM is a
 pair of the form (KEY VALUE).  The following KEYs are defined:
+
   * `tramp-remote-shell'
     This specifies the shell to use on the remote host.  This
     MUST be a Bourne-like shell.  It is normally not necessary to
@@ -177,19 +178,23 @@ pair of the form (KEY VALUE).  The following KEYs are 
defined:
     for it.  Also note that \"/bin/sh\" exists on all Unixen,
     this might not be true for the value that you decide to use.
     You Have Been Warned.
+
   * `tramp-remote-shell-login'
     This specifies the arguments to let `tramp-remote-shell' run
     as a login shell.  It defaults to (\"-l\"), but some shells,
     like ksh, require another argument.  See
     `tramp-connection-properties' for a way to overwrite the
     default value.
+
   * `tramp-remote-shell-args'
     For implementation of `shell-command', this specifies the
     arguments to let `tramp-remote-shell' run a single command.
+
   * `tramp-login-program'
     This specifies the name of the program to use for logging in to the
     remote host.  This may be the name of rsh or a workalike program,
     or the name of telnet or a workalike, or the name of su or a workalike.
+
   * `tramp-login-args'
     This specifies the list of arguments to pass to the above
     mentioned program.  Please note that this is a list of list of arguments,
@@ -205,59 +210,88 @@ pair of the form (KEY VALUE).  The following KEYs are 
defined:
     `tramp-make-tramp-temp-file'.  \"%k\" indicates the keep-date
     parameter of a program, if exists.  \"%c\" adds additional
     `tramp-ssh-controlmaster-options' options for the first hop.
+    The existence of `tramp-login-args', combined with the absence of
+    `tramp-copy-args', is an indication that the method is capable of
+     multi-hops.
+
   * `tramp-login-env'
      A list of environment variables and their values, which will
      be set when calling `tramp-login-program'.
+
   * `tramp-async-args'
     When an asynchronous process is started, we know already that
     the connection works.  Therefore, we can pass additional
     parameters to suppress diagnostic messages, in order not to
     tamper the process output.
+
   * `tramp-copy-program'
     This specifies the name of the program to use for remotely copying
     the file; this might be the absolute filename of scp or the name of
     a workalike program.  It is always applied on the local host.
+
   * `tramp-copy-args'
     This specifies the list of parameters to pass to the above mentioned
     program, the hints for `tramp-login-args' also apply here.
+
   * `tramp-copy-env'
      A list of environment variables and their values, which will
      be set when calling `tramp-copy-program'.
+
   * `tramp-remote-copy-program'
     The listener program to be applied on remote side, if needed.
+
   * `tramp-remote-copy-args'
     The list of parameters to pass to the listener program, the hints
     for `tramp-login-args' also apply here.  Additionally, \"%r\" could
     be used here and in `tramp-copy-args'.  It denotes a randomly
     chosen port for the remote listener.
+
   * `tramp-copy-keep-date'
     This specifies whether the copying program when the preserves the
     timestamp of the original file.
+
   * `tramp-copy-keep-tmpfile'
     This specifies whether a temporary local file shall be kept
     for optimization reasons (useful for \"rsync\" methods).
+
   * `tramp-copy-recursive'
     Whether the operation copies directories recursively.
+
   * `tramp-default-port'
     The default port of a method.
+
   * `tramp-tmpdir'
     A directory on the remote host for temporary files.  If not
     specified, \"/tmp\" is taken as default.
+
   * `tramp-connection-timeout'
     This is the maximum time to be spent for establishing a connection.
     In general, the global default value shall be used, but for
     some methods, like \"su\" or \"sudo\", a shorter timeout
     might be desirable.
+
   * `tramp-session-timeout'
     How long a Tramp connection keeps open before being disconnected.
     This is useful for methods like \"su\" or \"sudo\", which
     shouldn't run an open connection in the background forever.
+
   * `tramp-case-insensitive'
     Whether the remote file system handles file names case insensitive.
     Only a non-nil value counts, the default value nil means to
     perform further checks on the remote host.  See
     `tramp-connection-properties' for a way to overwrite this.
 
+  * `tramp-mount-args'
+  * `tramp-copyto-args'
+  * `tramp-moveto-args'
+  * `tramp-about-args'
+    These parameters, a list of list like `tramp-login-args', are used
+    for the \"rclone\" method, and are appended to the respective
+    \"rclone\" commands.  In general, they shouldn't be changed inside
+    `tramp-methods'; it is recommended to change their values via
+    `tramp-connection-properties'.  Unlike `tramp-login-args' there is
+     no pattern replacement.
+
 What does all this mean?  Well, you should specify `tramp-login-program'
 for all methods; this program is used to log in to the remote site.  Then,
 there are two ways to actually transfer the files between the local and the
@@ -2993,6 +3027,7 @@ Host is always \"localhost\"."
 (defun tramp-parse-netrc (filename)
   "Return a list of (user host) tuples allowed to access.
 User may be nil."
+  (require 'netrc)
   (mapcar
    (lambda (item)
      (and (assoc "machine" item)
@@ -3101,6 +3136,28 @@ User is always nil."
       (if (file-directory-p dir) dir (file-name-directory dir)) nil
     (tramp-flush-directory-properties v localname)))
 
+(defun tramp-handle-expand-file-name (name &optional dir)
+  "Like `expand-file-name' for Tramp files."
+  ;; If DIR is not given, use DEFAULT-DIRECTORY or "/".
+  (setq dir (or dir default-directory "/"))
+  ;; Unless NAME is absolute, concat DIR and NAME.
+  (unless (file-name-absolute-p name)
+    (setq name (concat (file-name-as-directory dir) name)))
+  ;; If NAME is not a Tramp file, run the real handler.
+  (if (not (tramp-tramp-file-p name))
+      (tramp-run-real-handler 'expand-file-name (list name nil))
+    ;; Dissect NAME.
+    (with-parsed-tramp-file-name name nil
+      (unless (tramp-run-real-handler 'file-name-absolute-p (list localname))
+       (setq localname (concat "/" localname)))
+      ;; Do normal `expand-file-name' (this does "/./" and "/../").
+      ;; `default-directory' is bound, because on Windows there would
+      ;; be problems with UNC shares or Cygwin mounts.
+      (let ((default-directory (tramp-compat-temporary-file-directory)))
+       (tramp-make-tramp-file-name
+        v (tramp-drop-volume-letter
+           (tramp-run-real-handler 'expand-file-name (list localname))))))))
+
 (defun tramp-handle-file-accessible-directory-p (filename)
   "Like `file-accessible-directory-p' for Tramp files."
   (and (file-directory-p filename)
@@ -3136,6 +3193,17 @@ User is always nil."
         (file-remote-p (expand-file-name directory)))
     (tramp-run-real-handler 'file-in-directory-p (list filename directory))))
 
+(defun tramp-handle-file-local-copy (filename)
+  "Like `file-local-copy' for Tramp files."
+  (with-parsed-tramp-file-name filename nil
+    (unless (file-exists-p filename)
+      (tramp-error
+       v tramp-file-missing
+       "Cannot make local copy of non-existing file `%s'" filename))
+    (let ((tmpfile (tramp-compat-make-temp-file filename)))
+      (copy-file filename tmpfile 'ok-if-already-exists 'keep-time)
+      tmpfile)))
+
 (defun tramp-handle-file-modes (filename)
   "Like `file-modes' for Tramp files."
   (let ((truename (or (file-truename filename) filename)))
@@ -3184,7 +3252,7 @@ User is always nil."
                  ;; lower case letters.  This avoids us to create a
                  ;; temporary file.
                  (while (and (string-match-p
-                              "[a-z]" (file-remote-p candidate 'localname))
+                              "[a-z]" (tramp-compat-file-local-name candidate))
                              (not (file-exists-p candidate)))
                    (setq candidate
                          (directory-file-name
@@ -3195,7 +3263,7 @@ User is always nil."
                  ;; so there is no compatibility problem calling it.
                  (unless
                      (string-match-p
-                      "[a-z]" (file-remote-p candidate 'localname))
+                      "[a-z]" (tramp-compat-file-local-name candidate))
                    (setq tmpfile
                          (let ((default-directory
                                  (file-name-directory filename)))
@@ -3208,7 +3276,7 @@ User is always nil."
                      (file-exists-p
                       (concat
                        (file-remote-p candidate)
-                       (upcase (file-remote-p candidate 'localname))))
+                       (upcase (tramp-compat-file-local-name candidate))))
                    ;; Cleanup.
                    (when tmpfile (delete-file tmpfile)))))))))))
 
@@ -3341,7 +3409,17 @@ User is always nil."
              (tramp-error
               v1 'file-error
               "Maximum number (%d) of symlinks exceeded" numchase-limit)))
-         (file-remote-p (directory-file-name result) 'localname)))))))
+         (tramp-compat-file-local-name (directory-file-name result))))))))
+
+(defun tramp-handle-file-writable-p (filename)
+  "Like `file-writable-p' for Tramp files."
+  (with-parsed-tramp-file-name filename nil
+    (with-tramp-file-property v localname "file-writable-p"
+      (if (file-exists-p filename)
+         (tramp-check-cached-permissions v ?w)
+       ;; If file doesn't exist, check if directory is writable.
+       (and (file-directory-p (file-name-directory filename))
+            (file-writable-p (file-name-directory filename)))))))
 
 (defun tramp-handle-find-backup-file-name (filename)
   "Like `find-backup-file-name' for Tramp files."
@@ -3717,6 +3795,48 @@ of."
           ;; only if that agrees with the buffer's record.
           (t (tramp-compat-time-equal-p mt tramp-time-doesnt-exist))))))))
 
+(defun tramp-handle-write-region
+  (start end filename &optional append visit lockname mustbenew)
+  "Like `write-region' for Tramp files."
+  (setq filename (expand-file-name filename))
+  (with-parsed-tramp-file-name filename nil
+    (when (and mustbenew (file-exists-p filename)
+              (or (eq mustbenew 'excl)
+                  (not
+                   (y-or-n-p
+                    (format "File %s exists; overwrite anyway? " filename)))))
+      (tramp-error v 'file-already-exists filename))
+
+    (let ((tmpfile (tramp-compat-make-temp-file filename)))
+      (when (and append (file-exists-p filename))
+       (copy-file filename tmpfile 'ok))
+      ;; We say `no-message' here because we don't want the visited file
+      ;; modtime data to be clobbered from the temp file.  We call
+      ;; `set-visited-file-modtime' ourselves later on.
+      (tramp-run-real-handler
+       'write-region (list start end tmpfile append 'no-message lockname))
+      (condition-case nil
+         (rename-file tmpfile filename 'ok-if-already-exists)
+       (error
+        (delete-file tmpfile)
+        (tramp-error
+         v 'file-error "Couldn't write region to `%s'" filename))))
+
+    (tramp-flush-file-properties v (file-name-directory localname))
+    (tramp-flush-file-properties v localname)
+
+    ;; Set file modification time.
+    (when (or (eq visit t) (stringp visit))
+      (set-visited-file-modtime
+       (tramp-compat-file-attribute-modification-time
+       (file-attributes filename))))
+
+    ;; The end.
+    (when (and (null noninteractive)
+              (or (eq visit t) (null visit) (stringp visit)))
+      (tramp-message v 0 "Wrote %s" filename))
+    (run-hooks 'tramp-handle-write-region-hook)))
+
 ;; This is used in tramp-gvfs.el and tramp-sh.el.
 (defconst tramp-gio-events
   '("attribute-changed" "changed" "changes-done-hint"
@@ -4344,7 +4464,7 @@ This handles also chrooted environments, which are not 
regarded as local."
           (tramp-make-tramp-file-name
            vec (or (tramp-get-method-parameter vec 'tramp-tmpdir) "/tmp"))))
       (or (and (file-directory-p dir) (file-writable-p dir)
-              (file-remote-p dir 'localname))
+              (tramp-compat-file-local-name dir))
          (tramp-error vec 'file-error "Directory %s not accessible" dir))
       dir)))
 
diff --git a/lisp/net/zeroconf.el b/lisp/net/zeroconf.el
index 0a3f277..25a8dea 100644
--- a/lisp/net/zeroconf.el
+++ b/lisp/net/zeroconf.el
@@ -528,22 +528,27 @@ DOMAIN is nil, the local domain is used."
             zeroconf-avahi-current-domain
             zeroconf-avahi-flags-unspec))))
 
+(defvar zeroconf-service-type-browser-handler-running nil
+  "Prevent infinite recursion in `zeroconf-service-type-browser-handler'.")
+
 (defun zeroconf-service-type-browser-handler (&rest val)
   "Registered service type browser handler at the Avahi daemon."
-  (when zeroconf-debug
-    (message "zeroconf-service-type-browser-handler: %s %S"
-            (dbus-event-member-name last-input-event) val))
-  (cond
-   ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
-    ;; Parameters: (interface protocol type domain flags)
-    ;; Register a service browser.
-    (let ((object-path (zeroconf-register-service-browser (nth 2 val))))
-      ;; Register the signals.
-      (dolist (member '("ItemNew" "ItemRemove" "Failure"))
-       (dbus-register-signal
-        :system zeroconf-service-avahi object-path
-        zeroconf-interface-avahi-service-browser member
-        'zeroconf-service-browser-handler))))))
+  (unless zeroconf-service-type-browser-handler-running
+    (let ((zeroconf-service-type-browser-handler-running t))
+      (when zeroconf-debug
+        (message "zeroconf-service-type-browser-handler: %s %S"
+                (dbus-event-member-name last-input-event) val))
+      (cond
+       ((string-equal (dbus-event-member-name last-input-event) "ItemNew")
+        ;; Parameters: (interface protocol type domain flags)
+        ;; Register a service browser.
+        (let ((object-path (zeroconf-register-service-browser (nth 2 val))))
+          ;; Register the signals.
+          (dolist (member '("ItemNew" "ItemRemove" "Failure"))
+           (dbus-register-signal
+            :system zeroconf-service-avahi object-path
+            zeroconf-interface-avahi-service-browser member
+            'zeroconf-service-browser-handler))))))))
 
 (defun zeroconf-register-service-browser (type)
   "Register a service browser at the Avahi daemon."



reply via email to

[Prev in Thread] Current Thread [Next in Thread]