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: 5010 bytes --]

Dmitry Gutov <dmitry@gutov.dev> writes:

> but that can't be that reason.

Indeed it isn't.  But you're not far off, I think.  Anyway, in the
(completing-read "" obarray) scenario, the shortcut is taken, and that
and the fact that the optimization then completing skips scoring for it
-- which is blatantly wrong -- is why it is much faster.

Looking at this, it seems that string-match with a non-group-capturing
regexp over all the matches (the thing that the change was optimizing
away) isn't that expensive in the overall gist of things.

Thus in the C-h v case, the shortcut isn't taken and the optimization
does what it should, but nothing gargantuan, around 8-9%.  Also keep in
mind this yoyo case is pretty contrived and I suspect more realistic
cases would have even more modest gains.

My attempts to fix the optimization to work correctly in all cases
complicated the code and then slowed down the bare completion-read case.
Not worth it IMO, therefore I have reverted it in the branch and in the
latest patch I attach (lazy-hilit-2023-v4.diff).  Here are the latest
measurements for the "yoyo" test, now considering the C-h v scenario:

;; Daniel+Dmitry completin-read: 0.834s avg
;; Daniel+Dmitry C-h v:          0.988s avg
                                           
;; lazy-hilit completing-read:   0.825s avg
;; lazy-hilit C-h v:             0.946s avg

Again, this shows my patch to be about 2-4% faster, though not really
relevant.

Again, the optimization I removed, if it were done correctly (which it
wasn't) could maybe shave off another 8-9% off that.

> But there are differences. The first is that the highlighter function
> takes one string as an argument instead of a collection. I mentioned
> this before, this will be much handier to use in company-capf.

Don't fully follow this.  Can you perhaps show two versions (or two
snippets) of the company-capf code, the handy and the non-handy version?

> Second, in Daniel's patch the "adjust metadata" function got a
> different, arguably better, calling convention. That's not dependent
> on the rest of the patch, so it can be considered separately.

Maybe.  Changes to calling convention can be argued for but, when
possible, they shoudn't be in with performance improvements.

> Third, it made a principled stance to avoid altering the original
> strings, even the non-visual text properties. This approach could be
> adopted piecewise from Daniel's patch, especially if the performance
> ends up the same or insignificantly different in practical usage.

If we really wanted to, we could also adopt the non-propertizing
approach in my lazy-hilit patch, by calculating the score "just in
time", much like Daniel's patch does it.  But it should be clear that
what we save in allocation in completion-pcm--hilit-commonality, we'll
pay for in the same amount in consing later.  So no performance benefit.

And if we do that, don't forget there will be the ugly "unquoted"
complication to deal with.  Then again, in my understanding that
complication is due to similar problem of mixing business and display
logic.  That's assuming I understand this comment in minibuffer.el
correctly:

   ;; Here we choose to quote all elements returned, but a better option
   ;; would be to return unquoted elements together with a function to
   ;; requote them, so that *Completions* can show nicer unquoted values
   ;; which only get quoted when needed by choose-completion.

So I would look into solving that first, instead of allowing the
"unquoted" hacks to spread even further in minibuffer.el

> As for whether we migrate to the completion-filter-completions API, I
> don't have a strong opinion. If we still think that the next revision
> of the completion API will be radically different, then there is not
> much point in making medium-sized steps like that. OTOH, if we end up
> with the same API for the next decade and more,
> completion-filter-completions does look more meaningful, and more
> easily extensible (e.g. next we could add a pair (completion-scorer
> . fn) to its return value; and so on). And again, the implementation
> could be a simple wrapper at first.

I agree on some points, and looking at this from a API-convenience
standpoint I note two things:

* To get late highlighting in Daniel's patch, one has to use a whole new
  API entry function to gather completions, and another to fontify
  completions.  One also deprecates an existing member of the API.

* In my patch, one binds a new API varaible and uses a function to fontify
  completions.  No deprecations.

Even if it wasn't a much simpler change to minibuffer.el without any
backward-compatibility gymnastics, I still think the latter is much
cleaner and easier to implement for completion frontends.  The fact that
there's no deprecation of one of the most important members of the API
to date makes it more confortable to understand IMO.

João


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: lazy-hilit-2023-v4.diff --]
[-- Type: text/x-patch, Size: 15535 bytes --]

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index e6fdd1f1836..3e888c8b06a 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -722,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:
@@ -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..cd8eeee2c78 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))
@@ -3749,108 +3750,194 @@ 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 highlighting.
+
+Completion-presenting frontends may opt to bind this variable to
+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
+fontify (i.e. propertize with the `face' property) completion
+strings with highlights of the matching parts.
+
+When doing so, it is the frontend -- not the style -- who becomes
+responsible this fontification.  The frontend binds this variable
+to non-nil, and calls the function with the same name
+`completion-lazy-hilit' on each completion string that is to be
+displayed to the user.
+
+Note that only some completion styles take advantage of this
+variable for optimization purposes.  Other styles will ignore the
+hint and greedily fontify as usual.  It is still safe for a
+frontend to call `completion-lazy-hilit' in these situations.
+
+To author a completion style that takes advantage see
+`completion-lazy-hilit-fn' and 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."
+  (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."
+  (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-groups 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-GROUPS is the \"group\"  part of 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 (and md-groups (car md-groups))
+      (let ((a from)
+            (b (pop md-groups)))
+        (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-groups)))
+    ;; 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--flex-score-last-md nil
+  "Helper variable for `completion--flex-score'.")
+
+(defun completion--flex-score (str re &optional dont-error)
+  "Compute flex score of completion STR based on RE.
+If DONT-ERROR, just return nil if RE doesn't match STR."
+  (cond ((string-match re str)
+         (let* ((match-end (match-end 0))
+                (md (cddr
+                     (setq
+                      completion--flex-score-last-md
+                      (match-data t completion--flex-score-last-md)))))
+           (completion--flex-score-1 md match-end (length str))))
+        ((not dont-error)
+         (error "Internal error: %s does not match %s" re 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
 `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)))
+           (score (lambda (str)
+                    (put-text-property 0 1 'completion-score
+                                       (completion--flex-score str re)
+                                       str))))
+      (cond (completion-lazy-hilit
+             (setq completion-lazy-hilit-fn
+                   (lambda (str) (completion--hilit-from-re str re)))
+             (mapc score completions))
+            (t
+             (mapcar
+              (lambda (str)
+                (setq str (copy-sequence str))
+                (funcall score str)
+                (completion--hilit-from-re str re)
+                str)
+              completions)))))
    (t completions)))
 
 (defun completion-pcm--find-all-completions (string table pred point