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