Initial commit

diff --git a/completion-preview.el b/completion-preview.el
new file mode 100644 (file)
index 0000000..f5a0125
--- /dev/null
+++ b/completion-preview.el
@@ -0,0 +1,166 @@
+;;; 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-exact-match-only nil
+  "Whether to show completion preview only when there is an exact match.
+
+If this option is non-nil, Completion Preview mode only shows the
+preview overlay when there is exactly one completion candidate
+that matches the symbol at point, otherwise it shows the top
+candidate also when there are multiple matching candidates."
+  :type 'boolean)
+
+(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* ((filtered (seq-filter (apply-partially #'string-prefix-p string)
+                                        all))
+                  (sorted (funcall sort-fn filtered))
+                  (multi (cadr sorted)) ; multiple candidates
+                  (cand (car sorted)))
+             (when (and cand
+                        (not (and multi completion-preview-exact-match-only)))
+               (let* ((face (if multi '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