config

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

vertico-flat.el (5972B)


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