corfu-quick.el (5802B)
1 ;;; corfu-quick.el --- Quick keys for Corfu -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2022 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: 0.1 9 ;; Package-Requires: ((emacs "27.1") (corfu "0.23")) 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 <http://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 ;; (define-key corfu-map "\M-q" #'corfu-quick-complete) 35 ;; (define-key corfu-map "\C-q" #'corfu-quick-exit) 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 "jkl" 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 (len (+ fst snd))) 78 (if (>= idx fst) 79 (let ((first (elt corfu-quick2 (mod (/ (- idx fst) len) snd))) 80 (second (elt (concat corfu-quick1 corfu-quick2) (mod (- idx fst) len)))) 81 (cond 82 ((eq first two) 83 (list 84 (concat " " (propertize (char-to-string second) 'face 'corfu-quick1)) 85 (cons second (+ corfu--scroll idx)))) 86 (two 87 (list " ")) 88 (t 89 (list 90 (concat (propertize (char-to-string first) 'face 'corfu-quick1) 91 (propertize (char-to-string second) 'face 'corfu-quick2)) 92 (cons first (list first)))))) 93 (let ((first (elt corfu-quick1 (mod idx fst)))) 94 (if two 95 (list " ") 96 (list 97 (concat (propertize (char-to-string first) 'face 'corfu-quick1) " ") 98 (cons first (+ corfu--scroll idx)))))))) 99 100 (defun corfu-quick--read (&optional first) 101 "Read quick key given FIRST pressed key." 102 (cl-letf* ((list nil) 103 (space1 (propertize " " 'display 104 `(space :width 105 (+ 0.5 (,(alist-get 106 'child-frame-border-width 107 corfu--frame-parameters)))))) 108 (space2 #(" " 0 1 (display (space :width 0.5)))) 109 (orig (symbol-function #'corfu--affixate)) 110 ((symbol-function #'corfu--affixate) 111 (lambda (cands) 112 (setq cands (cdr (funcall orig cands))) 113 (cl-loop for cand in cands for index from 0 do 114 (pcase-let ((`(,keys . ,events) (corfu-quick--keys first index))) 115 (setq list (nconc events list)) 116 (setf (cadr cand) (concat space1 (propertize " " 'display keys) space2)))) 117 (cons t cands))) 118 ;; Increase minimum width to avoid odd jumping 119 (corfu-min-width (+ 3 corfu-min-width))) 120 (corfu--candidates-popup (car completion-in-region--data)) 121 (alist-get (read-key) list))) 122 123 ;;;###autoload 124 (defun corfu-quick-jump () 125 "Jump to candidate using quick keys." 126 (interactive) 127 (setq corfu--echo-message "") 128 (corfu--echo-refresh) 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