emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] externals/vertico db83b0eb00 1/4: vertico--highlight: Take a sing


From: ELPA Syncer
Subject: [elpa] externals/vertico db83b0eb00 1/4: vertico--highlight: Take a single candidate
Date: Tue, 7 Nov 2023 15:58:58 -0500 (EST)

branch: externals/vertico
commit db83b0eb002550600cee00eccfc7f91991862227
Author: Daniel Mendler <mail@daniel-mendler.de>
Commit: Daniel Mendler <mail@daniel-mendler.de>

    vertico--highlight: Take a single candidate
---
 extensions/vertico-flat.el |  7 +++----
 extensions/vertico-grid.el |  2 +-
 vertico.el                 | 24 ++++++++++--------------
 3 files changed, 14 insertions(+), 19 deletions(-)

diff --git a/extensions/vertico-flat.el b/extensions/vertico-flat.el
index 3eb66d57cc..a9c2eec682 100644
--- a/extensions/vertico-flat.el
+++ b/extensions/vertico-flat.el
@@ -110,10 +110,9 @@
     (while (and candidates (not (eq wrapped (car candidates)))
                 (> width 0) (> count 0))
       (let ((cand (pop candidates)) (prefix "") (suffix ""))
-        (setq cand (funcall vertico--highlight (list cand)))
-        (pcase (and vertico-flat-annotate (vertico--affixate cand))
-          (`((,c ,p ,s)) (setq cand c prefix p suffix s))
-          (_ (setq cand (car cand))))
+        (setq cand (funcall vertico--highlight cand))
+        (pcase (and vertico-flat-annotate (vertico--affixate (list cand)))
+          (`((,c ,p ,s)) (setq cand c prefix p suffix s)))
         (when (string-search "\n" cand)
           (setq cand (vertico--truncate-multiline cand width)))
         (setq cand (string-trim
diff --git a/extensions/vertico-grid.el b/extensions/vertico-grid.el
index adb7708b9e..42fd3a95b7 100644
--- a/extensions/vertico-grid.el
+++ b/extensions/vertico-grid.el
@@ -134,7 +134,7 @@ When scrolling beyond this limit, candidates may be 
truncated."
           (thread-last
             (seq-subseq vertico--candidates start
                         (min (+ start count) vertico--total))
-            (funcall vertico--highlight)
+            (mapcar vertico--highlight)
             (funcall (if (> vertico-grid-annotate 0) #'vertico--affixate 
#'identity))
             (seq-map-indexed
              (lambda (cand index)
diff --git a/vertico.el b/vertico.el
index b1d10152ed..8f19f32fdb 100644
--- a/vertico.el
+++ b/vertico.el
@@ -269,10 +269,7 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
       (nconc (list (car found)) (delq (setcar found nil) list))
     list))
 
-;; bug#47711: Deferred highlighting for `completion-all-completions'
-;; XXX There is one complication: `completion--twq-all' already adds
-;; `completions-common-part'.  See below `vertico--candidate'.
-(defun vertico--all-completions (&rest args)
+(defun vertico--filter-completions (&rest args)
   "Compute all completions for ARGS with deferred highlighting."
   (cl-letf* ((orig-pcm (symbol-function #'completion-pcm--hilit-commonality))
              (orig-flex (symbol-function #'completion-flex-all-completions))
@@ -286,7 +283,7 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
              (hl #'identity)
              ((symbol-function #'completion-hilit-commonality)
               (lambda (cands prefix &optional base)
-                (setq hl (lambda (x) (nconc (completion-hilit-commonality x 
prefix base) nil)))
+                (setq hl (lambda (x) (car (completion-hilit-commonality (list 
x) prefix base))))
                 (and cands (nconc cands base))))
              ((symbol-function #'completion-pcm--hilit-commonality)
               (lambda (pattern cands)
@@ -294,15 +291,15 @@ The function is configured by BY, BSIZE, BINDEX, BPRED 
and PRED."
                            ;; `completion-pcm--hilit-commonality' sometimes 
throws an internal error
                            ;; for example when entering "/sudo:://u".
                            (condition-case nil
-                               (completion-pcm--hilit-commonality pattern x)
+                               (car (completion-pcm--hilit-commonality pattern 
(list x)))
                              (t x))))
                 cands)))
     ;; Only advise orderless after it has been loaded to avoid load order 
issues
     (if (and (fboundp 'orderless-highlight-matches) (fboundp 
'orderless-pattern-compiler))
         (cl-letf (((symbol-function 'orderless-highlight-matches)
                    (lambda (pattern cands)
-                     (let ((regexps (orderless-pattern-compiler pattern)))
-                       (setq hl (lambda (x) (orderless-highlight-matches 
regexps x))))
+                     (let ((rxs (orderless-pattern-compiler pattern)))
+                       (setq hl (lambda (x) (car (orderless-highlight-matches 
rxs (list x))))))
                      cands)))
           (cons (apply #'completion-all-completions args) hl))
       (cons (apply #'completion-all-completions args) hl))))
@@ -332,7 +329,7 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
                (field (substring content (car bounds) (+ pt (cdr bounds))))
                ;; `minibuffer-completing-file-name' has been obsoleted by the 
completion category
                (completing-file (eq 'file (vertico--metadata-get 'category)))
-               (`(,all . ,hl) (vertico--all-completions content table pred pt 
vertico--metadata))
+               (`(,all . ,hl) (vertico--filter-completions content table pred 
pt vertico--metadata))
                (base (or (when-let (z (last all)) (prog1 (cdr z) (setcdr z 
nil))) 0))
                (vertico--base (substring content 0 base))
                (def (or (car-safe minibuffer-default) minibuffer-default))
@@ -488,8 +485,8 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
   "Format group TITLE given the current CAND."
   (when (string-prefix-p title cand)
     ;; Highlight title if title is a prefix of the candidate
-    (setq title (substring (car (funcall vertico--highlight
-                                         (list (propertize cand 'face 
'vertico-group-title))))
+    (setq title (substring (funcall vertico--highlight
+                                    (propertize cand 'face 
'vertico-group-title))
                            0 (length title)))
     (vertico--remove-face 0 (length title) 'completions-first-difference 
title))
   (format (concat vertico-group-format "\n") title))
@@ -549,8 +546,7 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
         ;; `completion--twq-all' hack.  This should better be fixed in Emacs
         ;; itself, the corresponding code is already marked with a FIXME.
         (vertico--remove-face 0 (length cand) 'completions-common-part cand)
-        (concat vertico--base
-                (if hl (car (funcall vertico--highlight (list cand))) cand))))
+        (concat vertico--base (if hl (funcall vertico--highlight cand) cand))))
      ((and (equal content "") (or (car-safe minibuffer-default) 
minibuffer-default)))
      (t content))))
 
@@ -581,7 +577,7 @@ The function is configured by BY, BSIZE, BINDEX, BPRED and 
PRED."
            (candidates
             (thread-last (seq-subseq vertico--candidates index
                                      (min (+ index vertico-count) 
vertico--total))
-              (funcall vertico--highlight)
+              (mapcar vertico--highlight)
               (vertico--affixate))))
       (pcase-dolist ((and cand `(,str . ,_)) candidates)
         (when-let (new-title (and group-fun (funcall group-fun str nil)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]