[nongnu] elpa/sweeprolog 9466ce0d59 046/166: ADDED: completion-at-point function in sweep-top-level-mode

[ELPA Syncer]

branch: elpa/sweeprolog
commit 9466ce0d595ff214fcbb7841e30bcb538e85fc98
Author: Eshel Yaron <me@eshelyaron.com>
Commit: Eshel Yaron <me@eshelyaron.com>

    ADDED: completion-at-point function in sweep-top-level-mode
---
 sweep.el | 71 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--
 sweep.pl | 60 +++++++++++++++++++++++++++++++++++++++++++++---------
 2 files changed, 119 insertions(+), 12 deletions(-)

diff --git a/sweep.el b/sweep.el
index ad96bfa08f..401b1f1ee2 100644
--- a/sweep.el
+++ b/sweep.el
@@ -120,8 +120,18 @@
                (cons "-q" (cons "--no-signals" sweep-init-args))))
   (sweep-start-prolog-server))
 
-(defun sweep-predicates-collection ()
-  (sweep-open-query "user" "sweep" "sweep_predicates_collection" nil)
+
+(defvar sweep-predicate-completion-collection nil)
+
+(defun sweep-local-predicates-collection (&optional prefix)
+  (sweep-open-query "user" "sweep" "sweep_local_predicate_completion" prefix)
+  (let ((sol (sweep-next-solution)))
+    (sweep-close-query)
+    (when (sweep-true-p sol)
+      (setq sweep-predicate-completion-collection (cdr sol)))))
+
+(defun sweep-predicates-collection (&optional prefix)
+  (sweep-open-query "user" "sweep" "sweep_predicates_collection" prefix)
   (let ((sol (sweep-next-solution)))
     (sweep-close-query)
     (when (sweep-true-p sol)
@@ -146,6 +156,62 @@
                       nil))))))
     (completing-read sweep-read-predicate-prompt col)))
 
