Function: tramp-sh-handle-vc-registered

tramp-sh-handle-vc-registered is a byte-compiled function defined in tramp-sh.el.gz.

Signature

(tramp-sh-handle-vc-registered FILE)

Documentation

Like vc-registered for Tramp files.

Source Code

;; Defined in /usr/src/emacs/lisp/net/tramp-sh.el.gz
;; VC backends check for the existence of various different special
;; files.  This is very time consuming, because every single check
;; requires a remote command (the file cache must be invalidated).
;; Therefore, we apply a kind of optimization.  We install the file
;; name handler `tramp-vc-file-name-handler', which does nothing but
;; remembers all file names for which `file-exists-p',
;; `file-readable-p' or `file-directory-p' has been applied.  A first
;; run of `vc-registered' is performed.  Afterwards, a script is
;; applied for all collected file names, using just one remote
;; command.  The result of this script is used to fill the file cache
;; with actual values.  Now we can reset the file name handlers, and
;; we make a second run of `vc-registered', which returns the expected
;; result without sending 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)
  "Like `vc-registered' for Tramp files."
  (when vc-handled-backends
    (let ((inhibit-message (or revert-buffer-in-progress-p inhibit-message))
	  (temp-message (unless revert-buffer-in-progress-p "")))
      (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 cannot reuse the old cache entries, therefore.  In
	    ;; `tramp-get-file-property', `remote-file-name-inhibit-cache'
	    ;; could also be a timestamp as `current-time' returns.  This
	    ;; means invalidate all cache entries with an older timestamp.
	    (let (tramp-vc-registered-file-names
                  (remote-file-name-inhibit-cache (current-time))
                  (file-name-handler-alist
                   `((,tramp-file-name-regexp . tramp-vc-file-name-handler))))

	      ;; Here we collect only file names, which need an operation.
	      (tramp-with-demoted-errors
                  v "Error in 1st pass of `vc-registered': %s"
		(tramp-run-real-handler #'vc-registered (list file)))
	      (tramp-message v 10 "\n%s" tramp-vc-registered-file-names)

	      ;; Send just one command, in order to fill the cache.
	      (tramp-bundle-read-file-names v tramp-vc-registered-file-names))

	    ;; Second run.  Now all `file-exists-p', `file-readable-p'
	    ;; or `file-directory-p' calls shall be answered from the
	    ;; file cache.  We unset `process-file-side-effects' and
	    ;; `remote-file-name-inhibit-cache' in order to keep the
	    ;; cache.
	    (let ((vc-handled-backends (copy-sequence vc-handled-backends))
                  remote-file-name-inhibit-cache process-file-side-effects)
	      ;; Reduce `vc-handled-backends' in order to minimize
	      ;; process calls.
	      (when (and
		     (memq 'Bzr vc-handled-backends)
		     (or (not (require 'vc-bzr nil 'noerror))
			 (not (with-tramp-connection-property v vc-bzr-program
				(tramp-find-executable
				 v vc-bzr-program (tramp-get-remote-path v))))))
		(setq vc-handled-backends (remq 'Bzr vc-handled-backends)))
	      (when (and
		     (memq 'Git vc-handled-backends)
		     (or (not (require 'vc-git nil 'noerror))
			 (not (with-tramp-connection-property v vc-git-program
				(tramp-find-executable
				 v vc-git-program (tramp-get-remote-path v))))))
		(setq vc-handled-backends (remq 'Git vc-handled-backends)))
	      (when (and
		     (memq 'Hg vc-handled-backends)
		     (or (not (require 'vc-hg nil 'noerror))
			 (not (with-tramp-connection-property v vc-hg-program
				(tramp-find-executable
				 v vc-hg-program (tramp-get-remote-path v))))))
		(setq vc-handled-backends (remq 'Hg vc-handled-backends)))
	      ;; Run.
	      (tramp-with-demoted-errors
                  v "Error in 2nd pass of `vc-registered': %s"
		(tramp-run-real-handler #'vc-registered (list file))))))))))