procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Minor improvements to new Completion Preview commands

Browse source 
* 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.
This commit is contained in:
Eshel Yaron 2024-06-26 11:06:52 +02:00
parent b3017e7c25
commit 9cb2a20408
No known key found for this signature in database
GPG key ID: EF3EE9CA35D78618
2 changed files with 150 additions and 87 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

184
lisp/completion-preview.el
View file

@ -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.
;;
;; If you set the user option `completion-preview-exact-match-only' to
;; non-nil, Completion Preview mode only suggests a completion
@ -458,88 +471,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
(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--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 (function &rest args)
(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."
(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")))
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))
(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)))
(completion-preview-active-mode -1)
(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 arg)
"Insert the next word of the completion candidate that the preview is showing."
(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 arg))
(completion-preview-partial-insert #'forward-word n))
(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-insert-sexp (&optional n)
"Insert the first N s-expressions 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-sexp n 'interactive))
(defun completion-preview-complete ()
"Complete up to the longest common prefix of all completion candidates.
@ -550,8 +573,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))
@ -656,8 +678,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
@ -666,7 +692,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

53
test/lisp/completion-preview-tests.el
View file

@ -299,7 +299,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)
(should (string= (buffer-string) "foobar-1 2"))
(should-not completion-preview--overlay)
@ -321,7 +322,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)
@ -329,7 +331,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
@ -343,7 +345,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)
@ -351,7 +354,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)
@ -366,15 +369,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
@ -388,7 +424,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)