From: Dmitry Gutov Date: Wed, 15 Sep 2021 02:33:06 +0000 (+0300) Subject: Localize namespace-filtering code X-Git-Tag: emacs-28.0.90~966 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=1f54c7aeeddba90458260fd0d9515db904f3b1ad;p=emacs.git Localize namespace-filtering code To be able to filter results coming from elisp-xref-find-def-functions, and for general ease of understanding. * lisp/progmodes/elisp-mode.el (elisp--xref-find-definitions): Undo the previous change. (xref-backend-apropos): Update accordingly. (elisp--xref-filter-definitions): New function. (xref-backend-definitions): Use it to post-filter the results coming from elisp--xref-find-definitions. * test/lisp/progmodes/elisp-mode-tests.el (find-defs-minor-defvar-c): New test. (find-defs-defun-defvar-el): Update test. --- diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index e5ad36c30bf..fef01eca9dd 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -682,6 +682,7 @@ functions are annotated with \"\" via the ;;; Xref backend (declare-function xref-make "xref" (summary location)) +(declare-function xref-item-location "xref" (this)) (defun elisp--xref-backend () 'elisp) @@ -877,7 +878,6 @@ namespace but with lower confidence." ;; Use a property to transport the location of the identifier. (propertize ident 'pos (car bounds)))))) - (cl-defmethod xref-backend-definitions ((_backend (eql 'elisp)) identifier) (require 'find-func) (let ((sym (intern-soft identifier))) @@ -885,39 +885,53 @@ namespace but with lower confidence." (let* ((pos (get-text-property 0 'pos identifier)) (namespace (if pos (elisp--xref-infer-namespace pos) - 'any))) - (elisp--xref-find-definitions sym namespace))))) - -(defun elisp--xref-find-definitions (symbol &optional namespace) - "Return xrefs of definitions for SYMBOL in NAMESPACE. -NAMESPACE is one of: `function', `variable', `maybe-variable', `feature', -`face' or `any' (indicating any namespace). `maybe-variable' indicates a -variable namespace but will include definitions in other namespaces if -there are no matches for variables." - ;; FIXME: fix callers instead of having an optional argument - (unless namespace - (setq namespace 'any)) + 'any)) + (defs (elisp--xref-find-definitions sym))) + (if (eq namespace 'maybe-variable) + (or (elisp--xref-filter-definitions defs 'variable sym) + (elisp--xref-filter-definitions defs 'any sym)) + (elisp--xref-filter-definitions defs namespace sym)))))) + +(defun elisp--xref-filter-definitions (definitions namespace symbol) + (if (eq namespace 'any) + (if (memq symbol minor-mode-list) + ;; The symbol is a minor mode. These should be defined by + ;; "define-minor-mode", which means the variable and the + ;; function are declared in the same place. So we return only + ;; the function, arbitrarily. + ;; + ;; There is an exception, when the variable is defined in C + ;; code, as for abbrev-mode. + (cl-loop for d in definitions + for loc = (xref-item-location d) + for file = (xref-elisp-location-file loc) + when (or (not (eq (xref-elisp-location-type loc) 'defvar)) + (null file) + (string-prefix-p "src/" file)) + collect d) + definitions) + (let ((expected-types + (pcase-exhaustive namespace + ('function '( nil defalias define-type + cl-defgeneric cl-defmethod)) + ('variable '(defvar)) + ('face '(defface)) + ('feature '(feature))))) + (cl-loop for d in definitions + when (memq + (xref-elisp-location-type (xref-item-location d)) + expected-types) + collect d)))) + +(defun elisp--xref-find-definitions (symbol) ;; The file name is not known when `symbol' is defined via interactive eval. - (let ((maybe (eq namespace 'maybe-variable)) - (namespace (if (eq namespace 'maybe-variable) 'variable namespace)) - (xrefs nil) ; xrefs from NAMESPACE - (secondary-xrefs nil)) ; other xrefs - + (let (xrefs) (let ((temp elisp-xref-find-def-functions)) - ;; FIXME: The 'elisp-xref-find-def-functions' function interface does - ;; not allow for namespace filtering so we tacitly assume they all match. (while (and (null xrefs) temp) (setq xrefs (append xrefs (funcall (pop temp) symbol))))) (unless xrefs - (cl-flet ((add-xref (found-in-ns type symbol file &optional summary) - (let ((xref (elisp--xref-make-xref type symbol file summary))) - (push xref (if (or (eq namespace found-in-ns) - (eq namespace 'any)) - xrefs - secondary-xrefs))))) - ;; alphabetical by result type symbol ;; FIXME: advised function; list of advice functions @@ -926,161 +940,130 @@ there are no matches for variables." ;; Coding system symbols do not appear in ‘load-history’, ;; so we can’t get a location for them. - (when (and (symbolp symbol) - (symbol-function symbol) - (symbolp (symbol-function symbol))) - ;; aliased function - (let* ((alias-symbol symbol) - (alias-file (symbol-file alias-symbol)) - (real-symbol (symbol-function symbol)) - (real-file (find-lisp-object-file-name real-symbol 'defun))) - - (when real-file - (add-xref 'function nil real-symbol real-file)) - - (when alias-file - (add-xref 'function 'defalias alias-symbol alias-file)))) - - (when (facep symbol) - (let ((file (find-lisp-object-file-name symbol 'defface))) - (when file - (add-xref 'face 'defface symbol file)))) - - (when (fboundp symbol) - (let ((file (find-lisp-object-file-name symbol - (symbol-function symbol))) - generic doc) - (when file - (cond - ((eq file 'C-source) - ;; First call to find-lisp-object-file-name for an object - ;; defined in C; the doc strings from the C source have - ;; not been loaded yet. Second call will return "src/*.c" - ;; in file; handled by 't' case below. - (add-xref 'function nil symbol - (help-C-file-name (symbol-function symbol) 'subr))) - - ((and (setq doc (documentation symbol t)) - ;; This doc string is defined in cl-macs.el cl-defstruct - (string-match "Constructor for objects of type `\\(.*\\)'" - doc)) - ;; `symbol' is a name for the default constructor created by - ;; cl-defstruct, so return the location of the cl-defstruct. - (let* ((type-name (match-string 1 doc)) - (type-symbol (intern type-name)) - (file (find-lisp-object-file-name type-symbol - 'define-type)) - (summary (format elisp--xref-format-extra - 'cl-defstruct - (concat "(" type-name) - (concat "(:constructor " - (symbol-name symbol) - "))")))) - (add-xref 'function 'define-type type-symbol file summary))) - - ((setq generic (cl--generic symbol)) - ;; FIXME: move this to elisp-xref-find-def-functions, - ;; in cl-generic.el - - ;; A generic function. If there is a default method, it - ;; will appear in the method table, with no - ;; specializers. - ;; - ;; If the default method is declared by the cl-defgeneric - ;; declaration, it will have the same location as the - ;; cl-defgeneric, so we want to exclude it from the - ;; result. In this case, it will have a null doc - ;; string. User declarations of default methods may also - ;; have null doc strings, but we hope that is - ;; rare. Perhaps this heuristic will discourage that. - (dolist (method (cl--generic-method-table generic)) - (let* ((info (cl--generic-method-info method)) - ;; qual-string combined-args doconly - (specializers (cl--generic-method-specializers method)) - (non-default nil) - (met-name (cl--generic-load-hist-format - symbol - (cl--generic-method-qualifiers method) - specializers)) - (file (find-lisp-object-file-name met-name - 'cl-defmethod))) - (dolist (item specializers) - ;; default method has all 't' in specializers - (setq non-default (or non-default (not (equal t item))))) - - (when (and file - (or non-default - ;; assuming only co-located default has null - ;; doc string - (nth 2 info))) - (if specializers - (let ((summary (format elisp--xref-format-extra - 'cl-defmethod symbol - (nth 1 info)))) - (add-xref 'function - 'cl-defmethod met-name file summary)) - - (let ((summary (format elisp--xref-format-extra - 'cl-defmethod symbol "()"))) - (add-xref 'function - 'cl-defmethod met-name file summary)))))) - - (if (and (setq doc (documentation symbol t)) - ;; This doc string is created somewhere in - ;; cl--generic-make-function for an implicit - ;; defgeneric. - (string-match "\n\n(fn ARG &rest ARGS)" doc)) - ;; This symbol is an implicitly defined defgeneric, so - ;; don't return it. - nil - (add-xref 'function 'cl-defgeneric symbol file))) - - (t - (add-xref 'function nil symbol file)))))) - - (when (boundp symbol) - ;; A variable - (let ((file (find-lisp-object-file-name symbol 'defvar))) - (when file - (cond - ((eq file 'C-source) - ;; The doc strings from the C source have not been loaded - ;; yet; help-C-file-name does that. Second call will - ;; return "src/*.c" in file; handled below. - (add-xref 'variable - 'defvar symbol (help-C-file-name symbol 'var))) - - ((string= "src/" (substring file 0 4)) - ;; The variable is defined in a C source file; don't check - ;; for define-minor-mode. - (add-xref 'variable 'defvar symbol file)) - - ((memq symbol minor-mode-list) - ;; The symbol is a minor mode. These should be defined by - ;; "define-minor-mode", which means the variable and the - ;; function are declared in the same place. So we return only - ;; the function, arbitrarily, unless the search is in - ;; variable context, since it would be silly to have the - ;; user choose between both. - ;; - ;; There is an exception, when the variable is defined in C - ;; code, as for abbrev-mode. - (when (eq namespace 'variable) - (add-xref 'variable 'defvar symbol file))) - - (t - (add-xref 'variable 'defvar symbol file)))))) - - (when (featurep symbol) - (let ((file (ignore-errors - (find-library-name (symbol-name symbol))))) - (when file - (add-xref 'feature 'feature symbol file)))) - )) - - ;; If no xrefs consistent with the specified namespace were found - ;; and we weren't sure, use all other hits. - (or xrefs (and maybe secondary-xrefs)))) + (when (and (symbolp symbol) + (symbol-function symbol) + (symbolp (symbol-function symbol))) + ;; aliased function + (let* ((alias-symbol symbol) + (alias-file (symbol-file alias-symbol)) + (real-symbol (symbol-function symbol)) + (real-file (find-lisp-object-file-name real-symbol 'defun))) + + (when real-file + (push (elisp--xref-make-xref nil real-symbol real-file) xrefs)) + + (when alias-file + (push (elisp--xref-make-xref 'defalias alias-symbol alias-file) xrefs)))) + + (when (facep symbol) + (let ((file (find-lisp-object-file-name symbol 'defface))) + (when file + (push (elisp--xref-make-xref 'defface symbol file) xrefs)))) + + (when (fboundp symbol) + (let ((file (find-lisp-object-file-name symbol (symbol-function symbol))) + generic doc) + (when file + (cond + ((eq file 'C-source) + ;; First call to find-lisp-object-file-name for an object + ;; defined in C; the doc strings from the C source have + ;; not been loaded yet. Second call will return "src/*.c" + ;; in file; handled by 't' case below. + (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs)) + + ((and (setq doc (documentation symbol t)) + ;; This doc string is defined in cl-macs.el cl-defstruct + (string-match "Constructor for objects of type `\\(.*\\)'" doc)) + ;; `symbol' is a name for the default constructor created by + ;; cl-defstruct, so return the location of the cl-defstruct. + (let* ((type-name (match-string 1 doc)) + (type-symbol (intern type-name)) + (file (find-lisp-object-file-name type-symbol 'define-type)) + (summary (format elisp--xref-format-extra + 'cl-defstruct + (concat "(" type-name) + (concat "(:constructor " (symbol-name symbol) "))")))) + (push (elisp--xref-make-xref 'define-type type-symbol file summary) xrefs) + )) + + ((setq generic (cl--generic symbol)) + ;; FIXME: move this to elisp-xref-find-def-functions, in cl-generic.el + + ;; A generic function. If there is a default method, it + ;; will appear in the method table, with no + ;; specializers. + ;; + ;; If the default method is declared by the cl-defgeneric + ;; declaration, it will have the same location as the + ;; cl-defgeneric, so we want to exclude it from the + ;; result. In this case, it will have a null doc + ;; string. User declarations of default methods may also + ;; have null doc strings, but we hope that is + ;; rare. Perhaps this heuristic will discourage that. + (dolist (method (cl--generic-method-table generic)) + (let* ((info (cl--generic-method-info method));; qual-string combined-args doconly + (specializers (cl--generic-method-specializers method)) + (non-default nil) + (met-name (cl--generic-load-hist-format + symbol + (cl--generic-method-qualifiers method) + specializers)) + (file (find-lisp-object-file-name met-name 'cl-defmethod))) + (dolist (item specializers) + ;; default method has all 't' in specializers + (setq non-default (or non-default (not (equal t item))))) + + (when (and file + (or non-default + (nth 2 info))) ;; assuming only co-located default has null doc string + (if specializers + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)) + + (let ((summary (format elisp--xref-format-extra 'cl-defmethod symbol "()"))) + (push (elisp--xref-make-xref 'cl-defmethod met-name file summary) xrefs)))) + )) + + (if (and (setq doc (documentation symbol t)) + ;; This doc string is created somewhere in + ;; cl--generic-make-function for an implicit + ;; defgeneric. + (string-match "\n\n(fn ARG &rest ARGS)" doc)) + ;; This symbol is an implicitly defined defgeneric, so + ;; don't return it. + nil + (push (elisp--xref-make-xref 'cl-defgeneric symbol file) xrefs)) + ) + + (t + (push (elisp--xref-make-xref nil symbol file) xrefs)) + )))) + + (when (boundp symbol) + ;; A variable + (let ((file (find-lisp-object-file-name symbol 'defvar))) + (when file + (cond + ((eq file 'C-source) + ;; The doc strings from the C source have not been loaded + ;; yet; help-C-file-name does that. Second call will + ;; return "src/*.c" in file; handled below. + (push (elisp--xref-make-xref 'defvar symbol (help-C-file-name symbol 'var)) xrefs)) + + (t + (push (elisp--xref-make-xref 'defvar symbol file) xrefs)) + + )))) + + (when (featurep symbol) + (let ((file (ignore-errors + (find-library-name (symbol-name symbol))))) + (when file + (push (elisp--xref-make-xref 'feature symbol file) xrefs)))) + );; 'unless xrefs' + + xrefs)) (declare-function xref-apropos-regexp "xref" (pattern)) @@ -1089,8 +1072,7 @@ there are no matches for variables." (let ((regexp (xref-apropos-regexp pattern)) lst) (dolist (sym (apropos-internal regexp)) - (push (elisp--xref-find-definitions sym 'any) - lst)) + (push (elisp--xref-find-definitions sym) lst)) (nreverse lst)))) (defvar elisp--xref-identifier-completion-table diff --git a/test/lisp/progmodes/elisp-mode-tests.el b/test/lisp/progmodes/elisp-mode-tests.el index f80aca0ad44..60946c2f446 100644 --- a/test/lisp/progmodes/elisp-mode-tests.el +++ b/test/lisp/progmodes/elisp-mode-tests.el @@ -752,15 +752,11 @@ to (xref-elisp-test-descr-to-target xref)." ;; Source for both variable and defun is "(define-minor-mode ;; compilation-minor-mode". There is no way to tell that directly from ;; the symbol, but we can use (memq sym minor-mode-list) to detect -;; that the symbol is a minor mode. See `elisp--xref-find-definitions' -;; for more comments. -;; -;; IMPROVEME: return defvar instead of defun if source near starting -;; point indicates the user is searching for a variable, not a -;; function. +;; that the symbol is a minor mode. In non-filtering mode we only +;; return the function. (require 'compile) ;; not loaded by default at test time (xref-elisp-deftest find-defs-defun-defvar-el - (elisp--xref-find-definitions 'compilation-minor-mode) + (xref-backend-definitions 'elisp "compilation-minor-mode") (list (cons (xref-make "(defun compilation-minor-mode)" @@ -770,6 +766,21 @@ to (xref-elisp-test-descr-to-target xref)." "(define-minor-mode compilation-minor-mode") )) +;; Returning only defvar because source near point indicates the user +;; is searching for a variable, not a function. +(xref-elisp-deftest find-defs-minor-defvar-c + (with-temp-buffer + (emacs-lisp-mode) + (insert "(foo overwrite-mode") + (xref-backend-definitions 'elisp + (xref-backend-identifier-at-point 'elisp))) + (list + (cons + (xref-make "(defvar overwrite-mode)" + (xref-make-elisp-location 'overwrite-mode 'defvar "src/buffer.c")) + "DEFVAR_PER_BUFFER (\"overwrite-mode\"") + )) + (xref-elisp-deftest find-defs-defvar-el (elisp--xref-find-definitions 'xref--marker-ring) (list