[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] scratch/project 106e023: Add new `project' package, and us
From: |
Dmitry Gutov |
Subject: |
[Emacs-diffs] scratch/project 106e023: Add new `project' package, and use it in xref |
Date: |
Wed, 08 Jul 2015 00:09:36 +0000 |
branch: scratch/project
commit 106e023e7c08fef5e1397df74e99bd369c32bb03
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>
Add new `project' package, and use it in xref
---
lisp/emacs-lisp/cl-generic.el | 1 +
lisp/progmodes/elisp-mode.el | 39 +++++++-----------
lisp/progmodes/etags.el | 12 ++----
lisp/progmodes/project.el | 87 +++++++++++++++++++++++++++++++++++++++++
lisp/progmodes/xref.el | 40 ++++++++++++++++---
5 files changed, 142 insertions(+), 37 deletions(-)
diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 5923e4d..33953f7 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -936,6 +936,7 @@ 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 335a24b..4824798 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -584,6 +584,7 @@ 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)
@@ -593,9 +594,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,28 +653,16 @@ 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))))
+(declare-function project-source-directories "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)
- (and (file-exists-p dir)
- (funcall fun symbol dir)))
+ (xref-collect-references symbol dir))
dirs)))
(defun elisp--xref-find-apropos (regexp)
@@ -719,6 +706,12 @@ 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)))
+ (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..bffc98a 100644
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2087,18 +2087,14 @@ 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)
+(defun etags--xref-find-references (input)
(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)))
+ (project-source-directories (project-current)))))
+ (cl-mapcan (lambda (dir) (xref-collect-references input dir)) dirs)))
(defun etags--xref-find-definitions (pattern &optional regexp?)
;; This emulates the behaviour of `find-tag-in-order' but instead of
diff --git a/lisp/progmodes/project.el b/lisp/progmodes/project.el
new file mode 100644
index 0000000..21c5190
--- /dev/null
+++ b/lisp/progmodes/project.el
@@ -0,0 +1,87 @@
+;;; 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, source directories, related directories, etc.
+
+;;; Code:
+
+(require 'cl-generic)
+
+(defvar project-functions '(project-try-vc
+ project-try-ede
+ 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.")
+
+;;;###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-functions dir))
+
+(cl-defgeneric project-root (project)
+ "Return the root directory of the current project.")
+
+(cl-defgeneric project-source-directories (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."
+ (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)."
+ (list (project-root project)))
+
+(defvar project-vc-root-files '(".git" ".hg" ".bzr"))
+
+(defun project-try-vc (dir)
+ (let* ((fun (lambda (dir)
+ (let ((default-directory dir))
+ (cl-some #'file-exists-p project-vc-root-files))))
+ (root (locate-dominating-file dir fun)))
+ (when root (cons 'vc root))))
+
+(cl-defmethod project-root ((project (head vc)))
+ (cdr project))
+
+(declare-function ede-directory-get-open-project "ede")
+(declare-function ede-project-root "ede")
+
+(defun project-try-ede (dir)
+ (when (featurep 'ede)
+ (cons 'ede (ede-directory-get-open-project dir 'ROOT))))
+
+(defun project-ask-user (dir)
+ (cons 'user (read-directory-name "Project root: " dir nil t)))
+
+(cl-defmethod project-root ((project (head ede)))
+ (ede-project-root (cdr project)))
+
+(provide 'project)
+;;; project.el ends here
diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el
index 50d52d0..1a9943f 100644
--- a/lisp/progmodes/xref.el
+++ b/lisp/progmodes/xref.el
@@ -182,9 +182,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 +595,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 +658,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)))
+ (xref--prune-directories
+ (nconc
+ (project-directories proj)
+ (project-source-directories 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))
@@ -805,6 +817,22 @@ 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)