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: 1657 bytes --]

On 26/9/21 03:22, Dmitry Gutov wrote:
> Another issue is people working on monorepos (often backed by Git) 
> sometimes want to split them into separate projects. The latter 
> capability (excluding subproject's files) informed the choice of the 
> approach. Which is altering the vc project backend's behavior, rather 
> that offering this feature through another backend, like the one added 
> in the previous patch, for example.
> 
> I don't know if all users of this feature will want them excluded, 
> though. The attached implementation does, and maybe another option could 
> be added to disable this.
> 
> Or we could drop this part of the behavior, insisting that users who 
> want it could add the corresponding entries to project-vc-ignores. This 
> way they would be listing the subprojects twice, however. And the 
> project-vc-merge-submodules=nil behavior matches the other option 
> (submodule files are excluded from the parent).

Here's a third approach, which now seems to me the most approachable.

It solves the semantic problems by having the new "plain" projects also 
belong to the same type (which is still called project-vc, but means 
something more now). The backend's variables are adhered to, and 'git 
ls-files' is used for file listing in Git-backend subprojects still.

The subprojects' files are not excluded from the parent project, but as 
long as the format of markers stays with wildcards, it at least remains 
feasible to do, though with some extra expense at runtime. We'll see if 
people really want this.

It will probably also improve performance over Tramp compared to the 
current.

Does this work for everybody?

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

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 71061e6139d..19424a7343d 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,27 @@ 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.
+
+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, but still use the parent's ignore rules and
+general behaviors.
+
+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'."
+  :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 +471,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 +672,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