From: Eshel Yaron Date: Tue, 18 Jul 2023 13:48:13 +0000 (+0300) Subject: Refactor and enhance 'completion-at-point' support X-Git-Tag: V9.1.11-sweep-0.22.0~3 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=257832b1dc66b5bf7fc9aacdac80ba52ad40cb47;p=sweep.git Refactor and enhance 'completion-at-point' support Replace 'sweeprolog-completion-at-point-functions' with a single function 'sweeprolog-completion-at-point' that implements a much more refined context-sensitive decision tree to determine what kind of completion to perform. --- diff --git a/NEWS.org b/NEWS.org index adbb0fc..631f514 100644 --- a/NEWS.org +++ b/NEWS.org @@ -11,6 +11,24 @@ SWI-Prolog in Emacs. For further details, please consult the manual: [[https://eshelyaron.com/sweep.html][https://eshelyaron.com/sweep.html]]. +* Version 0.22.0 in development + +** New in-buffer completion implementation + +This version of Sweep includes an overhaul of the way the ~completion-at-point~ +command (~C-M-i~) works in ~sweeprolog-mode~ buffers. Sweep now performs a more +refined analysis of the code around point when you invoke ~completion-at-point~ +to determine what kind of completion candidates to provide. This results in the +following improvements: + +- Completion now works also for quoted atoms and functors +- Completion now avoids inserting parentheses and arguments after completing a + compound term when the opening parenthesis is already in place before you + invoke ~completion-at-point~ +- Completion now takes into account the qualifying module (if any) when + completing predicate calls, and suggests only predicates defined in that + module + * Version 0.21.0 on 2023-06-27 ** New ~sweeprolog-pce~ custom theme diff --git a/README.org b/README.org index 3057aeb..ccb1fce 100644 --- a/README.org +++ b/README.org @@ -1704,25 +1704,26 @@ prefix argument (~C-u C-c C-e~). #+FINDEX: completion-at-point #+KINDEX: C-M-i #+KINDEX: M-TAB -~sweeprolog-mode~ empowers Emacs's standard ~completion-at-point~ command, -bound by default to ~C-M-i~ and ~M-TAB~, with context-aware completion for -Prolog terms. For background about completion-at-point in Emacs, see [[info:emacs#Symbol -Completion][Symbol Completion]] in the Emacs manual. - -Sweep provides the following Prolog-specific completion facilities: - -- Variable name completion :: If the text before point can be - completed to one or more variable names that appear elsewhere in the - current clause, ~completion-at-point~ suggests matching variable names - as completion candidates. +In Emacs, major modes for different programming languages provide in-buffer +code completion via a standard generic command called ~completion-at-point~ +([[info:emacs#Symbol Completion][Symbol Completion]]). This command is normally bound to ~C-M-i~ and ~M-TAB~. +Sweep extends and empowers ~completion-at-point~ with context-aware +completion for Prolog code in Prolog buffers. + +When providing candidates for in-buffer completion, Sweep takes into account +the code surrounding the cursor to determine what kind of completion makes +most sense: + +- Variable name completion :: If the text before point can be completed to + one or more variable names that appear elsewhere in the current clause, + ~completion-at-point~ suggests matching variable names as completion + candidates. - Predicate completion :: If point is at a callable position, - ~completion-at-point~ suggests matching predicates as completion - candidates. Predicate calls are inserted as complete term. If the - chosen predicate takes arguments, holes are inserted in their places - (see [[#holes][Holes]]). + ~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 ([[#holes][Holes]]). - Atom completion :: If point is at a non-callable position, - ~completion-at-point~ suggests matching atoms as completion - candidates. + ~completion-at-point~ suggests matching atoms as completion candidates. ** Context-Based Term Insertion :PROPERTIES: @@ -2746,11 +2747,6 @@ some improvements remain to be pursued: :ALT_TITLE: Editing Improvements :END: -- 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 - to matching candidates in the specified module. - - Respect ~font-lock-maximum-decoration~ :: We should take into account the value of ~font-lock-maximum-decoration~ while highlighting ~sweeprolog-mode~ buffers. This variable conveys the user's preferred degree of highlighting. diff --git a/sweep.pl b/sweep.pl index 2ecebe0..48c306b 100644 --- a/sweep.pl +++ b/sweep.pl @@ -63,7 +63,6 @@ sweep_xref_source/2, sweep_beginning_of_next_predicate/2, sweep_beginning_of_last_predicate/2, - sweep_atom_collection/2, sweep_context_callable/2, sweep_heads_collection/2, sweep_exportable_predicates/2, @@ -90,7 +89,11 @@ sweep_expand_macro/2, sweep_module_annotation/2, sweep_is_module/2, - sweep_module_class/2 + sweep_module_class/2, + sweep_variable_start_code/2, + sweep_head_functors_collection/2, + sweep_functors_collection/2, + sweep_compound_functors_collection/2 ]). :- use_module(library(pldoc)). @@ -473,14 +476,28 @@ sweep_predicate_location_(M, H, Path, Line) :- predicate_property(M:H, line_count(Line)), atom_string(Path0, Path). -sweep_matching_predicates(S, D, PIs) :- - setof(M:F/A, sweep_matching_predicate(S, D, M, F, A), PIs). +sweep_matching_predicates(Bef, Aft, D, M, PIs) :- + setof(M:F/A, sweep_matching_predicate(Bef, Aft, D, M, F, A), PIs). -sweep_matching_predicate(S, D, M, F, A) :- +sweep_matching_predicate(Bef, Aft, D, M, F, A) :- sweep_known_predicate(M, F, A), - once(sub_atom(F, _, _, _, S)), + sweep_predicate_matches_(Bef, Aft, F), A >= D. +sweep_predicate_matches_([], Aft, F) :- + !, + sweep_predicate_matches_aft(Aft, 0, F). +sweep_predicate_matches_(Bef, Aft, F) :- + once(sub_string(F, N, L, _, Bef)), + M is N + L, + sweep_predicate_matches_aft(Aft, M, F). + +sweep_predicate_matches_aft([], _, _) :- !. +sweep_predicate_matches_aft(A, N, M) :- + sub_atom(M, B, _, _, A), + B >= N, + !. + sweep_known_predicate(M, F, A) :- current_predicate(M:F/A), ( M == system @@ -505,7 +522,7 @@ sweep_predicates_collection(S0, Ps) :- -> S = "" ; S = S0 ), - sweep_matching_predicates(S, 0, PIs), + sweep_matching_predicates([], S, 0, _, PIs), maplist(sweep_format_pi, PIs, Ps). sweep_format_pi(M:F/N, [S|T]) :- @@ -906,24 +923,71 @@ sweep_source_id(Path) :- string(Path0), atom_string(Path, Path0). -sweep_atom_collection(Sub, Col) :- - findall(S, - ( current_atom(A), - atom_string(A, S), - once(sub_string(S, _, _, _, Sub)) - ), - Col). +sweep_functors_collection([Bef|Aft], Ps) :- + setof(F, sweep_matching_functor(Bef, Aft, F), Ps0), + maplist(sweep_format_compound, Ps0, Ps). -sweep_heads_collection([D|Sub], Ps) :- - sweep_matching_predicates(Sub, D, PIs), +sweep_format_compound(F/A, [S|SP]) :- + pi_head(F/A, H), + length(NamedArgs, A), + maplist(=('$VAR'('_')), NamedArgs), + H =.. [F|NamedArgs], + term_string(H, S, [quoted(true), + character_escapes(true), + spacing(next_argument), + numbervars(true)]), + term_string(_, S, [subterm_positions(SP)]), + !. + +sweep_matching_functor(Bef, Aft, F/A) :- + current_functor(F, A), + atom(F), + term_string(F, S), + sweep_matching_atom(Bef, Aft, S). + +sweep_compound_functors_collection([Arity,Bef,Aft], Fs) :- + setof(F, sweep_matching_functor(Bef, Aft, F/Arity), Fs0), + maplist(term_string, Fs0, Fs). + +sweep_matching_atom([], Aft, Atom) :- + !, + sweep_matching_atom_(Aft, 0, Atom). +sweep_matching_atom(Bef, Aft, Atom) :- + once(sub_string(Atom, N, L, _, Bef)), + M is N + L, + sweep_matching_atom_(Aft, M, Atom). + +sweep_matching_atom_([], _, _) :- !. +sweep_matching_atom_(A, N, M) :- + sub_string(M, B, _, _, A), + B >= N, + !. + +sweep_head_functors_collection([Arity,D,M0,Bef,Aft], Fs) :- + ( M0 = [] + -> true + ; term_string(M, M0) + ), + sweep_matching_predicates(Bef, Aft, D, M, PIs0), + include({Arity}/[_:_/Arity]>>true, PIs0, PIs), + maplist([_:Functor/_, Functor]>>true, PIs, Fs0), + maplist(term_string, Fs0, Fs). + +sweep_heads_collection([D,M0,Bef,Aft], Ps) :- + ( M0 = [] + -> true + ; term_string(M, M0) + ), + sweep_matching_predicates(Bef, Aft, D, M, PIs), maplist(sweep_format_head_(D), PIs, Ps). sweep_format_head_(D, M:F/A, [S|SP]) :- N is A - D, length(NamedArgs, N), append(NamedArgs, _, OpenNamedArgs), - ( predicate_argument_names(M:F/A, As) - -> maplist(name_variable, As, Vs), OpenNamedArgs = Vs + ( predicate_argument_names(M:F/A, As, Extra) + -> maplist(name_variable, As, Vs), + append(Vs, Extra, OpenNamedArgs) ; maplist(=('$VAR'('_')), NamedArgs) ), !, @@ -1030,7 +1094,11 @@ sweep_file_path_in_library(Path, Spec) :- ). -predicate_argument_names(M:F/A, Args) :- +predicate_argument_names(M:F/A, Args, Extra) :- + ( sweep_grammar_rule(M, F, A) + -> Extra = [_,_] + ; Extra = [] + ), sweep_module_functor_arity_pi_(M, F, A, M:PI), ( predicate_argument_names_from_man(M, PI, Args0) -> true @@ -1137,7 +1205,7 @@ sweep_current_functors(A0, Col) :- findall([F|A], ( current_functor(F0, A), atom(F0), - atom_string(F0, F) + term_string(F0, F) ), Col). @@ -1348,3 +1416,5 @@ sweep_expand_macro(String0, String) :- functor(Term0, '#', 1), macros:expand_macros(M, Term0, Term, Pos0, _, _, _), term_string(Term, String, [variable_names(Vs), module(M)]). + +sweep_variable_start_code(C, _) :- code_type(C, prolog_var_start). diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el index e074865..66ab87a 100644 --- a/sweeprolog-tests.el +++ b/sweeprolog-tests.el @@ -402,7 +402,7 @@ test() :- TestBody. /** ")))) -(ert-deftest complete-atom () +(ert-deftest complete-compound () "Tests completing atoms." (let ((temp (make-temp-file "sweeprolog-test" nil @@ -418,7 +418,7 @@ baz(Baz) :- Baz = opa (call-interactively #'completion-at-point) (should (string= (buffer-string) " -baz(Baz) :- Baz = opaque +baz(Baz) :- Baz = opaque(_) " )))) @@ -528,6 +528,125 @@ baz(Baz) :- bar(Baz). " )))) +(defmacro sweeprolog-deftest (name _ doc text &rest body) + "Define Sweep test NAME with docstring DOC. + +The test runs BODY in a `sweeprolog-mode' buffer with initial +contents TEXT. + +The second argument is ignored." + (declare (doc-string 3) (indent 2)) + `(ert-deftest ,(intern (concat "sweeprolog-tests-" (symbol-name name))) () + ,doc + (let ((temp (make-temp-file "sweeprolog-test" + nil + "pl" + ,text)) + (enable-flymake-flag sweeprolog-enable-flymake) + (inhibit-message t)) + (setq-default sweeprolog-enable-flymake nil) + (find-file-literally temp) + (sweeprolog-mode) + (goto-char (point-min)) + (search-forward "-!-" nil t) + (delete-char -3) + ,@body + (set-buffer-modified-p nil) + (kill-buffer) + (sweeprolog-restart) + (setq-default sweeprolog-enable-flymake enable-flymake-flag)))) + +(sweeprolog-deftest cap-variable () + "Completion at point for variable names." + "baz(Baz) :- bar(B-!-)." + (should (pcase (sweeprolog-completion-at-point) + (`(17 18 ("Baz") . ,_) t)))) + +(sweeprolog-deftest cap-local-predicate () + "Completion at point for local predicates." + "%! foobar(+Baz) is det. + +foobar(Baz) :- baz(Baz). +baz(Baz) :- fooba-!-" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 64 (nth 0 cap))) + (should (= 69 (nth 1 cap))) + (should (equal '(("foobar(Baz)" compound "term_position" 0 11 0 6 ((compound "-" 7 10)))) + (nth 2 cap))))) + +(sweeprolog-deftest cap-autoloaded-predicate () + "Completion at point for remote predicates." + "%! foobar(+Baz) is det. + +foobar(Baz) :- baz(Baz). +baz(Baz) :- lists:memberc-!-" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 70 (nth 0 cap))) + (should (= 77 (nth 1 cap))) + (should (equal '(("memberchk(Elem, List)" compound "term_position" 0 21 0 9 ((compound "-" 10 14) (compound "-" 16 20)))) + (nth 2 cap))))) + +(sweeprolog-deftest cap-compound () + "Completion at point for compound terms." + "foobar(bar). + +foobar(Baz) :- Baz = foob-!-" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 36 (nth 0 cap))) + (should (= 40 (nth 1 cap))) + (should (equal '(("foobar(_)" compound "term_position" 0 9 0 6 ((compound "-" 7 8)))) + (nth 2 cap))))) + +(sweeprolog-deftest cap-compound-with-arity () + "Completion at point for compound terms of a given arity." + "foobar(Baz) :- Baz = tabl-!-tate(a,b,c)" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 22 (nth 0 cap))) + (should (= 30 (nth 1 cap))) + (should (equal '("table_cell_state" "table_state") (nth 2 cap))))) + +(sweeprolog-deftest cap-local-predicate-functor () + "Completion at point for predicate functors." + "%! foobar(+Baz) is det. + +foobar(Baz) :- baz(Baz). +baz(Baz) :- fooba-!-(" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 64 (nth 0 cap))) + (should (= 69 (nth 1 cap))) + (should (equal '("foobar") (nth 2 cap))))) + +(sweeprolog-deftest cap-compound-functor () + "Completion at point for compound term functors." + "foobar(bar). + +foobar(Baz) :- Baz = foob-!-(" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 36 (nth 0 cap))) + (should (= 40 (nth 1 cap))) + (should (equal '("foobar") (nth 2 cap))))) + +(sweeprolog-deftest cap-quoted-compound-functor () + "Completion at point for quoted functors." + "foobar('Baz baz'(bar)). + +foobar(Baz) :- Baz = 'Baz -!-'(" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 47 (nth 0 cap))) + (should (= 53 (nth 1 cap))) + (should (equal '("'Baz baz'") (nth 2 cap))))) + +(sweeprolog-deftest cap-quoted-compound () + "Completion at point for compounds with a quoted functor." + "foobar('Baz baz'(bar)). + +foobar(Baz) :- Baz = 'Baz -!-" + (let ((cap (sweeprolog-completion-at-point))) + (should (= 47 (nth 0 cap))) + (should (= 52 (nth 1 cap))) + (should (equal '(("'Baz baz'(_)" compound "term_position" 0 12 0 9 ((compound "-" 10 11)))) + (nth 2 cap))))) + (ert-deftest mark-predicate () "Test marking predicate definition." (let ((temp (make-temp-file "sweeprolog-test" diff --git a/sweeprolog.el b/sweeprolog.el index 283383a..10e68b5 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -1288,86 +1288,86 @@ command prompts for MOD." ;;;; Completion at point -(defvar sweeprolog-completion-at-point-functions - '(sweeprolog-atom-completion-at-point - sweeprolog-predicate-completion-at-point - sweeprolog-variable-completion-at-point)) - -(defun sweeprolog-atoms-collection (&optional sub) - "Return a list of atom completion candidates matchitng SUB." - (sweeprolog--query-once "sweep" "sweep_atom_collection" sub)) - -(defun sweeprolog-local-variables-collection (&rest exclude) - "Return a list of variable names that occur in the current clause. - -EXCLUDE is a list of variables name to be excluded from the -resulting list even when found in the current clause." - (let* ((beg (save-mark-and-excursion - (unless (sweeprolog-at-beginning-of-top-term-p) - (sweeprolog-beginning-of-top-term)) - (point))) - (end (save-mark-and-excursion - (sweeprolog-end-of-top-term) - (point))) - (vars nil)) - (save-excursion - (goto-char beg) - (save-match-data - (while (search-forward-regexp (rx bow (or "_" upper) - (* alnum)) - end t) - (unless (nth 8 (syntax-ppss)) - (let ((match (match-string-no-properties 0))) - (unless (or (member match exclude) - (member match vars)) - (push (match-string-no-properties 0) vars))))))) - vars)) - -(defun sweeprolog--char-uppercase-p (char) - (if (fboundp 'char-uppercase-p) - (char-uppercase-p char) - (cond ((unicode-property-table-internal 'lowercase) - (characterp (get-char-code-property char 'lowercase))) - ((and (>= char ?A) (<= char ?Z)))))) - -(defun sweeprolog-variable-completion-at-point () - "Prolog variable name completion backend for `completion-at-point'." - (when-let ((bounds (bounds-of-thing-at-point 'symbol)) - (beg (car bounds)) - (end (cdr bounds))) - (when (and (<= beg (point) end) - (let ((first (char-after beg))) - (or (sweeprolog--char-uppercase-p first) - (= first ?_)))) - (when-let ((col (sweeprolog-local-variables-collection - (buffer-substring-no-properties beg end)))) - (list beg end col - :exclusive 'no - :annotation-function - (lambda (_) " Var")))))) - -(defun sweeprolog-atom-completion-at-point () - "Prolog atom name completion backend for `completion-at-point'." - (when-let ((bounds (bounds-of-thing-at-point 'symbol)) - (beg (car bounds)) - (end (cdr bounds))) - (when (and (<= beg (point) end) - (let ((first (char-after beg))) - (not (or (sweeprolog--char-uppercase-p first) - (= first ?_))))) - (when-let ((sub (buffer-substring-no-properties beg end)) - (col (seq-filter (lambda (atom) - (not (string= atom sub))) - (sweeprolog-atoms-collection sub)))) - (list beg end col - :exclusive 'no - :annotation-function - (lambda (_) " atom")))))) - -(defun sweeprolog--parse-context (&optional point) +(defun sweeprolog-completion-at-point () + "Completion-at-point function for Prolog code. + +Sweep adds this function to `completion-at-point-functions' in +Prolog buffers." + (let ((ppss (syntax-ppss))) + (pcase (nth 3 ppss) + (?\' + ;; point is inside a quoted atom/functor + (sweeprolog--quoted-atom-or-functor-completion-at-point (nth 8 ppss))) + (?\" + ;; point is inside a string + (sweeprolog--string-completion-at-point ppss)) + ('nil (if (nth 4 ppss) + ;; point is inside a comment + (sweeprolog--comment-completion-at-point ppss) + (sweeprolog--completion-at-point)))))) + +(defun sweeprolog-variable-start-char-p (char) + (sweeprolog--query-once "sweep" "sweep_variable_start_code" char)) + +(defun sweeprolog-count-arguments-forward (&optional pos) + (save-excursion + (if pos + (goto-char pos) + (setq pos (point))) + (if (pcase (sweeprolog-next-token-boundaries) + (`(close ,beg ,_) + (= (char-after beg) ?\)))) + 0 + (let ((result 1)) + (while (progn + (ignore-error scan-error + (sweeprolog--forward-term 999)) + (and (< pos (point)) + (pcase (sweeprolog-next-token-boundaries) + (`(operator ,obeg ,oend) + (string= + "," + (buffer-substring-no-properties obeg + oend)))))) + (forward-char 1) + (setq pos (point)) + (cl-incf result)) + result)))) + +(defun sweeprolog--end-of-quote (bound) (save-excursion + (let ((go t) + (res nil) + (pos (point))) + (while go + (if (re-search-forward (rx (or "\\" "'")) bound t) + (if (= (char-before) ?\') + (setq res (point) + go nil) + (forward-char)) + (goto-char pos) + (setq go nil))) + res))) + +(defun sweeprolog--qualyfing-module (pos) + (pcase (sweeprolog-last-token-boundaries pos) + (`(operator ,beg ,end) + (when (string= (buffer-substring-no-properties beg end) ":") + (pcase (sweeprolog-last-token-boundaries beg) + (`(string ,sbeg ,send) + (when (= (char-after sbeg) ?\') + (buffer-substring-no-properties sbeg send))) + (`(symbol ,sbeg ,send) + (unless (sweeprolog-variable-start-char-p (char-after sbeg)) + (buffer-substring-no-properties sbeg send)))))))) + + +(defun sweeprolog--parse-context (&optional pos) + (setq pos (or pos (point))) + (save-excursion + (goto-char pos) (sweeprolog-backward-term 0) - (let ((pos (or point (point))) + (let ((pos ) (commas 0) (context nil)) (while @@ -1417,56 +1417,316 @@ resulting list even when found in the current clause." (setq commas 0))))))) context))) -(defun sweeprolog-context-callable-p () - "Check if point is in a position where a goal should appear." +(defun sweeprolog-context-callable-p (&optional point) + "Check if POINT is in a position where a goal should appear." (sweeprolog--query-once "sweep" "sweep_context_callable" - (sweeprolog--parse-context))) - -(defun sweeprolog-predicate-completion-at-point () - "Prolog predicate completion backend for `completion-at-point'." - (when-let ((bounds (bounds-of-thing-at-point 'symbol)) - (beg (car bounds)) - (end (cdr bounds))) - (when (and (<= beg (point) end) - (let ((first (char-after beg))) - (not (or (sweeprolog--char-uppercase-p first) - (= first ?_))))) - (when-let - ((extra-args (sweeprolog-context-callable-p)) - (col (sweeprolog--query-once - "sweep" "sweep_heads_collection" - (cons extra-args - (buffer-substring-no-properties beg end))))) - (list beg end col - :exclusive 'no - :annotation-function - (lambda (_) " Predicate") - :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))))))))))) + (sweeprolog--parse-context point))) + +(defun sweeprolog-local-variables-collection (&rest exclude) + "Return a list of variable names that occur in the current clause. +EXCLUDE is a list of variables name to be excluded from the +resulting list even when found in the current clause." + (let* ((case-fold-search nil) + (beg (save-mark-and-excursion + (unless (sweeprolog-at-beginning-of-top-term-p) + (sweeprolog-beginning-of-top-term)) + (point))) + (end (save-mark-and-excursion + (sweeprolog-end-of-top-term) + (point))) + (vars nil)) + (save-excursion + (goto-char beg) + (save-match-data + (while (search-forward-regexp (rx bow (or "_" upper) + (* alnum)) + end t) + (unless (nth 8 (syntax-ppss)) + (let ((match (match-string-no-properties 0))) + (unless (or (member match exclude) + (member match vars)) + (push (match-string-no-properties 0) vars))))))) + vars)) + +(defun sweeprolog-predicate-completion-candidates (beg end cxt) + (let ((col (sweeprolog--query-once + "sweep" "sweep_heads_collection" + (list cxt + (sweeprolog--qualyfing-module beg) + (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end))))) + (list beg end col + :exclusive 'no + :annotation-function (lambda (_) " Predicate functor") + :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-compound-completion-candidates (beg end) + (let ((col (sweeprolog--query-once + "sweep" "sweep_functors_collection" + (cons (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end))))) + (list beg end col + :exclusive 'no + :annotation-function (lambda (_) " Compound") + :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-predicate-functor-completion-candidates (beg end ari cxt) + (list beg end + (sweeprolog--query-once + "sweep" "sweep_head_functors_collection" + (list ari cxt + (sweeprolog--qualyfing-module beg) + (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end))) + :exclusive 'no + :annotation-function (lambda (_) " Predicate functor"))) + +(defun sweeprolog-compound-functor-completion-candidates (beg end ari) + (list beg end + (sweeprolog--query-once + "sweep" "sweep_compound_functors_collection" + (list ari + (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end))) + :exclusive 'no + :annotation-function (lambda (_) " Functor"))) + +(defun sweeprolog--atom-or-functor-completion-at-point (beg end) + "Return completion candidates for the atom or functor between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + foo :- bar-!-" + (let* ((cxt (sweeprolog-context-callable-p beg)) + (open-paren (char-after end)) + (fnc (and open-paren (= open-paren ?\() + (sweeprolog-count-arguments-forward (1+ end))))) + (if cxt + (if fnc + (sweeprolog-predicate-functor-completion-candidates beg end fnc cxt) + (sweeprolog-predicate-completion-candidates beg end cxt)) + (if fnc + (sweeprolog-compound-functor-completion-candidates beg end fnc) + (sweeprolog-compound-completion-candidates beg end))))) + +(defun sweeprolog--variable-completion-at-point (beg end) + "Return completion candidates for the variable between BEG and END. + +Used for `completion-at-point' candidates in cases such as: + + foo(Bar, Baz) :- member(Ba-!-" + (list beg end + (sweeprolog-local-variables-collection + (buffer-substring-no-properties beg end)) + :exclusive 'no + :annotation-function + (lambda (_) " Var"))) + +(defun sweeprolog--quoted-atom-or-functor-completion-at-point (beg) + "Return completion candidates for the quoted atom starting at BEG. + +Used for `completion-at-point' candidates in cases such as: + + foo :- \\='$bar-!-baz\\='(" + (let* ((end (or (sweeprolog--end-of-quote (line-end-position)) + (point)))) + (sweeprolog--atom-or-functor-completion-at-point beg end))) + +(defun sweeprolog--string-completion-at-point (&rest _) + "Return completion candidates for the Prolog string at point. + +Used for `completion-at-point' candidates in cases such as: + + foo :- bar(\"baz-!-" + nil) + +(defun sweeprolog--comment-completion-at-point (&rest _) + "Return completion candidates for the Prolog comment at point. + +Used for `completion-at-point' candidates in cases such as: + + % foo + % bar-!-" + nil) + +(defun sweeprolog--after-atom-or-variable-completion-at-point (&rest _) + "Return completion candidates after a Prolog atom or variable. + +Used for `completion-at-point' candidates in cases such as: + + foo :- bar -!-" + nil) + +(defun sweeprolog--after-operator-completion-at-point (&rest _) + "Return completion candidates after a Prolog operator. + +Used for `completion-at-point' candidates in cases such as: + + foo(Bar) :- Bar = -!-" + nil) + +(defun sweeprolog--first-term-completion-at-point (&rest _) + "Return completion candidates at the beginning of a Prolog buffer." + nil) + +(defun sweeprolog--after-term-completion-at-point (&rest _) + "Return completion candidates after a Prolog term. + +Used for `completion-at-point' candidates in cases such as: + + foo(Bar) :- baz(Bar) -!-" + nil) + +(defun sweeprolog--after-curly-brace-completion-at-point (&rest _) + "Return completion candidates after a curly brace. + +Used for `completion-at-point' candidates in cases such as: + + foo(Bar) --> baz, {-!-" + nil) + +(defun sweeprolog--first-dict-argument-completion-at-point (&rest _) + "Return completion candidates for the first Prolog dictionary key. + +Used for `completion-at-point' candidates in cases such as: + + foo(Bar) :- Bar = baz{-!-" + nil) + +(defun sweeprolog--first-list-argument-completion-at-point (&rest _) + "Return completion candidates for the list argument at point. + +Used for `completion-at-point' candidates in cases such as: + + foo :- member(X, [-!-" + nil) + +(defun sweeprolog--term-completion-at-point (&rest _) + "Return Prolog term at-point completion candidates. + +Used for `completion-at-point' candidates in cases such as: + + foo :- bar, (-!-" + nil) + +(defun sweeprolog--after-quoted-functor-completion-at-point (&rest _) + "Return completion candidates for the compound term at point. + +Used for `completion-at-point' candidates in cases such as: + + foo :- \\='$Bar\\='(-!-" + nil) + +(defun sweeprolog--after-functor-completion-at-point (&rest _) + "Return completion candidates for the compound term at point. + +Used for `completion-at-point' candidates in cases such as: + + foo :- bar(-!-" + nil) + +(defun sweeprolog--operator-completion-at-point (&rest _) + "Return completion candidates for the Prolog operator at point. + +Used for `completion-at-point' candidates in cases such as: + + foo :- 123 =-!- 100 + 20 + 3" + nil) + +(defun sweeprolog--completion-at-point () + "Return completion candidates for the Prolog code at point. + +Used for `completion-at-point' candidates when point is not +inside a comment, string or quoted atom." + (if (bobp) + (sweeprolog--first-term-completion-at-point) + (pcase (char-syntax (char-before)) + ((or ?w ?_) + (let ((symbol-beg (save-excursion + (skip-syntax-backward "w_") + (point))) + (symbol-end (save-excursion + (skip-syntax-forward "w_") + (point)))) + (if (sweeprolog-variable-start-char-p (char-after symbol-beg)) + (sweeprolog--variable-completion-at-point symbol-beg + symbol-end) + (sweeprolog--atom-or-functor-completion-at-point symbol-beg + symbol-end)))) + (?. (sweeprolog--operator-completion-at-point)) + (?\( (pcase (char-before) + (?\( (when-let ((prev (char-before (1- (point))))) + (pcase (char-syntax prev) + ((or ?w ?_) + (sweeprolog--after-functor-completion-at-point)) + (?\" + (when (= prev ?\') + (sweeprolog--after-quoted-functor-completion-at-point))) + (_ (sweeprolog--term-completion-at-point))))) + (?\[ (sweeprolog--first-list-argument-completion-at-point)) + (?\{ (when-let ((prev (char-before (1- (point))))) + (pcase (char-syntax prev) + ((or ?w ?_) + (sweeprolog--first-dict-argument-completion-at-point)) + (_ (sweeprolog--after-curly-brace-completion-at-point))))))) + ((or ?\) ?\") (sweeprolog--after-term-completion-at-point)) + (?\s (pcase (sweeprolog-last-token-boundaries) + ('nil (sweeprolog--first-term-completion-at-point)) + (`(open ,_ ,_) (sweeprolog--term-completion-at-point)) + (`(functor ,_ ,_) (sweeprolog--after-functor-completion-at-point)) + (`(operator ,obeg ,oend) (sweeprolog--after-operator-completion-at-point obeg oend)) + (`(symbol ,obeg ,oend) (sweeprolog--after-atom-or-variable-completion-at-point obeg oend)) + (`(close ,_ ,_) (sweeprolog--after-term-completion-at-point)) + (`(string ,_ ,_) (sweeprolog--after-term-completion-at-point))))))) ;;;; Packages @@ -3024,8 +3284,7 @@ GOAL. Otherwise, GOAL is set to a default value specified by comint-delimiter-argument-list '(?,) comment-start "%") (add-hook 'post-self-insert-hook #'sweeprolog-top-level--post-self-insert-function nil t) - (dolist (capf sweeprolog-completion-at-point-functions) - (add-hook 'completion-at-point-functions capf nil t)) + (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point nil t) (setq sweeprolog-top-level-timer (run-with-idle-timer 0.2 t #'sweeprolog-colourise-query (current-buffer))) (add-hook 'kill-buffer-hook (lambda () @@ -4507,8 +4766,7 @@ certain contexts to maintain conventional Prolog layout." (setq sweeprolog--analyze-buffer-duration (float-time (time-since time)))) (add-hook 'xref-backend-functions #'sweeprolog--xref-backend nil t) (add-hook 'file-name-at-point-functions #'sweeprolog-file-at-point nil t) - (dolist (capf sweeprolog-completion-at-point-functions) - (add-hook 'completion-at-point-functions capf nil t)) + (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point nil t) (when sweeprolog-analyze-buffer-on-idle (setq sweeprolog--timer (run-with-idle-timer @@ -5499,8 +5757,7 @@ moving point." (minibuffer-with-setup-hook (lambda () (set-syntax-table sweeprolog-mode-syntax-table) - (dolist (capf sweeprolog-completion-at-point-functions) - (add-hook 'completion-at-point-functions capf nil t))) + (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point nil t)) (read-from-minibuffer prompt nil sweeprolog-read-goal-map nil 'sweeprolog-read-goal-history