;;; Xref backend
(declare-function xref-make "xref" (summary location))
+(declare-function xref-item-location "xref" (this))
(defun elisp--xref-backend () 'elisp)
;; 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)))
(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
;; 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))
(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
projects / emacs.git / commitdiff