Received: (at submit) by debbugs.gnu.org; 20 Nov 2023 12:27:04 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 20 07:27:04 2023
Received: from localhost ([127.0.0.1]:52676 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1r53Ml-0005Rh-Ss
for submit <at> debbugs.gnu.org; Mon, 20 Nov 2023 07:27:04 -0500
Received: from lists.gnu.org ([2001:470:142::17]:43672)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <me@HIDDEN>) id 1r53Mi-0005R3-Ho
for submit <at> debbugs.gnu.org; Mon, 20 Nov 2023 07:27:02 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <me@HIDDEN>) id 1r53MZ-0007yv-SV
for bug-gnu-emacs@HIDDEN; Mon, 20 Nov 2023 07:26:52 -0500
Received: from mail.eshelyaron.com ([107.175.124.16] helo=eshelyaron.com)
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <me@HIDDEN>)
id 1r53MX-0007DO-GS; Mon, 20 Nov 2023 07:26:51 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com;
s=mail; t=1700483207;
bh=iCybZHWe2hoEH0JNLzf8g3XiiGnaP4WG67bH6+AooIs=;
h=From:To:Cc:Subject:In-Reply-To:References:Date:From;
b=tizDEgapTMC8QGdKQlu+fZIGnAWnZVlkqPJi+TLbBjCiguzA1TySxlNvxAfxT+3d4
Q9FydBg1irLouCbOAaPjKZZFJbPcosR8PfD3lBDCKZJm6c8hCExNd80gN3P8vda/XP
lfeUJm0z5tW/9MhrTbF9C6B5RsMuXf/OxYdJDalYiSACkJAUWUB9gQmYAY8l1QYSBO
B97mtEDWCFMahKf3G44ZCKTQFN8lpC/Zl3nZMOHw95tp3O3iljQ+5emC6dEO4KDYlN
ygkycTc5BzAOjdw1VD/ui5/hWrLQm1hRVBaKJfLqu/RimMytH/aM7zOQG2xOKf/jxn
UkVo4MZEuwFGA==
From: Eshel Yaron <me@HIDDEN>
To: Eshel Yaron via "Bug reports for GNU Emacs, the Swiss army knife of text
editors" <bug-gnu-emacs@HIDDEN>
Subject: Re: bug#67275: [PATCH] ; Improve and add tests for Completion
Preview mode
In-Reply-To: <m1jzqe9ecb.fsf@HIDDEN> (Eshel Yaron via's message of
"Sun, 19 Nov 2023 12:23:16 +0100")
References: <m1sf529gzw.fsf@HIDDEN> <8334x2ko1y.fsf@HIDDEN>
<m1jzqe9ecb.fsf@HIDDEN>
Date: Mon, 20 Nov 2023 13:26:45 +0100
Message-ID: <m1r0kkwqyi.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Received-SPF: pass client-ip=107.175.124.16; envelope-from=me@HIDDEN;
helo=eshelyaron.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001,
SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: 0.9 (/)
X-Debbugs-Envelope-To: submit
Cc: Eli Zaretskii <eliz@HIDDEN>, 67275 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.1 (/)
--=-=-=
Content-Type: text/plain
Eshel Yaron writes:
> ...Here's the updated patch...
I'm attaching below another patch, which is meant to be applied on top
of the patch from my previous message.
This patch simplifies Completion Preview mode a bit and, crucially,
fixes an issue where certain `completion-at-point-functions`
configurations could prevent `completion-preview-insert` from actually
inserting the completion suggestion.
I could unify this patch with the previous one and submit them as a
single patch if that'd be preferable, although in terms of Git history
it might be nicer to commit them separately IMO.
Thanks,
Eshel
--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
filename=0001-Avoid-completion-at-point-in-completion-preview-inse.patch
From f9a5099971511ce1b4298363395fd624453fb70d Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@HIDDEN>
Date: Mon, 20 Nov 2023 12:45:11 +0100
Subject: [PATCH] ; Avoid 'completion-at-point' in 'completion-preview-insert'
Insert the completion suggestion directly in
'completion-preview-insert' instead of using 'completion-at-point' to
do that. This fixes an issue where 'completion-preview-insert' would
not work correctly when the user uses 'add-hook' with a DEPTH argument
below a certain value to add functions to
'completion-at-point-functions', and obviates the need to manipulate
'completion-at-point-functions' when showing the preview all together.
* lisp/completion-preview.el (completion-preview--make-overlay)
(completion-preview-prev-candidate)
(completion-preview-next-candidate)
(completion-preview-mode): Improve docstring.
(completion-preview--exit-function)
(completion-preview--insert)
(completion-preview-insert-on-completion): Remove, no longer used.
(completion-preview--get): Turn into a 'defsubst'.
(completion-preview-active-mode)
(completion-preview--capf-wrapper): Simplify.
(completion-preview--try-table)
(completion-preview--update): Keep the completion "base" as a property
of the preview overlay, for use in completion exit functions.
(completion-preview-insert): Insert completion and call exit function
directly instead of manipulating 'completion-at-point' to do so.
---
lisp/completion-preview.el | 121 ++++++++++++++++---------------------
1 file changed, 52 insertions(+), 69 deletions(-)
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 95410e2e5cd..039a330bc84 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -22,10 +22,11 @@
;;; Commentary:
;; This library provides the Completion Preview mode. This minor mode
-;; displays the top completion candidate for the symbol at point in an
+;; displays a completion suggestion 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 enable Completion Preview mode, use `completion-preview-mode'.
;; 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
@@ -48,15 +49,6 @@
;; 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:
@@ -91,11 +83,6 @@ completion-preview-minimum-symbol-length
: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.")
@@ -149,7 +136,7 @@ completion-preview-hide
(setq completion-preview--overlay nil)))
(defun completion-preview--make-overlay (pos string)
- "Make a new completion preview overlay at POS showing STRING."
+ "Make preview overlay showing STRING at POS, or move existing preview there."
(if completion-preview--overlay
(move-overlay completion-preview--overlay pos pos)
(setq completion-preview--overlay (make-overlay pos pos))
@@ -162,23 +149,14 @@ completion-preview--make-overlay
(overlay-put completion-preview--overlay 'after-string string))
completion-preview--overlay))
-(defun completion-preview--get (prop)
+(defsubst 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))))
+ (unless completion-preview-active-mode (completion-preview-hide)))
(defun completion-preview--try-table (table beg end props)
"Check TABLE for a completion matching the text between BEG and END.
@@ -187,16 +165,16 @@ completion-preview--try-table
See `completion-at-point-functions' for more details.
If TABLE contains a matching completion, return a list
-\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show
-in the completion preview, ALL is the list of all matching
-completion candidates, and EXIT-FN is either a function to call
-after inserting PREVIEW or nil. If TABLE does not contain
-matching completions, or if there are multiple matching
-completions and `completion-preview-exact-match-only' is non-nil,
-return nil instead."
+\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to
+show in the completion preview, ALL is the list of all matching
+completion candidates, BASE is a common prefix that TABLE elided
+from the start of each candidate, and EXIT-FN is either a
+function to call after inserting PREVIEW or nil. If TABLE does
+not contain matching completions, or if there are multiple
+matching completions and `completion-preview-exact-match-only' is
+non-nil, return nil instead."
(let* ((pred (plist-get props :predicate))
- (exit-fn (completion-preview--exit-function
- (plist-get props :exit-function)))
+ (exit-fn (plist-get props :exit-function))
(string (buffer-substring beg end))
(md (completion-metadata string table pred))
(sort-fn (or (completion-metadata-get md 'cycle-sort-function)
@@ -217,23 +195,23 @@ completion-preview--try-table
'face (if (cdr sorted)
'completion-preview
'completion-preview-exact))
- (+ beg base) end sorted exit-fn))))))
+ (+ beg base) end sorted
+ (substring string 0 base) exit-fn))))))
(defun completion-preview--capf-wrapper (capf)
"Translate return value of CAPF to properties for completion preview overlay."
- (unless (eq capf #'completion-preview--insert)
- (let ((res (ignore-errors (funcall capf))))
- (and (consp res)
- (not (functionp res))
- (seq-let (beg end table &rest plist) res
- (or (completion-preview--try-table table beg end plist)
- (unless (eq 'no (plist-get plist :exclusive))
- ;; Return non-nil to exclude other capfs.
- '(nil))))))))
+ (let ((res (ignore-errors (funcall capf))))
+ (and (consp res)
+ (not (functionp res))
+ (seq-let (beg end table &rest plist) res
+ (or (completion-preview--try-table table beg end plist)
+ (unless (eq 'no (plist-get plist :exclusive))
+ ;; Return non-nil to exclude other capfs.
+ '(nil)))))))
(defun completion-preview--update ()
"Update completion preview."
- (seq-let (preview beg end all exit-fn)
+ (seq-let (preview beg end all base exit-fn)
(run-hook-wrapped
'completion-at-point-functions
#'completion-preview--capf-wrapper)
@@ -243,6 +221,7 @@ completion-preview--update
(overlay-put ov 'completion-preview-end end)
(overlay-put ov 'completion-preview-index 0)
(overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-base base)
(overlay-put ov 'completion-preview-exit-fn exit-fn)
(completion-preview-active-mode)))))
@@ -296,35 +275,30 @@ completion-preview--post-command
(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."
+ "Insert the completion candidate that the preview is showing."
(interactive)
- (let ((completion-preview-insert-on-completion t))
- (completion-at-point)))
+ (if completion-preview-active-mode
+ (let* ((pre (completion-preview--get 'completion-preview-base))
+ (end (completion-preview--get 'completion-preview-end))
+ (ind (completion-preview--get 'completion-preview-index))
+ (all (completion-preview--get 'completion-preview-cands))
+ (efn (completion-preview--get 'completion-preview-exit-fn))
+ (aft (completion-preview--get 'after-string))
+ (str (concat pre (nth ind all))))
+ (completion-preview-active-mode -1)
+ (goto-char end)
+ (insert (substring-no-properties aft))
+ (when (functionp efn) (funcall efn str 'finished)))
+ (user-error "No current completion preview")))
(defun completion-preview-prev-candidate ()
- "Cycle the candidate that the preview shows to the previous suggestion."
+ "Cycle the candidate that the preview is showing 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.
+ "Cycle the candidate that the preview is showing in direction DIRECTION.
DIRECTION should be either 1 which means cycle forward, or -1
which means cycle backward. Interactively, DIRECTION is the
@@ -351,7 +325,16 @@ completion-preview-next-candidate
;;;###autoload
(define-minor-mode completion-preview-mode
- "Show in-buffer completion preview as you type."
+ "Show in-buffer completion suggestions in a preview as you type.
+
+This mode automatically shows and updates the completion preview
+according to the text around point.
+\\<completion-preview-active-mode-map>\
+When the preview is visible, \\[completion-preview-insert]
+accepts the completion suggestion,
+\\[completion-preview-next-candidate] cycles forward to the next
+completion suggestion, and \\[completion-preview-prev-candidate]
+cycles backward."
:lighter " CP"
(if completion-preview-mode
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
--
2.42.0
--=-=-=--
bug-gnu-emacs@HIDDEN:bug#67275; Package emacs.
Full text available.
Received: (at 67275) by debbugs.gnu.org; 20 Nov 2023 12:26:53 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Mon Nov 20 07:26:53 2023
Received: from localhost ([127.0.0.1]:52672 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1r53Ma-0005Qt-WB
for submit <at> debbugs.gnu.org; Mon, 20 Nov 2023 07:26:53 -0500
Received: from mail.eshelyaron.com ([107.175.124.16]:41028 helo=eshelyaron.com)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <me@HIDDEN>) id 1r53MY-0005Ql-FL
for 67275 <at> debbugs.gnu.org; Mon, 20 Nov 2023 07:26:52 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com;
s=mail; t=1700483207;
bh=iCybZHWe2hoEH0JNLzf8g3XiiGnaP4WG67bH6+AooIs=;
h=From:To:Cc:Subject:In-Reply-To:References:Date:From;
b=tizDEgapTMC8QGdKQlu+fZIGnAWnZVlkqPJi+TLbBjCiguzA1TySxlNvxAfxT+3d4
Q9FydBg1irLouCbOAaPjKZZFJbPcosR8PfD3lBDCKZJm6c8hCExNd80gN3P8vda/XP
lfeUJm0z5tW/9MhrTbF9C6B5RsMuXf/OxYdJDalYiSACkJAUWUB9gQmYAY8l1QYSBO
B97mtEDWCFMahKf3G44ZCKTQFN8lpC/Zl3nZMOHw95tp3O3iljQ+5emC6dEO4KDYlN
ygkycTc5BzAOjdw1VD/ui5/hWrLQm1hRVBaKJfLqu/RimMytH/aM7zOQG2xOKf/jxn
UkVo4MZEuwFGA==
From: Eshel Yaron <me@HIDDEN>
To: Eshel Yaron via "Bug reports for GNU Emacs, the Swiss army knife of text
editors" <bug-gnu-emacs@HIDDEN>
Subject: Re: bug#67275: [PATCH] ; Improve and add tests for Completion
Preview mode
In-Reply-To: <m1jzqe9ecb.fsf@HIDDEN> (Eshel Yaron via's message of
"Sun, 19 Nov 2023 12:23:16 +0100")
References: <m1sf529gzw.fsf@HIDDEN> <8334x2ko1y.fsf@HIDDEN>
<m1jzqe9ecb.fsf@HIDDEN>
Date: Mon, 20 Nov 2023 13:26:45 +0100
Message-ID: <m1r0kkwqyi.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 67275
Cc: Eli Zaretskii <eliz@HIDDEN>, 67275 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
--=-=-=
Content-Type: text/plain
Eshel Yaron writes:
> ...Here's the updated patch...
I'm attaching below another patch, which is meant to be applied on top
of the patch from my previous message.
This patch simplifies Completion Preview mode a bit and, crucially,
fixes an issue where certain `completion-at-point-functions`
configurations could prevent `completion-preview-insert` from actually
inserting the completion suggestion.
I could unify this patch with the previous one and submit them as a
single patch if that'd be preferable, although in terms of Git history
it might be nicer to commit them separately IMO.
Thanks,
Eshel
--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
filename=0001-Avoid-completion-at-point-in-completion-preview-inse.patch
From f9a5099971511ce1b4298363395fd624453fb70d Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@HIDDEN>
Date: Mon, 20 Nov 2023 12:45:11 +0100
Subject: [PATCH] ; Avoid 'completion-at-point' in 'completion-preview-insert'
Insert the completion suggestion directly in
'completion-preview-insert' instead of using 'completion-at-point' to
do that. This fixes an issue where 'completion-preview-insert' would
not work correctly when the user uses 'add-hook' with a DEPTH argument
below a certain value to add functions to
'completion-at-point-functions', and obviates the need to manipulate
'completion-at-point-functions' when showing the preview all together.
* lisp/completion-preview.el (completion-preview--make-overlay)
(completion-preview-prev-candidate)
(completion-preview-next-candidate)
(completion-preview-mode): Improve docstring.
(completion-preview--exit-function)
(completion-preview--insert)
(completion-preview-insert-on-completion): Remove, no longer used.
(completion-preview--get): Turn into a 'defsubst'.
(completion-preview-active-mode)
(completion-preview--capf-wrapper): Simplify.
(completion-preview--try-table)
(completion-preview--update): Keep the completion "base" as a property
of the preview overlay, for use in completion exit functions.
(completion-preview-insert): Insert completion and call exit function
directly instead of manipulating 'completion-at-point' to do so.
---
lisp/completion-preview.el | 121 ++++++++++++++++---------------------
1 file changed, 52 insertions(+), 69 deletions(-)
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 95410e2e5cd..039a330bc84 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -22,10 +22,11 @@
;;; Commentary:
;; This library provides the Completion Preview mode. This minor mode
-;; displays the top completion candidate for the symbol at point in an
+;; displays a completion suggestion 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 enable Completion Preview mode, use `completion-preview-mode'.
;; 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
@@ -48,15 +49,6 @@
;; 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:
@@ -91,11 +83,6 @@ completion-preview-minimum-symbol-length
: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.")
@@ -149,7 +136,7 @@ completion-preview-hide
(setq completion-preview--overlay nil)))
(defun completion-preview--make-overlay (pos string)
- "Make a new completion preview overlay at POS showing STRING."
+ "Make preview overlay showing STRING at POS, or move existing preview there."
(if completion-preview--overlay
(move-overlay completion-preview--overlay pos pos)
(setq completion-preview--overlay (make-overlay pos pos))
@@ -162,23 +149,14 @@ completion-preview--make-overlay
(overlay-put completion-preview--overlay 'after-string string))
completion-preview--overlay))
-(defun completion-preview--get (prop)
+(defsubst 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))))
+ (unless completion-preview-active-mode (completion-preview-hide)))
(defun completion-preview--try-table (table beg end props)
"Check TABLE for a completion matching the text between BEG and END.
@@ -187,16 +165,16 @@ completion-preview--try-table
See `completion-at-point-functions' for more details.
If TABLE contains a matching completion, return a list
-\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show
-in the completion preview, ALL is the list of all matching
-completion candidates, and EXIT-FN is either a function to call
-after inserting PREVIEW or nil. If TABLE does not contain
-matching completions, or if there are multiple matching
-completions and `completion-preview-exact-match-only' is non-nil,
-return nil instead."
+\(PREVIEW BEG END ALL BASE EXIT-FN) where PREVIEW is the text to
+show in the completion preview, ALL is the list of all matching
+completion candidates, BASE is a common prefix that TABLE elided
+from the start of each candidate, and EXIT-FN is either a
+function to call after inserting PREVIEW or nil. If TABLE does
+not contain matching completions, or if there are multiple
+matching completions and `completion-preview-exact-match-only' is
+non-nil, return nil instead."
(let* ((pred (plist-get props :predicate))
- (exit-fn (completion-preview--exit-function
- (plist-get props :exit-function)))
+ (exit-fn (plist-get props :exit-function))
(string (buffer-substring beg end))
(md (completion-metadata string table pred))
(sort-fn (or (completion-metadata-get md 'cycle-sort-function)
@@ -217,23 +195,23 @@ completion-preview--try-table
'face (if (cdr sorted)
'completion-preview
'completion-preview-exact))
- (+ beg base) end sorted exit-fn))))))
+ (+ beg base) end sorted
+ (substring string 0 base) exit-fn))))))
(defun completion-preview--capf-wrapper (capf)
"Translate return value of CAPF to properties for completion preview overlay."
- (unless (eq capf #'completion-preview--insert)
- (let ((res (ignore-errors (funcall capf))))
- (and (consp res)
- (not (functionp res))
- (seq-let (beg end table &rest plist) res
- (or (completion-preview--try-table table beg end plist)
- (unless (eq 'no (plist-get plist :exclusive))
- ;; Return non-nil to exclude other capfs.
- '(nil))))))))
+ (let ((res (ignore-errors (funcall capf))))
+ (and (consp res)
+ (not (functionp res))
+ (seq-let (beg end table &rest plist) res
+ (or (completion-preview--try-table table beg end plist)
+ (unless (eq 'no (plist-get plist :exclusive))
+ ;; Return non-nil to exclude other capfs.
+ '(nil)))))))
(defun completion-preview--update ()
"Update completion preview."
- (seq-let (preview beg end all exit-fn)
+ (seq-let (preview beg end all base exit-fn)
(run-hook-wrapped
'completion-at-point-functions
#'completion-preview--capf-wrapper)
@@ -243,6 +221,7 @@ completion-preview--update
(overlay-put ov 'completion-preview-end end)
(overlay-put ov 'completion-preview-index 0)
(overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-base base)
(overlay-put ov 'completion-preview-exit-fn exit-fn)
(completion-preview-active-mode)))))
@@ -296,35 +275,30 @@ completion-preview--post-command
(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."
+ "Insert the completion candidate that the preview is showing."
(interactive)
- (let ((completion-preview-insert-on-completion t))
- (completion-at-point)))
+ (if completion-preview-active-mode
+ (let* ((pre (completion-preview--get 'completion-preview-base))
+ (end (completion-preview--get 'completion-preview-end))
+ (ind (completion-preview--get 'completion-preview-index))
+ (all (completion-preview--get 'completion-preview-cands))
+ (efn (completion-preview--get 'completion-preview-exit-fn))
+ (aft (completion-preview--get 'after-string))
+ (str (concat pre (nth ind all))))
+ (completion-preview-active-mode -1)
+ (goto-char end)
+ (insert (substring-no-properties aft))
+ (when (functionp efn) (funcall efn str 'finished)))
+ (user-error "No current completion preview")))
(defun completion-preview-prev-candidate ()
- "Cycle the candidate that the preview shows to the previous suggestion."
+ "Cycle the candidate that the preview is showing 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.
+ "Cycle the candidate that the preview is showing in direction DIRECTION.
DIRECTION should be either 1 which means cycle forward, or -1
which means cycle backward. Interactively, DIRECTION is the
@@ -351,7 +325,16 @@ completion-preview-next-candidate
;;;###autoload
(define-minor-mode completion-preview-mode
- "Show in-buffer completion preview as you type."
+ "Show in-buffer completion suggestions in a preview as you type.
+
+This mode automatically shows and updates the completion preview
+according to the text around point.
+\\<completion-preview-active-mode-map>\
+When the preview is visible, \\[completion-preview-insert]
+accepts the completion suggestion,
+\\[completion-preview-next-candidate] cycles forward to the next
+completion suggestion, and \\[completion-preview-prev-candidate]
+cycles backward."
:lighter " CP"
(if completion-preview-mode
(add-hook 'post-command-hook #'completion-preview--post-command nil t)
--
2.42.0
--=-=-=--
bug-gnu-emacs@HIDDEN:bug#67275; Package emacs.
Full text available.
Received: (at 67275) by debbugs.gnu.org; 19 Nov 2023 11:23:24 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Nov 19 06:23:24 2023
Received: from localhost ([127.0.0.1]:50112 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1r4ftb-0008Pd-7l
for submit <at> debbugs.gnu.org; Sun, 19 Nov 2023 06:23:24 -0500
Received: from mail.eshelyaron.com ([107.175.124.16]:48620 helo=eshelyaron.com)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <me@HIDDEN>) id 1r4ftY-0008PS-AM
for 67275 <at> debbugs.gnu.org; Sun, 19 Nov 2023 06:23:21 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com;
s=mail; t=1700392998;
bh=J781RpvRBDfQASgwez12CyIH9fSS/ABj6LMgLdLnCZs=;
h=From:To:Cc:Subject:In-Reply-To:References:Date:From;
b=tavKk+IHvoXc9s1CZBoBdR++N16mx70orhzawhcAaJLXaokoXgSj7/O+AQxdxb4AC
kOhboiV96hfOBcxv7H80IoX3/ROf3TAFDRa2wAzVV7bpyw78ZAUWuoyZBwzaPGYR1b
ECWL5R9A7wOKoquSuioYJZT7X2z4OnCuPn0YmYP1khzpLEpSqd9cIjgXHkQ6F5IrHU
+Xga48g6BGHUagGrX1ooBMYMJsUs5tjAUAD0YlwC+826yfBydFdW+eoLO7HLGFpEqp
y1CrbVbkW+P0ehmMyXwiCKfoN3Er4PoubndmpRFVbR5Xb6V2pudD1aUX4fvz6vit0l
CNOGe+WiyXCIg==
From: Eshel Yaron <me@HIDDEN>
To: Eli Zaretskii <eliz@HIDDEN>
Subject: Re: bug#67275: [PATCH] ; Improve and add tests for Completion
Preview mode
In-Reply-To: <8334x2ko1y.fsf@HIDDEN> (Eli Zaretskii's message of "Sun, 19 Nov
2023 12:58:01 +0200")
References: <m1sf529gzw.fsf@HIDDEN> <8334x2ko1y.fsf@HIDDEN>
Date: Sun, 19 Nov 2023 12:23:16 +0100
Message-ID: <m1jzqe9ecb.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
X-Spam-Score: -0.0 (/)
X-Debbugs-Envelope-To: 67275
Cc: 67275 <at> debbugs.gnu.org
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -1.0 (-)
--=-=-=
Content-Type: text/plain
Eli Zaretskii <eliz@HIDDEN> writes:
>> +When TABLE contains a matching completion, return a list
>> +\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show
>> +in the completion preview, ALL is the list of all matching
>> +completion candidates, and EXIT-FN is either a function to call
>> +after inserting PREVIEW or nil. When TABLE does not contain
>> +matching completions, or when there are multiple matching
>> +completions and `completion-preview-exact-match-only' is non-nil,
>> +return nil instead."
>
> It is better to use "if" here where you use "when". "When" can be
> interpreted as a time-related condition, which is not what you want
> here.
Right, done in the updated patch (v2) below.
>> +(defun completion-preview--capf-wrapper (capf)
>> + "Translate output of CAPF to properties for completion preview overlay.
>> +
>> +If CAPF returns a list (BEG END TABLE . PROPS), call
>
> If CAPF _returns_ something, it is probably a function. But then why
> does the first sentence say "output of CAPF"? functions in ELisp don't
> "output" stuff.
Thanks, I've replaced "output" with "return value".
>> +`completion-preview--try-table' to check TABLE for matching
>> +completion candidates. If `completion-preview--try-table'
>> +returns a non-nil value, return that value. Otherwise, return a
>> +list with nil car which means that completion failed, unless
>> +PROPS includes the property `:exclusive' with value `no', in
>> +which case this function returns nil which means to try other
>> +functions from `completion-at-point-functions'."
>
> This basically tells in words what the code does. But since the code
> is quite simple, I wonder why we need this in the doc string. The
> disadvantage of having this in the doc string is that we'd need to
> update it each time the code changes.
>
> Instead, think if something in what the code does needs to be
> explained _beyond_ what the code itself says, like if you need to
> explain the reasons why the code does what it does, or why you access
> this or that property, and explain that -- in comments, not in the doc
> string. The doc string should ideally be a higher-level description
> of the function's purpose and the meaning of its return values.
Makes sense, thanks. I removed the lengthy description and added a
comment explaining the only non-obvious part.
Here's the updated patch:
--=-=-=
Content-Type: text/x-patch
Content-Disposition: attachment;
filename=v2-0001-Improve-and-add-tests-for-Completion-Preview-mode.patch
From 675019870e885ffe93944bc92e680a70eab99133 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@HIDDEN>
Date: Sun, 19 Nov 2023 10:55:15 +0100
Subject: [PATCH v2] ; Improve and add tests for Completion Preview mode
Fix handling of capfs that return a function or signal an error,
respect the ':exclusive' completion property, fix lingering "exact"
face after deletion that makes the matches non-exact, and add tests.
* lisp/completion-preview.el (completion-preview--make-overlay): Only
reuse the previous 'after-string' if it has the right face.
(completion-preview--try-table)
(completion-preview--capf-wrapper): New functions.
(completion-preview--update): Use them.
* test/lisp/completion-preview-tests.el: New file.
---
lisp/completion-preview.el | 107 +++++++++------
test/lisp/completion-preview-tests.el | 184 ++++++++++++++++++++++++++
2 files changed, 250 insertions(+), 41 deletions(-)
create mode 100644 test/lisp/completion-preview-tests.el
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6048d5be272..95410e2e5cd 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -155,7 +155,9 @@ completion-preview--make-overlay
(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))
+ (unless (and previous (string= previous string)
+ (eq (get-text-property 0 'face previous)
+ (get-text-property 0 'face string)))
(add-text-properties 0 1 '(cursor 1) string)
(overlay-put completion-preview--overlay 'after-string string))
completion-preview--overlay))
@@ -178,48 +180,71 @@ completion-preview--exit-function
(completion-preview-active-mode -1)
(when (functionp func) (apply func args))))
+(defun completion-preview--try-table (table beg end props)
+ "Check TABLE for a completion matching the text between BEG and END.
+
+PROPS is a property list with additional information about TABLE.
+See `completion-at-point-functions' for more details.
+
+If TABLE contains a matching completion, return a list
+\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show
+in the completion preview, ALL is the list of all matching
+completion candidates, and EXIT-FN is either a function to call
+after inserting PREVIEW or nil. If TABLE does not contain
+matching completions, or if there are multiple matching
+completions and `completion-preview-exact-match-only' is non-nil,
+return nil instead."
+ (let* ((pred (plist-get props :predicate))
+ (exit-fn (completion-preview--exit-function
+ (plist-get props :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))
+ (prefix (substring string base)))
+ (when last
+ (setcdr last nil)
+ (when-let ((sorted (funcall sort-fn
+ (delete prefix (all-completions prefix all)))))
+ (unless (and (cdr sorted) completion-preview-exact-match-only)
+ (list (propertize (substring (car sorted) (length prefix))
+ 'face (if (cdr sorted)
+ 'completion-preview
+ 'completion-preview-exact))
+ (+ beg base) end sorted exit-fn))))))
+
+(defun completion-preview--capf-wrapper (capf)
+ "Translate return value of CAPF to properties for completion preview overlay."
+ (unless (eq capf #'completion-preview--insert)
+ (let ((res (ignore-errors (funcall capf))))
+ (and (consp res)
+ (not (functionp res))
+ (seq-let (beg end table &rest plist) res
+ (or (completion-preview--try-table table beg end plist)
+ (unless (eq 'no (plist-get plist :exclusive))
+ ;; Return non-nil to exclude other capfs.
+ '(nil))))))))
+
(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)))))))))
+ (seq-let (preview beg end all exit-fn)
+ (run-hook-wrapped
+ 'completion-at-point-functions
+ #'completion-preview--capf-wrapper)
+ (when preview
+ (let ((ov (completion-preview--make-overlay end preview)))
+ (overlay-put ov 'completion-preview-beg beg)
+ (overlay-put ov 'completion-preview-end end)
+ (overlay-put ov 'completion-preview-index 0)
+ (overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-exit-fn exit-fn)
+ (completion-preview-active-mode)))))
(defun completion-preview--show ()
"Show a new completion preview.
diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el
new file mode 100644
index 00000000000..b5518e96254
--- /dev/null
+++ b/test/lisp/completion-preview-tests.el
@@ -0,0 +1,184 @@
+;;; completion-preview-tests.el --- tests for completion-preview.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'completion-preview)
+
+(defun completion-preview-tests--capf (completions &rest props)
+ (lambda ()
+ (when-let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (append (list (car bounds) (cdr bounds) completions) props))))
+
+(defun completion-preview-tests--check-preview (string &optional exact)
+ "Check that the completion preview is showing STRING.
+
+If EXACT is non-nil, check that STRING has the
+`completion-preview-exact' face. Otherwise check that STRING has
+the `completion-preview' face.
+
+If STRING is nil, check that there is no completion preview
+instead."
+ (if (not string)
+ (should (not completion-preview--overlay))
+ (should completion-preview--overlay)
+ (let ((after-string (completion-preview--get 'after-string)))
+ (should (string= after-string string))
+ (should (eq (get-text-property 0 'face after-string)
+ (if exact
+ 'completion-preview-exact
+ 'completion-preview))))))
+
+(ert-deftest completion-preview ()
+ "Test Completion Preview mode."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf '("foobarbaz"))))
+
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "barbaz" 'exact)
+
+ (insert "v")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; No match, no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+
+ ;; Exact match again
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-multiple-matches ()
+ "Test Completion Preview mode with multiple matching candidates."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, the preview shows the first one
+ (completion-preview-tests--check-preview "bar")
+
+ (completion-preview-next-candidate 1)
+
+ ;; Next match
+ (completion-preview-tests--check-preview "baz")))
+
+(ert-deftest completion-preview-exact-match-only ()
+ "Test `completion-preview-exact-match-only'."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("spam" "foobar" "foobaz")))
+ completion-preview-exact-match-only t)
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, so no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-region (point-min) (point-max))
+ (insert "spa")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "m" 'exact)))
+
+(ert-deftest completion-preview-function-capfs ()
+ "Test Completion Preview mode with capfs that return a function."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () #'ignore)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")))
+
+(ert-deftest completion-preview-non-exclusive-capfs ()
+ "Test Completion Preview mode with non-exclusive capfs."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("spam") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")
+ (setq-local completion-preview-exact-match-only t)
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-face-updates ()
+ "Test updating the face in completion preview when match is no longer exact."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobarbaz" "food"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")
+ (insert "b")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "arbaz" 'exact)
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")))
+
+(ert-deftest completion-preview-capf-errors ()
+ "Test Completion Preview mode with capfs that signal errors.
+
+`dabbrev-capf' is one example of such a capf."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () (user-error "bad"))
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+;;; completion-preview-tests.el ends here
--
2.42.0
--=-=-=--
bug-gnu-emacs@HIDDEN:bug#67275; Package emacs.
Full text available.Received: (at 67275) by debbugs.gnu.org; 19 Nov 2023 10:58:31 +0000 From debbugs-submit-bounces <at> debbugs.gnu.org Sun Nov 19 05:58:31 2023 Received: from localhost ([127.0.0.1]:50100 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>) id 1r4fVX-0007hm-4U for submit <at> debbugs.gnu.org; Sun, 19 Nov 2023 05:58:31 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]:34568) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from <eliz@HIDDEN>) id 1r4fVT-0007hW-Sn for 67275 <at> debbugs.gnu.org; Sun, 19 Nov 2023 05:58:30 -0500 Received: from fencepost.gnu.org ([2001:470:142:3::e]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from <eliz@HIDDEN>) id 1r4fVM-000538-Sf; Sun, 19 Nov 2023 05:58:20 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=References:Subject:In-Reply-To:To:From:Date: mime-version; bh=G3MLiFKZ+LtKZSTpq1GJsc2NFt5lUro+wwv/k/pn/n0=; b=NxLy+RXKRH/U nzxp8B5RvQeEFvcCokloGN1XyMBlKoczfxl5EQX/oVQOeIlro/IvxAKiOnJShm7eJ5fJd0Gu2783P 6vz31n4neIo9ba1mrRsbk/7mcOM0DJwS0mO/b9CEaSoeDLD0/dwNHHFQCPqbXwKKZ6Ql4nBJY7BmD l23P4WYPkbWsOObA5oOhMIZELSWCEpCCkSSiA52F2YtpVJdXGYt4irgjtsHPoxRzg9nxwQ/yvYIFR RVi0WmAk0OnnCMpv8h3XRlDDSNDtz2ocNVvkqsjHZmWUy6d7qLx3hciY3nQz6ypfPaaZH5nKsudQv 2L4MOheRkAbR38+u0htcaA==; Date: Sun, 19 Nov 2023 12:58:01 +0200 Message-Id: <8334x2ko1y.fsf@HIDDEN> From: Eli Zaretskii <eliz@HIDDEN> To: Eshel Yaron <me@HIDDEN> In-Reply-To: <m1sf529gzw.fsf@HIDDEN> (bug-gnu-emacs@HIDDEN) Subject: Re: bug#67275: [PATCH] ; Improve and add tests for Completion Preview mode References: <m1sf529gzw.fsf@HIDDEN> X-Spam-Score: -2.3 (--) X-Debbugs-Envelope-To: 67275 Cc: 67275 <at> debbugs.gnu.org X-BeenThere: debbugs-submit <at> debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list List-Id: <debbugs-submit.debbugs.gnu.org> List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe> List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/> List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org> List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help> List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>, <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe> Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org> X-Spam-Score: -3.3 (---) > Date: Sun, 19 Nov 2023 11:25:55 +0100 > From: Eshel Yaron via "Bug reports for GNU Emacs, > the Swiss army knife of text editors" <bug-gnu-emacs@HIDDEN> > > +(defun completion-preview--try-table (table beg end props) > + "Check TABLE for a completion matching the text between BEG and END. > + > +PROPS is a property list with additional information about TABLE. > +See `completion-at-point-functions' for more details. > + > +When TABLE contains a matching completion, return a list > +\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show > +in the completion preview, ALL is the list of all matching > +completion candidates, and EXIT-FN is either a function to call > +after inserting PREVIEW or nil. When TABLE does not contain > +matching completions, or when there are multiple matching > +completions and `completion-preview-exact-match-only' is non-nil, > +return nil instead." It is better to use "if" here where you use "when". "When" can be interpreted as a time-related condition, which is not what you want here. > +(defun completion-preview--capf-wrapper (capf) > + "Translate output of CAPF to properties for completion preview overlay. > + > +If CAPF returns a list (BEG END TABLE . PROPS), call If CAPF _returns_ something, it is probably a function. But then why does the first sentence say "output of CAPF"? functions in ELisp don't "output" stuff. > +`completion-preview--try-table' to check TABLE for matching > +completion candidates. If `completion-preview--try-table' > +returns a non-nil value, return that value. Otherwise, return a > +list with nil car which means that completion failed, unless > +PROPS includes the property `:exclusive' with value `no', in > +which case this function returns nil which means to try other > +functions from `completion-at-point-functions'." This basically tells in words what the code does. But since the code is quite simple, I wonder why we need this in the doc string. The disadvantage of having this in the doc string is that we'd need to update it each time the code changes. Instead, think if something in what the code does needs to be explained _beyond_ what the code itself says, like if you need to explain the reasons why the code does what it does, or why you access this or that property, and explain that -- in comments, not in the doc string. The doc string should ideally be a higher-level description of the function's purpose and the meaning of its return values. Thanks.
bug-gnu-emacs@HIDDEN:bug#67275; Package emacs.
Full text available.
Received: (at submit) by debbugs.gnu.org; 19 Nov 2023 10:26:13 +0000
From debbugs-submit-bounces <at> debbugs.gnu.org Sun Nov 19 05:26:13 2023
Received: from localhost ([127.0.0.1]:50084 helo=debbugs.gnu.org)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <debbugs-submit-bounces <at> debbugs.gnu.org>)
id 1r4f0G-0006mX-L9
for submit <at> debbugs.gnu.org; Sun, 19 Nov 2023 05:26:13 -0500
Received: from lists.gnu.org ([2001:470:142::17]:50720)
by debbugs.gnu.org with esmtp (Exim 4.84_2)
(envelope-from <me@HIDDEN>) id 1r4f0C-0006mI-Tz
for submit <at> debbugs.gnu.org; Sun, 19 Nov 2023 05:26:11 -0500
Received: from eggs.gnu.org ([2001:470:142:3::10])
by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <me@HIDDEN>) id 1r4f06-0004Lv-27
for bug-gnu-emacs@HIDDEN; Sun, 19 Nov 2023 05:26:02 -0500
Received: from mail.eshelyaron.com ([107.175.124.16] helo=eshelyaron.com)
by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
(Exim 4.90_1) (envelope-from <me@HIDDEN>) id 1r4f03-0000gB-Mr
for bug-gnu-emacs@HIDDEN; Sun, 19 Nov 2023 05:26:01 -0500
DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=eshelyaron.com;
s=mail; t=1700389558;
bh=wgAJx+7QeDJKaJBIaKLPK4jtZ8LXqaZ4F+O0mSz+tJM=;
h=From:To:Subject:Date:From;
b=mn46FAHUiEYNOjEMdQq2pBoM6u2KpkjbUtni938OUkhVuvZ7U1lxZaj/tGxo34FIz
6F3mpdorDG0NWxR5PmxMsEap44zvTM0NQmVdx7YzLF1z3gQU9Z2lcSz7IeBGemsycM
QTVkdR7qsZwaqSpMURUknjAZwsv2oL02xq80Z1VkYxiCZcSKZpy5WADHl0Aq+QJJy3
4vm1ht4f1Rq7DbvlzqDWPvBZwdtHqLSqAYQV9tOgGECPfWN5U1ODA9tWu8eoS5anYb
Nz7/mlEUYNpayCXCa9JNKWQfNDh6k7wv1k5ioED2mVxz+qWiXViTBzDeMe9d2mzW+T
Z1xw/ilM0EHeA==
From: Eshel Yaron <me@HIDDEN>
To: bug-gnu-emacs@HIDDEN
Subject: [PATCH] ; Improve and add tests for Completion Preview mode
X-Hashcash: 1:20:231119:bug-gnu-emacs@HIDDEN::RpwUaytY3G9Pyr1n:06SO
Date: Sun, 19 Nov 2023 11:25:55 +0100
Message-ID: <m1sf529gzw.fsf@HIDDEN>
User-Agent: Gnus/5.13 (Gnus v5.13)
MIME-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Received-SPF: pass client-ip=107.175.124.16; envelope-from=me@HIDDEN;
helo=eshelyaron.com
X-Spam_score_int: -20
X-Spam_score: -2.1
X-Spam_bar: --
X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1,
DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_PASS=-0.001,
SPF_PASS=-0.001, T_SCC_BODY_TEXT_LINE=-0.01 autolearn=ham autolearn_force=no
X-Spam_action: no action
X-Spam-Score: 0.9 (/)
X-Debbugs-Envelope-To: submit
X-BeenThere: debbugs-submit <at> debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
List-Id: <debbugs-submit.debbugs.gnu.org>
List-Unsubscribe: <https://debbugs.gnu.org/cgi-bin/mailman/options/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=unsubscribe>
List-Archive: <https://debbugs.gnu.org/cgi-bin/mailman/private/debbugs-submit/>
List-Post: <mailto:debbugs-submit <at> debbugs.gnu.org>
List-Help: <mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=help>
List-Subscribe: <https://debbugs.gnu.org/cgi-bin/mailman/listinfo/debbugs-submit>,
<mailto:debbugs-submit-request <at> debbugs.gnu.org?subject=subscribe>
Errors-To: debbugs-submit-bounces <at> debbugs.gnu.org
Sender: "Debbugs-submit" <debbugs-submit-bounces <at> debbugs.gnu.org>
X-Spam-Score: -0.1 (/)
--=-=-=
Content-Type: text/plain
Tags: patch
This patch makes Completion Preview mode more robust in face of
misbehaving `completion-at-point-functions`, and adds some tests.
Thanks,
Eshel
--=-=-=
Content-Type: text/patch
Content-Disposition: attachment;
filename=0001-Improve-and-add-tests-for-Completion-Preview-mode.patch
From f6a4eac72e8439ad61a2d71e8e376db0d9d55064 Mon Sep 17 00:00:00 2001
From: Eshel Yaron <me@HIDDEN>
Date: Sun, 19 Nov 2023 10:55:15 +0100
Subject: [PATCH] ; Improve and add tests for Completion Preview mode
Fix handling of capfs that return a function or signal an error,
respect the ':exclusive' completion property, fix lingering "exact"
face after deletion that makes the matches non-exact, and add tests.
* lisp/completion-preview.el (completion-preview--make-overlay): Only
reuse the previous 'after-string' if it has the right face.
(completion-preview--try-table)
(completion-preview--capf-wrapper): New functions.
(completion-preview--update): Use them.
* test/lisp/completion-preview-tests.el: New file.
---
lisp/completion-preview.el | 114 ++++++++++------
test/lisp/completion-preview-tests.el | 184 ++++++++++++++++++++++++++
2 files changed, 257 insertions(+), 41 deletions(-)
create mode 100644 test/lisp/completion-preview-tests.el
diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index 6048d5be272..2b81dc5cd61 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -155,7 +155,9 @@ completion-preview--make-overlay
(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))
+ (unless (and previous (string= previous string)
+ (eq (get-text-property 0 'face previous)
+ (get-text-property 0 'face string)))
(add-text-properties 0 1 '(cursor 1) string)
(overlay-put completion-preview--overlay 'after-string string))
completion-preview--overlay))
@@ -178,48 +180,78 @@ completion-preview--exit-function
(completion-preview-active-mode -1)
(when (functionp func) (apply func args))))
+(defun completion-preview--try-table (table beg end props)
+ "Check TABLE for a completion matching the text between BEG and END.
+
+PROPS is a property list with additional information about TABLE.
+See `completion-at-point-functions' for more details.
+
+When TABLE contains a matching completion, return a list
+\(PREVIEW BEG END ALL EXIT-FN) where PREVIEW is the text to show
+in the completion preview, ALL is the list of all matching
+completion candidates, and EXIT-FN is either a function to call
+after inserting PREVIEW or nil. When TABLE does not contain
+matching completions, or when there are multiple matching
+completions and `completion-preview-exact-match-only' is non-nil,
+return nil instead."
+ (let* ((pred (plist-get props :predicate))
+ (exit-fn (completion-preview--exit-function
+ (plist-get props :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))
+ (prefix (substring string base)))
+ (when last
+ (setcdr last nil)
+ (when-let ((sorted (funcall sort-fn
+ (delete prefix (all-completions prefix all)))))
+ (unless (and (cdr sorted) completion-preview-exact-match-only)
+ (list (propertize (substring (car sorted) (length prefix))
+ 'face (if (cdr sorted)
+ 'completion-preview
+ 'completion-preview-exact))
+ (+ beg base) end sorted exit-fn))))))
+
+(defun completion-preview--capf-wrapper (capf)
+ "Translate output of CAPF to properties for completion preview overlay.
+
+If CAPF returns a list (BEG END TABLE . PROPS), call
+`completion-preview--try-table' to check TABLE for matching
+completion candidates. If `completion-preview--try-table'
+returns a non-nil value, return that value. Otherwise, return a
+list with nil car which means that completion failed, unless
+PROPS includes the property `:exclusive' with value `no', in
+which case this function returns nil which means to try other
+functions from `completion-at-point-functions'."
+ (unless (eq capf #'completion-preview--insert)
+ (let ((res (ignore-errors (funcall capf))))
+ (and (consp res)
+ (not (functionp res))
+ (seq-let (beg end table &rest plist) res
+ (or (completion-preview--try-table table beg end plist)
+ (and (not (eq 'no (plist-get plist :exclusive))) '(nil))))))))
+
(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)))))))))
+ (seq-let (preview beg end all exit-fn)
+ (run-hook-wrapped
+ 'completion-at-point-functions
+ #'completion-preview--capf-wrapper)
+ (when preview
+ (let ((ov (completion-preview--make-overlay end preview)))
+ (overlay-put ov 'completion-preview-beg beg)
+ (overlay-put ov 'completion-preview-end end)
+ (overlay-put ov 'completion-preview-index 0)
+ (overlay-put ov 'completion-preview-cands all)
+ (overlay-put ov 'completion-preview-exit-fn exit-fn)
+ (completion-preview-active-mode)))))
(defun completion-preview--show ()
"Show a new completion preview.
diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el
new file mode 100644
index 00000000000..b5518e96254
--- /dev/null
+++ b/test/lisp/completion-preview-tests.el
@@ -0,0 +1,184 @@
+;;; completion-preview-tests.el --- tests for completion-preview.el -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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.
+
+;; GNU Emacs 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 GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(require 'ert)
+(require 'completion-preview)
+
+(defun completion-preview-tests--capf (completions &rest props)
+ (lambda ()
+ (when-let ((bounds (bounds-of-thing-at-point 'symbol)))
+ (append (list (car bounds) (cdr bounds) completions) props))))
+
+(defun completion-preview-tests--check-preview (string &optional exact)
+ "Check that the completion preview is showing STRING.
+
+If EXACT is non-nil, check that STRING has the
+`completion-preview-exact' face. Otherwise check that STRING has
+the `completion-preview' face.
+
+If STRING is nil, check that there is no completion preview
+instead."
+ (if (not string)
+ (should (not completion-preview--overlay))
+ (should completion-preview--overlay)
+ (let ((after-string (completion-preview--get 'after-string)))
+ (should (string= after-string string))
+ (should (eq (get-text-property 0 'face after-string)
+ (if exact
+ 'completion-preview-exact
+ 'completion-preview))))))
+
+(ert-deftest completion-preview ()
+ "Test Completion Preview mode."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf '("foobarbaz"))))
+
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "barbaz" 'exact)
+
+ (insert "v")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; No match, no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+
+ ;; Exact match again
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-multiple-matches ()
+ "Test Completion Preview mode with multiple matching candidates."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, the preview shows the first one
+ (completion-preview-tests--check-preview "bar")
+
+ (completion-preview-next-candidate 1)
+
+ ;; Next match
+ (completion-preview-tests--check-preview "baz")))
+
+(ert-deftest completion-preview-exact-match-only ()
+ "Test `completion-preview-exact-match-only'."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list (completion-preview-tests--capf
+ '("spam" "foobar" "foobaz")))
+ completion-preview-exact-match-only t)
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Multiple matches, so no preview
+ (completion-preview-tests--check-preview nil)
+
+ (delete-region (point-min) (point-max))
+ (insert "spa")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+
+ ;; Exact match
+ (completion-preview-tests--check-preview "m" 'exact)))
+
+(ert-deftest completion-preview-function-capfs ()
+ "Test Completion Preview mode with capfs that return a function."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () #'ignore)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")))
+
+(ert-deftest completion-preview-non-exclusive-capfs ()
+ "Test Completion Preview mode with non-exclusive capfs."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("spam") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobar" "foobaz") :exclusive 'no)
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "bar")
+ (setq-local completion-preview-exact-match-only t)
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+(ert-deftest completion-preview-face-updates ()
+ "Test updating the face in completion preview when match is no longer exact."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (completion-preview-tests--capf
+ '("foobarbaz" "food"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")
+ (insert "b")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "arbaz" 'exact)
+ (delete-char -1)
+ (let ((this-command 'delete-backward-char))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "d")))
+
+(ert-deftest completion-preview-capf-errors ()
+ "Test Completion Preview mode with capfs that signal errors.
+
+`dabbrev-capf' is one example of such a capf."
+ (with-temp-buffer
+ (setq-local completion-at-point-functions
+ (list
+ (lambda () (user-error "bad"))
+ (completion-preview-tests--capf
+ '("foobarbaz"))))
+ (insert "foo")
+ (let ((this-command 'self-insert-command))
+ (completion-preview--post-command))
+ (completion-preview-tests--check-preview "barbaz" 'exact)))
+
+;;; completion-preview-tests.el ends here
--
2.42.0
--=-=-=--
Eshel Yaron <me@HIDDEN>:bug-gnu-emacs@HIDDEN.
Full text available.bug-gnu-emacs@HIDDEN:bug#67275; Package emacs.
Full text available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997 nCipher Corporation Ltd,
1994-97 Ian Jackson.