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