diff --git a/README.org b/README.org index 1eaaa0d..145d079 100644 --- a/README.org +++ b/README.org @@ -48,8 +48,12 @@ Here is an example configuration: ;; Enable vertico (use-package vertico :init + ;; Enable the Vertico UI (vertico-mode) + ;; Optionally enable an enhanced `completing-read-multiple` UI + (vertico-crm-mode) + ;; Grow and shrink the Vertico minibuffer ;; (setq vertico-resize t) @@ -74,11 +78,6 @@ Here is an example configuration: ;; A few more useful configurations... (use-package emacs :init - ;; Add prompt indicator to `completing-read-multiple'. - (defun crm-indicator (args) - (cons (concat "[CRM] " (car args)) (cdr args))) - (advice-add #'completing-read-multiple :filter-args #'crm-indicator) - ;; Do not allow the cursor in the minibuffer prompt (setq minibuffer-prompt-properties '(read-only t cursor-intangible t face minibuffer-prompt)) @@ -193,12 +192,14 @@ to their liking - completion plays an integral part in how the users interacts with Emacs. There are at least two other interactive completion UIs, which follow a similar philosophy: -- [[https://github.com/raxod502/selectrum][Selectrum]]: Selectrum has a similar UI as Vertico. Vertico offers more commands - for grouping support. Selectrum supports additional Avy-style quick keys and a - horizontal display. On the other hand, Selectrum is significantly more complex - and not fully compatible with every Emacs completion command ([[https://github.com/raxod502/selectrum/issues/481][Issue #481]]), - since it uses its own filtering infrastructure, which deviates from the - standard Emacs completion facilities. +- [[https://github.com/raxod502/selectrum][Selectrum]]: Selectrum has a similar UI as Vertico. Vertico additionally has + the ability to cycle over candidates, offers a more enhanced + =completing-read-multiple= UI and additional commands for grouping support. On + the other hand, Selectrum supports Avy-style quick keys and a horizontal + display. Furthermore Selectrum is significantly more complex and not fully + compatible with every Emacs completion command ([[https://github.com/raxod502/selectrum/issues/481][Issue #481]]), since it uses its + own filtering infrastructure, which deviates from the standard Emacs + completion facilities. - [[https://github.com/oantolin/icomplete-vertical][Icomplete-vertical]]: This package enhances the Emacs builtin Icomplete with a vertical display. In contrast to Vertico, the candidates are rotated such that the current candidate always appears at the top. From my perspective, diff --git a/vertico-crm.el b/vertico-crm.el new file mode 100644 index 0000000..2ebb360 --- /dev/null +++ b/vertico-crm.el @@ -0,0 +1,185 @@ +;;; vertico-crm.el --- Enhanced `completing-read-multiple' support for Vertico -*- lexical-binding: t -*- + +;; Copyright (C) 2021 Free Software Foundation, Inc. + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This package provides `vertico-crm-mode', which sets up an enhanced +;; `completing-read-multiple' UI for Vertico. + +;;; Code: + +(require 'vertico) + +(defvar-local vertico-crm--table nil) +(defvar-local vertico-crm--selected nil) +(defvar-local vertico-crm--count-ov nil) + +(defcustom vertico-crm-count-format "(%s selected): " + "Format string used for the selection count." + :type '(choice (const nil) string) + :group 'vertico) + +(defface vertico-crm-selected + '((t :inherit secondary-selection)) + "Face used to highlight selected items." + :group 'vertico) + +(defvar vertico-crm-map + (let ((map (make-composed-keymap nil vertico-map))) + (define-key map "\t" #'vertico-crm-select) + (define-key map [backtab] #'vertico-crm-select-erase) + map) + "Minibuffer keymap derived from `vertico-map'.") + +(defun vertico-crm--update-count () + "Update the count overlay." + (when vertico-crm--count-ov + (overlay-put vertico-crm--count-ov 'display + (and (car vertico-crm--selected) + (format " (%s selected): " (length (car vertico-crm--selected))))))) + +(defun vertico-crm--format (cand) + "Format selected candidate CAND." + ;; Restore original candidate in order to preserve formatting + (setq cand (substring (or (car (all-completions cand vertico-crm--table nil)) cand))) + (add-face-text-property 0 (length cand) 'vertico-crm-selected 'append cand) + (put-text-property 0 (length cand) 'vertico-crm--selected t cand) + cand) + +(defun vertico-crm--collection (str pred action) + "Programmable completion table for `vertico-crm--completing-read-multiple'. +See `completing-read' for the arguments STR, PRED and ACTION." + (pcase action + ('metadata + (let* ((md (and (functionp vertico-crm--table) + (cdr (funcall vertico-crm--table str pred action)))) + (group-fun (alist-get 'group-function md))) + `(metadata + (group-function + . ,(lambda (cand transform) + (if (get-text-property 0 'vertico-crm--selected cand) + (if transform cand "Selected") + (or (and group-fun (funcall group-fun cand transform)) + (if transform cand "Select multiple"))))) + ,@md))) + ('t + (nconc + (all-completions str (car vertico-crm--selected) nil) + (cl-delete-if (lambda (x) (member x (car vertico-crm--selected))) + (all-completions str vertico-crm--table pred)))) + (_ (complete-with-action action vertico-crm--table str pred)))) + +(defun vertico-crm--completing-read-multiple (prompt table &optional + pred require-match initial-input + hist def inherit-input-method) + "Enhanced replacement for `completing-read-multiple'. +See `completing-read-multiple' for the arguments." + ;; TODO maybe it is better to ignore initial-input or to pass it to completing-read? + ;; It depends on if initial-input is used to preselect candidates or if initial-input + ;; is used as a filter string. It is hard or impossible to determine this. + (let ((separator (or (bound-and-true-p crm-separator) "[ \t]*,[ \t]*")) + (selected '(nil . nil))) + (minibuffer-with-setup-hook + (lambda () + (when-let (pos (and vertico-crm-count-format + (string-match-p "\\(?: (default[^)]+)\\)?: \\'" + (minibuffer-prompt)))) + (setq vertico-crm--count-ov (make-overlay pos (minibuffer-prompt-end)))) + (setq vertico-crm--table table + vertico-crm--selected selected) + (setcar vertico-crm--selected + (and initial-input + (mapcar #'vertico-crm--format + (split-string initial-input separator 'omit-nulls)))) + (vertico-crm--update-count) + (use-local-map vertico-crm-map)) + (let* ((hist-sym (pcase hist + ('nil 'minibuffer-history) + ('t nil) + (`(,sym . ,_) sym) ;; ignore history position + (_ hist))) + (hist-val (symbol-value hist-sym)) + (result + (completing-read prompt + #'vertico-crm--collection + pred + require-match + nil ;; initial-input + hist + "" ;; default + inherit-input-method))) + (setq selected (mapcar #'substring-no-properties (car selected))) + (unless (or (equal result "") (member result selected)) + (setq selected (nconc selected (list result)))) + (set hist-sym (append selected hist-val)) + (when (consp def) + (setq def (car def))) + (if (and def (not (equal "" def)) (not selected)) + (split-string def separator 'omit-nulls) + selected))))) + +(defun vertico-crm-select () + "Select/deselect current candidate." + (interactive) + (when (>= vertico--index 0) + (let ((cand (vertico--candidate))) + (when (> vertico--total 1) + (vertico--goto (if (= (1+ vertico--index) vertico--total) + -1 + (1+ vertico--index)))) + (setq vertico--input t) + (if (member cand (car vertico-crm--selected)) + ;; Multi selections are not possible. + ;; This is probably no problem, since this is rarely desired. + (setcar vertico-crm--selected (delete cand (car vertico-crm--selected))) + (setq vertico--lock-groups t + vertico--all-groups '("Selected")) + (setcar vertico-crm--selected + (nconc (car vertico-crm--selected) + (list (vertico-crm--format cand))))) + (vertico-crm--update-count)))) + +(defun vertico-crm-select-erase () + "Select/deselect current candidate and erase input." + (interactive) + (vertico-crm-select) + (delete-minibuffer-contents) + (setq vertico--lock-candidate nil)) + +;;;###autoload +(define-minor-mode vertico-crm-mode + "Enhanced `completing-read-multiple' support for Vertico." + :global t + (if vertico-crm-mode + (add-hook 'vertico-mode-hook #'vertico-crm--setup) + (remove-hook 'vertico-mode-hook #'vertico-crm--setup)) + (vertico-crm--setup)) + +(defun vertico-crm--setup () + "Setup enhanced `completing-read-multiple'." + (if (and vertico-crm-mode vertico-mode) + (progn + (advice-remove #'completing-read-multiple #'vertico--advice) + (advice-add #'completing-read-multiple :override #'vertico-crm--completing-read-multiple)) + (advice-remove #'completing-read-multiple #'vertico-crm--completing-read-multiple) + (when vertico-mode + (advice-add #'completing-read-multiple :around #'vertico--advice)))) + +(provide 'vertico-crm) +;;; vertico-crm.el ends here