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

From: Jules Tamagnan <[email-masked]>
Date: Sat, 22 Jun 2024 02:11:18 -0700

Tags: patch

* Problem

Oftentimes when completing a value a user wants a small part of a
completion but not the entire thing. This happens frequently when
iterating on shell commands or on similar lines of
code. completion-preview can help with this by quickly suggesting a
sensible completion pulled from any completion-at-point function. The
problem is that accepting a full completion is often inefficient because
one might only want the first part of that completion. This leads to a
lot of deletions after the fact.

* Solution

Allow inserting of partial completions when using
completion-preview. For this I've added two new commands
completion-preview-insert-word and completion-preview-insert-sexp which
will insert the next word or sexp in the completion. For consistency
with completion-preview-insert I've refactored the code so that these
three commands share a common code path.

* Notes

 - I've added new tests for this and ensured that previous ones continue
   to pass.   
 - I've signed the copyright assignments and have contributed to emacs
   previously.

* Info

In GNU Emacs 30.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version
3.24.42, cairo version 1.18.0)
Repository revision: 988203fe980e3c80f736ad0b6aae9f288ebfa0f1
Repository branch: master
Windowing system distributor 'The X.Org Foundation', version 11.0.12101013
System Description: NixOS 24.11 (Vicuna)

Configured using:
 'configure
 --prefix=/nix/store/3riplzxicrgaff4jm49wa4vvvrd6yd1l-emacs-git-20240615.0
 --disable-build-details --with-modules --with-x-toolkit=gtk3
 --with-cairo --with-xft --with-compress-install
 --with-toolkit-scroll-bars --with-native-compilation
 --without-imagemagick --with-mailutils --without-small-ja-dic
 --with-tree-sitter --with-xinput2 --with-xwidgets --with-dbus
 --with-selinux'

>From d78a9a4209d050dcb2a410610d70840d35b9b722 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            | 56 +++++++++++++++++++--------
 test/lisp/completion-preview-tests.el | 52 +++++++++++++++++++++++--
 2 files changed, 88 insertions(+), 20 deletions(-)

diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index caebb9d01e3..3a7fa37afe0 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 ()
@@ -444,24 +448,42 @@ completion-preview--post-command
           (completion-preview--show)
         (completion-preview-active-mode -1)))))
 
+(defun completion-preview--insert (action)
+  "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))
+             (ful (completion-preview--get 'after-string))
+             (aft (with-temp-buffer
+                      (insert ful)
+                      (goto-char (point-min))
+                      (funcall action)
+                      (buffer-substring-no-properties (point-min) (point)))))
+        (completion-preview-active-mode -1)
+        (goto-char end)
+        (insert aft)
+        (when (and (functionp efn) (string= ful aft))
+          ;; If we've inserted a full completion call the exit-function
+          (funcall efn (concat (buffer-substring-no-properties beg end) aft) 'finished)))
+    (user-error "No current completion preview")))
+
 (defun completion-preview-insert ()
   "Insert the completion candidate that the preview is showing."
   (interactive)
-  (if completion-preview-active-mode
-      (let* ((pre (completion-preview--get 'completion-preview-base))
-             (end (completion-preview--get 'completion-preview-end))
-             (ind (completion-preview--get 'completion-preview-index))
-             (all (completion-preview--get 'completion-preview-suffixes))
-             (com (completion-preview--get 'completion-preview-common))
-             (efn (plist-get (completion-preview--get 'completion-preview-props)
-                             :exit-function))
-             (aft (completion-preview--get 'after-string))
-             (str (concat pre com (nth ind all))))
-        (completion-preview-active-mode -1)
-        (goto-char end)
-        (insert (substring-no-properties aft))
-        (when (functionp efn) (funcall efn str 'finished)))
-    (user-error "No current completion preview")))
+  (completion-preview--insert #'end-of-buffer))
+
+(defun completion-preview-insert-word ()
+  "Insert the next word of the completion candidate that the preview is showing."
+  (interactive)
+  (completion-preview--insert #'forward-word))
+
+(defun completion-preview-insert-sexp ()
+  "Insert the next sexp of the completion candidate that the preview is showing."
+  (interactive)
+  (completion-preview--insert #'forward-sexp))
 
 (defun completion-preview-complete ()
   "Complete up to the longest common prefix of all completion candidates.
@@ -583,6 +605,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..dedd135da73 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,55 @@ 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"))
+      (should-not completion-preview--overlay)
+      (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"))
+      (should-not completion-preview--overlay)
+      (should-not exit-fn-called)
+      (should-not exit-fn-args))))
 
 ;;; completion-preview-tests.el ends here
-- 
2.45.1