diff options
| author | Michael Albinus | 2017-05-08 17:27:50 +0200 |
|---|---|---|
| committer | Michael Albinus | 2017-05-08 17:27:50 +0200 |
| commit | 73e3ed48e21287d48fda8d04e55f8b79b526ca50 (patch) | |
| tree | 0469f5c6bc24befa0e6651ad970a12cb31c46e8e | |
| parent | 52f7440b8ea8e18f7e83f8d107bd5e4df1bda7b1 (diff) | |
| download | emacs-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.el | 2 | ||||
| -rw-r--r-- | lisp/net/tramp-cmds.el | 8 | ||||
| -rw-r--r-- | lisp/net/tramp-compat.el | 5 | ||||
| -rw-r--r-- | lisp/net/tramp-gvfs.el | 9 | ||||
| -rw-r--r-- | lisp/net/tramp-sh.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp-smb.el | 6 | ||||
| -rw-r--r-- | lisp/net/tramp.el | 28 | ||||
| -rw-r--r-- | test/lisp/net/tramp-tests.el | 54 |
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. |
| 540 | The regexp should match at end of buffer. | 539 | The 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")))) |