Skip to content

Commit 78f676f

Browse files
kiennqkiennq
authored
lsp-completion: support completion-lazy-hilit and quicker company-match (#4394)
* lsp-completion: support completion-lazy-hilit and quicker company-match * fix fail ci
1 parent b75777a commit 78f676f

File tree

1 file changed

+78
-68
lines changed

1 file changed

+78
-68
lines changed

‎lsp-completion.el

Lines changed: 78 additions & 68 deletions
Original file line numberDiff line numberDiff line change
@@ -272,35 +272,34 @@ The MARKERS and PREFIX value will be attached to each candidate."
272272
(lsp--while-no-input
273273
(->>
274274
(if items
275-
(-->
276-
(let (queries fuz-queries)
277-
(-keep (-lambda ((cand &as &plist :label :start-point :score))
278-
(let* ((query (or (plist-get queries start-point)
279-
(let ((s (buffer-substring-no-properties
280-
start-point (point))))
281-
(setq queries (plist-put queries start-point s))
282-
s)))
283-
(fuz-query (or (plist-get fuz-queries start-point)
284-
(let ((s (lsp-completion--regex-fuz query)))
285-
(setq fuz-queries
286-
(plist-put fuz-queries start-point s))
287-
s)))
288-
(label-len (length label)))
289-
(when (string-match fuz-query label)
290-
(put-text-property 0 label-len 'match-data (match-data) label)
291-
(plist-put cand
292-
:sort-score
293-
(* (or (lsp-completion--fuz-score query label) 1e-05)
294-
(or score 0.001)))
295-
cand)))
296-
items))
297-
(if lsp-completion--no-reordering
298-
it
299-
(sort it (lambda (o1 o2)
300-
(> (plist-get o1 :sort-score)
301-
(plist-get o2 :sort-score)))))
302-
;; TODO: pass additional function to sort the candidates
303-
(-map (-rpartial #'plist-get :item) it))
275+
(--> (let (queries fuz-queries)
276+
(-keep (-lambda ((cand &as &plist :label :start-point :score))
277+
(let* ((query (or (plist-get queries start-point)
278+
(let ((s (buffer-substring-no-properties
279+
start-point (point))))
280+
(setq queries (plist-put queries start-point s))
281+
s)))
282+
(fuz-query (or (plist-get fuz-queries start-point)
283+
(let ((s (lsp-completion--regex-fuz query)))
284+
(setq fuz-queries
285+
(plist-put fuz-queries start-point s))
286+
s)))
287+
(label-len (length label)))
288+
(when (string-match fuz-query label)
289+
(put-text-property 0 label-len 'match-data (match-data) label)
290+
(plist-put cand
291+
:sort-score
292+
(* (or (lsp-completion--fuz-score query label) 1e-05)
293+
(or score 0.001)))
294+
cand)))
295+
items))
296+
(if lsp-completion--no-reordering
297+
it
298+
(sort it (lambda (o1 o2)
299+
(> (plist-get o1 :sort-score)
300+
(plist-get o2 :sort-score)))))
301+
;; TODO: pass additional function to sort the candidates
302+
(-map (-rpartial #'plist-get :item) it))
304303
lsp-items)
305304
(-map (lambda (item) (lsp-completion--make-item item
306305
:markers markers
@@ -347,42 +346,45 @@ The MARKERS and PREFIX value will be attached to each candidate."
347346

348347
(defun lsp-completion--company-match (candidate)
349348
"Return highlight of typed prefix inside CANDIDATE."
350-
(let* ((prefix (downcase
351-
(buffer-substring-no-properties
352-
(plist-get (text-properties-at 0 candidate) 'lsp-completion-start-point)
353-
(point))))
354-
;; Workaround for bug #4192
355-
;; `lsp-completion-start-point' above might be from cached/previous completion and
356-
;; pointing to a very distant point, which results in `prefix' being way too long.
357-
;; So let's consider only the first line.
358-
(prefix (car (s-lines prefix)))
359-
(prefix-len (length prefix))
360-
(prefix-pos 0)
361-
(label (downcase candidate))
362-
(label-len (length label))
363-
(label-pos 0)
364-
matches start)
365-
(while (and (not matches)
366-
(< prefix-pos prefix-len))
367-
(while (and (< prefix-pos prefix-len)
368-
(< label-pos label-len))
369-
(if (equal (aref prefix prefix-pos) (aref label label-pos))
370-
(progn
371-
(unless start (setq start label-pos))
372-
(cl-incf prefix-pos))
373-
(when start
374-
(setq matches (nconc matches `((,start . ,label-pos))))
375-
(setq start nil)))
376-
(cl-incf label-pos))
377-
(when start (setq matches (nconc matches `((,start . ,label-pos)))))
378-
;; Search again when the whole prefix is not matched
379-
(when (< prefix-pos prefix-len)
380-
(setq matches nil))
381-
;; Start search from next offset of prefix to find a match with label
382-
(unless matches
383-
(cl-incf prefix-pos)
384-
(setq label-pos 0)))
385-
matches))
349+
(if-let ((md (cddr (plist-get (text-properties-at 0 candidate) 'match-data))))
350+
(let (matches start end)
351+
(while (progn (setq start (pop md) end (pop md))
352+
(and start end))
353+
(setq matches (nconc matches `((,start . ,end)))))
354+
matches)
355+
(let* ((prefix (downcase
356+
(buffer-substring-no-properties
357+
;; Put a safe guard to prevent staled cache from setting a wrong start point #4192
358+
(max (line-beginning-position)
359+
(plist-get (text-properties-at 0 candidate) 'lsp-completion-start-point))
360+
(point))))
361+
(prefix-len (length prefix))
362+
(prefix-pos 0)
363+
(label (downcase candidate))
364+
(label-len (length label))
365+
(label-pos 0)
366+
matches start)
367+
(while (and (not matches)
368+
(< prefix-pos prefix-len))
369+
(while (and (< prefix-pos prefix-len)
370+
(< label-pos label-len))
371+
(if (equal (aref prefix prefix-pos) (aref label label-pos))
372+
(progn
373+
(unless start (setq start label-pos))
374+
(cl-incf prefix-pos))
375+
(when start
376+
(setq matches (nconc matches `((,start . ,label-pos))))
377+
(setq start nil)))
378+
(cl-incf label-pos))
379+
(when start (setq matches (nconc matches `((,start . ,label-pos)))))
380+
;; Search again when the whole prefix is not matched
381+
(when (< prefix-pos prefix-len)
382+
(setq matches nil))
383+
;; Start search from next offset of prefix to find a match with label
384+
(unless matches
385+
(cl-incf prefix-pos)
386+
(setq label-pos 0)))
387+
matches)))
386388

387389
(defun lsp-completion--get-documentation (item)
388390
"Get doc comment for completion ITEM."
@@ -743,9 +745,17 @@ The CLEANUP-FN will be called to cleanup."
743745
(lsp-completion-mode -1))
744746

745747
(defun lsp-completion-passthrough-all-completions (_string table pred _point)
746-
"Like `completion-basic-all-completions' but have prefix ignored.
747-
TABLE PRED"
748-
(completion-basic-all-completions "" table pred 0))
748+
"Passthrough all completions from TABLE with PRED."
749+
(defvar completion-lazy-hilit-fn)
750+
(when (bound-and-true-p completion-lazy-hilit)
751+
(setq completion-lazy-hilit-fn
752+
(lambda (candidate)
753+
(->> candidate
754+
lsp-completion--company-match
755+
(mapc (-lambda ((start . end))
756+
(put-text-property start end 'face 'completions-common-part candidate))))
757+
candidate)))
758+
(all-completions "" table pred))
749759

750760
;;;###autoload
751761
(define-minor-mode lsp-completion-mode

0 commit comments

Comments
 (0)