From 8699e72f92524da8041f63949cf29858caded4a5 Mon Sep 17 00:00:00 2001
From: Dario Gjorgjevski <dario.gjorgjevski@gmail.com>
Date: Wed, 9 Sep 2020 12:10:52 +0200
Subject: [PATCH] Fix (and optimize) scoring in PCM completion
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit

* lisp/minibuffer.el (completion-pcm--hilit-commonality): Fix scoring
to also include the last part of the query string.  This was
especially evident for single-character query strings, e.g.,
‘(completion-flex-all-completions "1" '("1" "foo1") nil 1)’ would
match both "1" and "foo1" with a completion-score of 0.  This
adjustment makes the completion-score of "1" be 1 and of "foo1" by
0.25.  See also bug#42149.  Furthermore, some optimizations are done.
---
 lisp/minibuffer.el | 78 ++++++++++++++++++++++------------------------
 1 file changed, 37 insertions(+), 41 deletions(-)

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 62a33f3e2d..7fa132f3c5 100644
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3191,17 +3191,20 @@ one-letter-long matches).")
   (when completions
     (let* ((re (completion-pcm--pattern->regex pattern 'group))
            (point-idx (completion-pcm--pattern-point-idx pattern))
-           (case-fold-search completion-ignore-case))
+           (case-fold-search completion-ignore-case)
+           (score-numerator (float (apply #'+ (mapcar (lambda (part)
+                                                        (if (stringp part)
+                                                            (length part)
+                                                          0))
+                                                      pattern)))))
       (mapcar
        (lambda (str)
-	 ;; Don't modify the string itself.
+         ;; 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)))
                 (md (match-data))
-                (start (pop md))
-                (end (pop md))
                 (len (length str))
                 ;; To understand how this works, consider these bad
                 ;; ascii(tm) diagrams showing how the pattern "foo"
@@ -3237,47 +3240,40 @@ one-letter-long matches).")
                 ;;    (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
-                 (lambda (a b)
-                   "Update score variables given match range (A B)."
-                   (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))))
-           (funcall update-score start start)
+                (full-match-start (pop md))
+                (full-match-end (pop md))
+                (leading-hole-start (pop md))
+                (leading-hole-end (pop md))
+                (match-start leading-hole-end)
+                (score-denominator 0))
            (while md
-             (funcall update-score start (car md))
-             (add-face-text-property
-              start (pop md)
-              'completions-common-part
-              nil str)
-             (setq start (pop md)))
-           (funcall update-score len len)
+             (let ((hole-start (pop md))
+                   (hole-end (pop md)))
+               (add-face-text-property
+                match-start hole-start
+                'completions-common-part
+                nil str)
+               (unless (= hole-start hole-end)
+                 (setq
+                  score-denominator (+ score-denominator
+                                       1
+                                       (expt
+                                        (- hole-end hole-start 1)
+                                        (/ 1.0 flex-score-match-tightness)))))
+               (setq match-start hole-end)))
            (add-face-text-property
-            start end
+            match-start full-match-end
             'completions-common-part
             nil str)
-           (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 (* len (1+ score-denominator)) 1.0) str)))
+           (when (> len pos)
+             (add-face-text-property
+              pos (1+ pos)
+              'completions-first-difference
+              nil str))
+           (put-text-property
+            0 1
+            'completion-score
+            (/ score-numerator (* len (1+ score-denominator))) str))
          str)
        completions))))
 
-- 
2.17.1