bug#66948: [PATCH] Add Completion Preview mode

[Eshel Yaron via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>]

[-- Attachment #1: Type: text/plain, Size: 325 bytes --]

Eshel Yaron <me@eshelyaron.com> writes:

> This is for Emacs core, I'm attaching the latest patch again.  I think
> it mostly needs your OK.  Notably, I'd appreciate it if you could check
> out the addition to the manual and see if you have any comments on that.

And now with the actual patch attached... sorry about that.


[-- Attachment #2: v3-0001-Add-Completion-Preview-mode.patch --]
[-- Type: text/x-patch, Size: 18157 bytes --]

From 6c45fc9adfbc2f0239c6907ed8ed212fed7d44ab Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 2 Nov 2023 16:58:31 +0100
Subject: [PATCH v3] Add Completion Preview mode

This adds a new minor mode, 'completion-preview-mode', that displays
in-buffer completion suggestions with an inline "preview" overlay.

* lisp/completion-preview.el: New file.
* doc/emacs/programs.texi (Symbol Completion): Document it.
* etc/NEWS: Announce it.
---
 doc/emacs/programs.texi    |  84 ++++++++++++
 etc/NEWS                   |   6 +
 lisp/completion-preview.el | 266 +++++++++++++++++++++++++++++++++++++
 3 files changed, 356 insertions(+)
 create mode 100644 lisp/completion-preview.el

diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 7746bc8bc23..69f3ae76fe3 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1701,6 +1701,90 @@ Symbol Completion
   In Text mode and related modes, @kbd{M-@key{TAB}} completes words
 based on the spell-checker's dictionary.  @xref{Spelling}.
 
+@cindex completion preview
+@cindex preview completion
+@cindex suggestion preview
+@cindex Completion Preview mode
+@findex completion-preview-mode
+@vindex completion-preview-mode
+  Completion Preview mode is a minor mode that shows you symbol
+completion suggestions as type.  When you enable Completion Preview
+mode in a buffer (with @kbd{M-x completion-preview-mode}), Emacs
+examines the text around point after certain commands you invoke and
+automatically suggests a possible completion.  Emacs displays this
+suggestion with an inline preview right after point, so you see in
+advance exactly how the text will look if you accept the completion
+suggestion---that's why it's called a preview.
+
+For example, suppose that you have an Emacs Lisp buffer with the
+following code:
+
+@lisp
+(defun doit (foobarbaz)
+  fo@point{}
+@end lisp
+
+If you type another @samp{o}, the preview appears after point,
+suggesting that you complete the text to @samp{foobarbaz}:
+
+@lisp
+(defun doit (foobarbaz)
+  foo@point{}barbaz
+@end lisp
+
+Here, the text @samp{barbaz} after point is the completion preview.
+You can accept the completion suggestion with @kbd{@key{TAB}} to
+actually inserts @samp{barbaz} and move point after it:
+
+@lisp
+(defun doit (foobarbaz)
+  foobarbaz@point{}
+@end lisp
+
+If you want to ignore a completion suggestion, just go on editing or
+moving around the buffer.  Completion Preview mode continues to update
+the suggestion as you type according to the text around point.
+
+@vindex completion-preview-active-mode-map
+@findex completion-preview-prev-candidate
+@findex completion-preview-next-candidate
+The commands @code{completion-preview-next-candidate} and
+@code{completion-preview-prev-candidate} allow you to cycle the
+completion candidate that the preview suggests.  These commands don't
+have a default keybinding, but you can bind them, for example, to
+@kbd{M-n} and @kbd{M-p} in @code{completion-preview-active-mode-map}
+to have them handy whenever the preview is visible.
+
+@vindex completion-preview-exact-match-only
+@vindex completion-preview-commands
+@vindex completion-preview-minimum-symbol-length
+If you set the user option @code{completion-preview-exact-match-only}
+to non-@code{nil}, Completion Preview mode only suggests a completion
+candidate when its the only possible completion for the (partial)
+symbol at point.  The user option @code{completion-preview-commands}
+says which commands should trigger the completion preview; by default
+those are only @code{self-insert-command} and
+@code{delete-backward-char}, which correspond to when you type regular
+characters in the buffer or delete them.  The user option
+@code{completion-preview-minimum-symbol-length} specifies a minimum
+number of consecutive characters with word or symbol syntax that
+should appear around point for Emacs to suggest a completion.  By
+default, this option is set to 3, so Emacs suggests a completion if
+you type @samp{foo}, but typing just @samp{fo} doesn't trigger
+completion preview.
+
+@vindex completion-preview-insert-on-completion
+The user option @code{completion-preview-insert-on-completion}
+controls what happens when you invoke @code{completion-at-point} while
+the completion preview is visible.  By default this option is
+@code{nil}, which tells @code{completion-at-point} to ignore the
+completion preview and show the list of completion candidates as
+usual.  If you set @code{completion-preview-insert-on-completion} to
+non-@code{nil}, then @code{completion-at-point} inserts the preview
+directly without looking for more candidates.  To show the list of
+candidates with this setting while the preview is visible, type
+@kbd{C-g} to dismiss it before invoking @code{completion-at-point}.
+
 @node MixedCase Words
 @section MixedCase Words
 @cindex camel case
diff --git a/etc/NEWS b/etc/NEWS
index 767e4c27b43..0841c8aa860 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1028,6 +1028,12 @@ It highlights parens via ‘show-paren-mode’ and ‘blink-matching-paren’ in
 a user-friendly way, avoids reporting alleged paren mismatches and makes
 sexp navigation more intuitive.
 
++++
+*** New minor mode 'completion-preview-mode'.
+This minor mode shows you symbol completion suggestions as you type,
+using an inline preview.  New user options in the 'completion-preview'
+customization group control exactly when Emacs displays this preview.
+
 ---
 ** The highly accessible Modus themes collection has eight items.
 The 'modus-operandi' and 'modus-vivendi' are the main themes that have
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
new file mode 100644
index 00000000000..d21c0e042b7
--- /dev/null
+++ b/lisp/completion-preview.el
@@ -0,0 +1,266 @@
+;;; completion-preview.el --- Preview completion with inline overlay  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Maintainer: Eshel Yaron <me@eshelyaron.com>
+;; Keywords: abbrev 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.  If you want to enable Completion Preview mode
+;; in all programming modes, add the following to your Emacs init:
+;;
+;;     (add-hook 'prog-mode-hook #'completion-preview-mode)
+;;
+;; Also check out the customization group `completion-preview` for
+;; some user options that you may want to tweak.
+
+;;; 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
+                                         delete-backward-char
+                                         backward-delete-char-untabify)
+  "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 determine 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)
+
+(defcustom completion-preview-insert-on-completion nil
+  "Whether \\[completion-at-point] inserts the previewed suggestion."
+  :type 'boolean)
+
+(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-keymap completion-preview-active-mode-map
+  :doc "Keymap for Completion Preview Active mode."
+  "C-i" #'completion-preview-insert
+  ;; "M-n" #'completion-preview-next-candidate
+  ;; "M-p" #'completion-preview-prev-candidate
+  )
+
+(defvar-local completion-preview--overlay nil)
+
+(defvar completion-preview--internal-commands
+  '(completion-preview-next-candidate completion-preview-prev-candidate)
+  "List of commands that manipulate the completion preview.")
+
+(defun completion-preview--internal-command-p ()
+  "Return non-nil if `this-command' manipulates the completion preview."
+  (memq this-command completion-preview--internal-commands))
+
+(defun completion-preview-require-certain-commands ()
+  "Check if `this-command' is one of `completion-preview-commands'."
+  (or (completion-preview--internal-command-p)
+      (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-hide ()
+  "Hide the completion preview."
+  (when completion-preview--overlay
+    (delete-overlay completion-preview--overlay)
+    (setq completion-preview--overlay nil)))
+
+(defun completion-preview--make-overlay (pos string)
+  "Make a new completion preview overlay at POS showing STRING."
+  (if completion-preview--overlay
+      (move-overlay completion-preview--overlay pos pos)
+    (setq completion-preview--overlay (make-overlay pos pos)))
+  (add-text-properties 0 1 '(cursor 1) string)
+  (overlay-put completion-preview--overlay 'after-string string)
+  completion-preview--overlay)
+
+(defun completion-preview--get (prop)
+  "Return property PROP of the completion preview overlay."
+  (overlay-get completion-preview--overlay prop))
+
+(define-minor-mode completion-preview-active-mode
+  "Mode for when the completion preview is active."
+  :interactive nil
+  (if completion-preview-active-mode
+      (add-hook 'completion-at-point-functions #'completion-preview--insert -1 t)
+    (remove-hook 'completion-at-point-functions #'completion-preview--insert t)
+    (completion-preview-hide)))
+
+(defun completion-preview--exit-function (func)
+  "Return an exit function that hides the completion preview and calls FUNC."
+  (lambda (&rest args)
+    (completion-preview-active-mode -1)
+    (when func (apply func args))))
+
+(defun completion-preview--update ()
+  "Update completion preview."
+  (pcase (let ((completion-preview-insert-on-completion nil))
+           (run-hook-with-args-until-success 'completion-at-point-functions))
+    (`(,beg ,end ,table . ,plist)
+     (let* ((pred (plist-get plist :predicate))
+            (exit-fn (completion-preview--exit-function
+                      (plist-get plist :exit-function)))
+            (string (buffer-substring beg end))
+            (md (completion-metadata string table pred))
+            (sort-fn (or (completion-metadata-get md 'cycle-sort-function)
+                         (completion-metadata-get md 'display-sort-function)
+                         completion-preview-sort-function))
+            (all (let ((completion-lazy-hilit t))
+                   (completion-all-completions string table pred
+                                               (- (point) beg) md)))
+            (last (last all))
+            (base (or (cdr last) 0))
+            (bbeg (+ beg base))
+            (prefix (substring string base)))
+       (when last
+         (setcdr last nil)
+         (let* ((filtered (remove prefix (all-completions prefix 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 prefix)) 'face face))
+                    (ov (completion-preview--make-overlay end after)))
+               (overlay-put ov 'completion-preview-beg bbeg)
+               (overlay-put ov 'completion-preview-end end)
+               (overlay-put ov 'completion-preview-index 0)
+               (overlay-put ov 'completion-preview-cands sorted)
+               (overlay-put ov 'completion-preview-exit-fn exit-fn)
+               (completion-preview-active-mode)))))))))
+
+(defun completion-preview--show ()
+  "Show completion preview."
+  (when completion-preview-active-mode
+    (let* ((beg (completion-preview--get 'completion-preview-beg))
+           (cands (completion-preview--get 'completion-preview-cands))
+           (index (completion-preview--get 'completion-preview-index))
+           (cand (nth index cands))
+           (len (length cand))
+           (end (+ beg len))
+           (cur (point))
+           (face (get-text-property 0 'face (completion-preview--get 'after-string))))
+      (if (and (< beg cur end) (string-prefix-p (buffer-substring beg cur) cand))
+          (overlay-put (completion-preview--make-overlay
+                        cur (propertize (substring cand (- cur beg))
+                                        'face face))
+                       'completion-preview-end cur)
+        (completion-preview-active-mode -1))))
+  (while-no-input (completion-preview--update)))
+
+(defun completion-preview--post-command ()
+  "Create, update or delete completion preview post last command."
+  (if (run-hook-with-args-until-failure 'completion-preview-hook)
+      (or (completion-preview--internal-command-p)
+          (completion-preview--show))
+    (completion-preview-active-mode -1)))
+
+(defun completion-preview--insert ()
+  "Completion at point function for inserting the current preview."
+  (when (and completion-preview-active-mode
+             completion-preview-insert-on-completion)
+    (list (completion-preview--get 'completion-preview-beg)
+          (completion-preview--get 'completion-preview-end)
+          (list (nth (completion-preview--get 'completion-preview-index)
+                     (completion-preview--get 'completion-preview-cands)))
+          :exit-function (completion-preview--get 'completion-preview-exit-fn))))
+
+(defun completion-preview-insert ()
+  "Insert the current completion preview."
+  (interactive)
+  (let ((completion-preview-insert-on-completion t))
+    (completion-at-point)))
+
+(defun completion-preview-prev-candidate ()
+  "Cycle the preview to the previous completion suggestion."
+  (interactive)
+  (completion-preview-next-candidate -1))
+
+(defun completion-preview-next-candidate (direction)
+  "Cycle the preview to the next completion suggestion in DIRECTION.
+
+DIRECTION should be either 1 which means cycle forward, or -1
+which means cycle backward.  Interactively, DIRECTION is the
+prefix argument."
+  (interactive "p")
+  (when completion-preview-active-mode
+    (let* ((beg (completion-preview--get 'completion-preview-beg))
+           (all (completion-preview--get 'completion-preview-cands))
+           (cur (completion-preview--get 'completion-preview-index))
+           (len (length all))
+           (new (mod (+ cur direction) len))
+           (str (nth new all))
+           (pos (point)))
+      (while (or (<= (+ beg (length str)) pos)
+                 (not (string-prefix-p (buffer-substring beg pos) str)))
+        (setq new (mod (+ new direction) len) str (nth new all)))
+      (let ((aft (propertize (substring str (- pos beg))
+                             'face (if (< 1 len)
+                                       'completion-preview
+                                     'completion-preview-exact))))
+        (add-text-properties 0 1 '(cursor 1) aft)
+        (overlay-put completion-preview--overlay 'completion-preview-index new)
+        (overlay-put completion-preview--overlay 'after-string aft)))))
+
+;;;###autoload
+(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)
+    (completion-preview-active-mode -1)))
+
+(provide 'completion-preview)
+;;; completion-preview.el ends here
-- 
2.42.0