branch: externals/cape
commit 154145b0cbf3241b4ac601004ec83122d8cace68
Author: Daniel Mendler <m...@daniel-mendler.de>
Commit: Daniel Mendler <m...@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)
