[Emacs-diffs] master 13d3848 1/2: Write proper `write-region' message in Tramp backends

[Michael Albinus]

branch: master
commit 13d384820d820d76702ca4a5152011006d1a57a0
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>

    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 052ee83..aa71eff 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 f186367..ef354b6 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 05553cc..b7693f8 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 544f3f8..c869728 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 cf72f52..1a82652 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 d4aceb3..1688a16 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))