forked from Github/emacs
Compare commits
4 commits
master
...
scratch/ic
| Author | SHA1 | Date | |
|---|---|---|---|
|
|
70da05ac17 | ||
|
|
704855af17 | ||
|
|
4fa193527d | ||
|
|
4e1da63bef |
2 changed files with 67 additions and 9 deletions
|
|
@ -494,6 +494,7 @@ Usually run by inclusion in `minibuffer-setup-hook'."
|
|||
(setq-local icomplete--initial-input (icomplete--field-string))
|
||||
(setq-local completion-show-inline-help nil)
|
||||
(setq icomplete--scrolled-completions nil)
|
||||
(setq completion-lazy-hilit (cl-gensym))
|
||||
(use-local-map (make-composed-keymap icomplete-minibuffer-map
|
||||
(current-local-map)))
|
||||
(add-hook 'post-command-hook #'icomplete-post-command-hook nil t)
|
||||
|
|
@ -800,7 +801,9 @@ Return a list of (COMP PREFIX SUFFIX)."
|
|||
(cl-return-from icomplete--render-vertical
|
||||
(concat
|
||||
" \n"
|
||||
(mapconcat #'identity torender icomplete-separator))))
|
||||
(mapconcat #'identity
|
||||
(mapcar #'completion-lazy-hilit torender)
|
||||
icomplete-separator))))
|
||||
for (comp prefix) in triplets
|
||||
maximizing (length prefix) into max-prefix-len
|
||||
maximizing (length comp) into max-comp-len
|
||||
|
|
@ -812,7 +815,7 @@ Return a list of (COMP PREFIX SUFFIX)."
|
|||
(cl-loop for (comp prefix suffix) in triplets
|
||||
concat prefix
|
||||
concat (make-string (- max-prefix-len (length prefix)) ? )
|
||||
concat comp
|
||||
concat (completion-lazy-hilit comp)
|
||||
concat (make-string (- max-comp-len (length comp)) ? )
|
||||
concat suffix
|
||||
concat icomplete-separator))))
|
||||
|
|
@ -962,7 +965,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))))
|
||||
|
|
|
|||
|
|
@ -3512,6 +3512,54 @@ one large \"hole\" and a clumped-together \"oo\" match) higher
|
|||
than the latter (which has two \"holes\" and three
|
||||
one-letter-long matches).")
|
||||
|
||||
(defvar-local completion-lazy-hilit nil
|
||||
"If non-nil, request lazy hilighting of completion matches.
|
||||
|
||||
Completion-presenting frontends may opt to bind this variable to
|
||||
a unique non-nil value in the context of completion-producing
|
||||
calls (such as `completion-all-sorted-completions'). This hints
|
||||
the intervening completion styles that they do not need to
|
||||
propertize completion strings with the `face' property.
|
||||
|
||||
When doing so, it is the frontend -- not the style -- who becomes
|
||||
responsible for `face'-propertizing the completion matches meant
|
||||
to be displayed to the user, frequently a small subset of all
|
||||
completion matches. This can be done by calling the function
|
||||
`completion-lazy-hilit' which returns a `face'-propertized
|
||||
string.
|
||||
|
||||
The value stored in this variable by the completion frontend must
|
||||
be unique to each completion attempt/session. For instance,
|
||||
frontends which utilize the minibuffer as the locus of completion
|
||||
may set it to a buffer-local value returned by `gensym'. For
|
||||
frontends operating within a recursive command loop, let-binding
|
||||
it to `gensym' is appropriate.
|
||||
|
||||
Note that the optimization enabled by variable is only actually
|
||||
performed some completions styles. To others, it is a harmless
|
||||
and useless hint. To author a completion style that takes
|
||||
advantage of this, look in the source of
|
||||
`completion-pcm--hilit-commonality' for ideas.")
|
||||
|
||||
(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."
|
||||
(let* ((str (copy-sequence str))
|
||||
(data (get-text-property 0 'completion-lazy-hilit-data str))
|
||||
(re (and
|
||||
completion-lazy-hilit
|
||||
(eq completion-lazy-hilit (car data)) (cdr data)))
|
||||
(md (and re (string-match re str) (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 str)
|
||||
(setq from (pop md)))
|
||||
(unless (or (not me) (= from me))
|
||||
(add-face-text-property from me 'completions-common-part nil str))
|
||||
str))
|
||||
|
||||
(defun completion-pcm--hilit-commonality (pattern completions)
|
||||
"Show where and how well PATTERN matches COMPLETIONS.
|
||||
PATTERN, a list of symbols and strings as seen
|
||||
|
|
@ -3527,8 +3575,10 @@ between 0 and 1, and with faces `completions-common-part',
|
|||
last-md)
|
||||
(mapcar
|
||||
(lambda (str)
|
||||
;; Don't modify the string itself.
|
||||
(setq str (copy-sequence str))
|
||||
(unless completion-lazy-hilit
|
||||
;; Make a copy of `str' since in this case we're about to
|
||||
;; `face'-propertize it.
|
||||
(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)))
|
||||
|
|
@ -3576,9 +3626,10 @@ between 0 and 1, and with faces `completions-common-part',
|
|||
(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)
|
||||
(unless completion-lazy-hilit
|
||||
(add-face-text-property a b
|
||||
'completions-common-part
|
||||
nil str))
|
||||
(setq
|
||||
score-numerator (+ score-numerator (- b a)))
|
||||
(unless (or (= a last-b)
|
||||
|
|
@ -3601,7 +3652,10 @@ between 0 and 1, and with faces `completions-common-part',
|
|||
;; for that extra bit of match (bug#42149).
|
||||
(unless (= from match-end)
|
||||
(funcall update-score-and-face from match-end))
|
||||
(if (> (length str) pos)
|
||||
(put-text-property 0 1 'completion-lazy-hilit-data
|
||||
(cons completion-lazy-hilit re) str)
|
||||
(if (and (> (length str) pos)
|
||||
(not completion-lazy-hilit))
|
||||
(add-face-text-property
|
||||
pos (1+ pos)
|
||||
'completions-first-difference
|
||||
|
|
|
|||
Loading…
Reference in a new issue