;; 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.
+;;
;; Completion Preview mode can change the cursor shape while displaying
;; the preview right after point. By default, it uses a vertical bar
;; that clearly separates the completion preview from the preceding
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")
"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 ()
(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.
(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))
(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
(completion-preview-tests--insert-and-preview "foo")
(completion-preview-tests--check-preview "bar" 'completion-preview-common)
(completion-preview-insert)
+ (should (string= (buffer-string) "foobar-1 2"))
+ (should-not completion-preview--overlay)
+ (should exit-fn-called)
+ (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 '("foobar" finished))))))
+ (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))))
(ert-deftest completion-preview-cursor-type ()
"Test modification of `cursor-type' when completion preview is visible."
projects / emacs.git / commitdiff