(`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.
(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))
))
((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
))))
(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
(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)))
;; 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
;; 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
(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
)
;; 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
(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)))