[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog 9352e0deba 1/4: ADDED: new function sweeprolog-
From: |
ELPA Syncer |
Subject: |
[nongnu] elpa/sweeprolog 9352e0deba 1/4: ADDED: new function sweeprolog-definition-at-point |
Date: |
Sun, 2 Oct 2022 16:59:05 -0400 (EDT) |
branch: elpa/sweeprolog
commit 9352e0debab6e354d96a6820e155c0fd168c2fd0
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
ADDED: new function sweeprolog-definition-at-point
---
sweep.pl | 28 ++++++++++++++++++++++++++++
sweeprolog.el | 58 +++++++++++++++++++++++++++++++++++++++++-----------------
2 files changed, 69 insertions(+), 17 deletions(-)
diff --git a/sweep.pl b/sweep.pl
index 41b3618a1d..763bdd003b 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 36fe09aaaa..408b871d4d 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