From: Eshel Yaron <me@eshelyaron.com>
Date: Mon, 5 Sep 2022 16:26:40 +0000 (+0300)
Subject: ADDED: prepare xref backend
X-Git-Tag: v0.2.0~32
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=d974b0fe0a6ba4f2ac033ba870d165d7b23aef45;p=sweep.git

ADDED: prepare xref backend
---

diff --git a/sweep.el b/sweep.el
index 69fdac0..9603c17 100644
--- a/sweep.el
+++ b/sweep.el
@@ -987,6 +987,52 @@ Interactively, a prefix arg means to prompt for BUFFER."
             (string-to-syntax "w")))))
      start end)))
 
+
+(defun sweep-identifier-at-point (&optional point)
+  (let* ((p (or point (point)))
+         (beg (save-mark-and-excursion
+                (goto-char p)
+                (sweep-beginning-of-top-term)
+                (point)))
+         (end (save-mark-and-excursion
+                (goto-char p)
+                (sweep-end-of-top-term)
+                (point)))
+         (contents (buffer-substring-no-properties beg end)))
+    (sweep-open-query "user"
+                      "sweep"
+                      "sweep_identifier_at_point"
+                      (list contents
+                            (buffer-file-name)
+                            (- p beg)))
+    (let ((sol (sweep-next-solution)))
+      (sweep-close-query)
+      (when (sweep-true-p sol)
+        (cdr sol)))))
+
+;;;###autoload
+(defun sweep--xref-backend ()
+  "Hook for `xref-backend-functions'."
+  'sweep)
+
+
+(cl-defmethod xref-backend-identifier-at-point ((_backend (eql 'sweep)))
+  (sweep-identifier-at-point))
+
+(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql 'sweep)))
+  (sweep-identifier-completion-table))
+
+(cl-defmethod xref-backend-identifier-completion-ignore-case ((_backend (eql 'sweep)))
+  "Case is always significant for Prolog identifiers, so return nil."
+  nil)
+
+(cl-defmethod xref-backend-definitions ((_backend (eql 'sweep)) symbol))
+
+(cl-defmethod xref-backend-references ((_backend (eql 'sweep)) symbol))
+
+(cl-defmethod xref-backend-apropos ((_backend (eql 'sweep)) pattern))
+
+
 ;;;###autoload
 (define-derived-mode sweep-mode prog-mode "sweep"
   "Major mode for reading and editing Prolog code."
@@ -1007,6 +1053,7 @@ Interactively, a prefix arg means to prompt for BUFFER."
                 (font-lock-fontify-region-function . sweep-colourise-some-terms)))
   (sweep-colourise-buffer)
   (sweep--set-buffer-module)
+  (add-hook 'xref-backend-functions #'sweep--xref-backend nil t)
   (add-hook 'completion-at-point-functions #'sweep-completion-at-point-function nil t))
 
 ;;;; Testing:
diff --git a/sweep.pl b/sweep.pl
index a9836c6..61583c6 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -34,6 +34,7 @@
           [ sweep_colourise_buffer/2,
             sweep_colourise_some_terms/2,
             sweep_documentation/2,
+            sweep_identifier_at_point/2,
             sweep_expand_file_name/2,
             sweep_path_module/2,
             sweep_predicate_location/2,
@@ -103,6 +104,60 @@ sweep_colourise_buffer_(Path0, Contents, []) :-
     erase(Ref0),
     erase(Ref1).
 
+
+sweep_identifier_at_point([Contents0, Path, Point], Identifier) :-
+    setup_call_cleanup(( new_memory_file(H),
+                         insert_memory_file(H, 0, Contents0),
+                         open_memory_file(H, read, Contents, [encoding(utf8)])
+                       ),
+                       sweep_identifier_at_point_(Path, Point, Contents, Identifier),
+                       ( close(Contents),
+                         free_memory_file(H)
+                       )).
+
+:- dynamic sweep_current_identifier_at_point/1.
+
+
+sweep_identifier_at_point_(Path0, Point, Contents, Identifier) :-
+    atom_string(Path, Path0),
+    (   xref_module(Path, M)
+    ->  true
+    ;   M = user
+    ),
+    set_stream(Contents, encoding(utf8)),
+    set_stream(Contents, file_name(Path)),
+    seek(Contents, 0, bof, _),
+    retractall(sweep_current_identifier_at_point(_)),
+    prolog_colourise_term(Contents, Path,
+                          sweep_handle_identifier_at_point(Path, M, Point),
+                          []),
+    sweep_current_identifier_at_point(Identifier0),
+    term_string(Identifier0, Identifier).
+
+
+sweep_handle_identifier_at_point(Path, M, Point, Col, Beg, Len) :-
+    Beg =< Point,
+    Point =< Beg + Len,
+    !,
+    sweep_handle_identifier_at_point_(Path, M, Col).
+sweep_handle_identifier_at_point(_, _, _, _, _, _).
+
+sweep_handle_identifier_at_point_(Path, M0, goal_term(_Kind, Goal)) :-
+    !,
+    pi_head(PI0, Goal),
+    (   PI0 = M:PI
+    ->  true
+    ;   xref_defined(Path, Goal, imported(Other)), xref_module(Other, M)
+    ->  PI = PI0
+    ;   predicate_property(M0:Goal, imported_from(M))
+    ->  PI = PI0
+    ;   '$autoload':library_index(Goal, M, _)
+    ->  PI = PI0
+    ;   M = M0, PI = PI0
+    ),
+    asserta(sweep_current_identifier_at_point(M:PI)).
+sweep_handle_identifier_at_point_(_, _, _).
+
 sweep_colourise_some_terms([String,Path,Offset], Colors) :-
     setup_call_cleanup(( new_memory_file(H),
                          insert_memory_file(H, 0, String),