From 5dd4650ba36517754782ae1bc9871ccfb4546d92 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 22 Oct 2023 19:52:22 +0200 Subject: [PATCH] ADDED: in-buffer completions for predicate options * sweep.pl (sweep_option_functors_collection/2) (sweep_options_collection/2) (sweep_option_arguments_collection/2): New predicates. (sweep_context_callable_arg/4): Recognize predicate options. * sweeprolog.el (sweeprolog-option-functor-completion-candidates) (sweeprolog-option-completion-candidates) (sweeprolog-option-arg-completion-candidates): New functions, used in... (sweeprolog--atom-or-functor-completion-at-point): ...here. * sweep.texi (Code Completion): Document predicate options completion. * sweeprolog-tests.el: Test it. --- sweep.pl | 44 +++++++++++++++++++++- sweep.texi | 4 ++ sweeprolog-tests.el | 38 +++++++++++++++++-- sweeprolog.el | 91 +++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 173 insertions(+), 4 deletions(-) diff --git a/sweep.pl b/sweep.pl index 6e21b16..05f36cf 100644 --- a/sweep.pl +++ b/sweep.pl @@ -101,7 +101,10 @@ sweep_extract_goal/2, sweep_path_alias_collection/2, sweep_source_file_name_collection/2, - sweep_alias_source_file_name_collection/2 + sweep_alias_source_file_name_collection/2, + sweep_option_functors_collection/2, + sweep_options_collection/2, + sweep_option_arguments_collection/2 ]). :- use_module(library(pldoc)). @@ -960,6 +963,35 @@ sweep_compound_functors_collection([Arity,Bef,Aft], Fs) :- setof(F, sweep_matching_functor(Bef, Aft, F/Arity), Fs0), maplist(term_string, Fs0, Fs). +sweep_option_functors_collection([Bef,Aft,Pred0,Ari,Arg], Fs) :- + atom_string(Pred, Pred0), + current_predicate_options(Pred/Ari, Arg, Options), + maplist([T,F]>>(T =.. [F|_]), Options, Fs0), + maplist(term_string, Fs0, Fs1), + include(sweep_matching_atom(Bef, Aft), Fs1, Fs). + +sweep_options_collection([Bef,Aft,Pred0,Ari,Arg], Fs) :- + atom_string(Pred, Pred0), + current_predicate_options(Pred/Ari, Arg, Options), + maplist([T,F]>>(T =.. [F|_]), Options, Fs0), + maplist(term_string, Fs0, Fs1), + include(sweep_matching_atom(Bef, Aft), Fs1, Fs2), + maplist([L,R]>>sweep_format_term([L,1,999], R), Fs2, Fs). + +sweep_option_arguments_collection([Bef,Aft,Pred0,Ari,Arg,Opt0], Fs) :- + atom_string(Pred, Pred0), + atom_string(Opt1, Opt0), + Opt =.. [Opt1,Type], + current_predicate_options(Pred/Ari, Arg, Options), + member(Opt, Options), + sweep_option_arguments_collection_(Type, Bef, Aft, Fs). + +sweep_option_arguments_collection_(boolean, Bef, Aft, Fs) :- + sweep_option_arguments_collection_(oneof([true,false]), Bef, Aft, Fs). +sweep_option_arguments_collection_(oneof(Alts0), Bef, Aft, Alts) :- + maplist(atom_string, Alts0, Alts1), + include(sweep_matching_atom(Bef, Aft), Alts1, Alts). + sweep_alias_source_file_name_collection([Bef,Aft,Alias], As) :- setof(A, sweep_alias_source_file_name(Bef, Aft, Alias, A), As). @@ -1073,6 +1105,9 @@ sweep_context_callable_([["("|_]|T], R0, R) :- sweep_context_callable_([["{"|_]|T], 2, R) :- !, sweep_context_callable_(T, 0, R). +sweep_context_callable_([["["|_]|T], ["options", F, N], R) :- + !, + sweep_context_callable_(T, ["option", F, N], R). sweep_context_callable_([H|T], R0, R) :- H = [F0|N], atom_string(F, F0), @@ -1084,6 +1119,13 @@ sweep_context_callable_arg(^, _, _, 0) :- !. sweep_context_callable_arg(Neck, _, _, 0) :- op_is_neck(Neck), !. +sweep_context_callable_arg(F0, N, 0, ["options", F, N]) :- + current_option_arg(F0/N, N), + !, + atom_string(F0, F). +sweep_context_callable_arg(F0, 1, ["option", P, N], ["option", P, N, F]) :- + !, + atom_string(F0, F). sweep_context_callable_arg(F, N, 0, "source") :- source_arg(F,N), !. diff --git a/sweep.texi b/sweep.texi index 6b29f91..cdd2c78 100644 --- a/sweep.texi +++ b/sweep.texi @@ -2115,6 +2115,10 @@ If point is at a callable position, @code{completion-at-point} suggests matching predicate calls as completion candidates. If the predicate you choose takes arguments, Sweep inserts holes in their places, and moves point to the first argument (@pxref{Holes}). +@item Predicate option completion +If point is inside a predicates options list, +@code{completion-at-point} suggests matching options or option values +for the appropriate predicate. @item Source file completion If point is at a position where a source file specification should appear (such as the argument of @code{use_module/1}), diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el index ec5abae..83782b7 100644 --- a/sweeprolog-tests.el +++ b/sweeprolog-tests.el @@ -464,22 +464,54 @@ baz(Baz) :- bar(Baz). " ))) +(sweeprolog-deftest cap-option-functor () + "Completion at point for predicate option functors." + " +foo(T) :- + read_term(T, [va-!-mes( +" + (should (pcase (sweeprolog-completion-at-point) + (`(30 35 ("variable_names") . ,_) t)))) + +(sweeprolog-deftest cap-option () + "Completion at point for predicate options." + " +foo(T) :- + read_term(T, [va-!-mes +" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 30 (nth 0 cap))) + (should (= 35 (nth 1 cap))) + (should (equal '("variable_names(_)") + (all-completions "" (nth 2 cap)))))) + +(sweeprolog-deftest cap-option-argument () + "Completion at point for predicate option arguments." + " +foo(T) :- + read_term(T, [syntax_errors(fa-!- +" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 44 (nth 0 cap))) + (should (= 46 (nth 1 cap))) + (should (equal '("fail") (nth 2 cap))))) + (sweeprolog-deftest cap-source () - "Completion at point source files." + "Completion at point for source files." ":- use_module(li-!-" (should (pcase (sweeprolog-completion-at-point) (`(15 17 ,candidates . ,_) (member "library(prolog_colour)" candidates))))) (sweeprolog-deftest cap-source-in-library () - "Completion at point source files." + "Completion at point for source files in a path alias." ":- use_module(library(pro-!-" (should (pcase (sweeprolog-completion-at-point) (`(23 26 ,candidates . ,_) (member "prolog_colour" candidates))))) (sweeprolog-deftest cap-source-alias-functor () - "Completion at point source files." + "Completion at point for path alias functors." ":- use_module(l-!-ry(prolog_source))." (let ((res (sweeprolog-completion-at-point))) (should (= (nth 0 res) 15)) diff --git a/sweeprolog.el b/sweeprolog.el index 2aa3b0a..f600fef 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -1561,6 +1561,12 @@ Used for `completion-at-point' candidates in cases such as: (sweeprolog-source-completion-candidates beg end))) (`("source" . ,source) (sweeprolog-alias-source-completion-candidates beg end source)) + (`("option" ,pred ,ari) + (if fnc + (sweeprolog-option-functor-completion-candidates beg end pred ari) + (sweeprolog-option-completion-candidates beg end pred ari))) + (`("option" ,pred ,ari ,option) + (sweeprolog-option-arg-completion-candidates beg end pred ari option)) (_ (if fnc (sweeprolog-compound-functor-completion-candidates beg end fnc) @@ -1690,7 +1696,82 @@ Used for `completion-at-point' candidates in cases such as: foo :- 123 =-!- 100 + 20 + 3" nil) +(defun sweeprolog-option-functor-completion-candidates (beg end pred ari) + "Return completions for option functors for PRED/ARI between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + foo(T) :- read_term(T, [va-!-es(" + (list beg end + (sweeprolog--query-once + "sweep" "sweep_option_functors_collection" + (list (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end) + pred ari ari)) + :exclusive 'no + :annotation-function (lambda (_) " Option functor"))) + +(defun sweeprolog-option-completion-candidates (beg end pred ari) + "Return completions for options for PRED/ARI between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + foo(T) :- read_term(T, [va-!-" + (let ((col (sweeprolog--query-once + "sweep" "sweep_options_collection" + (list (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end) + pred ari ari)))) + (list beg end col + :exclusive 'no + :annotation-function (lambda (_) " Option") + :exit-function + (lambda (string status) + (pcase status + ('finished + (pcase (cdr (assoc-string string col)) + (`(compound + "term_position" + 0 ,length + ,_fbeg ,_fend + ,holes) + (with-silent-modifications + (dolist (hole holes) + (pcase hole + (`(compound "-" ,hbeg ,hend) + (add-text-properties + (- (point) length (- hbeg)) + (- (point) length (- hend)) + (list + 'sweeprolog-hole t + 'font-lock-face (list 'sweeprolog-hole) + 'rear-nonsticky '(sweeprolog-hole + cursor-sensor-functions + font-lock-face))))))) + (backward-char length) + (sweeprolog-forward-hole))))))))) + +(defun sweeprolog-option-arg-completion-candidates (beg end pred ari option) + "Return completions for argument of OPTION for PRED/ARI between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + foo(T) :- read_term(T, [syntax_errors(fa-!-" + (list beg end + (sweeprolog--query-once + "sweep" "sweep_option_arguments_collection" + (list (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end) + pred ari ari option)) + :exclusive 'no + :annotation-function (lambda (_) " Option argument"))) + (defun sweeprolog-source-functor-completion-candidates (beg end) + "Return completion candidates for the Prolog path alias between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + :- use_module(lib-!-ry(" (list beg end (sweeprolog--query-once "sweep" "sweep_path_alias_collection" @@ -1700,6 +1781,11 @@ Used for `completion-at-point' candidates in cases such as: :annotation-function (lambda (_) " Path alias functor"))) (defun sweeprolog-alias-source-completion-candidates (beg end alias) + "Return completions for the file specification in ALIAS between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + :- use_module(library(prol-!-" (list beg end (sweeprolog--query-once "sweep" "sweep_alias_source_file_name_collection" @@ -1710,6 +1796,11 @@ Used for `completion-at-point' candidates in cases such as: :annotation-function (lambda (_) " Source"))) (defun sweeprolog-source-completion-candidates (beg end) + "Return completions for the file specification between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + :- use_module(lib-!-" (list beg end (append (mapcar (lambda (file-name) -- 2.39.2