vertico-multiform.el (8968B)
1 ;;; vertico-multiform.el --- Configure Vertico in different forms per command -*- 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 ;; Package-Requires: ((emacs "28.1") (compat "30") (vertico "1.9")) 9 ;; URL: https://github.com/minad/vertico 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 Vertico extension for fine tuning the Vertico 29 ;; display and other minibuffer modes per command or completion 30 ;; category. For some commands you may want to use the 31 ;; `vertico-buffer' display and for completion categories like file 32 ;; you prefer the `vertico-grid-mode'. 33 ;; 34 ;; Example: 35 ;; 36 ;; (setq vertico-multiform-commands 37 ;; '((consult-line buffer) 38 ;; (consult-imenu reverse buffer) 39 ;; (execute-extended-command flat))) 40 ;; 41 ;; (setq vertico-multiform-categories 42 ;; '((file buffer grid) 43 ;; (imenu (:not indexed mouse)) 44 ;; (symbol (vertico-sort-function . vertico-sort-alpha)))) 45 ;; 46 ;; (vertico-multiform-mode) 47 ;; 48 ;; Temporary toggling between the different display modes is possible. 49 ;; The following keys are bound in the `vertico-multiform-map'. 50 ;; 51 ;; M-B -> `vertico-multiform-buffer' 52 ;; M-F -> `vertico-multiform-flat' 53 ;; M-G -> `vertico-multiform-grid' 54 ;; M-R -> `vertico-multiform-reverse' 55 ;; M-U -> `vertico-multiform-unobtrusive' 56 ;; M-V -> `vertico-multiform-vertical' 57 ;; 58 ;;; Code: 59 60 (require 'vertico) 61 (eval-when-compile (require 'cl-lib)) 62 63 (defcustom vertico-multiform-commands nil 64 "Alist of commands/regexps and list of settings to turn on per command. 65 Takes precedence over `vertico-multiform-categories'. A setting 66 can either be a mode symbol, a function, an inverted mode symbol 67 or function, or a cons cell of variable name and value. The key 68 t can be used to specify catch all/default settings. The value 69 of `this-command' is used as key for the lookup." 70 :group 'vertico 71 :type '(alist :key-type (choice symbol regexp (const t)) :value-type (repeat sexp))) 72 73 (defcustom vertico-multiform-categories nil 74 "Alist of categories/regexps and list of settings to turn on per category. 75 See `vertico-multiform-commands' on details about the settings. The 76 category settings have lower precedence than 77 `vertico-multiform-commands'." 78 :group 'vertico 79 :type '(alist :key-type (choice symbol regexp (const t)) :value-type (repeat sexp))) 80 81 (defvar vertico-multiform--stack nil) 82 83 (defun vertico-multiform--toggle (arg) 84 "Toggle modes from stack depending on ARG." 85 (when-let ((win (active-minibuffer-window)) 86 (modes (car vertico-multiform--stack))) 87 (when (> arg 0) (setq modes (reverse modes))) 88 (with-selected-window win 89 (dolist (m modes) 90 (if (eq (car-safe m) :not) 91 (funcall (cdr m) (- arg)) 92 (funcall m arg)))))) 93 94 (defun vertico-multiform--lookup (key list) 95 "Lookup symbolic KEY in LIST. 96 The keys in LIST can be symbols or regexps." 97 (and (symbolp key) 98 (let (case-fold-search) 99 (seq-find (pcase-lambda (`(,x . ,_)) 100 (cond 101 ((eq x t)) 102 ((symbolp x) (eq key x)) 103 ((string-match-p x (symbol-name key))))) 104 list)))) 105 106 (defun vertico-multiform--setup () 107 "Enable modes at minibuffer setup." 108 (let ((cat (compat-call completion-metadata-get 109 (completion-metadata (buffer-substring-no-properties 110 (minibuffer-prompt-end) 111 (max (minibuffer-prompt-end) (point))) 112 minibuffer-completion-table 113 minibuffer-completion-predicate) 114 'category)) 115 (exit (make-symbol "vertico-multiform--exit")) 116 (depth (recursion-depth)) 117 (modes nil)) 118 (fset exit (lambda () 119 (when (= depth (recursion-depth)) 120 (remove-hook 'minibuffer-exit-hook exit) 121 (vertico-multiform--toggle -1) 122 (pop vertico-multiform--stack)))) 123 (add-hook 'minibuffer-exit-hook exit) 124 (dolist (x (cdr (or (vertico-multiform--lookup this-command vertico-multiform-commands) 125 (vertico-multiform--lookup cat vertico-multiform-categories)))) 126 (pcase x 127 (`(:not . ,fs) 128 (dolist (f fs) 129 (let ((sym (and (symbolp f) (intern-soft (format "vertico-%s-mode" f))))) 130 (push (cons :not (if (and sym (fboundp sym)) sym f)) modes)))) 131 ((or (pred functionp) (pred symbolp)) 132 (let ((sym (and (symbolp x) (intern-soft (format "vertico-%s-mode" x))))) 133 (push (if (and sym (fboundp sym)) sym x) modes))) 134 (`(,k . ,v) (set (make-local-variable k) v)) 135 (_ (error "Invalid multiform setting %S" x)))) 136 (push modes vertico-multiform--stack) 137 (vertico-multiform--toggle 1) 138 (vertico--setup))) 139 140 (defvar-keymap vertico-multiform-map 141 :doc "Additional keymap activated in multiform mode.") 142 143 ;;;###autoload 144 (define-minor-mode vertico-multiform-mode 145 "Configure Vertico in various forms per command." 146 :global t :group 'vertico 147 (when (/= (recursion-depth) 0) 148 (warn "vertico-multiform must not be toggled from recursive minibuffers")) 149 (when vertico-multiform--stack 150 (warn "vertico-multiform state is inconsistent") 151 (setq vertico-multiform--stack nil)) 152 (cl-callf2 rassq-delete-all vertico-multiform-map minor-mode-map-alist) 153 (when vertico-multiform-mode 154 (push `(vertico--input . ,vertico-multiform-map) minor-mode-map-alist))) 155 156 (cl-defmethod vertico--advice (&context (vertico-multiform-mode (eql t)) &rest app) 157 (unwind-protect 158 (progn 159 (vertico-multiform--toggle -1) 160 (minibuffer-with-setup-hook #'vertico-multiform--setup 161 (apply app))) 162 (vertico-multiform--toggle 1))) 163 164 (defun vertico-multiform--temporary-mode (mode arg) 165 "Enable or disable MODE temporarily in minibuffer given ARG. 166 ARG can be nil, t, -1, 1 or toggle." 167 (unless (minibufferp) 168 (user-error "`%s' must be called inside the minibuffer" this-command)) 169 (unless vertico-multiform-mode 170 (user-error "`vertico-multiform-mode' is not enabled")) 171 (setq arg (pcase arg 172 ('toggle (not (and (boundp mode) (symbol-value mode)))) 173 ((or 'nil 't) arg) 174 (_ (> arg 0)))) 175 (unless (eq arg (and (boundp mode) (symbol-value mode))) 176 (funcall mode (if arg 1 -1)) 177 (let ((modes (car vertico-multiform--stack)) 178 (not-mode (cons :not mode))) 179 (when arg 180 (cl-rotatef not-mode mode)) 181 (if (member mode modes) 182 (setcar vertico-multiform--stack (remove mode modes)) 183 (push not-mode (car vertico-multiform--stack)))))) 184 185 (defvar vertico-multiform--display-modes nil) 186 (defvar-local vertico-multiform--display-last nil) 187 188 (defun vertico-multiform-vertical (&optional mode) 189 "Toggle to display MODE temporarily in minibuffer. 190 MODE defaults to the vertical display." 191 (interactive) 192 (let (last) 193 (dolist (m vertico-multiform--display-modes) 194 (when (and (boundp m) (symbol-value m)) 195 (setq last m) 196 (vertico-multiform--temporary-mode m -1))) 197 (when (eq last mode) 198 (setq mode vertico-multiform--display-last)) 199 (when mode 200 (vertico-multiform--temporary-mode mode 1)) 201 (setq vertico-multiform--display-last last))) 202 203 (pcase-dolist (`(,key ,name) '(("M-B" buffer) 204 ("M-F" flat) 205 ("M-G" grid) 206 ("M-R" reverse) 207 ("M-U" unobtrusive) ;; must come after flat 208 ("M-V" vertical))) 209 (let ((toggle (intern (format "vertico-multiform-%s" name)))) 210 (unless (eq name 'vertical) 211 (let ((mode (intern (format "vertico-%s-mode" name)))) 212 (defalias toggle 213 (lambda () (interactive) (vertico-multiform-vertical mode)) 214 (format "Toggle the %s display." name)) 215 (push mode vertico-multiform--display-modes))) 216 (put toggle 'completion-predicate #'vertico--command-p) 217 (keymap-set vertico-multiform-map key toggle))) 218 219 (provide 'vertico-multiform) 220 ;;; vertico-multiform.el ends here