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