config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

corfu.el (61521B)


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