Minor improvements to new Completion Preview commands

* lisp/completion-preview.el (Commentary): Mention
`completion-preview-partial-insert' and elaborate about
`completion-preview-insert-sexp'.
(completion-preview--barf-if-no-preview): New function.
(completion-preview-insert, completion-preview-complete):
Use it.
(completion-preview-partial-insert): Rename arg to FUN; only
compute (+ end (length aft)) once; bind 'deactivate-mark' to
nil while inserting/deleting to allow commands that use this
function to work as expected with 'shift-select-mode';
improve behavior when called with point not at the start of
the completion preview overlay (e.g. when point is in the
middle of a multi-word symbol and this function is called
via 'completion-preview-insert-word'); add the base part of
the completion candidate to when calling exit-function.
(completion-preview-insert-word): Improve docsting, rename
argument ARG to N.
(completion-preview-insert-sexp): Likewise, and also remove
second argument INTERACTIVE.
(completion-preview--active-p): Rename to...
(completion-preview-active-p): ...this.  Make this function
public so users can leverage it for their own commands.
Extend docstring to explain how to do that.

* test/lisp/completion-preview-tests.el
(completion-preview-insert-calls-exit-function)
(completion-preview-insert-word): Break long lines.
(completion-preview-insert-sexp)
(completion-preview-insert-nonsubword)
(completion-preview-insert-subword): Fix docstrings.
(completion-preview-insert-mid-symbol): New test.

(cherry picked from commit 9cb2a2040888c28587bed2b0902d9da90720f9a0)

diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el
index f846a649e82df62a1e3d13a2b6521ff473c0e323..2a0d193e6f6cb75fc7fe6950a52670e7e4813c09 100644 (file)
--- a/lisp/completion-preview.el
+++ b/lisp/completion-preview.el
@@ -55,9 +55,22 @@
 ;; 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.
