[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[nongnu] elpa/sweeprolog a16ea87e11 1/2: ENHANCED: Support refining term
|
From: |
ELPA Syncer |
|
Subject: |
[nongnu] elpa/sweeprolog a16ea87e11 1/2: ENHANCED: Support refining term searches with arbitrary goals |
|
Date: |
Fri, 6 Jan 2023 06:00:01 -0500 (EST) |
branch: elpa/sweeprolog
commit a16ea87e1197208896b49f185032828bce818b85
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>
ENHANCED: Support refining term searches with arbitrary goals
* sweep.pl (sweep_term_search/2): extend with an extra goal argument.
* sweeprolog.el (sweeprolog-read-term): new function, similar to
read--expression but for Prolog terms rather than Elisp expressions.
(sweeprolog-term-search): use it, and prompt for goal with prefix arg.
---
README.org | 13 ++++---
sweep.pl | 56 +++++++++++++++-------------
sweeprolog.el | 115 +++++++++++++++++++++++++++++++++++++++++++++++-----------
3 files changed, 132 insertions(+), 52 deletions(-)
diff --git a/README.org b/README.org
index b66ceb3011..713a150154 100644
--- a/README.org
+++ b/README.org
@@ -1337,16 +1337,19 @@ You can search for Prolog terms matching a given search
term with the
command ~M-x sweeprolog-term-search~. This command, bound by default to
~C-c C-s~ in ~sweeprolog-mode~ buffers, prompts for a Prolog term to
search for and finds terms in the current buffer that the search term
-subsumes. For example, to find if-then-else constructs in the current
-buffer do ~C-c C-s _ -> _ ; _ RET~.
+subsumes. It highlights all matching terms in the buffer and moves
+the cursor to the beginning of the next match after point. For
+example, to find if-then-else constructs in the current buffer do ~C-c
+C-s _ -> _ ; _ RET~. You can further refine the search with an
+arbitrary Prolog goal that variables in the search term should satisfy
+by invoking ~sweeprolog-term-search~ with a prefix argument (i.e. typing
+~C-u C-c C-c~).
#+FINDEX: sweeprolog-term-search-repeat-forward
#+FINDEX: sweeprolog-term-search-repeat-backward
#+KINDEX: C-s (sweeprolog-term-search-map)
#+KINDEX: C-r (sweeprolog-term-search-map)
-All matching terms in the buffer are highlighted and the cursor moves
-to the beginning of the next match after point. Typing ~C-s~
-immediately after a successful search invokes the command
+Typing ~C-s~ immediately after a successful search invokes the command
~sweeprolog-term-search-repeat-forward~ which moves forward to the next
match. Likewise, typing ~C-r~ after a successful term search invokes
the command ~sweeprolog-term-search-repeat-backward~ which moves
diff --git a/sweep.pl b/sweep.pl
index c9fdf80312..9e80898476 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -980,53 +980,59 @@ sweep_current_functors(A0, Col) :-
),
Col).
-sweep_term_search([Path0|String], Res) :-
- term_string(Term, String),
+sweep_term_search([Path0,TermString,GoalString], Res) :-
+ term_string(Term, TermString, [variable_names(TermVarNames)]),
+ term_string(Goal, GoalString, [variable_names(GoalVarNames)]),
+ maplist({GoalVarNames}/[TermVarName]>>ignore(memberchk(TermVarName,
GoalVarNames)),
+ TermVarNames),
atom_string(Path, Path0),
setup_call_cleanup(prolog_open_source(Path, Stream),
- sweep_search_stream(Stream, Term, Res),
+ sweep_search_stream(Stream, Term, Goal, Res),
prolog_close_source(Stream)).
-sweep_search_stream(Stream, Term, Res) :-
+sweep_search_stream(Stream, Term, Goal, Res) :-
prolog_read_source_term(Stream, Term0, _, [subterm_positions(TermPos)]),
- sweep_search_stream_(Term0, TermPos, Stream, Term, Res).
+ sweep_search_stream_(Term0, TermPos, Stream, Term, Goal, Res).
-sweep_search_stream_(end_of_file, _, _, _, []) :-
+sweep_search_stream_(end_of_file, _, _, _, _, []) :-
!.
-sweep_search_stream_(Term0, TermPos, Stream, Term, Res) :-
+sweep_search_stream_(Term0, TermPos, Stream, Term, Goal, Res) :-
findall([HS|HE],
- sweep_match_term(TermPos, Term0, Term, HS, HE),
+ sweep_match_term(TermPos, Term0, Term, Goal, HS, HE),
Res,
Tail),
- sweep_search_stream(Stream, Term, Tail).
+ sweep_search_stream(Stream, Term, Goal, Tail).
-sweep_match_term(Pos, Term0, Term, From, To) :-
+sweep_match_term(Pos, Term0, Term, Goal, From, To) :-
compound(Pos),
Pos \= parentheses_term_position(_, _, _),
arg(1, Pos, From),
arg(2, Pos, To),
- subsumes_term(Term, Term0).
-sweep_match_term(brace_term_position(_, _, Arg), {Term0}, Term, From, To) :-
- sweep_match_term(Arg, Term0, Term, From, To).
-sweep_match_term(list_position(_, _, Elms, _), Term0, Term, From, To) :-
+ subsumes_term(Term, Term0),
+ \+ \+ ( Term = Term0,
+ Goal
+ ).
+sweep_match_term(brace_term_position(_, _, Arg), {Term0}, Term, Goal, From,
To) :-
+ sweep_match_term(Arg, Term0, Term, Goal, From, To).
+sweep_match_term(list_position(_, _, Elms, _), Term0, Term, Goal, From, To) :-
nth0(I, Elms, Elm),
nth0(I, Term0, Term1),
- sweep_match_term(Elm, Term1, Term, From, To).
-sweep_match_term(list_position(_, _, _, Tail), Term0, Term, From, To) :-
+ sweep_match_term(Elm, Term1, Term, Goal, From, To).
+sweep_match_term(list_position(_, _, _, Tail), Term0, Term, Goal, From, To) :-
list_tail(Term0, Term1),
- sweep_match_term(Tail, Term1, Term, From, To).
-sweep_match_term(term_position(_, _, _, _, SubPos), Term0, Term, From, To) :-
+ sweep_match_term(Tail, Term1, Term, Goal, From, To).
+sweep_match_term(term_position(_, _, _, _, SubPos), Term0, Term, Goal, From,
To) :-
nth1(I, SubPos, Sub),
arg(I, Term0, Term1),
- sweep_match_term(Sub, Term1, Term, From, To).
-sweep_match_term(dict_position(_, _, _, _, KeyValuePosList), Term0, Term,
From, To) :-
+ sweep_match_term(Sub, Term1, Term, Goal, From, To).
+sweep_match_term(dict_position(_, _, _, _, KeyValuePosList), Term0, Term,
Goal, From, To) :-
member(key_value_position(_, _, _, _, Key, _, ValuePos), KeyValuePosList),
get_dict(Key, Term0, Term1),
- sweep_match_term(ValuePos, Term1, Term, From, To).
-sweep_match_term(parentheses_term_position(_, _, ContentPos), Term0, Term,
From, To) :-
- sweep_match_term(ContentPos, Term0, Term, From, To).
-sweep_match_term(quasi_quotation_position(_, _, SyntaxTerm, SyntaxPos, _), _,
Term, From, To) :-
- sweep_match_term(SyntaxPos, SyntaxTerm, Term, From, To).
+ sweep_match_term(ValuePos, Term1, Term, Goal, From, To).
+sweep_match_term(parentheses_term_position(_, _, ContentPos), Term0, Term,
Goal, From, To) :-
+ sweep_match_term(ContentPos, Term0, Term, Goal, From, To).
+sweep_match_term(quasi_quotation_position(_, _, SyntaxTerm, SyntaxPos, _), _,
Term, Goal, From, To) :-
+ sweep_match_term(SyntaxPos, SyntaxTerm, Term, Goal, From, To).
list_tail([_|T0], T) :- nonvar(T0), T0 = [_|_], !, list_tail(T0, T).
list_tail([_|T], T).
diff --git a/sweeprolog.el b/sweeprolog.el
index d2b7a29ae8..500725427c 100644
--- a/sweeprolog.el
+++ b/sweeprolog.el
@@ -4604,7 +4604,7 @@ to the ARGth next hole in the buffer."
When enabled, this minor mode binds TAB to the command
`sweeprolog-indent-or-forward-hole', which moves to the next hole
in the buffer when the called in a line that's already indented
-propely."
+properly."
:group 'sweeprolog)
@@ -4631,15 +4631,14 @@ propely."
;;;; Term Search
-(defvar sweeprolog-term-search-last-term nil
+(defvar sweeprolog-term-search-last-search nil
"Last term searched with `sweeprolog-term-search'.")
-(defvar sweeprolog-term-search-read-term-history nil
- "History list for `sweeprolog-term-search-read-term'.")
-
(defvar-local sweeprolog-term-search-overlays nil
"List of `sweeprolog-term-search' overlays in the current buffer.")
+(defvar-local sweeprolog-term-search-repeat-count 0)
+
(defun sweeprolog-term-search-delete-overlays ()
"Delete overlays created by `sweeprolog-term-search'."
(interactive "" sweeprolog-mode)
@@ -4649,18 +4648,27 @@ propely."
(defun sweeprolog-term-search-repeat-forward ()
"Repeat last `sweeprolog-term-search' searching forward from point."
(interactive "" sweeprolog-mode)
- (sweeprolog-term-search sweeprolog-term-search-last-term))
+ (setq sweeprolog-term-search-repeat-count
+ (mod (1+ sweeprolog-term-search-repeat-count)
+ (length sweeprolog-term-search-overlays)))
+ (sweeprolog-term-search (car sweeprolog-term-search-last-search)
+ (cdr sweeprolog-term-search-last-search)))
(defun sweeprolog-term-search-repeat-backward ()
"Repeat last `sweeprolog-term-search' searching backward from point."
(interactive "" sweeprolog-mode)
- (sweeprolog-term-search sweeprolog-term-search-last-term t))
+ (setq sweeprolog-term-search-repeat-count
+ (mod (1- sweeprolog-term-search-repeat-count)
+ (length sweeprolog-term-search-overlays)))
+ (sweeprolog-term-search (car sweeprolog-term-search-last-search)
+ (cdr sweeprolog-term-search-last-search) t))
(defun sweeprolog-term-search-abort ()
"Abort term search and restore point to its original position."
(interactive "" sweeprolog-mode)
(goto-char (mark t))
(pop-mark)
+ (sweeprolog-term-search-delete-overlays)
(signal 'quit nil))
(defvar sweeprolog-term-search-map
@@ -4672,12 +4680,13 @@ propely."
map)
"Transient keymap activated after `sweeprolog-term-search'.")
-(defun sweeprolog-term-search-in-buffer (term &optional buffer)
- "Search for Prolog term TERM in buffer BUFFER.
+(defun sweeprolog-term-search-in-buffer (term &optional goal buffer)
+ "Search for Prolog term TERM satisfying GOAL in buffer BUFFER.
Return a list of (BEG . END) cons cells where BEG is the buffer
position of the beginning of a matching term and END is its
corresponding end position."
+ (setq goal (or goal "true"))
(setq buffer (or buffer (current-buffer)))
(with-current-buffer buffer
(let ((offset (point-min)))
@@ -4685,12 +4694,57 @@ corresponding end position."
(cons (+ offset (car match))
(+ offset (cdr match))))
(sweeprolog--query-once "sweep" "sweep_term_search"
- (cons buffer-file-name term))))))
+ (list buffer-file-name
+ term goal))))))
+
+(defun sweeprolog-read-term-try ()
+ "Try to read a Prolog term in the minibuffer.
+
+Exit the minibuffer if successful, else report the error to the
+user and move point to the location of the error. If point is
+not already at the location of the error, push a mark before
+moving point."
+ (interactive)
+ (unless (> (minibuffer-depth) 0)
+ (error "Minibuffer must be active"))
+ (if-let* ((contents (minibuffer-contents))
+ (error-point
+ (condition-case error
+ (progn
+ (sweeprolog--query-once "system" "term_string"
+ contents t)
+ nil)
+ (prolog-exception (pcase error
+ (`(prolog-exception
+ compound "error"
+ (compound "syntax_error" ,_)
+ (compound ,_ ,_ ,point))
+ (+ (length (minibuffer-prompt))
+ point 1)))))))
+ (progn
+ (unless (= (point) error-point)
+ (push-mark))
+ (goto-char error-point)
+ (minibuffer-message "Invalid Prolog term"))
+ (exit-minibuffer)))
+
+(defvar sweeprolog-read-term-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map minibuffer-local-map)
+ (define-key map (kbd "C-m") #'sweeprolog-read-term-try)
+ (define-key map (kbd "C-j") #'sweeprolog-read-term-try)
+ map)
+ "Keymap used by `sweeprolog-read-term'.")
+
+(defvar sweeprolog-read-term-history nil
+ "History list for `sweeprolog-read-term'.")
-(defun sweeprolog-term-search-read-term ()
- "Read a Prolog term for searching with `sweeprolog-term-search'."
- (read-string "[search] ?- " nil
- sweeprolog-term-search-read-term-history))
+(defun sweeprolog-read-term (&optional prompt)
+ (setq prompt (or prompt "?- "))
+ "Read a Prolog term using the minibuffer."
+ (read-from-minibuffer prompt nil
+ sweeprolog-read-term-map nil
+ sweeprolog-read-term-history))
(defun sweeprolog-term-search-next (point overlays backward)
"Return first overlay in OVERLAYS starting after POINT.
@@ -4705,7 +4759,7 @@ instead, or the last overlay if no overlay ends before
POINT."
(while (and reversed (not match))
(let ((head (car reversed))
(tail (cdr reversed)))
- (if (<= (overlay-end head) point)
+ (if (< (overlay-start head) point)
(setq match head)
(setq reversed tail))))
(or match first))
@@ -4719,18 +4773,33 @@ instead, or the last overlay if no overlay ends before
POINT."
(setq overlays tail))))
(or match first))))
-(defun sweeprolog-term-search (term &optional backward interactive)
+(defun sweeprolog-term-search (term &optional goal backward interactive)
"Search forward for Prolog term TERM in the current buffer.
+Optional argument GOAL is a goal that matching terms must
+satisfy, it may refer to variables occuring in TERM.
+
If BACKWARD is non-nil, search backward instead.
If INTERACTIVE is non-nil, as it is when called interactively,
-push the current position to the mark ring before moving point."
- (interactive (list (sweeprolog-term-search-read-term) nil t)
+push the current position to the mark ring before moving point.
+
+When called interactively with a prefix argument, prompt for
+GOAL."
+ (interactive (let* ((term (sweeprolog-read-term "[Term-search] ?- "))
+ (goal (if current-prefix-arg
+ (sweeprolog-read-term
+ (concat "[Term-search goal for "
+ term
+ "] ?- "))
+ "true")))
+ (list term goal nil t))
sweeprolog-mode)
+ (when interactive
+ (setq sweeprolog-term-search-repeat-count 0))
(sweeprolog-term-search-delete-overlays)
- (setq sweeprolog-term-search-last-term term)
- (let ((matches (sweeprolog-term-search-in-buffer term)))
+ (setq sweeprolog-term-search-last-search (cons term goal))
+ (let ((matches (sweeprolog-term-search-in-buffer term goal)))
(if (not matches)
(message "No matching term found.")
(setq sweeprolog-term-search-overlays
@@ -4754,8 +4823,10 @@ push the current position to the mark ring before moving
point."
(message
(substitute-command-keys
(concat
- "Found " (number-to-string (length matches))
- " occurences of `" term "'. "
+ "Match "
+ (number-to-string (1+ sweeprolog-term-search-repeat-count))
+ "/"
+ (number-to-string (length matches)) ". "
"\\<sweeprolog-term-search-map>"
"\\[sweeprolog-term-search-repeat-forward] for next match, "
"\\[sweeprolog-term-search-repeat-backward] for previous match."))))))