xref-find-definitions: Exclude more generic function items.

* lisp/emacs-lisp/cl-generic.el (cl--generic-search-method): Add doc string.
(cl--generic-find-defgeneric-regexp): New.
(find-function-regexp-alist): Add it.

* lisp/emacs-lisp/find-func.el (find-feature-regexp): Move here from
elisp-mode.el, change to search for ";;; Code:"
(find-alias-regexp): Move here from elisp-mode.el, cleaned up.
(find-function-regexp-alist): Add them.

* lisp/progmodes/elisp-mode.el:
(elisp--xref-format, elisp--xref-format-extra): Change back to defvar due
to bug#21237.
(elisp--xref-find-definitions): Exclude co-located default methods for
generic functions. Also exclude implicitly declared defgeneric.
(elisp--xref-find-definitions): Handle C source properly. Exclude minor
mode variables defined by 'define-minor-mode'.

* test/automated/elisp-mode-tests.el: Declare generic functions, add
tests for them.
(xref-elisp-test-run): Fix bug.
(emacs-test-dir): Improve initial value.
(find-defs-defun-defvar-el): Don't expect defvar.
(find-defs-feature-el): Match change to find-feature-regexp.
This commit is contained in:
Stephen Leake 2015-08-13 12:54:39 -05:00
parent 9c13a81a9e
commit 0382fd42c6
4 changed files with 264 additions and 55 deletions

View file

