Function: project-try-vc

project-try-vc is a byte-compiled function defined in project.el.gz.

Signature

(project-try-vc DIR)

Source Code

;; Defined in /usr/src/emacs/lisp/progmodes/project.el.gz
(defun project-try-vc (dir)
  ;; FIXME: Learn to invalidate when the value of
  ;; `project-vc-merge-submodules' or `project-vc-extra-root-markers'
  ;; changes.
  (or (vc-file-getprop dir 'project-vc)
      (let* ((backend-markers
              (delete
               nil
               (mapcar
                (lambda (b) (assoc-default b project-vc-backend-markers-alist))
                vc-handled-backends)))
             (marker-re
              (concat
               "\\`"
               (mapconcat
                (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m)))
                (append backend-markers
                        (project--value-in-dir 'project-vc-extra-root-markers dir))
                "\\|")
               "\\'"))
             (locate-dominating-stop-dir-regexp
              (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp))
             last-matches
             (root
              (locate-dominating-file
               dir
               (lambda (d)
                 ;; Maybe limit count to 100 when we can drop Emacs < 28.
                 (setq last-matches
                       (condition-case nil
                           (directory-files d nil marker-re t)
                         (file-missing nil))))))
             (backend
              (cl-find-if
               (lambda (b)
                 (member (assoc-default b project-vc-backend-markers-alist)
                         last-matches))
               vc-handled-backends))
             project)
        (when (and
               (eq backend 'Git)
               (project--vc-merge-submodules-p root)
               (project--submodule-p root))
          (let* ((parent (file-name-directory (directory-file-name root))))
            (setq root (vc-call-backend 'Git 'root parent))))
        (when root
          (setq project (list 'vc backend root))
          ;; FIXME: Cache for a shorter time.
          (vc-file-setprop dir 'project-vc project)
          project))))