[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 47fe7a5983: Handle file name handler in write-region's VISIT arg
|
From: |
Michael Albinus |
|
Subject: |
master 47fe7a5983: Handle file name handler in write-region's VISIT arg |
|
Date: |
Tue, 3 May 2022 08:14:50 -0400 (EDT) |
branch: master
commit 47fe7a5983a97c3e806e90340f3cd6ab3f0c49b2
Author: Michael Albinus <michael.albinus@gmx.de>
Commit: Michael Albinus <michael.albinus@gmx.de>
Handle file name handler in write-region's VISIT arg
* lisp/net/tramp.el (tramp-skeleton-delete-directory): Move up.
(tramp-skeleton-write-region): New defmacro. Handle also file
name handler in VISIT. (Bug#55166)
(tramp-handle-write-region):
* lisp/net/tramp-adb.el (tramp-adb-handle-write-region):
* lisp/net/tramp-sh.el (tramp-sh-handle-write-region):
* lisp/net/tramp-smb.el (tramp-smb-handle-write-region):
* lisp/net/tramp-sshfs.el (tramp-sshfs-handle-write-region): Use it.
---
lisp/net/tramp-adb.el | 52 +-----
lisp/net/tramp-sh.el | 432 +++++++++++++++++++++---------------------------
lisp/net/tramp-smb.el | 52 +-----
lisp/net/tramp-sshfs.el | 45 +----
lisp/net/tramp.el | 185 +++++++++++++--------
5 files changed, 318 insertions(+), 448 deletions(-)
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index d897594f8d..251d5191cb 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -548,28 +548,8 @@ Emacs dired can't find files."
(defun tramp-adb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname 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 ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename)))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok)
(set-file-modes tmpfile (logior (or (file-modes tmpfile) 0) #o0600)))
@@ -582,33 +562,7 @@ Emacs dired can't find files."
(unless (tramp-adb-execute-adb-command
v "push" tmpfile (tramp-compat-file-name-unquote
localname))
(tramp-error v 'file-error "Cannot write: `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (file-attribute-modification-time (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (delete-file tmpfile))))))
(defun tramp-adb-handle-set-file-modes (filename mode &optional flag)
"Like `set-file-modes' for Tramp files."
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 5e0a67dbb3..ba4cdb0ab5 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3328,251 +3328,197 @@ implementation will be used."
(defun tramp-sh-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname 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 ((file-locked (eq (file-locked-p lockname) t))
- (uid (or (file-attribute-user-id (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (file-attribute-group-id (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (if (and (tramp-local-host-p v)
- ;; `file-writable-p' calls `file-expand-file-name'. We
- ;; cannot use `tramp-run-real-handler' therefore.
- (file-writable-p (file-name-directory localname))
- (or (file-directory-p localname)
- (file-writable-p localname)))
- ;; Short track: if we are on the local host, we can run directly.
- (let ((create-lockfiles (not file-locked)))
- (write-region start end localname append 'no-message lockname))
-
- (let* ((modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- ;; We use this to save the value of
- ;; `last-coding-system-used' after writing the tmp
- ;; file. At the end of the function, we set
- ;; `last-coding-system-used' to this saved value. This
- ;; way, any intermediary coding systems used while
- ;; talking to the remote shell or suchlike won't hose
- ;; this variable. This approach was snarfed from
- ;; ange-ftp.el.
- coding-system-used
- ;; Write region into a tmp file. This isn't really
- ;; needed if we use an encoding function, but currently
- ;; we use it always because this makes the logic
- ;; simpler. We must also set `temporary-file-directory',
- ;; because it could point to a remote directory.
- (temporary-file-directory tramp-compat-temporary-file-directory)
- (tmpfile (or tramp-temp-buffer-file-name
- (tramp-compat-make-temp-file filename))))
-
- ;; If `append' is non-nil, we copy the file locally, and let
- ;; the native `write-region' implementation do the job.
- (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. We must ensure that `file-coding-system-alist'
- ;; matches `tmpfile'.
- (let ((file-coding-system-alist
- (tramp-find-file-name-coding-system-alist filename tmpfile))
- create-lockfiles)
- (condition-case err
- (write-region start end tmpfile append 'no-message)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err))))
-
- ;; Now, `last-coding-system-used' has the right value. Remember it.
- (setq coding-system-used last-coding-system-used))
-
- ;; The permissions of the temporary file should be set. If
- ;; FILENAME does not exist (eq modes nil) it has been
- ;; renamed to the backup file. This case `save-buffer'
- ;; handles permissions.
- ;; Ensure that it is still readable.
- (when modes
- (set-file-modes tmpfile (logior (or modes 0) #o0400)))
-
- ;; This is a bit lengthy due to the different methods
- ;; possible for file transfer. First, we check whether the
- ;; method uses an scp program. If so, we call it.
- ;; Otherwise, both encoding and decoding command must be
- ;; specified. However, if the method _also_ specifies an
- ;; encoding function, then that is used for encoding the
- ;; contents of the tmp file.
- (let* ((size (file-attribute-size (file-attributes tmpfile)))
- (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
- (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
- (cond
- ;; `copy-file' handles direct copy and out-of-band methods.
- ((or (tramp-local-host-p v)
- (tramp-method-out-of-band-p v size))
- (if (and (not (stringp start))
- (= (or end (point-max)) (point-max))
- (= (or start (point-min)) (point-min))
- (tramp-get-method-parameter v 'tramp-copy-keep-tmpfile))
- (progn
- (setq tramp-temp-buffer-file-name tmpfile)
- (condition-case err
- ;; We keep the local file for performance
- ;; reasons, useful for "rsync".
- (copy-file tmpfile filename t)
- ((error quit)
- (setq tramp-temp-buffer-file-name nil)
- (delete-file tmpfile)
- (signal (car err) (cdr err)))))
- (setq tramp-temp-buffer-file-name nil)
- ;; Don't rename, in order to keep context in SELinux.
- (unwind-protect
- (copy-file tmpfile filename t)
- (delete-file tmpfile))))
-
- ;; Use inline file transfer.
- (rem-dec
- ;; Encode tmpfile.
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (if (and (tramp-local-host-p v)
+ ;; `file-writable-p' calls `file-expand-file-name'. We
+ ;; cannot use `tramp-run-real-handler' therefore.
+ (file-writable-p (file-name-directory localname))
+ (or (file-directory-p localname)
+ (file-writable-p localname)))
+ ;; Short track: if we are on the local host, we can run directly.
+ (let ((create-lockfiles (not file-locked)))
+ (write-region start end localname append 'no-message lockname))
+
+ (let* ((modes (tramp-default-file-modes
+ filename (and (eq mustbenew 'excl) 'nofollow)))
+ ;; We use this to save the value of
+ ;; `last-coding-system-used' after writing the tmp file.
+ ;; At the end of the function, we set
+ ;; `last-coding-system-used' to this saved value. This
+ ;; way, any intermediary coding systems used while
+ ;; talking to the remote shell or suchlike won't hose
+ ;; this variable. This approach was snarfed from
+ ;; ange-ftp.el.
+ coding-system-used
+ ;; Write region into a tmp file. This isn't really
+ ;; needed if we use an encoding function, but currently
+ ;; we use it always because this makes the logic simpler.
+ ;; We must also set `temporary-file-directory', because
+ ;; it could point to a remote directory.
+ (temporary-file-directory
+ tramp-compat-temporary-file-directory)
+ (tmpfile (or tramp-temp-buffer-file-name
+ (tramp-compat-make-temp-file filename))))
+
+ ;; If `append' is non-nil, we copy the file locally, and let
+ ;; the native `write-region' implementation do the job.
+ (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. We
+ ;; must ensure that `file-coding-system-alist' matches
+ ;; `tmpfile'.
+ (let ((file-coding-system-alist
+ (tramp-find-file-name-coding-system-alist filename tmpfile))
+ create-lockfiles)
+ (condition-case err
+ (write-region start end tmpfile append 'no-message)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err))))
+
+ ;; Now, `last-coding-system-used' has the right value.
+ ;; Remember it.
+ (setq coding-system-used last-coding-system-used))
+
+ ;; The permissions of the temporary file should be set. If
+ ;; FILENAME does not exist (eq modes nil) it has been renamed
+ ;; to the backup file. This case `save-buffer' handles
+ ;; permissions. Ensure that it is still readable.
+ (when modes
+ (set-file-modes tmpfile (logior (or modes 0) #o0400)))
+
+ ;; This is a bit lengthy due to the different methods possible
+ ;; for file transfer. First, we check whether the method uses
+ ;; an scp program. If so, we call it. Otherwise, both
+ ;; encoding and decoding command must be specified. However,
+ ;; if the method _also_ specifies an encoding function, then
+ ;; that is used for encoding the contents of the tmp file.
+ (let* ((size (file-attribute-size (file-attributes tmpfile)))
+ (rem-dec (tramp-get-inline-coding v "remote-decoding" size))
+ (loc-enc (tramp-get-inline-coding v "local-encoding" size)))
+ (cond
+ ;; `copy-file' handles direct copy and out-of-band methods.
+ ((or (tramp-local-host-p v)
+ (tramp-method-out-of-band-p v size))
+ (if (and (not (stringp start))
+ (= (or end (point-max)) (point-max))
+ (= (or start (point-min)) (point-min))
+ (tramp-get-method-parameter
+ v 'tramp-copy-keep-tmpfile))
+ (progn
+ (setq tramp-temp-buffer-file-name tmpfile)
+ (condition-case err
+ ;; We keep the local file for performance
+ ;; reasons, useful for "rsync".
+ (copy-file tmpfile filename t)
+ ((error quit)
+ (setq tramp-temp-buffer-file-name nil)
+ (delete-file tmpfile)
+ (signal (car err) (cdr err)))))
+ (setq tramp-temp-buffer-file-name nil)
+ ;; Don't rename, in order to keep context in SELinux.
(unwind-protect
- (with-temp-buffer
- (set-buffer-multibyte nil)
- ;; Use encoding function or command.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Encoding local file `%s' using `%s'"
- tmpfile loc-enc)
- (if (functionp loc-enc)
- ;; The following `let' is a workaround for
- ;; the base64.el that comes with pgnus-0.84.
- ;; If both of the following conditions are
- ;; satisfied, it tries to write to a local
- ;; file in default-directory, but at this
- ;; point, default-directory is remote.
- ;; (`call-process-region' can't write to
- ;; remote files, it seems.) The file in
- ;; question is a tmp file anyway.
- (let ((coding-system-for-read 'binary)
- (default-directory
- tramp-compat-temporary-file-directory))
- (insert-file-contents-literally tmpfile)
- (funcall loc-enc (point-min) (point-max)))
-
- (unless (zerop (tramp-call-local-coding-command
- loc-enc tmpfile t))
- (tramp-error
- v 'file-error
- (concat "Cannot write to `%s', "
- "local encoding command `%s' failed")
- filename loc-enc))))
-
- ;; Send buffer into remote decoding command which
- ;; writes to remote file. Because this happens on
- ;; the remote host, we cannot use the function.
- (with-tramp-progress-reporter
- v 3 (format-message
- "Decoding remote file `%s' using `%s'"
- filename rem-dec)
- (goto-char (point-max))
- (unless (bolp) (newline))
- (tramp-send-command
- v
- (format
- (concat rem-dec " <<'%s'\n%s%s")
- (tramp-shell-quote-argument localname)
- tramp-end-of-heredoc
- (buffer-string)
- tramp-end-of-heredoc))
- (tramp-barf-unless-okay
- v nil
- "Couldn't write region to `%s', decode using `%s' failed"
- filename rem-dec)
- ;; When `file-precious-flag' is set, the region is
- ;; written to a temporary file. Check that the
- ;; checksum is equal to that from the local tmpfile.
- (when file-precious-flag
- (erase-buffer)
- (and
- ;; cksum runs locally, if possible.
- (zerop (tramp-call-process v "cksum" tmpfile t))
- ;; cksum runs remotely.
- (tramp-send-command-and-check
- v
- (format
- "cksum <%s" (tramp-shell-quote-argument localname)))
- ;; ... they are different.
- (not
- (string-equal
- (buffer-string)
- (tramp-get-buffer-string (tramp-get-buffer v))))
- (tramp-error
- v 'file-error
- (concat "Couldn't write region to `%s',"
- " decode using `%s' failed")
- filename rem-dec)))))
-
- ;; Save exit.
- (delete-file tmpfile)))
-
- ;; That's not expected.
- (t
- (tramp-error
- v 'file-error
- (concat "Method `%s' should specify both encoding and "
- "decoding command or an scp program")
- method))))
-
- ;; Make `last-coding-system-used' have the right value.
- (when coding-system-used
- (setq last-coding-system-used coding-system-used))))
-
- (tramp-flush-file-properties v localname)
+ (copy-file tmpfile filename t)
+ (delete-file tmpfile))))
+
+ ;; Use inline file transfer.
+ (rem-dec
+ ;; Encode tmpfile.
+ (unwind-protect
+ (with-temp-buffer
+ (set-buffer-multibyte nil)
+ ;; Use encoding function or command.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Encoding local file `%s' using `%s'"
+ tmpfile loc-enc)
+ (if (functionp loc-enc)
+ ;; The following `let' is a workaround for the
+ ;; base64.el that comes with pgnus-0.84. If
+ ;; both of the following conditions are
+ ;; satisfied, it tries to write to a local
+ ;; file in default-directory, but at this
+ ;; point, default-directory is remote.
+ ;; (`call-process-region' can't write to
+ ;; remote files, it seems.) The file in
+ ;; question is a tmp file anyway.
+ (let ((coding-system-for-read 'binary)
+ (default-directory
+ tramp-compat-temporary-file-directory))
+ (insert-file-contents-literally tmpfile)
+ (funcall loc-enc (point-min) (point-max)))
+
+ (unless (zerop (tramp-call-local-coding-command
+ loc-enc tmpfile t))
+ (tramp-error
+ v 'file-error
+ (concat "Cannot write to `%s', "
+ "local encoding command `%s' failed")
+ filename loc-enc))))
+
+ ;; Send buffer into remote decoding command which
+ ;; writes to remote file. Because this happens on
+ ;; the remote host, we cannot use the function.
+ (with-tramp-progress-reporter
+ v 3 (format-message
+ "Decoding remote file `%s' using `%s'"
+ filename rem-dec)
+ (goto-char (point-max))
+ (unless (bolp) (newline))
+ (tramp-send-command
+ v
+ (format
+ (concat rem-dec " <<'%s'\n%s%s")
+ (tramp-shell-quote-argument localname)
+ tramp-end-of-heredoc
+ (buffer-string)
+ tramp-end-of-heredoc))
+ (tramp-barf-unless-okay
+ v nil
+ "Couldn't write region to `%s', decode using `%s' failed"
+ filename rem-dec)
+ ;; When `file-precious-flag' is set, the region is
+ ;; written to a temporary file. Check that the
+ ;; checksum is equal to that from the local tmpfile.
+ (when file-precious-flag
+ (erase-buffer)
+ (and
+ ;; cksum runs locally, if possible.
+ (zerop (tramp-call-process v "cksum" tmpfile t))
+ ;; cksum runs remotely.
+ (tramp-send-command-and-check
+ v
+ (format
+ "cksum <%s"
+ (tramp-shell-quote-argument localname)))
+ ;; ... they are different.
+ (not
+ (string-equal
+ (buffer-string)
+ (tramp-get-buffer-string (tramp-get-buffer v))))
+ (tramp-error
+ v 'file-error
+ "Couldn't write region to `%s', decode using `%s'
failed"
+ filename rem-dec)))))
+
+ ;; Save exit.
+ (delete-file tmpfile)))
+
+ ;; That's not expected.
+ (t
+ (tramp-error
+ v 'file-error
+ (concat "Method `%s' should specify both encoding and "
+ "decoding command or an scp program")
+ method))))
- ;; We must protect `last-coding-system-used', now we have set it
- ;; to its correct value.
- (let (last-coding-system-used (need-chown t))
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (let ((file-attr (file-attributes filename 'integer)))
- (set-visited-file-modtime
- ;; We must pass modtime explicitly, because FILENAME can
- ;; be different from (buffer-file-name), f.e. if
- ;; `file-precious-flag' is set.
- (or (file-attribute-modification-time file-attr)
- (current-time)))
- (when (and (= (file-attribute-user-id file-attr) uid)
- (= (file-attribute-group-id file-attr) gid))
- (setq need-chown nil))))
-
- ;; Set the ownership.
- (when need-chown
- (tramp-set-file-uid-gid filename uid gid))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook)))))
+ ;; Make `last-coding-system-used' have the right value.
+ (when coding-system-used
+ (setq last-coding-system-used coding-system-used))))))
(defvar tramp-vc-registered-file-names nil
"List used to collect file names, which are checked during `vc-registered'.")
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 4af5a4204f..968c1daccb 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1617,28 +1617,8 @@ VEC or USER, or if there is no home directory, return
nil."
(defun tramp-smb-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname 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 ((file-locked (eq (file-locked-p lockname) t))
- (curbuf (current-buffer))
- (tmpfile (tramp-compat-make-temp-file filename)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (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
@@ -1654,33 +1634,7 @@ VEC or USER, or if there is no home directory, return
nil."
v (format "put %s \"%s\""
tmpfile (tramp-smb-get-localname v)))
(tramp-error v 'file-error "Cannot write `%s'" filename))
- (delete-file tmpfile)))
-
- ;; We must also flush the cache of the directory, because
- ;; `file-attributes' reads the values from there.
- (tramp-flush-file-properties v localname)
-
- (unless (equal curbuf (current-buffer))
- (tramp-error
- v 'file-error
- "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (file-attribute-modification-time (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (delete-file tmpfile))))))
;; Internal file name functions.
diff --git a/lisp/net/tramp-sshfs.el b/lisp/net/tramp-sshfs.el
index 02c0da3f18..61bf165f30 100644
--- a/lisp/net/tramp-sshfs.el
+++ b/lisp/net/tramp-sshfs.el
@@ -373,47 +373,10 @@ arguments to pass to the OPERATION."
(defun tramp-sshfs-handle-write-region
(start end filename &optional append visit lockname mustbenew)
"Like `write-region' for Tramp files."
- (setq filename (expand-file-name filename)
- lockname (file-truename (or lockname 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 ((file-locked (eq (file-locked-p lockname) t)))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
- (let (create-lockfiles)
- (write-region
- start end (tramp-fuse-local-file-name filename) append 'nomessage)
- (tramp-flush-file-properties v localname))
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (file-attribute-modification-time (file-attributes filename))
- (current-time))))
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let (create-lockfiles)
+ (write-region
+ start end (tramp-fuse-local-file-name filename) append 'nomessage))))
;; File name conversions.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 3d28861179..b889f1f884 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -3353,6 +3353,121 @@ User is always nil."
(forward-line 1)
result))
+;;; Skeleton macros for file name handler functions.
+
+(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
+ "Skeleton for `tramp-*-handle-delete-directory'.
+BODY is the backend specific code."
+ (declare (indent 3) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
+ (if (and delete-by-moving-to-trash ,trash)
+ ;; Move non-empty dir to trash only if recursive deletion was
+ ;; requested.
+ (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
+ (tramp-error
+ v 'file-error "Directory is not empty, not moving to trash")
+ (move-file-to-trash ,directory))
+ ,@body)
+ (tramp-flush-directory-properties v localname)))
+
+(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
+
+(defmacro tramp-skeleton-write-region
+ (start end filename append visit lockname mustbenew &rest body)
+ "Skeleton for `tramp-*-handle-write-region'.
+BODY is the backend specific code."
+ (declare (indent 7) (debug t))
+ `(with-parsed-tramp-file-name (expand-file-name ,filename) nil
+ (setq ,filename (expand-file-name ,filename)
+ ,lockname (file-truename (or ,lockname ,filename)))
+ ;; Sometimes, there is another file name handler responsible for
+ ;; VISIT, for example `jka-compr-handler'. We must respect this.
+ ;; See Bug#55166.
+ (let ((handler (and (stringp ,visit)
+ (let ((inhibit-file-name-handlers
+ (cons 'tramp-file-name-handler
+ inhibit-file-name-handlers))
+ (inhibit-file-name-operation 'write-region))
+ (find-file-name-handler ,visit 'write-region)))))
+ (if handler
+ (progn
+ (tramp-message
+ v 5 "Calling handler `%s' for visiting `%s'" handler ,visit)
+ (funcall
+ handler 'write-region
+ ,start ,end ,filename ,append ,visit ,lockname ,mustbenew))
+
+ (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 ((file-locked (eq (file-locked-p ,lockname) t))
+ (uid (or (file-attribute-user-id
+ (file-attributes ,filename 'integer))
+ (tramp-get-remote-uid v 'integer)))
+ (gid (or (file-attribute-group-id
+ (file-attributes ,filename 'integer))
+ (tramp-get-remote-gid v 'integer)))
+ (curbuf (current-buffer)))
+
+ ;; Lock file.
+ (when (and (not (auto-save-file-name-p
+ (file-name-nondirectory ,filename)))
+ (file-remote-p ,lockname)
+ (not file-locked))
+ (setq file-locked t)
+ ;; `lock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'lock-file ,lockname))
+
+ ;; The body.
+ ,@body
+
+ ;; We must protect `last-coding-system-used', now we have
+ ;; set it to its correct value.
+ (let (last-coding-system-used (need-chown t))
+ ;; Set file modification time.
+ (when (or (eq ,visit t) (stringp ,visit))
+ (let ((file-attr (file-attributes ,filename 'integer)))
+ (set-visited-file-modtime
+ ;; We must pass modtime explicitly, because FILENAME
+ ;; can be different from (buffer-file-name), f.e. if
+ ;; `file-precious-flag' is set.
+ (or (file-attribute-modification-time file-attr)
+ (current-time)))
+ (when (and (= (file-attribute-user-id file-attr) uid)
+ (= (file-attribute-group-id file-attr) gid))
+ (setq need-chown nil))))
+
+ ;; Set the ownership.
+ (when need-chown
+ (tramp-set-file-uid-gid ,filename uid gid)))
+
+ ;; We must also flush the cache of the directory, because
+ ;; `file-attributes' reads the values from there.
+ (tramp-flush-file-properties v localname)
+
+ ;; Unlock file.
+ (when file-locked
+ ;; `unlock-file' exists since Emacs 28.1.
+ (tramp-compat-funcall 'unlock-file ,lockname))
+
+ ;; Sanity check.
+ (unless (equal curbuf (current-buffer))
+ (tramp-error
+ v 'file-error
+ "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
+
+ (when (and (null noninteractive)
+ (or (eq ,visit t) (string-or-null-p ,visit)))
+ (tramp-message v 0 "Wrote %s" ,filename))
+ (run-hooks 'tramp-handle-write-region-hook))))))
+
+(put #'tramp-skeleton-write-region 'tramp-suppress-trace t)
+
;;; Common file name handler functions for different backends:
(defvar tramp-handle-file-local-copy-hook nil
@@ -4827,33 +4942,10 @@ of."
(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)
- lockname (file-truename (or lockname 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 ((file-locked (eq (file-locked-p lockname) t))
- (tmpfile (tramp-compat-make-temp-file filename))
+ (tramp-skeleton-write-region start end filename append visit lockname
mustbenew
+ (let ((tmpfile (tramp-compat-make-temp-file filename))
(modes (tramp-default-file-modes
- filename (and (eq mustbenew 'excl) 'nofollow)))
- (uid (or (file-attribute-user-id (file-attributes filename 'integer))
- (tramp-get-remote-uid v 'integer)))
- (gid (or (file-attribute-group-id (file-attributes filename 'integer))
- (tramp-get-remote-gid v 'integer))))
-
- ;; Lock file.
- (when (and (not (auto-save-file-name-p (file-name-nondirectory
filename)))
- (file-remote-p lockname)
- (not file-locked))
- (setq file-locked t)
- ;; `lock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'lock-file lockname))
-
+ filename (and (eq mustbenew 'excl) 'nofollow))))
(when (and append (file-exists-p filename))
(copy-file filename tmpfile 'ok))
;; The permissions of the temporary file should be set. If
@@ -4872,29 +4964,7 @@ of."
(error
(delete-file tmpfile)
(tramp-error
- v 'file-error "Couldn't write region to `%s'" filename)))
-
- (tramp-flush-file-properties v localname)
-
- ;; Set file modification time.
- (when (or (eq visit t) (stringp visit))
- (set-visited-file-modtime
- (or (file-attribute-modification-time (file-attributes filename))
- (current-time))))
-
- ;; Set the ownership.
- (tramp-set-file-uid-gid filename uid gid)
-
- ;; Unlock file.
- (when file-locked
- ;; `unlock-file' exists since Emacs 28.1.
- (tramp-compat-funcall 'unlock-file lockname))
-
- ;; The end.
- (when (and (null noninteractive)
- (or (eq visit t) (string-or-null-p visit)))
- (tramp-message v 0 "Wrote %s" filename))
- (run-hooks 'tramp-handle-write-region-hook))))
+ v 'file-error "Couldn't write region to `%s'" filename))))))
;; This is used in tramp-sh.el and tramp-sudoedit.el.
(defconst tramp-stat-marker "/////"
@@ -6176,23 +6246,6 @@ If VEC is `tramp-null-hop', return local null device."
(let ((default-directory (tramp-make-tramp-file-name vec)))
(tramp-compat-null-device)))))
-(defmacro tramp-skeleton-delete-directory (directory recursive trash &rest
body)
- "Skeleton for `tramp-*-handle-delete-directory'.
-BODY is the backend specific code."
- (declare (indent 3) (debug t))
- `(with-parsed-tramp-file-name (expand-file-name ,directory) nil
- (if (and delete-by-moving-to-trash ,trash)
- ;; Move non-empty dir to trash only if recursive deletion was
- ;; requested.
- (if (not (or ,recursive (tramp-compat-directory-empty-p ,directory)))
- (tramp-error
- v 'file-error "Directory is not empty, not moving to trash")
- (move-file-to-trash ,directory))
- ,@body)
- (tramp-flush-directory-properties v localname)))
-
-(put #'tramp-skeleton-delete-directory 'tramp-suppress-trace t)
-
;; Checklist for `tramp-unload-hook'
;; - Unload all `tramp-*' packages
;; - Reset `file-name-handler-alist'
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 47fe7a5983: Handle file name handler in write-region's VISIT arg,
Michael Albinus <=