[Emacs-diffs] scratch/project 4abd553: Rename project-source-directories to project-search-path

[Dmitry Gutov]

branch: scratch/project
commit 4abd553fac14e606152000369364c37c4929d7ba
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Rename project-source-directories to project-search-path
    
    * Introduce project-search-path-function, default etags-search-path.
    
    * Move --prune-directories from xref to project.
---
 lisp/emacs-lisp/cl-generic.el |    1 -
 lisp/progmodes/elisp-mode.el  |   20 ++++++---------
 lisp/progmodes/etags.el       |   14 +++++++----
 lisp/progmodes/project.el     |   52 +++++++++++++++++++++++++++++++++++-----
 lisp/progmodes/xref.el        |   24 +-----------------
 5 files changed, 64 insertions(+), 47 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 33953f7..5923e4d 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -936,7 +936,6 @@ Can only be used from within the lexical body of a primary 
or around method."
 
 (cl--generic-prefill-dispatchers 0 (eql nil))
 (cl--generic-prefill-dispatchers window-system (eql nil))
-(cl--generic-prefill-dispatchers major-mode (eql emacs-lisp-mode))
 
 ;;; Support for cl-defstructs specializers.
 
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 4824798..aa02b04 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -229,6 +229,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   :group 'lisp
   (defvar xref-find-function)
   (defvar xref-identifier-completion-table-function)
