Turn project-roots into project-directories; add categoriesscratch/project-directories

4 files changed, 85 insertions, 90 deletions

diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 2a522bcccd8..b6bdc79080a 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1520,9 +1520,12 @@ It does not apply the value to buffers."
     (when project-dir
       (ede-directory-get-open-project project-dir 'ROOT))))
 
-(cl-defmethod project-roots ((project ede-project))
+(cl-defmethod project-directories ((project ede-project))
   (list (ede-project-root-directory project)))
 
+(cl-defmethod project-directory-categories ((_project ede-project) _dir)
+  '(primary))
+
 (add-hook 'project-find-functions #'project-try-ede)
 
 (provide 'ede)
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 12848fe02e0..3f536944f30 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -228,7 +228,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
 
 \\{emacs-lisp-mode-map}"
   :group 'lisp
-  (defvar project-library-roots-function)
+  (defvar project-vc-directories-function)
   (lisp-mode-variables nil nil 'elisp)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (setq-local electric-pair-text-pairs
@@ -238,7 +238,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   (add-function :before-until (local 'eldoc-documentation-function)
                 #'elisp-eldoc-documentation-function)
   (add-hook 'xref-backend-functions #'elisp--xref-backend nil t)
-  (setq-local project-library-roots-function #'elisp-library-roots)
+  (setq-local project-vc-directories-function #'elisp-library-roots)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -795,8 +795,6 @@ non-nil result supercedes the xrefs produced by
 
     xrefs))
 
-(declare-function project-library-roots "project")
-
 (cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp)
   (apply #'nconc
          (let (lst)
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 40d7e03baf4..5394e8afadd 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -38,35 +38,6 @@ Each functions on this hook is called in turn with one
 argument (the directory) and should return either nil to mean
 that it is not applicable, or a project instance.")
 
-;; 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 "library roots" of language A from buffers of language B, which
-;; seems desirable in multi-language projects, at least for some
-;; potential uses, like "jump to a file in project or library".
-;;
-;; We can add a second argument to this function: a file extension, or
-;; a language name.  Some projects will know the set of languages used
-;; in them; for others, like VC-based projects, we'll need
-;; auto-detection.  I see two options:
-;;
-;; - That could be implemented as a separate second hook, with a
-;;   list of functions that return file extensions.
-;;
-;; - This variable will be turned into a hook with "append" semantics,
-;;   and each function in it will perform auto-detection when passed
-;;   nil instead of an actual file extension.  Then this hook will, in
-;;   general, be modified globally, and not from major mode functions.
-(defvar project-library-roots-function 'etags-library-roots
-  "Function that returns a list of library roots.
-
-It should return a list of directories that contain source files
-related to the current buffer.  Depending on the language, it
-should include the headers search path, load path, class path,
-and so on.
-
-The directory names should be absolute.  Used in the default
-implementation of `project-library-roots'.")
-
 ;;;###autoload
 (defun project-current (&optional maybe-prompt dir)
   "Return the project instance in DIR or `default-directory'.
@@ -86,39 +57,39 @@ the user for a different directory to look in."
 (defun project--find-in-directory (dir)
   (run-hook-with-args-until-success 'project-find-functions dir))
 
-;; FIXME: Add MODE argument, like in `ede-source-paths'?
-(cl-defgeneric project-library-roots (project)
-  "Return the list of library roots for PROJECT.
+(cl-defgeneric project-directories (project)
+  "Return the list of directories related to the current project.
 
-It's the list of directories outside of the project that contain
-related source files.
+In the simplest case, it's just one directory, which contains the
+project file and everything else in the project.  In more
+advanced configurations, this list can include multiple project
+roots, as well as directories in specialized categories, such as
+`source-roots' and `test-roots', and .
 
-Project-specific version of `project-library-roots-function',
-which see.  Unless it knows better, a specialized implementation
-should use the value returned by that function."
-  (project-subtract-directories
-   (project-combine-directories
-    (funcall project-library-roots-function))
-   (project-roots project)))
+The directory names should be absolute.")
 
-(cl-defgeneric project-roots (project)
-  "Return the list of directory roots belonging to the current project.
+(cl-defgeneric project-directory-categories (project dir)
+  "Return the list of categories which DIR belongs to.
 
-Most often it's just one directory, which contains the project
-file and everything else in the project.  But in more advanced
-configurations, a project can span multiple directories.
+The standard categories are:
 
-The rule of thumb for whether to include a directory here, and not
-in `project-library-roots', is whether its contents are meant to
-be edited together with the rest of the project.
+`primary': It means that DIR is a part of PROJECT, as opposed to
+simply being in the headers search path, load path, class path, etc.
 
-The directory names should be absolute.")
+At least one of the `project-directories' elements must belong to
+this category.  When a projects has dependencies, the backend is
+allowed to designate some of them to be `primary' as well, if it
+knows that they are developed together with the main project.
+
+`sources': DIR contains files with source code.
+
+`tests': DIR contains test files.")
 
 (cl-defgeneric project-ignores (_project _dir)
   "Return the list of glob patterns to ignore inside DIR.
 Patterns can match both regular files and directories.
 To root an entry, start it with `./'.  To match directories only,
-end it with `/'.  DIR must be one of `project-roots' or
+end it with `/'.  DIR must be one of `project-directories' or
 `project-library-roots'."
   (require 'grep)
   (defvar grep-find-ignored-files)
@@ -133,36 +104,58 @@ end it with `/'.  DIR must be one of `project-roots' or
   "Project implementation using the VC package."
   :group 'tools)
 
-(defcustom project-vc-library-roots nil
-  "List ot directories to include in `project-library-roots'.
-The file names can be absolute, or relative to the project root."
-  :type '(repeat file)
-  :safe 'listp)
-
 (defcustom project-vc-ignores nil
   "List ot patterns to include in `project-ignores'."
   :type '(repeat string)
   :safe 'listp)
 
+;; 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 "related directories" of language A from buffers of language B,
+;; which seems desirable in multi-language projects, at least for some
+;; potential uses, like "jump to a file in any related directory".
+;;
+;; We can add a second argument to this function: a file extension, or
+;; a language name.  Some projects will know the set of languages used
+;; in them; for others, like VC-based projects, we'll need
+;; auto-detection.  I see two options:
+;;
+;; - That could be implemented as a separate second hook, with a
+;;   list of functions that return file extensions.
+;;
+;; - This variable will be turned into a hook with "append" semantics,
+;;   and each function in it will perform auto-detection when passed
+;;   nil instead of an actual file extension.  Then this hook will, in
+;;   general, be modified globally, and not from major mode functions.
+(defvar project-vc-directories-function 'etags-library-roots
+  "Function that returns a list of library roots.
+
+It should return a list of directories that contain source files
+related to the current buffer.  Depending on the language, it
+should include the headers search path, load path, class path,
+and so on.
+
+The directory names should be absolute.  Used in the default
+implementation of `project-library-roots'.")
+
 (defun project-try-vc (dir)
   (let* ((backend (ignore-errors (vc-responsible-backend dir)))
          (root (and backend (ignore-errors
                               (vc-call-backend backend 'root dir)))))
     (and root (cons 'vc root))))
 
-(cl-defmethod project-roots ((project (head vc)))
-  (list (cdr project)))
+(cl-defmethod project-directories ((project (head vc)))
+  (let ((root (cdr project)))
+    (cons
+     (cdr project)
+     (funcall
+      (project--value-in-dir 'project-vc-directories-function root)))))
 
-(cl-defmethod project-library-roots ((project (head vc)))
-  (project-subtract-directories
-   (project-combine-directories
-    (append
-     (let ((root (cdr project)))
-       (mapcar
-        (lambda (dir) (file-name-as-directory (expand-file-name dir root)))
-        (project--value-in-dir 'project-vc-library-roots root)))
-     (funcall project-library-roots-function)))
-   (project-roots project)))
+(cl-defmethod project-directory-categories ((project (head vc)) dir)
+  (let ((root (cdr project)))
+    (if (file-in-directory-p dir root)
+        '(primary)
+      '())))
 
 (cl-defmethod project-ignores ((project (head vc)) dir)
   (let* ((root (cdr project))
@@ -179,16 +172,22 @@ The file names can be absolute, or relative to the project root."
      (project--value-in-dir 'project-vc-ignores root)
      (cl-call-next-method))))
 
-(defun project-combine-directories (&rest lists-of-dirs)
-  "Return a sorted and culled list of directory names.
-Appends the elements of LISTS-OF-DIRS together, removes
-non-existing directories, as well as directories a parent of
-whose is already in the list."
+(defun project-directories-in-categories (project &rest categories)
+  (project-combine-directories
+   (cl-delete-if
+    (lambda (dir)
+      (cl-set-difference categories (project-directory-categories project dir)))
+    (project-directories project))))
+
+(defun project-combine-directories (dirs)
+  "Return a sorted and culled list of directory names in PROJECT.
+It takes DIRS, removes non-existing directories, as well as
+directories a parent of whose is already in the list."
   (let* ((dirs (sort
                 (mapcar
                  (lambda (dir)
                    (file-name-as-directory (expand-file-name dir)))
-                 (apply #'append lists-of-dirs))
+                 dirs)
                 #'string<))
          (ref dirs))
     ;; Delete subdirectories from the list.
@@ -225,19 +224,17 @@ to search in, and the file name pattern to search for."
          (dirs (if current-prefix-arg
                    (list (read-directory-name "Base directory: "
                                               nil default-directory t))
-                 (project-roots pr))))
+                 (project-directories-in-categories pr 'primary))))
     (project--find-regexp-in dirs regexp pr)))
 
 ;;;###autoload
-(defun project-or-libraries-find-regexp (regexp)
-  "Find all matches for REGEXP in the current project or libraries.
+(defun project-and-related-find-regexp (regexp)
+  "Find all matches for REGEXP in the current project or related directories.
 With \\[universal-argument] prefix, you can specify the file name
 pattern to search for."
   (interactive (list (project--read-regexp)))
   (let* ((pr (project-current t))
-         (dirs (append
-                (project-roots pr)
-                (project-library-roots pr))))
+         (dirs (project-directories-in-categories pr)))
     (project--find-regexp-in dirs regexp pr)))
 
 (defun project--read-regexp ()
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 397f379d434..b86074f99c0 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -243,10 +243,7 @@ find a search tool; by default, this uses \"find | grep\" in the
   (cl-mapcan
    (lambda (dir)
      (xref-collect-references identifier dir))
-   (let ((pr (project-current t)))
-     (append
-      (project-roots pr)
-      (project-library-roots pr)))))
+   (project-directories-in-categories (project-current t))))
 
 (cl-defgeneric xref-backend-apropos (backend pattern)
   "Find all symbols that match PATTERN.