aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMichael Albinus2017-05-08 17:27:50 +0200
committerMichael Albinus2017-05-08 17:27:50 +0200
commit73e3ed48e21287d48fda8d04e55f8b79b526ca50 (patch)
tree0469f5c6bc24befa0e6651ad970a12cb31c46e8e
parent52f7440b8ea8e18f7e83f8d107bd5e4df1bda7b1 (diff)
downloademacs-73e3ed48e21287d48fda8d04e55f8b79b526ca50.tar.gz
emacs-73e3ed48e21287d48fda8d04e55f8b79b526ca50.zip
Handle `write-region' messages in Tramp properly
* lisp/net/tramp.el (tramp-handle-write-region-message): New defsubst. * 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): Use it. * lisp/net/tramp.el (tramp-password-prompt-regexp) (tramp-completion-mode-p): * lisp/net/tramp-cmds.el (tramp-reporter-dump-variable) (tramp-append-tramp-buffers): * lisp/net/tramp-smb.el (tramp-smb-maybe-open-connection): Use `bound-and-true-p'. * lisp/net/tramp-compat.el (tramp-compat-delete-file): Don't check for `boundp' anymore. * test/lisp/net/tramp-tests.el (ert-x): Require it. (tramp--test-messages): New defvar. (tramp-test10-write-region): Extend test.
-rw-r--r--lisp/net/tramp-adb.el2
-rw-r--r--lisp/net/tramp-cmds.el8
-rw-r--r--lisp/net/tramp-compat.el5
-rw-r--r--lisp/net/tramp-gvfs.el9
-rw-r--r--lisp/net/tramp-sh.el6
-rw-r--r--lisp/net/tramp-smb.el6
-rw-r--r--lisp/net/tramp.el28
-rw-r--r--test/lisp/net/tramp-tests.el54
8 files changed, 89 insertions, 29 deletions
diff --git a/lisp/net/tramp-adb.el b/lisp/net/tramp-adb.el
index 2825532c525..8bbdca795e8 100644
--- a/lisp/net/tramp-adb.el
+++ b/lisp/net/tramp-adb.el
@@ -652,6 +652,8 @@ But handle the case, if the \"test\" command is not available."
652 (when (or (eq visit t) (stringp visit)) 652 (when (or (eq visit t) (stringp visit))
653 (set-visited-file-modtime)) 653 (set-visited-file-modtime))
654 654
655 (tramp-handle-write-region-message v start end filename append visit)
656
655 (unless (equal curbuf (current-buffer)) 657 (unless (equal curbuf (current-buffer))
656 (tramp-error 658 (tramp-error
657 v 'file-error 659 v 'file-error
diff --git a/lisp/net/tramp-cmds.el b/lisp/net/tramp-cmds.el
index 99fc0cc7098..a11908af63e 100644
--- a/lisp/net/tramp-cmds.el
+++ b/lisp/net/tramp-cmds.el
@@ -247,10 +247,9 @@ buffer in your bug report.
247 ;; Pretty print the cache. 247 ;; Pretty print the cache.
248 (set varsym (read (format "(%s)" (tramp-cache-print val)))) 248 (set varsym (read (format "(%s)" (tramp-cache-print val))))
249 ;; There are non-7bit characters to be masked. 249 ;; There are non-7bit characters to be masked.
250 (when (and (boundp 'mm-7bit-chars) 250 (when (and (stringp val)
251 (stringp val)
252 (string-match 251 (string-match
253 (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) 252 (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val))
254 (with-current-buffer reporter-eval-buffer 253 (with-current-buffer reporter-eval-buffer
255 (set 254 (set
256 varsym 255 varsym
@@ -327,8 +326,7 @@ buffer in your bug report.
327 ;; Append buffers only when we are in message mode. 326 ;; Append buffers only when we are in message mode.
328 (when (and 327 (when (and
329 (eq major-mode 'message-mode) 328 (eq major-mode 'message-mode)
330 (boundp 'mml-mode) 329 (bound-and-true-p mml-mode))
331 (symbol-value 'mml-mode))
332 330
333 (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") 331 (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/")
334 (buffer-list (tramp-list-tramp-buffers)) 332 (buffer-list (tramp-list-tramp-buffers))
diff --git a/lisp/net/tramp-compat.el b/lisp/net/tramp-compat.el
index 732922b60ec..322e9c36895 100644
--- a/lisp/net/tramp-compat.el
+++ b/lisp/net/tramp-compat.el
@@ -197,10 +197,7 @@ Add the extension of F, if existing."
197 (tramp-compat-funcall 'delete-file filename trash) 197 (tramp-compat-funcall 'delete-file filename trash)
198 ;; This Emacs version does not support the TRASH flag. 198 ;; This Emacs version does not support the TRASH flag.
199 (wrong-number-of-arguments 199 (wrong-number-of-arguments
200 (let ((delete-by-moving-to-trash 200 (let ((delete-by-moving-to-trash (and delete-by-moving-to-trash trash)))
201 (and (boundp 'delete-by-moving-to-trash)
202 (symbol-value 'delete-by-moving-to-trash)
203 trash)))
204 (delete-file filename))))) 201 (delete-file filename)))))
205 202
206;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been 203;; RECURSIVE has been introduced with Emacs 23.2. TRASH has been
diff --git a/lisp/net/tramp-gvfs.el b/lisp/net/tramp-gvfs.el
index aba6f414a45..55fddf3dbd8 100644
--- a/lisp/net/tramp-gvfs.el
+++ b/lisp/net/tramp-gvfs.el
@@ -619,7 +619,8 @@ is no information where to trace the message.")
619 (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) 619 (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event)
620 (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) 620 (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err))))
621 621
622;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. 622;; `dbus-event-error-hooks' has been renamed to
623;; `dbus-event-error-functions' in Emacs 24.3.
623(add-hook 624(add-hook
624 (if (boundp 'dbus-event-error-functions) 625 (if (boundp 'dbus-event-error-functions)
625 'dbus-event-error-functions 'dbus-event-error-hooks) 626 'dbus-event-error-functions 'dbus-event-error-hooks)
@@ -1223,11 +1224,7 @@ file-notify events."
1223 (file-attributes filename)))) 1224 (file-attributes filename))))
1224 1225
1225 ;; The end. 1226 ;; The end.
1226 (when (or (eq visit t) (null visit) (stringp visit)) 1227 (tramp-handle-write-region-message v start end filename append visit)
1227 (tramp-message v 0 "Wrote `%s' (%d characters)" filename
1228 (cond ((null start) (buffer-size))
1229 ((stringp start) (length start))
1230 (t (- end start)))))
1231 (run-hooks 'tramp-handle-write-region-hook))) 1228 (run-hooks 'tramp-handle-write-region-hook)))
1232 1229
1233 1230
diff --git a/lisp/net/tramp-sh.el b/lisp/net/tramp-sh.el
index 971cdaedf82..adadf9650e6 100644
--- a/lisp/net/tramp-sh.el
+++ b/lisp/net/tramp-sh.el
@@ -3412,11 +3412,7 @@ the result will be a local, non-Tramp, file name."
3412 ;; Set the ownership. 3412 ;; Set the ownership.
3413 (when need-chown 3413 (when need-chown
3414 (tramp-set-file-uid-gid filename uid gid)) 3414 (tramp-set-file-uid-gid filename uid gid))
3415 (when (or (eq visit t) (null visit) (stringp visit)) 3415 (tramp-handle-write-region-message v start end filename append visit)
3416 (tramp-message v 0 "Wrote `%s' (%d characters)" filename
3417 (cond ((null start) (buffer-size))
3418 ((stringp start) (length start))
3419 (t (- end start)))))
3420 (run-hooks 'tramp-handle-write-region-hook))))) 3416 (run-hooks 'tramp-handle-write-region-hook)))))
3421 3417
3422(defvar tramp-vc-registered-file-names nil 3418(defvar tramp-vc-registered-file-names nil
diff --git a/lisp/net/tramp-smb.el b/lisp/net/tramp-smb.el
index 5a3e2566d71..4b288e199af 100644
--- a/lisp/net/tramp-smb.el
+++ b/lisp/net/tramp-smb.el
@@ -1521,7 +1521,8 @@ errors for shares like \"C$/\", which are common in Microsoft Windows."
1521 v 'file-error 1521 v 'file-error
1522 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) 1522 "Buffer has changed from `%s' to `%s'" curbuf (current-buffer)))
1523 (when (eq visit t) 1523 (when (eq visit t)
1524 (set-visited-file-modtime))))) 1524 (set-visited-file-modtime))
1525 (tramp-handle-write-region-message v start end filename append visit))))
1525 1526
1526 1527
1527;; Internal file name functions. 1528;; Internal file name functions.
@@ -1945,8 +1946,7 @@ If ARGUMENT is non-nil, use it as argument for
1945 (error 1946 (error
1946 (with-current-buffer (tramp-get-connection-buffer vec) 1947 (with-current-buffer (tramp-get-connection-buffer vec)
1947 (goto-char (point-min)) 1948 (goto-char (point-min))
1948 (if (and (boundp 'auth-sources) 1949 (if (and (bound-and-true-p auth-sources)
1949 (symbol-value 'auth-sources)
1950 (search-forward-regexp 1950 (search-forward-regexp
1951 tramp-smb-wrong-passwd-regexp nil t)) 1951 tramp-smb-wrong-passwd-regexp nil t))
1952 ;; Disable `auth-source' and `password-cache'. 1952 ;; Disable `auth-source' and `password-cache'.
diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el
index 33e5900f3c2..4a1900c6f8a 100644
--- a/lisp/net/tramp.el
+++ b/lisp/net/tramp.el
@@ -533,9 +533,8 @@ This regexp must match both `tramp-initial-end-of-output' and
533(defcustom tramp-password-prompt-regexp 533(defcustom tramp-password-prompt-regexp
534 (format "^.*\\(%s\\).*:\^@? *" 534 (format "^.*\\(%s\\).*:\^@? *"
535 ;; `password-word-equivalents' has been introduced with Emacs 24.4. 535 ;; `password-word-equivalents' has been introduced with Emacs 24.4.
536 (if (boundp 'password-word-equivalents) 536 (regexp-opt (or (bound-and-true-p password-word-equivalents)
537 (regexp-opt (symbol-value 'password-word-equivalents)) 537 '("password" "passphrase"))))
538 "password\\|passphrase"))
539 "Regexp matching password-like prompts. 538 "Regexp matching password-like prompts.
540The regexp should match at end of buffer. 539The regexp should match at end of buffer.
541 540
@@ -2305,7 +2304,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'."
2305 "Check, whether method / user name / host name completion is active." 2304 "Check, whether method / user name / host name completion is active."
2306 (or 2305 (or
2307 ;; Signal from outside. `non-essential' has been introduced in Emacs 24. 2306 ;; Signal from outside. `non-essential' has been introduced in Emacs 24.
2308 (and (boundp 'non-essential) (symbol-value 'non-essential)) 2307 (bound-and-true-p non-essential)
2309 ;; This variable has been obsoleted in Emacs 26. 2308 ;; This variable has been obsoleted in Emacs 26.
2310 tramp-completion-mode)) 2309 tramp-completion-mode))
2311 2310
@@ -2754,6 +2753,27 @@ User is always nil."
2754(defvar tramp-handle-write-region-hook nil 2753(defvar tramp-handle-write-region-hook nil
2755 "Normal hook to be run at the end of `tramp-*-handle-write-region'.") 2754 "Normal hook to be run at the end of `tramp-*-handle-write-region'.")
2756 2755
2756(defsubst tramp-handle-write-region-message
2757 (vec start end filename &optional append visit)
2758 "Message to be written for `tramp-*-handle-write-region'"
2759 ;; We shall also don't write when autosaving. How to check?
2760 (when (and (null noninteractive)
2761 (or (eq visit t) (null visit) (stringp visit)))
2762 (let ((nchars (cond ((null start) (buffer-size))
2763 ((stringp start) (length start))
2764 (t (- end start)))))
2765 (tramp-message
2766 vec 0 "%s `%s'%s"
2767 (cond
2768 ((numberp append) "Updated")
2769 (append "Added to")
2770 (t "Wrote"))
2771 filename
2772 (cond
2773 ((null (bound-and-true-p write-region-verbose)) "")
2774 ((= nchars 1) " (1 character)")
2775 (t (format " (%d characters)" nchars)))))))
2776
2757(defun tramp-handle-directory-file-name (directory) 2777(defun tramp-handle-directory-file-name (directory)
2758 "Like `directory-file-name' for Tramp files." 2778 "Like `directory-file-name' for Tramp files."
2759 ;; If localname component of filename is "/", leave it unchanged. 2779 ;; If localname component of filename is "/", leave it unchanged.
diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el
index 8db54979b6d..742bdfd9348 100644
--- a/test/lisp/net/tramp-tests.el
+++ b/test/lisp/net/tramp-tests.el
@@ -39,6 +39,7 @@
39 39
40(require 'dired) 40(require 'dired)
41(require 'ert) 41(require 'ert)
42(require 'ert-x)
42(require 'tramp) 43(require 'tramp)
43(require 'vc) 44(require 'vc)
44(require 'vc-bzr) 45(require 'vc-bzr)
@@ -80,6 +81,9 @@
80(when (getenv "NIX_STORE") 81(when (getenv "NIX_STORE")
81 (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) 82 (add-to-list 'tramp-remote-path 'tramp-own-remote-path))
82 83
84(defvar tramp--test-messages nil
85 "Captured messages from *Messages* buffer.")
86
83(defvar tramp--test-expensive-test 87(defvar tramp--test-expensive-test
84 (null 88 (null
85 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) 89 (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))"))
@@ -1741,31 +1745,77 @@ This checks also `file-name-as-directory', `file-name-directory',
1741 (skip-unless (tramp--test-enabled)) 1745 (skip-unless (tramp--test-enabled))
1742 1746
1743 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) 1747 (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil)))
1744 (let ((tmp-name (tramp--test-make-temp-name nil quoted))) 1748 (let* ((tmp-name (tramp--test-make-temp-name nil quoted))
1749 (text-quoting-style 'grave)
1750 (write-region-verbose
1751 (and (null noninteractive) (boundp 'write-region-verbose)))
1752 (tramp-message-show-message
1753 (or tramp-message-show-message write-region-verbose)))
1745 (unwind-protect 1754 (unwind-protect
1746 (progn 1755 (ert-with-message-capture tramp--test-messages
1756 ;; Write buffer.
1757 (setq tramp--test-messages "")
1747 (with-temp-buffer 1758 (with-temp-buffer
1748 (insert "foo") 1759 (insert "foo")
1749 (write-region nil nil tmp-name)) 1760 (write-region nil nil tmp-name))
1761 (when write-region-verbose
1762 (should
1763 (string-match
1764 (format "Wrote `%s' (3 characters)" tmp-name)
1765 tramp--test-messages)))
1750 (with-temp-buffer 1766 (with-temp-buffer
1751 (insert-file-contents tmp-name) 1767 (insert-file-contents tmp-name)
1752 (should (string-equal (buffer-string) "foo"))) 1768 (should (string-equal (buffer-string) "foo")))
1769
1753 ;; Append. 1770 ;; Append.
1771 (setq tramp--test-messages "")
1754 (with-temp-buffer 1772 (with-temp-buffer
1755 (insert "bla") 1773 (insert "bla")
1756 (write-region nil nil tmp-name 'append)) 1774 (write-region nil nil tmp-name 'append))
1775 (when write-region-verbose
1776 (should
1777 (string-match
1778 (format "Added to `%s' (3 characters)" tmp-name)
1779 tramp--test-messages)))
1757 (with-temp-buffer 1780 (with-temp-buffer
1758 (insert-file-contents tmp-name) 1781 (insert-file-contents tmp-name)
1759 (should (string-equal (buffer-string) "foobla"))) 1782 (should (string-equal (buffer-string) "foobla")))
1783
1784 (setq tramp--test-messages "")
1785 (with-temp-buffer
1786 (insert "baz")
1787 (write-region nil nil tmp-name 3))
1788 (when write-region-verbose
1789 (should
1790 (string-match
1791 (format "Updated `%s' (3 characters)" tmp-name)
1792 tramp--test-messages)))
1793 (with-temp-buffer
1794 (insert-file-contents tmp-name)
1795 (should (string-equal (buffer-string) "foobaz")))
1796
1760 ;; Write string. 1797 ;; Write string.
1798 (setq tramp--test-messages "")
1761 (write-region "foo" nil tmp-name) 1799 (write-region "foo" nil tmp-name)
1800 (when write-region-verbose
1801 (should
1802 (string-match
1803 (format "Wrote `%s' (3 characters)" tmp-name)
1804 tramp--test-messages)))
1762 (with-temp-buffer 1805 (with-temp-buffer
1763 (insert-file-contents tmp-name) 1806 (insert-file-contents tmp-name)
1764 (should (string-equal (buffer-string) "foo"))) 1807 (should (string-equal (buffer-string) "foo")))
1808
1765 ;; Write partly. 1809 ;; Write partly.
1810 (setq tramp--test-messages "")
1766 (with-temp-buffer 1811 (with-temp-buffer
1767 (insert "123456789") 1812 (insert "123456789")
1768 (write-region 3 5 tmp-name)) 1813 (write-region 3 5 tmp-name))
1814 (when write-region-verbose
1815 (should
1816 (string-match
1817 (format "Wrote `%s' (2 characters)" tmp-name)
1818 tramp--test-messages)))
1769 (with-temp-buffer 1819 (with-temp-buffer
1770 (insert-file-contents tmp-name) 1820 (insert-file-contents tmp-name)
1771 (should (string-equal (buffer-string) "34")))) 1821 (should (string-equal (buffer-string) "34"))))