From ce38a7d77f32b754e2655fa68fa1de153a3810a9 Mon Sep 17 00:00:00 2001 From: Dmitry Gutov Date: Mon, 20 Jun 2016 04:27:09 +0300 Subject: [PATCH] Replace :sorted with :separate, and sort within each chunk Closes #513 --- NEWS.md | 2 ++ company.el | 55 +++++++++++++++++++++++++++------------------- test/core-tests.el | 20 +++++++++++++++++ 3 files changed, 54 insertions(+), 23 deletions(-) diff --git a/NEWS.md b/NEWS.md index 96e72e8d3..d05048950 100644 --- a/NEWS.md +++ b/NEWS.md @@ -2,6 +2,8 @@ ## Next +* Group of backends can now contain keyword `:separate`, which makes candidates + from different backends sorted separately in the combined list. * The value of `company-dabbrev-ignore-buffers` can also be a function. * `company-files` has been moved to right after `company-capf` in `company-backends` diff --git a/company.el b/company.el index a92f67825..9e45e9258 100644 --- a/company.el +++ b/company.el @@ -426,11 +426,11 @@ call is dispatched to the backend the candidate came from. In other cases (except for `duplicates' and `sorted'), the first non-nil value among all the backends is returned. -The group can also contain keywords. Currently, `:with' and `:sorted' +The group can also contain keywords. Currently, `:with' and `:separate' keywords are defined. If the group contains keyword `:with', the backends listed after this keyword are ignored for the purpose of the `prefix' -command. If the group contains keyword `:sorted', the final list of -candidates is not sorted after concatenation. +command. If the group contains keyword `:separate', the candidates that +come from different backends are sorted separately in the combined list. Asynchronous backends ===================== @@ -919,19 +919,19 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (let ((backends (cl-loop for b in backends when (not (and (symbolp b) (eq 'failed (get b 'company-init)))) - collect b))) + collect b)) + (separate (memq :separate backends))) (when (eq command 'prefix) (setq backends (butlast backends (length (member :with backends))))) - (unless (memq command '(sorted)) - (setq backends (cl-delete-if #'keywordp backends))) + (setq backends (cl-delete-if #'keywordp backends)) (pcase command (`candidates - (company--multi-backend-adapter-candidates backends (car args))) - (`sorted (memq :sorted backends)) - (`duplicates t) + (company--multi-backend-adapter-candidates backends (car args) separate)) + (`sorted separate) + (`duplicates (not separate)) ((or `prefix `ignore-case `no-cache `require-match) (let (value) (cl-dolist (backend backends) @@ -945,26 +945,35 @@ matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons." (car backends)))) (apply backend command args)))))))) -(defun company--multi-backend-adapter-candidates (backends prefix) - (let ((pairs (cl-loop for backend in (cdr backends) +(defun company--multi-backend-adapter-candidates (backends prefix separate) + (let ((pairs (cl-loop for backend in 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--multi-candidates-mapper + backend + separate + ;; Small perf optimization: don't tag the + ;; candidates received from the first + ;; backend in the group. + (not (eq backend (car backends)))))))) (company--merge-async pairs (lambda (values) (apply #'append values))))) +(defun company--multi-candidates-mapper (backend separate tag) + (lambda (candidates) + (when separate + (let ((company-backend backend)) + (setq candidates + (company--preprocess-candidates candidates)))) + (when tag + (setq candidates + (mapcar + (lambda (str) + (propertize str 'company-backend backend)) + candidates))) + candidates)) + (defun company--merge-async (pairs merger) (let ((async (cl-loop for pair in pairs thereis diff --git a/test/core-tests.el b/test/core-tests.el index 666ed80e0..965307b6a 100644 --- a/test/core-tests.el +++ b/test/core-tests.el @@ -153,6 +153,26 @@ (should (equal '("abb" "abc" "abd" "acc" "acd") (company-call-backend 'candidates "a")))))) +(ert-deftest company-multi-backend-handles-keyword-separate () + (let ((one (lambda (command &optional _) + (cl-case command + (prefix "a") + (candidates '("aa" "ca" "ba"))))) + (two (lambda (command &optional _) + (cl-case command + (prefix "a") + (candidates '("bb" "ab"))))) + (tri (lambda (command &optional _) + (cl-case command + (prefix "a") + (sorted t) + (candidates '("cc" "bc" "ac")))))) + (let ((company-backend (list one two tri :separate))) + (should (company-call-backend 'sorted)) + (should-not (company-call-backend 'duplicates)) + (should (equal '("aa" "ba" "ca" "ab" "bb" "cc" "bc" "ac") + (company-call-backend 'candidates "a")))))) + (ert-deftest company-begin-backend-failure-doesnt-break-company-backends () (with-temp-buffer (insert "a") -- 2.39.2