From a16ea87e1197208896b49f185032828bce818b85 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Fri, 6 Jan 2023 09:16:33 +0200 Subject: [PATCH] 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 b66ceb3..713a150 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 c9fdf80..9e80898 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 d2b7a29..5007254 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-repeat-forward] for next match, " "\\[sweeprolog-term-search-repeat-backward] for previous match.")))))) -- 2.39.2