config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

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