From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Jules Tamagnan Newsgroups: gmane.emacs.bugs Subject: bug#71716: [PATCH] Add new completion-preview-insert-{word, sexp} commands Date: Sat, 22 Jun 2024 15:00:03 -0700 Message-ID: <874j9k8wpo.fsf@gmail.com> References: <87a5jd8hqh.fsf@gmail.com> <877ceg9546.fsf@gmail.com> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="11150"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: 71716@debbugs.gnu.org To: Eshel Yaron Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Sun Jun 23 00:02:27 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1sL8oT-0002RG-Ne for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 23 Jun 2024 00:02:25 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sL8oE-0001Dk-S3; Sat, 22 Jun 2024 18:02:10 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sL8o6-0001D8-Gv for bug-gnu-emacs@gnu.org; Sat, 22 Jun 2024 18:02:02 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sL8o6-0002bf-16 for bug-gnu-emacs@gnu.org; Sat, 22 Jun 2024 18:02:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sL8o5-000675-ND for bug-gnu-emacs@gnu.org; Sat, 22 Jun 2024 18:02:01 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Jules Tamagnan Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sat, 22 Jun 2024 22:02:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 71716 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch Original-Received: via spool by 71716-submit@debbugs.gnu.org id=B71716.171909367623436 (code B ref 71716); Sat, 22 Jun 2024 22:02:01 +0000 Original-Received: (at 71716) by debbugs.gnu.org; 22 Jun 2024 22:01:16 +0000 Original-Received: from localhost ([127.0.0.1]:33599 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sL8nL-00065u-Il for submit@debbugs.gnu.org; Sat, 22 Jun 2024 18:01:16 -0400 Original-Received: from mail-pf1-f178.google.com ([209.85.210.178]:53441) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sL8nJ-00065c-Eq for 71716@debbugs.gnu.org; Sat, 22 Jun 2024 18:01:14 -0400 Original-Received: by mail-pf1-f178.google.com with SMTP id d2e1a72fcca58-7065a2f4573so1106847b3a.2 for <71716@debbugs.gnu.org>; Sat, 22 Jun 2024 15:01:13 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1719093607; x=1719698407; darn=debbugs.gnu.org; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:from:to:cc:subject:date:message-id:reply-to; bh=eym4BzLGYD/tyi+m750GKZfbfEluDySs9rQXS7oOzVk=; b=XtY+FP5RJYTIAXoVlIiWnTurTWVeWIetBYN6NHc14TYFafAAAPi1z+dSrq2M5OPJW7 T7FU/IsisystoBlhkWyCrGX/Ptr/dUlKdjhOkOBkNgxPRFDDRr1q9Mt6SoMNE9Xgjyic Deu90M+ldNJTLnQMe4dTGVb5vRZcZsQ046T4ZOaz3SCvJ3EuA/KI6XD95qBXUAsLQDLO bGmU0O0eHf56txVuxcLv1eJVj71N8JbuSXjgV3lBaLce+uKl7rJnufgWLJLYOImwl+ba t9QMSS+GXVyEIfTnPvhY1yuYngckF0nmWToqQl2wu42FsFetiYNtStEeHslrGyFNztyB Ow5A== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1719093607; x=1719698407; h=mime-version:user-agent:message-id:date:references:in-reply-to :subject:cc:to:from:x-gm-message-state:from:to:cc:subject:date :message-id:reply-to; bh=eym4BzLGYD/tyi+m750GKZfbfEluDySs9rQXS7oOzVk=; b=vLl/KAIayiu+0NWejvO8/GIhBpyXGxjtnymM4RXpQSnXrmcHYtsWR/YBqavNwbW/3j lWXPe3EMPM38sIotYfMk5PBSXRAy+DMXYPD1Yfu5slDHLvXcpx6zd2ORaJefpNFDnsD5 2hhMnW8vkMEB8JpEXaYFL2a6smzWsTnsdVEeRMSXDow5EsvGOBX182+sNYg5kYqSNYEV fPIwdBXiYcLtp4y2IP6kWnAFv3LE32evPcFtJ1irhTHQPwLi9wzjQgjBSt52FPtXVp61 3aL0hKumCmJX9iqGuXmKf2/EydM6Qit3UXhuiX5TxiedjR9K5nzMxYTZNl3I+lQw0lpl c9HA== X-Gm-Message-State: AOJu0Yx2exFyBcVIXArglmNBE3GJoA49fr/cozHDwKKF3R/zv6C8xoC+ wRkv8EvgqFnGUxvnoAcl9xJPNLLvm7aFeCMfF1dQMsdG+fZ6giAS6H/Ipg== X-Google-Smtp-Source: AGHT+IFRymIHS9ZFVXx6BUHXWXESBqKys/fD9tlwTS22kfBfJlCBTJ7nPnYxPa+CpCyltyJ0X19wog== X-Received: by 2002:a05:6a00:2d5:b0:706:5aee:b987 with SMTP id d2e1a72fcca58-706746b601bmr680539b3a.22.1719093606733; Sat, 22 Jun 2024 15:00:06 -0700 (PDT) Original-Received: from jat-framework (syn-076-081-086-146.biz.spectrum.com. [76.81.86.146]) by smtp.gmail.com with ESMTPSA id d2e1a72fcca58-706512900a0sm3657526b3a.149.2024.06.22.15.00.05 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Sat, 22 Jun 2024 15:00:06 -0700 (PDT) In-Reply-To: <877ceg9546.fsf@gmail.com> (Jules Tamagnan's message of "Sat, 22 Jun 2024 11:58:33 -0700") X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:287742 Archived-At: --=-=-= Content-Type: text/plain Hi Eshel, I've further tweaked the code to address the second point of feedback. Looking at it now it seems a bit uglier for the "standard" insert case so I'd be willing to revert that consolidation. Overall it seems to work well both in unit tests and in my personal testing. In the last message I attached a patch with only my second commit. This new patch contains of all 3 commits: 1. The initial change 2. The change to preserve the prefix and reduce flicker 3. The change to support different modes and definitions of word. This change also includes new tests. It is worth noting that this will not work as a user may expect if `forward-word` or `forward-sexp` are bound to other functions but hopefully the included helper functions can allow users to define these functions if they need. Best, Jules --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=full.patch Content-Description: Complete patch consisting of 3 commits >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 --=-=-=--