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