config

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

vertico-flat.el (5999B)


      1 ;;; vertico-flat.el --- Flat, horizontal 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 horizontal display.
     30 ;;
     31 ;; The mode can be enabled globally or via `vertico-multiform-mode'
     32 ;; per command or completion category.  Alternatively the flat display
     33 ;; can be toggled temporarily with M-F if `vertico-multiform-mode' is
     34 ;; enabled.
     35 ;;
     36 ;; The flat display can be made to look like `ido-mode' by setting
     37 ;; `vertico-cycle' to t. See also the `vertico-flat-format'
     38 ;; configuration variable for further tweaks.
     39 
     40 ;;; Code:
     41 
     42 (require 'vertico)
     43 (eval-when-compile (require 'cl-lib))
     44 
     45 (defcustom vertico-flat-max-lines 1
     46   "Maximal number of lines to use."
     47   :type 'natnum
     48   :group 'vertico)
     49 
     50 (defcustom vertico-flat-format
     51   '(:multiple   #("{%s}" 0 1 (face minibuffer-prompt)
     52                   3 4 (face minibuffer-prompt))
     53     :single     #("[%s]" 0 1 (face minibuffer-prompt)
     54                   1 3 (face success) 3 4 (face minibuffer-prompt))
     55     :prompt     #("(%s)" 0 1 (face minibuffer-prompt)
     56                   3 4 (face minibuffer-prompt))
     57     :separator  #(" | " 0 3 (face minibuffer-prompt))
     58     :ellipsis   #("…" 0 1 (face minibuffer-prompt))
     59     :no-match   "[No match]")
     60   "Formatting strings."
     61   :type 'plist
     62   :group 'vertico)
     63 
     64 (defcustom vertico-flat-annotate nil
     65   "Annotate candidates."
     66   :type 'boolean
     67   :group 'vertico)
     68 
     69 (defvar-keymap vertico-flat-map
     70   :doc "Additional keymap activated in flat mode."
     71   "<remap> <left-char>" #'vertico-previous
     72   "<remap> <right-char>" #'vertico-next)
     73 
     74 ;;;###autoload
     75 (define-minor-mode vertico-flat-mode
     76   "Flat, horizontal display for Vertico."
     77   :global t :group 'vertico
     78   ;; Shrink current minibuffer window
     79   (when-let ((win (active-minibuffer-window)))
     80     (unless (frame-root-window-p win)
     81       (window-resize win (- (window-pixel-height win)) nil nil 'pixelwise)))
     82   (cl-callf2 rassq-delete-all vertico-flat-map minor-mode-map-alist)
     83   (when vertico-flat-mode
     84     (push `(vertico--input . ,vertico-flat-map) minor-mode-map-alist)))
     85 
     86 (cl-defmethod vertico--display-candidates (candidates &context (vertico-flat-mode (eql t)))
     87   (setq-local truncate-lines nil
     88               resize-mini-windows t)
     89   (move-overlay vertico--candidates-ov (point-max) (point-max))
     90   (overlay-put
     91    vertico--candidates-ov 'after-string
     92    (concat #(" " 0 1 (cursor t))
     93            (cond
     94             ((and (not candidates) (plist-get vertico-flat-format :no-match)))
     95             ((and (= vertico--total 1) (= vertico--index 0)
     96                   (when-let ((fmt (plist-get vertico-flat-format :single)))
     97                     (format fmt (substring-no-properties (car candidates))))))
     98             (t (format (plist-get vertico-flat-format (if (< vertico--index 0) :prompt :multiple))
     99                        (string-join candidates (plist-get vertico-flat-format :separator))))))))
    100 
    101 (cl-defmethod vertico--arrange-candidates (&context (vertico-flat-mode (eql t)))
    102   (let* ((index (max 0 vertico--index)) (count vertico-count)
    103          (candidates (nthcdr vertico--index vertico--candidates))
    104          (width (- (* vertico-flat-max-lines (- (vertico--window-width) 4))
    105                    (length (plist-get vertico-flat-format :left))
    106                    (length (plist-get vertico-flat-format :separator))
    107                    (length (plist-get vertico-flat-format :right))
    108                    (length (plist-get vertico-flat-format :ellipsis))
    109                    (car (posn-col-row (posn-at-point (1- (point-max)))))))
    110          (result) (wrapped))
    111     (while (and candidates (not (eq wrapped (car candidates)))
    112                 (> width 0) (> count 0))
    113       (let ((cand (pop candidates)) (prefix "") (suffix ""))
    114         (setq cand (funcall vertico--hilit (substring cand)))
    115         (pcase (and vertico-flat-annotate (vertico--affixate (list cand)))
    116           (`((,c ,p ,s)) (setq cand c prefix p suffix s)))
    117         (when (string-search "\n" cand)
    118           (setq cand (vertico--truncate-multiline cand width)))
    119         (setq cand (string-trim
    120                     (replace-regexp-in-string
    121                      "[ \t]+"
    122                      (lambda (x) (apply #'propertize " " (text-properties-at 0 x)))
    123                      (vertico--format-candidate cand prefix suffix index vertico--index)))
    124               index (1+ index)
    125               count (1- count)
    126               width (- width (string-width cand) (length (plist-get vertico-flat-format :separator))))
    127         (when (or (not result) (> width 0))
    128           (push cand result))
    129         (when (and vertico-cycle (not candidates))
    130           (setq candidates vertico--candidates index 0
    131                 wrapped (nth vertico--index vertico--candidates)))))
    132     (when (if wrapped
    133               (> vertico--total (- vertico-count count))
    134             (and (/= vertico--total 0) (/= index vertico--total)))
    135       (push (plist-get vertico-flat-format :ellipsis) result))
    136     (nreverse result)))
    137 
    138 (provide 'vertico-flat)
    139 ;;; vertico-flat.el ends here