Rewrite flex completion with Gotoh algorithm

The greedy regexp matching, broken scoring and broken highlight were
sources of frequent complaints about the 'flex' matching style.  This
commit fixes that.

Inspired by the 'hotfuzz' style (available at
https://github.com/axelf4/hotfuzz) it uses a modified version of Gotoh's
1982 dynamic programming algorithm. It is strictly more correct than the
"old" flex.  For example, when matching the pattern 'goto' to no longer
will 'eglot-format' be sorted before some hypothetical much better
'goobarbaz-goto'.  And of course the highlighting is also correctly
placed on the 'goto', not scattered across the candidate.

Regarding performance, it is faster than the naive 'flex', primarily
because of the Elisp rewrite in minibuffer.el.  The matching and costing
algorithm matters but is not the bottleneck.

The Elisp parts of the style were almost completely decoupled from the
pcm/substring styles in lisp/minibuffer.el.  Only
'completion-flex-try-completion' uses some of pcm's code for pattern
augmentation.

* src/minibuf.c (completion--flex-cost-gotoh): New function.

* lisp/minibuffer.el (completion-flex--pattern-str): New variable.
(flex-score-match-tightness): Make obsolete.
(completion--flex-all-completions-1): New helper function.
(completion-flex-try-completion, completion-flex-all-completions): Rewrite.
(completion-substring--all-completions): No longer take transform-pattern-fn.
(completion--flex-adjust-metadata): Tweak.
(completion--flex-score, completion--flex-score-1)
(completion--flex-score-last-md, completion-flex--make-flex-pattern): Delete.

* test/lisp/minibuffer-tests.el (completion--sorted-flex-completions):
New helper function.
(completion-flex-test-non-ascii): New test.
(completion--pcm-score): Delete.
(completion-pcm-test-3, completion-pcm-test-4)
(completion-substring-test-1, completion-substring-test-2)
(completion-flex-test-2, completion-flex-test-3): Tweak.

* etc/NEWS: Describe change.

etc/NEWS

@@ -311,6 +311,12 @@ It still can use 'read-key' when the variable
 It still can use 'read-key' when the variable
 'y-or-n-p-use-read-key' is non-nil.
 
+*** 'flex' completion style rewritten to be faster and more accurate.
+Completion and highlighting use a new superior algorithm.  For example,
+pattern "scope" now ranks 'elisp-scope-*' functions well above
+'dos-codepage' and 'test-completion'.  Pattern "botwin" finds
+'menu-bar-bottom-window-divider' before 'ibuffer-other-window'.
+
 ** Mouse
 
 *** New mode 'mouse-shift-adjust-mode' extends selection with 'S-<mouse-1>'.

lisp/minibuffer.el

@@ -770,7 +770,7 @@ for use at QPOS."
                    (add-text-properties 0 1 (text-properties-at 0 completion)
                                         qcompletion)
                    ;; Attach unquoted completion string, which is needed
-                   ;; to score the completion in `completion--flex-score'.
+                   ;; to score the completion in other styles
                    (put-text-property 0 1 'completion--unquoted
                                       completion qcompletion)
 		   ;; FIXME: Similarly here, Cygwin's mapping trips this
@@ -4450,19 +4450,6 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
 	    (when (string-match-p regex c) (push c poss)))
 	  (nreverse poss))))))
 
-(defvar flex-score-match-tightness 3
-  "Controls how the `flex' completion style scores its matches.
-
-Value is a positive number.  A number smaller than 1 makes the
-scoring formula reward matches scattered along the string, while
-a number greater than one make the formula reward matches that
-are clumped together.  I.e \"foo\" matches both strings
-\"fbarbazoo\" and \"fabrobazo\", which are of equal length, but
-only a value greater than one will score the former (which has
-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-lazy-hilit nil
   "If non-nil, request lazy highlighting of completion candidates.
 
@@ -4525,108 +4512,6 @@ from which REGEXP was generated."
       (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."
-  (let ((case-fold-search completion-ignore-case))
-    (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)))))
-
 (defvar completion-pcm--regexp nil
   "Regexp from PCM pattern in `completion-pcm--hilit-commonality'.")
 
