;;; 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