From 246d6605f72810b1d4977947f266cf48b933446f Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Sat, 14 Nov 2015 02:37:01 +0200 Subject: [PATCH] Use generic dispatch for xref backends * lisp/progmodes/xref.el (xref-backend-functions): New variable. (xref-find-function): Remove. (xref-find-backend) (xref--etags-backend): New functions. (xref-identifier-at-point-function) (xref-identifier-completion-table-function): Remove. (xref-backend-definitions, xref-backend-references) (xref-backend-apropos, xref-backend-identifier-at-point) (xref-backend-identifier-completion-table): New generic functions. * lisp/progmodes/elisp-mode.el (emacs-lisp-mode): Add `elisp--xref-backend' to the beginning of `xref-backend-functions', locally. Delete references to removed functions and vars. (elisp-xref-find): Remove. (elisp--xref-backend): New function. (elisp--xref-find-references, elisp--xref-find-apropos) (elisp--xref-identifier-completion-table): Turn into appropriately named generic methods. * lisp/progmodes/etags.el (etags-xref-find): Remove. (xref-backend-identifier-completion-table) (xref-backend-references, xref-backend-definitions) (xref-backend-apropos): New generic methods. --- lisp/progmodes/elisp-mode.el | 41 +++++++-------- lisp/progmodes/etags.el | 21 ++++---- lisp/progmodes/xref.el | 99 ++++++++++++++++++++++-------------- 3 files changed, 88 insertions(+), 73 deletions(-) diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index af2ea56dcee..2c22483e86f 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -228,8 +228,7 @@ Blank lines separate paragraphs. Semicolons start comments. \\{emacs-lisp-mode-map}" :group 'lisp - (defvar xref-find-function) - (defvar xref-identifier-completion-table-function) + (defvar xref-backend-functions) (defvar project-library-roots-function) (lisp-mode-variables nil nil 'elisp) (add-hook 'after-load-functions #'elisp--font-lock-flush-elisp-buffers) @@ -239,9 +238,7 @@ Blank lines separate paragraphs. Semicolons start comments. (setq imenu-case-fold-search nil) (add-function :before-until (local 'eldoc-documentation-function) #'elisp-eldoc-documentation-function) - (setq-local xref-find-function #'elisp-xref-find) - (setq-local xref-identifier-completion-table-function - #'elisp--xref-identifier-completion-table) + (add-hook 'xref-backend-functions #'elisp--xref-backend nil t) (setq-local project-library-roots-function #'elisp-library-roots) (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local)) @@ -588,21 +585,7 @@ It can be quoted, or be inside a quoted form." (declare-function xref-make "xref" (summary location)) (declare-function xref-collect-references "xref" (symbol dir)) -(defun elisp-xref-find (action id) - (require 'find-func) - ;; FIXME: use information in source near point to filter results: - ;; (dvc-log-edit ...) - exclude 'feature - ;; (require 'dvc-log-edit) - only 'feature - ;; Semantic may provide additional information - (pcase action - (`definitions - (let ((sym (intern-soft id))) - (when sym - (elisp--xref-find-definitions sym)))) - (`references - (elisp--xref-find-references id)) - (`apropos - (elisp--xref-find-apropos id)))) +(defun elisp--xref-backend () 'elisp) ;; WORKAROUND: This is nominally a constant, but the text properties ;; are not preserved thru dump if use defconst. See bug#21237. @@ -638,7 +621,17 @@ Each function should return a list of xrefs, or nil; the first non-nil result supercedes the xrefs produced by `elisp--xref-find-definitions'.") -;; FIXME: name should be singular; match xref-find-definition +(cl-defmethod xref-backend-definitions ((_backend (eql elisp)) identifier) + (require 'find-func) + ;; FIXME: use information in source near point to filter results: + ;; (dvc-log-edit ...) - exclude 'feature + ;; (require 'dvc-log-edit) - only 'feature + ;; Semantic may provide additional information + ;; + (let ((sym (intern-soft identifier))) + (when sym + (elisp--xref-find-definitions sym)))) + (defun elisp--xref-find-definitions (symbol) ;; The file name is not known when `symbol' is defined via interactive eval. (let (xrefs) @@ -805,7 +798,7 @@ non-nil result supercedes the xrefs produced by (declare-function project-roots "project") (declare-function project-current "project") -(defun elisp--xref-find-references (symbol) +(cl-defmethod xref-backend-references ((_backend (eql elisp)) symbol) "Find all references to SYMBOL (a string) in the current project." (cl-mapcan (lambda (dir) @@ -815,7 +808,7 @@ non-nil result supercedes the xrefs produced by (project-roots pr) (project-library-roots pr))))) -(defun elisp--xref-find-apropos (regexp) +(cl-defmethod xref-backend-apropos ((_backend (eql elisp)) regexp) (apply #'nconc (let (lst) (dolist (sym (apropos-internal regexp)) @@ -832,7 +825,7 @@ non-nil result supercedes the xrefs produced by (facep sym))) 'strict)) -(defun elisp--xref-identifier-completion-table () +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql elisp))) elisp--xref-identifier-completion-table) (cl-defstruct (xref-elisp-location diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el index 38c5cc2bdb6..ae1aa11fbc2 100644 --- a/lisp/progmodes/etags.el +++ b/lisp/progmodes/etags.el @@ -2084,17 +2084,12 @@ for \\[find-tag] (which see)." (defvar etags-xref-find-definitions-tag-order '(tag-exact-match-p tag-implicit-name-match-p) - "Tag order used in `etags-xref-find' to look for definitions.") + "Tag order used in `xref-backend-definitions' to look for definitions.") -;;;###autoload -(defun etags-xref-find (action id) - (pcase action - (`definitions (etags--xref-find-definitions id)) - (`references (etags--xref-find-references id)) - (`apropos (etags--xref-find-definitions id t)))) - -(defun etags--xref-find-references (symbol) - ;; TODO: Merge together with the Elisp impl. +(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql etags))) + (tags-lazy-completion-table)) + +(cl-defmethod xref-backend-references ((_backend (eql etags)) symbol) (cl-mapcan (lambda (dir) (xref-collect-references symbol dir)) @@ -2103,6 +2098,12 @@ for \\[find-tag] (which see)." (project-roots pr) (project-library-roots pr))))) +(cl-defmethod xref-backend-definitions ((_backend (eql etags)) symbol) + (etags--xref-find-definitions symbol)) + +(cl-defmethod xref-backend-apropos ((_backend (eql etags)) symbol) + (etags--xref-find-definitions symbol t)) + (defun etags--xref-find-definitions (pattern &optional regexp?) ;; This emulates the behaviour of `find-tag-in-order' but instead of ;; returning one match at a time all matches are returned as list. diff --git a/lisp/progmodes/xref.el b/lisp/progmodes/xref.el index 8675c95ff9e..489a2ec0b0d 100644 --- a/lisp/progmodes/xref.el +++ b/lisp/progmodes/xref.el @@ -23,14 +23,21 @@ ;; referencing commands, in particular "find-definition". ;; ;; Some part of the functionality must be implemented in a language -;; dependent way and that's done by defining `xref-find-function', -;; `xref-identifier-at-point-function' and -;; `xref-identifier-completion-table-function', which see. +;; dependent way and that's done by defining an xref backend. ;; -;; A major mode should make these variables buffer-local first. +;; That consists of a constructor function, which should return a +;; backend value, and a set of implementations for the generic +;; functions: ;; -;; `xref-find-function' can be called in several ways, see its -;; description. It has to operate with "xref" and "location" values. +;; `xref-backend-identifier-at-point', +;; `xref-backend-identifier-completion-table', +;; `xref-backend-definitions', `xref-backend-references', +;; `xref-backend-apropos', which see. +;; +;; A major mode would normally use `add-hook' to add the backend +;; constructor to `xref-backend-functions'. +;; +;; The last three methods operate with "xref" and "location" values. ;; ;; One would usually call `make-xref' and `xref-make-file-location', ;; `xref-make-buffer-location' or `xref-make-bogus-location' to create @@ -46,12 +53,11 @@ ;; Each identifier must be represented as a string. Implementers can ;; use string properties to store additional information about the ;; identifier, but they should keep in mind that values returned from -;; `xref-identifier-completion-table-function' should still be +;; `xref-backend-identifier-completion-table' should still be ;; distinct, because the user can't see the properties when making the ;; choice. ;; -;; See the functions `etags-xref-find' and `elisp-xref-find' for full -;; examples. +;; See the etags and elisp-mode implementations for full examples. ;;; Code: @@ -195,35 +201,46 @@ LENGTH is the match length, in characters." ;;; API -(declare-function etags-xref-find "etags" (action id)) -(declare-function tags-lazy-completion-table "etags" ()) +;; We make the etags backend the default for now, until something +;; better comes along. +(defvar xref-backend-functions (list #'xref--etags-backend) + "Special hook to find the xref backend for the current context. +Each functions on this hook is called in turn with no arguments +and should return either nil to mean that it is not applicable, +or an xref backend, which is a value to be used to dispatch the +generic functions.") -;; For now, make the etags backend the default. -(defvar xref-find-function #'etags-xref-find - "Function to look for cross-references. -It can be called in several ways: +(defun xref-find-backend () + (run-hook-with-args-until-success 'xref-backend-functions)) - (definitions IDENTIFIER): Find definitions of IDENTIFIER. The -result must be a list of xref objects. If IDENTIFIER contains -sufficient information to determine a unique definition, returns -only that definition. If there are multiple possible definitions, -return all of them. If no definitions can be found, return nil. +(defun xref--etags-backend () 'etags) - (references IDENTIFIER): Find references of IDENTIFIER. The -result must be a list of xref objects. If no references can be -found, return nil. +(cl-defgeneric xref-backend-definitions (backend identifier) + "Find definitions of IDENTIFIER. - (apropos PATTERN): Find all symbols that match PATTERN. PATTERN -is a regexp. +The result must be a list of xref objects. If IDENTIFIER +contains sufficient information to determine a unique definition, +return only that definition. If there are multiple possible +definitions, return all of them. If no definitions can be found, +return nil. IDENTIFIER can be any string returned by -`xref-identifier-at-point-function', or from the table returned -by `xref-identifier-completion-table-function'. +`xref-backend-identifier-at-point', or from the table returned by +`xref-backend-identifier-completion-table'. To create an xref object, call `xref-make'.") -(defvar xref-identifier-at-point-function #'xref-default-identifier-at-point - "Function to get the relevant identifier at point. +(cl-defgeneric xref-backend-references (backend identifier) + "Find references of IDENTIFIER. +The result must be a list of xref objects. If no references can +be found, return nil.") + +(cl-defgeneric xref-backend-apropos (backend pattern) + "Find all symbols that match PATTERN. +PATTERN is a regexp") + +(cl-defgeneric xref-backend-identifier-at-point (_backend) + "Return the relevant identifier at point. The return value must be a string or nil. nil means no identifier at point found. @@ -231,16 +248,14 @@ identifier at point found. If it's hard to determine the identifier precisely (e.g., because it's a method call on unknown type), the implementation can return a simple string (such as symbol at point) marked with a -special text property which `xref-find-function' would recognize -and then delegate the work to an external process.") - -(defvar xref-identifier-completion-table-function #'tags-lazy-completion-table - "Function that returns the completion table for identifiers.") - -(defun xref-default-identifier-at-point () +special text property which e.g. `xref-backend-definitions' would +recognize and then delegate the work to an external process." (let ((thing (thing-at-point 'symbol))) (and thing (substring-no-properties thing)))) +(cl-defgeneric xref-backend-identifier-completion-table (backend) + "Returns the completion table for identifiers.") + ;;; misc utilities (defun xref--alistify (list key test) @@ -690,7 +705,8 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." (defun xref--read-identifier (prompt) "Return the identifier at point or read it from the minibuffer." - (let ((id (funcall xref-identifier-at-point-function))) + (let* ((backend (xref-find-backend)) + (id (xref-backend-identifier-at-point backend))) (cond ((or current-prefix-arg (not id) (xref--prompt-p this-command)) @@ -700,7 +716,7 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." "[ :]+\\'" prompt)) id) prompt) - (funcall xref-identifier-completion-table-function) + (xref-backend-identifier-completion-table backend) nil nil nil 'xref--read-identifier-history id)) (t id)))) @@ -709,7 +725,9 @@ Return an alist of the form ((FILENAME . (XREF ...)) ...)." ;;; Commands (defun xref--find-xrefs (input kind arg window) - (let ((xrefs (funcall xref-find-function kind arg))) + (let ((xrefs (funcall (intern (format "xref-backend-%s" kind)) + (xref-find-backend) + arg))) (unless xrefs (user-error "No %s found for: %s" (symbol-name kind) input)) (xref--show-xrefs xrefs window))) @@ -824,6 +842,8 @@ tools are used, and when." (cl-mapcan (lambda (hit) (xref--collect-matches hit (format "\\_<%s\\_>" (regexp-quote symbol)))) hits) + ;; TODO: Implement "lightweight" buffer visiting, so that we + ;; don't have to kill them. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) @@ -856,6 +876,7 @@ IGNORES is a list of glob patterns." (unwind-protect (cl-mapcan (lambda (hit) (xref--collect-matches hit regexp)) (nreverse hits)) + ;; TODO: Same as above. (mapc #'kill-buffer (cl-set-difference (buffer-list) orig-buffers))))) -- 2.39.2