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.

diff --git a/README.org b/README.org
index b66ceb30118792af5f9fba656c743bac4a064602..713a150154054ce0dfcaefea4fe6c6dd4c0fdbb9 100644 (file)
--- 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 c9fdf80312964273a90a5dcb89d356b464761671..9e80898476238b932af17408ac969aefb89302a9 100644 (file)
--- 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 d2b7a29ae8ea523646a524a63525f2ba49db7955..500725427c45de2f5e0fb60a8cfac9b891253f70 100644 (file)
--- 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."))))))