dotemacs

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

corfu-info.el (3765B)


      1 ;;; corfu-info.el --- Show candidate information in separate buffer -*- lexical-binding: t -*-
      2 
      3 ;; Copyright (C) 2022  Free Software Foundation, Inc.
      4 
      5 ;; Author: Daniel Mendler <mail@daniel-mendler.de>
      6 ;; Maintainer: Daniel Mendler <mail@daniel-mendler.de>
      7 ;; Created: 2022
      8 ;; Version: 0.1
      9 ;; Package-Requires: ((emacs "27.1") (corfu "0.23"))
     10 ;; Homepage: https://github.com/minad/corfu
     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 <http://www.gnu.org/licenses/>.
     26 
     27 ;;; Commentary:
     28 
     29 ;; This Corfu extension provides commands to show additional information
     30 ;; to the candidates in a separate buffer.
     31 
     32 ;;; Code:
     33 
     34 (require 'corfu)
     35 (eval-when-compile
     36   (require 'subr-x))
     37 
     38 (defun corfu-info--restore-on-next-command ()
     39   "Restore window configuration before next command."
     40   (let ((config (current-window-configuration))
     41         (other other-window-scroll-buffer)
     42         (restore (make-symbol "corfu--restore")))
     43     (fset restore
     44           (lambda ()
     45             (setq other-window-scroll-buffer other)
     46             (unless (memq this-command '(scroll-other-window scroll-other-window-down))
     47               (when (memq this-command '(corfu-quit corfu-reset))
     48                 (setq this-command #'ignore))
     49               (remove-hook 'pre-command-hook restore)
     50               (set-window-configuration config))))
     51     (add-hook 'pre-command-hook restore)))
     52 
     53 ;;;###autoload
     54 (defun corfu-info-documentation ()
     55   "Show documentation of current candidate."
     56   (interactive)
     57   ;; Company support, taken from `company.el', see `company-show-doc-buffer'.
     58   (when (< corfu--index 0)
     59     (user-error "No candidate selected"))
     60   (if-let* ((fun (plist-get corfu--extra :company-doc-buffer))
     61             (res (funcall fun (nth corfu--index corfu--candidates))))
     62       (let ((buf (or (car-safe res) res)))
     63         (corfu-info--restore-on-next-command)
     64         (setq other-window-scroll-buffer (get-buffer buf))
     65         (set-window-start (display-buffer buf t) (or (cdr-safe res) (point-min))))
     66     (user-error "No documentation available")))
     67 
     68 ;;;###autoload
     69 (defun corfu-info-location ()
     70   "Show location of current candidate."
     71   (interactive)
     72   ;; Company support, taken from `company.el', see `company-show-location'.
     73   (when (< corfu--index 0)
     74     (user-error "No candidate selected"))
     75   (if-let* ((fun (plist-get corfu--extra :company-location))
     76             (loc (funcall fun (nth corfu--index corfu--candidates))))
     77       (let ((buf (or (and (bufferp (car loc)) (car loc)) (find-file-noselect (car loc) t))))
     78         (corfu-info--restore-on-next-command)
     79         (setq other-window-scroll-buffer buf)
     80         (with-selected-window (display-buffer buf t)
     81           (save-restriction
     82             (widen)
     83             (if (bufferp (car loc))
     84                 (goto-char (cdr loc))
     85               (goto-char (point-min))
     86               (forward-line (1- (cdr loc))))
     87             (set-window-start nil (point)))))
     88     (user-error "No candidate location available")))
     89 
     90 ;; Emacs 28: Do not show Corfu commands with M-X
     91 (put #'corfu-info-location 'completion-predicate #'ignore)
     92 (put #'corfu-info-documentation 'completion-predicate #'ignore)
     93 
     94 (provide 'corfu-info)
     95 ;;; corfu-info.el ends here