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