branch: master
commit 5ebcae8283b17198ce5f0ee94da7c38c11233259
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
Improve duplicates removal
Remove items with equal annotations, even when separated by item(s) with
different annotation(s). Provided the string values match, of course.
---
company.el | 26 +++++++++++++++-----------
test/core-tests.el | 40 ++++++++++++++++++++++++++++++++++++++++
2 files changed, 55 insertions(+), 11 deletions(-)
diff --git a/company.el b/company.el
index 6d5cc6d..4129189 100644
--- a/company.el
+++ b/company.el
@@ -1161,21 +1161,25 @@ can retrieve meta-data for them."
(company--transform-candidates candidates))
(defun company--strip-duplicates (candidates)
- (let ((c2 candidates))
+ (let ((c2 candidates)
+ (annos 'unk))
(while c2
(setcdr c2
- (let ((str (car c2))
- (anno 'unk))
- (pop c2)
+ (let ((str (pop c2)))
(while (let ((str2 (car c2)))
(if (not (equal str str2))
- nil
- (when (eq anno 'unk)
- (setq anno (company-call-backend
- 'annotation str)))
- (equal anno
- (company-call-backend
- 'annotation str2))))
+ (progn
+ (setq annos 'unk)
+ nil)
+ (when (eq annos 'unk)
+ (setq annos (list (company-call-backend
+ 'annotation str))))
+ (let ((anno2 (company-call-backend
+ 'annotation str2)))
+ (if (member anno2 annos)
+ t
+ (push anno2 annos)
+ nil))))
(pop c2))
c2)))))
diff --git a/test/core-tests.el b/test/core-tests.el
index b395c9f..13e547e 100644
--- a/test/core-tests.el
+++ b/test/core-tests.el
@@ -392,6 +392,46 @@
(company-complete-selection)
(should (string= "tea-cup" (buffer-string))))))
+(defvar ct-sorted nil)
+
+(defun ct-equal-including-properties (list1 list2)
+ (or (and (not list1) (not list2))
+ (and (ert-equal-including-properties (car list1) (car list2))
+ (ct-equal-including-properties (cdr list1) (cdr list2)))))
+
+(ert-deftest company-strips-duplicates-within-groups ()
+ (let* ((kvs '(("a" . "b")
+ ("a" . nil)
+ ("a" . "b")
+ ("a" . "c")
+ ("a" . "b")
+ ("b" . "c")
+ ("b" . nil)
+ ("a" . "b")))
+ (fn (lambda (kvs)
+ (mapcar (lambda (kv) (propertize (car kv) 'ann (cdr kv)))
+ kvs)))
+ (company-backend
+ (lambda (command &optional arg)
+ (pcase command
+ (`prefix "")
+ (`sorted ct-sorted)
+ (`duplicates t)
+ (`annotation (get-text-property 0 'ann arg)))))
+ (reference '(("a" . "b")
+ ("a" . nil)
+ ("a" . "c")
+ ("b" . "c")
+ ("b" . nil)
+ ("a" . "b"))))
+ (let ((ct-sorted t))
+ (should (ct-equal-including-properties
+ (company--preprocess-candidates (funcall fn kvs))
+ (funcall fn reference))))
+ (should (ct-equal-including-properties
+ (company--preprocess-candidates (funcall fn kvs))
+ (funcall fn (butlast reference))))))
+
;;; Row and column
(ert-deftest company-column-with-composition ()
