sweep_predicate_location/2,
sweep_predicate_apropos/2,
sweep_predicates_collection/2,
- sweep_local_predicate_completion/2,
sweep_functor_arity_pi/2,
sweep_modules_collection/2,
sweep_packs_collection/2,
sweep_analyze_region/2,
sweep_xref_source/2,
sweep_beginning_of_next_predicate/2,
- sweep_beginning_of_last_predicate/2
+ sweep_beginning_of_last_predicate/2,
+ sweep_atom_collection/2,
+ sweep_context_callable/2,
+ sweep_predicate_completion_candidates/2
]).
:- use_module(library(pldoc)).
),
atom_string(Path0, Path).
-sweep_local_predicate_completion(Sub, Preds) :-
- sweep_current_module(M),
- findall(F/N,
- @(current_predicate(F/N), M),
- Preds0,
- Tail),
- findall(XF/XN,
- ( xref_module(SourceId, M),
- xref_defined(SourceId, H, _),
- H \= _:_,
- pi_head(XF/XN, H)
- ),
- Tail),
- list_to_set(Preds0, Preds1),
- convlist(sweep_predicate_completion_annotated(Sub, M), Preds1, Preds).
-
-sweep_predicate_completion_annotated(Sub, M, F/N, [S|A]) :-
- format(string(S), '~W', [F/N, [quoted(true), character_escapes(true)]]),
- sub_string(S, _, _, _, Sub),
- \+ sub_string(S, 0, _, _, "'$"),
- pi_head(F/N, Head),
- findall(P, @(predicate_property(Head, P), M), 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(_, 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,
xref_defined(Path, _, H), xref_definition_line(H, Next),
Start < Next.
-
sweep_source_id(Path) :-
sweep_main_thread,
user:sweep_funcall("buffer-file-name", Path),
string(Path).
+
+sweep_atom_collection(Sub, Col) :-
+ findall(S,
+ ( current_atom(A),
+ atom_string(A, S),
+ sub_string(S, _, _, _, Sub)
+ ),
+ Col).
+
+sweep_predicate_completion_candidates(_, Ps) :-
+ findall(H,
+ ( sweep_current_module(M),
+ @(predicate_property(H, visible), M)
+ ),
+ Hs),
+ maplist(sweep_format_predicate, Hs, Ps).
+
+sweep_format_predicate(H, S) :-
+ term_variables(H, Vs),
+ maplist(=('$VAR'('_')), Vs),
+ term_string(H, S, [quoted(true),
+ character_escapes(true),
+ spacing(next_argument),
+ numbervars(true)]).
+
+sweep_context_callable([], true) :- !.
+sweep_context_callable([[":"|2]], true) :- !.
+sweep_context_callable([H|T], R) :-
+ H = [F0|N],
+ atom_string(F, F0),
+ ( sweep_context_callable_(F, N)
+ -> sweep_context_callable(T, R)
+ ; R = []
+ ).
+
+sweep_context_callable_(Neck, _) :-
+ ( xref_op(_, op(1200, _, Neck))
+ -> true
+ ; current_op(1200, _, Neck)
+ ).
+sweep_context_callable_(F, N) :-
+ ( current_predicate(F/M), pi_head(F/M,Head)
+ ; xref_defined(_, Head, _), pi_head(F/M,Head)
+ ),
+ M >= N,
+ catch(infer_meta_predicate(Head, Spec),
+ error(permission_error(access, private_procedure, _),
+ context(system:clause/2, _)),
+ false),
+ arg(N, Spec, A),
+ callable_arg(A).
+
+callable_arg(N) :- integer(N), !.
+callable_arg(^) :- !.
+callable_arg(//) :- !.
+callable_arg(:) :- !.
(defvar sweeprolog-prolog-server-port nil)
-(defvar sweeprolog-predicate-completion-collection nil)
-
(defvar sweeprolog-read-predicate-history nil)
(defvar sweeprolog-read-module-history nil)
(modify-syntax-entry ?\n ">" table)
(modify-syntax-entry ?* ". 23b" table)
(modify-syntax-entry ?/ ". 14" table)
+ (modify-syntax-entry ?! "w" table)
table))
+(defvar sweeprolog-top-level-mode-syntax-table sweeprolog-mode-syntax-table)
;;;; User options
#'flymake-show-diagnostics-buffer))
(define-key map (kbd "C-M-^") #'kill-backward-up-list)
(define-key map (kbd "C-M-m") #'sweeprolog-insert-term-dwim)
+ (define-key map (kbd "C-M-i") #'sweeprolog-completion-at-point)
(define-key map (kbd "M-p") #'sweeprolog-backward-predicate)
(define-key map (kbd "M-n") #'sweeprolog-forward-predicate)
(define-key map (kbd "M-h") #'sweeprolog-mark-predicate)
(defvar sweeprolog-top-level-mode-map
(let ((map (make-sparse-keymap)))
+ (define-key map (kbd "C-M-i") #'sweeprolog-completion-at-point)
(define-key map (kbd "C-c C-c") #'sweeprolog-top-level-signal-current)
map)
"Keymap for `sweeprolog-top-level-mode'.")
;;;; Completion at point
+(defvar sweeprolog-completion-at-point-functions
+ '((sweeprolog-predicate-completion-at-point
+ ?p "predicate" "Predicate name")
+ (sweeprolog-atom-completion-at-point
+ ?a "atom" "Atom")
+ (sweeprolog-module-completion-at-point
+ ?m "module" "Module name")
+ (sweeprolog-variable-completion-at-point
+ ?v "variable" "Variable name")))
+
+(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.
:annotation-function
(lambda (_) " Var"))))))
-(defun sweeprolog-local-predicates-collection (&optional prefix)
- "Return a list of prediactes accessible in the current buffer.
-
-When non-nil, only predicates whose name contains PREFIX are returned."
- (setq sweeprolog-predicate-completion-collection
- (sweeprolog--query-once "sweep" "sweep_local_predicate_completion"
- prefix)))
-
-(defun sweeprolog-completion-at-point-function ()
- (when-let ((bounds (sweeprolog-predicate-prefix-boundaries)))
- (let ((start (car bounds))
- (end (cdr bounds)))
- (list start end
- (completion-table-with-cache #'sweeprolog-local-predicates-collection)
- :exclusive 'no
- :annotation-function
- (lambda (key)
- (when-let ((ann (cdr (assoc-string key sweeprolog-predicate-completion-collection))))
- (concat " " (mapconcat #'identity ann ","))))
- :exit-function
- (lambda (key sts)
- (when (eq sts 'finished)
- (let ((opoint (point)))
- (save-match-data
- (combine-after-change-calls
- (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
- sweeprolog-predicate-completion-collection)))))
- (insert "(")
- (dotimes (_ (1- arity))
- (insert "_, "))
- (insert "_)")
- (goto-char (1- opoint))))))))))))))
+(defun sweeprolog-module-completion-at-point ()
+ "Prolog module 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 ((col (sweeprolog-modules-collection)))
+ (list beg end (mapcar #'car col)
+ :exclusive 'no
+ :annotation-function
+ (lambda (_) " module"))))))
+(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 ((col (sweeprolog-atoms-collection
+ (buffer-substring-no-properties beg end))))
+ (list beg end col
+ :exclusive 'no
+ :annotation-function
+ (lambda (_) " atom"))))))
+
+(defun sweeprolog--parse-context (&optional point)
+ (save-excursion
+ (sweeprolog-backward-term 0)
+ (let ((pos (or point (point)))
+ (commas 0)
+ (context nil))
+ (while
+ (pcase (sweeprolog-last-token-boundaries pos)
+ ('nil nil)
+ (`(open ,obeg ,oend)
+ (push (cons (buffer-substring-no-properties obeg oend)
+ (1+ commas))
+ context)
+ (setq pos obeg)
+ (setq commas 0))
+ (`(functor ,obeg ,oend)
+ (push (cons (buffer-substring-no-properties obeg (1- oend))
+ (1+ commas))
+ context)
+ (setq pos obeg)
+ (setq commas 0))
+ ((or `(operator ,obeg ,oend)
+ `(symbol ,obeg ,oend))
+ (let* ((op (buffer-substring-no-properties obeg oend))
+ (ipre (sweeprolog-op-infix-precedence op))
+ (ppre (sweeprolog-op-prefix-precedence op)))
+ (cond
+ ((and (string= "." op)
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ nil)
+ ((string= "," op)
+ (setq pos
+ (save-excursion
+ (goto-char obeg)
+ (setq commas (1+ commas))
+ (sweeprolog-backward-term 999)
+ (point))))
+ (ipre
+ (push (cons op 2) context)
+ (setq pos
+ (save-excursion
+ (goto-char obeg)
+ (sweeprolog-backward-term (1- ipre))
+ (point)))
+ (setq commas 0))
+ (ppre
+ (push (cons op 1) context)
+ (setq pos obeg)
+ (setq commas 0)))))))
+ context)))
+
+(defun sweeprolog-predicate-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 ?_))))
+ (sweeprolog--query-once "sweep"
+ "sweep_context_callable"
+ (sweeprolog--parse-context)))
+ (when-let
+ ((col (sweeprolog--query-once "sweep" "sweep_predicate_completion_candidates"
+ nil)))
+ (list beg end col
+ :exclusive 'no
+ :annotation-function
+ (lambda (_) " Predicate"))))))
+
+(defun sweeprolog-completion-at-point (&optional funs)
+ (interactive
+ (list
+ (and current-prefix-arg
+ (list
+ (let ((choice (read-multiple-choice
+ "Completion kind: "
+ (mapcar
+ #'cdr
+ sweeprolog-completion-at-point-functions))))
+ (caar (seq-filter
+ (lambda (capf)
+ (equal (cdr capf) choice))
+ sweeprolog-completion-at-point-functions)))))))
+ (let ((completion-at-point-functions
+ (or funs
+ (append (mapcar #'car
+ sweeprolog-completion-at-point-functions)
+ completion-at-point-functions))))
+ (completion-at-point)))
;;;; Packages
ver)))))))
(completing-read sweeprolog-read-pack-prompt col)))
-(defun sweeprolog-true-p (sol)
- (or (eq (car sol) '!)
- (eq (car sol) t)))
-
;;;###autoload
(defun sweeprolog-pack-install (pack)
"Install or upgrade Prolog package PACK."
(list (list beg end (sweeprolog-head-extern-face))))
(`("head" ,(rx "public ") . ,_)
(list (list beg end (sweeprolog-head-public-face))))
- (`("head",(rx "dynamic ") . ,_)
+ (`("head" ,(rx "dynamic ") . ,_)
(list (list beg end (sweeprolog-head-dynamic-face))))
- (`("head",(rx "multifile ") . ,_)
+ (`("head" ,(rx "multifile ") . ,_)
(list (list beg end (sweeprolog-head-multifile-face))))
(`("head" ,(rx "local(") . ,_)
(list (list beg end (sweeprolog-head-local-face))))
(list (list beg end (sweeprolog-undefined-face))))
(`("goal" "global" . ,_)
(list (list beg end (sweeprolog-global-face))))
- (`("goal",(rx "dynamic ") . ,_)
+ (`("goal" ,(rx "dynamic ") . ,_)
(list (list beg end (sweeprolog-dynamic-face))))
- (`("goal",(rx "multifile ") . ,_)
+ (`("goal" ,(rx "multifile ") . ,_)
(list (list beg end (sweeprolog-multifile-face))))
- (`("goal",(rx "thread_local ") . ,_)
+ (`("goal" ,(rx "thread_local ") . ,_)
(list (list beg end (sweeprolog-thread-local-face))))
- (`("goal",(rx "extern(") . ,_)
+ (`("goal" ,(rx "extern(") . ,_)
(list (list beg end (sweeprolog-extern-face))))
- (`("goal",(rx "autoload(") . ,_)
+ (`("goal" ,(rx "autoload(") . ,_)
(list (list beg end (sweeprolog-autoload-face))))
- (`("goal",(rx "imported(") . ,_)
+ (`("goal" ,(rx "imported(") . ,_)
(list (list beg end (sweeprolog-imported-face))))
- (`("goal",(rx "global(") . ,_)
+ (`("goal" ,(rx "global(") . ,_)
(list (list beg end (sweeprolog-global-face))))
- (`("goal",(rx "local(") . ,_)
+ (`("goal" ,(rx "local(") . ,_)
(list (list beg end (sweeprolog-local-face))))
("instantiation_error"
(list (list beg end (sweeprolog-instantiation-error-face))))
(setq cur (point)))
(skip-chars-forward " \t\n")
(push (list cur (point) nil) ws)
- (cons (list beg end (sweeprolog-fullstop-face))
- ws))))
+ (cons (list beg end nil)
+ (cons (list beg end (sweeprolog-fullstop-face))
+ ws)))))
("functor"
(list (list beg end (sweeprolog-functor-face))))
("arity"
(1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
(string-to-syntax "."))))
((rx bow (group-n 1 "0'" anychar))
- (1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
- (string-to-syntax "w"))))
- ((rx bow (group-n 1 "!") eow)
(1 (unless (save-excursion (nth 8 (syntax-ppss (match-beginning 0))))
(string-to-syntax "w")))))
start end)))
comint-delimiter-argument-list '(?,)
comment-start "%")
(add-hook 'post-self-insert-hook #'sweeprolog-top-level--post-self-insert-function nil t)
- (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point-function 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 ()
(scan-error nil)))
(defun sweeprolog--backward-term (pre)
- (pcase (sweeprolog-last-token-boundaries)
- ('nil
- (signal 'scan-error
- (list "Cannot scan backwards beyond beginning of buffer."
- (point-min)
- (point-min))))
- (`(open ,obeg ,oend)
- (signal 'scan-error
- (list "Cannot scan backwards beyond opening parenthesis or bracket."
- obeg
- oend)))
- (`(functor ,obeg ,oend)
- (signal 'scan-error
- (list "Cannot scan backwards beyond functor."
- obeg
- oend)))
- (`(operator ,obeg ,oend)
- (if (and (string= "." (buffer-substring-no-properties obeg oend))
- (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
- (signal 'scan-error
- (list "Cannot scan backwards beyond fullstop."
- obeg
- (1+ obeg)))
+ (while t
+ (pcase (sweeprolog-last-token-boundaries)
+ ('nil
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond beginning of buffer."
+ (point-min)
+ (point-min))))
+ (`(open ,obeg ,oend)
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond opening parenthesis or bracket."
+ obeg
+ oend)))
+ (`(functor ,obeg ,oend)
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond functor."
+ obeg
+ oend)))
+ (`(operator ,obeg ,oend)
+ (if (and (string= "." (buffer-substring-no-properties obeg oend))
+ (member (char-syntax (char-after (1+ obeg))) '(?> ? )))
+ (signal 'scan-error
+ (list "Cannot scan backwards beyond fullstop."
+ obeg
+ (1+ obeg)))
+ (if-let ((opre (sweeprolog-op-infix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> opre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg))
+ (if-let ((ppre (sweeprolog-op-prefix-precedence
+ (buffer-substring-no-properties obeg oend))))
+ (if (> ppre pre)
+ (signal 'scan-error
+ (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
+ obeg
+ oend))
+ (goto-char obeg))
+ (goto-char obeg)))))
+ (`(symbol ,obeg ,oend)
(if-let ((opre (sweeprolog-op-infix-precedence
(buffer-substring-no-properties obeg oend))))
(if (> opre pre)
(list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
obeg
oend))
- (goto-char obeg)
- (sweeprolog--backward-term pre))
+ (goto-char obeg))
(if-let ((ppre (sweeprolog-op-prefix-precedence
(buffer-substring-no-properties obeg oend))))
(if (> ppre pre)
(list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
obeg
oend))
- (goto-char obeg)
- (sweeprolog--backward-term pre))
- (goto-char obeg)
- (sweeprolog--backward-term pre)))))
- (`(symbol ,obeg ,oend)
- (if-let ((opre (sweeprolog-op-infix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> opre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond infix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char obeg)
- (sweeprolog--backward-term pre))
- (if-let ((ppre (sweeprolog-op-prefix-precedence
- (buffer-substring-no-properties obeg oend))))
- (if (> ppre pre)
- (signal 'scan-error
- (list (format "Cannot scan backwards beyond prefix operator of higher precedence %s." opre)
- obeg
- oend))
- (goto-char obeg)
- (sweeprolog--backward-term pre))
- (goto-char obeg)
- (sweeprolog--backward-term pre))))
- (`(close ,lbeg ,_lend)
- (goto-char (nth 1 (syntax-ppss lbeg)))
- (when (or (= (char-syntax (char-before)) ?w)
- (= (char-syntax (char-before)) ?_))
- (skip-syntax-backward "w_"))
- (sweeprolog--backward-term pre))
- (`(,_ ,lbeg ,_)
- (goto-char lbeg)
- (sweeprolog--backward-term pre))))
+ (goto-char obeg))
+ (goto-char obeg))))
+ (`(close ,lbeg ,_lend)
+ (goto-char (nth 1 (syntax-ppss lbeg)))
+ (when (or (= (char-syntax (char-before)) ?w)
+ (= (char-syntax (char-before)) ?_))
+ (skip-syntax-backward "w_")))
+ (`(,_ ,lbeg ,_)
+ (goto-char lbeg)))))
(defun sweeprolog-backward-term (pre)
(condition-case _
(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)
- (add-hook 'completion-at-point-functions #'sweeprolog-completion-at-point-function nil t)
- (add-hook 'completion-at-point-functions #'sweeprolog-variable-completion-at-point nil t)
(when sweeprolog-analyze-buffer-on-idle
(setq sweeprolog--timer
(run-with-idle-timer
projects / sweep.git / commitdiff