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