From: Eshel Yaron <me@eshelyaron.com>
Date: Sat, 1 Oct 2022 19:26:07 +0000 (+0300)
Subject: ADDED: new function sweeprolog-definition-at-point
X-Git-Tag: v0.5.0~14
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=9352e0debab6e354d96a6820e155c0fd168c2fd0;p=sweep.git

ADDED: new function sweeprolog-definition-at-point
---

diff --git a/sweep.pl b/sweep.pl
index 41b3618..763bdd0 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -37,6 +37,7 @@
             sweep_current_prolog_flags/2,
             sweep_set_prolog_flag/2,
             sweep_documentation/2,
+            sweep_definition_at_point/2,
             sweep_file_at_point/2,
             sweep_identifier_at_point/2,
             sweep_expand_file_name/2,
@@ -142,6 +143,33 @@ sweep_colourise_buffer_(Path0, Contents, []) :-
     erase(Ref0),
     erase(Ref1).
 
+sweep_definition_at_point([Contents|Path0], Result) :-
+    atom_string(Path, Path0),
+    with_buffer_stream(Stream,
+                       Contents,
+                       sweep_definition_at_point_(Stream, Path, Result)).
+
+:- dynamic sweep_current_defintion_at_point/1.
+
+sweep_definition_at_point_(Stream, Path, [Beg,F,N]) :-
+    set_stream(Stream, file_name(Path)),
+    retractall(sweep_current_defintion_at_point(_)),
+    prolog_colourise_term(Stream, Path,
+                          sweep_handle_definition_at_point,
+                          []),
+    sweep_current_defintion_at_point(Beg-Def),
+    (   Def = M:F0/N
+    ->  term_string(M:F0, F)
+    ;   Def = F0/N,
+        term_string(F0, F)
+    ).
+
+sweep_handle_definition_at_point(head_term(_Kind, Goal), Beg, _Len) :-
+    !,
+    pi_head(PI, Goal),
+    asserta(sweep_current_defintion_at_point(Beg-PI)).
+sweep_handle_definition_at_point(_, _, _).
+
 
 sweep_file_at_point([Contents,Path0,Point], Result) :-
     atom_string(Path, Path0),
diff --git a/sweeprolog.el b/sweeprolog.el
index 36fe09a..408b871 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -184,23 +184,25 @@ clause."
 (declare-function sweeprolog-cleanup       "sweep-module")
 
 (defun sweeprolog--ensure-module ()
-  (let ((sweep-module-path (car
-                            (save-match-data
-                              (split-string
-                               (shell-command-to-string
-                                (concat
-                                 (or sweeprolog-swipl-path (executable-find "swipl"))
-                                 " -g"
-                                 " write_sweep_module_location"
-                                 " -t"
-                                 " halt"))
-                               "\n")))))
-    (condition-case _
-        (load sweep-module-path)
-      (file-error (user-error
-                   (concat "Failed to locate `sweep-module'. "
-                           "Make sure SWI-Prolog is installed "
-                           "and up to date"))))))
+  "Locate and load `sweep-module', unless already loaded."
+  (unless (featurep 'sweep-module)
+    (let ((sweep-module-path (car
+                              (save-match-data
+                                (split-string
+                                 (shell-command-to-string
+                                  (concat
+                                   (or sweeprolog-swipl-path (executable-find "swipl"))
+                                   " -g"
+                                   " write_sweep_module_location"
+                                   " -t"
+                                   " halt"))
+                                 "\n")))))
+      (condition-case _
+          (load sweep-module-path)
+        (file-error (user-error
+                     (concat "Failed to locate `sweep-module'. "
+                             "Make sure SWI-Prolog is installed "
+                             "and up to date")))))))
 
 (defface sweeprolog-debug-prefix-face
   '((default :inherit shadow))
@@ -2144,6 +2146,28 @@ Interactively, a prefix arg means to prompt for BUFFER."
   (and (looking-at-p (rx bol graph))
        (not (nth 8 (syntax-ppss)))))
 
+(defun sweeprolog-definition-at-point (&optional point)
+  (let* ((p (or point (point)))
+         (beg (save-mark-and-excursion
+                (goto-char p)
+                (unless (sweeprolog-at-beginning-of-top-term-p)
+                  (sweeprolog-beginning-of-top-term))
+                (max (1- (point)) (point-min))))
+         (end (save-mark-and-excursion
+                (goto-char p)
+                (sweeprolog-end-of-top-term)
+                (point)))
+         (contents (buffer-substring-no-properties beg end)))
+    (sweeprolog-open-query "user"
+                           "sweep"
+                           "sweep_definition_at_point"
+                           (cons contents
+                                 (buffer-file-name)))
+    (let ((sol (sweeprolog-next-solution)))
+      (sweeprolog-close-query)
+      (when (sweeprolog-true-p sol)
+        (cons (+ beg (cadr sol)) (cddr sol))))))
+
 (defun sweeprolog-file-at-point (&optional point)
   (let* ((p (or point (point)))
          (beg (save-mark-and-excursion