From: Eshel Yaron via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
To: Eli Zaretskii <eliz@gnu.org>
Cc: philipk@posteo.net, juri@linkov.net, dmitry@gutov.dev,
joaotavora@gmail.com, 66948@debbugs.gnu.org,
stefankangas@gmail.com
Subject: bug#66948: [PATCH] Add Completion Preview mode
Date: Wed, 15 Nov 2023 15:22:25 +0100 [thread overview]
Message-ID: <m1bkbvgkpq.fsf@sp-byods-145-109-9-233.wireless.uva.nl> (raw)
In-Reply-To: <83wmujqh89.fsf@gnu.org> (Eli Zaretskii's message of "Wed, 15 Nov 2023 15:27:34 +0200")
[-- Attachment #1: Type: text/plain, Size: 1783 bytes --]
Eli Zaretskii <eliz@gnu.org> writes:
>> > Alternatively, we could have a defcustom based on a different design:
>> > show preview only when there are fewer than N completion candidates,
>> > with N being customizable. That would make much more sense, IMO,
>> > since it replaces a largely "mechanical" limitation with one that is
>> > meaningful for users.
>>
>> That would indeed be a nice solution, but it has a fatal flaw, sadly.
>> Computing the set of completion candidates is a costly operation,
>> especially with backends such as LSP, so we don't want to do that after
>> each command.
>
> This seems to be an argument in favor of the timer-based design I
> suggested. But if you aren't inclined to do that, I guess we can
> install the feature as it is designed now.
That'd be great, thanks.
>> >> > The underline face is not universally supported, so this defface
>> >> > should have fallbacks.
>> >>
>> >> The `underline` face in faces.el has `:underline t` in the fallback
>> >> clause too, so I figured that should be alright, no?
>> >
>> > If you are okay with seeing no effect at all when the terminal doesn't
>> > support the underline attribute, then yes. But I thought we want this
>> > face to stand out no matter what, don't we?
>>
>> That's okay IMO, the underline just differentiates between when you have
>> a single candidate and when you have multiple candidates. I don't think
>> that's that crucial, but if you can suggest a universally supported
>> fallback I'd be glad to add it, of course.
>
> How about some color (foreground or background)?
Sure, I've added a fallback that uses `:weight bold` when that's
supported but `:underline` isn't, and another ultimate fallback that
uses a background color instead. Here's the updated patch (v6):
[-- Attachment #2: v6-0001-Add-Completion-Preview-mode.patch --]
[-- Type: text/x-patch, Size: 18699 bytes --]
From e55c03c2e7010e81682fafbf9b5b291a220f4026 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@eshelyaron.com>
Date: Thu, 2 Nov 2023 16:58:31 +0100
Subject: [PATCH v6] Add Completion Preview mode
This adds a new minor mode, 'completion-preview-mode', that displays
in-buffer completion suggestions with an inline "preview" overlay.
(Bug#66948)
* lisp/completion-preview.el: New file.
* doc/emacs/programs.texi (Symbol Completion): Document it.
* etc/NEWS: Announce it.
---
doc/emacs/programs.texi | 11 ++
etc/NEWS | 6 +
lisp/completion-preview.el | 336 +++++++++++++++++++++++++++++++++++++
3 files changed, 353 insertions(+)
create mode 100644 lisp/completion-preview.el
diff --git a/doc/emacs/programs.texi b/doc/emacs/programs.texi
index 7746bc8bc23..3f3801abdb4 100644
--- a/doc/emacs/programs.texi
+++ b/doc/emacs/programs.texi
@@ -1701,6 +1701,17 @@ 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
+ Completion Preview mode is a minor mode that shows completion
+suggestions as you type. When you enable this mode (with @kbd{M-x
+completion-preview-mode}), Emacs automatically displays the
+suggested completion for text around point as an in-line preview
+right after point; type @key{TAB} to accept the suggestion.
+
@node MixedCase Words
@section MixedCase Words
@cindex camel case
diff --git a/etc/NEWS b/etc/NEWS
index 22a08bc97ea..23f4a8b5311 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1078,6 +1078,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..a6e6e10c034
--- /dev/null
+++ b/lisp/completion-preview.el
@@ -0,0 +1,336 @@
+;;; 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. Check out the customization group
+;; `completion-preview' for user options that you may want to tweak.
+;;
+;; To accept the completion suggestion, press TAB. 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.
+;;
+;; The commands `completion-preview-next-candidate' and
+;; `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 M-n and M-p in `completion-preview-active-mode-map' to
+;; have them handy whenever the preview is visible.
+;;
+;; If you set the user option `completion-preview-exact-match-only' to
+;; non-nil, Completion Preview mode only suggests a completion
+;; candidate when its the only possible completion for the (partial)
+;; symbol at point. The user option `completion-preview-commands'
+;; says which commands should trigger the completion preview. The
+;; user option `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 "foo", but typing just "fo" doesn't show the preview.
+;;
+;; The user option `completion-preview-insert-on-completion' controls
+;; what happens when you invoke `completion-at-point' while the
+;; completion preview is visible. By default this option is nil,
+;; which tells `completion-at-point' to ignore the completion preview
+;; and show the list of completion candidates as usual. If you set
+;; `completion-preview-insert-on-completion' to non-nil, then
+;; `completion-at-point' inserts the preview directly without looking
+;; for more candidates.
+
+;;; 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 when there is exactly one completion candidate that
+matches the symbol at point. Otherwise, if this option is nil,
+when there are multiple matching candidates the preview shows the
+first candidate, and you can cycle between the candidates with
+\\[completion-preview-next-candidate] and
+\\[completion-preview-prev-candidate]."
+ :type 'boolean
+ :version "30.1")
+
+(defcustom completion-preview-commands '(self-insert-command
+ insert-char
+ delete-backward-char
+ backward-delete-char-untabify)
+ "List of commands that should trigger completion preview."
+ :type '(repeat (function :tag "Command" :value self-insert-command))
+ :version "30.1")
+
+(defcustom completion-preview-minimum-symbol-length 3
+ "Minimum length of the symbol at point for showing completion preview."
+ :type 'natnum
+ :version "30.1")
+
+(defcustom completion-preview-insert-on-completion nil
+ "Whether \\[completion-at-point] inserts the previewed suggestion."
+ :type 'boolean
+ :version "30.1")
+
+(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."
+ :version "30.1")
+
+(defface completion-preview-exact
+ '((((supports :underline t))
+ :underline t :inherit completion-preview)
+ (((supports :weight bold))
+ :weight bold :inherit completion-preview)
+ (t :background "gray"))
+ "Face for exact completion preview overlay."
+ :version "30.1")
+
+(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.")
+
+(defsubst completion-preview--internal-command-p ()
+ "Return non-nil if `this-command' manipulates the completion preview."
+ (memq this-command completion-preview--internal-commands))
+
+(defsubst 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."
+ (let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (and bounds (<= completion-preview-minimum-symbol-length
+ (- (cdr bounds) (car bounds))))))
+
+(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))
+ (overlay-put completion-preview--overlay 'window (selected-window)))
+ (let ((previous (overlay-get completion-preview--overlay 'after-string)))
+ (unless (and previous (string= previous string))
+ (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 shown."
+ :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 (functionp func) (apply func args))))
+
+(defun completion-preview--update ()
+ "Update completion preview."
+ (seq-let (beg end table &rest plist)
+ (let ((completion-preview-insert-on-completion nil))
+ (run-hook-with-args-until-success 'completion-at-point-functions))
+ (when (and beg end table)
+ (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 a new completion preview.
+
+Call `completion-at-point-functions' in order to obtain and
+display a completion candidate for the text around point.
+
+If the preview is already shown, first check whether the
+suggested candidate remains a valid completion for the text at
+point. If so, update the preview according the new text at
+point, otherwise hide it."
+ (when completion-preview-active-mode
+ ;; We were already showing a preview before this command, so we
+ ;; check if the text before point is still a prefix of the
+ ;; candidate that the preview suggested, and if so we first update
+ ;; existing preview according to the changes made by this command,
+ ;; and only then try to get a new candidate. This ensures that we
+ ;; never display a stale preview and that the preview doesn't
+ ;; flicker, even with slow completion backends.
+ (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))
+ ;; The previous preview is still applicable, update it.
+ (overlay-put (completion-preview--make-overlay
+ cur (propertize (substring cand (- cur beg))
+ 'face face))
+ 'completion-preview-end cur)
+ ;; The previous preview is no longer applicable, hide it.
+ (completion-preview-active-mode -1))))
+ ;; Run `completion-at-point-functions' to get a new candidate.
+ (while-no-input (completion-preview--update)))
+
+(defun completion-preview--post-command ()
+ "Create, update or delete completion preview post last command."
+ (if (and (completion-preview-require-certain-commands)
+ (completion-preview-require-minimum-symbol-length))
+ ;; We should show the preview.
+ (or
+ ;; If we're called after a command that itself updates the
+ ;; preview, don't do anything.
+ (completion-preview--internal-command-p)
+ ;; Otherwise, show the preview.
+ (completion-preview--show))
+ (completion-preview-active-mode -1)))
+
+(defun completion-preview--insert ()
+ "Completion at point function for inserting the current preview.
+
+When `completion-preview-insert-on-completion' is nil, this
+function returns nil. Completion Preview mode adds this function
+to `completion-at-point-functions' when the preview is shown,
+such that `completion-at-point' inserts the preview candidate if
+and only if `completion-preview-insert-on-completion' is non-nil."
+ (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 completion candidate that the preview shows."
+ (interactive)
+ (let ((completion-preview-insert-on-completion t))
+ (completion-at-point)))
+
+(defun completion-preview-prev-candidate ()
+ "Cycle the candidate that the preview shows to the previous suggestion."
+ (interactive)
+ (completion-preview-next-candidate -1))
+
+(defun completion-preview-next-candidate (direction)
+ "Cycle the candidate that the preview shows in direction DIRECTION.
+
+DIRECTION should be either 1 which means cycle forward, or -1
+which means cycle backward. Interactively, DIRECTION is the
+prefix argument and defaults to 1."
+ (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
next prev parent reply other threads:[~2023-11-15 14:22 UTC|newest]
Thread overview: 29+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-11-05 10:26 bug#66948: [PATCH] Add Completion Preview mode Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-05 18:26 ` Philip Kaludercic
2023-11-05 19:42 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-06 7:22 ` Juri Linkov
2023-11-06 15:30 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-06 18:05 ` Juri Linkov
2023-11-06 19:47 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-07 7:08 ` Juri Linkov
2023-11-08 7:30 ` Juri Linkov
2023-11-08 9:14 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-08 15:44 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-09 7:25 ` Juri Linkov
2023-11-10 7:09 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-10 7:43 ` Eli Zaretskii
2023-11-10 7:58 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-10 7:59 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-10 13:05 ` Eli Zaretskii
2023-11-10 16:23 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-11 8:53 ` Eli Zaretskii
2023-11-11 12:01 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-15 13:27 ` Eli Zaretskii
2023-11-15 14:22 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors [this message]
2023-11-15 17:17 ` Eli Zaretskii
2023-11-15 19:02 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-10 8:00 ` Philip Kaludercic
2023-11-06 7:36 ` Philip Kaludercic
2023-11-06 15:37 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
2023-11-15 10:28 ` Sean Whitton
2023-11-15 10:57 ` Eshel Yaron via Bug reports for GNU Emacs, the Swiss army knife of text editors
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m1bkbvgkpq.fsf@sp-byods-145-109-9-233.wireless.uva.nl \
--to=bug-gnu-emacs@gnu.org \
--cc=66948@debbugs.gnu.org \
--cc=dmitry@gutov.dev \
--cc=eliz@gnu.org \
--cc=joaotavora@gmail.com \
--cc=juri@linkov.net \
--cc=me@eshelyaron.com \
--cc=philipk@posteo.net \
--cc=stefankangas@gmail.com \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.