procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Handle `write-region' messages in Tramp properly

Browse source 
* 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.
This commit is contained in:
Michael Albinus 2017-05-08 17:27:50 +02:00
parent 52f7440b8e
commit 73e3ed48e2
8 changed files with 89 additions and 29 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
lisp/net/tramp-adb.el
View file

@ -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

8
lisp/net/tramp-cmds.el
View file

@ -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))

5
lisp/net/tramp-compat.el
View file

@ -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

9
lisp/net/tramp-gvfs.el
View file

@ -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)))

6
lisp/net/tramp-sh.el
View file

@ -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

6
lisp/net/tramp-smb.el
View file

@ -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'.

28
lisp/net/tramp.el
View file

@ -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.

54
test/lisp/net/tramp-tests.el
View file

@ -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"))))