New option etags-xref-prefer-current-file

* lisp/progmodes/etags.el (etags-xref-prefer-current-file):
New user option (bug#2544).
(xref-backend-definitions): Use it.

diff --git a/etc/NEWS b/etc/NEWS
index 1dd50a39bac45e07c24625a97816970db8ddf9e7..6495fd09515072f857fe93c6a872694a1c057807 100644 (file)
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -3689,6 +3689,9 @@ Emacs constructs the nondirectory part of the auto-save file name by
 applying that 'secure-hash' to the buffer file name.  This avoids any
 risk of excessively long file names.
 
+** New variable 'etags-xref-prefer-current-file' to change the order
+of definitions returned by the etags Xref backend.
+
 \f
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 

diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index ce1d8e5e620d1869be2212ad4b1ca06d7298defd..3ea1131db5851da10f7f05904bd9000e41372954 100644 (file)
--- a/lisp/progmodes/etags.el
+++ b/lisp/progmodes/etags.el
@@ -2059,6 +2059,11 @@ for \\[find-tag] (which see)."
 If you want `xref-find-definitions' to find the tagged files by their
 file name, add `tag-partial-file-name-match-p' to the list value.")
 
+(defcustom etags-xref-prefer-current-file nil
+  "Non-nil to show the matches in the current file first."
+  :type 'boolean
+  :version "28.1")
+
 ;;;###autoload
 (defun etags--xref-backend () 'etags)
 
@@ -2074,7 +2079,21 @@ file name, add `tag-partial-file-name-match-p' to the list value.")
   (find-tag--completion-ignore-case))
 
 (cl-defmethod xref-backend-definitions ((_backend (eql 'etags)) symbol)
-  (etags--xref-find-definitions symbol))
+  (let ((file (and buffer-file-name (expand-file-name buffer-file-name)))
+        (definitions (etags--xref-find-definitions symbol))
+        same-file-definitions)
+    (when (and etags-xref-prefer-current-file file)
+      (cl-delete-if
+       (lambda (definition)
+         (when (equal file
+                      (xref-location-group
+                       (xref-item-location definition)))
+           (push definition same-file-definitions)
+           t))
+       definitions)
+      (setq definitions (nconc (nreverse same-file-definitions)
+                               definitions)))
+    definitions))
 
 (cl-defmethod xref-backend-apropos ((_backend (eql 'etags)) pattern)
   (etags--xref-find-definitions (xref-apropos-regexp pattern) t))