corfu.el (55140B)
1 ;;; corfu.el --- Completion Overlay Region FUnction -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2021, 2022 Free Software Foundation, Inc. 4 5 ;; Author: Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> 7 ;; Created: 2021 8 ;; Version: 0.27 9 ;; Package-Requires: ((emacs "27.1")) 10 ;; Homepage: https://github.com/minad/corfu 11 12 ;; This file is part of GNU Emacs. 13 14 ;; This program is free software: you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation, either version 3 of the License, or 17 ;; (at your option) any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; You should have received a copy of the GNU General Public License 25 ;; along with this program. If not, see <http://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 29 ;; Corfu enhances the default completion in region function with a 30 ;; completion overlay. The current candidates are shown in a popup 31 ;; below or above the point. Corfu can be considered the minimalistic 32 ;; completion-in-region counterpart of Vertico. 33 34 ;;; Code: 35 36 (require 'seq) 37 (eval-when-compile 38 (require 'cl-lib) 39 (require 'subr-x)) 40 41 (defgroup corfu nil 42 "Completion Overlay Region FUnction." 43 :group 'convenience 44 :prefix "corfu-") 45 46 (defcustom corfu-count 10 47 "Maximal number of candidates to show." 48 :type 'integer) 49 50 (defcustom corfu-scroll-margin 2 51 "Number of lines at the top and bottom when scrolling. 52 The value should lie between 0 and corfu-count/2." 53 :type 'integer) 54 55 (defcustom corfu-min-width 15 56 "Popup minimum width in characters." 57 :type 'integer) 58 59 (defcustom corfu-max-width 100 60 "Popup maximum width in characters." 61 :type 'integer) 62 63 (defcustom corfu-cycle nil 64 "Enable cycling for `corfu-next' and `corfu-previous'." 65 :type 'boolean) 66 67 (defcustom corfu-on-exact-match 'insert 68 "Configure how a single exact match should be handled." 69 :type '(choice (const insert) (const quit) (const nil))) 70 71 (defcustom corfu-continue-commands 72 ;; nil is undefined command 73 '(nil ignore universal-argument universal-argument-more digit-argument 74 "\\`corfu-" "\\`scroll-other-window") 75 "Continue Corfu completion after executing these commands." 76 :type '(repeat (choice regexp symbol))) 77 78 (defcustom corfu-preview-current 'insert 79 "Preview currently selected candidate. 80 If the variable has the value `insert', the candidate is automatically 81 inserted on further input." 82 :type '(choice boolean (const insert))) 83 84 (defcustom corfu-preselect-first t 85 "Preselect first candidate." 86 :type 'boolean) 87 88 (defcustom corfu-separator ?\s 89 "Component separator character. 90 The character used for separating components in the input. The presence 91 of this separator character will inhibit quitting at completion 92 boundaries, so that any further characters can be entered. To enter the 93 first separator character, call `corfu-insert-separator' (bound to M-SPC 94 by default). Useful for multi-component completion styles such as 95 Orderless." 96 :type 'character) 97 98 (defcustom corfu-quit-at-boundary 'separator 99 "Automatically quit at completion boundary. 100 nil: Never quit at completion boundary. 101 t: Always quit at completion boundary. 102 separator: Quit at boundary if no `corfu-separator' has been inserted." 103 :type '(choice boolean (const separator))) 104 105 (defcustom corfu-quit-no-match 'separator 106 "Automatically quit if no matching candidate is found. 107 nil: Stay alive even if there is no match. 108 t: Quit if there is no match. 109 separator: Only stay alive if there is no match and 110 `corfu-separator' has been inserted." 111 :type '(choice boolean (const separator))) 112 113 (defcustom corfu-excluded-modes nil 114 "List of modes excluded by `global-corfu-mode'." 115 :type '(repeat symbol)) 116 117 (defcustom corfu-left-margin-width 0.5 118 "Width of the left margin in units of the character width." 119 :type 'float) 120 121 (defcustom corfu-right-margin-width 0.5 122 "Width of the right margin in units of the character width." 123 :type 'float) 124 125 (defcustom corfu-bar-width 0.2 126 "Width of the bar in units of the character width." 127 :type 'float) 128 129 (defcustom corfu-echo-documentation '(1.0 . 0.2) 130 "Show documentation string in the echo area after that number of seconds. 131 Set to nil to disable the echo message or to t for an instant message. 132 The value can be a pair of two floats to specify initial and subsequent 133 delay." 134 :type '(choice (const :tag "Never" nil) 135 (const :tag "Instant" t) 136 (number :tag "Delay in seconds") 137 (cons :tag "Two Delays" 138 (choice :tag "Initial " number) 139 (choice :tag "Subsequent" number)))) 140 141 (defcustom corfu-margin-formatters nil 142 "Registry for margin formatter functions. 143 Each function of the list is called with the completion metadata as 144 argument until an appropriate formatter is found. The function should 145 return a formatter function, which takes the candidate string and must 146 return a string, possibly an icon." 147 :type 'hook) 148 149 (defcustom corfu-sort-function #'corfu-sort-length-alpha 150 "Default sorting function, used if no `display-sort-function' is specified." 151 :type `(choice 152 (const :tag "No sorting" nil) 153 (const :tag "By length and alpha" ,#'corfu-sort-length-alpha) 154 (function :tag "Custom function"))) 155 156 (defcustom corfu-sort-override-function nil 157 "Override sort function which overrides the `display-sort-function'." 158 :type '(choice (const nil) function)) 159 160 (defcustom corfu-auto-prefix 3 161 "Minimum length of prefix for auto completion. 162 The completion backend can override this with 163 :company-prefix-length." 164 :type 'integer) 165 166 (defcustom corfu-auto-delay 0.2 167 "Delay for auto completion." 168 :type 'float) 169 170 (defcustom corfu-auto-commands 171 '("self-insert-command\\'" 172 c-electric-colon c-electric-lt-gt c-electric-slash c-scope-operator) 173 "Commands which initiate auto completion." 174 :type '(repeat (choice regexp symbol))) 175 176 (defcustom corfu-auto nil 177 "Enable auto completion." 178 :type 'boolean) 179 180 (defgroup corfu-faces nil 181 "Faces used by Corfu." 182 :group 'corfu 183 :group 'faces) 184 185 (defface corfu-default 186 '((((class color) (min-colors 88) (background dark)) :background "#191a1b") 187 (((class color) (min-colors 88) (background light)) :background "#f0f0f0") 188 (t :background "gray")) 189 "Default face, foreground and background colors used for the popup.") 190 191 (defface corfu-current 192 '((((class color) (min-colors 88) (background dark)) 193 :background "#00415e" :foreground "white") 194 (((class color) (min-colors 88) (background light)) 195 :background "#c0efff" :foreground "black") 196 (t :background "blue" :foreground "white")) 197 "Face used to highlight the currently selected candidate.") 198 199 (defface corfu-bar 200 '((((class color) (min-colors 88) (background dark)) :background "#a8a8a8") 201 (((class color) (min-colors 88) (background light)) :background "#505050") 202 (t :background "gray")) 203 "The background color is used for the scrollbar indicator.") 204 205 (defface corfu-border 206 '((((class color) (min-colors 88) (background dark)) :background "#323232") 207 (((class color) (min-colors 88) (background light)) :background "#d7d7d7") 208 (t :background "gray")) 209 "The background color used for the thin border.") 210 211 (defface corfu-echo 212 '((t :inherit completions-annotations)) 213 "Face used for echo area messages.") 214 215 (defface corfu-annotations 216 '((t :inherit completions-annotations)) 217 "Face used for annotations.") 218 219 (defface corfu-deprecated 220 '((t :inherit shadow :strike-through t)) 221 "Face used for deprecated candidates.") 222 223 (defvar corfu-map 224 (let ((map (make-sparse-keymap))) 225 (define-key map [remap beginning-of-buffer] #'corfu-first) 226 (define-key map [remap end-of-buffer] #'corfu-last) 227 (define-key map [remap scroll-down-command] #'corfu-scroll-down) 228 (define-key map [remap scroll-up-command] #'corfu-scroll-up) 229 (define-key map [remap next-line] #'corfu-next) 230 (define-key map [remap previous-line] #'corfu-previous) 231 (define-key map [remap completion-at-point] #'corfu-complete) 232 (define-key map [down] #'corfu-next) 233 (define-key map [up] #'corfu-previous) 234 (define-key map [remap keyboard-escape-quit] #'corfu-reset) 235 ;; XXX [tab] is bound because of org-mode 236 ;; The binding should be removed from org-mode-map. 237 (define-key map [tab] #'corfu-complete) 238 (define-key map "\M-n" #'corfu-next) 239 (define-key map "\M-p" #'corfu-previous) 240 (define-key map "\C-g" #'corfu-quit) 241 (define-key map "\r" #'corfu-insert) 242 (define-key map "\t" #'corfu-complete) 243 (define-key map "\M-g" 'corfu-info-location) 244 (define-key map "\M-h" 'corfu-info-documentation) 245 (define-key map "\M- " #'corfu-insert-separator) 246 map) 247 "Corfu keymap used when popup is shown.") 248 249 (defvar corfu--auto-timer nil 250 "Auto completion timer.") 251 252 (defvar-local corfu--candidates nil 253 "List of candidates.") 254 255 (defvar-local corfu--metadata nil 256 "Completion metadata.") 257 258 (defvar-local corfu--base "" 259 "Base string, which is concatenated with the candidate.") 260 261 (defvar-local corfu--total 0 262 "Length of the candidate list `corfu--candidates'.") 263 264 (defvar-local corfu--highlight #'identity 265 "Deferred candidate highlighting function.") 266 267 (defvar-local corfu--index -1 268 "Index of current candidate or negative for prompt selection.") 269 270 (defvar-local corfu--preselect -1 271 "Index of preselected candidate, negative for prompt selection.") 272 273 (defvar-local corfu--scroll 0 274 "Scroll position.") 275 276 (defvar-local corfu--input nil 277 "Cons of last prompt contents and point.") 278 279 (defvar-local corfu--preview-ov nil 280 "Current candidate overlay.") 281 282 (defvar-local corfu--extra nil 283 "Extra completion properties.") 284 285 (defvar-local corfu--change-group nil 286 "Undo change group.") 287 288 (defvar-local corfu--echo-timer nil 289 "Echo area message timer.") 290 291 (defvar-local corfu--echo-message nil 292 "Last echo message.") 293 294 (defvar corfu--frame nil 295 "Popup frame.") 296 297 (defvar corfu--frame-timer nil 298 "Frame hide timer.") 299 300 (defconst corfu--state-vars 301 '(corfu--base 302 corfu--candidates 303 corfu--highlight 304 corfu--index 305 corfu--preselect 306 corfu--scroll 307 corfu--input 308 corfu--total 309 corfu--preview-ov 310 corfu--extra 311 corfu--echo-timer 312 corfu--echo-message 313 corfu--change-group 314 corfu--metadata) 315 "Buffer-local state variables used by Corfu.") 316 317 (defvar corfu--frame-parameters 318 '((no-accept-focus . t) 319 (no-focus-on-map . t) 320 (min-width . t) 321 (min-height . t) 322 (width . 0) 323 (height . 0) 324 (border-width . 0) 325 (child-frame-border-width . 1) 326 (left-fringe . 0) 327 (right-fringe . 0) 328 (vertical-scroll-bars . nil) 329 (horizontal-scroll-bars . nil) 330 (menu-bar-lines . 0) 331 (tool-bar-lines . 0) 332 (tab-bar-lines . 0) 333 (no-other-frame . t) 334 (unsplittable . t) 335 (undecorated . t) 336 (cursor-type . nil) 337 (visibility . nil) 338 (no-special-glyphs . t) 339 (desktop-dont-save . t)) 340 "Default child frame parameters.") 341 342 (defvar corfu--buffer-parameters 343 '((mode-line-format . nil) 344 (header-line-format . nil) 345 (tab-line-format . nil) 346 (tab-bar-format . nil) ;; Emacs 28 tab-bar-format 347 (frame-title-format . "") 348 (truncate-lines . t) 349 (cursor-in-non-selected-windows . nil) 350 (cursor-type . nil) 351 (show-trailing-whitespace . nil) 352 (display-line-numbers . nil) 353 (left-fringe-width . nil) 354 (right-fringe-width . nil) 355 (left-margin-width . 0) 356 (right-margin-width . 0) 357 (fringes-outside-margins . 0) 358 (fringe-indicator-alist . nil) 359 (indicate-empty-lines . nil) 360 (indicate-buffer-boundaries . nil) 361 (buffer-read-only . t)) 362 "Default child frame buffer parameters.") 363 364 (defvar corfu--mouse-ignore-map 365 (let ((map (make-sparse-keymap))) 366 (dotimes (i 7) 367 (dolist (k '(mouse down-mouse drag-mouse double-mouse triple-mouse)) 368 (define-key map (vector (intern (format "%s-%s" k (1+ i)))) #'ignore))) 369 map) 370 "Ignore all mouse clicks.") 371 372 (defun corfu--make-buffer (content) 373 "Create corfu buffer with CONTENT." 374 (let ((fr face-remapping-alist) 375 (ls line-spacing) 376 (buffer (get-buffer-create " *corfu*"))) 377 (with-current-buffer buffer 378 ;;; XXX HACK install mouse ignore map 379 (use-local-map corfu--mouse-ignore-map) 380 (dolist (var corfu--buffer-parameters) 381 (set (make-local-variable (car var)) (cdr var))) 382 (setq-local face-remapping-alist (copy-tree fr) 383 line-spacing ls) 384 (cl-pushnew 'corfu-default (alist-get 'default face-remapping-alist)) 385 (let ((inhibit-modification-hooks t) 386 (inhibit-read-only t)) 387 (erase-buffer) 388 (insert content) 389 (goto-char (point-min)))) 390 buffer)) 391 392 ;; Function adapted from posframe.el by tumashu 393 (defvar x-gtk-resize-child-frames) ;; Not present on non-gtk builds 394 (defun corfu--make-frame (x y width height content) 395 "Show child frame at X/Y with WIDTH/HEIGHT and CONTENT." 396 (let* ((window-min-height 1) 397 (window-min-width 1) 398 (x-gtk-resize-child-frames 399 (let ((case-fold-search t)) 400 (and 401 ;; XXX HACK to fix resizing on gtk3/gnome taken from posframe.el 402 ;; More information: 403 ;; * https://github.com/minad/corfu/issues/17 404 ;; * https://gitlab.gnome.org/GNOME/mutter/-/issues/840 405 ;; * https://lists.gnu.org/archive/html/emacs-devel/2020-02/msg00001.html 406 (string-match-p "gtk3" system-configuration-features) 407 (string-match-p "gnome\\|cinnamon" 408 (or (getenv "XDG_CURRENT_DESKTOP") 409 (getenv "DESKTOP_SESSION") "")) 410 'resize-mode))) 411 (after-make-frame-functions) 412 (edge (window-inside-pixel-edges)) 413 (ch (default-line-height)) 414 (border (alist-get 'child-frame-border-width corfu--frame-parameters)) 415 (x (max border (min (+ (car edge) x (- border)) 416 (- (frame-pixel-width) width)))) 417 (yb (+ (cadr edge) (window-tab-line-height) y ch)) 418 (y (if (> (+ yb (* corfu-count ch) ch ch) (frame-pixel-height)) 419 (- yb height ch 1) 420 yb)) 421 (buffer (corfu--make-buffer content)) 422 (parent (window-frame))) 423 (unless (and (frame-live-p corfu--frame) 424 (eq (frame-parent corfu--frame) parent)) 425 (when corfu--frame (delete-frame corfu--frame)) 426 (setq corfu--frame (make-frame 427 `((parent-frame . ,parent) 428 (minibuffer . ,(minibuffer-window parent)) 429 ;; Set `internal-border-width' for Emacs 27 430 (internal-border-width . ,border) 431 ,@corfu--frame-parameters)))) 432 ;; XXX HACK Setting the same frame-parameter/face-background is not a nop. 433 ;; Check explicitly before applying the setting. Without the check, the 434 ;; frame flickers on Mac. 435 ;; XXX HACK We have to apply the face background before adjusting the frame 436 ;; parameter, otherwise the border is not updated (BUG!). 437 (let* ((face (if (facep 'child-frame-border) 'child-frame-border 'internal-border)) 438 (new (face-attribute 'corfu-border :background nil 'default))) 439 (unless (equal (face-attribute face :background corfu--frame 'default) new) 440 (set-face-background face new corfu--frame))) 441 (let ((new (face-attribute 'corfu-default :background nil 'default))) 442 (unless (equal (frame-parameter corfu--frame 'background-color) new) 443 (set-frame-parameter corfu--frame 'background-color new))) 444 (let ((win (frame-root-window corfu--frame))) 445 (set-window-buffer win buffer) 446 ;; Disallow selection of root window (#63) 447 (set-window-parameter win 'no-delete-other-windows t) 448 (set-window-parameter win 'no-other-window t) 449 ;; Mark window as dedicated to prevent frame reuse (#60) 450 (set-window-dedicated-p win t)) 451 (set-frame-size corfu--frame width height t) 452 (if (frame-visible-p corfu--frame) 453 ;; XXX HACK Avoid flicker when frame is already visible. 454 ;; Redisplay, wait for resize and then move the frame. 455 (unless (equal (frame-position corfu--frame) (cons x y)) 456 (redisplay 'force) 457 (sleep-for 0.01) 458 (set-frame-position corfu--frame x y)) 459 ;; XXX HACK: Force redisplay, otherwise the popup sometimes does not 460 ;; display content. 461 (set-frame-position corfu--frame x y) 462 (redisplay 'force) 463 (make-frame-visible corfu--frame)) 464 (redirect-frame-focus corfu--frame parent))) 465 466 (defun corfu--popup-show (pos off width lines &optional curr lo bar) 467 "Show LINES as popup at POS - OFF. 468 WIDTH is the width of the popup. 469 The current candidate CURR is highlighted. 470 A scroll bar is displayed from LO to LO+BAR." 471 (let* ((ch (default-line-height)) 472 (cw (default-font-width)) 473 (ml (ceiling (* cw corfu-left-margin-width))) 474 (mr (ceiling (* cw corfu-right-margin-width))) 475 (bw (ceiling (min mr (* cw corfu-bar-width)))) 476 (marginl (and (> ml 0) (propertize " " 'display `(space :width (,ml))))) 477 (marginr (and (> mr 0) (propertize " " 'display `(space :align-to right)))) 478 (sbar (when (> bw 0) 479 (concat (propertize " " 'display `(space :align-to (- right (,mr)))) 480 (propertize " " 'display `(space :width (,(- mr bw)))) 481 (propertize " " 'face 'corfu-bar 'display `(space :width (,bw)))))) 482 (row 0) 483 (pos (posn-x-y (posn-at-point pos))) 484 (x (or (car pos) 0)) 485 (y (or (cdr pos) 0))) 486 (corfu--make-frame 487 (- x ml (* cw off)) y 488 (+ (* width cw) ml mr) (* (length lines) ch) 489 (mapconcat (lambda (line) 490 (let ((str (concat marginl line 491 (if (and lo (<= lo row (+ lo bar))) sbar marginr)))) 492 (when (eq row curr) 493 (add-face-text-property 494 0 (length str) 'corfu-current 'append str)) 495 (setq row (1+ row)) 496 str)) 497 lines "\n")))) 498 499 (defun corfu--hide-frame-deferred () 500 "Deferred frame hiding." 501 (setq corfu--frame-timer nil) 502 (when (frame-live-p corfu--frame) 503 (make-frame-invisible corfu--frame) 504 (with-current-buffer (window-buffer (frame-root-window corfu--frame)) 505 (let ((inhibit-modification-hooks t) 506 (inhibit-read-only t)) 507 (erase-buffer))))) 508 509 (defun corfu--popup-hide () 510 "Hide Corfu popup." 511 (when (and (frame-live-p corfu--frame) (not corfu--frame-timer)) 512 (setq corfu--frame-timer (run-at-time 0 nil #'corfu--hide-frame-deferred)))) 513 514 (defun corfu--popup-support-p () 515 "Return non-nil if child frames are supported." 516 (display-graphic-p)) 517 518 (defun corfu--move-to-front (elem list) 519 "Move ELEM to front of LIST." 520 (if-let (found (member elem list)) 521 (let ((head (list (car found)))) 522 (nconc head (delq (setcar found nil) list))) 523 list)) 524 525 ;; bug#47711: Deferred highlighting for `completion-all-completions' 526 ;; XXX There is one complication: `completion--twq-all' already adds 527 ;; `completions-common-part'. 528 (defun corfu--all-completions (&rest args) 529 "Compute all completions for ARGS with deferred highlighting." 530 (cl-letf* ((orig-pcm (symbol-function #'completion-pcm--hilit-commonality)) 531 (orig-flex (symbol-function #'completion-flex-all-completions)) 532 ((symbol-function #'completion-flex-all-completions) 533 (lambda (&rest args) 534 ;; Unfortunately for flex we have to undo the deferred 535 ;; highlighting, since flex uses the completion-score for 536 ;; sorting, which is applied during highlighting. 537 (cl-letf (((symbol-function #'completion-pcm--hilit-commonality) orig-pcm)) 538 (apply orig-flex args)))) 539 ;; Defer the following highlighting functions 540 (hl #'identity) 541 ((symbol-function #'completion-hilit-commonality) 542 (lambda (cands prefix &optional base) 543 (setq hl (lambda (x) (nconc (completion-hilit-commonality x prefix base) nil))) 544 (and cands (nconc cands base)))) 545 ((symbol-function #'completion-pcm--hilit-commonality) 546 (lambda (pattern cands) 547 (setq hl (lambda (x) 548 ;; `completion-pcm--hilit-commonality' sometimes 549 ;; throws an internal error for example when entering 550 ;; "/sudo:://u". 551 (condition-case nil 552 (completion-pcm--hilit-commonality pattern x) 553 (t x)))) 554 cands))) 555 ;; Only advise orderless after it has been loaded to avoid load order issues 556 (if (and (fboundp 'orderless-highlight-matches) 557 (fboundp 'orderless-pattern-compiler)) 558 (cl-letf (((symbol-function 'orderless-highlight-matches) 559 (lambda (pattern cands) 560 (let ((regexps (orderless-pattern-compiler pattern))) 561 (setq hl (lambda (x) (orderless-highlight-matches regexps x)))) 562 cands))) 563 (cons (apply #'completion-all-completions args) hl)) 564 (cons (apply #'completion-all-completions args) hl)))) 565 566 (defun corfu--sort-predicate (x y) 567 "Sorting predicate which compares X and Y." 568 (or (< (length x) (length y)) (and (= (length x) (length y)) (string< x y)))) 569 570 (defun corfu-sort-length-alpha (list) 571 "Sort LIST by length and alphabetically." 572 (sort list #'corfu--sort-predicate)) 573 574 (defmacro corfu--partition! (list form) 575 "Evaluate FORM for every element and partition LIST." 576 (let ((head1 (make-symbol "head1")) 577 (head2 (make-symbol "head2")) 578 (tail1 (make-symbol "tail1")) 579 (tail2 (make-symbol "tail2"))) 580 `(let* ((,head1 (cons nil nil)) 581 (,head2 (cons nil nil)) 582 (,tail1 ,head1) 583 (,tail2 ,head2)) 584 (while ,list 585 (if (let ((it (car ,list))) ,form) 586 (progn 587 (setcdr ,tail1 ,list) 588 (pop ,tail1)) 589 (setcdr ,tail2 ,list) 590 (pop ,tail2)) 591 (pop ,list)) 592 (setcdr ,tail1 (cdr ,head2)) 593 (setcdr ,tail2 nil) 594 (setq ,list (cdr ,head1))))) 595 596 (defun corfu--move-prefix-candidates-to-front (field candidates) 597 "Move CANDIDATES which match prefix of FIELD to the beginning." 598 (let* ((word (substring field 0 599 (seq-position field corfu-separator))) 600 (len (length word))) 601 (corfu--partition! 602 candidates 603 (and (>= (length it) len) 604 (eq t (compare-strings word 0 len it 0 len 605 completion-ignore-case)))))) 606 607 (defun corfu--filter-files (files) 608 "Filter FILES by `completion-ignored-extensions'." 609 (let ((re (concat "\\(?:\\(?:\\`\\|/\\)\\.\\.?/\\|" 610 (regexp-opt completion-ignored-extensions) 611 "\\)\\'"))) 612 (or (seq-remove (lambda (x) (string-match-p re x)) files) files))) 613 614 (defun corfu--sort-function () 615 "Return the sorting function." 616 (or corfu-sort-override-function 617 (corfu--metadata-get 'display-sort-function) 618 corfu-sort-function)) 619 620 (defun corfu--recompute-candidates (str pt table pred) 621 "Recompute candidates from STR, PT, TABLE and PRED." 622 (pcase-let* ((before (substring str 0 pt)) 623 (after (substring str pt)) 624 (corfu--metadata (completion-metadata before table pred)) 625 ;; bug#47678: `completion-boundaries` fails for `partial-completion` 626 ;; if the cursor is moved between the slashes of "~//". 627 ;; See also vertico.el which has the same issue. 628 (bounds (or (condition-case nil 629 (completion-boundaries before table pred after) 630 (t (cons 0 (length after)))))) 631 (field (substring str (car bounds) (+ pt (cdr bounds)))) 632 (completing-file (eq (corfu--metadata-get 'category) 'file)) 633 (`(,all . ,hl) (corfu--all-completions str table pred pt corfu--metadata)) 634 (base (or (when-let (z (last all)) (prog1 (cdr z) (setcdr z nil))) 0)) 635 (corfu--base (substring str 0 base))) 636 ;; Filter the ignored file extensions. We cannot use modified predicate for 637 ;; this filtering, since this breaks the special casing in the 638 ;; `completion-file-name-table' for `file-exists-p' and `file-directory-p'. 639 (when completing-file (setq all (corfu--filter-files all))) 640 (setq all (delete-consecutive-dups (funcall (or (corfu--sort-function) #'identity) all))) 641 (setq all (corfu--move-prefix-candidates-to-front field all)) 642 (when (and completing-file (not (string-suffix-p "/" field))) 643 (setq all (corfu--move-to-front (concat field "/") all))) 644 (setq all (corfu--move-to-front field all)) 645 (list corfu--base all (length all) hl corfu--metadata 646 ;; Select the prompt when the input is a valid completion 647 ;; and if it is not equal to the first candidate. 648 (if (or (not corfu-preselect-first) (not all) 649 (and (not (equal field (car all))) 650 (not (and completing-file (equal (concat field "/") (car all)))) 651 (test-completion str table pred))) 652 -1 0)))) 653 654 (defun corfu--update-candidates (str pt table pred) 655 "Update candidates from STR, PT, TABLE and PRED." 656 ;; Redisplay such that the input becomes immediately visible before the 657 ;; expensive candidate recomputation is performed (Issue #48). See also 658 ;; corresponding vertico#89. 659 (redisplay) 660 (pcase 661 ;; Bind non-essential=t to prevent Tramp from opening new connections, 662 ;; without the user explicitly requesting it via M-TAB. 663 (let ((non-essential t)) 664 (while-no-input (corfu--recompute-candidates str pt table pred))) 665 ('nil (keyboard-quit)) 666 (`(,base ,candidates ,total ,hl ,metadata ,preselect) 667 (setq corfu--input (cons str pt) 668 corfu--candidates candidates 669 corfu--base base 670 corfu--total total 671 corfu--preselect preselect 672 corfu--index preselect 673 corfu--highlight hl 674 corfu--metadata metadata)))) 675 676 (defun corfu--match-symbol-p (pattern sym) 677 "Return non-nil if SYM is matching an element of the PATTERN list." 678 (and (symbolp sym) 679 (cl-loop for x in pattern 680 thereis (if (symbolp x) 681 (eq sym x) 682 (string-match-p x (symbol-name sym)))))) 683 684 (defun corfu-quit () 685 "Quit Corfu completion." 686 (interactive) 687 (completion-in-region-mode -1)) 688 689 (defun corfu-reset () 690 "Reset Corfu completion. 691 This command can be executed multiple times by hammering the ESC key. If a 692 candidate is selected, unselect the candidate. Otherwise reset the input. If 693 there hasn't been any input, then quit." 694 (interactive) 695 (if (/= corfu--index corfu--preselect) 696 (progn 697 (corfu--goto -1) 698 (setq this-command #'corfu-first)) 699 ;; Cancel all changes and start new change group. 700 (cancel-change-group corfu--change-group) 701 (activate-change-group (setq corfu--change-group (prepare-change-group))) 702 (when (eq last-command #'corfu-reset) (corfu-quit)))) 703 704 (defun corfu--affixate (cands) 705 "Annotate CANDS with annotation function." 706 (setq cands 707 (if-let (aff (or (corfu--metadata-get 'affixation-function) 708 (plist-get corfu--extra :affixation-function))) 709 (funcall aff cands) 710 (if-let (ann (or (corfu--metadata-get 'annotation-function) 711 (plist-get corfu--extra :annotation-function))) 712 (cl-loop for cand in cands collect 713 (let ((suffix (or (funcall ann cand) ""))) 714 ;; The default completion UI adds the 715 ;; `completions-annotations' face if no other faces are 716 ;; present. We use a custom `corfu-annotations' face to 717 ;; allow further styling which fits better for popups. 718 (unless (text-property-not-all 0 (length suffix) 'face nil suffix) 719 (setq suffix (propertize suffix 'face 'corfu-annotations))) 720 (list cand "" suffix))) 721 (cl-loop for cand in cands collect (list cand "" ""))))) 722 (let* ((dep (plist-get corfu--extra :company-deprecated)) 723 (completion-extra-properties corfu--extra) 724 (mf (run-hook-with-args-until-success 'corfu-margin-formatters corfu--metadata))) 725 (cl-loop for x in cands for (c . _) = x do 726 (when mf 727 (setf (cadr x) (funcall mf c))) 728 (when (and dep (funcall dep c)) 729 (setcar x (setq c (substring c))) 730 (add-face-text-property 0 (length c) 'corfu-deprecated 'append c))) 731 (cons mf cands))) 732 733 (defun corfu--metadata-get (prop) 734 "Return PROP from completion metadata." 735 ;; Note: Do not use `completion-metadata-get' in order to avoid Marginalia. 736 ;; The Marginalia annotators are too heavy for the Corfu popup! 737 (cdr (assq prop corfu--metadata))) 738 739 (defun corfu--format-candidates (cands) 740 "Format annotated CANDS." 741 (setq cands 742 (cl-loop for c in cands collect 743 (cl-loop for s in c collect 744 (replace-regexp-in-string "[ \t]*\n[ \t]*" " " s)))) 745 (let* ((cw (cl-loop for x in cands maximize (string-width (car x)))) 746 (pw (cl-loop for x in cands maximize (string-width (cadr x)))) 747 (sw (cl-loop for x in cands maximize (string-width (caddr x)))) 748 (width (+ pw cw sw)) 749 ;; -4 because of margins and some additional safety 750 (max-width (min corfu-max-width (- (frame-width) 4)))) 751 (when (> width max-width) 752 (setq sw (max 0 (- max-width pw cw)) 753 width (+ pw cw sw))) 754 (when (< width corfu-min-width) 755 (setq cw (+ cw (- corfu-min-width width)) 756 width corfu-min-width)) 757 (setq width (min width max-width)) 758 (list pw width 759 (cl-loop for (cand prefix suffix) in cands collect 760 (truncate-string-to-width 761 (concat prefix 762 (make-string (max 0 (- pw (string-width prefix))) ?\s) 763 cand 764 (when (/= sw 0) 765 (make-string 766 (+ (max 0 (- cw (string-width cand))) 767 (max 0 (- sw (string-width suffix)))) 768 ?\s)) 769 suffix) 770 width))))) 771 772 (defun corfu--update-scroll () 773 "Update scroll position." 774 (let ((off (max (min corfu-scroll-margin (/ corfu-count 2)) 0)) 775 (corr (if (= corfu-scroll-margin (/ corfu-count 2)) (1- (mod corfu-count 2)) 0))) 776 (setq corfu--scroll (min (max 0 (- corfu--total corfu-count)) 777 (max 0 (+ corfu--index off 1 (- corfu-count)) 778 (min (- corfu--index off corr) corfu--scroll)))))) 779 780 (defun corfu--candidates-popup (pos) 781 "Show candidates popup at POS." 782 (corfu--update-scroll) 783 (pcase-let* ((last (min (+ corfu--scroll corfu-count) corfu--total)) 784 (bar (ceiling (* corfu-count corfu-count) corfu--total)) 785 (lo (min (- corfu-count bar 1) (floor (* corfu-count corfu--scroll) corfu--total))) 786 (`(,mf . ,acands) (corfu--affixate (funcall corfu--highlight 787 (seq-subseq corfu--candidates corfu--scroll last)))) 788 (`(,pw ,width ,fcands) (corfu--format-candidates acands)) 789 ;; Disable the left margin if a margin formatter is active. 790 (corfu-left-margin-width (if mf 0 corfu-left-margin-width))) 791 ;; Nonlinearity at the end and the beginning 792 (when (/= corfu--scroll 0) 793 (setq lo (max 1 lo))) 794 (when (/= last corfu--total) 795 (setq lo (min (- corfu-count bar 2) lo))) 796 (corfu--popup-show (+ pos (length corfu--base)) pw width fcands (- corfu--index corfu--scroll) 797 (and (> corfu--total corfu-count) lo) bar))) 798 799 (defun corfu--preview-current (beg end) 800 "Show current candidate as overlay given BEG and END." 801 (when-let (cand (and corfu-preview-current (>= corfu--index 0) 802 (/= corfu--index corfu--preselect) 803 (nth corfu--index corfu--candidates))) 804 (setq corfu--preview-ov (make-overlay beg end nil t t)) 805 (overlay-put corfu--preview-ov 'priority 1000) 806 (overlay-put corfu--preview-ov 'window (selected-window)) 807 (overlay-put corfu--preview-ov 808 (if (= beg end) 'after-string 'display) 809 (concat corfu--base cand)))) 810 811 (defun corfu--echo-cancel (&optional msg) 812 "Cancel echo timer and refresh MSG to prevent flicker during redisplay." 813 (when corfu--echo-timer 814 (cancel-timer corfu--echo-timer) 815 (setq corfu--echo-timer nil)) 816 (corfu--echo-show msg)) 817 818 (defun corfu--echo-show (msg) 819 "Show MSG in echo area." 820 (when (or msg corfu--echo-message) 821 (setq msg (or msg "") 822 corfu--echo-message msg) 823 (corfu--message "%s" (if (text-property-not-all 0 (length msg) 'face nil msg) 824 msg 825 (propertize msg 'face 'corfu-echo))))) 826 827 (defun corfu--echo-documentation () 828 "Show documentation string of current candidate in echo area." 829 (if-let* ((delay (if (consp corfu-echo-documentation) 830 (funcall (if corfu--echo-message #'cdr #'car) 831 corfu-echo-documentation) 832 corfu-echo-documentation)) 833 (fun (plist-get corfu--extra :company-docsig)) 834 (cand (and (>= corfu--index 0) 835 (nth corfu--index corfu--candidates)))) 836 (if (or (eq delay t) (<= delay 0)) 837 (corfu--echo-show (funcall fun cand)) 838 (corfu--echo-cancel) 839 (setq corfu--echo-timer 840 (run-at-time delay nil 841 (lambda () 842 (corfu--echo-show (funcall fun cand)))))) 843 (corfu--echo-cancel))) 844 845 (defun corfu--update () 846 "Refresh Corfu UI." 847 (pcase-let* ((`(,beg ,end ,table ,pred) completion-in-region--data) 848 (pt (- (point) beg)) 849 (str (buffer-substring-no-properties beg end)) 850 (initializing (not corfu--input))) 851 (when corfu--frame-timer 852 (cancel-timer corfu--frame-timer) 853 (setq corfu--frame-timer nil)) 854 (corfu--echo-cancel corfu--echo-message) 855 (cond 856 ;; XXX Guard against errors during candidate generation. 857 ;; Turn off completion immediately if there are errors 858 ;; For example dabbrev throws error "No dynamic expansion ... found". 859 ;; TODO Report this as a bug? Are completion tables supposed to throw errors? 860 ((condition-case err 861 ;; Only recompute when input changed 862 (unless (equal corfu--input (cons str pt)) 863 (corfu--update-candidates str pt table pred) 864 nil) 865 (error (corfu-quit) 866 (message "Corfu completion error: %s" (error-message-string err))))) 867 ;; 1) Initializing, no candidates => Quit. Happens during auto completion. 868 ((and initializing (not corfu--candidates)) 869 (corfu-quit)) 870 ;; 2) Single exactly matching candidate and no further completion is possible. 871 ((and (not (equal str "")) 872 (equal (car corfu--candidates) str) (not (cdr corfu--candidates)) 873 (not (consp (completion-try-completion str table pred pt corfu--metadata))) 874 (or initializing corfu-on-exact-match)) 875 ;; Quit directly when initializing. This happens during auto completion. 876 (if (or initializing (eq corfu-on-exact-match 'quit)) 877 (corfu-quit) 878 (corfu--done str 'finished))) 879 ;; 3) There exist candidates => Show candidates popup. 880 (corfu--candidates 881 (corfu--candidates-popup beg) 882 (corfu--preview-current beg end) 883 (corfu--echo-documentation) 884 (redisplay 'force)) ;; XXX HACK Ensure that popup is redisplayed 885 ;; 4) There are no candidates & corfu-quit-no-match => Confirmation popup. 886 ((and (not corfu--candidates) 887 (pcase-exhaustive corfu-quit-no-match 888 ('t nil) 889 ('nil t) 890 ('separator (seq-contains-p (car corfu--input) corfu-separator)))) 891 (corfu--popup-show beg 0 8 '(#("No match" 0 8 (face italic)))) 892 (redisplay 'force)) ;; XXX HACK Ensure that popup is redisplayed 893 (t (corfu-quit))))) 894 895 (defun corfu--pre-command () 896 "Insert selected candidate unless command is marked to continue completion." 897 (when corfu--preview-ov 898 (delete-overlay corfu--preview-ov) 899 (setq corfu--preview-ov nil)) 900 (when (and (eq corfu-preview-current 'insert) 901 (/= corfu--index corfu--preselect) 902 ;; See the comment about `overriding-local-map' in `corfu--post-command'. 903 (not (or overriding-terminal-local-map 904 (corfu--match-symbol-p corfu-continue-commands this-command)))) 905 (corfu--insert 'exact))) 906 907 (defun corfu-insert-separator () 908 "Insert a separator character, inhibiting quit on completion boundary. 909 See `corfu-separator' for more details." 910 (interactive) 911 (insert corfu-separator)) 912 913 (defun corfu--post-command () 914 "Refresh Corfu after last command." 915 (or (pcase completion-in-region--data 916 (`(,beg ,end . ,_) 917 (when (let ((pt (point))) 918 (and (eq (marker-buffer beg) (current-buffer)) 919 ;; Check ranges 920 (<= beg pt end) 921 (save-excursion 922 (goto-char beg) 923 (let ((inhibit-field-text-motion t)) 924 (<= (line-beginning-position) pt (line-end-position)))) 925 (or 926 ;; TODO We keep alive Corfu if a `overriding-terminal-local-map' is 927 ;; installed, for example the `universal-argument-map'. It would be good to 928 ;; think about a better criterion instead. Unfortunately relying on 929 ;; `this-command' alone is not sufficient, since the value of `this-command' 930 ;; gets clobbered in the case of transient keymaps. 931 overriding-terminal-local-map 932 ;; Check if it is an explicitly listed continue command 933 (corfu--match-symbol-p corfu-continue-commands this-command) 934 (and 935 ;; Check for empty input 936 (or (not corfu--input) (< beg end)) 937 ;; Check separator or predicate 938 (or (not corfu-quit-at-boundary) 939 (and (eq corfu-quit-at-boundary 'separator) 940 (or (eq this-command #'corfu-insert-separator) 941 ;; with separator, any further chars allowed 942 (seq-contains-p (car corfu--input) corfu-separator))) 943 (funcall completion-in-region-mode--predicate)))))) 944 (corfu--update) 945 t))) 946 (corfu-quit)) 947 (when corfu-auto (corfu--auto-post-command))) 948 949 (defun corfu--goto (index) 950 "Go to candidate with INDEX." 951 (setq corfu--index (max corfu--preselect (min index (1- corfu--total))))) 952 953 (defun corfu-next (&optional n) 954 "Go forward N candidates." 955 (interactive "p") 956 (let ((index (+ corfu--index (or n 1)))) 957 (corfu--goto 958 (cond 959 ((not corfu-cycle) index) 960 ((= corfu--total 0) -1) 961 ((< corfu--preselect 0) (1- (mod (1+ index) (1+ corfu--total)))) 962 (t (mod index corfu--total)))))) 963 964 (defun corfu-previous (&optional n) 965 "Go backward N candidates." 966 (interactive "p") 967 (corfu-next (- (or n 1)))) 968 969 (defun corfu-scroll-down (&optional n) 970 "Go back by N pages." 971 (interactive "p") 972 (corfu--goto (max 0 (- corfu--index (* (or n 1) corfu-count))))) 973 974 (defun corfu-scroll-up (&optional n) 975 "Go forward by N pages." 976 (interactive "p") 977 (corfu-scroll-down (- (or n 1)))) 978 979 (defun corfu-first () 980 "Go to first candidate, or to the prompt when the first candidate is selected." 981 (interactive) 982 (corfu--goto (if (> corfu--index 0) 0 -1))) 983 984 (defun corfu-last () 985 "Go to last candidate." 986 (interactive) 987 (corfu--goto (1- corfu--total))) 988 989 (defun corfu-complete () 990 "Try to complete current input. 991 If a candidate is selected, insert it." 992 (interactive) 993 (pcase-let ((`(,beg ,end ,table ,pred) completion-in-region--data)) 994 (if (>= corfu--index 0) 995 ;; Continue completion with selected candidate 996 (progn 997 (corfu--insert nil) 998 ;; Exit with status 'finished if input is a valid match and no further 999 ;; completion is possible. Furthermore treat the completion as 1000 ;; finished if we are at the end of a boundary, even if other longer 1001 ;; candidates would still match, since the user invoked `corfu-complete' 1002 ;; with an explicitly selected candidate! 1003 (let ((newstr (buffer-substring-no-properties beg end))) 1004 (when (and (test-completion newstr table pred) 1005 (or 1006 (not (consp (completion-try-completion 1007 newstr table pred (length newstr) 1008 (completion-metadata newstr table pred)))) 1009 (equal (completion-boundaries newstr table pred "") '(0 . 0)))) 1010 (corfu--done newstr 'finished)))) 1011 ;; Try to complete the current input string 1012 (let* ((pt (max 0 (- (point) beg))) 1013 (str (buffer-substring-no-properties beg end)) 1014 (metadata (completion-metadata (substring str 0 pt) table pred))) 1015 (pcase (completion-try-completion str table pred pt metadata) 1016 ('t 1017 (goto-char end) 1018 (corfu--done str 'finished)) 1019 (`(,newstr . ,newpt) 1020 (unless (equal str newstr) 1021 ;; bug#55205: completion--replace removes properties! 1022 (completion--replace beg end (concat newstr))) 1023 (goto-char (+ beg newpt)) 1024 ;; Exit with status 'finished if input is a valid match 1025 ;; and no further completion is possible. 1026 (when (and (test-completion newstr table pred) 1027 (not (consp (completion-try-completion 1028 newstr table pred newpt 1029 (completion-metadata newstr table pred))))) 1030 (corfu--done newstr 'finished)))))))) 1031 1032 (defun corfu--insert (status) 1033 "Insert current candidate, exit with STATUS if non-nil." 1034 (pcase-let* ((`(,beg ,end . ,_) completion-in-region--data) 1035 (str (buffer-substring-no-properties beg end))) 1036 ;; XXX There is a small bug here, depending on interpretation. 1037 ;; When completing "~/emacs/master/li|/calc" where "|" is the 1038 ;; cursor, then the candidate only includes the prefix 1039 ;; "~/emacs/master/lisp/", but not the suffix "/calc". Default 1040 ;; completion has the same problem when selecting in the 1041 ;; *Completions* buffer. See bug#48356. 1042 (setq str (concat corfu--base (substring-no-properties 1043 (nth corfu--index corfu--candidates)))) 1044 ;; bug#55205: completion--replace removes properties! 1045 (completion--replace beg end (concat str)) 1046 (corfu--goto -1) ;; Reset selection, but continue completion. 1047 (when status (corfu--done str status)))) ;; Exit with status 1048 1049 (defun corfu--done (str status) 1050 "Call the `:exit-function' with STR and STATUS and exit completion." 1051 (let ((exit (plist-get corfu--extra :exit-function))) 1052 ;; For successfull completions, amalgamate undo operations, 1053 ;; such that completion can be undone in a single step. 1054 (undo-amalgamate-change-group corfu--change-group) 1055 (corfu-quit) 1056 ;; XXX Is the :exit-function handling sufficient? 1057 (when exit (funcall exit str status)))) 1058 1059 (defun corfu-insert () 1060 "Insert current candidate. 1061 Quit if no candidate is selected." 1062 (interactive) 1063 (if (>= corfu--index 0) 1064 (corfu--insert 'finished) 1065 (corfu-quit))) 1066 1067 (defun corfu--setup () 1068 "Setup Corfu completion state." 1069 (setq corfu--extra completion-extra-properties) 1070 (completion-in-region-mode 1) 1071 (undo-boundary) ;; Necessary to support `corfu-reset' 1072 (activate-change-group (setq corfu--change-group (prepare-change-group))) 1073 (setcdr (assq #'completion-in-region-mode minor-mode-overriding-map-alist) corfu-map) 1074 (add-hook 'pre-command-hook #'corfu--pre-command nil 'local) 1075 (add-hook 'post-command-hook #'corfu--post-command) 1076 ;; Disable default post-command handling, since we have our own 1077 ;; checks in `corfu--post-command'. 1078 (remove-hook 'post-command-hook #'completion-in-region--postch) 1079 (let ((sym (make-symbol "corfu--teardown")) 1080 (buf (current-buffer))) 1081 (fset sym (lambda () 1082 ;; Ensure that the teardown runs in the correct buffer, if still alive. 1083 (unless completion-in-region-mode 1084 (remove-hook 'completion-in-region-mode-hook sym) 1085 (with-current-buffer (if (buffer-live-p buf) buf (current-buffer)) 1086 (corfu--teardown))))) 1087 (add-hook 'completion-in-region-mode-hook sym))) 1088 1089 (defun corfu--teardown () 1090 "Teardown Corfu." 1091 (corfu--popup-hide) 1092 (remove-hook 'pre-command-hook #'corfu--pre-command 'local) 1093 (remove-hook 'post-command-hook #'corfu--post-command) 1094 (when corfu--preview-ov (delete-overlay corfu--preview-ov)) 1095 (corfu--echo-cancel) 1096 (accept-change-group corfu--change-group) 1097 (mapc #'kill-local-variable corfu--state-vars)) 1098 1099 (defun corfu--in-region (&rest args) 1100 "Corfu completion in region function called with ARGS." 1101 ;; XXX We can get an endless loop when `completion-in-region-function' is set 1102 ;; globally to `corfu--in-region'. This should never happen. 1103 (apply (if (corfu--popup-support-p) #'corfu--in-region-1 1104 (default-value 'completion-in-region-function)) 1105 args)) 1106 1107 (defun corfu--in-region-1 (beg end table &optional pred) 1108 "Complete in region, see `completion-in-region' for BEG, END, TABLE, PRED." 1109 (barf-if-buffer-read-only) 1110 ;; Restart the completion. This can happen for example if C-M-/ 1111 ;; (`dabbrev-completion') is pressed while the Corfu popup is already open. 1112 (when completion-in-region-mode (corfu-quit)) 1113 (let* ((pt (max 0 (- (point) beg))) 1114 (str (buffer-substring-no-properties beg end)) 1115 (before (substring str 0 pt)) 1116 (metadata (completion-metadata before table pred)) 1117 (exit (plist-get completion-extra-properties :exit-function)) 1118 (threshold (completion--cycle-threshold metadata)) 1119 (completion-in-region-mode-predicate 1120 (or completion-in-region-mode-predicate (lambda () t)))) 1121 (pcase (completion-try-completion str table pred pt metadata) 1122 ('nil (corfu--message "No match") nil) 1123 ('t (goto-char end) 1124 (corfu--message "Sole match") 1125 (when exit (funcall exit str 'finished)) 1126 t) 1127 (`(,newstr . ,newpt) 1128 (pcase-let ((`(,base ,candidates ,total . ,_) 1129 (corfu--recompute-candidates str pt table pred))) 1130 (unless (markerp beg) (setq beg (copy-marker beg))) 1131 (setq end (copy-marker end t) 1132 completion-in-region--data (list beg end table pred)) 1133 (unless (equal str newstr) 1134 ;; bug#55205: completion--replace removes properties! 1135 (completion--replace beg end (concat newstr))) 1136 (goto-char (+ beg newpt)) 1137 (if (= total 1) 1138 ;; If completion is finished and cannot be further completed, 1139 ;; return 'finished. Otherwise setup the Corfu popup. 1140 (cond 1141 ((consp (completion-try-completion 1142 newstr table pred newpt 1143 (completion-metadata newstr table pred))) 1144 (corfu--setup)) 1145 (exit (funcall exit newstr 'finished))) 1146 (if (or (= total 0) (not threshold) 1147 (and (not (eq threshold t)) (< threshold total))) 1148 (corfu--setup) 1149 (corfu--cycle-candidates total candidates (+ (length base) beg) end) 1150 ;; Do not show Corfu when "trivially" cycling, i.e., 1151 ;; when the completion is finished after the candidate. 1152 (unless (equal (completion-boundaries (car candidates) table pred "") 1153 '(0 . 0)) 1154 (corfu--setup))))) 1155 t)))) 1156 1157 (defun corfu--message (&rest msg) 1158 "Show completion MSG." 1159 (let (message-log-max) (apply #'message msg))) 1160 1161 (defun corfu--cycle-candidates (total cands beg end) 1162 "Cycle between TOTAL number of CANDS. 1163 See `completion-in-region' for the arguments BEG, END, TABLE, PRED." 1164 (let* ((idx 0) 1165 (map (make-sparse-keymap)) 1166 (replace (lambda () 1167 (interactive) 1168 ;; bug#55205: completion--replace removes properties! 1169 (completion--replace beg end (concat (nth idx cands))) 1170 (corfu--message "Cycling %d/%d..." (1+ idx) total) 1171 (setq idx (mod (1+ idx) total)) 1172 (set-transient-map map)))) 1173 (define-key map [remap completion-at-point] replace) 1174 (define-key map [remap corfu-complete] replace) 1175 (define-key map (vector last-command-event) replace) 1176 (funcall replace))) 1177 1178 (defun corfu--auto-complete-deferred (&optional tick) 1179 "Initiate auto completion if TICK did not change." 1180 (setq corfu--auto-timer nil) 1181 (when (and (not completion-in-region-mode) 1182 (or (not tick) (equal tick (corfu--auto-tick)))) 1183 (pcase (while-no-input ;; Interruptible capf query 1184 (run-hook-wrapped 'completion-at-point-functions #'corfu--capf-wrapper)) 1185 (`(,fun ,beg ,end ,table . ,plist) 1186 (let ((completion-in-region-mode-predicate 1187 (lambda () (eq beg (car-safe (funcall fun))))) 1188 (completion-extra-properties plist)) 1189 (setq completion-in-region--data 1190 (list (if (markerp beg) beg (copy-marker beg)) 1191 (copy-marker end t) 1192 table 1193 (plist-get plist :predicate))) 1194 (corfu--setup) 1195 (corfu--update)))))) 1196 1197 (defun corfu--auto-post-command () 1198 "Post command hook which initiates auto completion." 1199 (when corfu--auto-timer 1200 (cancel-timer corfu--auto-timer) 1201 (setq corfu--auto-timer nil)) 1202 (when (and (not completion-in-region-mode) 1203 (not defining-kbd-macro) 1204 (not buffer-read-only) 1205 (corfu--match-symbol-p corfu-auto-commands this-command) 1206 (corfu--popup-support-p)) 1207 (if (<= corfu-auto-delay 0) 1208 (corfu--auto-complete-deferred) 1209 ;; NOTE: Do not use idle timer since this leads to unacceptable slowdowns, 1210 ;; in particular if flyspell-mode is enabled. 1211 (setq corfu--auto-timer 1212 (run-at-time corfu-auto-delay nil 1213 #'corfu--auto-complete-deferred (corfu--auto-tick)))))) 1214 1215 (defun corfu--auto-tick () 1216 "Return the current tick/status of the buffer. 1217 Auto completion is only performed if the tick did not change." 1218 (list (current-buffer) (buffer-chars-modified-tick) (point))) 1219 1220 ;;;###autoload 1221 (define-minor-mode corfu-mode 1222 "Completion Overlay Region FUnction." 1223 :global nil :group 'corfu 1224 (cond 1225 (corfu-mode 1226 ;; FIXME: Install advice which fixes `completion--capf-wrapper', such that 1227 ;; it respects the completion styles for non-exclusive capfs. See FIXME in 1228 ;; the `completion--capf-wrapper' function in minibuffer.el, where the 1229 ;; issue has been mentioned. We never uninstall this advice since the 1230 ;; advice is active *globally*. 1231 (advice-add #'completion--capf-wrapper :around #'corfu--capf-wrapper-advice) 1232 (advice-add #'eldoc-display-message-no-interference-p :before-while #'corfu--allow-eldoc) 1233 (and corfu-auto (add-hook 'post-command-hook #'corfu--auto-post-command nil 'local)) 1234 (setq-local completion-in-region-function #'corfu--in-region)) 1235 (t 1236 (remove-hook 'post-command-hook #'corfu--auto-post-command 'local) 1237 (kill-local-variable 'completion-in-region-function)))) 1238 1239 (defun corfu--capf-wrapper (fun &optional prefix) 1240 "Wrapper for `completion-at-point' FUN. 1241 The wrapper determines if the capf is applicable at the current position 1242 and performs sanity checking on the returned result. PREFIX is a prefix 1243 length override, set to t for manual completion." 1244 (pcase (funcall fun) 1245 ((and res `(,beg ,end ,table . ,plist)) 1246 (and (integer-or-marker-p beg) ;; Valid capf result 1247 (<= beg (point) end) ;; Sanity checking 1248 ;; When auto completing, check the prefix length! 1249 (let ((len (or prefix 1250 (plist-get plist :company-prefix-length) 1251 (- (point) beg)))) 1252 (or (eq len t) (>= len corfu-auto-prefix))) 1253 ;; For non-exclusive capfs, check for valid completion. 1254 (or (not (eq 'no (plist-get plist :exclusive))) 1255 (let* ((str (buffer-substring-no-properties beg end)) 1256 (pt (- (point) beg)) 1257 (pred (plist-get plist :predicate)) 1258 (md (completion-metadata (substring str 0 pt) table pred))) 1259 ;; We use `completion-try-completion' to check if there are 1260 ;; completions. The upstream `completion--capf-wrapper' uses 1261 ;; `try-completion' which is incorrect since it only checks for 1262 ;; prefix completions. 1263 (completion-try-completion str table pred pt md))) 1264 (cons fun res))))) 1265 1266 (defun corfu--capf-wrapper-advice (orig fun which) 1267 "Around advice for `completion--capf-wrapper'. 1268 The ORIG function takes the FUN and WHICH arguments." 1269 (if corfu-mode (corfu--capf-wrapper fun t) (funcall orig fun which))) 1270 1271 ;;;###autoload 1272 (define-globalized-minor-mode global-corfu-mode corfu-mode corfu--on :group 'corfu) 1273 1274 (defun corfu--on () 1275 "Turn `corfu-mode' on." 1276 (unless (or noninteractive 1277 (eq (aref (buffer-name) 0) ?\s) 1278 (memq major-mode corfu-excluded-modes)) 1279 (corfu-mode 1))) 1280 1281 (defun corfu--allow-eldoc () 1282 "Return non-nil if Corfu is currently not active." 1283 (not (and corfu-mode completion-in-region-mode))) 1284 1285 ;; Emacs 28: Do not show Corfu commands with M-X 1286 (dolist (sym '(corfu-next corfu-previous corfu-first corfu-last corfu-quit corfu-reset 1287 corfu-complete corfu-insert corfu-scroll-up corfu-scroll-down 1288 corfu-insert-separator)) 1289 (put sym 'completion-predicate #'ignore)) 1290 1291 (provide 'corfu) 1292 ;;; corfu.el ends here