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

[Dmitry Gutov <dgutov@yandex.ru>]

[-- Attachment #1: Type: text/plain, Size: 3614 bytes --]

On 26/11/22 16:27, Eli Zaretskii wrote:
>> Date: Sat, 26 Nov 2022 15:22:36 +0200
>> Cc: philipk@posteo.net, rudi@constantly.at, eric@ericabrahamsen.net,
>>   cjpeople2013@gmail.com, theo@thornhill.no, mardani29@yahoo.es,
>>   salutis@me.com, joaotavora@gmail.com, manuel.uberti@inventati.org,
>>   juri@linkov.net, arstoffel@gmail.com, 41572@debbugs.gnu.org
>> From: Dmitry Gutov <dgutov@yandex.ru>
>>
>> On 26/11/22 09:47, Eli Zaretskii wrote:
>>
>>>> +(defcustom project-vc-extra-root-markers nil
>>>> +  "List of additional \"markers\" to signal project roots.
>>>> +
>>>> +A marker is either a base file name or a glob pattern for such.
>>>> +
>>>> +These will be used in addition to regular directory markers such
>>>> +as .git, .hg, and so on, dependent on the value of
>>>> +`vc-handled-backends'.
>>>
>>> "These will be used" how?  This crucial information is sorely missing from
>>> this description.  Likewise, how "markers" that are not files are used and
>>> are useful?
>>
>> Not files, meaning, markers which are globs with wildcards?
>>
>>>>                           They are most useful when a VC project
>>>> +has subdirectories inside it that need to be considered as
>>>> +separate projects, but still use the parent's ignore rules and
>>>> +general behaviors.
>>>
>>> How are "markers" useful in this scenario?
>>
>> As mentioned in e.g.
>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=54228#11, monorepos often
>> contain subdirectories which one might want to handle separately.
>>
>> Those subdirectories often come in standard structures, e.g. a frontend
>> subdirectory might contain a file called "package.json", a backend
>> subdirectory might contain "Gemfile" or "build.gradle", or perhaps
>> "autogen.sh", and so on.
>>
>> Adding those to the markers list will tag those subdirectories as
>> projects on their own. People can also use the file names special to
>> their particular organization instead of those above.
>>
>>>> +It can also be used for projects outside of VC repositories.
>>>> +Their behavior will still obey the relevant variables, such as
>>>> +`project-vc-ignores' or `project-vc-name'."
>>>
>>> And in this one?
>>
>> This covers the use cases described in the first messages of this and
>> the merged bug report:
>>
>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=41572#5
>> https://debbugs.gnu.org/cgi/bugreport.cgi?bug=54228#5
>>
>> People would add ".project" or ".emacs-project" to
>> project-vc-extra-root-markers and see things work.
>>
>> Might have to restart Emacs, though, if they already called project
>> commands in the given directory, because the current project info is cached.
>>
>>> IOW, please describe the main ideas of this approach instead of relying on
>>> use immediately gleaning that from a patch with incomplete documentation.
>>
>> If you have further questions, please ask.
> 
> Thanks, but I meant for at least some of the above to be in the doc strings
> and/or explained here in plain English.  Readers aren't supposed to search
> bug reports for relevant information.  (And for me personally, this means I
> won't be able to look up the relevant information before at least another
> week or two, which is a pity.)

The links were meant to illustrate that most people Cc'd probably 
understand the context already (modulo some forgetting because time has 
passed).

And either way I'm probably too close to the problem to understand 
easily what is clear to the average user and what is not. That's why 
questions are always useful.

I've added the examples to the docstring and rephrased it a little. Does 
it read better now?

[-- Attachment #2: project-vc-extra-root-markers-v2.diff --]
[-- Type: text/x-patch, Size: 5269 bytes --]

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 5b8648031fb..b4d5b4b0c9e 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -66,6 +66,9 @@
 ;; files, but supports additions to the list using the user option
 ;; `project-vc-ignores' (usually through .dir-locals.el).
 ;;
+;; At this point the name might as well be an abbreviation for "VC and
+;; Etc", see the variable `project-vc-extra-root-markers'.
+;;
 ;; Utils:
 ;;
 ;; `project-combine-directories' and `project-subtract-directories',
@@ -411,6 +414,29 @@ project-vc-name
   :version "29.1"
   :safe #'stringp)
 
+;; Not using regexps because these wouldn't work in Git pathspecs, in
+;; case we decide we need to be able to list subprojects.
+(defcustom project-vc-extra-root-markers nil
+  "List of additional markers to signal project roots.
+
+A marker is either a base file name or a glob pattern for such.
+
+Example values: \".dir-locals.el\", \"package.json\", \"pom.xml\",
+\"requirements.txt\", \"Gemfile\", \"*.gemspec\", \"autogen.sh\".
+
+These will be used in addition to regular directory markers such
+as .git, .hg, and so on, dependent on the value of
+`vc-handled-backends'.  They are most useful when a VC project
+has subdirectories inside it that need to be considered as
+separate projects.  It can also be used for projects outside of
+VC repositories.
+
+Either way, their behavior will still obey the relevant
+variables, such as `project-vc-ignores' or `project-vc-name'."
+  :type 'list
+  :version "29.1"
+  :safe (lambda (val) (and (listp val) (cl-every #'stringp val))))
+
 ;; FIXME: Using the current approach, major modes are supposed to set
 ;; this variable to a buffer-local value.  So we don't have access to
 ;; the "external roots" of language A from buffers of language B, which
@@ -447,28 +473,50 @@ project-vc-external-roots-function
 backend implementation of `project-external-roots'.")
 
 (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.
@@ -626,7 +674,8 @@ project-ignores
   (let* ((root (nth 2 project))
          backend)
     (append
-     (when (file-equal-p dir root)
+     (when (and backend
+                (file-equal-p dir root))
        (setq backend (cadr project))
        (delq
         nil