diff options
| -rw-r--r-- | corfu.el | 56 | ||||
| -rw-r--r-- | extensions/corfu-history.el | 101 | ||||
| -rw-r--r-- | extensions/corfu-info.el | 95 |
3 files changed, 199 insertions, 53 deletions
@@ -236,8 +236,8 @@ The completion backend can override this with (define-key map "\C-g" #'corfu-quit) (define-key map "\r" #'corfu-insert) (define-key map "\t" #'corfu-complete) - (define-key map "\eg" #'corfu-show-location) - (define-key map "\eh" #'corfu-show-documentation) + (define-key map "\eg" 'corfu-info-location) + (define-key map "\eh" 'corfu-info-documentation) (define-key map (concat "\e" " ") #'corfu-insert-separator) ;; Avoid ugly warning map) "Corfu keymap used when popup is shown.") @@ -940,56 +940,6 @@ there hasn't been any input, then quit." (interactive) (corfu--goto (1- corfu--total))) -(defun corfu--restore-on-next-command () - "Restore window configuration before next command." - (let ((config (current-window-configuration)) - (other other-window-scroll-buffer) - (restore (make-symbol "corfu--restore"))) - (fset restore - (lambda () - (setq other-window-scroll-buffer other) - (unless (memq this-command '(scroll-other-window scroll-other-window-down)) - (when (memq this-command '(corfu-quit corfu-reset)) - (setq this-command #'ignore)) - (remove-hook 'pre-command-hook restore) - (set-window-configuration config)))) - (add-hook 'pre-command-hook restore))) - -;; Company support, taken from `company.el', see `company-show-doc-buffer'. -(defun corfu-show-documentation () - "Show documentation of current candidate." - (interactive) - (when (< corfu--index 0) - (user-error "No candidate selected")) - (if-let* ((fun (plist-get corfu--extra :company-doc-buffer)) - (res (funcall fun (nth corfu--index corfu--candidates)))) - (let ((buf (or (car-safe res) res))) - (corfu--restore-on-next-command) - (setq other-window-scroll-buffer (get-buffer buf)) - (set-window-start (display-buffer buf t) (or (cdr-safe res) (point-min)))) - (user-error "No documentation available"))) - -;; Company support, taken from `company.el', see `company-show-location'. -(defun corfu-show-location () - "Show location of current candidate." - (interactive) - (when (< corfu--index 0) - (user-error "No candidate selected")) - (if-let* ((fun (plist-get corfu--extra :company-location)) - (loc (funcall fun (nth corfu--index corfu--candidates)))) - (let ((buf (or (and (bufferp (car loc)) (car loc)) (find-file-noselect (car loc) t)))) - (corfu--restore-on-next-command) - (setq other-window-scroll-buffer buf) - (with-selected-window (display-buffer buf t) - (save-restriction - (widen) - (if (bufferp (car loc)) - (goto-char (cdr loc)) - (goto-char (point-min)) - (forward-line (1- (cdr loc)))) - (set-window-start nil (point))))) - (user-error "No candidate location available"))) - (defun corfu-complete () "Try to complete current input." (interactive) @@ -1266,7 +1216,7 @@ The ORIG function takes the FUN and WHICH arguments." ;; Emacs 28: Do not show Corfu commands with M-X (dolist (sym '(corfu-next corfu-previous corfu-first corfu-last corfu-quit corfu-reset corfu-complete corfu-insert corfu-scroll-up corfu-scroll-down - corfu-show-location corfu-show-documentation corfu-insert-separator)) + corfu-insert-separator)) (put sym 'completion-predicate #'ignore)) (provide 'corfu) diff --git a/extensions/corfu-history.el b/extensions/corfu-history.el new file mode 100644 index 0000000..80424bc --- /dev/null +++ b/extensions/corfu-history.el @@ -0,0 +1,101 @@ +;;; corfu-history.el --- Sorting by history for Corfu -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2021 +;; Version: 0.1 +;; Package-Requires: ((emacs "27.1") (corfu "0.20")) +;; Homepage: https://github.com/minad/corfu + +;; This file is 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/>. + +;;; Commentary: + +;; Sort candidates by their history position. Maintain a list of +;; recently selected candidates. + +;;; Code: + +(require 'corfu) + +(defcustom corfu-history-length nil + "Corfu history length." + :type '(choice (const nil) integer) + :group 'corfu) + +(defvar corfu-history--hash nil + "Hash table of Corfu candidates.") + +(defvar corfu-history nil + "History of Corfu candidates.") + +(defun corfu-history--sort-predicate (x y) + "Sorting predicate which compares X and Y." + (or (< (cdr x) (cdr y)) + (and (= (cdr x) (cdr y)) + (string< (car x) (car y))))) + +(defun corfu-history--sort (candidates) + "Sort CANDIDATES by history." + (unless corfu-history--hash + (let ((index 0)) + (setq corfu-history--hash (make-hash-table :test #'equal :size (length corfu-history))) + (dolist (elt corfu-history) + (unless (gethash elt corfu-history--hash) + (puthash elt index corfu-history--hash)) + (setq index (1+ index))))) + ;; Decorate each candidate with (index<<13) + length. This way we sort first by index and then by + ;; length. We assume that the candidates are shorter than 2**13 characters and that the history is + ;; shorter than 2**16 entries. + (let ((cand candidates)) + (while cand + (setcar cand (cons (car cand) + (+ (lsh (gethash (car cand) corfu-history--hash #xFFFF) 13) + (length (car cand))))) + (pop cand))) + (setq candidates (sort candidates #'corfu-history--sort-predicate)) + ;; Drop decoration from the candidates + (let ((cand candidates)) + (while cand + (setcar cand (caar cand)) + (pop cand))) + candidates) + +(defun corfu-history--insert (&rest _) + "Advice for `corfu--insert'." + (when (>= corfu--index 0) + (add-to-history 'corfu-history + (nth corfu--index corfu--candidates) + corfu-history-length) + (setq corfu-history--hash nil))) + +;;;###autoload +(define-minor-mode corfu-history-mode + "Update Corfu history and sort completions by history." + :global t + :group 'corfu + (cond + (corfu-history-mode + (setq corfu-sort-function #'corfu-history--sort) + (advice-add #'corfu--insert :before #'corfu-history--insert)) + (t + (setq corfu-sort-function #'corfu-sort-length-alpha) + (advice-remove #'corfu--insert #'corfu-history--insert)))) + +(provide 'corfu-history) +;;; corfu-history.el ends here diff --git a/extensions/corfu-info.el b/extensions/corfu-info.el new file mode 100644 index 0000000..152aeea --- /dev/null +++ b/extensions/corfu-info.el @@ -0,0 +1,95 @@ +;;; corfu-info.el --- Show candidate information in separate buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2022 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2021 +;; Version: 0.1 +;; Package-Requires: ((emacs "27.1") (corfu "0.20")) +;; Homepage: https://github.com/minad/corfu + +;; This file is 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/>. + +;;; Commentary: + +;; This Corfu extension provides commands to show additional information +;; to the candidates in a separate buffer. + +;;; Code: + +(require 'corfu) +(eval-when-compile + (require 'subr-x)) + +(defun corfu-info--restore-on-next-command () + "Restore window configuration before next command." + (let ((config (current-window-configuration)) + (other other-window-scroll-buffer) + (restore (make-symbol "corfu--restore"))) + (fset restore + (lambda () + (setq other-window-scroll-buffer other) + (unless (memq this-command '(scroll-other-window scroll-other-window-down)) + (when (memq this-command '(corfu-quit corfu-reset)) + (setq this-command #'ignore)) + (remove-hook 'pre-command-hook restore) + (set-window-configuration config)))) + (add-hook 'pre-command-hook restore))) + +;;;###autoload +(defun corfu-info-documentation () + "Show documentation of current candidate." + (interactive) + ;; Company support, taken from `company.el', see `company-show-doc-buffer'. + (when (< corfu--index 0) + (user-error "No candidate selected")) + (if-let* ((fun (plist-get corfu--extra :company-doc-buffer)) + (res (funcall fun (nth corfu--index corfu--candidates)))) + (let ((buf (or (car-safe res) res))) + (corfu-info--restore-on-next-command) + (setq other-window-scroll-buffer (get-buffer buf)) + (set-window-start (display-buffer buf t) (or (cdr-safe res) (point-min)))) + (user-error "No documentation available"))) + +;;;###autoload +(defun corfu-info-location () + "Show location of current candidate." + (interactive) + ;; Company support, taken from `company.el', see `company-show-location'. + (when (< corfu--index 0) + (user-error "No candidate selected")) + (if-let* ((fun (plist-get corfu--extra :company-location)) + (loc (funcall fun (nth corfu--index corfu--candidates)))) + (let ((buf (or (and (bufferp (car loc)) (car loc)) (find-file-noselect (car loc) t)))) + (corfu-info--restore-on-next-command) + (setq other-window-scroll-buffer buf) + (with-selected-window (display-buffer buf t) + (save-restriction + (widen) + (if (bufferp (car loc)) + (goto-char (cdr loc)) + (goto-char (point-min)) + (forward-line (1- (cdr loc)))) + (set-window-start nil (point))))) + (user-error "No candidate location available"))) + +;; Emacs 28: Do not show Corfu commands with M-X +(put #'corfu-info-location 'completion-predicate #'ignore) +(put #'corfu-info-documentation 'completion-predicate #'ignore) + +(provide 'corfu-info) +;;; corfu-info.el ends here |