* sweep.pl (sweep_terms_at_point/2): new predicate.
* sweeprolog.el (sweeprolog-terms-at-point): new function.
(sweeprolog-read-term): use it for setting the future history.
(sweeprolog-read-goal): new function.
(sweeprolog-term-search): use it for reading a goal when called with
prefix argument.
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~).
+C-s _ -> _ ; _ RET~.
+
+While prompting for a search term in the minibuffer, this command
+populates the "future history" with the Prolog terms at point, with
+the most nested term at point on top. Typing ~M-n~ once in the
+minibuffer fills it the innermost term at point, typing ~M-n~ again
+cycles up the syntax tree at point filling the minibuffer with larger
+terms, up until the top-term at point. For more information about
+minibuffer history commands, see [[info:emacs#Minibuffer History][Minibuffer History]] in the Emacs
+manual.
+
+If you invoke ~sweeprolog-term-search~ with a prefix argument, e.g. by
+typing ~C-u C-c C-c~, you can further refine the search with an
+arbitrary Prolog goal for filtering out search results that fail it.
+The given goal runs for each matching term, it may use variables from
+the search term to refer to subterms of the matching term.
#+FINDEX: sweeprolog-term-search-repeat-forward
#+FINDEX: sweeprolog-term-search-repeat-backward
~help-echo~ property that says what kind of token this is, to expose
the precise semantics of each token to the user.
-- Add a command for interactively inserting a new predicate :: ~sweeprolog-mode~
- should provide a command for interactively inserting a new predicate
- definition, ideally with optional =PlDoc= comments (see [[#sweeprolog-pldoc][Documenting
- predicates]]).
-
- Make predicate completion aware of module-qualification :: predicate
completion should detect when the prefix it's trying to complete
starts with a module-qualification ~foo:ba<|>~ and restrict completion
sweep_format_head/2,
sweep_format_term/2,
sweep_current_functors/2,
- sweep_term_search/2
+ sweep_term_search/2,
+ sweep_terms_at_point/2
]).
:- use_module(library(pldoc)).
list_tail([_|T0], T) :- nonvar(T0), T0 = [_|_], !, list_tail(T0, T).
list_tail([_|T], T).
+
+sweep_terms_at_point([String, Start, Point], Res) :-
+ ( sweep_source_id(Path0),
+ atom_string(Path, Path0),
+ findall(Op, xref_op(Path, Op), Ops),
+ ( xref_module(Path, Module)
+ -> true
+ ; Module = user
+ )
+ -> true
+ ; Module = user, Ops = []
+ ),
+ with_buffer_stream(
+ Stream,
+ String,
+ ( ignore(( nonvar(Path),
+ set_stream(Stream, file_name(Path))
+ )),
+ read_source_term_at_location(Stream, _,
+ [module(Module),
+ operators(Ops),
+ subterm_positions(SubPos)]),
+ findall([Beg|End],
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End),
+ Res)
+ )).
+
+sweep_terms_at_point_(SubPos, Start, Point, Beg, End) :-
+ SubPos \= parentheses_term_position(_, _, _),
+ arg(1, SubPos, Beg0),
+ arg(2, SubPos, End0),
+ Beg0 =< Point,
+ Point =< End0,
+ Beg is Beg0 + Start,
+ End is End0 + Start.
+sweep_terms_at_point_(list_position(_, _, Elms, _), Start, Point, Beg, End) :-
+ member(SubPos, Elms),
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
+sweep_terms_at_point_(list_position(_, _, _, SubPos), Start, Point, Beg, End) :-
+ SubPos \== none,
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
+sweep_terms_at_point_(term_position(_, _, _, _, Args), Start, Point, Beg, End) :-
+ member(SubPos, Args),
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
+sweep_terms_at_point_(dict_position(_, _, _, _, KeyValuePosList), Start, Point, Beg, End) :-
+ member(key_value_position(_, _, _, _, _, _, SubPos), KeyValuePosList),
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
+sweep_terms_at_point_(parentheses_term_position(_, _, SubPos), Start, Point, Beg, End) :-
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
+sweep_terms_at_point_(quasi_quotation_position(_, _, _, SubPos, _), Start, Point, Beg, End) :-
+ sweep_terms_at_point_(SubPos, Start, Point, Beg, End).
(should (not (sweeprolog-beginning-of-next-top-term)))
(should (= (point) 19))))
-(ert-deftest beginning-of-next-top-term ()
+(ert-deftest terms-at-point ()
+ "Test `sweeprolog-term-search'."
+ (let ((temp (make-temp-file "sweeprolog-terms-at-point-test"
+ nil
+ "pl"
+ "
+recursive(Var) :-
+ ( true
+ -> recursive(Bar)
+ ; var(Baz)
+ *-> Bar is foo
+ ).
+")))
+ (find-file-literally temp)
+ (sweeprolog-mode)
+ (should (equal (sweeprolog-terms-at-point 81)
+ '("Bar"
+ "Bar is foo"
+ "var(Baz)
+ *-> Bar is foo" "true
+ -> recursive(Bar)
+ ; var(Baz)
+ *-> Bar is foo"
+ "recursive(Var) :-
+ ( true
+ -> recursive(Bar)
+ ; var(Baz)
+ *-> Bar is foo
+ )")))))
+
+(ert-deftest term-search ()
"Test `sweeprolog-term-search'."
(let ((temp (make-temp-file "sweeprolog-test"
nil
`sweeprolog-top-level-signal-default-goal'."
(interactive (list (if current-prefix-arg
(read-string "Signal goal: ?- " nil
- sweeprolog-top-level-signal-goal-history)
+ 'sweeprolog-top-level-signal-goal-history)
sweeprolog-top-level-signal-default-goal)))
(sweeprolog-signal-thread sweeprolog-top-level-thread-id goal))
;;;; Help
+;;;###autoload
(defun sweeprolog-info-manual ()
"Display the Sweep manual in Info mode."
(interactive)
map)
"Keymap used by `sweeprolog-read-term'.")
+(defun sweeprolog-terms-at-point (&optional point)
+ "Return boundarines of Prolog terms at POINT, innermost first."
+ (setq point (or point (point)))
+ (save-excursion
+ (goto-char point)
+ (unless (sweeprolog-at-beginning-of-top-term-p)
+ (sweeprolog-beginning-of-top-term))
+ (unless (bobp)
+ (forward-char -1))
+ (let ((start (point)))
+ (sweeprolog-end-of-top-term)
+ (mapcar (lambda (beg-end)
+ (buffer-substring-no-properties (car beg-end)
+ (cdr beg-end)))
+ (reverse
+ (sweeprolog--query-once "sweep" "sweep_terms_at_point"
+ (list
+ (buffer-substring-no-properties
+ start (point))
+ start
+ (- point start))))))))
+
(defvar sweeprolog-read-term-history nil
"History list for `sweeprolog-read-term'.")
+(defvar sweeprolog-read-goal-history nil
+ "History list for `sweeprolog-read-goal'.")
+
(defun sweeprolog-read-term (&optional prompt)
+ "Read a Prolog term prompting with PROMPT (default \"?- \")."
+ (setq prompt (or prompt "?- "))
+ (read-from-minibuffer prompt nil
+ sweeprolog-read-term-map nil
+ 'sweeprolog-read-term-history
+ (when (derived-mode-p 'sweeprolog-mode)
+ (sweeprolog-terms-at-point))))
+
+(defun sweeprolog-read-goal (&optional prompt)
+ "Read a Prolog goal prompting with PROMPT (default \"?- \")."
(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))
+ 'sweeprolog-read-goal-history))
(defun sweeprolog-term-search-next (point overlays backward)
"Return first overlay in OVERLAYS starting after POINT.
GOAL."
(interactive (let* ((term (sweeprolog-read-term "[Term-search] ?- "))
(goal (if current-prefix-arg
- (sweeprolog-read-term
+ (sweeprolog-read-goal
(concat "[Term-search goal for "
term
"] ?- "))
"\\[sweeprolog-term-search-repeat-forward] for next match, "
"\\[sweeprolog-term-search-repeat-backward] for previous match."))))))
+
;;;; Footer
(provide 'sweeprolog)
projects / sweep.git / commitdiff