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