Add 'completion-preview' Elisp library

diff --git a/.emacs.d/init.el b/.emacs.d/init.el
index f386e4854bef8b0f25a52fed26fed6fc03eb7dd3..2492164aaac6c456d5bc013ba188fddcb9e81845 100644 (file)
--- a/.emacs.d/init.el
+++ b/.emacs.d/init.el
@@ -22,6 +22,7 @@
 
 (pcase system-type
   ('darwin
+   (add-to-list 'exec-path "/usr/local/bin")
    (setq initial-frame-alist '((fullscreen . fullboth))
          frame-title-format "Emacs")
    (set-fontset-font t '(?􀀀 . ?􏿽) "SF Pro Display"))
@@ -470,6 +471,7 @@
 (add-to-list 'load-path (expand-file-name "lisp/" user-emacs-directory))
 (autoload 'some-button "some-button" nil t)
 (autoload 'completions-auto-update-mode "completions-auto-update" nil t)
+(autoload 'completion-preview-mode "completion-preview" nil t)
 
 (unless (eq system-type 'android)
   (add-to-list 'load-path "~/checkouts/esy-publish/")
@@ -844,6 +846,7 @@ Interactively, POINT is point and KILL is the prefix argument."
                 display-line-numbers-mode
                 flymake-mode
                 ;; flyspell-prog-mode
+                completion-preview-mode
                 ))
   (add-hook 'prog-mode-hook mode))
 
@@ -1124,18 +1127,6 @@ as the initial input for completion, and return that directory."
 
 ;;; Set up some global `completion-at-point-functions'
 
-(defun esy/dabbrev-capf ()
-  "Workaround for issue with `dabbrev-capf'."
-  (require 'dabbrev)
-  (dabbrev--reset-global-variables)
-  (setq dabbrev-case-fold-search nil)
-  (pcase (let ((inhibit-message t))
-           (ignore-errors (dabbrev-capf)))
-    (`(,beg ,end ,table . ,_)
-     (list beg end table :exclusive 'no))))
-
-(add-to-list 'completion-at-point-functions #'esy/dabbrev-capf)
-
 (defun esy/file-capf ()
   "File completion at point function."
   (let ((bs (bounds-of-thing-at-point 'filename)))

diff --git a/.emacs.d/lisp/completion-preview.el b/.emacs.d/lisp/completion-preview.el
new file mode 100644 (file)
index 0000000..c38b9c4
--- /dev/null
+++ b/.emacs.d/lisp/completion-preview.el
@@ -0,0 +1,153 @@
+;;; completion-preview.el --- Preview completion with inline overlay  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: convenience
+
+;; 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 <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This library provides the Completion Preview mode.  This minor mode
+;; displays the top completion candidate for the symbol at point in an
+;; overlay after point.
+
+;;; Code:
+
+(defgroup completion-preview nil
+  "In-buffer completion preview."
+  :group 'completion)
+
+(defcustom completion-preview-commands '(self-insert-command)
+  "List of commands that should trigger completion preview."
+  :type '(repeat (function :tag "Command" :value self-insert-command)))
+
+(defcustom completion-preview-minimum-symbol-length 3
+  "Minimum length of the symbol at point for showing completion preview."
+  :type 'natnum)
+
+(defcustom completion-preview-hook
+  '(completion-preview-require-certain-commands
+    completion-preview-require-minimum-symbol-length)
+  "Hook for functions that determines whether to show preview completion.
+
+Completion Preview mode calls each of these functions in order
+after each command, and only displays the completion preview when
+all of the functions return non-nil."
+  :type 'hook)
+
+(defvar completion-preview-predicate #'always
+  "Completion predicate to use for completion preview.")
+
+(defvar completion-preview-sort-function #'minibuffer--sort-by-length-alpha
+  "Sort function to use for choosing a completion candidate to preview.")
+
+(defface completion-preview
+  '((t :inherit shadow))
+  "Face for completion preview overlay.")
+
+(defface completion-preview-exact
+  '((t :underline t :inherit completion-preview))
+  "Face for exact completion preview overlay.")
+
+(defvar-local completion-preview--overlay nil)
+
+(defun completion-preview-require-certain-commands ()
+  "Check if `this-command' is one of `completion-preview-commands'."
+  (memq this-command completion-preview-commands))
+
+(defun completion-preview-require-minimum-symbol-length ()
+  "Check if the length of symbol at point is at least above a certain threshold.
+`completion-preview-minimum-symbol-length' determines that threshold."
+  (pcase (bounds-of-thing-at-point 'symbol)
+    (`(,beg . ,end)
+     (<= completion-preview-minimum-symbol-length (- end beg)))))
+
+(defun completion-preview-show ()
+  "Show completion preview with inline overlay after point."
+  (interactive)
+  (let ((res (run-hook-wrapped 'completion-at-point-functions
+                               #'completion--capf-wrapper 'all)))
+    (pcase res
+      (`(,_ ,beg ,end ,table . ,plist)
+       (let* ((string (buffer-substring beg end))
+              (md (completion-metadata string table completion-preview-predicate))
+              (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
+                           (completion-metadata-get md 'display-sort-function)
+                           completion-preview-sort-function))
+              (all (completion-all-completions string table
+                                               (or (plist-get plist :predicate)
+                                                   completion-preview-predicate)
+                                               (- (point) beg) md))
+              (last (last all)))
+         (when last
+           (setcdr last nil)
+           (let* ((sorted (funcall sort-fn all))
+                  (cand (car sorted)))
+             (when (string-prefix-p string cand)
+               (let* ((face (if (cadr sorted) 'completion-preview 'completion-preview-exact))
+                      (after (propertize (substring cand (length string)) 'face face)))
+                 (unless (string-empty-p after)
+                   (add-text-properties 0 1 '(cursor 1) after))
+                 (setq completion-preview--overlay (make-overlay end end))
+                 (overlay-put completion-preview--overlay 'after-string after)
+                 (overlay-put completion-preview--overlay 'completion-preview-plist plist)
+                 (overlay-put completion-preview--overlay 'completion-preview-string cand))))))))))
+
+(defun completion-preview--post-command ()
+  "Delete the previous completion preview overlay, and maybe show a new one."
+  (when completion-preview--overlay
+    (delete-overlay completion-preview--overlay)
+    (setq completion-preview--overlay nil))
+  (when (run-hook-with-args-until-failure 'completion-preview-hook)
+    (while-no-input
+      (completion-preview-show))))
+
+(defun completion-preview-insert-or-complete (complete-p)
+  "Insert the completion preview candidate.
+If there is no completion preview, or when COMPLETE-P is non-nil,
+invoke `completion-at-point' instead.  Interactively, COMPLETE-P
+is the prefix argument."
+  (interactive "P")
+  (if (or complete-p (not completion-preview--overlay))
+      (completion-at-point)
+    (let ((after (substring-no-properties
+                  (overlay-get completion-preview--overlay 'after-string)))
+          (string (overlay-get completion-preview--overlay
+                               'completion-preview-string))
+          (plist (overlay-get completion-preview--overlay
+                              'completion-preview-plist)))
+      (delete-overlay completion-preview--overlay)
+      (setq completion-preview--overlay nil)
+      (insert after)
+      (when-let ((exit-fn (plist-get plist :exit-function)))
+        (funcall exit-fn string 'finished)))))
+
+(defvar-keymap completion-preview-mode-map
+  :doc "Keymap for Completion Preview mode."
+  "C-M-i" #'completion-preview-insert-or-complete)
+
+(define-minor-mode completion-preview-mode
+  "Show in-buffer completion preview as you type."
+  :lighter " CP"
+  (if completion-preview-mode
+      (add-hook 'post-command-hook #'completion-preview--post-command nil t)
+    (remove-hook 'post-command-hook #'completion-preview--post-command t)
+    (when completion-preview--overlay
+      (delete-overlay completion-preview--overlay)
+      (setq completion-preview--overlay nil))))
+
+(provide 'completion-preview)
+;;; completion-preview.el ends here