From mboxrd@z Thu Jan  1 00:00:00 1970
Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail
From: Eshel Yaron via "Bug reports for GNU Emacs,
 the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org>
Newsgroups: gmane.emacs.bugs
Subject: bug#67275: [PATCH] ; Improve and add tests for Completion Preview mode
Date: Sun, 19 Nov 2023 12:23:16 +0100
Message-ID: <m1jzqe9ecb.fsf@dazzs-mbp.home>
References: <m1sf529gzw.fsf@dazzs-mbp.home> <8334x2ko1y.fsf@gnu.org>
Reply-To: Eshel Yaron <me@eshelyaron.com>
Mime-Version: 1.0
Content-Type: multipart/mixed; boundary="=-=-="
Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214";
	logging-data="12337"; mail-complaints-to="usenet@ciao.gmane.io"
User-Agent: Gnus/5.13 (Gnus v5.13)
Cc: 67275@debbugs.gnu.org
To: Eli Zaretskii <eliz@gnu.org>
Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Nov 19 12:24:14 2023
Return-path: <bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org>
Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org
Original-Received: from lists.gnu.org ([209.51.188.17])
	by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256)
	(Exim 4.92)
	(envelope-from <bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org>)
	id 1r4fuQ-0002zu-BX
	for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 19 Nov 2023 12:24:14 +0100
Original-Received: from localhost ([::1] helo=lists1p.gnu.org)
	by lists.gnu.org with esmtp (Exim 4.90_1)
	(envelope-from <bug-gnu-emacs-bounces@gnu.org>)
	id 1r4fuE-0004g3-Nt; Sun, 19 Nov 2023 06:24:02 -0500
Original-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 <Debian-debbugs@debbugs.gnu.org>)
 id 1r4fuD-0004fn-9E
 for bug-gnu-emacs@gnu.org; Sun, 19 Nov 2023 06:24:01 -0500
Original-Received: from debbugs.gnu.org ([2001:470:142:5::43])
 by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128)
 (Exim 4.90_1) (envelope-from <Debian-debbugs@debbugs.gnu.org>)
 id 1r4fuD-0005Oc-0Z
 for bug-gnu-emacs@gnu.org; Sun, 19 Nov 2023 06:24:01 -0500
Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2)
 (envelope-from <Debian-debbugs@debbugs.gnu.org>) id 1r4fuE-0008Qm-CV
 for bug-gnu-emacs@gnu.org; Sun, 19 Nov 2023 06:24:02 -0500
X-Loop: help-debbugs@gnu.org
Resent-From: Eshel Yaron <me@eshelyaron.com>
Original-Sender: "Debbugs-submit" <debbugs-submit-bounces@debbugs.gnu.org>
Resent-CC: bug-gnu-emacs@gnu.org
Resent-Date: Sun, 19 Nov 2023 11:24:02 +0000
Resent-Message-ID: <handler.67275.B67275.170039300432347@debbugs.gnu.org>
Resent-Sender: help-debbugs@gnu.org
X-GNU-PR-Message: followup 67275
X-GNU-PR-Package: emacs
X-GNU-PR-Keywords: patch
Original-Received: via spool by 67275-submit@debbugs.gnu.org id=B67275.170039300432347
 (code B ref 67275); Sun, 19 Nov 2023 11:24:02 +0000
Original-Received: (at 67275) by debbugs.gnu.org; 19 Nov 2023 11:23:24 +0000
Original-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@debbugs.gnu.org>)
 id 1r4ftb-0008Pd-7l
 for submit@debbugs.gnu.org; Sun, 19 Nov 2023 06:23:24 -0500
Original-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@eshelyaron.com>) id 1r4ftY-0008PS-AM
 for 67275@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==
In-Reply-To: <8334x2ko1y.fsf@gnu.org> (Eli Zaretskii's message of "Sun, 19 Nov
 2023 12:58:01 +0200")
X-BeenThere: debbugs-submit@debbugs.gnu.org
X-Mailman-Version: 2.1.18
Precedence: list
X-BeenThere: bug-gnu-emacs@gnu.org
List-Id: "Bug reports for GNU Emacs,
 the Swiss army knife of text editors" <bug-gnu-emacs.gnu.org>
List-Unsubscribe: <https://lists.gnu.org/mailman/options/bug-gnu-emacs>,
 <mailto:bug-gnu-emacs-request@gnu.org?subject=unsubscribe>
List-Archive: <https://lists.gnu.org/archive/html/bug-gnu-emacs>
List-Post: <mailto:bug-gnu-emacs@gnu.org>
List-Help: <mailto:bug-gnu-emacs-request@gnu.org?subject=help>
List-Subscribe: <https://lists.gnu.org/mailman/listinfo/bug-gnu-emacs>,
 <mailto:bug-gnu-emacs-request@gnu.org?subject=subscribe>
Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org
Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org
Xref: news.gmane.io gmane.emacs.bugs:274610
Archived-At: <http://permalink.gmane.org/gmane.emacs.bugs/274610>

--=-=-=
Content-Type: text/plain

Eli Zaretskii <eliz@gnu.org> 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@eshelyaron.com>
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


--=-=-=--