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

On 26/11/22 21:23, João Távora wrote:
> On Sat, Nov 26, 2022, 12:30 Dmitry Gutov <dgutov@yandex.ru 
> <mailto:dgutov@yandex.ru>> wrote:
> 
> 
>      > My use case is the following: I'm interested in being able to
>     designate
>      > projects (through various means, not only marker files) that may only
>      > exist inside other projects.
> 
>     You previously described your super-project and how you handled it
>     using
>     project-find-functions hook with a new element that looked for file
>     markers. Does this patch make that easier to do? Without writing custom
>     functions?
> 
> 
> The example i gave did _not_ use file markers. Personally, I can't use 
> them. I need some elisp way.

Please elaborate. Does it mean that those subprojects are chosen 
manually and don't have "packages.jon" or etc exactly (or that too many 
subprojects in that same project would, undesirably, contain the same 
files)?

Would being able to set to absolute file names (directories) help? Or is 
that too awkward? Worst case, we could also add the new option from 
https://debbugs.gnu.org/cgi/bugreport.cgi?bug=41572#85, the result see 
attached.

>      > I then want the C-x p family of commands
>      > to allow a choice of inner project or any of the associated
>      > super-projects.
> 
>     Please avoid mixing feature requests. I already said that "choice of
>     inner or outer" is out of scope for this, but it's easily
>     implemented on
>     top.
> 
> 
> What good are sub and super projects without a way to take advantage of 
> them? If anything we should focus on the operations first.

As I have demonstrated, the features are orthogonal.

Let's do it piece by piece, otherwise this bug might stay open another 
couple of years.

> I have not seen your other patch. I take it it must have had some 
> drawback since you superseded it with something else. But post the link, 
> this thread is too long. I'll look at it on Monday if I have time.

That would be https://debbugs.gnu.org/cgi/bugreport.cgi?bug=41572#85

The downsides we have already discussed: having to customize every 
"super" project individually is a pain, people more often seem to prefer 
to use "markers", the set of which is customized once.

So we have to support "markers" anyway, hence it makes sense to try to 
make do with them only. But here's how it would look if we try to 
support both approaches.

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

diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 5b8648031fb..05ba631e52f 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,51 @@ 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.
+
+A directory containing such a marker file or a file matching a
+marker pattern will be recognized as the root of a VC project.
+
+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, depending on the value of
+`vc-handled-backends'.  It is 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.
+
+In either case, 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))))
+
+(defcustom project-vc-subprojects nil
+  "List of relative directory names to consider separate projects.
+Each entry should a string, name of a subproject root directory
+relative to the VC project root.
+
+Whenever a VC project root detected according to the usual
+conditions contains a subdirectory from that list, that
+subdirectory will be recognized as the root of a separate VC
+project as well.
+
+One would usually set this variable through the dir-locals
+mechanism.
+
+If subprojects are Git submodules, you can use the variable
+`project-vc-merge-submodules' instead."
+  :type 'list
+  :version "29.1"
+  :safe (lambda (val) (and (listp val) (seq-every-p #'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,29 +495,59 @@ 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
+          (let* ((relative-dir (file-relative-name dir root))
+                 (subproject (seq-find
+                              (lambda (sub-dir)
+                                (string-prefix-p (file-name-as-directory sub-dir)
+                                                 relative-dir))
+                              project-vc-subprojects)))
+            (and subproject
+                 (setq root (concat root subproject))))
           (setq project (list 'vc backend root))
           ;; FIXME: Cache for a shorter time.
           (vc-file-setprop dir 'project-vc project)
@@ -626,7 +704,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