(company-call 'self-insert-command 1))
(should (equal '("abc") company-candidates)))))
+(ert-deftest company-multi-backend-forces-prefix-to-sync ()
+ (with-temp-buffer
+ (let ((company-backend (list 'ignore
+ (lambda (command)
+ (should (eq command 'prefix))
+ (cons :async
+ (lambda (cb)
+ (run-with-timer
+ 0.01 nil
+ (lambda () (funcall cb nil))))))
+ (lambda (command)
+ (should (eq command 'prefix))
+ "foo"))))
+ (should (equal "foo" (company-call-backend-raw 'prefix))))
+ (let ((company-backend (list (lambda (_command)
+ (cons :async
+ (lambda (cb)
+ (run-with-timer
+ 0.01 nil
+ (lambda () (funcall cb "bar"))))))
+ (lambda (_command)
+ "foo"))))
+ (should (equal "bar" (company-call-backend-raw 'prefix))))))
+
+(ert-deftest company-multi-backend-merges-deferred-candidates ()
+ (with-temp-buffer
+ (let* ((immediate (lambda (command &optional arg)
+ (pcase command
+ (`prefix "foo")
+ (`candidates
+ (cons :async
+ (lambda (cb) (funcall cb '("f"))))))))
+ (company-backend (list 'ignore
+ (lambda (command &optional arg)
+ (pcase command
+ (`prefix "foo")
+ (`candidates
+ (should (equal arg "foo"))
+ (cons :async
+ (lambda (cb)
+ (run-with-timer
+ 0.01 nil
+ (lambda () (funcall cb '("a" "b")))))))))
+ (lambda (command &optional arg)
+ (pcase command
+ (`prefix "foo")
+ (`candidates '("c" "d" "e"))))
+ immediate)))
+ (should (equal :async (car (company-call-backend-raw 'candidates "foo"))))
+ (should (equal '("a" "b" "c" "d" "e" "f")
+ (company-call-backend 'candidates "foo")))
+ (let ((company-backend (list immediate)))
+ (should (equal '("f") (company-call-backend 'candidates "foo")))))))
+
;;; Template
(ert-deftest company-template-removed-after-the-last-jump ()
True asynchronous operation is only supported for command `candidates', and
only during idle completion. Other commands will block the user interface,
-even if the back-end uses the asynchronous calling convention.
-
-Grouped back-ends can't work asynchronously (yet)."
+even if the back-end uses the asynchronous calling convention."
:type `(repeat
(choice
:tag "Back-end"
(defun company-call-backend (&rest args)
(let ((val (apply #'company-call-backend-raw args)))
- (if (not (eq (car-safe val) :async))
- val
- (let ((res 'trash)
- (start (time-to-seconds)))
- (funcall (cdr val)
- (lambda (result) (setq res result)))
- (while (eq res 'trash)
- (if (> (- (time-to-seconds) start) company-async-timeout)
- (error "Company: Back-end %s async timeout with args %s"
- company-backend args)
- (sleep-for company-async-wait)))
- res))))
+ (company--force-sync val company-backend args)))
+
+(defun company--force-sync (value backend args)
+ (if (not (eq (car-safe value) :async))
+ value
+ (let ((res 'trash)
+ (start (time-to-seconds)))
+ (funcall (cdr value)
+ (lambda (result) (setq res result)))
+ (while (eq res 'trash)
+ (if (> (- (time-to-seconds) start) company-async-timeout)
+ (error "Company: Back-end %s async timeout with args %s"
+ backend args)
+ (sleep-for company-async-wait)))
+ res)))
(defun company-call-backend-raw (&rest args)
(condition-case err
(delq :with backends)))
(pcase command
(`candidates
- ;; Small perf optimization: don't tag the candidates received
- ;; from the first backend in the group.
- (append (apply (car backends) 'candidates args)
- (loop for backend in (cdr backends)
- when (equal (funcall backend 'prefix)
- (car args))
- append (mapcar
- (lambda (str)
- (propertize str 'company-backend backend))
- (apply backend 'candidates args)))))
+ (company--multi-backend-adapter-candidates backends (car args)))
(`sorted nil)
(`duplicates t)
((or `prefix `ignore-case `no-cache `require-match)
(let (value)
(dolist (backend backends)
- (when (setq value (apply backend command args))
+ (when (setq value (company--force-sync
+ (apply backend command args)
+ backend (cons command args)))
(return value)))))
(_
(let ((arg (car args)))
(car backends))))
(apply backend command args))))))))
+(defun company--multi-backend-adapter-candidates (backends prefix)
+ (let ((pairs (loop for backend in (cdr backends)
+ when (equal (funcall backend 'prefix)
+ prefix)
+ collect (cons (funcall backend 'candidates prefix)
+ (lambda (candidates)
+ (mapcar
+ (lambda (str)
+ (propertize str 'company-backend
+ backend))
+ candidates))))))
+ (when (equal (funcall (car backends) 'prefix) prefix)
+ ;; Small perf optimization: don't tag the candidates received
+ ;; from the first backend in the group.
+ (push (cons (funcall (car backends) 'candidates prefix)
+ 'identity)
+ pairs))
+ (company--merge-async pairs (lambda (values) (apply #'append values)))))
+
+(defun company--merge-async (pairs merger)
+ (let ((async (loop for (val . mapper) in pairs
+ thereis
+ (eq :async (car-safe val)))))
+ (if (not async)
+ (funcall merger (mapcar (lambda (pair)
+ (funcall (cdr pair) (car pair)))
+ pairs))
+ (cons
+ :async
+ (lambda (callback)
+ (let* (lst pending
+ (finisher (lambda ()
+ (unless pending
+ (funcall callback
+ (funcall merger
+ (nreverse lst)))))))
+ (dolist (pair pairs)
+ (let ((val (car pair))
+ (mapper (cdr pair)))
+ (if (not (eq :async (car-safe val)))
+ (push (funcall mapper val) lst)
+ (push nil lst)
+ (let ((cell lst)
+ (fetcher (cdr val)))
+ (push fetcher pending)
+ (funcall fetcher
+ (lambda (res)
+ (setq pending (delq fetcher pending))
+ (setcar cell (funcall mapper res))
+ (funcall finisher)))))))
+ (funcall finisher)))))))
+
;;; completion mechanism ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defvar company-prefix nil)