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

[Jules Tamagnan <jtamagnan@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 5566 bytes --]

Eshel Yaron <me@eshelyaron.com> writes:

> One important point is that I'm a bit hesitant about adding the sexp
> variant, rather then defining only completion-preview-insert-word, and
> mentioning in the documentation that other variants are trivial to
> define (and how).  The reason is that I don't have a good idea of when
> a completion candidate would span multiple sexps (if you have such an
> example, please share it), so I'm not sure how much utility this
> command would bring in practice.

The use case that I have for the sexp variant is when completing eshell
history. Both because: parts of shell commands such as file names can be
considered sexp's, but also because eshell itself can interpret "full"
elisp forms.

On a similar note. Some similar tools additionally define a `forward-char`
variant. This is not something that I've found a need for personally but
would be willing to add for completeness.

>> From 7fd70fb330e0623636729657b17a9cdac3841a3d Mon Sep 17 00:00:00 2001
>> From: Jules Tamagnan <jtamagnan@gmail.com>
>> 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.
>
> It's best to single-quote symbols in the commit message, like 'this'.

Thank you. Done

>> +(defun completion-preview--insert-partial (command)
>
> This should be a public function (no --), to indicate that it's fine for
> users to use it in their own command definitions.  So either
> completion-preview-insert-partial or completion-preview-partial-insert.
> (I tend to prefer the latter, but both work.)

Thank you. Done

> Also, COMMAND should instead be FUN or FUNC, since the argument doesn't
> have to be command, any motion function would do.

Thank you. Done

> Lastly this command should also take &rest args and pass them to the
> function argument, to facilitate writing something like
> (c-p-partial-insert #'forward-word 2) to complete two words.

Thank you. Done

Another idea would be to turn `c-p-partial-insert` into a macro that
uses the `interactive-form` function to generate a sensible
insert-partial function. I'm more than happy to take this tweak on as
well.

> The first line of the docstring should be a full sentence.  We also want
> to describe accurately enough what this function does for users to be
> able to leverage it in their definitions.  I suggest:
>
> (defun completion-preview-partial-insert (fun &rest args)
>   "Insert part of the current completion preview candidate.
> This function calls FUN with arguments ARGS, after temporarily inserting
> the entire current completion preview candidate.  FUN should move point:
> if it moves point forward into the completion text, this function
> inserts the prefix of the completion candidate up to that point.
> Beyond moving point, FUN should not modify the current buffer."

Thank you. Done

> Better strip text properties from AFT before inserting it here.

Thank you. Done

There were two ways of implementing this that I could think of.

 1. Insert with properties, set `suf` to delete-and-extract-region to
    preserve the properties, use `(set-text-properties end (point) nil)`
    to remove the text properties from the deletion.
 2. Insert without text properties, use `delete-region`, set `suf` to a
     substring of `aft` directly

Both seem to work equally well, I've gone with option 2 because it seems
more consistent with what you had suggested.

> We should ensure that new-end isn't smaller then end, otherwise the
> deletion below won't do the right thing.

Thank you. Done

> This is a nice use of delete-and-extract-region, but the insertion and
> deletion must be inside an atomic-change-group, so we don't leave AFT
> inserted in case the motion function signals an error.  This is also
> where we need to add an undo-amalgamate-change-group, to prevent undo
> from seeing an unwanted intermediate step in case an undo-boundary is
> created between the insertion and the deletion.  So the structure should
> be something like:
>
> (atomic-change-group
>   (let ((change-group (prepare-change-group)))
>     ;; Insert,
>     ;; Move,
>     ;; Delete.
>     (undo-amalgamate-change-group change-group)))

Thank you. Done

I'm glad to better understand how this works now.

>> +(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))
>
> This should handle an optional numeric argument, like forward-word does.

Thank you. Done

> Finally, we should document completion-preview-insert-word in the
> Commentary section.  Here's the text I'd like to add, you can include it
> the patch (and change it as you see fit) or I'll add it later:
>
> ;; You can also insert only the first word of the completion candidate
> ;; with the command `completion-preview-insert-word'.  With a numeric
> ;; prefix argument, it inserts that many words instead of just the one.
> ;; This command is not bound by default, but you may want to bind it to
> ;; M-f (or remap `forward-word') in `completion-preview-active-mode-map'
> ;; since it's very much like a `forward-word' that also moves "into" the
> ;; completion preview.

Thank you. Done

At the end of the paragraph I've additionally added a brief note about
the `sexp` variant.

> Best,
>
> Eshel

Best,
Jules


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Full patch with addressed comments --]
[-- Type: text/x-patch, Size: 12140 bytes --]

From 74d8efceaf8f64f7cf61e36f8a5e8a4fc86e558d Mon Sep 17 00:00:00 2001
From: Jules Tamagnan <jtamagnan@gmail.com>
Date: Mon, 24 Jun 2024 08:53:23 -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..14c28b0c76b 100644
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -49,6 +49,16 @@
 ;; prefix (so nothing is underlined in the preview), it displays a list
 ;; of all matching completion candidates.
 ;;
+;; You can also insert only the first word of the completion candidate
+;; with the command `completion-preview-insert-word'.  With a numeric
+;; prefix argument, it inserts that many words instead of just the one.
+;; This command is not bound by default, but you may want to bind it to
+;; M-f (or remap `forward-word') in `completion-preview-active-mode-map'
+;; since it's very much like a `forward-word' that also moves "into" the
+;; completion preview. A similar command,
+;; `completion-preview-insert-sexp', exists for the `forward-sexp'
+;; command.
+;;
 ;; If you set the user option `completion-preview-exact-match-only' to
 ;; non-nil, Completion Preview mode only suggests a completion
 ;; candidate when its the only possible completion for the (partial)
@@ -90,7 +100,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 +175,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 +477,70 @@ completion-preview-insert
         (when (functionp efn) (funcall efn str 'finished)))
     (user-error "No current completion preview")))

+(defun completion-preview-partial-insert (function &rest args)
+  "Insert part of the current completion preview candidate.
+This function calls FUN with arguments ARGS, after temporarily inserting
+the entire current completion preview candidate.  FUN should move point:
+if it moves point forward into the completion text, this function
+inserts the prefix of the completion candidate up to that point.  Beyond
+moving point, FUN should not modify the current buffer."
+  (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))
+             (suf))
+        ;; Perform the insertion
+        (atomic-change-group
+          (let ((change-group (prepare-change-group)))
+            ;; Insert full completion
+            (goto-char end)
+            (insert (substring-no-properties aft))
+            ;; Move forward within the completion
+            (goto-char end)
+            (apply function args)
+            (when (< (point) end)
+              ;; If the movement function brought us backwards lurch
+              ;; forward to the original end
+              (goto-char end))
+            ;; Delete.
+            (when (< (point) (+ end (length aft)))
+              (delete-region (+ end (length aft)) (point))
+              (setq suf (substring aft (- (point) (+ end (length aft))) nil)))
+            ;; Combine into one change group
+            (undo-amalgamate-change-group change-group)))
+        ;; Perform any cleanup actions
+        (if suf
+            ;; The movement function 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
+                            (point) (propertize suf
+                                                'mouse-face 'completion-preview-highlight
+                                                'keymap completion-preview--mouse-map))
+                           'completion-preview-end (point)))
+          ;; The movement function has taken us to the end of the
+          ;; completion or past it which signifies a full completion.
+          (goto-char (+ end (length aft)))
+          (completion-preview-active-mode -1)
+          (when (functionp efn)
+            (funcall efn (buffer-substring-no-properties beg (point)) 'finished))))
+    (user-error "No current completion preview")))
+
+(defun completion-preview-insert-word (&optional arg)
+  "Insert the next word of the completion candidate that the preview is showing."
+  (interactive "^p")
+  (completion-preview-partial-insert #'forward-word arg))
+
+(defun completion-preview-insert-sexp (&optional arg interactive)
+  "Insert the next sexp of the completion candidate that the preview is showing."
+  (interactive "^p\nd")
+  (completion-preview-partial-insert #'forward-sexp arg interactive))
+
 (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