From 12590d7d3295c1e69628f649023e318e8b2ac7bf Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Wed, 1 Feb 2023 18:28:09 +0200
Subject: [PATCH] ENHANCED: provide exact buffer positions for cross references

* sweep.pl (reference_span/5): new predicate.
(sweep_predicate_references/2): use it to find exact character offset of
predicate references.
* sweeprolog.el (xref-backend-references): adapt accordingly.
---
 sweep.pl            | 27 +++++++++++++++++++++++----
 sweeprolog-tests.el | 22 ++++++++++++++++++++++
 sweeprolog.el       | 12 ++++++++----
 3 files changed, 53 insertions(+), 8 deletions(-)

diff --git a/sweep.pl b/sweep.pl
index 0a02caf..48a8c0d 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -316,20 +316,39 @@ sweep_module_description([M0|P], [M|[P]]) :- atom_string(M0, M).
 sweep_predicate_references(MFN, Refs) :-
     term_string(M:F/N, MFN),
     pi_head(F/N, H),
-    findall([B,Path|Line],
+    findall([B, Path, From, Len],
             (xref_called(Path0, H, B0, _, Line),
              pi_head(B1, B0),
              term_string(B1, B),
-             atom_string(Path0, Path)),
+             atom_string(Path0, Path),
+             reference_span(Path0, Line, H, From, Len)),
             Refs,
             Tail),
-    findall([B,Path|Line],
+    findall([B, Path, From, Len],
             (xref_called(Path0, M:H, B0, _, Line),
              pi_head(B1, B0),
              term_string(B1, B),
-             atom_string(Path0, Path)),
+             atom_string(Path0, Path),
+             reference_span(Path0, Line, H, From, Len)),
             Tail).
 
+:- dynamic current_reference_span/2.
+
+reference_span(Path, Line, Head, From, Len) :-
+    retractall(current_reference_span(_, _)),
+    setup_call_cleanup(prolog_open_source(Path, Stream),
+                       (   prolog_source:seek_to_line(Stream, Line),
+                           prolog_colourise_term(Stream, Path, reference_span_(Head), [])
+                       ),
+                       prolog_close_source(Stream)),
+    !,
+    current_reference_span(From, Len).
+
+reference_span_(Head, goal_term(_, Goal), Beg0, Len) :-
+    \+ \+ Head = Goal,
+    Beg is Beg0 + 1,
+    assertz(current_reference_span(Beg, Len)).
+reference_span_(_, _, _, _) :- true.
 
 sweep_predicate_location(MFN, [Path|Line]) :-
     term_string(M:F/N, MFN),
diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el
index b766af1..9dad8f4 100644
--- a/sweeprolog-tests.el
+++ b/sweeprolog-tests.el
@@ -302,6 +302,28 @@ foo(Foo) :- bar.
     (should (string= (buffer-string)
                      "foo(Baz,Bar) :- spam(Bar,Baz)."))))
 
+(ert-deftest find-references ()
+  "Tests `sweeprolog-predicate-references'."
+  (let ((temp (make-temp-file "sweeprolog-test"
+                              nil
+                              ".pl"
+                              ":- module(test_sweep_find_references, [caller/0]).
+
+caller :- callee, baz, callee.
+caller :- baz, callee, baz.
+
+callee.
+
+baz.
+"
+                              )))
+    (find-file-literally temp)
+    (sweeprolog-mode)
+    (should (equal (sweeprolog-predicate-references "test_sweep_find_references:callee/0")
+                   (list (list "caller/0" temp 63 6)
+                         (list "caller/0" temp 76 6)
+                         (list "caller/0" temp 99 6))))))
+
 (ert-deftest forward-many-holes ()
   "Tests jumping over holes with `sweeprolog-forward-hole'."
   (let ((temp (make-temp-file "sweeprolog-test"
diff --git a/sweeprolog.el b/sweeprolog.el
index 3365561..1f283d7 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -4516,10 +4516,14 @@ accordingly."
 (cl-defmethod xref-backend-references ((_backend (eql sweeprolog)) mfn)
   (let ((refs (sweeprolog-predicate-references mfn)))
     (seq-map (lambda (loc)
-               (let ((by (car loc))
-                     (path (cadr loc))
-                     (line (or (cddr loc) 1)))
-                 (xref-make by (xref-make-file-location path line 0))))
+               (let* ((by   (nth 0 loc))
+                      (file (nth 1 loc))
+                      (beg  (nth 2 loc))
+                      (buf (find-file-noselect file t)))
+                 (xref-make (format "Call from %s at line %s" by
+                                    (with-current-buffer buf
+                                      (line-number-at-pos beg t)))
+                            (xref-make-buffer-location buf beg))))
              refs)))
 
 (cl-defmethod xref-backend-apropos ((_backend (eql sweeprolog)) pattern)
-- 
2.39.2