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.

1 files changed, 98 insertions, 0 deletions

diff --git a/lisp/cedet/mode-local.el b/lisp/cedet/mode-local.el
index ce30a985a79..9ee875022f8 100644
--- a/lisp/cedet/mode-local.el
+++ b/lisp/cedet/mode-local.el
@@ -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."