120 lines
4.0 KiB
EmacsLisp
120 lines
4.0 KiB
EmacsLisp
;;; corfu-mouse.el --- Mouse support for Corfu -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2021, 2022 Free Software Foundation, Inc.
|
|
|
|
;; Author: Akib Azmain Turja <akib@disroot.org>
|
|
;; Maintainer: Akib Azmain Turja <akib@disroot.org>
|
|
;; Created: 2022
|
|
;; Version: 0.1
|
|
;; Package-Requires: ((emacs "24.4") (corfu "0.25"))
|
|
;; Homepage: https://codeberg.org/akib/emacs-corfu-mouse
|
|
|
|
;; This file is not 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 <http://www.gnu.org/licenses/>.
|
|
|
|
;; Disclaimer: This file is based on vertico-mouse.el of Vertico package,
|
|
;; which is a part of GNU Emacs.
|
|
|
|
;;; Commentary:
|
|
|
|
;; This package is a Corfu extension, which adds mouse support.
|
|
|
|
;; To enable, M-x corfu-mouse-mode.
|
|
|
|
;;; Code:
|
|
|
|
(require 'corfu)
|
|
|
|
(defface corfu-mouse
|
|
'((t :inherit highlight))
|
|
"Face used for mouse highlighting."
|
|
:group 'corfu-faces)
|
|
|
|
(defvar corfu-mouse--completion-buffer nil
|
|
"The buffer for which the popup is being shown.")
|
|
|
|
(defun corfu-mouse--candidate-map (index)
|
|
"Return keymap for candidate with INDEX."
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map [mouse-1]
|
|
(lambda ()
|
|
(interactive)
|
|
(let ((corfu--index index))
|
|
(corfu-insert))))
|
|
(define-key map [mouse-3]
|
|
(lambda ()
|
|
(interactive)
|
|
(let ((corfu--index index))
|
|
(corfu-complete))))
|
|
map))
|
|
|
|
(defun corfu-mouse--format-candidates (fcands)
|
|
"Format candidatesq.
|
|
|
|
FCANDS is the return value of `corfu--format-candidates'."
|
|
(let ((index corfu--scroll))
|
|
(dolist (cand (caddr fcands))
|
|
(add-text-properties 0 (length cand)
|
|
`(mouse-face
|
|
corfu-mouse
|
|
keymap
|
|
,(corfu-mouse--candidate-map index))
|
|
cand)
|
|
(setq index (1+ index)))
|
|
fcands))
|
|
|
|
(defun corfu-mouse--scroll-up (n)
|
|
"Scroll up by N lines."
|
|
(with-current-buffer corfu-mouse--completion-buffer
|
|
(corfu-next n)))
|
|
|
|
(defun corfu-mouse--scroll-down (n)
|
|
"Scroll down by N lines."
|
|
(corfu-mouse--scroll-up (- n)))
|
|
|
|
(defun corfu-mouse--setup-scrolling (buffer)
|
|
"Setup mouse scrolling on BUFFER."
|
|
(let ((current-buffer (current-buffer)))
|
|
(with-current-buffer buffer
|
|
(setq-local mwheel-scroll-up-function #'corfu-mouse--scroll-up)
|
|
(setq-local mwheel-scroll-down-function #'corfu-mouse--scroll-down)
|
|
(setq-local corfu-mouse--completion-buffer current-buffer)))
|
|
buffer)
|
|
|
|
;;;###autoload
|
|
(define-minor-mode corfu-mouse-mode
|
|
"Mouse support for Corfu."
|
|
:global t :group 'corfu
|
|
(let ((scroll-events '(mouse-4 mouse-5 down-mouse-4 down-mouse-5
|
|
double-mouse-4 double-mouse-5
|
|
triple-mouse-4 triple-mouse-5)))
|
|
(cond
|
|
(corfu-mouse-mode
|
|
(advice-add #'corfu--format-candidates :filter-return
|
|
#'corfu-mouse--format-candidates)
|
|
(advice-add #'corfu--make-buffer :filter-return
|
|
#'corfu-mouse--setup-scrolling)
|
|
(dolist (event scroll-events)
|
|
(define-key corfu--mouse-ignore-map (vector event) nil)))
|
|
(t
|
|
(advice-remove #'corfu--format-candidates
|
|
#'corfu-mouse--format-candidates)
|
|
(advice-remove #'corfu--make-buffer #'corfu-mouse--setup-scrolling)
|
|
(dolist (event scroll-events)
|
|
(define-key corfu--mouse-ignore-map (vector event) #'ignore))))))
|
|
|
|
(provide 'corfu-mouse)
|
|
;;; corfu-mouse.el ends here
|