;;; Code:
+(require 'cl-generic)
(require 'lisp-mode)
(eval-when-compile (require 'cl-lib))
(string-match ".*$" doc)
(match-string 0 doc))))
+;; can't (require 'find-func) in a preloaded file
(declare-function find-library-name "find-func" (library))
(declare-function find-function-library "find-func" (function &optional l-o v))
(`apropos
(elisp--xref-find-apropos id))))
-(defun elisp--xref-identifier-location (type sym)
- (let ((file
- (pcase type
- (`defun (when (fboundp sym)
- (let ((fun-lib
- (find-function-library sym)))
- (setq sym (car fun-lib))
- (cdr fun-lib))))
- (`defvar (and (boundp sym)
- (let ((el-file (symbol-file sym 'defvar)))
- (if el-file
- (and
- ;; Don't show minor modes twice.
- ;; TODO: If TYPE ever becomes dependent on the
- ;; context, move this check outside.
- (not (and (fboundp sym)
- (memq sym minor-mode-list)))
- el-file)
- (help-C-file-name sym 'var)))))
- (`feature (and (featurep sym)
- ;; Skip when a function with the same name
- ;; is defined, because it's probably in the
- ;; same file.
- (not (fboundp sym))
- (ignore-errors
- (find-library-name (symbol-name sym)))))
- (`defface (when (facep sym)
- (symbol-file sym 'defface))))))
- (when file
- (when (string-match-p "\\.elc\\'" file)
- (setq file (substring file 0 -1)))
- (xref-make-elisp-location sym type file))))
-
-(defvar elisp--xref-format
+(defconst 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-cl-defmethod
+ (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)))
+
+(defun elisp--xref-make-xref (type symbol file &optional summary)
+ "Return an xref for TYPE SYMBOL in FILE.
+TYPE must be a type in 'find-function-regexp-alist' (use nil for
+'defun). If SUMMARY is non-nil, use it for the summary;
+otherwise build the summary from TYPE and SYMBOL."
+ (xref-make (or summary
+ (format elisp--xref-format (or type 'defun) symbol))
+ (xref-make-elisp-location symbol type file)))
+
(defun elisp--xref-find-definitions (symbol)
- (save-excursion
- (let (lst)
- (dolist (type '(feature defface defvar defun))
- (let ((loc
- (condition-case err
- (elisp--xref-identifier-location type symbol)
- (error
- (xref-make-bogus-location (error-message-string err))))))
- (when loc
- (push
- (xref-make (format elisp--xref-format type symbol)
- loc)
- lst))))
- lst)))
+ ;; The file name is not known when `symbol' is defined via interactive eval.
+ (let (xrefs)
+ ;; alphabetical by result type symbol
+
+ ;; FIXME: advised function; list of advice functions
+
+ ;; FIXME: aliased variable
+
+ (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)
+ (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.
+ (push (elisp--xref-make-xref nil symbol (help-C-file-name (symbol-function symbol) 'subr)) xrefs))
+
+ ((setq generic (cl--generic symbol))
+ (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-cl-defmethod 'cl-defmethod symbol (nth 1 info)))
+ (file (find-lisp-object-file-name met-name 'cl-defmethod)))
+ (when file
+ (push (elisp--xref-make-xref 'cl-defmethod met-name file descr) xrefs))
+ ))
+
+ (let ((descr (format elisp--xref-format 'cl-defgeneric symbol)))
+ (push (elisp--xref-make-xref nil symbol file descr) xrefs))
+ )
+
+ (t
+ (push (elisp--xref-make-xref nil symbol file) xrefs))
+ ))))
+
+ (when (boundp symbol)
+ (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))))
+
+ (when (featurep symbol)
+ (let ((file (ignore-errors
+ (find-library-name (symbol-name symbol)))))
+ (when file
+ (push (elisp--xref-make-xref 'feature symbol file) xrefs))))
+
+ xrefs))
(declare-function project-search-path "project")
(declare-function project-current "project")
(cl-defmethod xref-location-marker ((l xref-elisp-location))
(pcase-let (((cl-struct xref-elisp-location symbol type file) l))
- (let ((buffer-point
- (pcase type
- (`defun (find-function-search-for-symbol symbol nil file))
- ((or `defvar `defface)
- (find-function-search-for-symbol symbol type file))
- (`feature
- (cons (find-file-noselect file) 1)))))
+ (let ((buffer-point (find-function-search-for-symbol symbol type file)))
(with-current-buffer (car buffer-point)
(goto-char (or (cdr buffer-point) (point-min)))
(point-marker)))))
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Dmitry Gutov <dgutov@yandex.ru>
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
;; This file is part of GNU Emacs.
(should (member "backup-buffer" comps))
(should-not (member "backup-inhibited" comps)))))
-;;; Navigation
+;;; xref
-(ert-deftest elisp-xref-finds-both-function-and-variable ()
- ;; "system-name" is both: a variable and a function
- (let ((defs (elisp-xref-find 'definitions "system-name")))
- (should (= (length defs) 2))
- (should (string= (xref-item-summary (nth 0 defs))
- "(defun system-name)"))
- (should (string= (xref-item-summary (nth 1 defs))
- "(defvar system-name)")))
+(defun xref-elisp-test-descr-to-target (xref)
+ "Return an appropiate `looking-at' match string for XREF."
+ (let* ((loc (xref-item-location xref))
+ (type (or (xref-elisp-location-type loc)
+ 'defun)))
+
+ (cl-case type
+ (defalias
+ ;; summary: "(defalias xref)"
+ ;; target : "(defalias 'xref)"
+ (concat "(defalias '" (substring (xref-item-summary xref) 10 -1)))
+
+ (defun
+ (let ((summary (xref-item-summary xref))
+ (file (xref-elisp-location-file loc)))
+ (cond
+ ((string= "c" (file-name-extension file))
+ ;; summary: "(defun buffer-live-p)"
+ ;; target : "DEFUN (buffer-live-p"
+ (concat
+ (upcase (substring summary 1 6))
+ " (\""
+ (substring summary 7 -1)
+ "\""))
+
+ (t
+ (substring summary 0 -1))
+ )))
+
+ (defvar
+ (let ((summary (xref-item-summary xref))
+ (file (xref-elisp-location-file loc)))
+ (cond
+ ((string= "c" (file-name-extension file))
+ ;; summary: "(defvar system-name)"
+ ;; target : "DEFVAR_LISP ("system-name", "
+ ;; summary: "(defvar abbrev-mode)"
+ ;; target : DEFVAR_PER_BUFFER ("abbrev-mode"
+ (concat
+ (upcase (substring summary 1 7))
+ (if (bufferp (variable-binding-locus (xref-elisp-location-symbol loc)))
+ "_PER_BUFFER (\""
+ "_LISP (\"")
+ (substring summary 8 -1)
+ "\""))
+
+ (t
+ (substring summary 0 -1))
+ )))
+
+ (feature
+ ;; summary: "(feature xref)"
+ ;; target : "(provide 'xref)"
+ (concat "(provide '" (substring (xref-item-summary xref) 9 -1)))
+
+ (otherwise
+ (substring (xref-item-summary xref) 0 -1))
+ )))
+
+
+(defmacro xref-elisp-test (name computed-xrefs expected-xrefs)
+ "Define an ert test for an xref-elisp feature.
+COMPUTED-XREFS and EXPECTED-XREFS are lists of xrefs, except if
+an element of EXPECTED-XREFS is a cons (XREF . TARGET), TARGET is
+matched to the found location; otherwise, match
+to (xref-elisp-test-descr-to-target xref)."
+ (declare (indent defun))
+ (declare (debug (symbolp "name")))
+ `(ert-deftest ,(intern (concat "xref-elisp-test-" (symbol-name name))) ()
+ (let ((xrefs ,computed-xrefs)
+ (expecteds ,expected-xrefs))
+ (while xrefs
+ (let ((xref (pop xrefs))
+ (expected (pop expecteds)))
+
+ (should (equal xref
+ (or (when (consp expected) (car expected)) expected)))
+
+ (xref--goto-location (xref-item-location xref))
+ (should (looking-at (or (when (consp expected) (cdr expected))
+ (xref-elisp-test-descr-to-target expected)))))
+ ))
+ ))
+
+;; 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"))
+
+;; alphabetical by test name
+
+;; FIXME: autoload
+
+;; FIXME: defalias-defun-c cmpl-prefix-entry-head
+;; FIXME: defalias-defvar-el allout-mode-map
+
+(xref-elisp-test find-defs-defalias-defun-el
+ (elisp--xref-find-definitions 'Buffer-menu-sort)
+ (list
+ (xref-make "(defalias Buffer-menu-sort)"
+ (xref-make-elisp-location
+ 'Buffer-menu-sort 'defalias
+ (expand-file-name "../../lisp/buff-menu.elc" emacs-test-dir)))
+ (xref-make "(defun tabulated-list-sort)"
+ (xref-make-elisp-location
+ 'tabulated-list-sort nil
+ (expand-file-name "../../lisp/emacs-lisp/tabulated-list.el" emacs-test-dir)))
+ ))
+
+;; FIXME: defconst
+
+(xref-elisp-test 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
+ (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-location-marker xref-elisp-location) 'cl-defmethod
+ (expand-file-name "../../lisp/progmodes/elisp-mode.el" emacs-test-dir)))
+ (xref-make "(cl-defmethod xref-location-marker ((l xref-file-location)))"
+ (xref-make-elisp-location
+ '(xref-location-marker xref-file-location) 'cl-defmethod
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+ (xref-make "(cl-defmethod xref-location-marker ((l xref-buffer-location)))"
+ (xref-make-elisp-location
+ '(xref-location-marker xref-buffer-location) 'cl-defmethod
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+ (xref-make "(cl-defmethod xref-location-marker ((l xref-bogus-location)))"
+ (xref-make-elisp-location
+ '(xref-location-marker xref-bogus-location) 'cl-defmethod
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+ (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)))
+ ))
+
+;; FIXME: constructor xref-make-elisp-location; location is
+;; cl-defstruct location. use :constructor in description.
+
+(xref-elisp-test find-defs-defgeneric-eval
+ (elisp--xref-find-definitions (eval '(cl-defgeneric stephe-leake-cl-defgeneric ())))
+ nil)
+
+(xref-elisp-test find-defs-defun-el
+ (elisp--xref-find-definitions 'xref-find-definitions)
+ (list
+ (xref-make "(defun xref-find-definitions)"
+ (xref-make-elisp-location
+ 'xref-find-definitions nil
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))))
+
+(xref-elisp-test find-defs-defun-eval
+ (elisp--xref-find-definitions (eval '(defun stephe-leake-defun ())))
+ nil)
+
+(xref-elisp-test find-defs-defun-c
+ (elisp--xref-find-definitions 'buffer-live-p)
+ (list
+ (xref-make "(defun buffer-live-p)"
+ (xref-make-elisp-location 'buffer-live-p nil "src/buffer.c"))))
+
+;; FIXME: deftype
+
+(xref-elisp-test find-defs-defun-c-defvar-c
+ (elisp-xref-find 'definitions "system-name")
+ (list
+ (xref-make "(defvar system-name)"
+ (xref-make-elisp-location 'system-name 'defvar "src/editfns.c"))
+ (xref-make "(defun system-name)"
+ (xref-make-elisp-location 'system-name nil "src/editfns.c")))
+ )
+
+(xref-elisp-test find-defs-defun-el-defvar-c
+ (elisp-xref-find 'definitions "abbrev-mode")
;; It's a minor mode, but the variable is defined in buffer.c
- (let ((defs (elisp-xref-find 'definitions "abbrev-mode")))
- (should (= (length defs) 2))))
-
-(ert-deftest elisp-xref-finds-only-function-for-minor-mode ()
- ;; Both variable and function are defined in the same place.
- (let ((defs (elisp-xref-find 'definitions "visible-mode")))
- (should (= (length defs) 1))
- (should (string= (xref-item-summary (nth 0 defs))
- "(defun visible-mode)"))))
+ (list
+ (xref-make "(defvar abbrev-mode)"
+ (xref-make-elisp-location 'abbrev-mode 'defvar "src/buffer.c"))
+ (cons
+ (xref-make "(defun abbrev-mode)"
+ (xref-make-elisp-location
+ 'abbrev-mode nil
+ (expand-file-name "../../lisp/abbrev.el" emacs-test-dir)))
+ "(define-minor-mode abbrev-mode"))
+ )
+
+;; 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.
+(xref-elisp-test find-defs-defun-defvar-el
+ (elisp--xref-find-definitions 'compilation-minor-mode)
+ (list
+ (cons
+ (xref-make "(defun compilation-minor-mode)"
+ (xref-make-elisp-location
+ 'compilation-minor-mode nil
+ (expand-file-name "../../lisp/progmodes/compile.el" emacs-test-dir)))
+ "(define-minor-mode compilation-minor-mode")
+ (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")
+ )
+ )
+
+(xref-elisp-test find-defs-defvar-el
+ (elisp--xref-find-definitions 'xref--marker-ring)
+ ;; This is a defconst, which creates an alias and a variable.
+ ;; FIXME: try not to show the alias in this case
+ (list
+ (xref-make "(defvar xref--marker-ring)"
+ (xref-make-elisp-location
+ 'xref--marker-ring 'defvar
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))
+ (cons
+ (xref-make "(defalias xref--marker-ring)"
+ (xref-make-elisp-location
+ 'xref--marker-ring 'defalias
+ (expand-file-name "../../lisp/progmodes/xref.elc" emacs-test-dir)))
+ "(defvar xref--marker-ring")
+ ))
+
+(xref-elisp-test find-defs-defvar-c
+ (elisp--xref-find-definitions 'default-directory)
+ (list
+ (cons
+ (xref-make "(defvar default-directory)"
+ (xref-make-elisp-location 'default-directory 'defvar "src/buffer.c"))
+ ;; IMPROVEME: we might be able to compute this target
+ "DEFVAR_PER_BUFFER (\"default-directory\"")))
+
+(xref-elisp-test find-defs-defvar-eval
+ (elisp--xref-find-definitions (eval '(defvar stephe-leake-defvar nil)))
+ nil)
+
+(xref-elisp-test find-defs-face-el
+ (elisp--xref-find-definitions 'font-lock-keyword-face)
+ ;; 'font-lock-keyword-face is both a face and a var
+ ;; defface creates both a face and an alias
+ ;; FIXME: try to not show the alias in this case
+ (list
+ (xref-make "(defvar font-lock-keyword-face)"
+ (xref-make-elisp-location
+ 'font-lock-keyword-face 'defvar
+ (expand-file-name "../../lisp/font-lock.el" emacs-test-dir)))
+ (xref-make "(defface font-lock-keyword-face)"
+ (xref-make-elisp-location
+ 'font-lock-keyword-face 'defface
+ (expand-file-name "../../lisp/font-lock.el" emacs-test-dir)))
+ (cons
+ (xref-make "(defalias font-lock-keyword-face)"
+ (xref-make-elisp-location
+ 'font-lock-keyword-face 'defalias
+ (expand-file-name "../../lisp/font-lock.elc" emacs-test-dir)))
+ "(defface font-lock-keyword-face")
+ ))
+
+(xref-elisp-test find-defs-face-eval
+ (elisp--xref-find-definitions (eval '(defface stephe-leake-defface nil "")))
+ nil)
+
+(xref-elisp-test find-defs-feature-el
+ (elisp--xref-find-definitions 'xref)
+ (list
+ (xref-make "(feature xref)"
+ (xref-make-elisp-location
+ 'xref 'feature
+ (expand-file-name "../../lisp/progmodes/xref.el" emacs-test-dir)))))
+
+(xref-elisp-test find-defs-feature-eval
+ (elisp--xref-find-definitions (eval '(provide 'stephe-leake-feature)))
+ nil)
(provide 'elisp-mode-tests)
;;; elisp-mode-tests.el ends here
projects / emacs.git / commitdiff