From: Ihor Radchenko <yantar92@posteo.net>
To: "Christopher M. Miles" <numbchild@gmail.com>
Cc: Org-mode <emacs-orgmode@gnu.org>
Subject: [PATCH v6] Re: Improve the performance of `org-set-tags-command` on large `org-tag-alist`
Date: Tue, 09 Jan 2024 14:12:25 +0000 [thread overview]
Message-ID: <87frz6y4s6.fsf@localhost> (raw)
In-Reply-To: <87pm5boofs.fsf@localhost>
[-- Attachment #1: Type: text/plain, Size: 244 bytes --]
I have incorporated my suggestions into an updated patch.
Note that I dropped the condition that new customization only works for
org-use-fast-tag-selection = 'auto.
Please let me know if anything you wanted to see in this patch is
missing.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: v6-0001-org-fast-tag-selection-Limit-the-number-of-displa.patch --]
[-- Type: text/x-patch, Size: 8290 bytes --]
From 79fee381dc5ecbaed5bfe3ba66b11bb2a02aa97f Mon Sep 17 00:00:00 2001
Message-ID: <79fee381dc5ecbaed5bfe3ba66b11bb2a02aa97f.1704809509.git.yantar92@posteo.net>
From: stardiviner <numbchild@gmail.com>
Date: Sat, 1 Jul 2023 18:29:02 +0800
Subject: [PATCH v6] org-fast-tag-selection: Limit the number of displayed tags
* lisp/org.el (org-fast-tag-selection): Do not print tags without
explicit bindings and tags outside groups when the number of displayed
tags exceeds new customization.
* lisp/org.el (org-fast-tag-selection-maximum-tags): Add new custom
option to set maximum tags number for fast tag selection.
(org--fast-tag-selection-keys): New internal variable holding keys
available for auto-assigning tag bindings.
* doc/org-manual.org (org-fast-tag-selection-maximum-tags): Add new
custom option documentation.
* etc/ORG-NEWS: Declare this new custom option.
Co-Authored-by: Ihor Radchenko <yantar92@posteo.net>
Link: https://list.orgmode.org/orgmode/CAL1eYuK7GUx_=47e8+N5Jh+ZJnDexY+CDMUjPjJHNmcMiVVRrQ@mail.gmail.com/
---
doc/org-manual.org | 5 ++++
etc/ORG-NEWS | 5 ++++
lisp/org.el | 73 +++++++++++++++++++++++++++++++++++-----------
3 files changed, 66 insertions(+), 17 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index acc6d07ff..bb4b6e625 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -5090,6 +5090,11 @@ ** Setting Tags
the special window is not even shown for single-key tag selection, it
comes up only when you press an extra {{{kbd(C-c)}}}.
+#+vindex: org-fast-tag-selection-maximum-tags
+The number of tags displayed in the fast tag selection interface is
+limited by ~org-fast-tag-selection-maximum-tags~ to avoid running out
+of keyboard keys. You can customize this variable.
+
** Tag Hierarchy
:PROPERTIES:
:DESCRIPTION: Create a hierarchy of tags.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index b808357d8..847ddf614 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -371,6 +371,11 @@ The change is breaking when ~org-use-property-inheritance~ is set to ~t~.
The =TEST= parameter is better served by Emacs debugging tools.
** New and changed options
+*** New option ~org-fast-tag-selection-maximum-tags~
+
+You can now limit the total number of tags displayed in the fast tag
+selection interface. Useful in buffers with huge number of tags.
+
*** New variable ~org-clock-out-removed-last-clock~
The variable is intended to be used by ~org-clock-out-hook~. It is a
diff --git a/lisp/org.el b/lisp/org.el
index 57379c26a..3d3099c48 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -2790,6 +2790,25 @@ (defcustom org-fast-tag-selection-single-key nil
(const :tag "Yes" t)
(const :tag "Expert" expert)))
+(defvar org--fast-tag-selection-keys
+ (string-to-list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~")
+ "List of chars to be used as bindings by `org-fast-tag-selection'.")
+
+(defcustom org-fast-tag-selection-maximum-tags (length org--fast-tag-selection-keys)
+ "Set the maximum tags number for fast tag selection.
+This variable only affects tags without explicit key bindings outside
+tag groups. All the tags with user bindings and all the tags
+corresponding to tag groups are always displayed.
+
+When the number of tags with bindings + tags inside tag groups is
+smaller than `org-fast-tag-selection-maximum-tags', tags without
+explicit bindings will be assigned a binding and displayed up to the
+limit."
+ :package-version '(Org . "9.7")
+ :group 'org-tags
+ :type 'number
+ :safe #'numberp)
+
(defvar org-fast-tag-selection-include-todo nil
"Non-nil means fast tags selection interface will also offer TODO states.
This is an undocumented feature, you should not rely on it.")
@@ -11983,9 +12002,8 @@ (defun org-fast-tag-selection (current-tags inherited-tags tag-table &optional t
(inherited-face 'org-done)
(current-face 'org-todo)
;; Characters available for auto-assignment.
- (tag-binding-char-list
- (eval-when-compile
- (string-to-list "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ{|}~")))
+ (tag-binding-char-list org--fast-tag-selection-keys)
+ (tag-binding-chars-left org-fast-tag-selection-maximum-tags)
field-number ; current tag column in the completion buffer.
tag-binding-spec ; Alist element.
current-tag current-tag-char auto-tag-char
@@ -11995,6 +12013,22 @@ (defun org-fast-tag-selection (current-tags inherited-tags tag-table &optional t
(exit-after-next org-fast-tag-selection-single-key)
(done-keywords org-done-keywords)
groups ingroup intaggroup)
+ ;; Calculate the number of tags with explicit user bindings + tags in groups.
+ ;; These tags will be displayed unconditionally. Other tags will
+ ;; be displayed only when there are free bindings left according
+ ;; to `org-fast-tag-selection-maximum-tags'.
+ (dolist (tag-binding-spec tag-alist)
+ (pcase tag-binding-spec
+ (`((or :startgroup :startgrouptag) . _)
+ (setq ingroup t))
+ (`((or :endgroup :endgrouptag) . _)
+ (setq ingroup nil))
+ ((guard (cdr tag-binding-spec))
+ (cl-decf tag-binding-chars-left))
+ (`((or :newline :grouptags))) ; pass
+ ((guard ingroup)
+ (cl-decf tag-binding-chars-left))))
+ (setq ingroup nil) ; It t, it means malformed tag alist. Reset just in case.
;; Move global `org-tags-overlay' overlay to current heading.
;; Calls to `org-set-current-tags-overlay' will take care about
;; updating the overlay text.
@@ -12083,6 +12117,9 @@ (defun org-fast-tag-selection (current-tags inherited-tags tag-table &optional t
(if (cdr tag-binding-spec)
;; Custom binding.
(setq current-tag-char (cdr tag-binding-spec))
+ ;; No auto-binding. Update `tag-binding-chars-left'.
+ (unless (or ingroup intaggroup) ; groups are always displayed.
+ (cl-decf tag-binding-chars-left))
;; Automatically assign a character according to the tag string.
(setq auto-tag-char
(string-to-char
@@ -12116,20 +12153,22 @@ (defun org-fast-tag-selection (current-tags inherited-tags tag-table &optional t
((member current-tag inherited-tags) inherited-face))))
(when (equal (caar tag-alist) :grouptags)
(org-add-props current-tag nil 'face 'org-tag-group))
- ;; Insert the tag.
- (when (and (zerop field-number) (not ingroup) (not intaggroup)) (insert " "))
- (insert "[" current-tag-char "] " current-tag
- ;; Fill spaces up to FIELD-WIDTH.
- (make-string
- (- field-width 4 (length current-tag)) ?\ ))
- ;; Record tag and the binding/auto-binding.
- (push (cons current-tag current-tag-char) tag-table-local)
- ;; Last column in the row.
- (when (= (cl-incf field-number) (/ (- (window-width) 4) field-width))
- (unless (memq (caar tag-alist) '(:endgroup :endgrouptag))
- (insert "\n")
- (when (or ingroup intaggroup) (insert " ")))
- (setq field-number 0)))))
+ ;; Respect `org-fast-tag-selection-maximum-tags'.
+ (when (or ingroup intaggroup (cdr tag-binding-spec) (> tag-binding-chars-left 0))
+ ;; Insert the tag.
+ (when (and (zerop field-number) (not ingroup) (not intaggroup)) (insert " "))
+ (insert "[" current-tag-char "] " current-tag
+ ;; Fill spaces up to FIELD-WIDTH.
+ (make-string
+ (- field-width 4 (length current-tag)) ?\ ))
+ ;; Record tag and the binding/auto-binding.
+ (push (cons current-tag current-tag-char) tag-table-local)
+ ;; Last column in the row.
+ (when (= (cl-incf field-number) (/ (- (window-width) 4) field-width))
+ (unless (memq (caar tag-alist) '(:endgroup :endgrouptag))
+ (insert "\n")
+ (when (or ingroup intaggroup) (insert " ")))
+ (setq field-number 0))))))
(insert "\n")
;; Keep the tags in order displayed. Will be used later for sorting.
(setq tag-table-local (nreverse tag-table-local))
--
2.43.0
[-- Attachment #3: Type: text/plain, Size: 224 bytes --]
--
Ihor Radchenko // yantar92,
Org mode contributor,
Learn more about Org mode at <https://orgmode.org/>.
Support Org development at <https://liberapay.com/org-mode>,
or support my work at <https://liberapay.com/yantar92>
next prev parent reply other threads:[~2024-01-09 14:10 UTC|newest]
Thread overview: 30+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-05-13 4:49 Improve the performance of `org-set-tags-command` on large `org-tag-alist` stardiviner
2023-05-13 7:43 ` Ihor Radchenko
2023-05-13 9:39 ` Christopher M. Miles
2023-05-13 11:13 ` stardiviner
2023-05-13 11:26 ` Ihor Radchenko
2023-05-13 14:24 ` [PATCH] " Christopher M. Miles
2023-05-13 18:43 ` Ihor Radchenko
2023-05-14 1:54 ` Christopher M. Miles
2023-05-14 8:09 ` Ihor Radchenko
2023-05-14 14:27 ` Christopher M. Miles
2023-05-14 14:58 ` Ihor Radchenko
2023-05-14 16:27 ` Christopher M. Miles
2023-05-14 17:38 ` Ihor Radchenko
2023-05-14 18:14 ` [PATCH v2] " Christopher M. Miles
2023-05-15 10:59 ` Ihor Radchenko
2023-05-15 12:43 ` Christopher M. Miles
2023-05-15 13:14 ` Ihor Radchenko
2023-05-15 14:40 ` [PATCH v3] " Christopher M. Miles
2023-05-15 16:12 ` [PATCH v3.1] " Christopher M. Miles
2023-05-16 9:31 ` Ihor Radchenko
2023-05-16 12:12 ` [PATCH v4] " Christopher M. Miles
2023-05-16 12:12 ` Christopher M. Miles
2023-05-16 18:53 ` Ihor Radchenko
2023-05-17 5:57 ` [PATCH v4.1] " Christopher M. Miles
2023-06-30 12:55 ` Ihor Radchenko
2023-07-01 10:31 ` [PATCH v5] " Christopher M. Miles
2023-07-01 11:34 ` Ihor Radchenko
2024-01-09 14:12 ` Ihor Radchenko [this message]
2024-01-10 3:48 ` [PATCH v6] " Christopher M. Miles
2024-01-12 12:00 ` Ihor Radchenko
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=87frz6y4s6.fsf@localhost \
--to=yantar92@posteo.net \
--cc=emacs-orgmode@gnu.org \
--cc=numbchild@gmail.com \
/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
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public 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).