@@ -4959,7 +4844,7 @@ the same set of elements."
 ;; Mostly derived from the code of `basic' completion.
 
 (defun completion-substring--all-completions
-    (string table pred point &optional transform-pattern-fn)
+    (string table pred point)
   "Match the presumed substring STRING to the entries in TABLE.
 Respect PRED and POINT.  The pattern used is a PCM-style
 substring pattern, but it be massaged by TRANSFORM-PATTERN-FN, if
@@ -4975,9 +4860,7 @@ that is non-nil."
                       basic-pattern
                     (cons 'prefix basic-pattern)))
          (pattern (completion-pcm--optimize-pattern
-                   (if transform-pattern-fn
-                       (funcall transform-pattern-fn pattern)
-                     pattern)))
+                   pattern))
          (all (completion-pcm--all-completions prefix pattern table pred)))
     (list all pattern prefix suffix (car bounds))))
 
@@ -4996,7 +4879,7 @@ that is non-nil."
     (when all
       (nconc (completion-pcm--hilit-commonality pattern all)
              (length prefix)))))
-
+
 ;;; "flex" completion, also known as flx/fuzzy/scatter completion
 ;; Completes "foo" to "frodo" and "farfromsober"
 
@@ -5005,11 +4888,34 @@ that is non-nil."
   :version "27.1"
   :type 'boolean)
 
-(put 'flex 'completion--adjust-metadata 'completion--flex-adjust-metadata)
+(defvar completion-flex--pattern-str nil
+  "Pattern string for flex completion scoring.
+This is the concatenated string parts from the PCM pattern,
+used by `completion--flex-cost' for Gotoh algorithm matching.")
+
+(defvar flex-score-match-tightness nil)
+
+(make-obsolete-variable
+ 'flex-score-match-tightness
+ "It never did anything very useful anyway."
+ "31.0")
+
+(cl-defun completion--flex-cost (pat str &optional dont-error)
+  "Compute flex cost of STR matching PAT using Gotoh algorithm.
+If DONT-ERROR, return nil if PAT cannot match STR.
+Return (NORMALIZED-COST . MATCHES) where NORMALIZED-COST is a
+number (lower = better) and MATCHES is a list of match positions in STR."
+  (pcase-let ((`(,cost . ,matches)
+               (completion--flex-cost-gotoh pat str)))
+    (unless cost
+      (if dont-error (cl-return-from completion--flex-cost nil)
+        (error "Pattern %s does not match %s" pat str)))
+    (cons (* (1+ cost) (- (length str) (length pat))) matches)))
 
 (defun completion--flex-adjust-metadata (metadata)
   "If `flex' is actually doing filtering, adjust sorting."
-  (let ((flex-is-filtering-p completion-pcm--regexp)
+  (let ((flex-is-filtering-p
+         (not (zerop (length completion-flex--pattern-str))))
         (existing-dsf
          (completion-metadata-get metadata 'display-sort-function))
         (existing-csf
@@ -5021,11 +4927,8 @@ that is non-nil."
                              (mapcar
                               (lambda (str)
                                 (cons
-                                 (- (completion--flex-score
-                                     (or (get-text-property
-                                          0 'completion--unquoted str)
-                                         str)
-                                     completion-pcm--regexp))
+                                 ;; Use pre-recorded flex-cost property
+                                 (get-text-property 0 'flex-cost str)
                                  str))
                               (if existing-sort-fn
                                   (funcall existing-sort-fn completions)
@@ -5044,30 +4947,48 @@ that is non-nil."
                `((cycle-sort-function . ,(compose-flex-sort-fn existing-csf))))
         ,@(cdr metadata)))))
 
-(defun completion-flex--make-flex-pattern (pattern)
-  "Convert PCM-style PATTERN into PCM-style flex pattern.
+(put 'flex 'completion--adjust-metadata 'completion--flex-adjust-metadata)
 
-This turns
-    (prefix \"foo\" point)
-into
-    (prefix \"f\" any \"o\" any \"o\" any point)
-which is at the core of flex logic.  The extra
-`any' is optimized away later on."
-  (mapcan (lambda (elem)
-            (if (stringp elem)
-                (mapcan (lambda (char)
-                          (list (string char) 'any))
-                        elem)
-              (list elem)))
-          pattern))
+(defun completion--flex-all-completions-1 (pat table pred point)
+  "Filters completions TABLE by PAT, \"flex\" string. PRED and POINT as
+usual. Returns (ALL PAT PREFIX SUFFIX)."
+  (let* ((beforepoint (substring pat 0 point))
+         (afterpoint (substring pat point))
+         (bounds (completion-boundaries beforepoint table pred afterpoint))
+         (prefix (substring beforepoint 0 (car bounds)))
+         (suffix (substring afterpoint (cdr bounds)))
+         (pat2 (substring pat (car bounds) (+ point (cdr bounds))))
+         (completion-regexp-list
+          (cons (mapconcat (lambda (c) (regexp-quote (char-to-string c)))
+                           pat2
+                           ".*")
+                completion-regexp-list))
+         (all (all-completions prefix table pred))
+         (all
+          (if (zerop (length pat2)) all
+            (cl-loop
+             for c in all
+             for c2 = (or (get-text-property 0 'completion--unquoted c) c)
+             for (cost . matches) = (completion--flex-cost pat2 c2 t)
+             when cost
+             collect (propertize
+                      c2 'flex-cost cost 'flex-matches matches)))))
+    (list all pat2 prefix suffix)))
 
-(defun completion-flex-try-completion (string table pred point)
+(cl-defun completion-flex-try-completion (string table pred point)
   "Try to flex-complete STRING in TABLE given PRED and POINT."
-  (unless (and completion-flex-nospace (string-search " " string))
-    (pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
-                 (completion-substring--all-completions
-                  string table pred point
-                  #'completion-flex--make-flex-pattern)))
+  (when (and completion-flex-nospace (string-search " " string))
+    (cl-return-from completion-flex-try-completion))
+  (pcase-let* ((`(,all ,pattern-str ,prefix ,suffix)
+                (completion--flex-all-completions-1 string table pred point))
+               (pcm-pattern
+                (cons
+                 'prefix
+                 (cl-loop with point-idx = (1- (- point (length prefix)))
+                          for x across pattern-str for i from 0
+                          collect (char-to-string x)
+                          collect (if (eq i point-idx)
+                                      'point 'any)))))
     (if minibuffer-completing-file-name
         (setq all (completion-pcm--filename-try-filter all)))
     ;; Try some "merging", meaning add as much as possible to the
@@ -5076,19 +4997,35 @@ which is at the core of flex logic.  The extra
     ;; contain the substring "config".  FIXME: this still won't
     ;; augment "foo" to "froo" when matching "frodo" and
     ;; "farfromsober".
-      (completion-pcm--merge-try pattern all prefix suffix))))
+    (completion-pcm--merge-try pcm-pattern all prefix suffix)))
 
-(defun completion-flex-all-completions (string table pred point)
+(cl-defun completion-flex-all-completions (string table pred point)
   "Get flex-completions of STRING in TABLE, given PRED and POINT."
-  (unless (and completion-flex-nospace (string-search " " string))
-    (pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
-                 (completion-substring--all-completions
-                  string table pred point
-                  #'completion-flex--make-flex-pattern)))
-      (when all
-        (nconc (completion-pcm--hilit-commonality pattern all)
-               (length prefix))))))
+  (when (and completion-flex-nospace (string-search " " string))
+    (cl-return-from completion-flex-all-completions))
+  (pcase-let ((`(,all ,pattern-str ,prefix ,_suffix)
+               (completion--flex-all-completions-1 string table pred point)))
+    (setq completion-lazy-hilit-fn
+          (lambda (str)
+            (when-let* ((matches (get-text-property 0 'flex-matches str)))
+              (dolist (pos matches)
+                (add-face-text-property pos (1+ pos)
+                                        'completions-common-part
+                                        nil str))
+              (let ((special-match (nth (1- (- point (length prefix))) matches)))
+                (when (and special-match (> (length str) (1+ special-match)))
+                  (add-face-text-property
+                   (1+ special-match) (+ 2 special-match)
+                   'completions-first-difference nil str))))
+            str))
+    (unless completion-lazy-hilit
+      (setq all (mapcar completion-lazy-hilit-fn all)))
+    ;; Store pattern for adjust-metadata to use
+    (setq completion-flex--pattern-str pattern-str)
+    ;; Return completions with base-size
+    (and all (if (string= prefix "") all (nconc all (length prefix))))))
 
+
 ;; Initials completion
 ;; Complete /ums to /usr/monnier/src or lch to list-command-history.
 

src/minibuf.c

@@ -2279,6 +2279,188 @@ init_minibuf_once_for_pdumper (void)
   last_minibuf_string = Qnil;
 }
 
+/* FLEX/GOTOH algorithm for the 'flex' completion-style.  Adapted from
+   GOTOH, Osamu.  An improved algorithm for matching biological
+   sequences. Journal of molecular biology, 1982, 162.3: 705-708.
+
+   This algorithm matches patterns to candidate strings, or needles to
+   haystacks.  It works with cost matrices: imagine rows of these
+   matrices as pattern characters, and columns as the candidate string
+   characters.  There is a -1 row, and a -1 column.  The values there
+   hold real costs used for situations "before the first ever" match of
+   a pattern character to a string character.
+
+   M and D are cost matrices.  At the end of the algorithm, M will have
+   non-infinite values only for the spots where a pattern character
+   matches a string character.  So a non-infinite M[i,j] means the i-th
+   character of the pattern matches the j-th character of the string.
+   The value stored is the lowest possible cost the algorithm had to
+   "pay" to be able to make that match there, given everything that may
+   have happened before/to the left.  An infinite value simply means no
+   match at this pattern/string position.  Note that both rows and
+   columns of M may have more than one match at multiple indices.  If
+   some row or column of M has no match at all, the final cost will be
+   infinite, and the funtion will return nil.
+
+   D (originally stands for 'Distance' in the Gotoh paper) has "running
+   costs".  Each value D[i,j] represents what the algorithm has to pay
+   to make or extend a gap when a match is found at i+1, j+1.  By that
+   time, that cost may or may not be lower than continuing from a match
+   that had also been found at i,j.  We always pick the lowest cost, and
+   by the time we reach the final column, we know we have picked the
+   cheapest possible path choosing when to gap, and when to follow up.
+
+   Here's an illustration of the final state of M and D when matching
+   "goto" to "eglot--goto".  Notice how the algorithm detects but
+   ultimately discards the scattered match at indexes 1,3,4,8, which
+   would have total cost 27, and ultimately settles on the match at
+   positions 7,8,9,10 which has cost 5:
+
+             -1  0  1  2  3  4  5  6  7  8  9 10
+              -  e  g  l  o  t  -  -  g  o  t  o
+   M:  -1  -  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞
+        0  g  ∞  ∞  5  ∞  ∞  ∞  ∞  ∞  5  ∞  ∞  ∞
+        1  o  ∞  ∞  ∞  ∞ 15  ∞  ∞  ∞  ∞  5  ∞ 16
+        2  t  ∞  ∞  ∞  ∞  ∞ 15  ∞  ∞  ∞  ∞  5  ∞
+        3  o  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞ 27  ∞  5
+
+   D:  -1  -  0  5  5  5  5  5  5  5  5  5  5  5
+        0  g  ∞  ∞  ∞ 15 16 17 18 19 20 15 16 17
+        1  o  ∞  ∞  ∞  ∞  ∞ 25 26 27 28 29 15 16
+        2  t  ∞  ∞  ∞  ∞  ∞  ∞ 25 26 27 28 29 15
+        3  o  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞  ∞ 37 38
+ **/
+DEFUN ("completion--flex-cost-gotoh", Fcompletion__flex_cost_gotoh,
+       Scompletion__flex_cost_gotoh, 2, 2, 0,
+       doc: /* Compute cost of PAT matching STR using modified Gotoh
+algorithm.  Return nil if no match found, else return (COST . MATCHES)
+where COST is a fixnum (lower is better) and MATCHES is a list of the
+same length as PAT.  Each i-th element is a FIXNUM indicating where in
+STR the i-th character of PAT matched.  */)
+  (Lisp_Object pat, Lisp_Object str)
+  {
+    /* Pre-allocated matrices for flex completion scoring.  */
+#define FLEX_MAX_STR_SIZE 512
+#define FLEX_MAX_PAT_SIZE 128
+#define FLEX_MAX_MATRIX_SIZE FLEX_MAX_PAT_SIZE * FLEX_MAX_STR_SIZE
+    /* Macro for 2D indexing into "flat" arrays.  */
+#define MAT(matrix, i, j) ((matrix)[((i) + 1) * width + ((j) + 1)])
+
+    CHECK_STRING (pat);
+    CHECK_STRING (str);
+
+    ptrdiff_t patlen = SCHARS (pat);
+    ptrdiff_t strlen = SCHARS (str);
+    ptrdiff_t width = strlen + 1;
+    ptrdiff_t size = (patlen + 1) * width;
+    const int gap_open_cost = 10;
+    const int gap_extend_cost = 1;
+    const int pos_inf = INT_MAX / 2;
+    static int M[FLEX_MAX_MATRIX_SIZE];
+    static int D[FLEX_MAX_MATRIX_SIZE];
+
+    /* Bail if strings are empty or matrix too large.  */
+    if (patlen == 0 || strlen == 0 || size > FLEX_MAX_MATRIX_SIZE)
+      return Qnil;
+
+    /* Initialize M and D with positive infinity...  */
+    for (int j = 0; j < size; j++)
+      M[j] = D[j] = pos_inf;
+    /* ...except for D[-1,-1], which is 0 to promote matches at the
+       beginning.  Rest of first row has gap_open_cost/2 for cheaper
+       leading gaps.  */
+    for (int j = 0; j < width; j++)
+      D[j] = gap_open_cost / 2;
+    D[0] = 0;
+
+    /* Poor man's iterator type: cur char idx, next char idx, next byte idx.  */
+    typedef struct iter { int x; ptrdiff_t n; ptrdiff_t b; } iter_t;
+
+    /* Position of first match found in the previous row, to save
+       iterations.  */
+    iter_t prev_match = { 0, 0, 0 };
+
+    /* Forward pass.  */
+    for (iter_t i = { 0, 0, 0 }; i.x < patlen; i.x++)
+      {
+	int pat_char = fetch_string_char_advance (pat, &i.n, &i.b);
+	bool match_seen = false;
+
+	for (iter_t j = prev_match; j.x < strlen; j.x++)
+	  {
+	    iter_t jcopy = j; /* else advance function destroys it...  */
+	    int str_char = fetch_string_char_advance (str, &j.n, &j.b);
+
+	    /* Check if characters match (case-insensitive if needed).  */
+	    bool cmatch;
+	    if (completion_ignore_case)
+	      cmatch = (downcase (pat_char) == downcase (str_char));
+	    else
+	      cmatch = (pat_char == str_char);
+
+	    if (cmatch)
+	      {
+		/* There is a match here, so compute match cost
+		   M[i][j], i.e. replace its infinite value with
+		   something finite.  */
+		if (!match_seen)
+		  {
+		    match_seen = true;
+		    prev_match = jcopy;
+		  }
+		/* Compute M[i,j]. If we pick M[i-1,j-1] it means that
+		   not only did the previous char also match (else
+		   M[i-1,j-1] would have been infinite) but following
+		   it up with this match is best overall.  If we pick
+		   D[i-1, j-1] it means that gapping is best,
+		   regardless of whether the previous char also
+		   matched.  That is, it's better to arrive at this
+		   match from a gap.  */
+		MAT (M, i.x, j.x) = min (MAT (M, i.x - 1, j.x - 1),
+					 MAT (D, i.x - 1, j.x - 1));
+	      }
+	    /* Regardless of a match here, compute D[i,j], the best
+	       accumulated gapping cost at this point, considering
+	       whether it's more advantageous to open from a previous
+	       match on this row (a cost which may well be infinite if
+	       no such match ever existed) or extend a gap started
+	       sometime before.  The next iteration will take this
+	       into account, and so will the next row when analyzing a
+	       possible match for the j+1-th string character.  */
+	    MAT (D, i.x, j.x)
+	      = min (MAT (M, i.x, j.x - 1) + gap_open_cost,
+		     MAT (D, i.x, j.x - 1) + gap_extend_cost);
+	  }
+      }
+    /* Find lowest cost in last row.  */
+    int best_cost = pos_inf;
+    int lastcol = -1;
+    for (int j = 0; j < strlen; j++)
+      {
+	int cost = MAT (M, patlen - 1, j);
+	if (cost < best_cost)
+	  {
+	    best_cost = cost;
+	    lastcol = j;
+	  }
+      }
+
+    /* Return early if no match.  */
+    if (lastcol < 0 || best_cost >= pos_inf)
+      return Qnil;
+
+    /* Go backwards to build match positions list.  */
+    Lisp_Object matches = Fcons (make_fixnum (lastcol), Qnil);
+    for (int i = patlen - 2, l = lastcol; i >= 0; --i)
+      {
+	do --l; while (l >= 0 && MAT (M, i, l) >= MAT (D, i, l));
+	matches = Fcons (make_fixnum (l), matches);
+      }
+
+    return Fcons (make_fixnum (best_cost), matches);
+#undef MAT
+  }
+
 void
 syms_of_minibuf (void)
 {
@@ -2541,6 +2723,7 @@ showing the *Completions* buffer, if any.  */);
   defsubr (&Stest_completion);
   defsubr (&Sassoc_string);
   defsubr (&Scompleting_read);
+  defsubr (&Scompletion__flex_cost_gotoh);
   DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit");
   DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer");
   DEFSYM (Qcompleting_read_function, "completing-read-function");

test/lisp/minibuffer-tests.el

@@ -205,11 +205,6 @@
                   '("some/alpha" "base/epsilon" "base/delta"))
                  `("epsilon" "delta" "beta" "alpha" "gamma"  . 5))))
 
-(defun completion--pcm-score (comp)
-  "Get `completion-score' from COMP."
-  ;; FIXME, uses minibuffer.el implementation details
-  (completion--flex-score comp completion-pcm--regexp))
-
 (defun completion--pcm-first-difference-pos (comp)
   "Get `completions-first-difference' from COMP."
   (cl-loop for pos = (next-single-property-change 0 'face comp)
@@ -244,20 +239,11 @@
            "barfoobar")))
 
 (ert-deftest completion-pcm-test-3 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-pcm-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion-pcm-all-completions
+                "R" '("R" "hello") nil 1))))
 
 (ert-deftest completion-pcm-test-4 ()
-  ;; One fourth of a match and no match due to point being at the end
-  (should (eql
-           (completion--pcm-score
-            (car (completion-pcm-all-completions
-                  "RO" '("RaOb") nil 1)))
-           (/ 1.0 4.0)))
+  ;; No match due to point being at the end
   (should (null
            (completion-pcm-all-completions
             "RO" '("RaOb") nil 2))))
@@ -420,24 +406,14 @@
            "a")))
 
 (ert-deftest completion-substring-test-1 ()
-  ;; One third of a match!
   (should (equal
            (car (completion-substring-all-completions
                  "foo" '("hello" "world" "barfoobar") nil 3))
-           "barfoobar"))
-  (should (eql
-           (completion--pcm-score
-            (car (completion-substring-all-completions
-                  "foo" '("hello" "world" "barfoobar") nil 3)))
-           (/ 1.0 3.0))))
+           "barfoobar")))
 
 (ert-deftest completion-substring-test-2 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-substring-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion-substring-all-completions
+                "R" '("R" "hello") nil 1))))
 
 (ert-deftest completion-substring-test-3 ()
   ;; Substring match
@@ -495,39 +471,75 @@
            (completion-substring-try-completion "b" '("ab" "ab") nil 0)
            '("ab" . 2))))
 
+(defun completion--sorted-flex-completions (pat list &optional point)
+  "Flex test helper"
+  (let ((all (completion-flex-all-completions pat list nil point)))
+    (setcdr (last all) nil)
+    (sort all
+          (lambda (a b)
+            (< (car (completion--flex-cost pat a))
+               (car (completion--flex-cost pat b)))))))
+
 (ert-deftest completion-flex-test-1 ()
-  ;; Fuzzy match
   (should (equal
            (car (completion-flex-all-completions
                  "foo" '("hello" "world" "fabrobazo") nil 3))
            "fabrobazo")))
 
 (ert-deftest completion-flex-test-2 ()
-  ;; Full match!
-  (should (eql
-           (completion--pcm-score
-            (car (completion-flex-all-completions
-                  "R" '("R" "hello") nil 1)))
-           1.0)))
+  (should (car (completion--sorted-flex-completions
+                "R" '("R" "hello") 1))))
 
 (ert-deftest completion-flex-test-3 ()
-  ;; Another fuzzy match, but more of a "substring" one
   (should (equal
-           (car (completion-flex-all-completions
-                 "custgroup" '("customize-group-other-window") nil 4))
+           (car (completion--sorted-flex-completions
+                 "custgroup" '("customize-group-other-window") 4))
            "customize-group-other-window"))
   ;; `completions-first-difference' should be at the right place
   (should (equal
            (completion--pcm-first-difference-pos
-            (car (completion-flex-all-completions
-                  "custgroup" '("customize-group-other-window") nil 4)))
+            (car (completion--sorted-flex-completions
+                  "custgroup" '("customize-group-other-window") 4)))
            4))
   (should (equal
            (completion--pcm-first-difference-pos
-            (car (completion-flex-all-completions
-                  "custgroup" '("customize-group-other-window") nil 9)))
+            (car (completion--sorted-flex-completions
+                  "custgroup" '("customize-group-other-window") 0)))
+           nil))
+  (should (equal
+           (completion--pcm-first-difference-pos
+            (car (completion--sorted-flex-completions
+                  "custgroup" '("customize-group-other-window") 9)))
            15)))
 
+(ert-deftest completion-flex-test-non-ascii ()
+  "Test flex completion with variable-width UTF-8 characters."
+  ;; Uses Japanese Kanji to test multi-byte character handling.
+
+  ;; 日本 = "nihon" (Japan), 東京 = "tōkyō" (Tokyo)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "日本" '("日本語" "日本" "中国") 2))
+           "日本"))
+
+  ;; 図書館 = "toshokan" (library)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "tsk" '("図書館-toshokan" "task" "desk") 3))
+           "task"))
+
+  ;; Mixed pattern (Kanji + ASCII) matching mixed string
+  ;; 学校 = "gakkō" (school)
+  (should (equal
+           (car (completion--sorted-flex-completions
+                 "学s" '("学校-school" "school" "学生") 2))
+           "学校-school"))
+
+  ;; Pattern "東" should match "東京" better than "関東"
+  (let ((results (completion--sorted-flex-completions
+                  "東" '("東京" "関東") 1)))
+    (should (equal (car results) "東京"))))
+
 
 (defmacro with-minibuffer-setup (completing-read &rest body)
   (declare (indent 1) (debug t))