From: Eshel Yaron Date: Sun, 22 Oct 2023 16:17:23 +0000 (+0200) Subject: ADDED: in-buffer completions for source file specs X-Git-Tag: V9.1.17-0.26.0~3 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f30540376cd2d81cfa01f0eb890ff53f8de2d6b7;p=sweep.git ADDED: in-buffer completions for source file specs * sweep.pl (sweep_alias_source_file_name_collection/2) (sweep_alias_source_file_name/4) (sweep_source_file_name_collection/2) (sweep_source_file_name/3) (sweep_path_alias_collection/2) (sweep_matching_path_alias/3): New predicates. (sweep_context_callable_/3): Simplify, and recognize predicate arguments that should be source file specifications. * sweeprolog.el (sweeprolog-source-functor-completion-candidates) (sweeprolog-alias-source-completion-candidates) (sweeprolog-source-completion-candidates): New functions, used in... (sweeprolog--atom-or-functor-completion-at-point): ...here. (sweeprolog-electric-layout-post-self-insert-function) (sweeprolog-context-menu-for-region) (sweeprolog-maybe-extract-region-to-predicate): Adapt. * sweep.texi (Code Completion): Document file spec completion. * sweeprolog-tests.el: Test it. --- diff --git a/sweep.pl b/sweep.pl index 6e0feec..6e21b16 100644 --- a/sweep.pl +++ b/sweep.pl @@ -98,7 +98,10 @@ sweep_cleanup_threads/2, sweep_kill_thread/2, sweep_list_threads/2, - sweep_extract_goal/2 + sweep_extract_goal/2, + sweep_path_alias_collection/2, + sweep_source_file_name_collection/2, + sweep_alias_source_file_name_collection/2 ]). :- use_module(library(pldoc)). @@ -957,6 +960,41 @@ sweep_compound_functors_collection([Arity,Bef,Aft], Fs) :- setof(F, sweep_matching_functor(Bef, Aft, F/Arity), Fs0), maplist(term_string, Fs0, Fs). +sweep_alias_source_file_name_collection([Bef,Aft,Alias], As) :- + setof(A, sweep_alias_source_file_name(Bef, Aft, Alias, A), As). + +sweep_alias_source_file_name(Bef, Aft, Alias, L) :- + atom_string(F, Alias), + A =.. [F,'.'], + absolute_file_name(A, Dir, [file_type(directory), solutions(all)]), + directory_member(Dir, M, [extensions([pl]), recursive(true)]), + atom_concat(Dir, '/', Prefix), + atom_concat(Prefix, R, M), + file_name_extension(S, pl, R), + atom_string(S, L), + sweep_matching_atom(Bef, Aft, L). + +sweep_source_file_name_collection([Bef|Aft], As) :- + setof(A, sweep_source_file_name(Bef, Aft, A), As). + +sweep_source_file_name(Bef, Aft, L) :- + file_search_path(A0, _), + term_string(A0, S), + sweep_matching_atom(Bef, Aft, S), + A =.. [A0,'.'], + absolute_file_name(A, Dir, [file_type(directory), solutions(all)]), + directory_member(Dir, F, [extensions([pl]), recursive(true)]), + sweep_file_path_in_library(F, L). + +sweep_path_alias_collection([Bef|Aft], As) :- + setof(A, sweep_matching_path_alias(Bef, Aft, A), As0), + maplist(term_string, As0, As). + +sweep_matching_path_alias(Bef, Aft, A) :- + file_search_path(A, _), + term_string(A, S), + sweep_matching_atom(Bef, Aft, S). + sweep_matching_atom([], Aft, Atom) :- !, sweep_matching_atom_(Aft, 0, Atom). @@ -1017,7 +1055,7 @@ sweep_context_callable([H|T], R) :- -> R0 = 2 ; R0 = 0 ), - sweep_context_callable_(T, R0, 0, R). + sweep_context_callable_(T, R0, R). sweep_context_callable([_|T], R) :- sweep_context_callable(T, R). @@ -1027,26 +1065,32 @@ op_is_neck(F) :- ; current_op(1200, _, F) ). -sweep_context_callable_([], R0, R1, R) :- R is R0 + R1, !. -sweep_context_callable_([[":"|2]], R0, R1, R) :- R is R0 + R1, !. -sweep_context_callable_([["("|_]|T], R0, R1, R) :- +sweep_context_callable_([], R, R) :- !. +sweep_context_callable_([[":"|2]], R, R) :- !. +sweep_context_callable_([["("|_]|T], R0, R) :- !, - sweep_context_callable_(T, R0, R1, R). -sweep_context_callable_([["{"|_]|T], 2, R1, R) :- + sweep_context_callable_(T, R0, R). +sweep_context_callable_([["{"|_]|T], 2, R) :- !, - sweep_context_callable_(T, 0, R1, R). -sweep_context_callable_([H|T], R0, _, R) :- + sweep_context_callable_(T, 0, R). +sweep_context_callable_([H|T], R0, R) :- H = [F0|N], atom_string(F, F0), - sweep_context_callable_arg(F, N, R1), - sweep_context_callable_(T, R0, R1, R). + sweep_context_callable_arg(F, N, R0, R1), + sweep_context_callable_(T, R1, R). -sweep_context_callable_arg((-->), _, 2) :- !. -sweep_context_callable_arg(^, _, 0) :- !. -sweep_context_callable_arg(Neck, _, 0) :- +sweep_context_callable_arg((-->), _, _, 2) :- !. +sweep_context_callable_arg(^, _, _, 0) :- !. +sweep_context_callable_arg(Neck, _, _, 0) :- op_is_neck(Neck), !. -sweep_context_callable_arg(F, N, R) :- +sweep_context_callable_arg(F, N, 0, "source") :- + source_arg(F,N), + !. +sweep_context_callable_arg(F0, 1, "source", ["source"|F]) :- + !, + atom_string(F0, F). +sweep_context_callable_arg(F, N, _, R) :- sweep_current_module(Mod), ( @(predicate_property(Head, visible), Mod) ; xref_defined(_, Head, _) @@ -1062,6 +1106,11 @@ sweep_context_callable_arg(F, N, R) :- arg(N, Spec, A), callable_arg(A, R). +source_arg(load_files, 1). +source_arg(use_module, 1). +source_arg(consult, 1). +source_arg(ensure_loaded, 1). + callable_arg(N, N) :- integer(N), !. callable_arg((^), 0) :- !. callable_arg((//), 2) :- !. @@ -1099,6 +1148,8 @@ sweep_file_path_in_library(Path, Spec) :- prolog_deps:segments(Spec0, Spec1), ( string(Spec1) -> Spec = Spec1 + ; atom(Spec1) + -> atom_string(Spec1, Spec) ; term_string(Spec1, Spec) ). diff --git a/sweep.texi b/sweep.texi index 481f0cb..6b29f91 100644 --- a/sweep.texi +++ b/sweep.texi @@ -2115,6 +2115,11 @@ 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 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}), +@code{completion-at-point} suggests matching source file +specifications. @item Atom completion If point is at a non-callable position, @code{completion-at-point} suggests matching atoms and functors as completion candidates. diff --git a/sweeprolog-tests.el b/sweeprolog-tests.el index 06c8638..ec5abae 100644 --- a/sweeprolog-tests.el +++ b/sweeprolog-tests.el @@ -464,11 +464,33 @@ baz(Baz) :- bar(Baz). " ))) -(sweeprolog-deftest cap-variable () - "Completion at point for variable names." - "baz(Baz) :- bar(B-!-)." +(sweeprolog-deftest cap-source () + "Completion at point 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." + ":- use_module(library(pro-!-" (should (pcase (sweeprolog-completion-at-point) - (`(17 18 ("Baz") . ,_) t)))) + (`(23 26 ,candidates . ,_) + (member "prolog_colour" candidates))))) + +(sweeprolog-deftest cap-source-alias-functor () + "Completion at point source files." + ":- use_module(l-!-ry(prolog_source))." + (let ((res (sweeprolog-completion-at-point))) + (should (= (nth 0 res) 15)) + (should (= (nth 1 res) 18)) + (should (equal (nth 2 res) '("library"))))) + +(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." diff --git a/sweeprolog.el b/sweeprolog.el index 0e6c682..2aa3b0a 100644 --- a/sweeprolog.el +++ b/sweeprolog.el @@ -1550,13 +1550,21 @@ Used for `completion-at-point' candidates in cases such as: (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))))) + (pcase cxt + ((pred integerp) + (if fnc + (sweeprolog-predicate-functor-completion-candidates beg end fnc cxt) + (sweeprolog-predicate-completion-candidates beg end cxt))) + ("source" + (if fnc + (sweeprolog-source-functor-completion-candidates beg end) + (sweeprolog-source-completion-candidates beg end))) + (`("source" . ,source) + (sweeprolog-alias-source-completion-candidates beg end source)) + (_ + (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. @@ -1682,6 +1690,40 @@ Used for `completion-at-point' candidates in cases such as: foo :- 123 =-!- 100 + 20 + 3" nil) +(defun sweeprolog-source-functor-completion-candidates (beg end) + (list beg end + (sweeprolog--query-once + "sweep" "sweep_path_alias_collection" + (cons (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end))) + :exclusive 'no + :annotation-function (lambda (_) " Path alias functor"))) + +(defun sweeprolog-alias-source-completion-candidates (beg end alias) + (list beg end + (sweeprolog--query-once + "sweep" "sweep_alias_source_file_name_collection" + (list (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end) + alias)) + :exclusive 'no + :annotation-function (lambda (_) " Source"))) + +(defun sweeprolog-source-completion-candidates (beg end) + (list beg end + (append + (mapcar (lambda (file-name) + (file-name-sans-extension + (file-relative-name file-name default-directory))) + (directory-files-recursively default-directory + (rx ".pl" eos) nil t)) + (sweeprolog--query-once + "sweep" "sweep_source_file_name_collection" + (cons (buffer-substring-no-properties beg (point)) + (buffer-substring-no-properties (point) end)))) + :exclusive 'no + :annotation-function (lambda (_) " Source"))) + (defun sweeprolog--completion-at-point () "Return completion candidates for the Prolog code at point. @@ -1699,9 +1741,9 @@ inside a comment, string or quoted atom." (point)))) (if (sweeprolog-variable-start-char-p (char-after symbol-beg)) (sweeprolog--variable-completion-at-point symbol-beg - symbol-end) + symbol-end) (sweeprolog--atom-or-functor-completion-at-point symbol-beg - symbol-end)))) + symbol-end)))) (?. (sweeprolog--operator-completion-at-point)) (?\( (pcase (char-before) (?\( (when-let ((prev (char-before (1- (point))))) @@ -4720,7 +4762,7 @@ This function is added to ‘post-self-insert-hook’ by `(operator ,beg ,end)) (when (and (member (buffer-substring-no-properties beg end) '("(" ";" "->" "*->")) - (sweeprolog-context-callable-p)) + (integerp (sweeprolog-context-callable-p))) (insert (make-string (+ 4 beg (- end)) ? )))))) ((= (char-syntax inserted) ?\)) (sweeprolog-indent-line)))))) @@ -6284,8 +6326,8 @@ POINT is the buffer position of the mouse click." (<= sweeprolog-context-menu-region-beg-at-click point sweeprolog-context-menu-region-end-at-click)) - (when (sweeprolog-context-callable-p - sweeprolog-context-menu-region-beg-at-click) + (when (integerp (sweeprolog-context-callable-p + sweeprolog-context-menu-region-beg-at-click)) (define-key menu [sweeprolog-extract-region-to-predicate] `(menu-item "Extract to New Predicate" @@ -7209,7 +7251,7 @@ where in the buffer to insert the newly created predicate." (defun sweeprolog-maybe-extract-region-to-predicate (_point arg) (when (and (use-region-p) - (sweeprolog-context-callable-p (use-region-beginning))) + (integerp (sweeprolog-context-callable-p (use-region-beginning)))) (sweeprolog-extract-region-to-predicate (use-region-beginning) (use-region-end)