Github/emacs
2
0
Fork 1
mirror of git://git.sv.gnu.org/emacs.git synced 2026-02-16 17:24:23 +00:00
Code Issues Projects Releases Packages Wiki Activity

Rewrite flex completion scoring with Gotoh algorithm

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

It was inspired by the 'hotfuzz' style available at
https://github.com/axelf4/hotfuzz which is a modified version of Gotoh's
1982 dynamic programming algorithm (see: GOTOH, Osamu. An improved
algorithm for matching biological sequences. Journal of molecular
biology, 1982, 162.3: 705-708.).  That style is slightly more
sophisticated than 'flex' (has special rules for matching things at word
boundaries, a C module with multithreading support).  It's almost (but not
entirely) void of hacks so it'd make a good candidate to replace 'flex'
entirely, but no progress has been made in getting it into Emacs's core
in over 2 years, so I thought I'd try my hand at it.

The new 'flex' implementation also uses Gotoh algorithm (apparently
a common choice for these kinds of task) and happens mostly in a new C
function.  It is strictly more correct than the "old" flex.  For
example, when matching the pattern 'goto' to, say, 'eglot--goto' and
'eglot--bol', no longer is the latter returned first, which was a
substantial annoyance.  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', but that's
mainly because this commit also includes changes to the Elisp code which
make faster regexp's for the filtering step.  It is slower than
'hotfuzz' when that style's C-module extension is leveraged.  'hotfuzz'
does the filtering and sorting steps together in C code and has
multithreaded workers there.  The matching and scoring algorithm itself
is not the bottleneck.

Test code were refactored and more tests were added.

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

* lisp/minibuffer.el (completion--flex-score): Rewrite.
(completion--flex-propertize): New function.
(completion-flex--pattern-str): New variable.
(flex-score-match-tightness): Make obsolete.
(completion-pcm--all-completions): Add optional override-re parameter.
(completion-pcm--hilit-commonality): No more re-based highlighting.
(completion-substring--all-completions): Add optional simple-re parameters.
(completion--flex-adjust-metadata): Tweak to new scoring API.
(completion-flex-try-completion, completion-flex-all-completions):
Pass simple-re parameter to completion-substring--all-completions.
(completion--hilit-from-re, completion--flex-score-1)
(completion--flex-score-last-md, completion-pcm--regexp): 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): Remove old scoring
expectations.
This commit is contained in:
João Távora 2026-02-03 12:14:03 +00:00
parent 3ea1010a6b
commit afb422bb98
3 changed files with 345 additions and 203 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

256
lisp/minibuffer.el
View file

