vertico-mouse.el (3472B)
1 ;;; vertico-mouse.el --- Mouse support 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, which adds mouse support. 30 31 ;;; Code: 32 33 (require 'vertico) 34 35 (defface vertico-mouse 36 '((t :inherit highlight)) 37 "Face used for mouse highlighting." 38 :group 'vertico-faces) 39 40 (defun vertico-mouse--index (event) 41 "Return candidate index at EVENT." 42 (when-let ((object (posn-object (event-end event))) 43 ((consp object))) 44 (get-text-property (cdr object) 'vertico-mouse--index (car object)))) 45 46 (defun vertico-mouse--click (key) 47 "Create command handling mouse click, behave like KEY press." 48 (lambda (event) 49 (interactive "e") 50 ;; Mouse clicks can even happen if another window is selected. 51 (with-selected-window (active-minibuffer-window) 52 (when-let ((vertico--index (vertico-mouse--index event)) 53 (cmd (keymap-local-lookup key))) 54 (funcall cmd))))) 55 56 (defvar-keymap vertico-mouse-map 57 :doc "Additional keymap activated in mouse mode." 58 "<mouse-1>" (vertico-mouse--click "RET") 59 "<mouse-3>" (vertico-mouse--click "TAB")) 60 (fset 'vertico-mouse-map vertico-mouse-map) 61 62 (defun vertico-mouse--scroll-up (n) 63 "Scroll up by N lines." 64 (vertico--goto (max 0 (+ vertico--index n)))) 65 66 (defun vertico-mouse--scroll-down (n) 67 "Scroll down by N lines." 68 (vertico-mouse--scroll-up (- n))) 69 70 ;;;###autoload 71 (define-minor-mode vertico-mouse-mode 72 "Mouse support for Vertico." 73 :global t :group 'vertico) 74 75 (cl-defmethod vertico--format-candidate 76 :around (cand prefix suffix index start &context (vertico-mouse-mode (eql t))) 77 (setq cand (cl-call-next-method cand prefix 78 (concat suffix #(" " 0 1 (display (space :align-to right)))) 79 index start)) 80 (add-text-properties 0 (1- (length cand)) 81 `(vertico-mouse--index ,index 82 mouse-face vertico-mouse keymap vertico-mouse-map) 83 cand) 84 cand) 85 86 (cl-defmethod vertico--setup :after (&context (vertico-mouse-mode (eql t))) 87 (when (boundp 'mwheel-coalesce-scroll-events) 88 (setq-local mwheel-coalesce-scroll-events t)) 89 (when (boundp 'pixel-scroll-precision-mode) 90 (setq-local pixel-scroll-precision-mode nil)) 91 (setq-local mwheel-scroll-up-function #'vertico-mouse--scroll-up 92 mwheel-scroll-down-function #'vertico-mouse--scroll-down)) 93 94 (provide 'vertico-mouse) 95 ;;; vertico-mouse.el ends here