+(defun sweep-predicate-prefix-boundaries (&optional point)
+  (let ((case-fold-search nil))
+    (save-mark-and-excursion
+      (save-match-data
+        (when point (goto-char point))
+        (unless (bobp) (backward-char))
+        (while (looking-at "[[:alnum:]_]" t)
+          (backward-char))
+        (when (looking-at ":[[:lower:]]")
+          (unless (bobp) (backward-char))
+          (while (looking-at "[[:alnum:]_]" t)
+            (backward-char)))
+        (forward-char)
+        (when (looking-at "[[:lower:]]" t)
+          (let ((start (point)))
+            (while (looking-at "[[:alnum:]:_]" t)
+              (forward-char))
+            (cons start (point))))))))
+
+(defun sweep-completion-at-point-function ()
+  (when-let ((bounds (sweep-predicate-prefix-boundaries)))
+    (let ((start (car bounds))
+          (end   (cdr bounds)))
+      (list start end
+            (completion-table-with-cache #'sweep-local-predicates-collection)
+            :exclusive 'no
+            :annotation-function
+            (lambda (key)
+              (when-let ((ann (cdr (assoc-string key 
sweep-predicate-completion-collection))))
+                (concat " " (mapconcat #'identity ann ","))))
+            :exit-function
+            (lambda (key sts)
+              (when (eq sts 'finished)
+                (let ((opoint (point)))
+                  (save-match-data
+                    (with-silent-modifications
+                      (skip-chars-backward "1234567890")
+                      (when (= ?/ (preceding-char))
+                        (backward-char)
+                        (let ((arity (string-to-number 
(buffer-substring-no-properties (1+ (point)) opoint))))
+                          (delete-region (point) opoint)
+                          (when (and
+                                 (< 0 arity)
+                                 (not
+                                  (string=
+                                   "op"
+                                   (cadr
+                                    (assoc-string
+                                     key
+                                     sweep-predicate-completion-collection)))))
+                            (insert "(")
+                            (dotimes (_ (1- arity))
+                              (insert "_, "))
+                            (insert "_)")
+                            (goto-char (1- opoint))))))))))))))
+
 ;;;###autoload
 (defun sweep-find-predicate (mfn)
   "Jump to the definiton of the Prolog predicate MFN.
@@ -566,6 +632,7 @@ module name, F is a functor name and N is its arity."
               comment-start "%")
   (add-hook 'post-self-insert-hook 
#'sweep-top-level--post-self-insert-function nil t)
   (setq sweep-top-level-timer (run-with-idle-timer 0.2 t 
#'sweep-colourise-query (current-buffer)))
+  (add-hook 'completion-at-point-functions 
#'sweep-completion-at-point-function nil t)
   (add-hook 'kill-buffer-hook
             (lambda ()
               (when (timerp sweep-top-level-timer)
diff --git a/sweep.pl b/sweep.pl
index 68ea5792f8..56d4d816e5 100644
--- a/sweep.pl
+++ b/sweep.pl
@@ -195,15 +195,47 @@ sweep_predicate_location(MFN, [Path|Line]) :-
     predicate_property(M:H, line_count(Line)),
     predicate_property(M:H, file(Path0)), atom_string(Path0, Path).
 
-% sweep_predicates_try_completion(Match, "match") :-
-%     term_string(M:F/N, Match, [syntax_errors(quiet)]),
-%     current_predicate(M:F/N), !.
-% sweep_predicates_try_completion(Prefix, "match") :-
-%     term_string(M:F,   Prefix, [syntax_errors(quiet)]),
-%     findall(M:F/N, current_predicate(M:F/N),
-%     current_predicate(M:F/N), !.
-
-sweep_predicates_collection([], Preds) :-
+sweep_local_predicate_completion(Sub, Preds) :-
+    findall(F/N,
+            current_predicate(F/N),
+            Preds0),
+    list_to_set(Preds0, Preds1),
+    convlist(sweep_predicate_completion_annotated(Sub), Preds1, Preds).
+
+sweep_predicate_completion_annotated(Sub, F/N, [S|A]) :-
+    format(string(S), '~W/~w', [F, [quoted(true), character_escapes(true)], 
N]),
+    sub_string(S, _, _, _, Sub),
+    pi_head(F/N, Head),
+    findall(P, predicate_property(Head, P), Ps0),
+    sweep_predicate_completion_op_annotation(F, Ps0, Ps),
+    phrase(sweep_head_annotation(Ps), A).
+
+sweep_predicate_completion_op_annotation(F, Ps, [op(Pri,Fix)|Ps]) :-
+    current_op(Pri, Fix, F),
+    !.
+sweep_predicate_completion_op_annotation(F, Ps, Ps).
+
+sweep_head_annotation([H|T]) -->
+    sweep_head_annotation_(H),
+    sweep_head_annotation(T).
+sweep_head_annotation([]) --> [].
+
+sweep_head_annotation_(built_in)          --> !, ["built-in"].
+sweep_head_annotation_(det)               --> !, ["!"].
+sweep_head_annotation_(dynamic)           --> !, ["dynamic"].
+sweep_head_annotation_(foreign)           --> !, ["C"].
+sweep_head_annotation_(iso)               --> !, ["iso"].
+sweep_head_annotation_(multifile)         --> !, ["multifile"].
+sweep_head_annotation_(meta_predicate(_)) --> !, [":"].
+sweep_head_annotation_(non_terminal)      --> !, ["//"].
+sweep_head_annotation_(ssu)               --> !, ["=>"].
+sweep_head_annotation_(tabled)            --> !, ["table"].
+sweep_head_annotation_(tabled(_))         --> !, ["table"].
+sweep_head_annotation_(thread_local)      --> !, ["thread-local"].
+sweep_head_annotation_(op(_,_))           --> !, ["op"].
+sweep_head_annotation_(_)                 --> [].
+
+sweep_predicates_collection(Sub, Preds) :-
     findall(M:F/N,
             ( current_predicate(M:F/N),
               pi_head(F/N, H),
@@ -217,7 +249,15 @@ sweep_predicates_collection([], Preds) :-
             ),
             Tail),
     list_to_set(Preds0, Preds1),
-    maplist(sweep_predicate_description, Preds1, Preds).
+    maplist(sweep_predicate_description, Preds1, Preds2),
+    (   Sub == []
+    ->  Preds = Preds2
+    ;   include(sweep_predicate_matches(Sub), Preds2, Preds)
+    ).
+
+sweep_predicate_matches(Sub, [String|_]) :-
+    sub_string(String, _, _, _, Sub).
+
 
 sweep_predicate_description(M:F/N, [S|T]) :-
     sweep_predicate_description_(M, F, N, T), format(string(S), '~w:~w/~w', 
[M, F, N]).