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:
parent
78c3e14aaf
commit
f8c720b55b
@ -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.
|
||||
|
@ -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
|
||||
|
@ -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
119
lisp/progmodes/project.el
Normal 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
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user