* sweep.pl (sweep_term_search/2): new predicate.
* sweeprolog.el (sweeprolog-term-search-in-buffer): new function.
(sweeprolog-term-search): new command.
* README.org ("Term Search"): new manual section.
diagnosing implicit autoloads, customize the user option
~sweeprolog-note-implicit-autoloads~ to nil.
+** Term Search
+:PROPERTIES:
+:CUSTOM_ID: term-search
+:DESCRIPTION: Search for Prolog terms matching with a given structure
+:ALT_TITLE: Term Search
+:END:
+
+#+FINDEX: sweeprolog-term-search
+#+KINDEX: C-c C-s
+#+CINDEX: term search
+#+CINDEX: search term
+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~.
+
+#+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
+~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
+backward to the previous match.
+
* Prolog Help
:PROPERTIES:
:CUSTOM_ID: prolog-help
sweep_file_missing_dependencies/2,
sweep_format_head/2,
sweep_format_term/2,
- sweep_current_functors/2
+ sweep_current_functors/2,
+ sweep_term_search/2
]).
:- use_module(library(pldoc)).
atom_string(F0, F)
),
Col).
+
+sweep_term_search([Path0|String], Res) :-
+ term_string(Term, String),
+ atom_string(Path, Path0),
+ setup_call_cleanup(prolog_open_source(Path, Stream),
+ sweep_search_stream(Stream, Term, Res),
+ prolog_close_source(Stream)).
+
+sweep_search_stream(Stream, Term, Res) :-
+ prolog_read_source_term(Stream, Term0, _, [subterm_positions(TermPos)]),
+ sweep_search_stream_(Term0, TermPos, Stream, Term, Res).
+
+sweep_search_stream_(end_of_file, _, _, _, []) :-
+ !.
+sweep_search_stream_(Term0, TermPos, Stream, Term, Res) :-
+ findall([HS|HE],
+ sweep_match_term(TermPos, Term0, Term, HS, HE),
+ Res,
+ Tail),
+ sweep_search_stream(Stream, Term, Tail).
+
+sweep_match_term(Pos, Term0, Term, 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) :-
+ 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) :-
+ list_tail(Term0, Term1),
+ sweep_match_term(Tail, Term1, Term, From, To).
+sweep_match_term(term_position(_, _, _, _, SubPos), Term0, Term, 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) :-
+ 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).
+
+list_tail([_|T0], T) :- T0 = [_|_], !, list_tail(T0, T).
+list_tail([_|T], T).
(should (not (sweeprolog-beginning-of-next-top-term)))
(should (= (point) 19))))
+(ert-deftest beginning-of-next-top-term ()
+ "Test `sweeprolog-term-search'."
+ (let ((temp (make-temp-file "sweeprolog-test"
+ nil
+ "pl"
+ "
+bar(bar(bar), bar{bar:bar}, [bar,bar|bar]).
+")))
+ (find-file-literally temp)
+ (sweeprolog-mode)
+ (goto-char (point-min))
+ (sweeprolog-term-search "bar")
+ (should (= (point) 10))
+ (sweeprolog-term-search "bar")
+ (should (= (point) 24))
+ (sweeprolog-term-search "bar")
+ (should (= (point) 31))
+ (sweeprolog-term-search "bar")
+ (should (= (point) 35))
+ (sweeprolog-term-search "bar")
+ (should (= (point) 39))))
+
(ert-deftest beginning-of-next-top-term-header ()
"Test finding the beginning of the first top term."
(let ((temp (make-temp-file "sweeprolog-test"
(define-key map (kbd "C-c C-l") #'sweeprolog-load-buffer)
(define-key map (kbd "C-c C-m") #'sweeprolog-insert-term-with-holes)
(define-key map (kbd "C-c C-o") #'sweeprolog-find-file-at-point)
+ (define-key map (kbd "C-c C-s") #'sweeprolog-term-search)
(define-key map (kbd "C-c C-t") #'sweeprolog-top-level)
(define-key map (kbd "C-c C-u") #'sweeprolog-update-dependencies)
(define-key map (kbd "C-c C-`")
(eq major-mode 'sweeprolog-mode) ]
[ "Infer Indentation Style" sweeprolog-infer-indent-style
(eq major-mode 'sweeprolog-mode) ]
+ [ "Search Term" sweeprolog-term-search
+ (derived-mode-p 'sweeprolog-mode)]
+ "--"
[ "Set Prolog Flag" sweeprolog-set-prolog-flag t ]
[ "Install Prolog Package" sweeprolog-pack-install t ]
"--"
#'sweeprolog-command-line-function))
+;;;; Term Search
+
+(defvar sweeprolog-term-search-last-term 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.")
+
+(defun sweeprolog-term-search-delete-overlays ()
+ "Delete overlays created by `sweeprolog-term-search'."
+ (interactive "" sweeprolog-mode)
+ (mapc #'delete-overlay sweeprolog-term-search-overlays)
+ (setq sweeprolog-term-search-overlays nil))
+
+(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))
+
+(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))
+
+(defvar sweeprolog-term-search-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-m") #'sweeprolog-term-search-delete-overlays)
+ (define-key map (kbd "C-r") #'sweeprolog-term-search-repeat-backward)
+ (define-key map (kbd "C-s") #'sweeprolog-term-search-repeat-forward)
+ 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.
+
+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 buffer (or buffer (current-buffer)))
+ (with-current-buffer buffer
+ (let ((offset (point-min)))
+ (mapcar (lambda (match)
+ (cons (+ offset (car match))
+ (+ offset (cdr match))))
+ (sweeprolog--query-once "sweep" "sweep_term_search"
+ (cons buffer-file-name 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-term-search-next (point overlays backward)
+ "Return first overlay in OVERLAYS starting after POINT.
+If no overlay starts after POINT, return the first overlay.
+
+If BACKWARD is non-nil, return last overlay ending before POINT
+instead, or the last overlay if no overlay ends before POINT."
+ (if backward
+ (let* ((match nil)
+ (reversed (reverse overlays))
+ (first (car reversed)))
+ (while (and reversed (not match))
+ (let ((head (car reversed))
+ (tail (cdr reversed)))
+ (if (<= (overlay-end head) point)
+ (setq match head)
+ (setq reversed tail))))
+ (or match first))
+ (let ((match nil)
+ (first (car overlays)))
+ (while (and overlays (not match))
+ (let ((head (car overlays))
+ (tail (cdr overlays)))
+ (if (< point (overlay-start head))
+ (setq match head)
+ (setq overlays tail))))
+ (or match first))))
+
+(defun sweeprolog-term-search (term &optional backward)
+ "Search forward for Prolog term TERM in the current buffer.
+
+If BACKWARD is non-nil, search backward instead."
+ (interactive (list (sweeprolog-term-search-read-term) nil)
+ sweeprolog-mode)
+ (sweeprolog-term-search-delete-overlays)
+ (setq sweeprolog-term-search-last-term term)
+ (let ((matches (sweeprolog-term-search-in-buffer term)))
+ (if (not matches)
+ (message "No matching term found.")
+ (setq sweeprolog-term-search-overlays
+ (mapcar (lambda (match)
+ (let* ((beg (car match))
+ (end (cdr match))
+ (overlay (make-overlay beg end)))
+ (overlay-put overlay 'face 'lazy-highlight)
+ (overlay-put overlay 'evaporate t)
+ overlay))
+ matches))
+ (let ((next
+ (sweeprolog-term-search-next
+ (point) sweeprolog-term-search-overlays backward)))
+ (overlay-put next 'face 'isearch)
+ (push-mark (point) t)
+ (goto-char (overlay-start next)))
+ (set-transient-map sweeprolog-term-search-map t
+ #'sweeprolog-term-search-delete-overlays)
+ (message
+ (substitute-command-keys
+ (concat
+ "Found " (number-to-string (length matches))
+ " occurences of `" term "'. "
+ "\\<sweeprolog-term-search-map>"
+ "\\[sweeprolog-term-search-repeat-forward] for next match, "
+ "\\[sweeprolog-term-search-repeat-backward] for previous match."))))))
+
;;;; Footer
(provide 'sweeprolog)
projects / sweep.git / commitdiff