[elpa] 16/31: Tag candidates from grouped backends

[Dmitry Gutov]

dgutov pushed a commit to branch master
in repository elpa.

commit f84ee9494524ed3729d42f056001b32ec5b9e156
Author: Dmitry Gutov <address@hidden>
Date:   Tue Mar 11 08:32:25 2014 +0200

    Tag candidates from grouped backends
    
    Closes #25
---
 NEWS.md          |    2 ++
 company-tests.el |   28 ++++++++++++++++++++++++++--
 company.el       |   25 ++++++++++++++++++-------
 3 files changed, 46 insertions(+), 9 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 86136c7..da764ab 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,8 @@
 
 ## Next
 
+* Completion candidates returned from grouped back-ends are tagged to remember
+  which back-end each came from.
 * New user option `company-tooltip-align-annotations`, off by default.
 * New bundled back-end `company-bbdb`.
 
diff --git a/company-tests.el b/company-tests.el
index dca38b0..4ac5990 100644
--- a/company-tests.el
+++ b/company-tests.el
@@ -65,6 +65,28 @@
                    (candidates '("c" "d")))))))
     (should (equal (company-call-backend 'candidates "z") '("a" "b" "c" 
"d")))))
 
+(ert-deftest company-multi-backend-remembers-candidate-backend ()
+  (let ((company-backend
+         (list (lambda (command &optional arg &rest ignore)
+                 (case command
+                   (ignore-case nil)
+                   (annotation "1")
+                   (candidates '("a" "c"))
+                   (post-completion "13")))
+               (lambda (command &optional arg &rest ignore)
+                 (case command
+                   (ignore-case t)
+                   (annotation "2")
+                   (candidates '("b" "d"))
+                   (post-completion "42"))))))
+    (let ((candidates (company-calculate-candidates nil)))
+      (should (equal candidates '("a" "b" "c" "d")))
+      (should (equal t (company-call-backend 'ignore-case)))
+      (should (equal "1" (company-call-backend 'annotation (nth 0 
candidates))))
+      (should (equal "2" (company-call-backend 'annotation (nth 1 
candidates))))
+      (should (equal "13" (company-call-backend 'post-completion (nth 2 
candidates))))
+      (should (equal "42" (company-call-backend 'post-completion (nth 3 
candidates)))))))
+
 (ert-deftest company-begin-backend-failure-doesnt-break-company-backends ()
   (with-temp-buffer
     (insert "a")
@@ -285,7 +307,8 @@
     (search-backward "bb")
     (let ((col (company--column))
           (company-candidates-length 2)
-          (company-candidates '("123" "45")))
+          (company-candidates '("123" "45"))
+          (company-backend 'ignore))
       (company-pseudo-tooltip-show (company--row) col 0)
       (let ((ov company-pseudo-tooltip-overlay))
         ;; With margins.
@@ -352,7 +375,8 @@
 (ert-deftest company-create-lines-shows-numbers ()
   (let ((company-show-numbers t)
         (company-candidates '("x" "y" "z"))
-        (company-candidates-length 3))
+        (company-candidates-length 3)
+        (company-backend 'ignore))
     (should (equal '(" x 1 " " y 2 " " z 3 ")
                    (company--create-lines 0 999)))))
 
diff --git a/company.el b/company.el
index 2c7fa5f..fd01f74 100644
--- a/company.el
+++ b/company.el
@@ -302,7 +302,7 @@ If this many lines are not available, prefer to display the 
tooltip above."
                               company-xcode company-ropemacs company-cmake
                               ,@(when company--include-capf
                                   (list 'company-capf))
-                              (company-gtags company-etags company-dabbrev-code
+                              (company-dabbrev-code company-gtags company-etags
                                company-keywords)
                               company-oddmuse company-files company-dabbrev)
   "The list of active back-ends (completion engines).
@@ -776,17 +776,28 @@ means that `company-mode' is always turned on except in 
`message-mode' buffers."
                         collect b)))
     (case command
       (candidates
-       (loop for backend in backends
-             when (equal (funcall backend 'prefix)
-                         (car args))
-             append (apply backend 'candidates args)))
+       ;; 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)))))
       (sorted nil)
       (duplicates t)
-      (otherwise
+      ((prefix ignore-case no-cache require-match)
        (let (value)
          (dolist (backend backends)
            (when (setq value (apply backend command args))
-             (return value))))))))
+             (return value)))))
+      (otherwise
+       (let* ((arg (car args))
+              (backend (or (get-text-property 0 'company-backend arg)
+                           (car backends))))
+         (apply backend command args))))))
 
 ;;; completion mechanism 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;