From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Jules Tamagnan Newsgroups: gmane.emacs.bugs Subject: bug#71716: [PATCH] Add new completion-preview-insert-{word, sexp} commands Date: Sun, 23 Jun 2024 15:08:43 -0700 Message-ID: <87r0cn5n2s.fsf@gmail.com> References: <87a5jd8hqh.fsf@gmail.com> <877ceg9546.fsf@gmail.com> <874j9k8wpo.fsf@gmail.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="39878"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 71716@debbugs.gnu.org To: Eshel Yaron Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Jun 24 00:10:17 2024 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 1sLVPd-000A8N-5E for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 24 Jun 2024 00:10:17 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sLVPO-0000EJ-HX; Sun, 23 Jun 2024 18:10:02 -0400 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 1sLVPN-0000E5-Cq for bug-gnu-emacs@gnu.org; Sun, 23 Jun 2024 18:10:01 -0400 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 1sLVPN-0007KO-4W for bug-gnu-emacs@gnu.org; Sun, 23 Jun 2024 18:10:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sLVPN-0003Zo-N2 for bug-gnu-emacs@gnu.org; Sun, 23 Jun 2024 18:10:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Jules Tamagnan Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 23 Jun 2024 22:10:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 71716 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 71716-submit@debbugs.gnu.org id=B71716.171918059913732 (code B ref 71716); Sun, 23 Jun 2024 22:10:01 +0000 Original-Received: (at 71716) by debbugs.gnu.org; 23 Jun 2024 22:09:59 +0000 Original-Received: from localhost ([127.0.0.1]:53687 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sLVPJ-0003ZL-6N for submit@debbugs.gnu.org; Sun, 23 Jun 2024 18:09:58 -0400 Original-Received: from mail-pl1-f180.google.com ([209.85.214.180]:42328) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sLVPG-0003Yt-8Y for 71716@debbugs.gnu.org; Sun, 23 Jun 2024 18:09:55 -0400 Original-Received: by mail-pl1-f180.google.com with SMTP id d9443c01a7336-1f4a5344ec7so24173055ad.1 for <71716@debbugs.gnu.org>; Sun, 23 Jun 2024 15:09:53 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1719180528; x=1719785328; darn=debbugs.gnu.org; h=mime-version:message-id:date:user-agent:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=zkslLIlpr+DhYJQurg/kQaaRa12NHPaS23jvnyCykSU=; b=XafPN2q88h/hs8KwFM9WJbfRtblgRXrRaCOjSkJZ91yGmvfducf4N/UqorNMI0VzjL X2zBeawwopyXGWXQi4sIkVuVkXRnQLJXROcNO5sVjwQ0jv8lah/6ffQyMaI5ZGgz4YkK JcpcI21k0ROs3qDSijlMMCFLKAZOn5FW4dRsx5GZKvwmkAhKMljJLyeLXI/e2g78YY7l K2ZNLTwGNLOwLL9cnhiBVvXtHpA5yvfLTLduvpG6YEpQs+3MYohpf59zyQinluZQVqvR tftVUPVGJsc6XvRMl34YQmI7gzpfLdNse3fqfRpNngLWw0UMVEpUAv4YtRqr+QCbv424 aYWA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1719180528; x=1719785328; h=mime-version:message-id:date:user-agent:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=zkslLIlpr+DhYJQurg/kQaaRa12NHPaS23jvnyCykSU=; b=oruZyu07GFMZP1GPOOSt/MCUK2QafpD2yEGzT7o6I2YZrgBggoDYHtVaO9gBOqZThx enJOWxHYdkY8+15WPnxZCQiq/oMKMev/RBvZdJVTJmfo+NiJ4n3QihFlt/B7bPjUNckE 1aek4S7wiMkTPWyLPYNt0vYg4mjknl4BQ7yNU7MlewLxTiCxIJAQ8wJ8a7ig5H+UAHEH yeif7P8CVdAhCLBxqCx1ugqrv5vFFjzBuYL93Wq1bXlO8IiA+JUx6dkIaeDqLyl4NBId wW1u3Py+WrXaOyccP5TM2mae5kpyAqVKdvheWTm9qz938k2GXQGm3rb4PPZ0UqiIVNz4 bfaA== X-Gm-Message-State: AOJu0YzDHiVWxiVC68b/ex9SgRgE8Wa+3X9eLGUSMGeLCAJav1iRcuAG hPd3ufnS7WQZgLIYfGMnLa2X340iHGvci2jfoaZc4ilQgDlinYbSj7Uljg== X-Google-Smtp-Source: AGHT+IGqrdlDfjs2Di7XzuoDSoi+/oFlPlcphIfh5F0preo6YVamutu5fHPYMSPpgeJhIoi6E5qJ/A== X-Received: by 2002:a17:903:187:b0:1fa:2c79:74fe with SMTP id d9443c01a7336-1fa2c7975f8mr17237565ad.42.1719180527174; Sun, 23 Jun 2024 15:08:47 -0700 (PDT) Original-Received: from jat-framework (c-73-189-85-43.hsd1.ca.comcast.net. [73.189.85.43]) by smtp.gmail.com with ESMTPSA id d9443c01a7336-1f9ebbb2b06sm49195045ad.262.2024.06.23.15.08.45 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sun, 23 Jun 2024 15:08:45 -0700 (PDT) In-Reply-To: (Eshel Yaron's message of "Sun, 23 Jun 2024 10:00:24 +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:287804 Archived-At: --=-=-= Content-Type: text/plain Hi Eshel, I just want to start off once again by saying thank you for the thoughtful review, help, testing, and encouragement. I'll start by responding to the previous email and then go on to explain the two attached patches. --- Eshel Yaron writes: > Right. And when considering sexps, forward-sexp-function can come into > play, which might take into account all sorts of buffer-local variables. Yeah.. I can imagine this become a frustrating game of whack-a-mole. > I think that might be the way to go, actually. Placing the after-string > insertion and subsequent deletion in an atomic change group (and using > undo-amalgamate-change-group to let the user undo everything in one go) > should hopefully work just as well, and that would alleviate the need to > chase down and replicate complex buffer state in the temporary buffer. I took a stab at implementing this. I didn't fiddle with `undo-amalgamate-change-group` but it seems like it wasn't required to get what felt like sensible behavior. > I think that'd be best, yes. Let's keep completion-preview-insert > intact for the time being and see if we there's room for cleanly > consolidating it with the new commands after we get them right. That sounds great no need to make things too complicated. > I'll give it a try, thanks. Thank you > In the future if you could squash all changes to a single patch I > think that'd make it easiest to review. That sounds great. I'll keep that in mind when presenting the next changesets. --- Okay now onto the latest patches. Both patches have reverted the changes to `completion-preview-insert` and both patches pass the same set of unit tests. The first patch `completion-preview-partial-insertion-with-temp-buffer.patch` is the same as the previous patch but with two critical changes: the revert, and the addition of a new variable `completion-preview-context-variables` which can be used to customize the list of variables to copy into the temporary buffer. The second patch `completion-preview-partial-insertion-with-region-delete.patch` is the version of the change that uses in-buffer deletion. There's not much to say here, it seems quite a bit more robust. I reckon the second patch is more in line with what you had in mind but I wanted to bring the first approach to a more acceptable state. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=completion-preview-partial-insertion-with-temp-buffer.patch Content-Description: New partial insertion functions implemented with a temporary buffer >From 89c552df4704f12bfdac8f05fd04b72bc91efccf Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Sat, 22 Jun 2024 00:45:01 -0700 Subject: [PATCH] Add new completion-preview-insert-{word,sexp} commands * lisp/completion-preview.el: Add new completion-preview-insert-word and completion-preview-insert-sexp commands. * test/lisp/completion-preview-tests.el: Add tests for new commands. --- lisp/completion-preview.el | 82 +++++++++++++++++++++- test/lisp/completion-preview-tests.el | 97 +++++++++++++++++++++++++-- 2 files changed, 174 insertions(+), 5 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index caebb9d01e3..49f40eb5a68 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -90,11 +90,22 @@ completion-preview-commands delete-backward-char backward-delete-char-untabify analyze-text-conversion - completion-preview-complete) + completion-preview-complete + completion-preview-insert-word + completion-preview-insert-sexp) "List of commands that should trigger completion preview." :type '(repeat (function :tag "Command" :value self-insert-command)) :version "30.1") +(defcustom completion-preview-context-variables '(char-script-table + forward-sexp-function + find-word-boundary-function-table + inhibit-field-text-motion) + "List of variables which can change the functionality of `forward-word' +or `forward-sexp'." + :type '(repeat (variable :tag "Variable" :value char-script-table)) + :version "30.1") + (defcustom completion-preview-minimum-symbol-length 3 "Minimum length of the symbol at point for showing completion preview. @@ -163,6 +174,8 @@ completion-preview-active-mode-map "M-i" #'completion-preview-complete ;; "M-n" #'completion-preview-next-candidate ;; "M-p" #'completion-preview-prev-candidate + ;; " " #'completion-preview-insert-word + ;; " " #'completion-preview-insert-sexp ) (defun completion-preview--ignore () @@ -463,6 +476,71 @@ completion-preview-insert (when (functionp efn) (funcall efn str 'finished))) (user-error "No current completion preview"))) +(defun completion-preview--determine-substring (command string) + "A helper function to determine what parts of a STRING come before and +after the point when a certain COMMAND has been performed on that STRING" + ;; Determine the parent buffer + (let ((parent-buffer (current-buffer))) + (with-temp-buffer + ;; Certain locally set variables can affect common movement + ;; commands such as `forward-word'; determine their values from + ;; the parent buffer and set them in the temporary buffer. + (dolist (context-variable completion-preview-context-variables) + (make-variable-buffer-local context-variable) + (set context-variable (buffer-local-value context-variable parent-buffer))) + + (insert string) + (goto-char (point-min)) + (funcall command) + (cons (buffer-substring-no-properties (point-min) (point)) + (buffer-substring (point) (point-max)))))) + +(defun completion-preview--insert-partial (command) + "A helper function to insert part of the completion candidate that the +preview is showing." + (if completion-preview-active-mode + (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) + (efn (plist-get (completion-preview--get 'completion-preview-props) + :exit-function)) + (aft (completion-preview--get 'after-string)) + (ful (completion-preview--determine-substring command aft)) + (ins (car ful)) + (suf (cdr ful))) + ;; If the completion is a full completion (there is no suffix) + ;; deactivate the preview + (when (string-empty-p suf) + (completion-preview-active-mode -1)) + + ;; Insert the new text + (goto-char end) + (insert ins) + + ;; If we are not inserting a full completion update the preview + (when (not (string-empty-p suf)) + (let ((pos (point))) + (completion-preview--inhibit-update) + (overlay-put (completion-preview--make-overlay + pos (propertize suf + 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map)) + 'completion-preview-end pos))) + + ;; If we've inserted a full completion call the exit-function + (when (and (functionp efn) (string-empty-p suf)) + (funcall efn (concat (buffer-substring-no-properties beg end) ins) 'finished))) + (user-error "No current completion preview"))) + +(defun completion-preview-insert-word () + "Insert the next word of the completion candidate that the preview is showing." + (interactive) + (completion-preview--insert-partial #'forward-word)) + +(defun completion-preview-insert-sexp () + "Insert the next sexp of the completion candidate that the preview is showing." + (interactive) + (completion-preview--insert-partial #'forward-sexp)) + (defun completion-preview-complete () "Complete up to the longest common prefix of all completion candidates. @@ -583,6 +661,8 @@ completion-preview--active-p (buffer-local-value 'completion-preview-active-mode buffer)) (dolist (cmd '(completion-preview-insert + completion-preview-insert-word + completion-preview-insert-sexp completion-preview-complete completion-preview-prev-candidate completion-preview-next-candidate)) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 7d358d07519..1c8a04c765d 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -292,7 +292,7 @@ completion-preview-insert-calls-exit-function (setq-local completion-at-point-functions (list (completion-preview-tests--capf - '("foobar" "foobaz") + '("foobar-1 2" "foobarverylong") :exit-function (lambda (&rest args) (setq exit-fn-called t @@ -300,11 +300,100 @@ completion-preview-insert-calls-exit-function (insert "foo") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "bar" 'completion-preview-common) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) (completion-preview-insert) - (should (string= (buffer-string) "foobar")) + (should (string= (buffer-string) "foobar-1 2")) (should-not completion-preview--overlay) (should exit-fn-called) - (should (equal exit-fn-args '("foobar" finished)))))) + (should (equal exit-fn-args '("foobar-1 2" finished)))))) + +(ert-deftest completion-preview-insert-word () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar-1 2" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobar")) + (completion-preview-tests--check-preview "-1 2" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) + +(ert-deftest completion-preview-insert-nonsubword () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobarBar" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "barBar" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobarBar")) + (should-not completion-preview--overlay) + (should exit-fn-called) + (should (equal exit-fn-args '("foobarBar" finished)))))) + +(ert-deftest completion-preview-insert-subword () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (subword-mode) + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobarBar" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "barBar" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobar")) + (completion-preview-tests--check-preview "Bar" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) + +(ert-deftest completion-preview-insert-sexp () + "Test that `completion-preview-insert-word' properly inserts just a sexp." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar-1 2" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) + (completion-preview-insert-sexp) + (should (string= (buffer-string) "foobar-1")) + (completion-preview-tests--check-preview " 2" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) ;;; completion-preview-tests.el ends here -- 2.45.1 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=completion-preview-partial-insertion-with-region-delete.patch Content-Description: New partial insertion functions implemented with in-buffer deletion >From 7fd70fb330e0623636729657b17a9cdac3841a3d Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Sat, 22 Jun 2024 00:45:01 -0700 Subject: [PATCH] Add new completion-preview-insert-{word,sexp} commands * lisp/completion-preview.el: Add new completion-preview-insert-word and completion-preview-insert-sexp commands. * test/lisp/completion-preview-tests.el: Add tests for new commands. --- lisp/completion-preview.el | 59 +++++++++++++++- test/lisp/completion-preview-tests.el | 97 +++++++++++++++++++++++++-- 2 files changed, 151 insertions(+), 5 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index caebb9d01e3..e94baab4508 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -90,7 +90,9 @@ completion-preview-commands delete-backward-char backward-delete-char-untabify analyze-text-conversion - completion-preview-complete) + completion-preview-complete + completion-preview-insert-word + completion-preview-insert-sexp) "List of commands that should trigger completion preview." :type '(repeat (function :tag "Command" :value self-insert-command)) :version "30.1") @@ -163,6 +165,8 @@ completion-preview-active-mode-map "M-i" #'completion-preview-complete ;; "M-n" #'completion-preview-next-candidate ;; "M-p" #'completion-preview-prev-candidate + ;; " " #'completion-preview-insert-word + ;; " " #'completion-preview-insert-sexp ) (defun completion-preview--ignore () @@ -463,6 +467,57 @@ completion-preview-insert (when (functionp efn) (funcall efn str 'finished))) (user-error "No current completion preview"))) +(defun completion-preview--insert-partial (command) + "A helper function to insert part of the completion candidate that the +preview is showing." + (if completion-preview-active-mode + (let* ((beg (completion-preview--get 'completion-preview-beg)) + (end (completion-preview--get 'completion-preview-end)) + (efn (plist-get (completion-preview--get 'completion-preview-props) + :exit-function)) + (aft (completion-preview--get 'after-string)) + (new-end) + (full-end)) + ;; Insert the new text + (goto-char end) + (insert aft) + (setq full-end (point)) + + ;; Use the movement command to go to a new location in the buffer + (goto-char end) + (funcall command) + (setq new-end (point)) + + (if (< new-end full-end) + ;; The movement command has not taken us to the end of the + ;; initial insertion this means that a partial completion + ;; occured. + (progn + (completion-preview--inhibit-update) + ;; If we are not inserting a full completion update the preview + (overlay-put (completion-preview--make-overlay + new-end (propertize (delete-and-extract-region full-end new-end) + 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map)) + 'completion-preview-end new-end)) + ;; The movement command has taken us to the end of the + ;; completion or past it which signifies a full completion. + (goto-char full-end) + (completion-preview-active-mode -1) + (when (functionp efn) + (funcall efn (concat (buffer-substring-no-properties beg end) aft) 'finished)))) + (user-error "No current completion preview"))) + +(defun completion-preview-insert-word () + "Insert the next word of the completion candidate that the preview is showing." + (interactive) + (completion-preview--insert-partial #'forward-word)) + +(defun completion-preview-insert-sexp () + "Insert the next sexp of the completion candidate that the preview is showing." + (interactive) + (completion-preview--insert-partial #'forward-sexp)) + (defun completion-preview-complete () "Complete up to the longest common prefix of all completion candidates. @@ -583,6 +638,8 @@ completion-preview--active-p (buffer-local-value 'completion-preview-active-mode buffer)) (dolist (cmd '(completion-preview-insert + completion-preview-insert-word + completion-preview-insert-sexp completion-preview-complete completion-preview-prev-candidate completion-preview-next-candidate)) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 7d358d07519..1c8a04c765d 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -292,7 +292,7 @@ completion-preview-insert-calls-exit-function (setq-local completion-at-point-functions (list (completion-preview-tests--capf - '("foobar" "foobaz") + '("foobar-1 2" "foobarverylong") :exit-function (lambda (&rest args) (setq exit-fn-called t @@ -300,11 +300,100 @@ completion-preview-insert-calls-exit-function (insert "foo") (let ((this-command 'self-insert-command)) (completion-preview--post-command)) - (completion-preview-tests--check-preview "bar" 'completion-preview-common) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) (completion-preview-insert) - (should (string= (buffer-string) "foobar")) + (should (string= (buffer-string) "foobar-1 2")) (should-not completion-preview--overlay) (should exit-fn-called) - (should (equal exit-fn-args '("foobar" finished)))))) + (should (equal exit-fn-args '("foobar-1 2" finished)))))) + +(ert-deftest completion-preview-insert-word () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar-1 2" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobar")) + (completion-preview-tests--check-preview "-1 2" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) + +(ert-deftest completion-preview-insert-nonsubword () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobarBar" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "barBar" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobarBar")) + (should-not completion-preview--overlay) + (should exit-fn-called) + (should (equal exit-fn-args '("foobarBar" finished)))))) + +(ert-deftest completion-preview-insert-subword () + "Test that `completion-preview-insert-word' properly inserts just a word." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (subword-mode) + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobarBar" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "barBar" 'completion-preview-common) + (completion-preview-insert-word) + (should (string= (buffer-string) "foobar")) + (completion-preview-tests--check-preview "Bar" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) + +(ert-deftest completion-preview-insert-sexp () + "Test that `completion-preview-insert-word' properly inserts just a sexp." + (let ((exit-fn-called nil) (exit-fn-args nil)) + (with-temp-buffer + (setq-local completion-at-point-functions + (list + (completion-preview-tests--capf + '("foobar-1 2" "foobarverylong") + :exit-function + (lambda (&rest args) + (setq exit-fn-called t + exit-fn-args args))))) + (insert "foo") + (let ((this-command 'self-insert-command)) + (completion-preview--post-command)) + (completion-preview-tests--check-preview "bar-1 2" 'completion-preview-common) + (completion-preview-insert-sexp) + (should (string= (buffer-string) "foobar-1")) + (completion-preview-tests--check-preview " 2" 'completion-preview) + (should-not exit-fn-called) + (should-not exit-fn-args)))) ;;; completion-preview-tests.el ends here -- 2.45.1 --=-=-= Content-Type: text/plain Best, Jules --=-=-=--