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' or
;; `file-readable-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.
	      (when tramp-vc-registered-file-names
		(tramp-maybe-send-script
		 v
		 (format tramp-vc-registered-read-file-names
			 (tramp-get-file-exists-command v)
			 (format "%s -r" (tramp-get-test-command v)))
		 "tramp_vc_registered_read_file_names")

		(dolist
		    (elt
		     (ignore-errors
		       ;; We cannot use `tramp-send-command-and-read',
		       ;; because this does not cooperate well with
		       ;; heredoc documents.
		       (tramp-send-command
			v
			(format
			 "tramp_vc_registered_read_file_names <<'%s'\n%s\n%s\n"
			 tramp-end-of-heredoc
			 (mapconcat #'tramp-shell-quote-argument
				    tramp-vc-registered-file-names
				    "\n")
			 tramp-end-of-heredoc))
		       (with-current-buffer (tramp-get-connection-buffer v)
			 ;; Read the expression.
			 (goto-char (point-min))
			 (read (current-buffer)))))

                  (tramp-set-file-property
                   v (car elt) (cadr elt) (cadr (cdr elt))))))

	    ;; Second run.  Now all `file-exists-p' or `file-readable-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))))))))))