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