+ (cl-dolist (backend backends)
+ (when (setq value (company--force-sync
+ backend (cons command args) backend))
+ (cl-return value)))))
+ (_
+ (let ((arg (car args)))
+ (when (> (length arg) 0)
+ (let ((backend (or (get-text-property 0 'company-backend arg)
+ (car backends))))
+ (apply backend command args))))))))
+
+(defun company--multi-backend-adapter-candidates (backends prefix)
+ (let ((pairs (cl-loop for backend in (cdr backends)
+ when (equal (company--prefix-str
+ (funcall backend 'prefix))
+ prefix)
+ collect (cons (funcall backend 'candidates prefix)
+ (let ((b backend))
+ (lambda (candidates)
+ (mapcar
+ (lambda (str)
+ (propertize str 'company-backend b))
+ candidates)))))))
+ (when (equal (company--prefix-str (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 (cl-loop for pair in pairs
+ thereis
+ (eq :async (car-safe (car pair))))))
+ (if (not async)
+ (funcall merger (cl-loop for (val . mapper) in pairs
+ collect (funcall mapper val)))
+ (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)))))))))))))
+
+(defun company--prefix-str (prefix)
+ (or (car-safe prefix) prefix))