Company backend for utop completion
This commit is contained in:
parent
730a8aeac1
commit
1f3a5d66ef
|
@ -992,6 +992,18 @@ module Emacs(M : sig end) = struct
|
||||||
loop_commands history_prev history_next
|
loop_commands history_prev history_next
|
||||||
else
|
else
|
||||||
loop ()
|
loop ()
|
||||||
|
| Some ("complete-company", _) ->
|
||||||
|
let input = read_data () in
|
||||||
|
let _, words =
|
||||||
|
UTop_complete.complete
|
||||||
|
~syntax:(UTop.get_syntax ())
|
||||||
|
~phrase_terminator:(UTop.get_phrase_terminator ())
|
||||||
|
~input
|
||||||
|
in
|
||||||
|
send "completion-start" "";
|
||||||
|
List.iter (fun (w, _) -> send "completion" w) words;
|
||||||
|
send "completion-stop" "";
|
||||||
|
loop_commands history_prev history_next
|
||||||
| Some ("complete", _) ->
|
| Some ("complete", _) ->
|
||||||
let input = read_data () in
|
let input = read_data () in
|
||||||
let start, words =
|
let start, words =
|
||||||
|
|
|
@ -230,6 +230,10 @@ end-pos-with-comments)." )
|
||||||
Non-nil means skip to the end of the phrase after evaluation in the
|
Non-nil means skip to the end of the phrase after evaluation in the
|
||||||
Caml toplevel")
|
Caml toplevel")
|
||||||
|
|
||||||
|
(defvar utop--complete-k (lambda (_candidates) '())
|
||||||
|
"continuation function to populate the candidates for the company
|
||||||
|
backend")
|
||||||
|
|
||||||
;; +-----------------------------------------------------------------+
|
;; +-----------------------------------------------------------------+
|
||||||
;; | Compability with different ocaml major modes |
|
;; | Compability with different ocaml major modes |
|
||||||
;; +-----------------------------------------------------------------+
|
;; +-----------------------------------------------------------------+
|
||||||
|
@ -619,11 +623,12 @@ it is started."
|
||||||
;; End of completion
|
;; End of completion
|
||||||
("completion-stop"
|
("completion-stop"
|
||||||
(utop-set-state 'edit)
|
(utop-set-state 'edit)
|
||||||
(if (> (length utop-completion) 1)
|
;; (if (> (length utop-completion) 1)
|
||||||
(with-current-buffer utop-complete-buffer
|
;; (with-current-buffer utop-complete-buffer
|
||||||
(with-output-to-temp-buffer "*Completions*"
|
;; (with-output-to-temp-buffer "*Completions*"
|
||||||
(display-completion-list (nreverse utop-completion))))
|
;; (display-completion-list (nreverse utop-completion))))
|
||||||
(minibuffer-hide-completions))
|
;; (minibuffer-hide-completions))
|
||||||
|
(funcall utop--complete-k (nreverse utop-completion))
|
||||||
(setq utop-completion nil)))))
|
(setq utop-completion nil)))))
|
||||||
|
|
||||||
(defun utop-process-output (_process output)
|
(defun utop-process-output (_process output)
|
||||||
|
@ -711,7 +716,7 @@ If ADD-TO-HISTORY is t then the input will be added to history."
|
||||||
;; We are now waiting for completion
|
;; We are now waiting for completion
|
||||||
(utop-set-state 'comp)
|
(utop-set-state 'comp)
|
||||||
;; Send all lines to utop
|
;; Send all lines to utop
|
||||||
(utop-send-string "complete:\n")
|
(utop-send-string "complete-company:\n")
|
||||||
(while lines
|
(while lines
|
||||||
;; Send the line
|
;; Send the line
|
||||||
(utop-send-string (concat "data:" (car lines) "\n"))
|
(utop-send-string (concat "data:" (car lines) "\n"))
|
||||||
|
@ -1122,6 +1127,8 @@ See https://github.com/diml/utop for configuration information."))
|
||||||
(make-local-variable 'utop-pending-position)
|
(make-local-variable 'utop-pending-position)
|
||||||
(make-local-variable 'utop-pending-entry)
|
(make-local-variable 'utop-pending-entry)
|
||||||
|
|
||||||
|
(make-local-variable 'utop--complete-k)
|
||||||
|
|
||||||
;; Set the hook to call before changing the buffer
|
;; Set the hook to call before changing the buffer
|
||||||
(add-hook 'before-change-functions 'utop-before-change nil t)
|
(add-hook 'before-change-functions 'utop-before-change nil t)
|
||||||
|
|
||||||
|
@ -1131,6 +1138,10 @@ See https://github.com/diml/utop for configuration information."))
|
||||||
;; Save history before killing the buffer
|
;; Save history before killing the buffer
|
||||||
(add-hook 'kill-buffer-query-functions (lambda () (utop-save-history) t) nil t)
|
(add-hook 'kill-buffer-query-functions (lambda () (utop-save-history) t) nil t)
|
||||||
|
|
||||||
|
;; add company completion hook:
|
||||||
|
(with-eval-after-load 'company
|
||||||
|
(add-to-list 'company-backends #'utop-company-backend))
|
||||||
|
|
||||||
;; Start utop
|
;; Start utop
|
||||||
(utop-start (utop-arguments)))
|
(utop-start (utop-arguments)))
|
||||||
;; +-----------------------------------------------------------------+
|
;; +-----------------------------------------------------------------+
|
||||||
|
@ -1177,6 +1188,20 @@ Special keys for utop:
|
||||||
(with-current-buffer buf (utop-mode)))))
|
(with-current-buffer buf (utop-mode)))))
|
||||||
buf))
|
buf))
|
||||||
|
|
||||||
|
(defun utop-company-backend (command &optional _arg &rest ignored)
|
||||||
|
"company backend for utop completions"
|
||||||
|
(interactive (list 'interactive))
|
||||||
|
(pcase command
|
||||||
|
('interactive (company-begin-backend 'utop-company-backend))
|
||||||
|
('sorted t)
|
||||||
|
('prefix (company-grab-symbol))
|
||||||
|
('candidates
|
||||||
|
(progn
|
||||||
|
`(:async
|
||||||
|
. ,(lambda (k)
|
||||||
|
(setq utop--complete-k k)
|
||||||
|
(call-interactively #'utop-complete)))))))
|
||||||
|
|
||||||
(provide 'utop-minor-mode)
|
(provide 'utop-minor-mode)
|
||||||
(provide 'utop)
|
(provide 'utop)
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue