bug#47711: bug#48841: bug#47711: bug#48841: bug#47711: [PATCH VERSION 2] Add new `completion-filter-completions` API and deferred highlighting

["João Távora" <joaotavora@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 2023 bytes --]

João Távora <joaotavora@gmail.com> writes:

>>  and then get rid of the hash-table altogether?
>
> Stefan, again we think alike, I'm taking care of that, the hash table
> and the gensym aren't needed at all.

Here's a revised patch without the hash table (actually a patch on top
of the other one, but I send the two of them again).

completion-lazy-hilit is simply bound in icomplete.el's
icomplete-exhibit.

I don't recall exactly why I used to set it in the hook to a gensym in
2021.  I think it was because I was setting face properties on reused
strings (not just score) and that caused problems when switching
completion styles.  But I don't think that can happen anymore, so no
need for that.

>> Hmm... in order to get the right result you need to call
>> `completion-lazy-hilit` sometime after calling
>> `completion-all-completions` and before the next call to
>> `completion-all-completions` done with the same value of
>> `completion-lazy-hilit`, right?

Right, it used to be something like that, but not anymore I think.  Now
the semantics, could be described informally as

   "called by the frontend in the hopes that the style got the hint,
    which will speed things up significantly -- but if the hint wasn't
    caught that's OK too".

>> How much more expensive is it to replace the 

>>     (mapc (lambda (str)
>>             (put-text-property 0 1 'completion-score (funcall score str) str))
>>           completions))

>> with something like

>>     (let ((tail `(completion-lazy-hilit (completion--hilit-from-re ,re))))
>>       (mapc (lambda (str)
>>               (add-text-properties
>>                0 1 `(completion-score ,(funcall score str) ,@tail) str))
>>             completions))


I get the idea, I think but I think it would be somewhat more expensive,
at it is similar to my earlier patch which stored more stuff in every
string which Dmitry (and then I) measured to be slower.  But feel free
to experiment, of course.

João


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-completion-frontends-to-highlight-completion-s.patch --]
[-- Type: text/x-patch, Size: 15907 bytes --]

From 09ac2a87cb95d31acdefa3b4920449da2cb848fb Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= <joaotavora@gmail.com>
Date: Wed, 25 Oct 2023 13:45:01 +0100
Subject: [PATCH 1/2] Allow completion frontends to highlight completion
 strings just-in-time

This allows completion-pcm--hilit-commonality to be sped up
substantially.

Introduce a new variable completion-lazy-hilit that allows for
completion frontends to opt-in an time-saving optimization by some
completions styles, such as the 'flex' and 'pcm' styles.

The variable must be bound or set by the frontend to a unique value
around a completion attempt/session.  See completion-lazy-hilit
docstring for more info.

* lisp/icomplete.el (icomplete-minibuffer-setup): Set completion-lazy-hilit.
(icomplete--render-vertical): Call completion-lazy-hilit.
(icomplete-completions): Call completion-lazy-hilit.

* lisp/minibuffer.el (completion-lazy-hilit): New variable.
(completion-lazy-hilit)
(completion--hilit-from-re): New functions.
(completion--lazy-hilit-table): New variable.
(completion--flex-score-1): New helper.
(completion-pcm--hilit-commonality): Use completion-lazy-hilit.
---
 lisp/icomplete.el  |   9 +-
 lisp/minibuffer.el | 262 +++++++++++++++++++++++++++++----------------
 2 files changed, 173 insertions(+), 98 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index e6fdd1f1836..a9ac0b3f040 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -545,6 +545,7 @@ icomplete-minibuffer-setup
     (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)
@@ -754,12 +755,13 @@ icomplete-exhibit
                            (overlay-end rfn-eshadow-overlay)))
           (let* ((field-string (icomplete--field-string))
                  (text (while-no-input
+                         (benchmark-progn
                          (icomplete-completions
                           field-string
                           (icomplete--completion-table)
                           (icomplete--completion-predicate)
                           (if (window-minibuffer-p)
-                              (eq minibuffer--require-match t)))))
+                              (eq minibuffer--require-match t))))))
                  (buffer-undo-list t)
                  deactivate-mark)
             ;; Do nothing if while-no-input was aborted.
@@ -901,7 +903,7 @@ icomplete--render-vertical
                                 'icomplete-selected-match 'append comp)
      collect (concat prefix
                      (make-string (- max-prefix-len (length prefix)) ? )
-                     comp
+                     (completion-lazy-hilit comp)
                      (make-string (- max-comp-len (length comp)) ? )
                      suffix)
      into lines-aux
