[Emacs-diffs] master f8c720b 1/2: Introduce a Project API

[Dmitry Gutov]

branch: master
commit f8c720b55b9419c849ea9febe6f888761a61949b
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Introduce a Project API
    
    * lisp/progmodes/project.el: New file.
    
    * lisp/cedet/ede.el: (project-try-ede): New function.
    (project-root): New implementation.
    
    * lisp/progmodes/elisp-mode.el (emacs-lisp-mode):
    Set project-search-path-function.
    (elisp--xref-find-references): Delegate some logic to
    project-search-path.
    (elisp-search-path): New function.
    (elisp-xref-find): Don't implement `matches' anymore.
    
    * lisp/progmodes/etags.el: Don't implement `matches'.
    Delegate some logic to project-search-path.
    (etags-search-path): New function.
    
    * lisp/progmodes/xref.el (xref-find-function):
    Remove `matches' from the API.
    (xref-find-regexp): Move whatever common logic was in elisp and
    etags implementations, and search the directories returned by
    project-directories and project-search-path.
---
 lisp/cedet/ede.el            |   16 ++++++
 lisp/progmodes/elisp-mode.el |   41 +++++---------
 lisp/progmodes/etags.el      |   20 ++++----
 lisp/progmodes/project.el    |  119 ++++++++++++++++++++++++++++++++++++++++++
 lisp/progmodes/xref.el       |   26 +++++++---
 5 files changed, 179 insertions(+), 43 deletions(-)

diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el
index 43660a8..9e92fc7 100644
--- a/lisp/cedet/ede.el
+++ b/lisp/cedet/ede.el
@@ -1517,6 +1517,22 @@ It does not apply the value to buffers."
   "Commit change to local variables in PROJ."
   nil)
 
+;;; Integration with project.el
+
+(defun project-try-ede (dir)
+  (let ((project-dir
+         (locate-dominating-file
+          dir
+          (lambda (dir)
+            (ede-directory-get-open-project dir 'ROOT)))))
+    (when project-dir
+      (ede-directory-get-open-project project-dir 'ROOT))))
+
+(cl-defmethod project-root ((project ede-project))
+  (ede-project-root-directory project))
+
+(add-hook 'project-find-functions #'project-try-ede)
+
 (provide 'ede)
 
 ;; Include this last because it depends on ede.
diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index 335a24b..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))
 
@@ -593,9 +595,7 @@ It can be quoted, or be inside a quoted form."
         (when sym
           (elisp--xref-find-definitions sym))))
     (`references
-     (elisp--xref-find-matches id #'xref-collect-references))
-    (`matches
-     (elisp--xref-find-matches id #'xref-collect-matches))
+     (elisp--xref-find-references id))
     (`apropos
      (elisp--xref-find-apropos id))))
 
@@ -654,29 +654,14 @@ It can be quoted, or be inside a quoted form."
              lst))))
       lst)))
 