+;; completion preview.  To define your own command that inserts part of
+;; a completion candidate by moving "into" the completion preview, use
+;; the function `completion-preview-partial-insert'.  For example, you
+;; can define a command that completes exactly one symbol as follows:
+;;
+;;   (defun my-completion-preview-insert-symbol ()
+;;     (interactive)
+;;     (completion-preview-partial-insert #'forward-symbol 1))
+;;
+;; Similarly to `completion-preview-insert-word', the command
+;; `completion-preview-insert-sexp' lets you complete by one or more
+;; balanced expressions.  The definition of this command is very similar
+;; to the simple example above, expect it uses `forward-sexp' rather
+;; than `forward-symbol'.  This command can be useful when you're using
+;; Completion Preview mode with long, complex completion candidates,
+;; such as entire shell commands from the shell history.
 ;;
 ;; Completion Preview mode can change the cursor shape while displaying
 ;; the preview right after point.  By default, it uses a vertical bar
@@ -525,88 +538,98 @@ point, otherwise hide it."
           (completion-preview--show)
         (completion-preview-active-mode -1)))))
 
+(defun completion-preview--barf-if-no-preview ()
+  "Signal a `user-error' if completion preview is not active."
+  (unless completion-preview-active-mode
+    (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
+  (completion-preview--barf-if-no-preview)
+  (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))))
+
+(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."
+  (completion-preview--barf-if-no-preview)
+  (let* ((end (completion-preview--get 'completion-preview-end))
+         (aft (completion-preview--get 'after-string))
+         (eoc (+ end (length aft))))
+    ;; Partially insert current completion candidate.
+    (atomic-change-group
+      (let ((change-group (prepare-change-group))
+            ;; Keep region active, if it is already.  This allows
+            ;; commands such as `completion-preview-insert-word' to
+            ;; interact correctly with `shift-select-mode'.
+            (deactivate-mark nil))
+        (save-excursion
+          (goto-char end)
+          ;; Temporarily insert the full completion candidate.
+          (insert (substring-no-properties aft)))
+        ;; Set point to the end of the prefix that we want to keep.
+        (apply fun args)
+        ;; Delete the rest.
+        (delete-region (min (max end (point)) eoc) eoc)
+        ;; Combine into one change group
+        (undo-amalgamate-change-group change-group)))
+    ;; Cleanup.
+    (cond
+     ;; If we kept the entire completion candidate, call :exit-function.
+     ((<= eoc (point))
       (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))))
+             (efn (plist-get
+                   (completion-preview--get 'completion-preview-props)
+                   :exit-function)))
         (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")))
+        (when (functionp efn) (funcall efn (concat pre com (nth ind all))
+                                       'finished))))
+     ;; If we kept anything, update preview overlay accordingly.
+     ((< end (point))
+      (completion-preview--inhibit-update)
+      (overlay-put (completion-preview--make-overlay
+                    (point)
+                    (propertize
+                     (substring aft (- (point) end))
+                     'mouse-face 'completion-preview-highlight
+                     'keymap completion-preview--mouse-map))
+                   'completion-preview-end (point)))
+     ;; If we kept nothing, do nothing.
+     )))
+
+(defun completion-preview-insert-word (&optional n)
+  "Insert the first N words of the current completion preview candidate.
+
+Interactively, N is the numeric prefix argument, and it defaults to 1."
+  (interactive "^p")
+  (completion-preview-partial-insert #'forward-word n))
 
-(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-sexp (&optional n)
+  "Insert the first N s-expressions of the current completion preview candidate.
 
-(defun completion-preview-insert-word (&optional arg)
-  "Insert the next word of the completion candidate that the preview is showing."
+Interactively, N is the numeric prefix argument, and it defaults to 1."
   (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))
+  (completion-preview-partial-insert #'forward-sexp n 'interactive))
 
 (defun completion-preview-complete ()
   "Complete up to the longest common prefix of all completion candidates.
@@ -617,8 +640,7 @@ candidates unless `completion-auto-help' is nil.  If you repeat this
 command again when the completions list is visible, it scrolls the
 completions list."
   (interactive)
-  (unless completion-preview-active-mode
-    (user-error "No current completion preview"))
+  (completion-preview--barf-if-no-preview)
   (let* ((beg (completion-preview--get 'completion-preview-beg))
          (end (completion-preview--get 'completion-preview-end))
          (com (completion-preview--get 'completion-preview-common))
@@ -723,8 +745,12 @@ prefix argument and defaults to 1."
         (message (format-spec completion-preview-message-format
                               `((?i . ,(1+ new)) (?n . ,len))))))))
 
-(defun completion-preview--active-p (_symbol buffer)
-  "Check if the completion preview is currently shown in BUFFER."
+(defun completion-preview-active-p (_symbol buffer)
+  "Check if the completion preview is currently shown in BUFFER.
+
+The first argument, SYMBOL, is ignored.  You can use this function as
+the `completion-predicate' property of commands that you define that
+should only be available when the completion preview is active."
   (buffer-local-value 'completion-preview-active-mode buffer))
 
 (dolist (cmd '(completion-preview-insert
@@ -733,7 +759,7 @@ prefix argument and defaults to 1."
                completion-preview-complete
                completion-preview-prev-candidate
                completion-preview-next-candidate))
-  (put cmd 'completion-predicate #'completion-preview--active-p))
+  (put cmd 'completion-predicate #'completion-preview-active-p))
 
 ;;;###autoload
 (define-minor-mode completion-preview-mode

diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el
index 6809c7e1320e19e6690e751597d8dc7d5eab209f..35b69681ce694831c8a192b265f8cd717d18efad 100644 (file)
--- a/test/lisp/completion-preview-tests.el
+++ b/test/lisp/completion-preview-tests.el
@@ -301,7 +301,8 @@ instead."
       (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-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)
@@ -309,7 +310,7 @@ instead."
       (should-not exit-fn-args))))
 
 (ert-deftest completion-preview-insert-nonsubword ()
-  "Test that `completion-preview-insert-word' properly inserts just a word."
+  "Test that `completion-preview-insert-word' with `subword-mode' off."
   (let ((exit-fn-called nil) (exit-fn-args nil))
     (with-temp-buffer
       (setq-local completion-at-point-functions
@@ -323,7 +324,8 @@ instead."
       (insert "foo")
       (let ((this-command 'self-insert-command))
         (completion-preview--post-command))
-      (completion-preview-tests--check-preview "barBar" 'completion-preview-common)
+      (completion-preview-tests--check-preview "barBar"
+                                               'completion-preview-common)
       (completion-preview-insert-word)
       (should (string= (buffer-string) "foobarBar"))
       (should-not completion-preview--overlay)
@@ -331,7 +333,7 @@ instead."
       (should (equal exit-fn-args '("foobarBar" finished))))))
 
 (ert-deftest completion-preview-insert-subword ()
-  "Test that `completion-preview-insert-word' properly inserts just a word."
+  "Test that `completion-preview-insert-word' with `subword-mode' on."
   (let ((exit-fn-called nil) (exit-fn-args nil))
     (with-temp-buffer
       (subword-mode)
@@ -346,15 +348,48 @@ instead."
       (insert "foo")
       (let ((this-command 'self-insert-command))
         (completion-preview--post-command))
-      (completion-preview-tests--check-preview "barBar" 'completion-preview-common)
+      (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-mid-symbol ()
+  "Test `completion-preview-insert-word' when point is in a mulit-word symbol."
+  (with-temp-buffer
+    (setq-local completion-at-point-functions
+                (list
+                 (completion-preview-tests--capf
+                  '("foo-bar-baz-spam"))))
+    (insert "foo-bar-baz-")
+    (goto-char 4)
+    (let ((this-command 'self-insert-command))
+      (completion-preview--post-command))
+    (completion-preview-tests--check-preview "spam"
+                                             'completion-preview-exact
+                                             'completion-preview-exact)
+    (completion-preview-insert-word 2)
+    (let ((this-command 'self-insert-command))
+      (completion-preview--post-command))
+    ;; Moving two words forward should land at the end of baz, without
+    ;; inserting anything from the completion candidate.
+    (completion-preview-tests--check-preview "spam"
+                                             'completion-preview-exact
+                                             'completion-preview-exact)
+    (should (= (point) 12))
+    (completion-preview-insert-word -2)
+    ;; Moving backward shouldn't change anything, either.
+    (let ((this-command 'self-insert-command))
+      (completion-preview--post-command))
+    (completion-preview-tests--check-preview "spam"
+                                             'completion-preview-exact
+                                             'completion-preview-exact)
+    (should (= (point) 5))))
+
 (ert-deftest completion-preview-insert-sexp ()
-  "Test that `completion-preview-insert-word' properly inserts just a sexp."
+  "Test that `completion-preview-insert-sexp' properly inserts just a sexp."
   (let ((exit-fn-called nil) (exit-fn-args nil))
     (with-temp-buffer
       (setq-local completion-at-point-functions
@@ -368,7 +403,8 @@ instead."
       (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-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)