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: Mon, 24 Jun 2024 10:16:31 -0700 Message-ID: <87bk3q5ki8.fsf@gmail.com> References: <87a5jd8hqh.fsf@gmail.com> <877ceg9546.fsf@gmail.com> <874j9k8wpo.fsf@gmail.com> <87r0cn5n2s.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="4665"; 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 Mon Jun 24 19:18:18 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 1sLnKb-000106-HG for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 24 Jun 2024 19:18:18 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sLnKP-00010N-74; Mon, 24 Jun 2024 13:18:05 -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 1sLnKM-0000r2-0q for bug-gnu-emacs@gnu.org; Mon, 24 Jun 2024 13:18: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 1sLnKL-0004eH-Mf for bug-gnu-emacs@gnu.org; Mon, 24 Jun 2024 13:18:01 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sLnKM-0005YD-HK for bug-gnu-emacs@gnu.org; Mon, 24 Jun 2024 13:18:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Jules Tamagnan Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 24 Jun 2024 17:18:02 +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.171924946521313 (code B ref 71716); Mon, 24 Jun 2024 17:18:02 +0000 Original-Received: (at 71716) by debbugs.gnu.org; 24 Jun 2024 17:17:45 +0000 Original-Received: from localhost ([127.0.0.1]:35152 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sLnK4-0005Xg-8I for submit@debbugs.gnu.org; Mon, 24 Jun 2024 13:17:45 -0400 Original-Received: from mail-pf1-f170.google.com ([209.85.210.170]:59480) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sLnK1-0005XT-FR for 71716@debbugs.gnu.org; Mon, 24 Jun 2024 13:17:43 -0400 Original-Received: by mail-pf1-f170.google.com with SMTP id d2e1a72fcca58-7066c9741fbso2030049b3a.2 for <71716@debbugs.gnu.org>; Mon, 24 Jun 2024 10:17:40 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20230601; t=1719249394; x=1719854194; 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=DLujXGRUryiQ3Pc8LR/MlUi4fBBKPcKCcCF66eQQ9Xg=; b=NJjZoRwbujPgI+t7LHCXIuyfAYA/m4cB6WOvOxcYbBeKTqTXC5rlhzv4JAS8EVMhmT XFmUJFIwUa4vIfNUm6oTqWotedMfoCijAWVRNZ0ePmHLLY1Ahab2cd6S5yUvhuzsx+sr D7YGzwb3zD+aET4JksGPO2rTBlI4qfTg2qNeheYJwlysJkqaYVgO52CJOR8ieqpXNTan E7hyg7vKb1cwwmdgzrmkU1B+p/mQDmltRvLAsTVebEeQt3ipJ4j3pCvmRCxawTFHxysW qz1DlQ044fxAyhXkDmSDN5WSrw0sPn2FbLkRvbpV4X/xnzPQnRnXuZP0XnwU3Z2OySeZ JfFA== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20230601; t=1719249394; x=1719854194; 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=DLujXGRUryiQ3Pc8LR/MlUi4fBBKPcKCcCF66eQQ9Xg=; b=Ru8mjTPkse6gritQBM6qrLDbQY52LXXCmiWghDO9oBvxF6UpMgflh3YGEYgUKLzRE2 qLmz1GZHZQTnRKBwPf54WNnS2PsPMduutHatZDXy5U7DOnISke9Y9ofwzMeoIzP2Wwi+ 19u/o+ZwIMqcW0t1EiRFAv1nWFO76SCrnspF4fiPlHcMfZ3OAiDtVkRMbcEmzjaTLM5M o0N0h2Z2odwV0c2p+SSEu2n8DoTkJ5wqxTAW26tWyHs64mOdw+Z8r3948uO4fuCcB4hb oYBi94jh7z5qfShzxb3O2/4uKJHd1Xncpd9t8+dP6HFt8hFhlb72xnqWCoVd8UDR6fCk Fl0g== X-Gm-Message-State: AOJu0YxiG+VdkwaTh4scdWcj5gaI+pU8uIn4sSSonTWlKZskCMTKKiT/ 59mgniDtayc2Fqv5I8exOqnvrM9q090l8cSLjPKZqXgCYoDXnmC8WINHhg== X-Google-Smtp-Source: AGHT+IGOqWt/pqMQ80mN7JHqThCJXamgNn5c1wSgewjX9WyHfAusNTRbi9JioCIQX/hq30B9aAd+tA== X-Received: by 2002:a05:6a20:49a8:b0:1b8:b8bd:9427 with SMTP id adf61e73a8af0-1bcf7fb9c91mr5941310637.50.1719249393800; Mon, 24 Jun 2024 10:16:33 -0700 (PDT) Original-Received: from jat-framework (c-73-189-85-43.hsd1.ca.comcast.net. [73.189.85.43]) by smtp.gmail.com with ESMTPSA id d2e1a72fcca58-7065129012asm6662576b3a.146.2024.06.24.10.16.32 (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 24 Jun 2024 10:16:33 -0700 (PDT) In-Reply-To: (Eshel Yaron's message of "Mon, 24 Jun 2024 14:43:56 +0200") 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:287846 Archived-At: --=-=-= Content-Type: text/plain Eshel Yaron writes: > One important point is that I'm a bit hesitant about adding the sexp > variant, rather then defining only completion-preview-insert-word, and > mentioning in the documentation that other variants are trivial to > define (and how). The reason is that I don't have a good idea of when > a completion candidate would span multiple sexps (if you have such an > example, please share it), so I'm not sure how much utility this > command would bring in practice. The use case that I have for the sexp variant is when completing eshell history. Both because: parts of shell commands such as file names can be considered sexp's, but also because eshell itself can interpret "full" elisp forms. On a similar note. Some similar tools additionally define a `forward-char` variant. This is not something that I've found a need for personally but would be willing to add for completeness. >> From 7fd70fb330e0623636729657b17a9cdac3841a3d Mon Sep 17 00:00:00 2001 >> From: Jules Tamagnan >> Date: Sat, 22 Jun 2024 00:45:01 -0700 >> Subject: [PATCH] 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. > > It's best to single-quote symbols in the commit message, like 'this'. Thank you. Done >> +(defun completion-preview--insert-partial (command) > > This should be a public function (no --), to indicate that it's fine for > users to use it in their own command definitions. So either > completion-preview-insert-partial or completion-preview-partial-insert. > (I tend to prefer the latter, but both work.) Thank you. Done > Also, COMMAND should instead be FUN or FUNC, since the argument doesn't > have to be command, any motion function would do. Thank you. Done > Lastly this command should also take &rest args and pass them to the > function argument, to facilitate writing something like > (c-p-partial-insert #'forward-word 2) to complete two words. Thank you. Done Another idea would be to turn `c-p-partial-insert` into a macro that uses the `interactive-form` function to generate a sensible insert-partial function. I'm more than happy to take this tweak on as well. > The first line of the docstring should be a full sentence. We also want > to describe accurately enough what this function does for users to be > able to leverage it in their definitions. I suggest: > > (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." Thank you. Done > Better strip text properties from AFT before inserting it here. Thank you. Done There were two ways of implementing this that I could think of. 1. Insert with properties, set `suf` to delete-and-extract-region to preserve the properties, use `(set-text-properties end (point) nil)` to remove the text properties from the deletion. 2. Insert without text properties, use `delete-region`, set `suf` to a substring of `aft` directly Both seem to work equally well, I've gone with option 2 because it seems more consistent with what you had suggested. > We should ensure that new-end isn't smaller then end, otherwise the > deletion below won't do the right thing. Thank you. Done > This is a nice use of delete-and-extract-region, but the insertion and > deletion must be inside an atomic-change-group, so we don't leave AFT > inserted in case the motion function signals an error. This is also > where we need to add an undo-amalgamate-change-group, to prevent undo > from seeing an unwanted intermediate step in case an undo-boundary is > created between the insertion and the deletion. So the structure should > be something like: > > (atomic-change-group > (let ((change-group (prepare-change-group))) > ;; Insert, > ;; Move, > ;; Delete. > (undo-amalgamate-change-group change-group))) Thank you. Done I'm glad to better understand how this works now. >> +(defun completion-preview-insert-word () >> + "Insert the next word of the completion candidate that the preview is showing." >> + (interactive) >> + (completion-preview--insert-partial #'forward-word)) > > This should handle an optional numeric argument, like forward-word does. Thank you. Done > Finally, we should document completion-preview-insert-word in the > Commentary section. Here's the text I'd like to add, you can include it > the patch (and change it as you see fit) or I'll add it later: > > ;; 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. Thank you. Done At the end of the paragraph I've additionally added a brief note about the `sexp` variant. > Best, > > Eshel Best, Jules --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=completion-preview-partial-insertion.patch Content-Description: Full patch with addressed comments >From 74d8efceaf8f64f7cf61e36f8a5e8a4fc86e558d Mon Sep 17 00:00:00 2001 From: Jules Tamagnan Date: Mon, 24 Jun 2024 08:53:23 -0700 Subject: [PATCH] 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 | 82 +++++++++++++++++++++- test/lisp/completion-preview-tests.el | 97 +++++++++++++++++++++++++-- 2 files changed, 174 insertions(+), 5 deletions(-) diff --git a/lisp/completion-preview.el b/lisp/completion-preview.el index caebb9d01e3..14c28b0c76b 100644 --- a/lisp/completion-preview.el +++ b/lisp/completion-preview.el @@ -49,6 +49,16 @@ ;; 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. +;; ;; If you set the user option `completion-preview-exact-match-only' to ;; non-nil, Completion Preview mode only suggests a completion ;; candidate when its the only possible completion for the (partial) @@ -90,7 +100,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 +175,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 () @@ -463,6 +477,70 @@ completion-preview-insert (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. @@ -583,6 +661,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..1c8a04c765d 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,100 @@ 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")) + (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 '("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)))) ;;; completion-preview-tests.el ends here -- 2.45.1 --=-=-=--