From: Michael Albinus Date: Mon, 8 May 2017 15:27:50 +0000 (+0200) Subject: Handle `write-region' messages in Tramp properly X-Git-Tag: emacs-26.0.90~521^2~434 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=73e3ed48e21287d48fda8d04e55f8b79b526ca50;p=emacs.git 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. --- 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." (when (or (eq visit t) (stringp visit)) (set-visited-file-modtime)) + (tramp-handle-write-region-message v start end filename append visit) + (unless (equal curbuf (current-buffer)) (tramp-error 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. ;; Pretty print the cache. (set varsym (read (format "(%s)" (tramp-cache-print val)))) ;; There are non-7bit characters to be masked. - (when (and (boundp 'mm-7bit-chars) - (stringp val) + (when (and (stringp val) (string-match - (concat "[^" (symbol-value 'mm-7bit-chars) "]") val)) + (concat "[^" (bound-and-true-p mm-7bit-chars) "]") val)) (with-current-buffer reporter-eval-buffer (set varsym @@ -327,8 +326,7 @@ buffer in your bug report. ;; Append buffers only when we are in message mode. (when (and (eq major-mode 'message-mode) - (boundp 'mml-mode) - (symbol-value 'mml-mode)) + (bound-and-true-p mml-mode)) (let ((tramp-buf-regexp "\\*\\(debug \\)?tramp/") (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." (tramp-compat-funcall 'delete-file filename trash) ;; This Emacs version does not support the TRASH flag. (wrong-number-of-arguments - (let ((delete-by-moving-to-trash - (and (boundp 'delete-by-moving-to-trash) - (symbol-value 'delete-by-moving-to-trash) - trash))) + (let ((delete-by-moving-to-trash (and delete-by-moving-to-trash trash))) (delete-file filename))))) ;; 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.") (tramp-message tramp-gvfs-dbus-event-vector 10 "%S" event) (tramp-error tramp-gvfs-dbus-event-vector 'file-error "%s" (cadr err)))) -;; `dbus-event-error-hooks' has been renamed to `dbus-event-error-functions'. +;; `dbus-event-error-hooks' has been renamed to +;; `dbus-event-error-functions' in Emacs 24.3. (add-hook (if (boundp 'dbus-event-error-functions) 'dbus-event-error-functions 'dbus-event-error-hooks) @@ -1223,11 +1224,7 @@ file-notify events." (file-attributes filename)))) ;; The end. - (when (or (eq visit t) (null visit) (stringp visit)) - (tramp-message v 0 "Wrote `%s' (%d characters)" filename - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) + (tramp-handle-write-region-message v start end filename append visit) (run-hooks 'tramp-handle-write-region-hook))) 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." ;; Set the ownership. (when need-chown (tramp-set-file-uid-gid filename uid gid)) - (when (or (eq visit t) (null visit) (stringp visit)) - (tramp-message v 0 "Wrote `%s' (%d characters)" filename - (cond ((null start) (buffer-size)) - ((stringp start) (length start)) - (t (- end start))))) + (tramp-handle-write-region-message v start end filename append visit) (run-hooks 'tramp-handle-write-region-hook))))) (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." v 'file-error "Buffer has changed from `%s' to `%s'" curbuf (current-buffer))) (when (eq visit t) - (set-visited-file-modtime))))) + (set-visited-file-modtime)) + (tramp-handle-write-region-message v start end filename append visit)))) ;; Internal file name functions. @@ -1945,8 +1946,7 @@ If ARGUMENT is non-nil, use it as argument for (error (with-current-buffer (tramp-get-connection-buffer vec) (goto-char (point-min)) - (if (and (boundp 'auth-sources) - (symbol-value 'auth-sources) + (if (and (bound-and-true-p auth-sources) (search-forward-regexp tramp-smb-wrong-passwd-regexp nil t)) ;; 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 (defcustom tramp-password-prompt-regexp (format "^.*\\(%s\\).*:\^@? *" ;; `password-word-equivalents' has been introduced with Emacs 24.4. - (if (boundp 'password-word-equivalents) - (regexp-opt (symbol-value 'password-word-equivalents)) - "password\\|passphrase")) + (regexp-opt (or (bound-and-true-p password-word-equivalents) + '("password" "passphrase")))) "Regexp matching password-like prompts. The regexp should match at end of buffer. @@ -2305,7 +2304,7 @@ Add operations defined in `HANDLER-alist' to `tramp-file-name-handler'." "Check, whether method / user name / host name completion is active." (or ;; Signal from outside. `non-essential' has been introduced in Emacs 24. - (and (boundp 'non-essential) (symbol-value 'non-essential)) + (bound-and-true-p non-essential) ;; This variable has been obsoleted in Emacs 26. tramp-completion-mode)) @@ -2754,6 +2753,27 @@ User is always nil." (defvar tramp-handle-write-region-hook nil "Normal hook to be run at the end of `tramp-*-handle-write-region'.") +(defsubst tramp-handle-write-region-message + (vec start end filename &optional append visit) + "Message to be written for `tramp-*-handle-write-region'" + ;; We shall also don't write when autosaving. How to check? + (when (and (null noninteractive) + (or (eq visit t) (null visit) (stringp visit))) + (let ((nchars (cond ((null start) (buffer-size)) + ((stringp start) (length start)) + (t (- end start))))) + (tramp-message + vec 0 "%s `%s'%s" + (cond + ((numberp append) "Updated") + (append "Added to") + (t "Wrote")) + filename + (cond + ((null (bound-and-true-p write-region-verbose)) "") + ((= nchars 1) " (1 character)") + (t (format " (%d characters)" nchars))))))) + (defun tramp-handle-directory-file-name (directory) "Like `directory-file-name' for Tramp files." ;; 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 @@ (require 'dired) (require 'ert) +(require 'ert-x) (require 'tramp) (require 'vc) (require 'vc-bzr) @@ -80,6 +81,9 @@ (when (getenv "NIX_STORE") (add-to-list 'tramp-remote-path 'tramp-own-remote-path)) +(defvar tramp--test-messages nil + "Captured messages from *Messages* buffer.") + (defvar tramp--test-expensive-test (null (string-equal (getenv "SELECTOR") "(quote (not (tag :expensive-test)))")) @@ -1741,31 +1745,77 @@ This checks also `file-name-as-directory', `file-name-directory', (skip-unless (tramp--test-enabled)) (dolist (quoted (if tramp--test-expensive-test '(nil t) '(nil))) - (let ((tmp-name (tramp--test-make-temp-name nil quoted))) + (let* ((tmp-name (tramp--test-make-temp-name nil quoted)) + (text-quoting-style 'grave) + (write-region-verbose + (and (null noninteractive) (boundp 'write-region-verbose))) + (tramp-message-show-message + (or tramp-message-show-message write-region-verbose))) (unwind-protect - (progn + (ert-with-message-capture tramp--test-messages + ;; Write buffer. + (setq tramp--test-messages "") (with-temp-buffer (insert "foo") (write-region nil nil tmp-name)) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Append. + (setq tramp--test-messages "") (with-temp-buffer (insert "bla") (write-region nil nil tmp-name 'append)) + (when write-region-verbose + (should + (string-match + (format "Added to `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foobla"))) + + (setq tramp--test-messages "") + (with-temp-buffer + (insert "baz") + (write-region nil nil tmp-name 3)) + (when write-region-verbose + (should + (string-match + (format "Updated `%s' (3 characters)" tmp-name) + tramp--test-messages))) + (with-temp-buffer + (insert-file-contents tmp-name) + (should (string-equal (buffer-string) "foobaz"))) + ;; Write string. + (setq tramp--test-messages "") (write-region "foo" nil tmp-name) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (3 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "foo"))) + ;; Write partly. + (setq tramp--test-messages "") (with-temp-buffer (insert "123456789") (write-region 3 5 tmp-name)) + (when write-region-verbose + (should + (string-match + (format "Wrote `%s' (2 characters)" tmp-name) + tramp--test-messages))) (with-temp-buffer (insert-file-contents tmp-name) (should (string-equal (buffer-string) "34"))))