bug#41572: 28.0.50; [PATCH] Support plain project marked with file .emacs-project

[Eli Zaretskii]

> Date: Wed, 30 Nov 2022 20:52:32 +0200
> Cc: philipk@posteo.net, rudi@constantly.at, eric@ericabrahamsen.net,
>  cjpeople2013@gmail.com, theo@thornhill.no, mardani29@yahoo.es,
>  joaotavora@gmail.com, manuel.uberti@inventati.org, juri@linkov.net,
>  salutis@me.com, arstoffel@gmail.com, 41572@debbugs.gnu.org
> From: Dmitry Gutov <dgutov@yandex.ru>
> 
> >> Eli, what do you think about this feature
> >> (project-vc-extra-root-markers) for emacs-29?
> > Where can I see the code that you are proposing?
> 
> Here you go, I also added some documentation updates and 2 tests.

Thanks.  But I don't see any tests...

> +;; If the repository is using any other VCS than Git or Hg, the file
> +;; listing uses the default mechanism based on 'find'.

Instead of a literal 'find', this should probably say something like

  If the repository is using any other VCS than Git or Hg, the file
  listing uses the default mechanism based on the program specified by
  `find-program'.

>  (defun project-try-vc (dir)
> +  (defvar vc-svn-admin-directory)
> +  (require 'vc-svn)
> +  ;; 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 (ignore-errors (vc-responsible-backend dir)))
> +      (let* ((backend-markers-alist `((Git . ".git")
> +                                      (Hg . ".hg")
> +                                      (Bzr . ".bzr")
> +                                      (SVN . ,vc-svn-admin-directory)
> +                                      (DARCS . "_darcs")
> +                                      (Fossil . ".fslckout")))
> +             (backend-markers
> +              (delete
> +               nil
> +               (mapcar
> +                (lambda (b) (assoc-default b backend-markers-alist))
> +                vc-handled-backends)))
> +             (marker-re
> +              (mapconcat
> +               (lambda (m) (format "\\(%s\\)" (wildcard-to-regexp m)))
> +               (append backend-markers project-vc-extra-root-markers)
> +               "\\|"))
> +             (locate-dominating-stop-dir-regexp
> +              (or vc-ignore-dir-regexp locate-dominating-stop-dir-regexp))
> +             last-matches
>               (root
> -              (pcase backend
> -                ('Git
> -                 ;; Don't stop at submodule boundary.
> -                 (or (vc-file-getprop dir 'project-git-root)
> -                     (let ((root (vc-call-backend backend 'root dir)))
> -                       (vc-file-setprop
> -                        dir 'project-git-root
> -                        (if (and
> -                             ;; FIXME: Invalidate the cache when the value
> -                             ;; of this variable changes.
> -                             project-vc-merge-submodules
> -                             (project--submodule-p root))
> -                            (let* ((parent (file-name-directory
> -                                            (directory-file-name root))))
> -                              (vc-call-backend backend 'root parent))
> -                          root)))))
> -                ('nil nil)
> -                (_ (ignore-errors (vc-call-backend backend 'root dir)))))
> +              (locate-dominating-file
> +               dir
> +               (lambda (d)
> +                 (setq last-matches (directory-files d nil marker-re t 
> 100)))))
> +             (backend
> +              (cl-find-if
> +               (lambda (b)
> +                 (member (assoc-default b backend-markers-alist)
> +                         last-matches))
> +               vc-handled-backends))
>               project)
> +        (when (and
> +               (eq backend 'Git)
> +               project-vc-merge-submodules
> +               (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.

This is a significant change of the implementation of a public API.  Isn't
it risky to make such changes on the release branch?

But if you are okay with that, it's fine by me.