Add corfu-history and corfu-info extensionsextensions

3 files changed, 199 insertions, 53 deletions

diff --git a/corfu.el b/corfu.el
index c9e6436..13a5617 100644
--- a/corfu.el
+++ b/corfu.el
@@ -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