Subject: Re: bug#71716: [PATCH] Add new completion-preview-insert-{word, sexp} commands

From: Jules Tamagnan <[email-masked]>
Date: Sun, 23 Jun 2024 15:08:43 -0700

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 <[email-masked]> 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.

>From 89c552df4704f12bfdac8f05fd04b72bc91efccf Mon Sep 17 00:00:00 2001
From: Jules Tamagnan <[email-masked]>
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
+  ;; "<remap> <forward-word>" #'completion-preview-insert-word
+  ;; "<remap> <forward-sexp>" #'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
>From 7fd70fb330e0623636729657b17a9cdac3841a3d Mon Sep 17 00:00:00 2001
From: Jules Tamagnan <[email-masked]>
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
+  ;; "<remap> <forward-word>" #'completion-preview-insert-word
+  ;; "<remap> <forward-sexp>" #'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

Best,
Jules