1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

Add mode local overrides to xref-find-definitions

* lisp/cedet/mode-local.el (xref-mode-local--override-present,
xref-mode-local-overload): New; add mode local overrides to
xref-find-definitions.

* test/automated/elisp-mode-tests.el: Add mode local override tests.
(xref-elisp-test-run): Handle indented defuns.
(xref-elisp-generic-*): Improve doc strings.

* lisp/progmodes/elisp-mode.el (elisp-xref-find-def-functions): New.
(elisp--xref-find-definitions): Use it.
This commit is contained in:
Stephen Leake 2015-08-26 16:43:29 -05:00
parent 2e8750c769
commit 64fbdc9825
4 changed files with 349 additions and 138 deletions

View file

@ -48,6 +48,13 @@
(eval-when-compile (require 'cl))
(require 'find-func)
;; For find-function-regexp-alist. It is tempting to replace this
;; require by (defvar find-function-regexp-alist) and
;; with-eval-after-load, but model-local.el is typically loaded when a
;; semantic autoload is invoked, and something in semantic loads
;; find-func.el before mode-local.el, so the eval-after-load is lost.
;;; Misc utilities
;;
(defun mode-local-map-file-buffers (function &optional predicate buffers)
@ -649,6 +656,97 @@ SYMBOL is a function that can be overridden."
(add-hook 'help-fns-describe-function-functions 'describe-mode-local-overload)
(declare-function xref-item-location "xref" (xref))
(defun xref-mode-local--override-present (sym xrefs)
"Return non-nil if SYM is in XREFS."
(let (result)
(while (and (null result)
xrefs)
(when (equal sym (car (xref-elisp-location-symbol (xref-item-location (pop xrefs)))))
(setq result t)))
result))
(defun xref-mode-local-overload (symbol)
"For elisp-xref-find-def-functions; add overloads for SYMBOL."
;; Current buffer is the buffer where xref-find-definitions was invoked.
(when (get symbol 'mode-local-overload)
(let* ((symbol-file (find-lisp-object-file-name symbol (symbol-function symbol)))
(default (intern-soft (format "%s-default" (symbol-name symbol))))
(default-file (when default (find-lisp-object-file-name default (symbol-function default))))
modes
xrefs)
(mapatoms
(lambda (sym) (when (get sym 'mode-local-symbol-table) (push sym modes)))
obarray)
;; mode-local-overrides are inherited from parent modes; we
;; don't want to list the same function twice. So order modes
;; with parents first, and check for duplicates.
(setq modes
(sort modes
(lambda (a b)
(not (equal b (get a 'mode-local-parent)))))) ;; a is not a child, or not a child of b
(dolist (mode modes)
(let* ((major-mode mode)
(override (fetch-overload symbol))
(override-file (when override (find-lisp-object-file-name override (symbol-function override)))))
(when (and override override-file)
(let ((meta-name (cons override major-mode))
;; For the declaration:
;;
;;(define-mode-local-override xref-elisp-foo c-mode
;;
;; The override symbol name is
;; "xref-elisp-foo-c-mode". The summary should match
;; the declaration, so strip the mode from the
;; symbol name.
(summary (format elisp--xref-format-extra
'define-mode-local-override
(substring (symbol-name override) 0 (- (1+ (length (symbol-name major-mode)))))
major-mode)))
(unless (xref-mode-local--override-present override xrefs)
(push (elisp--xref-make-xref
'define-mode-local-override meta-name override-file summary)
xrefs))))))
;; %s-default is interned whether it is a separate function or
;; not, so we have to check that here.
(when (and (functionp default) default-file)
(push (elisp--xref-make-xref nil default default-file) xrefs))
(when symbol-file
(push (elisp--xref-make-xref 'define-overloadable-function symbol symbol-file) xrefs))
xrefs)))
(add-hook 'elisp-xref-find-def-functions 'xref-mode-local-overload)
(defconst xref-mode-local-find-overloadable-regexp
"(\\(\\(define-overloadable-function\\)\\|\\(define-overload\\)\\) +%s"
"Regexp used by xref-find-definitions when searching for a
mode-local overloadable function definition.")
(defun xref-mode-local-find-override (meta-name)
"Function used by xref-find-definitions when searching for an
override of a mode-local overloadable function.
META-NAME is a cons (OVERLOADABLE-SYMBOL . MAJOR-MODE)."
(let* ((override (car meta-name))
(mode (cdr meta-name))
(regexp (format "(define-mode-local-override +%s +%s"
(substring (symbol-name override) 0 (- (1+ (length (symbol-name mode)))))
mode)))
(re-search-forward regexp nil t)
))
(add-to-list 'find-function-regexp-alist '(define-overloadable-function . xref-mode-local-find-overloadable-regexp))
(add-to-list 'find-function-regexp-alist (cons 'define-mode-local-override #'xref-mode-local-find-override))
;; Help for mode-local bindings.
(defun mode-local-print-binding (symbol)
"Print the SYMBOL binding."