]> git.eshelyaron.com Git - sweep.git/commitdiff
ADDED: in-buffer completions for predicate options
authorEshel Yaron <me@eshelyaron.com>
Sun, 22 Oct 2023 17:52:22 +0000 (19:52 +0200)
committerEshel Yaron <me@eshelyaron.com>
Sun, 22 Oct 2023 17:53:17 +0000 (19:53 +0200)
* 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
sweep.texi
sweeprolog-tests.el
sweeprolog.el

index 6e21b16bbcb5578a40a4f4f8c5f0fdd40cb8c5b0..05f36cfb51b6bc68ed4d183c2dca61664ba32157 100644 (file)
--- a/sweep.pl
+++ b/sweep.pl
             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),
     !.
index 6b29f9149c33f2ce2c3a952aee8455f0bdc70c6b..cdd2c78d860b91ea7eb3c1c1e12295d9bd20e6e6 100644 (file)
@@ -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}),
index ec5abae40d826e66313181e73448214221ee1b63..83782b74f53b7b596dfe4f0409602174491f9a25 100644 (file)
@@ -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))
index 2aa3b0a503877f7239d84f662ce1d5438e937c12..f600fef44d49f537506037a2df6895a2cf6a194a 100644 (file)
@@ -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)