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