emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
From: Allen Li <darkfeline@felesatra.moe>
To: emacs-orgmode@gnu.org
Subject: Bug: [PATCH] Use crm for tag completion [9.4.6 (9.4.6-gab9f2a @ /home/ionasal/.emacs.d/elpa/org-9.4.6/)]
Date: Thu, 08 Jul 2021 22:26:07 -0700	[thread overview]
Message-ID: <80mtqw3vo0.fsf@felesatra.moe> (raw)

[-- Attachment #1: Type: text/plain, Size: 497 bytes --]

Org mode's tag completion commands all use a custom completion function,
which makes it difficult for alternative completion functions to support
well.

Emacs already has a function for reading multiple things,
completing-read-multiple, which can be used for the tag completion use
case.

I have attached a patch for this change, which I have tested manually a
few times and also fixed the existing tests.  I have tested this with
vertico, which claims to strictly follow Emacs's completion API.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: patch --]
[-- Type: text/x-patch, Size: 10140 bytes --]

From 933dc914694c14889af86c06ba0a8bbd88a316cf Mon Sep 17 00:00:00 2001
From: Allen Li <darkfeline@felesatra.moe>
Date: Thu, 8 Jul 2021 21:35:34 -0700
Subject: [PATCH] org: Use crm for completing tags

Change various places which use `completing-read' to read tags using a
custom completion function to instead use `completing-read-multiple'
with a completion table instead.

This makes tab completion play better with alternative completion
frameworks such as vertico, selectrum, etc.

`org-change-tag-in-region' only reads a single tag, so it is changed
to use a completion table with `completing-read'.  This also makes it
play better with alternative completion frameworks.

Note that there is still one use for `org-tags-completion-function',
which is for completing tag matches.  Completing tag matches is
different from completing lists of tags since the separators (+, -,
etc) have semantic meaning.  This commit does not address that use
case.

* lisp/org-capture.el (org-capture-fill-template): Changed to use
completing-read-multiple.
* lisp/org.el (org-set-tags-command): Changed to use
completing-read-multiple.
(org-change-tag-in-region): Changed to use a simple completion table.
* testing/lisp/test-org.el (test-org/set-tags-command): Fixed tests.
* etc/ORG-NEWS (Tag completion now uses =completing-read-multiple=):
Added news.
---
 etc/ORG-NEWS             |  6 +++++
 lisp/org-capture.el      | 12 +++++-----
 lisp/org.el              | 18 +++++++++------
 testing/lisp/test-org.el | 50 ++++++++++++++++------------------------
 4 files changed, 43 insertions(+), 43 deletions(-)

diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 3f3971961..719ac3547 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -409,6 +409,12 @@ The function does not allow for a third optional parameter anymore.
 If a babel src block produces a raw LaTeX environment, it will now be
 recognised as a result, and so replaced when re-evaluated.
 
+*** Tag completion now uses =completing-read-multiple=
+
+Tag completion now uses =completing-read-multiple= with a simple
+completion table, which should allow better interoperability with
+custom completion functions.
+
 * Version 9.4
 ** Incompatible changes
 *** Possibly broken internal file links: please check and fix
diff --git a/lisp/org-capture.el b/lisp/org-capture.el
index 5ecec6309..c51744680 100644
--- a/lisp/org-capture.el
+++ b/lisp/org-capture.el
@@ -69,6 +69,7 @@
 (declare-function org-table-goto-line "org-table" (N))
 
 (defvar dired-buffers)
+(defvar crm-separator)
 (defvar org-end-time-was-given)
 (defvar org-keyword-properties)
 (defvar org-remember-default-headline)
@@ -1739,12 +1740,11 @@ The template may still contain \"%?\" for cursor positioning."
 			    (org-add-colon-after-tag-completion t)
 			    (ins (mapconcat
 				  #'identity
-				  (org-split-string
-				   (completing-read
-				    (if prompt (concat prompt ": ") "Tags: ")
-				    'org-tags-completion-function nil nil nil
-				    'org-tags-history)
-				   "[^[:alnum:]_@#%]+")
+				  (let ((crm-separator "[ \t]*:[ \t]*"))
+                                    (completing-read-multiple
+				     (if prompt (concat prompt ": ") "Tags: ")
+				     org-last-tags-completion-table nil nil nil
+				     'org-tags-history))
 				  ":")))
 		       (when (org-string-nw-p ins)
 			 (unless (eq (char-before) ?:) (insert ":"))
diff --git a/lisp/org.el b/lisp/org.el
index 4fd8b6fa6..ed3ee3a1c 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -201,6 +201,8 @@ Stars are put in group 1 and the trimmed body in group 2.")
 ;; load languages based on value of `org-babel-load-languages'
 (defvar org-babel-load-languages)
 
+(defvar crm-separator)  ; dynamically scoped param
+
 ;;;###autoload
 (defun org-babel-do-load-languages (sym value)
   "Load the languages defined in `org-babel-load-languages'."
@@ -12054,12 +12056,14 @@ in Lisp code use `org-set-tags' instead."
 		      inherited-tags
 		      table
 		      (and org-fast-tag-selection-include-todo org-todo-key-alist))
-		   (let ((org-add-colon-after-tag-completion (< 1 (length table))))
-		     (org-trim (completing-read
-				"Tags: "
-				#'org-tags-completion-function
-				nil nil (org-make-tag-string current-tags)
-				'org-tags-history)))))))
+		   (let ((org-add-colon-after-tag-completion (< 1 (length table)))
+                         (crm-separator "[ \t]*:[ \t]*"))
+		     (string-join (completing-read-multiple
+			           "Tags: "
+			           org-last-tags-completion-table
+			           nil nil (org-make-tag-string current-tags)
+			           'org-tags-history)
+                                  ":"))))))
 	  (org-set-tags tags)))))
     ;; `save-excursion' may not replace the point at the right
     ;; position.
@@ -12139,7 +12143,7 @@ This works in the agenda, and also in an Org buffer."
 		     (org-global-tags-completion-table))
 		  (org-global-tags-completion-table))))
 	   (completing-read
-	    "Tag: " 'org-tags-completion-function nil nil nil
+	    "Tag: " org-last-tags-completion-table nil nil nil
 	    'org-tags-history))
 	 (progn
 	   (message "[s]et or [r]emove? ")
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 95ffb0a80..de3c6f3c9 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -6969,8 +6969,8 @@ Paragraph<point>"
   (should
    (equal "* H1 :foo:"
 	  (org-test-with-temp-text "* H1"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -6979,8 +6979,8 @@ Paragraph<point>"
   (should
    (equal "* H1 :foo:\nContents"
 	  (org-test-with-temp-text "* H1\n<point>Contents"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -6988,30 +6988,20 @@ Paragraph<point>"
   (should-not
    (equal "* H1 :foo:\nContents2"
 	  (org-test-with-temp-text "* H1\n<point>Contents2"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
 	    (org-at-heading-p))))
-  ;; Strip all forbidden characters from user-entered tags.
-  (should
-   (equal "* H1 :foo:"
-	  (org-test-with-temp-text "* H1"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ": foo *:")))
-	      (let ((org-use-fast-tag-selection nil)
-		    (org-tags-column 1))
-		(org-set-tags-command)))
-	    (buffer-string))))
   ;; When a region is active and
   ;; `org-loop-over-headlines-in-active-region' is non-nil, insert the
   ;; same value in all headlines in region.
   (should
    (equal "* H1 :foo:\nContents\n* H2 :foo:"
 	  (org-test-with-temp-text "* H1\nContents\n* H2"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-loop-over-headlines-in-active-region t)
 		    (org-tags-column 1))
@@ -7023,8 +7013,8 @@ Paragraph<point>"
   (should
    (equal "* H1\nContents\n* H2 :foo:"
 	  (org-test-with-temp-text "* H1\nContents\n* H2"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-loop-over-headlines-in-active-region nil)
 		    (org-tags-column 1))
@@ -7043,8 +7033,8 @@ Paragraph<point>"
   (should
    (equal ":foo:"
 	  (org-test-with-temp-text "* <point>"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -7053,8 +7043,8 @@ Paragraph<point>"
   (should
    (equal "* H1 :foo:"
 	  (org-test-with-temp-text "* H1"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -7063,8 +7053,8 @@ Paragraph<point>"
   (should
    (equal "* H1 :foo:"
 	  (org-test-with-temp-text "*<point>* H1"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -7073,8 +7063,8 @@ Paragraph<point>"
   (should
    (equal " b :foo:"
 	  (org-test-with-temp-text "* a<point> b"
-	    (cl-letf (((symbol-function 'completing-read)
-		       (lambda (&rest args) ":foo:")))
+	    (cl-letf (((symbol-function 'completing-read-multiple)
+		       (lambda (&rest args) '("foo"))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
@@ -7083,9 +7073,9 @@ Paragraph<point>"
   (should
    (equal "b :foo:"
 	  (org-test-with-temp-text "* a :foo:\n** <point>b :foo:"
-	    (cl-letf (((symbol-function 'completing-read)
+	    (cl-letf (((symbol-function 'completing-read-multiple)
 		       (lambda (prompt coll &optional pred req initial &rest args)
-			 initial)))
+			 (list initial))))
 	      (let ((org-use-fast-tag-selection nil)
 		    (org-tags-column 1))
 		(org-set-tags-command)))
-- 
2.32.0


             reply	other threads:[~2021-07-09  5:53 UTC|newest]

Thread overview: 2+ messages / expand[flat|nested]  mbox.gz  Atom feed  top
2021-07-09  5:26 Allen Li [this message]
2021-07-09  6:49 ` Nicolas Goaziou

Reply instructions:

You may reply publicly to this message via plain-text email
using any one of the following methods:

* Save the following mbox file, import it into your mail client,
  and reply-to-all from there: mbox

  Avoid top-posting and favor interleaved quoting:
  https://en.wikipedia.org/wiki/Posting_style#Interleaved_style

  List information: https://www.orgmode.org/

* Reply using the --to, --cc, and --in-reply-to
  switches of git-send-email(1):

  git send-email \
    --in-reply-to=80mtqw3vo0.fsf@felesatra.moe \
    --to=darkfeline@felesatra.moe \
    --cc=emacs-orgmode@gnu.org \
    --subject='Re: Bug: [PATCH] Use crm for tag completion [9.4.6 (9.4.6-gab9f2a @ /home/ionasal/.emacs.d/elpa/org-9.4.6/)]' \
    /path/to/YOUR_REPLY

  https://kernel.org/pub/software/scm/git/docs/git-send-email.html

* If your mail client supports setting the In-Reply-To header
  via mailto: links, try the mailto: link

Code repositories for project(s) associated with this inbox:

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).