lsp-completion.el (36614B)
1 ;;; lsp-completion.el --- LSP completion -*- lexical-binding: t; -*- 2 ;; 3 ;; Copyright (C) 2020 emacs-lsp maintainers 4 ;; 5 ;; This program is free software; you can redistribute it and/or modify 6 ;; it under the terms of the GNU General Public License as published by 7 ;; the Free Software Foundation, either version 3 of the License, or 8 ;; (at your option) any later version. 9 10 ;; This program is distributed in the hope that it will be useful, 11 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 13 ;; GNU General Public License for more details. 14 15 ;; You should have received a copy of the GNU General Public License 16 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 17 ;; 18 ;;; Commentary: 19 ;; 20 ;; LSP completion 21 ;; 22 ;;; Code: 23 24 (require 'lsp-mode) 25 26 (defgroup lsp-completion nil 27 "LSP support for completion." 28 :prefix "lsp-completion-" 29 :group 'lsp-mode 30 :tag "LSP Completion") 31 32 ;;;###autoload 33 (define-obsolete-variable-alias 'lsp-prefer-capf 34 'lsp-completion-provider "lsp-mode 7.0.1") 35 36 (defcustom lsp-completion-provider :capf 37 "The completion backend provider." 38 :type '(choice 39 (const :tag "Use company-capf" :capf) 40 (const :tag "None" :none)) 41 :group 'lsp-completion 42 :package-version '(lsp-mode . "7.0.1")) 43 44 ;;;###autoload 45 (define-obsolete-variable-alias 'lsp-enable-completion-at-point 46 'lsp-completion-enable "lsp-mode 7.0.1") 47 48 (defcustom lsp-completion-enable t 49 "Enable `completion-at-point' integration." 50 :type 'boolean 51 :group 'lsp-completion) 52 53 (defcustom lsp-completion-enable-additional-text-edit t 54 "Whether or not to apply additional text edit when performing completion. 55 56 If set to non-nil, `lsp-mode' will apply additional text edits 57 from the server. Otherwise, the additional text edits are 58 ignored." 59 :type 'boolean 60 :group 'lsp-completion 61 :package-version '(lsp-mode . "6.3.2")) 62 63 (defcustom lsp-completion-show-kind t 64 "Whether or not to show kind of completion candidates." 65 :type 'boolean 66 :group 'lsp-completion 67 :package-version '(lsp-mode . "7.0.1")) 68 69 (defcustom lsp-completion-show-detail t 70 "Whether or not to show detail of completion candidates." 71 :type 'boolean 72 :group 'lsp-completion) 73 74 (defcustom lsp-completion-show-label-description t 75 "Whether or not to show description of completion candidates." 76 :type 'boolean 77 :group 'lsp-completion 78 :package-version '(lsp-mode . "9.0.0")) 79 80 (defcustom lsp-completion-no-cache nil 81 "Whether or not caching the returned completions from server." 82 :type 'boolean 83 :group 'lsp-completion 84 :package-version '(lsp-mode . "7.0.1")) 85 86 (defcustom lsp-completion-filter-on-incomplete t 87 "Whether or not filter incomplete results." 88 :type 'boolean 89 :group 'lsp-completion 90 :package-version '(lsp-mode . "7.0.1")) 91 92 (defcustom lsp-completion-sort-initial-results t 93 "Whether or not filter initial results from server." 94 :type 'boolean 95 :group 'lsp-completion 96 :package-version '(lsp-mode . "8.0.0")) 97 98 (defcustom lsp-completion-use-last-result t 99 "Temporarily use last server result when interrupted by keyboard. 100 This will help minimize popup flickering issue in `company-mode'." 101 :type 'boolean 102 :group 'lsp-completion 103 :package-version '(lsp-mode . "8.0.0")) 104 105 (defconst lsp-completion--item-kind 106 [nil 107 "Text" 108 "Method" 109 "Function" 110 "Constructor" 111 "Field" 112 "Variable" 113 "Class" 114 "Interface" 115 "Module" 116 "Property" 117 "Unit" 118 "Value" 119 "Enum" 120 "Keyword" 121 "Snippet" 122 "Color" 123 "File" 124 "Reference" 125 "Folder" 126 "EnumMember" 127 "Constant" 128 "Struct" 129 "Event" 130 "Operator" 131 "TypeParameter"]) 132 133 (defvar yas-indent-line) 134 (defvar company-backends) 135 (defvar company-abort-on-unique-match) 136 137 (defvar lsp-completion--no-reordering nil 138 "Dont do client-side reordering completion items when set.") 139 140 (declare-function company-mode "ext:company") 141 (declare-function yas-expand-snippet "ext:yasnippet") 142 143 (defun lsp-doc-buffer (&optional string) 144 "Return doc for STRING." 145 (with-current-buffer (get-buffer-create "*lsp-documentation*") 146 (erase-buffer) 147 (fundamental-mode) 148 (when string 149 (save-excursion 150 (insert string) 151 (visual-line-mode))) 152 (current-buffer))) 153 154 (defun lsp-falsy? (val) 155 "Non-nil if VAL is falsy." 156 ;; https://developer.mozilla.org/en-US/docs/Glossary/Falsy 157 (or (not val) (equal val "") (equal val 0))) 158 159 (cl-defun lsp-completion--make-item (item &key markers prefix) 160 "Make completion item from lsp ITEM and with MARKERS and PREFIX." 161 (-let (((&CompletionItem :label 162 :sort-text? 163 :_emacsStartPoint start-point) 164 item)) 165 (propertize label 166 'lsp-completion-item item 167 'lsp-sort-text sort-text? 168 'lsp-completion-start-point start-point 169 'lsp-completion-markers markers 170 'lsp-completion-prefix prefix))) 171 172 (defun lsp-completion--annotate (item) 173 "Annotate ITEM detail." 174 (-let (((&CompletionItem :detail? :kind? :label-details?) (plist-get (text-properties-at 0 item) 175 'lsp-completion-item))) 176 (concat (when (and lsp-completion-show-detail detail?) 177 (concat " " (s-replace "\r" "" detail?))) 178 (when (and lsp-completion-show-label-description label-details?) 179 (when-let ((description (and label-details? (lsp:label-details-description label-details?)))) 180 (format " %s" description))) 181 (when lsp-completion-show-kind 182 (when-let ((kind-name (and kind? (aref lsp-completion--item-kind kind?)))) 183 (format " (%s)" kind-name)))))) 184 185 (defun lsp-completion--looking-back-trigger-characterp (trigger-characters) 186 "Return character if text before point match any of the TRIGGER-CHARACTERS." 187 (unless (= (point) (line-beginning-position)) 188 (seq-some 189 (lambda (trigger-char) 190 (and (equal (buffer-substring-no-properties (- (point) (length trigger-char)) (point)) 191 trigger-char) 192 trigger-char)) 193 trigger-characters))) 194 195 (defvar lsp-completion--cache nil 196 "Cached candidates for completion at point function. 197 In the form of plist (prefix-pos items :lsp-items :prefix ...). 198 When the completion is incomplete, `items' contains value of :incomplete.") 199 200 (defvar lsp-completion--last-result nil 201 "Last completion result.") 202 203 (defun lsp-completion--clear-cache (&optional keep-last-result) 204 "Clear completion caches. 205 KEEP-LAST-RESULT if specified." 206 (-some-> lsp-completion--cache 207 (cddr) 208 (plist-get :markers) 209 (cl-second) 210 (set-marker nil)) 211 (setq lsp-completion--cache nil) 212 (unless keep-last-result (setq lsp-completion--last-result nil))) 213 214 (defcustom lsp-completion-default-behaviour :replace 215 "Default behaviour of `InsertReplaceEdit'." 216 :type '(choice 217 (const :insert :tag "Default completion inserts") 218 (const :replace :tag "Default completion replaces")) 219 :group 'lsp-mode 220 :package-version '(lsp-mode . "8.0.0")) 221 222 (lsp-defun lsp-completion--guess-prefix ((item &as &CompletionItem :text-edit?)) 223 "Guess ITEM's prefix start point according to following heuristics: 224 - If `textEdit' exists, use insertion range start as prefix start point. 225 - Else, find the point before current point is longest prefix match of 226 `insertText' or `label'. And: 227 - The character before prefix is not word constitute 228 Return `nil' when fails to guess prefix." 229 (cond 230 ((lsp-insert-replace-edit? text-edit?) 231 (lsp--position-to-point (lsp:range-start (lsp:insert-replace-edit-insert text-edit?)))) 232 (text-edit? 233 (lsp--position-to-point (lsp:range-start (lsp:text-edit-range text-edit?)))) 234 (t 235 (-let* (((&CompletionItem :label :insert-text?) item) 236 (text (or (unless (lsp-falsy? insert-text?) insert-text?) label)) 237 (point (point)) 238 (start (max 1 (- point (length text)))) 239 (char-before (char-before start)) 240 start-point) 241 (while (and (< start point) (not start-point)) 242 (unless (or (and char-before (equal (char-syntax char-before) ?w)) 243 (not (string-prefix-p (buffer-substring-no-properties start point) 244 text))) 245 (setq start-point start)) 246 (cl-incf start) 247 (setq char-before (char-before start))) 248 start-point)))) 249 250 (defun lsp-completion--to-internal (items) 251 "Convert ITEMS into internal form." 252 (--> items 253 (-map (-lambda ((item &as &CompletionItem 254 :label 255 :filter-text? 256 :_emacsStartPoint start-point 257 :score?)) 258 `( :label ,(or (unless (lsp-falsy? filter-text?) filter-text?) label) 259 :item ,item 260 :start-point ,start-point 261 :score ,score?)) 262 it))) 263 264 (cl-defun lsp-completion--filter-candidates (items &key 265 lsp-items 266 markers 267 prefix 268 &allow-other-keys) 269 "List all possible completions in cached ITEMS with their prefixes. 270 We can pass LSP-ITEMS, which will be used when there's no cache. 271 The MARKERS and PREFIX value will be attached to each candidate." 272 (lsp--while-no-input 273 (->> 274 (if items 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)) 303 lsp-items) 304 (-map (lambda (item) (lsp-completion--make-item item 305 :markers markers 306 :prefix prefix)))))) 307 308 (defconst lsp-completion--kind->symbol 309 '((1 . text) 310 (2 . method) 311 (3 . function) 312 (4 . constructor) 313 (5 . field) 314 (6 . variable) 315 (7 . class) 316 (8 . interface) 317 (9 . module) 318 (10 . property) 319 (11 . unit) 320 (12 . value) 321 (13 . enum) 322 (14 . keyword) 323 (15 . snippet) 324 (16 . color) 325 (17 . file) 326 (18 . reference) 327 (19 . folder) 328 (20 . enum-member) 329 (21 . constant) 330 (22 . struct) 331 (23 . event) 332 (24 . operator) 333 (25 . type-parameter))) 334 335 (defun lsp-completion--candidate-kind (item) 336 "Return ITEM's kind." 337 (alist-get (lsp:completion-item-kind? (get-text-property 0 'lsp-completion-item item)) 338 lsp-completion--kind->symbol)) 339 340 (defun lsp-completion--candidate-deprecated (item) 341 "Return if ITEM is deprecated." 342 (let ((completion-item (get-text-property 0 'lsp-completion-item item))) 343 (or (lsp:completion-item-deprecated? completion-item) 344 (seq-position (lsp:completion-item-tags? completion-item) 345 lsp/completion-item-tag-deprecated)))) 346 347 (defun lsp-completion--company-match (candidate) 348 "Return highlight of typed prefix inside CANDIDATE." 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))) 388 389 (defun lsp-completion--get-documentation (item) 390 "Get doc comment for completion ITEM." 391 (unless (get-text-property 0 'lsp-completion-resolved item) 392 (let ((resolved-item 393 (-some->> item 394 (get-text-property 0 'lsp-completion-item) 395 (lsp-completion--resolve))) 396 (len (length item))) 397 (put-text-property 0 len 'lsp-completion-item resolved-item item) 398 (put-text-property 0 len 'lsp-completion-resolved t item))) 399 (-some->> item 400 (get-text-property 0 'lsp-completion-item) 401 (lsp:completion-item-documentation?) 402 (lsp--render-element))) 403 404 (defun lsp-completion--get-context (trigger-characters same-session?) 405 "Get completion context with provided TRIGGER-CHARACTERS and SAME-SESSION?." 406 (let* ((triggered-by-char non-essential) 407 (trigger-char (when triggered-by-char 408 (lsp-completion--looking-back-trigger-characterp 409 trigger-characters))) 410 (trigger-kind (cond 411 (trigger-char 412 lsp/completion-trigger-kind-trigger-character) 413 ((and same-session? 414 (equal (cl-second lsp-completion--cache) :incomplete)) 415 lsp/completion-trigger-kind-trigger-for-incomplete-completions) 416 (t lsp/completion-trigger-kind-invoked)))) 417 (apply #'lsp-make-completion-context 418 (nconc 419 `(:trigger-kind ,trigger-kind) 420 (when trigger-char 421 `(:trigger-character? ,trigger-char)))))) 422 423 (defun lsp-completion--sort-completions (completions) 424 "Sort COMPLETIONS." 425 (sort 426 completions 427 (-lambda ((&CompletionItem :sort-text? sort-text-left :label label-left) 428 (&CompletionItem :sort-text? sort-text-right :label label-right)) 429 (if (equal sort-text-left sort-text-right) 430 (string-lessp label-left label-right) 431 (string-lessp sort-text-left sort-text-right))))) 432 433 ;;;###autoload 434 (defun lsp-completion-at-point () 435 "Get lsp completions." 436 (when (or (--some (lsp--client-completion-in-comments? (lsp--workspace-client it)) 437 (lsp-workspaces)) 438 (not (nth 4 (syntax-ppss)))) 439 (let* ((trigger-chars (-> (lsp--capability-for-method "textDocument/completion") 440 (lsp:completion-options-trigger-characters?))) 441 (bounds-start (or (cl-first (bounds-of-thing-at-point 'symbol)) 442 (point))) 443 result done? 444 (candidates 445 (lambda () 446 (lsp--catch 'input 447 (let ((lsp--throw-on-input lsp-completion-use-last-result) 448 (same-session? (and lsp-completion--cache 449 ;; Special case for empty prefix and empty result 450 (or (cl-second lsp-completion--cache) 451 (not (string-empty-p 452 (plist-get (cddr lsp-completion--cache) :prefix)))) 453 (equal (cl-first lsp-completion--cache) bounds-start) 454 (s-prefix? 455 (plist-get (cddr lsp-completion--cache) :prefix) 456 (buffer-substring-no-properties bounds-start (point)))))) 457 (cond 458 ((or done? result) result) 459 ((and (not lsp-completion-no-cache) 460 same-session? 461 (listp (cl-second lsp-completion--cache))) 462 (setf result (apply #'lsp-completion--filter-candidates 463 (cdr lsp-completion--cache)))) 464 (t 465 (-let* ((resp (lsp-request-while-no-input 466 "textDocument/completion" 467 (plist-put (lsp--text-document-position-params) 468 :context (lsp-completion--get-context trigger-chars same-session?)))) 469 (completed (and resp 470 (not (and (lsp-completion-list? resp) 471 (lsp:completion-list-is-incomplete resp))))) 472 (items (lsp--while-no-input 473 (--> (cond 474 ((lsp-completion-list? resp) 475 (lsp:completion-list-items resp)) 476 (t resp)) 477 (if (or completed 478 (seq-some #'lsp:completion-item-sort-text? it)) 479 (lsp-completion--sort-completions it) 480 it) 481 (-map (lambda (item) 482 (lsp-put item 483 :_emacsStartPoint 484 (or (lsp-completion--guess-prefix item) 485 bounds-start))) 486 it)))) 487 (markers (list bounds-start (copy-marker (point) t))) 488 (prefix (buffer-substring-no-properties bounds-start (point))) 489 (lsp-completion--no-reordering (not lsp-completion-sort-initial-results))) 490 (lsp-completion--clear-cache same-session?) 491 (setf done? completed 492 lsp-completion--cache (list bounds-start 493 (cond 494 ((and done? (not (seq-empty-p items))) 495 (lsp-completion--to-internal items)) 496 ((not done?) :incomplete)) 497 :lsp-items nil 498 :markers markers 499 :prefix prefix) 500 result (lsp-completion--filter-candidates 501 (cond (done? 502 (cl-second lsp-completion--cache)) 503 (lsp-completion-filter-on-incomplete 504 (lsp-completion--to-internal items))) 505 :lsp-items items 506 :markers markers 507 :prefix prefix)))))) 508 (:interrupted lsp-completion--last-result) 509 (`,res (setq lsp-completion--last-result res)))))) 510 (list 511 bounds-start 512 (point) 513 (lambda (probe pred action) 514 (cond 515 ((eq action 'metadata) 516 '(metadata (category . lsp-capf) 517 (display-sort-function . identity) 518 (cycle-sort-function . identity))) 519 ((eq (car-safe action) 'boundaries) nil) 520 (t 521 (complete-with-action action (funcall candidates) probe pred)))) 522 :annotation-function #'lsp-completion--annotate 523 :company-kind #'lsp-completion--candidate-kind 524 :company-deprecated #'lsp-completion--candidate-deprecated 525 :company-require-match 'never 526 :company-prefix-length 527 (save-excursion 528 (let ( 529 ;; 2 is a heuristic number to make sure we look futher back than 530 ;; the bounds-start, which can be different from the actual start 531 ;; of the symbol 532 (bounds-left (max (line-beginning-position) (- bounds-start 2))) 533 triggered-by-char?) 534 (while (and (> (point) bounds-left) 535 (not (equal (char-after) ?\s)) 536 (not triggered-by-char?)) 537 (setq triggered-by-char? (lsp-completion--looking-back-trigger-characterp trigger-chars)) 538 (goto-char (1- (point)))) 539 (and triggered-by-char? t))) 540 :company-match #'lsp-completion--company-match 541 :company-doc-buffer (-compose #'lsp-doc-buffer 542 #'lsp-completion--get-documentation) 543 :exit-function 544 (-rpartial #'lsp-completion--exit-fn candidates))))) 545 546 (defun lsp-completion--find-workspace (server-id) 547 (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) 548 (lsp-workspaces))) 549 550 (defun lsp-completion--exit-fn (candidate _status &optional candidates) 551 "Exit function of `completion-at-point'. 552 CANDIDATE is the selected completion item. 553 Others: CANDIDATES" 554 (unwind-protect 555 (-let* ((candidate (if (plist-member (text-properties-at 0 candidate) 556 'lsp-completion-item) 557 candidate 558 (cl-find candidate (funcall candidates) :test #'equal))) 559 ((&plist 'lsp-completion-item item 560 'lsp-completion-start-point start-point 561 'lsp-completion-markers markers 562 'lsp-completion-resolved resolved 563 'lsp-completion-prefix prefix) 564 (text-properties-at 0 candidate)) 565 ((&CompletionItem? :label :insert-text? :text-edit? :insert-text-format? 566 :additional-text-edits? :insert-text-mode? :command?) 567 ;; see #3498 typescript-language-server does not provide the 568 ;; proper insertText without resolving. 569 (if (and (lsp-completion--find-workspace 'ts-ls) 570 (not resolved)) 571 (lsp-completion--resolve item) 572 item))) 573 (cond 574 (text-edit? 575 (apply #'delete-region markers) 576 (insert prefix) 577 (pcase text-edit? 578 ((lsp-interface TextEdit) (lsp--apply-text-edit text-edit?)) 579 ((lsp-interface InsertReplaceEdit :insert :replace :new-text) 580 (lsp--apply-text-edit 581 (lsp-make-text-edit 582 :new-text new-text 583 :range (if (or (and current-prefix-arg (eq lsp-completion-default-behaviour :replace)) 584 (and (not current-prefix-arg) (eq lsp-completion-default-behaviour :insert))) 585 insert 586 replace)))))) 587 ((or (unless (lsp-falsy? insert-text?) insert-text?) label) 588 (apply #'delete-region markers) 589 (insert prefix) 590 (delete-region start-point (point)) 591 (insert (or (unless (lsp-falsy? insert-text?) insert-text?) label)))) 592 593 (lsp--indent-lines start-point (point) insert-text-mode?) 594 (when (equal insert-text-format? lsp/insert-text-format-snippet) 595 (lsp--expand-snippet (buffer-substring start-point (point)) 596 start-point 597 (point))) 598 599 (when lsp-completion-enable-additional-text-edit 600 (if (or (get-text-property 0 'lsp-completion-resolved candidate) 601 (not (seq-empty-p additional-text-edits?))) 602 (lsp--apply-text-edits additional-text-edits? 'completion) 603 (-let [(callback cleanup-fn) (lsp--create-apply-text-edits-handlers)] 604 (lsp-completion--resolve-async 605 item 606 (-compose callback #'lsp:completion-item-additional-text-edits?) 607 cleanup-fn)))) 608 609 (if (or (get-text-property 0 'lsp-completion-resolved candidate) 610 command?) 611 (when command? (lsp--execute-command command?)) 612 (lsp-completion--resolve-async 613 item 614 (-lambda ((&CompletionItem? :command?)) 615 (when command? (lsp--execute-command command?))))) 616 617 (when (and (or 618 (equal lsp-signature-auto-activate t) 619 (memq :after-completion lsp-signature-auto-activate) 620 (and (memq :on-trigger-char lsp-signature-auto-activate) 621 (-when-let ((&SignatureHelpOptions? :trigger-characters?) 622 (lsp--capability :signatureHelpProvider)) 623 (lsp-completion--looking-back-trigger-characterp 624 trigger-characters?)))) 625 (lsp-feature? "textDocument/signatureHelp")) 626 (lsp-signature-activate)) 627 628 (setq-local lsp-inhibit-lsp-hooks nil)) 629 (lsp-completion--clear-cache))) 630 631 (defun lsp-completion--regex-fuz (str) 632 "Build a regex sequence from STR. Insert .* between each char." 633 (apply #'concat 634 (cl-mapcar 635 #'concat 636 (cons "" (cdr (seq-map (lambda (c) (format "[^%c]*" c)) str))) 637 (seq-map (lambda (c) 638 (format "\\(%s\\)" (regexp-quote (char-to-string c)))) 639 str)))) 640 641 (defun lsp-completion--fuz-score (query str) 642 "Calculate fuzzy score for STR with query QUERY. 643 The return is nil or in range of (0, inf)." 644 (-when-let* ((md (cddr (or (get-text-property 0 'match-data str) 645 (let ((re (lsp-completion--regex-fuz query))) 646 (when (string-match re str) 647 (match-data)))))) 648 (start (pop md)) 649 (len (length str)) 650 ;; To understand how this works, consider these bad ascii(tm) 651 ;; diagrams showing how the pattern "foo" flex-matches 652 ;; "fabrobazo", "fbarbazoo" and "barfoobaz": 653 654 ;; f abr o baz o 655 ;; + --- + --- + 656 657 ;; f barbaz oo 658 ;; + ------ ++ 659 660 ;; bar foo baz 661 ;; --- +++ --- 662 663 ;; "+" indicates parts where the pattern matched. A "hole" in 664 ;; the middle of the string is indicated by "-". Note that there 665 ;; are no "holes" near the edges of the string. The completion 666 ;; score is a number bound by ]0..1]: the higher the better and 667 ;; only a perfect match (pattern equals string) will have score 668 ;; 1. The formula takes the form of a quotient. For the 669 ;; numerator, we use the number of +, i.e. the length of the 670 ;; pattern. For the denominator, it first computes 671 ;; 672 ;; hole_i_contrib = 1 + (Li-1)^1.05 for first hole 673 ;; hole_i_contrib = 1 + (Li-1)^0.25 for hole i of length Li 674 ;; 675 ;; The final value for the denominator is then given by: 676 ;; 677 ;; (SUM_across_i(hole_i_contrib) + 1) 678 ;; 679 (score-numerator 0) 680 (score-denominator 0) 681 (last-b -1) 682 (q-ind 0) 683 (update-score 684 (lambda (a b) 685 "Update score variables given match range (A B)." 686 (setq score-numerator (+ score-numerator (- b a))) 687 (unless (= a len) 688 ;; case mismatch will be pushed to near next rank 689 (unless (equal (aref query q-ind) (aref str a)) 690 (cl-incf a 0.9)) 691 (setq score-denominator 692 (+ score-denominator 693 (if (= a last-b) 0 694 (+ 1 (* (if (< 0 (- a last-b 1)) 1 -1) 695 (expt (abs (- a last-b 1)) 696 ;; Give a higher score for match near start 697 (if (eq last-b -1) 0.75 0.25)))))))) 698 (setq last-b b)))) 699 (while md 700 (funcall update-score start (cl-first md)) 701 ;; Due to the way completion regex is constructed, `(eq end (+ start 1))` 702 (cl-incf q-ind) 703 (pop md) 704 (setq start (pop md))) 705 (unless (zerop len) 706 (/ score-numerator (1+ score-denominator) 1.0)))) 707 708 (defun lsp-completion--fix-resolve-data (item) 709 "Patch `CompletionItem' ITEM for rust-analyzer otherwise resolve will fail. 710 See #2675" 711 (let ((data (lsp:completion-item-data? item))) 712 (when (lsp-member? data :import_for_trait_assoc_item) 713 (unless (lsp-get data :import_for_trait_assoc_item) 714 (lsp-put data :import_for_trait_assoc_item :json-false))))) 715 716 (defun lsp-completion--resolve (item) 717 "Resolve completion ITEM." 718 (cl-assert item nil "Completion item must not be nil") 719 (lsp-completion--fix-resolve-data item) 720 (or (ignore-errors 721 (when (lsp-feature? "completionItem/resolve") 722 (lsp-request "completionItem/resolve" 723 (lsp-delete (lsp-copy item) :_emacsStartPoint)))) 724 item)) 725 726 (defun lsp-completion--resolve-async (item callback &optional cleanup-fn) 727 "Resolve completion ITEM asynchronously with CALLBACK. 728 The CLEANUP-FN will be called to cleanup." 729 (cl-assert item nil "Completion item must not be nil") 730 (lsp-completion--fix-resolve-data item) 731 (ignore-errors 732 (if (lsp-feature? "completionItem/resolve") 733 (lsp-request-async "completionItem/resolve" 734 (lsp-delete (lsp-copy item) :_emacsStartPoint) 735 (lambda (result) 736 (funcall callback result) 737 (when cleanup-fn (funcall cleanup-fn))) 738 :error-handler (lambda (err) 739 (when cleanup-fn (funcall cleanup-fn)) 740 (error (lsp:json-error-message err))) 741 :cancel-handler cleanup-fn 742 :mode 'alive) 743 (funcall callback item) 744 (when cleanup-fn (funcall cleanup-fn))))) 745 746 747 ;;;###autoload 748 (defun lsp-completion--enable () 749 "Enable LSP completion support." 750 (when (and lsp-completion-enable 751 (lsp-feature? "textDocument/completion")) 752 (lsp-completion-mode 1))) 753 754 (defun lsp-completion--disable () 755 "Disable LSP completion support." 756 (lsp-completion-mode -1)) 757 758 (defun lsp-completion-passthrough-all-completions (_string table pred _point) 759 "Passthrough all completions from TABLE with PRED." 760 (defvar completion-lazy-hilit-fn) 761 (when (bound-and-true-p completion-lazy-hilit) 762 (setq completion-lazy-hilit-fn 763 (lambda (candidate) 764 (->> candidate 765 lsp-completion--company-match 766 (mapc (-lambda ((start . end)) 767 (put-text-property start end 'face 'completions-common-part candidate)))) 768 candidate))) 769 (all-completions "" table pred)) 770 771 ;;;###autoload 772 (define-minor-mode lsp-completion-mode 773 "Toggle LSP completion support." 774 :group 'lsp-completion 775 :global nil 776 :lighter "" 777 (let ((completion-started-fn (lambda (&rest _) 778 (setq-local lsp-inhibit-lsp-hooks t))) 779 (after-completion-fn (lambda (result) 780 (when (stringp result) 781 (lsp-completion--clear-cache)) 782 (setq-local lsp-inhibit-lsp-hooks nil)))) 783 (cond 784 (lsp-completion-mode 785 (make-local-variable 'completion-at-point-functions) 786 ;; Ensure that `lsp-completion-at-point' the first CAPF to be tried, 787 ;; unless user has put it elsewhere in the list by their own 788 (add-to-list 'completion-at-point-functions #'lsp-completion-at-point) 789 (make-local-variable 'completion-category-defaults) 790 (setf (alist-get 'lsp-capf completion-category-defaults) '((styles . (lsp-passthrough)))) 791 (make-local-variable 'completion-styles-alist) 792 (setf (alist-get 'lsp-passthrough completion-styles-alist) 793 '(completion-basic-try-completion 794 lsp-completion-passthrough-all-completions 795 "Passthrough completion.")) 796 797 (cond 798 ((equal lsp-completion-provider :none)) 799 ((and (not (equal lsp-completion-provider :none)) 800 (fboundp 'company-mode)) 801 (setq-local company-abort-on-unique-match nil) 802 (company-mode 1) 803 (setq-local company-backends (cl-adjoin 'company-capf company-backends :test #'equal))) 804 (t 805 (lsp--warn "Unable to autoconfigure company-mode."))) 806 807 (when (bound-and-true-p company-mode) 808 (add-hook 'company-completion-started-hook 809 completion-started-fn 810 nil 811 t) 812 (add-hook 'company-after-completion-hook 813 after-completion-fn 814 nil 815 t)) 816 (add-hook 'lsp-unconfigure-hook #'lsp-completion--disable nil t)) 817 (t 818 (remove-hook 'completion-at-point-functions #'lsp-completion-at-point t) 819 (setq-local completion-category-defaults 820 (cl-remove 'lsp-capf completion-category-defaults :key #'cl-first)) 821 (setq-local completion-styles-alist 822 (cl-remove 'lsp-passthrough completion-styles-alist :key #'cl-first)) 823 (remove-hook 'lsp-unconfigure-hook #'lsp-completion--disable t) 824 (when (featurep 'company) 825 (remove-hook 'company-completion-started-hook 826 completion-started-fn 827 t) 828 (remove-hook 'company-after-completion-hook 829 after-completion-fn 830 t)))))) 831 832 ;;;###autoload 833 (add-hook 'lsp-configure-hook (lambda () 834 (when (and lsp-auto-configure 835 lsp-completion-enable) 836 (lsp-completion--enable)))) 837 838 (lsp-consistency-check lsp-completion) 839 840 (provide 'lsp-completion) 841 ;;; lsp-completion.el ends here