Commit 0daf79c6 authored by João Távora's avatar João Távora

Score flex-style completions according to match tightness

The new completion style needs to score completion matches so that we
can use it later on when sorting the completions.  This is because, in
the flex style, "foo" can now match "foobar", "frodo" and
"barfromsober" but we probably want "foobar" to appear at the top of
the completion list.

This change makes the new flex completion style add sort-order hints
under the completion string's `completion-style-sort-order' property.

* lisp/minibuffer.el (completion-pcm--hilit-commonality): Propertize
completion with 'completion-pcm-commonality-score.
(completion-flx-all-completions): Propertize completion with
completion-style-sort-order and completion-style-annotation.
parent 8b44a4bf
Pipeline #746 failed with stage
in 51 minutes and 38 seconds
......@@ -3056,20 +3056,38 @@ PATTERN is as returned by `completion-pcm--string->pattern'."
(let* ((pos (if point-idx (match-beginning point-idx) (match-end 0)))
(md (match-data))
(start (pop md))
(end (pop md)))
(end (pop md))
(len (length str))
(score-numerator 0)
(score-denominator 0)
(aux 0)
(lambda (a b)
"Update score variables given match range (A B)."
score-numerator (+ score-numerator (- b a))
score-denominator (+ score-denominator (expt (- a aux) 1.5))
aux b))))
(funcall update-score 0 start)
(while md
(put-text-property start (pop md)
(funcall update-score start (car md))
(put-text-property start
(pop md)
'font-lock-face 'completions-common-part
(setq start (pop md)))
(put-text-property start end
'font-lock-face 'completions-common-part
(funcall update-score start end)
(if (> (length str) pos)
(put-text-property pos (1+ pos)
'font-lock-face 'completions-first-difference
'font-lock-face 'completions-first-difference
0 1 'completion-pcm-commonality-score
(/ score-numerator (* len (1+ score-denominator)) 1.0) str))
(defun completion-pcm--find-all-completions (string table pred point
......@@ -3440,8 +3458,13 @@ which is at the core of flex logic. The extra
string table pred point
(when all
(nconc (completion-pcm--hilit-commonality pattern all)
(length prefix)))))
(let ((hilighted (completion-pcm--hilit-commonality pattern all)))
(lambda (comp)
(let ((score (get-text-property 0 'completion-pcm-commonality-score comp)))
(put-text-property 0 1 'completion-style-sort-order (- score) comp)))
(nconc hilighted (length prefix))))))
;; Initials completion
;; Complete /ums to /usr/monnier/src or lch to list-command-history.
Markdown is supported
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment