hmmm

* lisp/minibuffer.el (completion--get-lazy-hilit-re):
(completion--flex-get-completion-score): New functions.
(completion--flex-adjust-metadata): Use
completion--flex-get-completion-score.
(completion-lazy-hilit): Use completion--get-lazy-hilit-re.

lisp/icomplete.el

@@ -494,6 +494,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
     (setq-local icomplete--initial-input (icomplete--field-string))
     (setq-local completion-show-inline-help nil)
     (setq icomplete--scrolled-completions nil)
+    (setq completion-lazy-hilit (cl-gensym))
     (use-local-map (make-composed-keymap icomplete-minibuffer-map
     					 (current-local-map)))
     (add-hook 'post-command-hook #'icomplete-post-command-hook nil t)
@@ -800,7 +801,9 @@ Return a list of (COMP PREFIX SUFFIX)."
                (cl-return-from icomplete--render-vertical
                  (concat
                   " \n"
-                  (mapconcat #'identity torender icomplete-separator))))
+                  (mapconcat #'identity
+                             (mapcar #'completion-lazy-hilit torender)
+                             icomplete-separator))))
    for (comp prefix) in triplets
    maximizing (length prefix) into max-prefix-len
    maximizing (length comp) into max-comp-len
@@ -812,7 +815,7 @@ Return a list of (COMP PREFIX SUFFIX)."
     (cl-loop for (comp prefix suffix) in triplets
              concat prefix
              concat (make-string (- max-prefix-len (length prefix)) ? )
-             concat comp
+             concat (completion-lazy-hilit comp)
              concat (make-string (- max-comp-len (length comp)) ? )
              concat suffix
              concat icomplete-separator))))
@@ -962,7 +965,8 @@ matches exist."
                   (if (< prospects-len prospects-max)
                       (push comp prospects)
                     (setq limit t)))
-                (setq prospects (nreverse prospects))
+                (setq prospects
+                      (nreverse (mapcar #'completion-lazy-hilit prospects)))
                 ;; Decorate first of the prospects.
                 (when prospects
                   (let ((first (copy-sequence (pop prospects))))

lisp/minibuffer.el

@@ -3512,6 +3512,66 @@ one large \"hole\" and a clumped-together \"oo\" match) higher
 than the latter (which has two \"holes\" and three
 one-letter-long matches).")
 
+(defvar-local completion-lazy-hilit nil
+  "If non-nil, request lazy hilighting of completion matches.
+
+Completion-presenting frontends may opt to bind this variable to
+a unique non-nil value in the context of completion-producing
+calls (such as `completion-all-sorted-completions').  This hints
+the intervening completion styles that they do not need to
+propertize completion strings with the `face' property.
+
+When doing so, it is the frontend -- not the style -- who becomes
+responsible for `face'-propertizing the completion matches meant
+to be displayed to the user, frequently a small subset of all
+completion matches.  This can be done by calling the function
+`completion-lazy-hilit' which returns a `face'-propertized
+string.
+
+The value stored in this variable by the completion frontend must
+be unique to each completion attempt/session.  For instance,
+frontends which utilize the minibuffer as the locus of completion
+may set it to a buffer-local value returned by `gensym'.  For
+frontends operating within a recursive command loop, let-binding
+it to `gensym' is appropriate.
+
+Note that the optimization enabled by variable is only actually
+performed some completions styles.  To others, it is a harmless
+and useless hint.  To author a completion style that takes
+advantage of this, look in the source of
+`completion-pcm--hilit-commonality' for ideas.")
+
+(defvar completion--lazy-highlight-cache
+  (make-hash-table :weakness 'key))
+
+(defvar completion--score-map (make-hash-table :test 'eq))
+
+(defun completion--get-lazy-hilit-re ()
+  "Helper for `completion-lazy-hilit'."
+  (gethash completion-lazy-hilit completion--lazy-highlight-cache))
+
+(defun completion--flex-get-completion-score (str)
+  "Get the Flex completion score of STR"
+  (if completion-lazy-hilit
+      (gethash str completion--score-map)
+      (get-text-property 0 'completion-score str)))
+
+(defun completion-lazy-hilit (str)
+  "Return a copy of completion STR that is `face'-propertized.
+See documentation for variable `completion-lazy-hilit' for more
+details."
+  (let* ((str (copy-sequence str))
+         (re (completion--get-lazy-hilit-re))
+         (md (and re (string-match re str) (cddr (match-data t))))
+         (me (and md (match-end 0)))
+         (from 0))
+    (while md
+      (add-face-text-property from (pop md) 'completions-common-part nil str)
+      (setq from (pop md)))
+    (unless (or (not me) (= from me))
+      (add-face-text-property from me 'completions-common-part nil str))
+    str))
+
 (defun completion-pcm--hilit-commonality (pattern completions)
   "Show where and how well PATTERN matches COMPLETIONS.
 PATTERN, a list of symbols and strings as seen
@@ -3525,10 +3585,16 @@ between 0 and 1, and with faces `completions-common-part',
            (point-idx (completion-pcm--pattern-point-idx pattern))
            (case-fold-search completion-ignore-case)
            last-md)
+      (when completion-lazy-hilit
+        (puthash completion-lazy-hilit
+                 re
+                 completion--lazy-highlight-cache))
       (mapcar
        (lambda (str)
-	 ;; Don't modify the string itself.
-         (setq str (copy-sequence str))
+         (unless completion-lazy-hilit
+           ;; Make a copy of `str' since in this case we're about to
+           ;; `face'-propertize it.
+           (setq str (copy-sequence str)))
          (unless (string-match re str)
            (error "Internal error: %s does not match %s" re str))
          (let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
@@ -3576,9 +3642,10 @@ between 0 and 1, and with faces `completions-common-part',
                 (update-score-and-face
                  (lambda (a b)
                    "Update score and face given match range (A B)."
-                   (add-face-text-property a b
-                                           'completions-common-part
-                                           nil str)
+                   (unless completion-lazy-hilit
+                     (add-face-text-property a b
+                                             'completions-common-part
+                                             nil str))
                    (setq
                     score-numerator   (+ score-numerator (- b a)))
                    (unless (or (= a last-b)
@@ -3601,15 +3668,16 @@ between 0 and 1, and with faces `completions-common-part',
            ;; for that extra bit of match (bug#42149).
            (unless (= from match-end)
              (funcall update-score-and-face from match-end))
-           (if (> (length str) pos)
+           (if (and (> (length str) pos)
+                    (not completion-lazy-hilit))
                (add-face-text-property
                 pos (1+ pos)
                 'completions-first-difference
                 nil str))
-           (unless (zerop (length str))
-             (put-text-property
-              0 1 'completion-score
-              (/ score-numerator (* end (1+ score-denominator)) 1.0) str)))
+           (let ((score (/ score-numerator (* end (1+ score-denominator)) 1.0)))
+             (unless (zerop (length str))
+               (if completion-lazy-hilit (puthash str score completion--score-map)
+                 (put-text-property 0 1 'completion-score score str)))))
          str)
        completions))))
 
@@ -3963,8 +4031,8 @@ that is non-nil."
                  (funcall existing-sort-fn completions)
                completions)
              (lambda (c1 c2)
-               (let ((s1 (get-text-property 0 'completion-score c1))
-                     (s2 (get-text-property 0 'completion-score c2)))
+               (let ((s1 (completion--flex-get-completion-score c1))
+                     (s2 (completion--flex-get-completion-score c2)))
                  (> (or s1 0) (or s2 0))))))
            (;; If no existing sort fn and nothing flexy happening, use
             ;; the customary sorting strategy.