corfu-quick.el (5643B)
1 ;;; corfu-quick.el --- Quick keys for Corfu -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2022-2024 Free Software Foundation, Inc. 4 5 ;; Author: Luis Henriquez-Perez <luis@luishp.xyz>, Daniel Mendler <mail@daniel-mendler.de> 6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> 7 ;; Created: 2022 8 ;; Package-Requires: ((emacs "28.1") (compat "30") (corfu "1.5")) 9 ;; URL: https://github.com/minad/corfu 10 11 ;; This file is part of GNU Emacs. 12 13 ;; This program is free software: you can redistribute it and/or modify 14 ;; it under the terms of the GNU General Public License as published by 15 ;; the Free Software Foundation, either version 3 of the License, or 16 ;; (at your option) any later version. 17 18 ;; This program is distributed in the hope that it will be useful, 19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 21 ;; GNU General Public License for more details. 22 23 ;; You should have received a copy of the GNU General Public License 24 ;; along with this program. If not, see <https://www.gnu.org/licenses/>. 25 26 ;;; Commentary: 27 28 ;; This package is a Corfu extension, which prefixes candidates with 29 ;; quick keys. Typing these quick keys allows you to select the 30 ;; candidate in front of them. This is designed to be a faster 31 ;; alternative to selecting a candidate with `corfu-next' and 32 ;; `corfu-previous'. 33 ;; (keymap-set corfu-map "M-q" #'corfu-quick-complete) 34 ;; (keymap-set corfu-map "C-q" #'corfu-quick-insert) 35 36 ;;; Code: 37 38 (require 'corfu) 39 (eval-when-compile 40 (require 'cl-lib)) 41 42 (defcustom corfu-quick1 "asdfgh" 43 "First level quick keys." 44 :type 'string 45 :group 'corfu) 46 47 (defcustom corfu-quick2 "jkluionm" 48 "Second level quick keys." 49 :type 'string 50 :group 'corfu) 51 52 (defface corfu-quick1 53 '((((class color) (min-colors 88) (background dark)) 54 :background "#0050af" :foreground "white" :inherit bold) 55 (((class color) (min-colors 88) (background light)) 56 :background "#7feaff" :foreground "black" :inherit bold) 57 (t :background "blue" :foreground "white" :inherit bold)) 58 "Face used for the first quick key." 59 :group 'corfu-faces) 60 61 (defface corfu-quick2 62 '((((class color) (min-colors 88) (background dark)) 63 :background "#7f1f7f" :foreground "white" :inherit bold) 64 (((class color) (min-colors 88) (background light)) 65 :background "#ffaaff" :foreground "black" :inherit bold) 66 (t :background "magenta" :foreground "white" :inherit bold)) 67 "Face used for the second quick key." 68 :group 'corfu-faces) 69 70 (defun corfu-quick--keys (two idx) ;; See vertico-quick--keys 71 "Format quick keys prefix. 72 IDX is the current candidate index. 73 TWO is non-nil if two keys should be displayed." 74 (let ((fst (length corfu-quick1)) 75 (snd (length corfu-quick2))) 76 (if (>= idx fst) 77 (let ((first (elt corfu-quick2 (mod (/ (- idx fst) fst) snd))) 78 (second (elt corfu-quick1 (mod (- idx fst) fst)))) 79 (cond 80 ((eq first two) 81 (list 82 (concat " " (propertize (char-to-string second) 'face 'corfu-quick1)) 83 (cons second (+ corfu--scroll idx)))) 84 (two 85 (list " ")) 86 (t 87 (list 88 (concat (propertize (char-to-string first) 'face 'corfu-quick1) 89 (propertize (char-to-string second) 'face 'corfu-quick2)) 90 (cons first (list first)))))) 91 (let ((first (elt corfu-quick1 (mod idx fst)))) 92 (if two 93 (list " ") 94 (list 95 (concat (propertize (char-to-string first) 'face 'corfu-quick1) " ") 96 (cons first (+ corfu--scroll idx)))))))) 97 98 (defun corfu-quick--read (&optional first) 99 "Read quick key given FIRST pressed key." 100 (cl-letf* ((list nil) 101 (space1 (propertize " " 'display 102 `(space :width 103 (+ 0.5 (,(alist-get 104 'child-frame-border-width 105 corfu--frame-parameters)))))) 106 (space2 #(" " 0 1 (display (space :width 0.5)))) 107 (orig (symbol-function #'corfu--affixate)) 108 ((symbol-function #'corfu--affixate) 109 (lambda (cands) 110 (setq cands (cdr (funcall orig cands))) 111 (cl-loop for cand in cands for index from 0 do 112 (pcase-let ((`(,keys . ,events) (corfu-quick--keys first index))) 113 (setq list (nconc events list)) 114 (setf (cadr cand) (concat space1 (propertize " " 'display keys) space2)))) 115 (cons t cands))) 116 ;; Increase minimum width to avoid odd jumping 117 (corfu-min-width (+ 3 corfu-min-width))) 118 (corfu--candidates-popup 119 (posn-at-point (+ (car completion-in-region--data) (length corfu--base)))) 120 (alist-get (read-key) list))) 121 122 ;;;###autoload 123 (defun corfu-quick-jump () 124 "Jump to candidate using quick keys." 125 (interactive) 126 (when (fboundp 'corfu-echo--cancel) 127 (corfu-echo--cancel)) 128 (if (= corfu--total 0) 129 (and (message "No match") nil) 130 (let ((idx (corfu-quick--read))) 131 (when (consp idx) (setq idx (corfu-quick--read (car idx)))) 132 (when idx (setq corfu--index idx))))) 133 134 ;;;###autoload 135 (defun corfu-quick-insert () 136 "Insert candidate using quick keys." 137 (interactive) 138 (when (corfu-quick-jump) 139 (corfu-insert))) 140 141 ;;;###autoload 142 (defun corfu-quick-complete () 143 "Complete candidate using quick keys." 144 (interactive) 145 (when (corfu-quick-jump) 146 (corfu-complete))) 147 148 (provide 'corfu-quick) 149 ;;; corfu-quick.el ends here