master d5a2fde: New option etags-xref-prefer-current-file

[Dmitry Gutov]

branch: master
commit d5a2fdeefb819dbb44b9e98794d6e4f85f8e1db2
Author: Dmitry Gutov <dgutov@yandex.ru>
Commit: Dmitry Gutov <dgutov@yandex.ru>

    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.
---
 etc/NEWS                |  3 +++
 lisp/progmodes/etags.el | 21 ++++++++++++++++++++-
 2 files changed, 23 insertions(+), 1 deletion(-)

diff --git a/etc/NEWS b/etc/NEWS
index 1dd50a3..6495fd0 100644
--- 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.
+
 
 * Changes in Emacs 28.1 on Non-Free Operating Systems
 
diff --git a/lisp/progmodes/etags.el b/lisp/progmodes/etags.el
index ce1d8e5..3ea1131 100644
--- 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))