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" 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: References: <8334x2ko1y.fsf@gnu.org> Reply-To: Eshel Yaron 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 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: 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 ) 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 ) 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 ) 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 ) 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 ) 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 Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 19 Nov 2023 11:24:02 +0000 Resent-Message-ID: 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 ) 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 ) 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" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-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: --=-=-= Content-Type: text/plain Eli Zaretskii 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 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 . + +;;; 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 --=-=-=--