[elpa] master ce38a7d 166/173: Replace :sorted with :separate, and sort within each chunk

[Dmitry Gutov]

branch: master
commit ce38a7d77f32b754e2655fa68fa1de153a3810a9
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    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 96e72e8..d050489 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 a92f678..9e45e92 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 666ed80..965307b 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")