* sweep.pl (sweep_context_callable_arg/4): Report "flag" context.
(sweep_flags_collection/2): New predicate.
* sweeprolog.el (sweeprolog--flag-completion-at-point): New function.
(sweeprolog--atom-or-functor-completion-at-point): Use it.
* sweeprolog-tests.el (cap-flag-name): New test.
* sweep.texi (Code Completion): Update.
sweep_functions_collection/2,
sweep_function_functors_collection/2,
sweep_nohup/2,
- sweep_short_documentation/2
+ sweep_short_documentation/2,
+ sweep_flags_collection/2
]).
:- use_module(library(pldoc)).
),
Fs).
+sweep_flags_collection([Bef|Aft], Fs) :-
+ findall(F, sweep_current_flag(Bef, Aft, F), Fs).
+
+%! sweep_current_flag(+Bef:string, +Aft:string, -Flag:string) is nondet.
+%
+% True when Flag is a current Prolog flag that contains Bef and then Aft.
+
+sweep_current_flag(Bef, Aft, Flag) :-
+ current_prolog_flag(Flag0, _),
+ term_string(Flag0, Flag),
+ sweep_matching_atom(Bef, Aft, Flag).
+
sweep_option_functors_collection([Bef,Aft,Pred0,Ari,Arg], Fs) :-
atom_string(Pred, Pred0),
current_predicate_options(Pred/Ari, Arg, Options),
sweep_context_callable_arg(F0, 1, ["option", P, N], ["option", P, N, F]) :-
!,
atom_string(F0, F).
+sweep_context_callable_arg(F, N, 0, "flag") :-
+ flag_arg(F,N),
+ !.
sweep_context_callable_arg(F, N, 0, "source") :-
source_arg(F,N),
!.
arith_arg((=:=), 1).
arith_arg((=:=), 2).
+flag_arg(set_prolog_flag , 1).
+flag_arg(current_prolog_flag, 1).
+
source_arg(load_files, 1).
source_arg(use_module, 1).
source_arg(consult, 1).
completion candidates.
@item Predicate completion
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}).
+suggests matching predicate calls. 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,
+If point is inside a predicate options list,
@code{completion-at-point} suggests matching options or option values
for the appropriate predicate.
@item Source file completion
@item Arithmetic function completion
If point is inside an arithmetic expression,
@code{completion-at-point} suggests matching arithmetic functions.
+@item Flag completion
+If point is at a position where a Prolog flag should appear (such as
+the first argument of @code{set_prolog_flag/2}),
+@code{completion-at-point} suggests matching flags.
@item Atom completion
If point is at a non-callable position, @code{completion-at-point}
-suggests matching atoms and functors as completion candidates.
+suggests matching atoms and functors.
@end table
@node Insert Term DWIM
"
)))
+(sweeprolog-deftest cap-flag-name ()
+ "Completion at point for Prolog flag names."
+ "
+foo :-
+ current_prolog_flag(double_q-!-
+"
+ (let ((res (sweeprolog-completion-at-point)))
+ (should (= (nth 0 res) 33))
+ (should (= (nth 1 res) 41))
+ (should (equal (nth 2 res) '("double_quotes")))))
+
(sweeprolog-deftest cap-option-functor ()
"Completion at point for predicate option functors."
"
:exclusive 'no
:annotation-function (lambda (_) " Functor")))
+(defun sweeprolog--flag-completion-at-point (beg end)
+ "Return completion candidates for the Prolog flag between BEG and END.
+
+Used for `completion-at-point' candidates in cases such as:
+
+ foo(Bar, Baz) :- set_prolog_flag(ba-!-"
+ (list beg end
+ (sweeprolog--query-once
+ "sweep" "sweep_flags_collection"
+ (cons (buffer-substring-no-properties beg (point))
+ (buffer-substring-no-properties (point) end)))
+ :exclusive 'no
+ :annotation-function
+ (lambda (_) " Flag")))
+
(defun sweeprolog--atom-or-functor-completion-at-point (beg end)
"Return completion candidates for the atom or functor between BEG and END.
(if fnc
(sweeprolog-arith-functor-completion-candidates beg end)
(sweeprolog-arith-completion-candidates beg end)))
+ ("flag"
+ (sweeprolog--flag-completion-at-point beg end))
(_
(if fnc
(sweeprolog-compound-functor-completion-candidates beg end fnc)