From 13d384820d820d76702ca4a5152011006d1a57a0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Thu, 4 Jan 2018 12:48:07 +0100 Subject: [PATCH] Write proper `write-region' message in Tramp backends * lisp/net/tramp-adb.el (tramp-adb-handle-write-region): * lisp/net/tramp-gvfs.el (tramp-gvfs-handle-write-region): * lisp/net/tramp-sh.el (tramp-sh-handle-write-region): * lisp/net/tramp-smb.el (tramp-smb-handle-write-region): Write proper message. * lisp/net/tramp.el (tramp-message-show-message): Change default. * test/lisp/net/tramp-tests.el (ert-x): Require it. (tramp-test10-write-region): Extend test. --- lisp/net/tramp-adb.el | 17 +++++++++++++---- lisp/net/tramp-gvfs.el | 5 +++-- lisp/net/tramp-sh.el | 12 ++++++------ lisp/net/tramp-smb.el | 13 +++++++++++-- lisp/net/tramp.el | 11 ++++++++--- test/lisp/net/tramp-tests.el | 18 ++++++++++++++++++ 6 files changed, 59 insertions(+), 17 deletions(-) diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el index 052ee838e47..aa71effdd92 100644 --- a/lisp/net/tramp-adb.el +++ b/lisp/net/tramp-adb.el @@ -681,13 +681,22 @@ But handle the case, if the \"test\" command is not available." (tramp-error v 'file-error "Cannot write: `%s'" filename)) (delete-file tmpfile))) - (when (or (eq visit t) (stringp visit)) - (set-visited-file-modtime)) - (unless (equal curbuf (current-buffer)) (tramp-error v 'file-error - "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))))) + "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 + (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)))) (defun tramp-adb-handle-set-file-modes (filename mode) "Like `set-file-modes' for Tramp files." diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el index f1863677447..ef354b68950 100644 --- a/lisp/net/tramp-gvfs.el +++ b/lisp/net/tramp-gvfs.el @@ -71,7 +71,7 @@ ;; 'car ;; (dbus-call-method ;; :session tramp-gvfs-service-daemon tramp-gvfs-path-mounttracker -;; tramp-gvfs-interface-mounttracker "listMountableInfo"))) +;; tramp-gvfs-interface-mounttracker "ListMountableInfo"))) ;; Note that all other connection methods are not tested, beside the ;; ones offered for customization in `tramp-gvfs-methods'. If you @@ -1272,7 +1272,8 @@ file-notify events." (file-attributes filename)))) ;; The end. - (when (or (eq visit t) (null visit) (stringp visit)) + (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))) diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el index 05553ccefa3..b7693f8edb5 100644 --- a/lisp/net/tramp-sh.el +++ b/lisp/net/tramp-sh.el @@ -3410,7 +3410,8 @@ the result will be a local, non-Tramp, file name." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) - (when (or (eq visit t) (null visit) (stringp visit)) + (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))))) @@ -4717,7 +4718,8 @@ connection if a previous connection has died for some reason." (setenv "PS1" tramp-initial-end-of-output) (unless (stringp tramp-encoding-shell) (tramp-error vec 'file-error "`tramp-encoding-shell' not set")) - (let* ((target-alist (tramp-compute-multi-hops vec)) + (let* ((current-host (system-name)) + (target-alist (tramp-compute-multi-hops vec)) ;; We will apply `tramp-ssh-controlmaster-options' ;; only for the first hop. (options (tramp-ssh-controlmaster-options vec)) @@ -4738,16 +4740,14 @@ connection if a previous connection has died for some reason." (if tramp-encoding-command-interactive (list tramp-encoding-shell tramp-encoding-command-interactive) - (list tramp-encoding-shell))))) - current-host) + (list tramp-encoding-shell)))))) ;; Set sentinel and query flag. Initialize variables. (tramp-set-connection-property p "vector" vec) (set-process-sentinel p 'tramp-process-sentinel) (process-put p 'adjust-window-size-function 'ignore) (set-process-query-on-exit-flag p nil) - (setq tramp-current-connection (cons vec (current-time)) - current-host (system-name)) + (setq tramp-current-connection (cons vec (current-time))) (tramp-message vec 6 "%s" (mapconcat 'identity (process-command p) " ")) diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el index 544f3f8d759..c8697285360 100644 --- a/lisp/net/tramp-smb.el +++ b/lisp/net/tramp-smb.el @@ -1573,9 +1573,18 @@ errors for shares like \"C$/\", which are common in Microsoft Windows." (tramp-error v 'file-error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) - (when (eq visit t) - (set-visited-file-modtime))))) + ;; 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)))) ;; Internal file name functions. diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index cf72f5225a7..1a8265200cb 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -1626,10 +1626,11 @@ ARGUMENTS to actually emit the message (if applicable)." ;; The message. (insert (apply #'format-message fmt-string arguments)))) -(defvar tramp-message-show-message t +(defvar tramp-message-show-message (null noninteractive) "Show Tramp message in the minibuffer. -This variable is used to disable messages from `tramp-error'. -The messages are visible anyway, because an error is raised.") +This variable is used to suppress progress reporter output, and +to disable messages from `tramp-error'. Those messages are +visible anyway, because an error is raised.") (defsubst tramp-message (vec-or-proc level fmt-string &rest arguments) "Emit a message depending on verbosity level. @@ -2230,6 +2231,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." (let ((default-directory (tramp-compat-temporary-file-directory))) (load (cadr sf) 'noerror 'nomessage))) +;; (tramp-message +;; v 4 "Running `%s'..." (cons operation args)) ;; If `non-essential' is non-nil, Tramp shall ;; not open a new connection. ;; If Tramp detects that it shouldn't continue @@ -2253,6 +2256,8 @@ Falls back to normal file name handler if no Tramp file name handler exists." (let ((tramp-locker t)) (apply foreign operation args)) (setq tramp-locked tl)))))) +;; (tramp-message +;; v 4 "Running `%s'...`%s'" (cons operation args) result) (cond ((eq result 'non-essential) (tramp-message diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index d4aceb31b58..1688a166ca6 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -43,6 +43,7 @@ (require 'dired) (require 'ert) +(require 'ert-x) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -1866,6 +1867,23 @@ This checks also `file-name-as-directory', `file-name-directory', (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34"))) + ;; Check message. + ;; Macro `ert-with-message-capture' was introduced in Emacs 26.1. + (with-no-warnings (when (symbol-plist 'ert-with-message-capture) + (let ((tramp-message-show-message t)) + (dolist (noninteractive '(nil t)) + (dolist (visit '(nil t "string" no-message)) + (ert-with-message-capture tramp--test-messages + (write-region "foo" nil tmp-name nil visit) + ;; We must check the last line. There could be + ;; other messages from the progress reporter. + (should + (string-match + (if (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (format "^Wrote %s\n\\'" tmp-name) "^\\'") + tramp--test-messages)))))))) + ;; Do not overwrite if excluded. (cl-letf (((symbol-function 'y-or-n-p) (lambda (_prompt) t))) (write-region "foo" nil tmp-name nil nil nil 'mustbenew)) -- 2.39.2