mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
Allow completion frontends to fontify candidates just-in-time
bug#48841, bug#47711 The variable may be bound by the frontend to a non-nil around completion-producing calls like completion-all-completions. See completion-lazy-hilit docstring for more info. * lisp/icomplete.el (icomplete-minibuffer-setup): Set completion-lazy-hilit. (icomplete--render-vertical): Call completion-lazy-hilit. (icomplete-completions): Call completion-lazy-hilit. * lisp/minibuffer.el (completion-lazy-hilit): New variable. (completion-lazy-hilit): New function. (completion-lazy-hilit-fn): New variable. (completion-pcm--regexp) (completion--flex-score-last-md): New helper variables. (completion--flex-score-1): New helper. (completion-pcm--hilit-commonality): Use completion-lazy-hilit. (completion--flex-adjust-metadata): Rework sorting code. * etc/NEWS: Mention completion-lazy-hilit
This commit is contained in:
João Távora
parent
94807b6896
commit
dfffb91a70
3 changed files with 223 additions and 121 deletions
7
etc/NEWS
7
etc/NEWS
|
|
@ -1279,6 +1279,13 @@ with Emacs.
|
|||
If non-nil, this variable contains a keymap of menu items that are
|
||||
displayed along tool bar items inside 'tool-bar-map'.
|
||||
|
||||
** New variable 'completion-lazy-hilit'.
|
||||
Completion-presenting frontends may bind this variable non-nil around
|
||||
calls to functions such as `completion-all-completions'. This hints
|
||||
at the underlying completion styles to skip eager fontification of
|
||||
completion candidates, which increases performance. Frontends then
|
||||
use the 'completion-lazy-hilit' function to fontify just in time.
|
||||
|
||||
** Functions and variables to transpose sexps
|
||||
|
||||
+++
|
||||
|
|
|
|||
|
|
@ -722,7 +722,8 @@ See `icomplete-mode' and `minibuffer-setup-hook'."
|
|||
;; Check if still in the right buffer (bug#61308)
|
||||
(or (window-minibuffer-p) completion-in-region--data)
|
||||
(icomplete-simple-completing-p)) ;Shouldn't be necessary.
|
||||
(let ((saved-point (point)))
|
||||
(let ((saved-point (point))
|
||||
(completion-lazy-hilit t))
|
||||
(save-excursion
|
||||
(goto-char (icomplete--field-end))
|
||||
;; Insert the match-status information:
|
||||
|
|
@ -901,7 +902,7 @@ by `group-function''s second \"transformation\" protocol."
|
|||
'icomplete-selected-match 'append comp)
|
||||
collect (concat prefix
|
||||
(make-string (- max-prefix-len (length prefix)) ? )
|
||||
comp
|
||||
(completion-lazy-hilit comp)
|
||||
(make-string (- max-comp-len (length comp)) ? )
|
||||
suffix)
|
||||
into lines-aux
|
||||
|
|
@ -1067,7 +1068,8 @@ matches exist."
|
|||
(if (< prospects-len prospects-max)
|
||||
(push comp prospects)
|
||||
(setq limit t)))
|
||||
(setq prospects (nreverse prospects))
|
||||
(setq prospects
|
||||
(nreverse (mapcar #'completion-lazy-hilit prospects)))
|
||||
;; Decorate first of the prospects.
|
||||
(when prospects
|
||||
(let ((first (copy-sequence (pop prospects))))
|
||||
|
|
|
|||
|
|
@ -677,6 +677,10 @@ for use at QPOS."
|
|||
'completions-common-part)
|
||||
qprefix))))
|
||||
(qcompletion (concat qprefix qnew)))
|
||||
;; Attach unquoted completion string, which is needed
|
||||
;; to score the completion in `completion--flex-score'.
|
||||
(put-text-property 0 1 'completion--unquoted
|
||||
completion qcompletion)
|
||||
;; FIXME: Similarly here, Cygwin's mapping trips this
|
||||
;; assertion.
|
||||
;;(cl-assert
|
||||
|
|
@ -1234,6 +1238,7 @@ Only the elements of table that satisfy predicate PRED are considered.
|
|||
POINT is the position of point within STRING.
|
||||
The return value is a list of completions and may contain the base-size
|
||||
in the last `cdr'."
|
||||
(setq completion-lazy-hilit-fn nil)
|
||||
;; FIXME: We need to additionally return the info needed for the
|
||||
;; second part of completion-base-position.
|
||||
(completion--nth-completion 2 string table pred point metadata))
|
||||
|
|
@ -3793,108 +3798,193 @@ 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 completion lazy highlighting.
|
||||
|
||||
Completion-presenting frontends may opt to bind this variable to
|
||||
non-nil value in the context of completion-producing calls (such
|
||||
as `completion-all-completions'). This hints the intervening
|
||||
completion styles that they do not need to
|
||||
fontify (i.e. propertize with a `face' property) completion
|
||||
strings with highlights of the matching parts.
|
||||
|
||||
When doing so, it is the frontend -- not the style -- who becomes
|
||||
responsible for this fontification. The frontend binds this
|
||||
variable to non-nil, and calls the function with the same name
|
||||
`completion-lazy-hilit' on each completion string that is to be
|
||||
displayed to the user.
|
||||
|
||||
Note that only some completion styles take advantage of this
|
||||
variable for optimization purposes. Other styles will ignore the
|
||||
hint and fontify eagerly as usual. It is still safe for a
|
||||
frontend to call `completion-lazy-hilit' in these situations.
|
||||
|
||||
To author a completion style that takes advantage see
|
||||
`completion-lazy-hilit-fn' and look in the source of
|
||||
`completion-pcm--hilit-commonality'.")
|
||||
|
||||
(defvar completion-lazy-hilit-fn nil
|
||||
"Function set by lazy-highlighting completions styles.
|
||||
When a given style wants to enable support for
|
||||
`completion-lazy-hilit' (which see), that style should set this
|
||||
variable to a function of one argument, a fresh string to be
|
||||
displayed to the user. The function is responsible for
|
||||
destructively propertizing the string with a `face' property.")
|
||||
|
||||
(defun completion-lazy-hilit (str)
|
||||
"Return a copy of completion STR that is `face'-propertized.
|
||||
See documentation for variable `completion-lazy-hilit' for more
|
||||
details."
|
||||
(if (and completion-lazy-hilit completion-lazy-hilit-fn)
|
||||
(funcall completion-lazy-hilit-fn (copy-sequence str))
|
||||
str))
|
||||
|
||||
(defun completion--hilit-from-re (string regexp)
|
||||
"Fontify STRING with `completions-common-part' using REGEXP."
|
||||
(let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
|
||||
(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)))
|
||||
(unless (or (not me) (= from me))
|
||||
(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."
|
||||
(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'.")
|
||||
|
||||
(defun completion-pcm--hilit-commonality (pattern completions)
|
||||
"Show where and how well PATTERN matches COMPLETIONS.
|
||||
PATTERN, a list of symbols and strings as seen
|
||||
`completion-pcm--merge-completions', is assumed to match every
|
||||
string in COMPLETIONS. Return a deep copy of COMPLETIONS where
|
||||
each string is propertized with `completion-score', a number
|
||||
between 0 and 1, and with faces `completions-common-part',
|
||||
`completions-first-difference' in the relevant segments."
|
||||
string in COMPLETIONS.
|
||||
|
||||
If `completion-lazy-hilit' is nil, return a deep copy of
|
||||
COMPLETIONS where each string is propertized with
|
||||
`completion-score', a number between 0 and 1, and with faces
|
||||
`completions-common-part', `completions-first-difference' in the
|
||||
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)
|
||||
(cond
|
||||
((and completions (cl-loop for e in pattern thereis (stringp e)))
|
||||
(let* ((re (completion-pcm--pattern->regex pattern 'group))
|
||||
(point-idx (completion-pcm--pattern-point-idx pattern))
|
||||
(case-fold-search completion-ignore-case)
|
||||
last-md)
|
||||
(mapcar
|
||||
(lambda (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))
|
||||
(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))))
|
||||
(from 0)
|
||||
(end (length str))
|
||||
;; 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)
|
||||
(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)
|
||||
(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))))
|
||||
(while md
|
||||
(funcall update-score-and-face from (pop md))
|
||||
(setq from (pop md)))
|
||||
;; 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)
|
||||
(funcall update-score-and-face from match-end))
|
||||
(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 (* end (1+ score-denominator)) 1.0) str)))
|
||||
str)
|
||||
completions)))
|
||||
(let* ((re (completion-pcm--pattern->regex pattern 'group)))
|
||||
(setq completion-pcm--regexp re)
|
||||
(cond (completion-lazy-hilit
|
||||
(setq completion-lazy-hilit-fn
|
||||
(lambda (str) (completion--hilit-from-re str re)))
|
||||
completions)
|
||||
(t
|
||||
(mapcar
|
||||
(lambda (str)
|
||||
(completion--hilit-from-re (copy-sequence str) re))
|
||||
completions)))))
|
||||
(t completions)))
|
||||
|
||||
(defun completion-pcm--find-all-completions (string table pred point
|
||||
|
|
@ -4231,36 +4321,39 @@ that is non-nil."
|
|||
|
||||
(defun completion--flex-adjust-metadata (metadata)
|
||||
"If `flex' is actually doing filtering, adjust sorting."
|
||||
(let ((flex-is-filtering-p
|
||||
;; JT@2019-12-23: FIXME: this is kinda wrong. What we need
|
||||
;; to test here is "some input that actually leads/led to
|
||||
;; flex filtering", not "something after the minibuffer
|
||||
;; prompt". E.g. The latter is always true for file
|
||||
;; searches, meaning we'll be doing extra work when we
|
||||
;; needn't.
|
||||
(or (not (window-minibuffer-p))
|
||||
(> (point-max) (minibuffer-prompt-end))))
|
||||
(let ((flex-is-filtering-p completion-pcm--regexp)
|
||||
(existing-dsf
|
||||
(completion-metadata-get metadata 'display-sort-function))
|
||||
(existing-csf
|
||||
(completion-metadata-get metadata 'cycle-sort-function)))
|
||||
(cl-flet
|
||||
((compose-flex-sort-fn
|
||||
(existing-sort-fn) ; wish `cl-flet' had proper indentation...
|
||||
(lambda (completions)
|
||||
(sort
|
||||
(funcall existing-sort-fn completions)
|
||||
(lambda (c1 c2)
|
||||
(let ((s1 (get-text-property 0 'completion-score c1))
|
||||
(s2 (get-text-property 0 'completion-score c2)))
|
||||
(> (or s1 0) (or s2 0))))))))
|
||||
((compose-flex-sort-fn (existing-sort-fn)
|
||||
(lambda (completions)
|
||||
(let* ((sorted (sort
|
||||
(mapcar
|
||||
(lambda (str)
|
||||
(cons
|
||||
(- (completion--flex-score
|
||||
(or (get-text-property
|
||||
0 'completion--unquoted str)
|
||||
str)
|
||||
completion-pcm--regexp))
|
||||
str))
|
||||
(if existing-sort-fn
|
||||
(funcall existing-sort-fn completions)
|
||||
completions))
|
||||
#'car-less-than-car))
|
||||
(cell sorted))
|
||||
;; Reuse the list
|
||||
(while cell
|
||||
(setcar cell (cdar cell))
|
||||
(pop cell))
|
||||
sorted))))
|
||||
`(metadata
|
||||
,@(and flex-is-filtering-p
|
||||
`((display-sort-function
|
||||
. ,(compose-flex-sort-fn (or existing-dsf #'identity)))))
|
||||
`((display-sort-function . ,(compose-flex-sort-fn existing-dsf))))
|
||||
,@(and flex-is-filtering-p
|
||||
`((cycle-sort-function
|
||||
. ,(compose-flex-sort-fn (or existing-csf #'identity)))))
|
||||
`((cycle-sort-function . ,(compose-flex-sort-fn existing-csf))))
|
||||
,@(cdr metadata)))))
|
||||
|
||||
(defun completion-flex--make-flex-pattern (pattern)
|
||||
|
|
|
|||
Loading…
Reference in a new issue