[elpa] externals/cape 154145b0cb: cape-capf-super: Normalize plists attached to candidates

[ELPA Syncer]

branch: externals/cape
commit 154145b0cbf3241b4ac601004ec83122d8cace68
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    cape-capf-super: Normalize plists attached to candidates
    
    This helps with deduplication.
---
 CHANGELOG.org |  3 +++
 cape.el       | 44 ++++++++++++++++++++++++--------------------
 2 files changed, 27 insertions(+), 20 deletions(-)

diff --git a/CHANGELOG.org b/CHANGELOG.org
index 1360eccf69..5019f5a8f3 100644
--- a/CHANGELOG.org
+++ b/CHANGELOG.org
@@ -15,6 +15,9 @@
 - ~cape-capf-super~: If the resulting Capf is non-exclusive, one of the main 
Capfs
   must have returned candidates, in order for the resulting Capf to return
   candidates.
+- ~cape-capf-super~: Normalize plists which are attached to candidates. This 
helps
+  with deduplication, such that only candidates with different annotations or
+  icons appear twice.
 - ~cape-dabbrev-check-other-buffers~: Support function as customization value. 
The
   function should return the exact list of buffers to search.
 
diff --git a/cape.el b/cape.el
index 006cb31d71..ac82317c88 100644
--- a/cape.el
+++ b/cape.el
@@ -920,7 +920,11 @@ experimental."
                  (cand-ht nil)
                  (tables nil)
                  (exclusive nil)
-                 (prefix-len nil))
+                 (prefix-len nil)
+                 (cand-functions
+                  '(:company-docsig :company-location :company-kind
+                    :company-doc-buffer :company-deprecated
+                    :annotation-function :exit-function)))
       (cl-loop for (main beg2 end2 table . plist) in results do
                ;; TODO `cape-capf-super' currently cannot merge Capfs which
                ;; trigger at different beginning positions.  In order to 
support
@@ -928,7 +932,13 @@ experimental."
                ;; candidates by prefixing them such that they all start at the
                ;; smallest BEG position.
                (when (= beg beg2)
-                 (push `(,main ,table ,@plist) tables)
+                 (push (list main (plist-get plist :predicate) table
+                             ;; Plist attached to the candidates
+                             (mapcan (lambda (f)
+                                       (when-let ((v (plist-get plist f)))
+                                         (list f v)))
+                                     cand-functions))
+                       tables)
                  ;; The resulting merged Capf is exclusive if one of the main
                  ;; Capfs is exclusive.
                  (when (and main (not (eq (plist-get plist :exclusive) 'no)))
@@ -954,12 +964,10 @@ experimental."
              ('t ;; all-completions
               (let ((ht (make-hash-table :test #'equal))
                     (candidates nil))
-                (cl-loop for (main table . plist) in tables do
-                         (let* ((pr (if-let (pr (plist-get plist :predicate))
-                                        (if pred
-                                            (lambda (x) (and (funcall pr x) 
(funcall pred x)))
-                                          pr)
-                                      pred))
+                (cl-loop for (main table-pred table cand-plist) in tables do
+                         (let* ((pr (if (and table-pred pred)
+                                        (lambda (x) (and (funcall table-pred 
x) (funcall pred x)))
+                                      (or table-pred pred)))
                                 (md (completion-metadata "" table pr))
                                 (sort (or (completion-metadata-get md 
'display-sort-function)
                                           #'identity))
@@ -977,27 +985,25 @@ experimental."
                             (cond
                              ((eq dup t)
                               ;; Candidate does not yet exist.
-                              (puthash cand plist ht))
-                             ((not (equal dup plist))
+                              (puthash cand cand-plist ht))
+                             ((not (equal dup cand-plist))
                               ;; Duplicate candidate. Candidate plist is
                               ;; different, therefore disambiguate the
                               ;; candidates.
                               (setf cand (propertize cand 'cape-capf-super
-                                                     (cons cand plist))))))
+                                                     (cons cand 
cand-plist))))))
                            (when cands (push cands candidates))))
                 (when (or cand-ht candidates)
                   (setq candidates (apply #'nconc (nreverse candidates))
                         cand-ht ht)
                   candidates)))
              (_ ;; try-completion and test-completion
-              (cl-loop for (_main table . plist) in tables thereis
+              (cl-loop for (_main table-pred table _cand-plist) in tables 
thereis
                        (complete-with-action
                         action table str
-                        (if-let (pr (plist-get plist :predicate))
-                            (if pred
-                                (lambda (x) (and (funcall pr x) (funcall pred 
x)))
-                              pr)
-                          pred))))))
+                        (if (and table-pred pred)
+                            (lambda (x) (and (funcall table-pred x) (funcall 
pred x)))
+                          (or table-pred pred)))))))
         :company-prefix-length ,prefix-len
         ,@(and (not exclusive) '(:exclusive no))
         ,@(mapcan
@@ -1009,9 +1015,7 @@ experimental."
                                                  (and cand-ht (gethash cand 
cand-ht)))
                                              prop)))
                               (apply fun (or (car ref) cand) args))))))
-           '(:company-docsig :company-location :company-kind
-             :company-doc-buffer :company-deprecated
-             :annotation-function :exit-function))))))
+           cand-functions)))))
 
 ;;;###autoload
 (defun cape-wrap-debug (capf &optional name)