master 1f54c7a: Localize namespace-filtering code

[Dmitry Gutov]

branch: master
commit 1f54c7aeeddba90458260fd0d9515db904f3b1ad
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>

    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.
---
 lisp/progmodes/elisp-mode.el            | 350 +++++++++++++++-----------------
 test/lisp/progmodes/elisp-mode-tests.el |  25 ++-
 2 files changed, 184 insertions(+), 191 deletions(-)

diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el
index e5ad36c..fef01ec 100644
--- a/lisp/progmodes/elisp-mode.el
+++ b/lisp/progmodes/elisp-mode.el
@@ -682,6 +682,7 @@ functions are annotated with \"<f>\" 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 f80aca0..60946c2 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