+  (defvar project-search-path-function)
   (lisp-mode-variables nil nil 'elisp)
   (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers)
   (setq-local electric-pair-text-pairs
@@ -240,6 +241,7 @@ Blank lines separate paragraphs.  Semicolons start comments.
   (setq-local xref-find-function #'elisp-xref-find)
   (setq-local xref-identifier-completion-table-function
               #'elisp--xref-identifier-completion-table)
+  (setq-local project-search-path-function #'elisp-search-path)
   (add-hook 'completion-at-point-functions
             #'elisp-completion-at-point nil 'local))
 
@@ -584,7 +586,6 @@ It can be quoted, or be inside a quoted form."
 (declare-function xref-make "xref" (description location))
 (declare-function xref-collect-matches "xref" (symbol dir))
 (declare-function xref-collect-references "xref" (symbol dir))
-(declare-function xref--prune-directories "xref" (dirs))
 
 (defun elisp-xref-find (action id)
   (require 'find-func)
@@ -653,17 +654,14 @@ It can be quoted, or be inside a quoted form."
              lst))))
       lst)))
 
-(declare-function project-source-directories "project")
+(declare-function project-search-path "project")
 (declare-function project-current "project")
 
 (defun elisp--xref-find-references (symbol)
-  (require 'project)
-  (let ((dirs (xref--prune-directories (project-source-directories
-                                        (project-current)))))
-    (cl-mapcan
-     (lambda (dir)
-       (xref-collect-references symbol dir))
-     dirs)))
+  (cl-mapcan
+   (lambda (dir)
+     (xref-collect-references symbol dir))
+   (project-search-path (project-current))))
 
 (defun elisp--xref-find-apropos (regexp)
   (apply #'nconc
@@ -706,9 +704,7 @@ It can be quoted, or be inside a quoted form."
 (cl-defmethod xref-location-group ((l xref-elisp-location))
   (xref-elisp-location-file l))
 
-(cl-defmethod project-source-directories (_backend
-                                          &context
-                                          (major-mode (eql emacs-lisp-mode)))
+(defun elisp-search-path ()
   (defvar package-user-dir)
   (cons package-user-dir load-path))
 
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index bffc98a..f5745a9 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2090,11 +2090,12 @@ for \\[find-tag] (which see)."
     (`references  (etags--xref-find-references id))
     (`apropos (etags--xref-find-definitions id t))))
 
-(defun etags--xref-find-references (input)
-  (let ((dirs (if tags-table-list
-                  (mapcar #'file-name-directory tags-table-list)
-                (project-source-directories (project-current)))))
-    (cl-mapcan (lambda (dir) (xref-collect-references input dir)) dirs)))
+(defun etags--xref-find-references (symbol)
+  ;; TODO: Merge together with the Elisp impl.
+  (cl-mapcan
+   (lambda (dir)
+     (xref-collect-references symbol dir))
+   (project-search-path (project-current))))
 
 (defun etags--xref-find-definitions (pattern &optional regexp?)
   ;; This emulates the behaviour of `find-tag-in-order' but instead of
@@ -2150,6 +2151,9 @@ for \\[find-tag] (which see)."
   (with-slots (tag-info) l
     (nth 1 tag-info)))
 
+(defun etags-search-path ()
+  (mapcar #'file-name-directory tags-table-list))
+
 
 (provide 'etags)
 
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
index 26b5e0c..eaa2f9a 100644
--- a/lisp/progmodes/project.el
+++ b/lisp/progmodes/project.el
@@ -21,7 +21,7 @@
 
 ;; This file contains generic infrastructure for dealing with
 ;; projects, and a number of public functions: finding the current
-;; root, source directories, related directories, etc.
+;; root, related project directories, search path, etc.
 
 ;;; Code:
 
@@ -34,6 +34,20 @@ 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.")
 
+(declare-function etags-search-path "etags" ())
+
+(defvar project-search-path-function #'etags-search-path
+  "Function that returns a list of source directories.
+
+The directories in which we can look for the declarations or
+other references to the symbols used in the current buffer.
+Depending on the language, it should include the headers search
+path, load path, class path, or so on.
+
+The directory names should be absolute.  Normally set by the
+major mode.  Used in the default implementation of
+`project-search-path'.")
+
 ;;;###autoload
 (defun project-current (&optional dir)
   "Return the project instance in DIR or `default-directory'."
@@ -44,18 +58,26 @@ that it is not applicable, or a project instance.")
   "Return the root directory of the current project.
 The directory name should be absolute.")
 
-(cl-defgeneric project-source-directories (project)
+(cl-defgeneric project-search-path (project)
   "Return the list of source directories.
 Including any where source (or header, etc) files used by the
 current project may be found.  Including those outside of the
-project tree.  The directory names should be absolute."
-  (project-directories project))
+project tree.  The directory names should be absolute.
+
+A specialized implementation should use the value
+`project-search-path-function', or, better yet, call and combine
+the results from the functions that this value is set to by all
+major modes used in the project.  Alternatively, it can return a
+user-configurable value."
+  (project--prune-directories
+   (nconc (funcall project-search-path-function)
+          (project-directories project))))
 
 (cl-defgeneric project-directories (project)
   "Return the list of directories related to the current project.
-It should include the current project root, then possibly the
-roots of any currently open related projects (if they're meant to
-be edited together).  The directory names should be absolute."
+It should include the current project root, as well as the roots
+of any currently open related projects, if they're meant to be
+edited together.  The directory names should be absolute."
   (list (project-root project)))
 
 (defun project-try-vc (dir)
@@ -73,5 +95,21 @@ be edited together).  The directory names should be 
absolute."
 (cl-defmethod project-root ((project (head user)))
   (cdr project))
 
+(defun project--prune-directories (dirs)
+  "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
+  (let* ((dirs (sort
+                (mapcar
+                 (lambda (dir)
+                   (file-name-as-directory (expand-file-name dir)))
+                 dirs)
+                #'string<))
+         (ref dirs))
+    ;; Delete subdirectories from the list.
+    (while (cdr ref)
+      (if (string-prefix-p (car ref) (cadr ref))
+          (setcdr ref (cddr ref))
+        (setq ref (cdr ref))))
+    (cl-delete-if-not #'file-exists-p dirs)))
+
 (provide 'project)
 ;;; project.el ends here
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 1a9943f..f2f02a4 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -54,6 +54,7 @@
 (require 'eieio)
 (require 'ring)
 (require 'pcase)
+(require 'project)
 
 (defgroup xref nil "Cross-referencing commands"
   :group 'tools)
@@ -665,11 +666,7 @@ to search in."
   (interactive (list (xref--read-identifier "Find regexp: ")))
   (let* ((dirs (if current-prefix-arg
                    (list (read-directory-name "In directory: "))
-                 (let ((proj (project-current)))
-                   (xref--prune-directories
-                    (nconc
-                     (project-directories proj)
-                     (project-source-directories proj))))))
+                 (project-search-path (project-current))))
          (xref-find-function
           (lambda (_kind regexp)
             (cl-mapcan
@@ -817,23 +814,6 @@ tools are used, and when."
                      (xref-make-file-location file line
                                               (current-column))))))))
 
-(defun xref--prune-directories (dirs)
-  "Returns a copy of DIRS sorted, without subdirectories or non-existing ones."
-  (let* ((dirs (sort
-                (mapcar
-                 (lambda (dir)
-                   (file-name-as-directory (expand-file-name dir)))
-                 dirs)
-                #'string<))
-         (ref dirs))
-    ;; Delete subdirectories from the list.
-    (while (cdr ref)
-      (if (string-prefix-p (car ref) (cadr ref))
-          (setcdr ref (cddr ref))
-        (setq ref (cdr ref))))
-    (cl-delete-if-not #'file-exists-p dirs)))
-
-
 (provide 'xref)
 
 ;;; xref.el ends here