dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

consult-selectrum.el (4515B)

      1 ;;; consult-selectrum.el --- Selectrum integration for Consult -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2021, 2022  Free Software Foundation, Inc.
      4 
      5 ;; This file is part of GNU Emacs.
      6 
      7 ;; This program is free software: you can redistribute it and/or modify
      8 ;; it under the terms of the GNU General Public License as published by
      9 ;; the Free Software Foundation, either version 3 of the License, or
     10 ;; (at your option) any later version.
     11 
     12 ;; This program is distributed in the hope that it will be useful,
     13 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
     14 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
     15 ;; GNU General Public License for more details.
     16 
     17 ;; You should have received a copy of the GNU General Public License
     18 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
     19 
     20 ;;; Commentary:
     21 
     22 ;; Integration code for the Selectrum completion system. This package
     23 ;; is automatically loaded by Consult.
     24 
     25 ;;; Code:
     26 
     27 (require 'consult)
     28 
     29 ;; NOTE: It is not guaranteed that Selectrum is available during compilation!
     30 (defvar selectrum-default-value-format)
     31 (defvar selectrum-highlight-candidates-function)
     32 (defvar selectrum-is-active)
     33 (defvar selectrum-refine-candidates-function)
     34 (defvar selectrum--history-hash)
     35 (declare-function selectrum-exhibit "ext:selectrum")
     36 (declare-function selectrum-get-current-candidate "ext:selectrum")
     37 
     38 (defun consult-selectrum--filter-adv (orig pattern cands category highlight)
     39   "Advice for ORIG `consult--completion-filter' function.
     40 See `consult--completion-filter' for arguments PATTERN, CANDS, CATEGORY
     41 and HIGHLIGHT."
     42   ;; Do not use selectrum-is-active here, since we want to always use
     43   ;; the Selectrum filtering when Selectrum is installed, even when
     44   ;; Selectrum is currently not active.
     45   ;; However if `selectrum-refine-candidates-function' is the default
     46   ;; function, which uses the completion styles, the Selectrum filtering
     47   ;; is not used and the original function is called.
     48   (if (and (eq completing-read-function 'selectrum-completing-read)
     49            (not (eq selectrum-refine-candidates-function
     50                     'selectrum-refine-candidates-using-completions-styles)))
     51       (if highlight
     52           (funcall selectrum-highlight-candidates-function pattern
     53                    (funcall selectrum-refine-candidates-function pattern cands))
     54         (funcall selectrum-refine-candidates-function pattern cands))
     55     (funcall orig pattern cands category highlight)))
     56 
     57 (defun consult-selectrum--candidate ()
     58   "Return current selectrum candidate."
     59   (and selectrum-is-active (selectrum-get-current-candidate)))
     60 
     61 (defun consult-selectrum--refresh (&optional reset)
     62   "Refresh completion UI, keep current candidate unless RESET is non-nil."
     63   (when selectrum-is-active
     64     (when consult--narrow
     65       (setq-local selectrum-default-value-format nil))
     66     (when reset
     67       (setq-local selectrum--history-hash nil))
     68     (selectrum-exhibit (not reset))))
     69 
     70 (defun consult-selectrum--split-wrap (orig split)
     71   "Wrap candidates highlight/refinement ORIG function.
     72 The input is split by the SPLIT function."
     73   (lambda (str cands)
     74     (funcall orig (cadr (funcall split str 0)) cands)))
     75 
     76 (defun consult-selectrum--split-setup-adv (orig split)
     77   "Advice for `consult--split-setup' to be used by Selectrum.
     78 
     79 ORIG is the original function.
     80 SPLIT is the splitter function."
     81   (if (not selectrum-is-active)
     82       (funcall orig split)
     83     (setq-local
     84      selectrum-refine-candidates-function
     85      (consult-selectrum--split-wrap selectrum-refine-candidates-function split)
     86      selectrum-highlight-candidates-function
     87      (consult-selectrum--split-wrap selectrum-highlight-candidates-function split))))
     88 
     89 (defun consult-selectrum--crm-adv (&rest args)
     90   "Setup crm for Selectrum given ARGS."
     91   (consult--minibuffer-with-setup-hook
     92       (lambda ()
     93         (when selectrum-is-active
     94           (setq-local selectrum-default-value-format nil)))
     95     (apply args)))
     96 
     97 (add-hook 'consult--completion-candidate-hook #'consult-selectrum--candidate)
     98 (add-hook 'consult--completion-refresh-hook #'consult-selectrum--refresh)
     99 (advice-add #'consult-completing-read-multiple :around #'consult-selectrum--crm-adv)
    100 (advice-add #'consult--completion-filter :around #'consult-selectrum--filter-adv)
    101 (advice-add #'consult--split-setup :around #'consult-selectrum--split-setup-adv)
    102 (define-key consult-async-map [remap selectrum-insert-current-candidate] 'selectrum-next-page)
    103 
    104 (provide 'consult-selectrum)
    105 ;;; consult-selectrum.el ends here