Function: vc-hg-known-other-working-trees

vc-hg-known-other-working-trees is a byte-compiled function defined in vc-hg.el.gz.

Signature

(vc-hg-known-other-working-trees)

Documentation

Implementation of known-other-working-trees backend function for Hg.

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-hg.el.gz
(defun vc-hg-known-other-working-trees ()
  "Implementation of `known-other-working-trees' backend function for Hg."
  ;; Mercurial doesn't maintain records of shared repositories.
  ;; The first repository knows nothing about shares created from it,
  ;; and each share only has a reference back to the first repository.
  ;;
  ;; Therefore, to support the VC API for other working trees, Emacs
  ;; needs to maintain records of its own about other working trees.
  ;; Rather than create something new our strategy is to rely on
  ;; project.el's knowledge of existing projects.
  ;; Note that this relies on code calling `vc-hg-add-working-tree'
  ;; registering the resultant working tree with project.el.
  (let* ((our-root (vc-hg-root default-directory))
         (our-sp (expand-file-name ".hg/sharedpath" our-root))
         our-store shares)
    (if (file-exists-p our-sp)
        (with-temp-buffer
          (insert-file-contents-literally our-sp)
          ;; On MS-Windows, ".hg/sharedpath" gives file names with
          ;; backslashes; expand-file-name normalizes that to forward
          ;; slashes, needed for 'equal' comparison below.
          (setq our-store (expand-file-name (string-trim (buffer-string))))
          (push (abbreviate-file-name (file-name-directory our-store))
                shares))
      (setq our-store (expand-file-name ".hg" our-root)))
    (dolist (root (project-known-project-roots))
      (when-let* (((not (equal root our-root)))
                  (sp (expand-file-name ".hg/sharedpath" root))
                  ((file-exists-p sp)))
        (with-temp-buffer
          (insert-file-contents-literally sp)
          (when (equal our-store
                       ;; See above why we use expand-file-name
                       (expand-file-name (string-trim (buffer-string))))
            (push root shares)))))
    shares))