-(defvar package-user-dir)
-
-(defun elisp--xref-find-matches (symbol fun)
-  (let* ((dirs (sort
-                (mapcar
-                 (lambda (dir)
-                   (file-name-as-directory (expand-file-name dir)))
-                 ;; It's one level above a number of `load-path'
-                 ;; elements (one for each installed package).
-                 ;; Save us some process calls.
-                 (cons package-user-dir load-path))
-                #'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-mapcan
-     (lambda (dir)
-       (and (file-exists-p dir)
-            (funcall fun symbol dir)))
-     dirs)))
+(declare-function project-search-path "project")
+(declare-function project-current "project")
+
+(defun elisp--xref-find-references (symbol)
+  (cl-mapcan
+   (lambda (dir)
+     (xref-collect-references symbol dir))
+   (project-search-path (project-current))))
 
 (defun elisp--xref-find-apropos (regexp)
   (apply #'nconc
@@ -719,6 +704,10 @@ It can be quoted, or be inside a quoted form."
 (cl-defmethod xref-location-group ((l xref-elisp-location))
   (xref-elisp-location-file l))
 
+(defun elisp-search-path ()
+  (defvar package-user-dir)
+  (cons package-user-dir load-path))
+
 ;;; Elisp Interaction mode
 
 (defvar lisp-interaction-mode-map
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index fc986f3..f5745a9 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2087,18 +2087,15 @@ for \\[find-tag] (which see)."
 (defun etags-xref-find (action id)
   (pcase action
     (`definitions (etags--xref-find-definitions id))
-    (`references
-     (etags--xref-find-matches id #'xref-collect-references))
-    (`matches
-     (etags--xref-find-matches id #'xref-collect-matches))
+    (`references  (etags--xref-find-references id))
     (`apropos (etags--xref-find-definitions id t))))
 
-(defun etags--xref-find-matches (input fun)
-  (let ((dirs (if tags-table-list
-                  (mapcar #'file-name-directory tags-table-list)
-                ;; If no tags files are loaded, prompt for the dir.
-                (list (read-directory-name "In directory: " nil nil t)))))
-    (cl-mapcan (lambda (dir) (funcall fun 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
@@ -2154,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
new file mode 100644
index 0000000..26b32b4
--- /dev/null
+++ b/lisp/progmodes/project.el
@@ -0,0 +1,119 @@
+;;; project.el --- Operations on the current project  -*- lexical-binding: t; 
-*-
+
+;; Copyright (C) 2015 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file contains generic infrastructure for dealing with
+;; projects, and a number of public functions: finding the current
+;; root, related project directories, search path, etc.
+
+;;; Code:
+
+(require 'cl-generic)
+
+(defvar project-find-functions (list #'project-try-vc
+                                     #'project-ask-user)
+  "Special hook to find the project containing a given directory.
+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, and 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'."
+  (unless dir (setq dir default-directory))
+  (run-hook-with-args-until-success 'project-find-functions dir))
+
+(cl-defgeneric project-root (project)
+  "Return the root directory of the current project.
+The directory name should be absolute.")
+
+(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, inside or outside of the 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)
+          ;; Include these, because we don't know any better.
+          ;; But a specialized implementation may include only some of
+          ;; the project's subdirectories, if there are no source
+          ;; files at the top level.
+          (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, 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)
+  (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-root ((project (head vc)))
+  (cdr project))
+
+(defun project-ask-user (dir)
+  (cons 'user (read-directory-name "Project root: " dir nil t)))
+
+(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 f175c89..042429e 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)
@@ -182,9 +183,6 @@ found, return nil.
  (apropos PATTERN): Find all symbols that match PATTERN.  PATTERN
 is a regexp.
 
- (matches REGEXP): Find all matches for REGEXP in the related
-files.  REGEXP is an Emacs regular expression.
-
 IDENTIFIER can be any string returned by
 `xref-identifier-at-point-function', or from the table returned
 by `xref-identifier-completion-table-function'.
@@ -598,7 +596,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)."
          (tb (cl-set-difference (buffer-list) bl)))
     (cond
      ((null xrefs)
-      (user-error "No known %s for: %s" (symbol-name kind) input))
+      (user-error "No %s found for: %s" (symbol-name kind) input))
      ((not (cdr xrefs))
       (xref-push-marker-stack)
       (xref--pop-to-location (xref--xref-location (car xrefs)) window))
@@ -661,10 +659,25 @@ With prefix argument, prompt for the identifier."
 
 ;;;###autoload
 (defun xref-find-regexp (regexp)
-  "Find all matches for REGEXP."
+  "Find all matches for REGEXP.
+With \\[universal-argument] prefix, you can specify the directory
+to search in."
   ;; FIXME: Prompt for directory.
   (interactive (list (xref--read-identifier "Find regexp: ")))
-  (xref--show-xrefs regexp 'matches regexp nil))
+  (let* ((dirs (if current-prefix-arg
+                   (list (read-directory-name "In directory: "))
+                 (let ((proj (project-current)))
+                   (project--prune-directories
+                    (nconc
+                     (project-directories proj)
+                     (project-search-path proj))))))
+         (xref-find-function
+          (lambda (_kind regexp)
+            (cl-mapcan
+             (lambda (dir)
+               (xref-collect-matches regexp dir))
+             dirs))))
+    (xref--show-xrefs regexp 'matches regexp nil)))
 
 (declare-function apropos-parse-pattern "apropos" (pattern))
 
@@ -807,7 +820,6 @@ tools are used, and when."
                      (xref-make-file-location file line
                                               (current-column))))))))
 
-
 (provide 'xref)
 
 ;;; xref.el ends here