From d78a9a4209d050dcb2a410610d70840d35b9b722 Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Sat, 22 Jun 2024 00:45:01 -0700 Subject: [PATCH 1/3] 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 + ;; " " #'completion-preview-insert-word + ;; " " #'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 From 1bbcc10c5b23d63dc8454113403c2d834a69d803 Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Sat, 22 Jun 2024 11:40:09 -0700 Subject: [PATCH 2/3] [Cont] Add new completion-preview-insert-{word,sexp} commands --- lisp/completion-preview.el | 37 ++++++++++++++++++++------- test/lisp/completion-preview-tests.el | 4 +-- 2 files changed, 30 insertions(+), 11 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 3a7fa37afe0..637778caadb 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -456,18 +456,37 @@ completion-preview--insert (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) + (aft (completion-preview--get 'after-string)) + (ful (with-temp-buffer + (insert aft) (goto-char (point-min)) (funcall action) - (buffer-substring-no-properties (point-min) (point))))) - (completion-preview-active-mode -1) + (cons (buffer-substring-no-properties (point-min) (point)) + (buffer-substring (point) (point-max))))) + (ins (car ful)) + (suf (cdr ful))) + ;; If the completion is a full completion (there is no suffix) + ;; deactivate the preview + (when (string-empty-p suf) + (completion-preview-active-mode -1)) + + ;; Insert the new text (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))) + (insert ins) + + ;; If we are not inserting a full completion update the preview + (when (not (string-empty-p suf)) + (let ((pos (point))) + (completion-preview--inhibit-update) + (overlay-put (completion-preview--make-overlay + pos (propertize suf + 'mouse-face 'completion-preview-highlight + 'keymap completion-preview--mouse-map)) + 'completion-preview-end pos))) + + ;; If we've inserted a full completion call the exit-function + (when (and (functionp efn) (string-empty-p suf)) + (funcall efn (concat (buffer-substring-no-properties beg end) ins) 'finished))) (user-error "No current completion preview"))) (defun completion-preview-insert () diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index dedd135da73..54ba566ad3c 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -325,7 +325,7 @@ completion-preview-insert-word (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) + (completion-preview-tests--check-preview "-1 2" 'completion-preview) (should-not exit-fn-called) (should-not exit-fn-args)))) @@ -347,7 +347,7 @@ completion-preview-insert-sexp (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) + (completion-preview-tests--check-preview " 2" 'completion-preview) (should-not exit-fn-called) (should-not exit-fn-args)))) -- 2.45.1 From 2c8ce27276405d4f541527768940a7847a6d9050 Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Sat, 22 Jun 2024 12:51:35 -0700 Subject: [PATCH 3/3] [Cont 2] Add new completion-preview-insert-{word,sexp} commands --- lisp/completion-preview.el | 27 +++++++++++----- test/lisp/completion-preview-tests.el | 45 +++++++++++++++++++++++++++ 2 files changed, 65 insertions(+), 7 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index 637778caadb..4071240df81 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -448,7 +448,25 @@ completion-preview--post-command (completion-preview--show) (completion-preview-active-mode -1))))) -(defun completion-preview--insert (action) +(defun completion-preview--determine-substring (command string) + "A helper function to determine what parts of a STRING come before and +after the point when a certain COMMAND has been performed on that STRING" + ;; Determine the parent buffer + (let ((parent-buffer (current-buffer))) + (with-temp-buffer + ;; Certain locally set variables can affect common movement + ;; commands such as `forward-word'; determine their values from + ;; the parent buffer and set them in the temporary buffer. + (let ((char-script-table (buffer-local-value 'char-script-table parent-buffer)) + (find-word-boundary-function-table (buffer-local-value 'find-word-boundary-function-table parent-buffer)) + (inhibit-field-text-motion (buffer-local-value 'inhibit-field-text-motion parent-buffer))) + (insert string) + (goto-char (point-min)) + (funcall command) + (cons (buffer-substring-no-properties (point-min) (point)) + (buffer-substring (point) (point-max))))))) + +(defun completion-preview--insert (command) "A helper function to insert part of the completion candidate that the preview is showing." (if completion-preview-active-mode @@ -457,12 +475,7 @@ completion-preview--insert (efn (plist-get (completion-preview--get 'completion-preview-props) :exit-function)) (aft (completion-preview--get 'after-string)) - (ful (with-temp-buffer - (insert aft) - (goto-char (point-min)) - (funcall action) - (cons (buffer-substring-no-properties (point-min) (point)) - (buffer-substring (point) (point-max))))) + (ful (completion-preview--determine-substring command aft)) (ins (car ful)) (suf (cdr ful))) ;; If the completion is a full completion (there is no suffix) diff --git a/test/lisp/completion-preview-tests.el b/test/lisp/completion-preview-tests.el index 54ba566ad3c..1c8a04c765d 100644 --- a/test/lisp/completion-preview-tests.el +++ b/test/lisp/completion-preview-tests.el @@ -329,6 +329,51 @@ completion-preview-insert-word (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)) -- 2.45.1