vertico-grid.el (7144B)
1 ;;; vertico-grid.el --- Grid display for Vertico -*- 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.8 9 ;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4") (vertico "1.8")) 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 providing a grid display. 30 ;; 31 ;; The mode can be enabled globally or via `vertico-multiform-mode' 32 ;; per command or completion category. Alternatively the grid display 33 ;; can be toggled temporarily with M-G if `vertico-multiform-mode' is 34 ;; enabled. 35 36 ;;; Code: 37 38 (require 'vertico) 39 (eval-when-compile 40 (require 'cl-lib) 41 (require 'subr-x)) 42 43 (defcustom vertico-grid-min-columns 2 44 "Minimal number of grid columns." 45 :type 'natnum 46 :group 'vertico) 47 48 (defcustom vertico-grid-max-columns 8 49 "Maximal number of grid columns." 50 :type 'natnum 51 :group 'vertico) 52 53 (defcustom vertico-grid-annotate 0 54 "Reserved characters for the annotations." 55 :type 'natnum 56 :group 'vertico) 57 58 (defcustom vertico-grid-separator 59 #(" | " 3 4 (display (space :width (1)) face (:inherit shadow :inverse-video t))) 60 "Separator between columns." 61 :type 'string 62 :group 'vertico) 63 64 (defcustom vertico-grid-lookahead 100 65 "Number of candidates to lookahead for column number computation. 66 When scrolling beyond this limit, candidates may be truncated." 67 :type 'natnum 68 :group 'vertico) 69 70 (defvar-keymap vertico-grid-map 71 :doc "Additional keymap activated in grid mode." 72 "<remap> <left-char>" #'vertico-grid-left 73 "<remap> <right-char>" #'vertico-grid-right 74 "<remap> <scroll-down-command>" #'vertico-grid-scroll-down 75 "<remap> <scroll-up-command>" #'vertico-grid-scroll-up) 76 77 (defvar-local vertico-grid--columns vertico-grid-min-columns 78 "Current number of grid columns.") 79 80 (defun vertico-grid-left (&optional n) 81 "Move N columns to the left in the grid." 82 (interactive "p") 83 (vertico-grid-right (- (or n 1)))) 84 85 (defun vertico-grid-right (&optional n) 86 "Move N columns to the right in the grid." 87 (interactive "p") 88 (let* ((page (* vertico-count vertico-grid--columns)) 89 (x1 (/ (% vertico--index page) vertico-count)) 90 (cols (min (1- vertico-grid--columns) 91 (+ x1 (/ (- vertico--total vertico--index 1) vertico-count)))) 92 (x2 (if vertico-cycle 93 (mod (+ x1 (or n 1)) (1+ cols)) 94 (min cols (max 0 (+ x1 (or n 1))))))) 95 (vertico--goto (+ vertico--index (* vertico-count (- x2 x1)))))) 96 97 (defun vertico-grid-scroll-down (&optional n) 98 "Go back by N pages." 99 (interactive "p") 100 (vertico--goto (max 0 (- vertico--index (* (or n 1) vertico-grid--columns vertico-count))))) 101 102 (defun vertico-grid-scroll-up (&optional n) 103 "Go forward by N pages." 104 (interactive "p") 105 (vertico-grid-scroll-down (- (or n 1)))) 106 107 ;;;###autoload 108 (define-minor-mode vertico-grid-mode 109 "Grid display for Vertico." 110 :global t :group 'vertico 111 ;; Shrink current minibuffer window 112 (when-let ((win (active-minibuffer-window))) 113 (unless (frame-root-window-p win) 114 (window-resize win (- (window-pixel-height win)) nil nil 'pixelwise))) 115 (cl-callf2 rassq-delete-all vertico-grid-map minor-mode-map-alist) 116 (when vertico-grid-mode 117 (push `(vertico--input . ,vertico-grid-map) minor-mode-map-alist))) 118 119 (cl-defmethod vertico--arrange-candidates (&context (vertico-grid-mode (eql t))) 120 (when (<= vertico--index 0) 121 (let ((w 1)) 122 (cl-loop repeat vertico-grid-lookahead for cand in vertico--candidates do 123 (setq w (max w (+ vertico-grid-annotate (length cand))))) 124 (setq vertico-grid--columns 125 (max vertico-grid-min-columns 126 (min vertico-grid-max-columns 127 (floor (vertico--window-width) (+ w (length vertico-grid-separator)))))))) 128 (let* ((sep (length vertico-grid-separator)) 129 (count (* vertico-count vertico-grid--columns)) 130 (start (* count (floor (max 0 vertico--index) count))) 131 (width (- (/ (vertico--window-width) vertico-grid--columns) sep)) 132 (cands (funcall (if (> vertico-grid-annotate 0) #'vertico--affixate #'identity) 133 (cl-loop repeat count for c in (nthcdr start vertico--candidates) 134 collect (funcall vertico--hilit (substring c))))) 135 (cands (cl-loop 136 for cand in cands for index from 0 collect 137 (let (prefix suffix) 138 (when (consp cand) 139 (setq prefix (cadr cand) suffix (caddr cand) cand (car cand))) 140 (when (string-search "\n" cand) 141 (setq cand (vertico--truncate-multiline cand width))) 142 (truncate-string-to-width 143 (string-trim 144 (replace-regexp-in-string 145 "[ \t]+" 146 (lambda (x) (apply #'propertize " " (text-properties-at 0 x))) 147 (vertico--format-candidate cand prefix suffix (+ index start) start))) 148 width)))) 149 (width (make-vector vertico-grid--columns 0))) 150 (dotimes (col vertico-grid--columns) 151 (dotimes (row vertico-count) 152 (aset width col (max 153 (aref width col) 154 (string-width (or (nth (+ row (* col vertico-count)) cands) "")))))) 155 (dotimes (col (1- vertico-grid--columns)) 156 (cl-incf (aref width (1+ col)) (+ (aref width col) sep))) 157 (cl-loop for row from 0 to (1- (min vertico-count vertico--total)) collect 158 (let ((line (list "\n"))) 159 (cl-loop for col from (1- vertico-grid--columns) downto 0 do 160 (when-let ((cand (nth (+ row (* col vertico-count)) cands))) 161 (push cand line) 162 (when (> col 0) 163 (push vertico-grid-separator line) 164 (push (propertize " " 'display 165 `(space :align-to (+ left ,(aref width (1- col))))) line)))) 166 (string-join line))))) 167 168 ;; Emacs 28: Do not show Vertico commands in M-X 169 (dolist (sym '(vertico-grid-left vertico-grid-right 170 vertico-grid-scroll-up vertico-grid-scroll-down)) 171 (put sym 'completion-predicate #'vertico--command-p)) 172 173 (provide 'vertico-grid) 174 ;;; vertico-grid.el ends here