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