[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 13d3848 1/2: Write proper `write-region' message in
From: |
Michael Albinus |
Subject: |
[Emacs-diffs] master 13d3848 1/2: Write proper `write-region' message in Tramp backends |
Date: |
Thu, 4 Jan 2018 06:59:17 -0500 (EST) |
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))