@ -791,6 +791,8 @@ Can only be used from within the lexical body of a primary or around method."
;;; Add support for describe-function
(defun cl--generic-search-method (met-name)
"For `find-function-regexp-alist'. Searches for a cl-defmethod.
MET-NAME is a cons (SYMBOL . SPECIALIZERS)."
(let ((base-re (concat "(\\(?:cl-\\)?defmethod[ \t]+"
(regexp-quote (format "%s" (car met-name)))
"\\_>")))
@ -806,11 +808,15 @@ Can only be used from within the lexical body of a primary or around method."
nil t)
(re-search-forward base-re nil t))))
;; WORKAROUND: This can't be a defconst due to bug#21237.
(defvar cl--generic-find-defgeneric-regexp "(\\(?:cl-\\)?defgeneric[ \t]+%s\\>")
(with-eval-after-load 'find-func
(defvar find-function-regexp-alist)
(add-to-list 'find-function-regexp-alist
`(cl-defmethod . ,#'cl--generic-search-method)))
`(cl-defmethod . ,#'cl--generic-search-method))
(add-to-list 'find-function-regexp-alist
`(cl-defgeneric . cl--generic-find-defgeneric-regexp)))
(defun cl--generic-method-info (method)
(let* ((specializers (cl--generic-method-specializers method))

View file

@ -100,10 +100,34 @@ Please send improvements and fixes to the maintainer."
:group 'find-function
:version "22.1")
(defcustom find-feature-regexp
(concat ";;; Code:")
"The regexp used by `xref-find-definitions' when searching for a feature definition.
Note it must contain a `%s' at the place where `format'
should insert the feature name."
;; We search for ";;; Code" rather than (feature '%s) because the
;; former is near the start of the code, and the latter is very
;; uninteresting. If the regexp is not found, just goes to
;; (point-min), which is acceptable in this case.
:type 'regexp
:group 'xref
:version "25.0")
(defcustom find-alias-regexp
"(defalias +'%s"
"The regexp used by `xref-find-definitions' to search for an alias definition.
Note it must contain a `%s' at the place where `format'
should insert the feature name."
:type 'regexp
:group 'xref
:version "25.0")
(defvar find-function-regexp-alist
'((nil . find-function-regexp)
(defvar . find-variable-regexp)
(defface . find-face-regexp))
(defface . find-face-regexp)
(feature . find-feature-regexp)
(defalias . find-alias-regexp))
"Alist mapping definition types into regexp variables.
Each regexp variable's value should actually be a format string
to be used to substitute the desired symbol name into the regexp.

View file

@ -604,40 +604,23 @@ It can be quoted, or be inside a quoted form."
(`apropos
(elisp--xref-find-apropos id))))
(defconst elisp--xref-format
;; WORKAROUND: This is nominally a constant, but the text properities
;; are not preserved thru dump if use defconst. See bug#21237
(defvar elisp--xref-format
(let ((str "(%s %s)"))
(put-text-property 1 3 'face 'font-lock-keyword-face str)
(put-text-property 4 6 'face 'font-lock-function-name-face str)
str))
(defconst elisp--xref-format-extra
;; WORKAROUND: This is nominally a constant, but the text properities
;; are not preserved thru dump if use defconst. See bug#21237
(defvar elisp--xref-format-extra
(let ((str "(%s %s %s)"))
(put-text-property 1 3 'face 'font-lock-keyword-face str)
(put-text-property 4 6 'face 'font-lock-function-name-face str)
str))
(defcustom find-feature-regexp
(concat "(provide +'%s)")
"The regexp used by `xref-find-definitions' to search for a feature definition.
Note it must contain a `%s' at the place where `format'
should insert the feature name."
:type 'regexp
:group 'xref
:version "25.0")
(defcustom find-alias-regexp
"(\\(defalias +'\\|def\\(const\\|face\\) +\\)%s"
"The regexp used by `xref-find-definitions' to search for an alias definition.
Note it must contain a `%s' at the place where `format'
should insert the feature name."
:type 'regexp
:group 'xref
:version "25.0")
(with-eval-after-load 'find-func
(defvar find-function-regexp-alist)
(add-to-list 'find-function-regexp-alist (cons 'feature 'find-feature-regexp))
(add-to-list 'find-function-regexp-alist (cons 'defalias 'find-alias-regexp)))
(defvar find-feature-regexp)
(defun elisp--xref-make-xref (type symbol file &optional summary)
"Return an xref for TYPE SYMBOL in FILE.
@ -683,9 +666,10 @@ otherwise build the summary from TYPE and SYMBOL."
(when file
(cond
((eq file 'C-source)
;; First call to find-lisp-object-file-name (for this
;; symbol?); C-source has not been cached yet.
;; Second call will return "src/*.c" in file; handled by 't' case below.
;; 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))
@ -704,17 +688,42 @@ otherwise build the summary from TYPE and SYMBOL."
))
((setq generic (cl--generic symbol))
;; 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 teh
;; 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 hueristic will discourage that.
(dolist (method (cl--generic-method-table generic))
(let* ((info (cl--generic-method-info method))
(met-name (cons symbol (cl--generic-method-specializers method)))
(descr (format elisp--xref-format-extra 'cl-defmethod symbol (nth 1 info)))
(let* ((info (cl--generic-method-info method));; qual-string combined-args doconly
(specializers (cl--generic-method-specializers method))
(met-name (cons symbol specializers))
(file (find-lisp-object-file-name met-name 'cl-defmethod)))
(when file
(push (elisp--xref-make-xref 'cl-defmethod met-name file descr) xrefs))
(when (and file
(or specializers ;; default method has null specializers
(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))))
))
(let ((descr (format elisp--xref-format 'cl-defgeneric symbol)))
(push (elisp--xref-make-xref nil symbol file descr) 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
@ -722,11 +731,43 @@ otherwise build the summary from TYPE and SYMBOL."
))))
(when (boundp symbol)
;; A variable
(let ((file (find-lisp-object-file-name symbol 'defvar)))
(when file
(when (eq file 'C-source)
(setq file (help-C-file-name symbol 'var)))
(push (elisp--xref-make-xref 'defvar symbol file) xrefs))))
(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))
((string= "src/" (substring file 0 4))
;; The variable is defined in a C source file; don't check
;; for define-minor-mode.
(push (elisp--xref-make-xref 'defvar symbol file) xrefs))
((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.
;;
;; IMPROVEME: If the user is searching for the identifier at
;; point, we can determine whether it is a variable or
;; function by looking at the source code near point.
;;
;; IMPROVEME: The user may actually be asking "do any
;; variables by this name exist"; we need a way to specify
;; that.
nil)
(t
(push (elisp--xref-make-xref 'defvar symbol file) xrefs))
))))
(when (featurep symbol)
(let ((file (ignore-errors

View file

@ -177,8 +177,8 @@
(defun xref-elisp-test-run (xrefs expecteds)
(should (= (length xrefs) (length expecteds)))
(while xrefs
(should (= (length xrefs) (length expecteds)))
(let ((xref (pop xrefs))
(expected (pop expecteds)))
@ -204,8 +204,9 @@ to (xref-elisp-test-descr-to-target xref)."
;; When tests are run from the Makefile, 'default-directory' is $HOME,
;; so we must provide this dir to expand-file-name in the expected
;; results. The Makefile sets EMACS_TEST_DIRECTORY.
(defconst emacs-test-dir (getenv "EMACS_TEST_DIRECTORY"))
;; results. This also allows running these tests from other
;; directories.
(defconst emacs-test-dir (file-name-directory (or load-file-name (buffer-file-name))))
;; alphabetical by test name
@ -244,12 +245,144 @@ to (xref-elisp-test-descr-to-target xref)."
;; FIXME: defconst
;; FIXME: eieio defclass
;; Possible ways of defining the default method implementation for a
;; generic function. We declare these here, so we know we cover all
;; cases, and we don't rely on other code not changing.
;;
;; When the generic and default method are declared in the same place,
;; elisp--xref-find-definitions only returns one.
(cl-defstruct (xref-elisp-root-type)
slot-1)
(cl-defgeneric xref-elisp-generic-no-methods ()
"doc string no-methods"
;; No default implementation, no methods, but fboundp is true for
;; this symbol; it calls cl-no-applicable-method
)
(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type))
"doc string no-default xref-elisp-root-type"
"non-default for no-default")
;; defgeneric after defmethod in file to ensure the fallback search
;; method of just looking for the function name will fail.
(cl-defgeneric xref-elisp-generic-no-default ()
"doc string no-default generic"
;; No default implementation; this function calls the cl-generic
;; dispatching code.
)
(cl-defgeneric xref-elisp-generic-co-located-default ()
"doc string co-located-default generic"
"co-located default")
(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type))
"doc string co-located-default xref-elisp-root-type"
"non-default for co-located-default")
(cl-defgeneric xref-elisp-generic-separate-default ()
"doc string separate-default generic"
;; default implementation provided separately
)
(cl-defmethod xref-elisp-generic-separate-default ()
"doc string separate-default default"
"separate default")
(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type))
"doc string separate-default xref-elisp-root-type"
"non-default for separate-default")
(cl-defmethod xref-elisp-generic-implicit-generic ()
"doc string implict-generic default"
"default for implicit generic")
(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type))
"doc string implict-generic xref-elisp-root-type"
"non-default for implicit generic")
(xref-elisp-deftest find-defs-defgeneric-no-methods
(elisp--xref-find-definitions 'xref-elisp-generic-no-methods)
(list
(xref-make "(cl-defgeneric xref-elisp-generic-no-methods)"
(xref-make-elisp-location
'xref-elisp-generic-no-methods 'cl-defgeneric
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-no-default
(elisp--xref-find-definitions 'xref-elisp-generic-no-default)
(list
(xref-make "(cl-defgeneric xref-elisp-generic-no-default)"
(xref-make-elisp-location
'xref-elisp-generic-no-default 'cl-defgeneric
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-elisp-generic-no-default ((this xref-elisp-root-type)))"
(xref-make-elisp-location
'(xref-elisp-generic-no-default xref-elisp-root-type) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-co-located-default
(elisp--xref-find-definitions 'xref-elisp-generic-co-located-default)
(list
(xref-make "(cl-defgeneric xref-elisp-generic-co-located-default)"
(xref-make-elisp-location
'xref-elisp-generic-co-located-default 'cl-defgeneric
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-elisp-generic-co-located-default ((this xref-elisp-root-type)))"
(xref-make-elisp-location
'(xref-elisp-generic-co-located-default xref-elisp-root-type) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-separate-default
(elisp--xref-find-definitions 'xref-elisp-generic-separate-default)
(list
(xref-make "(cl-defgeneric xref-elisp-generic-separate-default)"
(xref-make-elisp-location
'xref-elisp-generic-separate-default 'cl-defgeneric
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-elisp-generic-separate-default ())"
(xref-make-elisp-location
'(xref-elisp-generic-separate-default) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-elisp-generic-separate-default ((this xref-elisp-root-type)))"
(xref-make-elisp-location
'(xref-elisp-generic-separate-default xref-elisp-root-type) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-implicit-generic
(elisp--xref-find-definitions 'xref-elisp-generic-implicit-generic)
(list
(xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ())"
(xref-make-elisp-location
'(xref-elisp-generic-implicit-generic) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-elisp-generic-implicit-generic ((this xref-elisp-root-type)))"
(xref-make-elisp-location
'(xref-elisp-generic-implicit-generic xref-elisp-root-type) 'cl-defmethod
(expand-file-name "elisp-mode-tests.el" emacs-test-dir)))
))
;; Test that we handle more than one method
;; When run from the Makefile, etags is not loaded at compile time,
;; but it is by the time this test is run. interactively; don't fail
;; for that.
(require 'etags)
(xref-elisp-deftest find-defs-defgeneric-el
(elisp--xref-find-definitions 'xref-location-marker)
(list
(xref-make "(cl-defgeneric xref-location-marker)"
(xref-make-elisp-location
'xref-location-marker nil
'xref-location-marker 'cl-defgeneric
(expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
(xref-make "(cl-defmethod xref-location-marker ((l xref-elisp-location)))"
(xref-make-elisp-location
@ -267,7 +400,10 @@ to (xref-elisp-test-descr-to-target xref)."
(xref-make-elisp-location
'(xref-location-marker xref-bogus-location) 'cl-defmethod
(expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
;; etags is not loaded at test time
(xref-make "(cl-defmethod xref-location-marker ((l xref-etags-location)))"
(xref-make-elisp-location
'(xref-location-marker xref-etags-location) 'cl-defmethod
(expand-file-name "../../lisp/progmodes/etags.el" emacs-test-dir)))
))
(xref-elisp-deftest find-defs-defgeneric-eval
@ -318,19 +454,18 @@ 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 from the
;; symbol. find-function-regexp-alist uses find-function-regexp for
;; this, but that matches too many things for use in this test.
;; 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 varible, not a
;; 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)
(list
(cons
(xref-make "(defvar compilation-minor-mode)"
(xref-make-elisp-location
'compilation-minor-mode 'defvar
(expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir)))
"(define-minor-mode compilation-minor-mode")
(cons
(xref-make "(defun compilation-minor-mode)"
(xref-make-elisp-location
@ -382,10 +517,13 @@ to (xref-elisp-test-descr-to-target xref)."
(xref-elisp-deftest find-defs-feature-el
(elisp--xref-find-definitions 'xref)
(list
(xref-make "(feature xref)"
(cons
(xref-make "(feature xref)"
(xref-make-elisp-location
'xref 'feature
(expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))))
(expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
";;; Code:")
))
(xref-elisp-deftest find-defs-feature-eval
(elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature)))