@ -4421,9 +4421,12 @@ This is used in combination with `completion-pcm--segments->regex'."
(setq idx i)))
idx))
(defun completion-pcm--all-completions (prefix pattern table pred)
(defun completion-pcm--all-completions (prefix pattern table pred
&optional override-re)
"Find all completions for PATTERN in TABLE obeying PRED.
PATTERN is as returned by `completion-pcm--string->pattern'."
PATTERN is as returned by `completion-pcm--string->pattern'.
OVERRIDE-RE means to use this regular expression instead of grabbing one
from PATTERN."
;; (cl-assert (= (car (completion-boundaries prefix table pred ""))
;; (length prefix)))
;; Find an initial list of possible completions.
@ -4435,7 +4438,7 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
;; Use all-completions to do an initial cull. This is a big win,
;; since all-completions is written in C!
(let* (;; Convert search pattern to a standard regular expression.
(regex (completion-pcm--pattern->regex pattern))
(regex (or override-re (completion-pcm--pattern->regex pattern)))
(case-fold-search completion-ignore-case)
(completion-regexp-list (cons regex completion-regexp-list))
(compl (all-completions
@ -4450,18 +4453,12 @@ 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.
(defvar flex-score-match-tightness nil)
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).")
(make-obsolete-variable
'flex-score-match-tightness
"It never did anything very useful anyway."
"31.0")
(defvar completion-lazy-hilit nil
"If non-nil, request lazy highlighting of completion candidates.
@ -4502,133 +4499,49 @@ details."
(funcall completion-lazy-hilit-fn (copy-sequence str))
str))
(defun completion--hilit-from-re (string regexp &optional point-idx)
"Fontify STRING using REGEXP POINT-IDX.
Uses `completions-common-part' and `completions-first-difference'
faces to fontify STRING.
POINT-IDX is the position of point in the presumed \"PCM\" pattern
from which REGEXP was generated."
(let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
(pos (if point-idx (match-beginning point-idx) (match-end 0)))
(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)))
(if (and (numberp pos) (> (length string) pos))
(add-face-text-property
pos (1+ pos)
'completions-first-difference
nil string))
(unless (or (not me) (= from me))
(add-face-text-property from me 'completions-common-part nil string))
string))
(cl-defun completion--flex-score (pat str &optional dont-error)
"Compute flex score 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-score-gotoh pat str)))
(unless cost
(if dont-error (cl-return-from completion--flex-score nil)
(error "Pattern %s does not match %s" pat str)))
(cons (* (1+ cost) (- (length str) (length pat))) matches)))
(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":
(defun completion--flex-propertize (str matches point-idx segments)
"Add completion faces to STR based on MATCHES and POINT-IDX.
MATCHES is a list of match positions. POINT-IDX is a match group index
from the PCM pattern. SEGMENTS are extracted from the full PCM pattern.
Adds `completions-common-part' for matched positions and
`completions-first-difference' for the position corresponding to point."
(when point-idx
;; Compute character position from segments
(let* ((pos (cl-loop for seg in segments
for i from 1
while (<= i point-idx)
sum (length (car seg)))))
;; Add first-difference after pos-th match, if in range
(let ((point-match (and (> pos 0)
(<= pos (length matches))
(nth (1- pos) matches))))
(when (and point-match (< (1+ point-match) (length str)))
(add-face-text-property
(1+ point-match) (+ 2 point-match)
'completions-first-difference nil str)))))
;; Highlight matched positions
(dolist (pos matches)
(add-face-text-property pos (1+ pos)
'completions-common-part
nil str))
str)
;; 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'.")
(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-score' for Gotoh algorithm matching.")
(defun completion-pcm--hilit-commonality (pattern completions)
"Show where and how well PATTERN matches COMPLETIONS.
@ -4645,22 +4558,37 @@ relevant segments.
Else, if `completion-lazy-hilit' is t, return COMPLETIONS
unchanged, but setup a suitable `completion-lazy-hilit-fn' (which
see) for later lazy highlighting."
(setq completion-pcm--regexp nil
completion-lazy-hilit-fn nil)
(setq completion-lazy-hilit-fn nil
completion-flex--pattern-str nil)
(cond
((and completions (cl-loop for e in pattern thereis (stringp e)))
(let* ((segments (completion-pcm--pattern->segments pattern))
(re (completion-pcm--segments->regex segments 'group))
(point-idx (completion-pcm--segments-point-idx segments)))
(setq completion-pcm--regexp re)
(point-idx (completion-pcm--segments-point-idx segments))
;; Extract pattern string (concatenate string elements)
(pat (mapconcat #'identity
(delq nil (mapcar (lambda (x)
(if (stringp x) x nil))
pattern))
"")))
(setq completion-flex--pattern-str pat)
(cond (completion-lazy-hilit
(setq completion-lazy-hilit-fn
(lambda (str) (completion--hilit-from-re str re point-idx)))
(lambda (str)
(let ((result (completion--flex-score pat str t)))
(when result
(completion--flex-propertize
str (cdr result) point-idx segments)))
str))
completions)
(t
(mapcar
(lambda (str)
(completion--hilit-from-re (copy-sequence str) re point-idx))
(setq str (copy-sequence str))
(let ((result (completion--flex-score pat str t)))
(when result
(completion--flex-propertize
str (cdr result) point-idx segments)))
str)
completions)))))
(t completions)))
@ -4959,11 +4887,13 @@ 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 &optional
transform-pattern-fn simple-re)
"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
that is non-nil."
Respect PRED and POINT. The pattern used is a PCM-style substring
pattern, but it be massaged by TRANSFORM-PATTERN-FN, if that is non-nil.
SIMPLE-RE is means to pass a simpler faster regular expression to
`completion-pcm--all-completions'"
(let* ((beforepoint (substring string 0 point))
(afterpoint (substring string point))
(bounds (completion-boundaries beforepoint table pred afterpoint))
@ -4978,7 +4908,13 @@ that is non-nil."
(if transform-pattern-fn
(funcall transform-pattern-fn pattern)
pattern)))
(all (completion-pcm--all-completions prefix pattern table pred)))
(override-re (and simple-re
(mapconcat #'identity
(split-string
(substring string (car bounds)
(+ point (cdr bounds))) "" t)
".*")))
(all (completion-pcm--all-completions prefix pattern table pred override-re)))
(list all pattern prefix suffix (car bounds))))
(defun completion-substring-try-completion (string table pred point)
@ -5009,7 +4945,7 @@ that is non-nil."
(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 completion-flex--pattern-str)
(existing-dsf
(completion-metadata-get metadata 'display-sort-function))
(existing-csf
@ -5021,11 +4957,11 @@ that is non-nil."
(mapcar
(lambda (str)
(cons
(- (completion--flex-score
(or (get-text-property
0 'completion--unquoted str)
str)
completion-pcm--regexp))
(car (completion--flex-score
completion-flex--pattern-str
(or (get-text-property
0 'completion--unquoted str)
str)))
str))
(if existing-sort-fn
(funcall existing-sort-fn completions)
@ -5067,7 +5003,8 @@ which is at the core of flex logic. The extra
(pcase-let ((`(,all ,pattern ,prefix ,suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
#'completion-flex--make-flex-pattern)))
#'completion-flex--make-flex-pattern
t)))
(if minibuffer-completing-file-name
(setq all (completion-pcm--filename-try-filter all)))
;; Try some "merging", meaning add as much as possible to the
@ -5084,7 +5021,8 @@ which is at the core of flex logic. The extra
(pcase-let ((`(,all ,pattern ,prefix ,_suffix ,_carbounds)
(completion-substring--all-completions
string table pred point
#'completion-flex--make-flex-pattern)))
#'completion-flex--make-flex-pattern
t)))
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix))))))

197
src/minibuf.c
View file

@ -20,6 +20,7 @@ along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */
#include <config.h>
#include <errno.h>
#include <math.h>
#include <binary-io.h>
@ -2279,6 +2280,201 @@ 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 row and column
of M may have more than one match at multiple indices. But this
particular implementation of the algorithm assumes they have at least
one match.
D (originally stands for 'Deletion' 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.
Along the way, we construct P, a matrix used just for backtracking,
to reconstruct that path. Maybe P isn't needed, and all the
information can be cleverly derived from the final state of M and D.
But I couldn't make it work. */
DEFUN ("completion--flex-score-gotoh", Fcompletion__flex_score_gotoh,
Scompletion__flex_score_gotoh, 2, 2, 0,
doc: /* Compute flex score of STR matching PAT using 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 match
positions in STR. */)
(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);
size_t patlen = SCHARS (pat);
size_t strlen = SCHARS (str);
size_t width = strlen + 1;
size_t size = (patlen + 1) * width;
/* Bail if strings are empty or matrix too large. */
if (patlen == 0 || strlen == 0)
return Qnil;
if (size > FLEX_MAX_MATRIX_SIZE)
return Qnil;
/* Cost constants (lower is better). Maybe these could be
defcustom's?*/
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];
static size_t P[FLEX_MAX_MATRIX_SIZE];
/* Initialize costs. Fill both matrices with positive infinity. */
for (int j = 0; j < size; j++) M[j] = pos_inf;
for (int j = 0; j < size; j++) D[j] = pos_inf;
/* Except for D[0,0], which is 0, for prioritizing matches at the
beginning. Remaining elements on the first row are gap_open_cost/2
to represent cheaper leading gaps. */
for (int j = 0; j < width; j++) D[j] = gap_open_cost/2;
D[0] = 0;
/* Index of last match before gap started, as computed in the previous
row. Used to build P. */
int prev_gap_origin = -1;
/* Poor man's iterator type. */
typedef struct iter { int x; ptrdiff_t c; ptrdiff_t b; } iter_t;
/* Info about first match computed in the previous row. */
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.c, &i.b);
int gap_origin = -1;
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.c, &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);
/* Compute match cost M[i][j], i.e. replace its infinite
value with something finite. */
if (cmatch)
{
if (!match_seen)
{
match_seen = true;
prev_match = jcopy;
}
int pmatch_cost = MAT (M, i.x - 1, j.x - 1);
int pgap_cost = MAT (D, i.x - 1, j.x - 1);
if (pmatch_cost <= pgap_cost)
{
/* Not only did the previous char also match (else
pmatch_cost would have been infinite) but following
it up with this match is best overall. */
MAT (M, i.x, j.x) = pmatch_cost;
MAT (P, i.x, j.x) = j.x - 1;
}
else
{
/* 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) = pgap_cost;
MAT (P, i.x, j.x) = prev_gap_origin;
}
}
/* 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. */
int open_cost = MAT (M, i.x, j.x - 1) + gap_open_cost;
int extend_cost = MAT (D, i.x, j.x - 1) + gap_extend_cost;
if (open_cost < extend_cost)
{
MAT (D, i.x, j.x) = open_cost;
gap_origin = j.x - 1; /* New gap. */
}
else
MAT (D, i.x, j.x) = extend_cost; /* Extend gap. */
}
prev_gap_origin = gap_origin;
}
/* Find best (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;
}
}
if (lastcol < 0 || best_cost >= pos_inf)
return Qnil;
/* Build match positions list by tracing back through P matrix. */
Lisp_Object matches = Qnil;
for (int i = patlen - 1, l = lastcol; i >= 0 && l >= 0; i--)
{
matches = Fcons (make_fixnum (l), matches);
l = MAT (P, i, l);
}
return Fcons (make_fixnum (best_cost), matches);
#undef MAT
}
void
syms_of_minibuf (void)
{
@ -2541,6 +2737,7 @@ showing the *Completions* buffer, if any. */);
defsubr (&Stest_completion);
defsubr (&Sassoc_string);
defsubr (&Scompleting_read);
defsubr (&Scompletion__flex_score_gotoh);
DEFSYM (Qminibuffer_quit_recursive_edit, "minibuffer-quit-recursive-edit");
DEFSYM (Qinternal_complete_buffer, "internal-complete-buffer");
DEFSYM (Qcompleting_read_function, "completing-read-function");

95
test/lisp/minibuffer-tests.el
View file

@ -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,70 @@
(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-score pat a))
(car (completion--flex-score 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") 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))