scratch/icomplete-lazy-highlight-attempt-2 dbfe6f7: Don't copy strings in completion-pcm--hilit-commanlity

[João Távora]

branch: scratch/icomplete-lazy-highlight-attempt-2
commit dbfe6f72e3608db4488bbc9bbc22d876746b1012
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Don't copy strings in completion-pcm--hilit-commanlity
---
 lisp/icomplete.el  |  9 ++++++---
 lisp/minibuffer.el | 38 +++++++++++++++++++++++++++++---------
 2 files changed, 35 insertions(+), 12 deletions(-)

diff --git a/lisp/icomplete.el b/lisp/icomplete.el
index adea150..f67c6f4 100644
--- a/lisp/icomplete.el
+++ b/lisp/icomplete.el
@@ -797,7 +797,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-pcm-lazy-hilit torender)
+                             icomplete-separator))))
    for (comp prefix) in triplets
    maximizing (length prefix) into max-prefix-len
    maximizing (length comp) into max-comp-len
@@ -809,7 +811,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-pcm-lazy-hilit comp)
              concat (make-string (- max-comp-len (length comp)) ? )
              concat suffix
              concat icomplete-separator))))
@@ -959,7 +961,8 @@ matches exist."
                   (if (< prospects-len prospects-max)
                       (push comp prospects)
                     (setq limit t)))
-                (setq prospects (nreverse prospects))
+                (setq prospects
+                      (nreverse (mapcar #'completion-pcm-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 1e8e9fc..ce0d981 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3512,6 +3512,24 @@ one large \"hole\" and a clumped-together \"oo\" match) 
higher
 than the latter (which has two \"holes\" and three
 one-letter-long matches).")
 
+(defvar completion-pcm--last-hacky-re nil)
+
+(defun completion-pcm-lazy-hilit (str)
+  (let* ((str (copy-sequence str)))
+    (when completion-pcm--last-hacky-re
+      (string-match completion-pcm--last-hacky-re str)
+      (let ((from 0)
+            (match-end (match-end 0))
+            (md (cddr (match-data t))))
+        (while md
+          (add-face-text-property from (pop md)
+                                  'completions-common-part nil str)
+          (setq from (pop md)))
+        (unless (= from match-end)
+          (add-face-text-property from match-end
+                                  '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
@@ -3527,10 +3545,11 @@ between 0 and 1, and with faces 
`completions-common-part',
            last-md)
       (mapcar
        (lambda (str)
-        ;; Don't modify the string itself.
-         (setq str (copy-sequence 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))
+         (setq completion-pcm--last-hacky-re re)
          (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))))
@@ -3576,9 +3595,9 @@ 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)
+                   ;; (add-face-text-property a b
+                   ;;                         'completions-common-part
+                   ;;                         nil str)
                    (setq
                     score-numerator   (+ score-numerator (- b a)))
                    (unless (or (= a last-b)
@@ -3602,10 +3621,11 @@ between 0 and 1, and with faces 
`completions-common-part',
            (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))
+               ;; (add-face-text-property
+               ;;  pos (1+ pos)
+               ;;  'completions-first-difference
+               ;;  nil str)
+             )
            (unless (zerop (length str))
              (put-text-property
               0 1 'completion-score