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

[Dmitry Gutov <dgutov@yandex.ru>]

On 30/11/2022 22:32, Eli Zaretskii wrote:
>> 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...

Sorry, missed them in this patch. They don't really need an advance 
review, though, so just see them later.

>> +;; 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'.

Sure, thanks.

>>   (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.

A little bit, yeah. But I've done some dogfooding, and we have a couple 
of months before the release, right?