@@ -1067,7 +1069,8 @@ icomplete-completions
                   (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))))
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 2120e31775e..4591f1145c8 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3749,108 +3749,180 @@ flex-score-match-tightness
 than the latter (which has two \"holes\" and three
 one-letter-long matches).")
 
+(defvar-local completion-lazy-hilit nil
+  "If non-nil, request completion lazy hilighting.
+
+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 only the completion strings
+that are meant to be displayed to the user.  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
+should be unique to each completion attempt or session that
+utilizes the same completion style in `completion-styles-alist'.
+For frontends using the minibuffer as the locus of completion
+calls and display, setting it to a buffer-local value given by
+`gensym' is appropriate.  For frontends operating entirely in a
+single command, 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'.")
+
+(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."
+  (completion--hilit-from-re
+   (copy-sequence str)
+   (gethash completion-lazy-hilit completion--lazy-hilit-table)))
+
+(defun completion--hilit-from-re (string regexp)
+  "Fontify STRING with `completions-common-part' using REGEXP."
+  (let* ((md (and regexp (string-match regexp string) (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 string)
+      (setq from (pop md)))
+    (unless (or (not me) (= from me))
+      (add-face-text-property from me 'completions-common-part nil string))
+    string))
+
+(defun completion--flex-score-1 (md match-end len)
+  "Compute matching score of completion.
+The score lies in the range between 0 and 1, where 1 corresponds to
+the full match.
+MD is the match data.
+MATCH-END is the end of the match.
+LEN is the length of the completion string."
+  (let* ((from 0)
+         ;; To understand how this works, consider these simple
+         ;; ascii diagrams showing how the pattern "foo"
+         ;; flex-matches "fabrobazo", "fbarbazoo" and
+         ;; "barfoobaz":
+
+         ;;      f abr o baz o
+         ;;      + --- + --- +
+
+         ;;      f barbaz oo
+         ;;      + ------ ++
+
+         ;;      bar foo baz
+         ;;          +++
+
+         ;; "+" indicates parts where the pattern matched.  A
+         ;; "hole" in the middle of the string is indicated by
+         ;; "-".  Note that there are no "holes" near the edges
+         ;; of the string.  The completion score is a number
+         ;; bound by (0..1] (i.e., larger than (but not equal
+         ;; to) zero, and smaller or equal to one): the higher
+         ;; the better and only a perfect match (pattern equals
+         ;; string) will have score 1.  The formula takes the
+         ;; form of a quotient.  For the numerator, we use the
+         ;; number of +, i.e. the length of the pattern.  For
+         ;; the denominator, it first computes
+         ;;
+         ;;     hole_i_contrib = 1 + (Li-1)^(1/tightness)
+         ;;
+         ;; , for each hole "i" of length "Li", where tightness
+         ;; is given by `flex-score-match-tightness'.  The
+         ;; final value for the denominator is then given by:
+         ;;
+         ;;    (SUM_across_i(hole_i_contrib) + 1) * len
+         ;;
+         ;; , where "len" is the string's length.
+         (score-numerator 0)
+         (score-denominator 0)
+         (last-b 0))
+    (while md
+      (let ((a from)
+            (b (pop md)))
+        (setq
+         score-numerator   (+ score-numerator (- b a)))
+        (unless (or (= a last-b)
+                    (zerop last-b)
+                    (= a len))
+          (setq
+           score-denominator (+ score-denominator
+                                1
+                                (expt (- a last-b 1)
+                                      (/ 1.0
+                                         flex-score-match-tightness)))))
+        (setq
+         last-b              b))
+      (setq from (pop md)))
+    ;; If `pattern' doesn't have an explicit trailing any, the
+    ;; regex `re' won't produce match data representing the
+    ;; region after the match.  We need to account to account
+    ;; for that extra bit of match (bug#42149).
+    (unless (= from match-end)
+      (let ((a from)
+            (b match-end))
+        (setq
+         score-numerator   (+ score-numerator (- b a)))
+        (unless (or (= a last-b)
+                    (zerop last-b)
+                    (= a len))
+          (setq
+           score-denominator (+ score-denominator
+                                1
+                                (expt (- a last-b 1)
+                                      (/ 1.0
+                                         flex-score-match-tightness)))))
+        (setq
+         last-b              b)))
+    (/ score-numerator (* len (1+ score-denominator)) 1.0)))
+
+(defvar completion--lazy-hilit-table (make-hash-table :weakness 'key))
+
 (defun completion-pcm--hilit-commonality (pattern completions)
   "Show where and how well PATTERN matches COMPLETIONS.
 PATTERN, a list of symbols and strings as seen
 `completion-pcm--merge-completions', is assumed to match every
-string in COMPLETIONS.  Return a deep copy of COMPLETIONS where
-each string is propertized with `completion-score', a number
-between 0 and 1, and with faces `completions-common-part',
-`completions-first-difference' in the relevant segments."
+string in COMPLETIONS.
+
+If `completion-lazy-hilit' is nil, return a deep copy of
+COMPLETIONS where each string is propertized with
+`completion-score', a number between 0 and 1, and with faces
+`completions-common-part', `completions-first-difference' in the
+relevant segments.
+
+Else, if `completion-lazy-hilit' is t, return COMPLETIONS where
+each string now has a `completion-score' property and no
+highlighting."
   (cond
    ((and completions (cl-loop for e in pattern thereis (stringp e)))
     (let* ((re (completion-pcm--pattern->regex pattern 'group))
-           (point-idx (completion-pcm--pattern-point-idx pattern))
-           (case-fold-search completion-ignore-case)
-           last-md)
-      (mapcar
-       (lambda (str)
-	 ;; Don't modify the string itself.
-         (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)))
-                (match-end (match-end 0))
-                (md (cddr (setq last-md (match-data t last-md))))
-                (from 0)
-                (end (length str))
-                ;; To understand how this works, consider these simple
-                ;; ascii diagrams showing how the pattern "foo"
-                ;; flex-matches "fabrobazo", "fbarbazoo" and
-                ;; "barfoobaz":
-
-                ;;      f abr o baz o
-                ;;      + --- + --- +
-
-                ;;      f barbaz oo
-                ;;      + ------ ++
-
-                ;;      bar foo baz
-                ;;          +++
-
-                ;; "+" indicates parts where the pattern matched.  A
-                ;; "hole" in the middle of the string is indicated by
-                ;; "-".  Note that there are no "holes" near the edges
-                ;; of the string.  The completion score is a number
-                ;; bound by (0..1] (i.e., larger than (but not equal
-                ;; to) zero, and smaller or equal to one): the higher
-                ;; the better and only a perfect match (pattern equals
-                ;; string) will have score 1.  The formula takes the
-                ;; form of a quotient.  For the numerator, we use the
-                ;; number of +, i.e. the length of the pattern.  For
-                ;; the denominator, it first computes
-                ;;
-                ;;     hole_i_contrib = 1 + (Li-1)^(1/tightness)
-                ;;
-                ;; , for each hole "i" of length "Li", where tightness
-                ;; is given by `flex-score-match-tightness'.  The
-                ;; final value for the denominator is then given by:
-                ;;
-                ;;    (SUM_across_i(hole_i_contrib) + 1) * len
-                ;;
-                ;; , where "len" is the string's length.
-                (score-numerator 0)
-                (score-denominator 0)
-                (last-b 0)
-                (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)
-                   (setq
-                    score-numerator   (+ score-numerator (- b a)))
-                   (unless (or (= a last-b)
-                               (zerop last-b)
-                               (= a (length str)))
-                     (setq
-                      score-denominator (+ score-denominator
-                                           1
-                                           (expt (- a last-b 1)
-                                                 (/ 1.0
-                                                    flex-score-match-tightness)))))
-                   (setq
-                    last-b              b))))
-           (while md
-             (funcall update-score-and-face from (pop md))
-             (setq from (pop md)))
-           ;; If `pattern' doesn't have an explicit trailing any, the
-           ;; regex `re' won't produce match data representing the
-           ;; region after the match.  We need to account to account
-           ;; for that extra bit of match (bug#42149).
-           (unless (= from match-end)
-             (funcall update-score-and-face from match-end))
-           (if (> (length str) pos)
-               (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)))
-         str)
-       completions)))
+           last-md
+           (score (lambda (str)
+                    (unless (string-match re str)
+                      (error "Internal error: %s does not match %s" re str))
+                    (let* ((match-end (match-end 0))
+                           (md (cddr (setq last-md (match-data t last-md)))))
+                      (completion--flex-score-1 md match-end (length str))))))
+      (cond (completion-lazy-hilit
+             (puthash completion-lazy-hilit re completion--lazy-hilit-table)
+             (mapc (lambda (str)
+                     (put-text-property 0 1 'completion-score (funcall score str) str))
+                   completions))
+            (t
+             (mapcar
+              (lambda (str)
+                (setq str (copy-sequence str))
+                (put-text-property 0 1 'completion-score (funcall score str) str)
+                (completion--hilit-from-re str re)
+                str)
+              completions)))))
    (t completions)))
 
 (defun completion-pcm--find-all-completions (string table pred point
-- 
2.39.2


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-Replace-lazy-hilit-hash-table-with-something-simpler.patch --]
[-- Type: text/x-patch, Size: 6064 bytes --]

From 5c4449dc578903314f400461d13c4c08e02a18ef Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Jo=C3=A3o=20T=C3=A1vora?= <joaotavora@gmail.com>
Date: Wed, 25 Oct 2023 22:36:15 +0100
Subject: [PATCH 2/2] Replace lazy hilit hash table with something simpler

* lisp/icomplete.el (icomplete-minibuffer-setup): Don't set
completion-lazy-hilit.
(icomplete-exhibit): Set it here.

* lisp/minibuffer.el (completion-lazy-hilit): Rework docstring.
(completion-lazy-hilit-fn): Rework from completion--lazy-hilit-re.
(completion--lazy-hilit-table): Delete.
(completion-pcm--hilit-commonality): Rework.
---
 lisp/icomplete.el  |  4 ++--
 lisp/minibuffer.el | 42 +++++++++++++++++++++---------------------
 2 files changed, 23 insertions(+), 23 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index a9ac0b3f040..3e888c8b06a 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -545,7 +545,6 @@ icomplete-minibuffer-setup
     (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)
@@ -723,7 +722,8 @@ icomplete-exhibit
              ;; Check if still in the right buffer (bug#61308)
              (or (window-minibuffer-p) completion-in-region--data)
              (icomplete-simple-completing-p)) ;Shouldn't be necessary.
-    (let ((saved-point (point)))
+    (let ((saved-point (point))
+          (completion-lazy-hilit t))
       (save-excursion
         (goto-char (icomplete--field-end))
         ;; Insert the match-status information:
diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 4591f1145c8..4a727615afb 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -1234,6 +1234,7 @@ completion-all-completions
 POINT is the position of point within STRING.
 The return value is a list of completions and may contain the base-size
 in the last `cdr'."
+  (setq completion-lazy-hilit-fn nil)
   ;; FIXME: We need to additionally return the info needed for the
   ;; second part of completion-base-position.
   (completion--nth-completion 2 string table pred point metadata))
@@ -3753,24 +3754,16 @@ completion-lazy-hilit
   "If non-nil, request completion lazy hilighting.
 
 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.
+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 only the completion strings
-that are meant to be displayed to the user.  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
-should be unique to each completion attempt or session that
-utilizes the same completion style in `completion-styles-alist'.
-For frontends using the minibuffer as the locus of completion
-calls and display, setting it to a buffer-local value given by
-`gensym' is appropriate.  For frontends operating entirely in a
-single command, let-binding it to `gensym' is appropriate.
+that are meant to be displayed to the user.  This is done by
+calling `completion-lazy-hilit' on each such string, which
+produces the suitably propertized string.
 
 Note that the optimization enabled by variable is only actually
 performed some completions styles.  To others, it is a harmless
@@ -3778,13 +3771,21 @@ completion-lazy-hilit
 advantage of this, look in the source of
 `completion-pcm--hilit-commonality'.")
 
+(defvar completion-lazy-hilit-fn nil
+  "Used by completions styles to honouring `completion-lazy-hilit'.
+When a given style wants to enable support for
+`completion-lazy-hilit' (which see), that style should set this
+variable to a function of one argument, a fresh string to be
+displayed to the user.  The function is responsible for
+destructively highlighting the string.")
+
 (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."
-  (completion--hilit-from-re
-   (copy-sequence str)
-   (gethash completion-lazy-hilit completion--lazy-hilit-table)))
+  (if (and completion-lazy-hilit completion-lazy-hilit-fn)
+      (funcall completion-lazy-hilit-fn (copy-sequence str))
+    str))
 
 (defun completion--hilit-from-re (string regexp)
   "Fontify STRING with `completions-common-part' using REGEXP."
@@ -3883,8 +3884,6 @@ completion--flex-score-1
          last-b              b)))
     (/ score-numerator (* len (1+ score-denominator)) 1.0)))
 
-(defvar completion--lazy-hilit-table (make-hash-table :weakness 'key))
-
 (defun completion-pcm--hilit-commonality (pattern completions)
   "Show where and how well PATTERN matches COMPLETIONS.
 PATTERN, a list of symbols and strings as seen
@@ -3911,7 +3910,8 @@ completion-pcm--hilit-commonality
                            (md (cddr (setq last-md (match-data t last-md)))))
                       (completion--flex-score-1 md match-end (length str))))))
       (cond (completion-lazy-hilit
-             (puthash completion-lazy-hilit re completion--lazy-hilit-table)
+             (setq completion-lazy-hilit-fn
+                   (lambda (str) (completion--hilit-from-re str re)))
              (mapc (lambda (str)
                      (put-text-property 0 1 'completion-score (funcall score str) str))
                    completions))
-- 
2.39.2