mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

Don't spam the echo area and the *Messages* buffer in Tramp

Browse Source 
* lisp/net/tramp-sh.el (tramp-sh-handle-vc-registered):
When called during `revert-buffer', don't spam the echo area and
the *Messages* buffer.
This commit is contained in:
Michael Albinus 2019-12-11 16:05:12 +01:00
parent eb7df2a4e3
commit 8aaa92a4b6
1 changed files with 82 additions and 76 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

158
lisp/net/tramp-sh.el
View File

@ -3463,91 +3463,97 @@ the result will be a local, non-Tramp, file name."
;; can reset the file name handlers, and we make a second run of ;; can reset the file name handlers, and we make a second run of
;; `vc-registered', which returns the expected result without sending ;; `vc-registered', which returns the expected result without sending
;; any other remote command. ;; any other remote command.
;; When called during `revert-buffer', it shouldn't spam the echo area
;; and the *Messages* buffer.
(defun tramp-sh-handle-vc-registered (file) (defun tramp-sh-handle-vc-registered (file)
"Like `vc-registered' for Tramp files." "Like `vc-registered' for Tramp files."
(when vc-handled-backends (when vc-handled-backends
(with-temp-message "" (let ((tramp-message-show-message
(with-parsed-tramp-file-name file nil (and (not revert-buffer-in-progress-p) tramp-message-show-message))
(with-tramp-progress-reporter (temp-message (unless revert-buffer-in-progress-p "")))
v 3 (format-message "Checking `vc-registered' for %s" file) (with-temp-message temp-message
(with-parsed-tramp-file-name file nil
(with-tramp-progress-reporter
v 3 (format-message "Checking `vc-registered' for %s" file)
;; There could be new files, created by the vc backend. We ;; There could be new files, created by the vc backend.
;; cannot reuse the old cache entries, therefore. In ;; We cannot reuse the old cache entries, therefore. In
;; `tramp-get-file-property', `remote-file-name-inhibit-cache' ;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
;; could also be a timestamp as `current-time' returns. This ;; could also be a timestamp as `current-time' returns. This
;; means invalidate all cache entries with an older timestamp. ;; means invalidate all cache entries with an older timestamp.
(let (tramp-vc-registered-file-names (let (tramp-vc-registered-file-names
(remote-file-name-inhibit-cache (current-time)) (remote-file-name-inhibit-cache (current-time))
(file-name-handler-alist (file-name-handler-alist
`((,tramp-file-name-regexp . tramp-vc-file-name-handler)))) `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))
;; Here we collect only file names, which need an operation. ;; Here we collect only file names, which need an operation.
(tramp-with-demoted-errors (tramp-with-demoted-errors
v "Error in 1st pass of `vc-registered': %s" v "Error in 1st pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file))) (tramp-run-real-handler #'vc-registered (list file)))
(tramp-message v 10 "\n%s" tramp-vc-registered-file-names) (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)
;; Send just one command, in order to fill the cache. ;; Send just one command, in order to fill the cache.
(when tramp-vc-registered-file-names (when tramp-vc-registered-file-names
(tramp-maybe-send-script (tramp-maybe-send-script
v v
(format tramp-vc-registered-read-file-names (format tramp-vc-registered-read-file-names
(tramp-get-file-exists-command v) (tramp-get-file-exists-command v)
(format "%s -r" (tramp-get-test-command v))) (format "%s -r" (tramp-get-test-command v)))
"tramp_vc_registered_read_file_names") "tramp_vc_registered_read_file_names")
(dolist (dolist
(elt (elt
(ignore-errors (ignore-errors
;; We cannot use `tramp-send-command-and-read', ;; We cannot use `tramp-send-command-and-read',
;; because this does not cooperate well with ;; because this does not cooperate well with
;; heredoc documents. ;; heredoc documents.
(tramp-send-command (tramp-send-command
v v
(format (format
"tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n" "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
tramp-end-of-heredoc tramp-end-of-heredoc
(mapconcat #'tramp-shell-quote-argument (mapconcat #'tramp-shell-quote-argument
tramp-vc-registered-file-names tramp-vc-registered-file-names
"\n") "\n")
tramp-end-of-heredoc)) tramp-end-of-heredoc))
(with-current-buffer (tramp-get-connection-buffer v) (with-current-buffer (tramp-get-connection-buffer v)
;; Read the expression. ;; Read the expression.
(goto-char (point-min)) (goto-char (point-min))
(read (current-buffer))))) (read (current-buffer)))))
(tramp-set-file-property (tramp-set-file-property
v (car elt) (cadr elt) (cadr (cdr elt)))))) v (car elt) (cadr elt) (cadr (cdr elt))))))
;; Second run. Now all `file-exists-p' or `file-readable-p' ;; Second run. Now all `file-exists-p' or `file-readable-p'
;; calls shall be answered from the file cache. We unset ;; calls shall be answered from the file cache. We unset
;; `process-file-side-effects' and `remote-file-name-inhibit-cache' ;; `process-file-side-effects' and `remote-file-name-inhibit-cache'
;; in order to keep the cache. ;; in order to keep the cache.
(let ((vc-handled-backends vc-handled-backends) (let ((vc-handled-backends vc-handled-backends)
remote-file-name-inhibit-cache process-file-side-effects) remote-file-name-inhibit-cache process-file-side-effects)
;; Reduce `vc-handled-backends' in order to minimize process calls. ;; Reduce `vc-handled-backends' in order to minimize
(when (and (memq 'Bzr vc-handled-backends) ;; process calls.
(boundp 'vc-bzr-program) (when (and (memq 'Bzr vc-handled-backends)
(not (with-tramp-connection-property v vc-bzr-program (boundp 'vc-bzr-program)
(tramp-find-executable (not (with-tramp-connection-property v vc-bzr-program
v vc-bzr-program (tramp-get-remote-path v))))) (tramp-find-executable
(setq vc-handled-backends (remq 'Bzr vc-handled-backends))) v vc-bzr-program (tramp-get-remote-path v)))))
(when (and (memq 'Git vc-handled-backends) (setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
(boundp 'vc-git-program) (when (and (memq 'Git vc-handled-backends)
(not (with-tramp-connection-property v vc-git-program (boundp 'vc-git-program)
(tramp-find-executable (not (with-tramp-connection-property v vc-git-program
v vc-git-program (tramp-get-remote-path v))))) (tramp-find-executable
(setq vc-handled-backends (remq 'Git vc-handled-backends))) v vc-git-program (tramp-get-remote-path v)))))
(when (and (memq 'Hg vc-handled-backends) (setq vc-handled-backends (remq 'Git vc-handled-backends)))
(boundp 'vc-hg-program) (when (and (memq 'Hg vc-handled-backends)
(not (with-tramp-connection-property v vc-hg-program (boundp 'vc-hg-program)
(tramp-find-executable (not (with-tramp-connection-property v vc-hg-program
v vc-hg-program (tramp-get-remote-path v))))) (tramp-find-executable
(setq vc-handled-backends (remq 'Hg vc-handled-backends))) v vc-hg-program (tramp-get-remote-path v)))))
;; Run. (setq vc-handled-backends (remq 'Hg vc-handled-backends)))
(tramp-with-demoted-errors ;; Run.
v "Error in 2nd pass of `vc-registered': %s" (tramp-with-demoted-errors
(tramp-run-real-handler #'vc-registered (list file))))))))) v "Error in 2nd pass of `vc-registered': %s"
(tramp-run-real-handler #'vc-registered (list file))))))))))
;;;###tramp-autoload ;;;###tramp-autoload
(defun tramp-sh-file-name-handler (operation &rest args) (defun tramp-sh-file-name-handler (operation &rest args)