From: Dmitry Gutov Date: Fri, 10 Jul 2015 01:34:41 +0000 (+0300) Subject: Introduce a Project API X-Git-Tag: emacs-25.0.90~1509 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f8c720b55b9419c849ea9febe6f888761a61949b;p=emacs.git 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. --- diff --git a/lisp/cedet/ede.el b/lisp/cedet/ede.el index 43660a8bb71..9e92fc7b4af 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 335a24b444e..aa02b040083 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 fc986f34187..f5745a9c8e8 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 00000000000..26b32b4b750 --- /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 . + +;;; 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 f175c89c573..042429e3efe 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