1
0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-14 16:50:58 +00:00

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.
This commit is contained in:
Dmitry Gutov 2015-07-10 04:34:41 +03:00
parent 78c3e14aaf
commit f8c720b55b
5 changed files with 178 additions and 42 deletions

View File

@ -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.

View File

@ -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)
(declare-function project-search-path "project")
(declare-function project-current "project")
(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)))
(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

View File

@ -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)

119
lisp/progmodes/project.el Normal file
View File

@ -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

View File

@ -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