Commit 294b2c2b authored by Michael Albinus's avatar Michael Albinus

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.
parent e4a8f6eb
Pipeline #218 failed with stage
in 5 minutes and 40 seconds
......@@ -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.
......
......@@ -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))))
......
......@@ -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.
......
......@@ -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
......@@ -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)))
......
......@@ -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)