From: Morgan Smith <Morgan.J.Smith@outlook.com>
To: emacs-orgmode@gnu.org
Cc: Morgan Smith <Morgan.J.Smith@outlook.com>
Subject: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy
Date: Sat, 15 Jun 2024 08:35:46 -0400 [thread overview]
Message-ID: <CH3PR84MB3424C03A7D026DC66E15DB14C5C32@CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM> (raw)
* lisp/org.el (org-tags-sort-hierarchy): New function.
(org-tags-sort-function): Add new function to type.
* testing/lisp/test-org.el (test-org/tags-sort-hierarchy): New test
---
This is one of those things that I thought would be easy but then ended up
hard.
I wrote this so that items in my agenda would sort nicely. Items tagged in the
same hierarchy would end up next to each other.
lisp/org.el | 38 +++++++++++++++++++++++++++++++++++++-
testing/lisp/test-org.el | 19 +++++++++++++++++++
2 files changed, 56 insertions(+), 1 deletion(-)
diff --git a/lisp/org.el b/lisp/org.el
index 750b060f3..b828f4127 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -2955,7 +2955,8 @@ is better to limit inheritance to certain tags using the variables
(const :tag "No sorting" nil)
(const :tag "Alphabetical" org-string<)
(const :tag "Reverse alphabetical" org-string>)
- (function :tag "Custom function" nil)))
+ (const :tag "Hierarchy" org-tags-sort-hierarchy)
+ (function :tag "Custom function" nil)))
(defvar org-tags-history nil
"History of minibuffer reads for tags.")
@@ -4262,6 +4263,41 @@ See `org-tag-alist' for their structure."
;; Preserve order of ALIST1.
(append (nreverse to-add) alist2)))))
+(defun org-tags-sort-hierarchy (tag1 tag2)
+ "Sort tags TAG1 and TAG2 by the tag hierarchy.
+Sorting is done alphabetically. This function is intended to be a value
+of `org-tags-sort-function'."
+ (let ((sort-func #'org-string<)
+ (group-alist (or org-tag-groups-alist-for-agenda
+ org-tag-groups-alist)))
+ (if (not (and org-group-tags
+ group-alist))
+ (funcall sort-func tag1 tag2)
+ (let* ((tag-path-function
+ ;; Returns a list of tags describing the tag path
+ ;; ex: '("top level tag" "second level" "tag")
+ (lambda (tag)
+ (let ((result (list tag)))
+ (while (setq tag
+ (map-some
+ (lambda (key tags)
+ (when (and (member tag tags)
+ ;; infinite loop (only catches the trivial case)
+ (not (string-equal tag key)))
+ key))
+ group-alist))
+ (push tag result))
+ result)))
+ (tag1-path (funcall tag-path-function tag1))
+ (tag2-path (funcall tag-path-function tag2)))
+ ;; value< was added in Emacs 30
+ ;; (value< tag1-path tag2-path)
+ (catch :result
+ (dotimes (n (min (length tag1-path) (length tag2-path)))
+ (unless (string-equal (nth n tag1-path) (nth n tag2-path))
+ (throw :result (funcall sort-func (nth n tag1-path) (nth n tag2-path)))))
+ (< (length tag1-path) (length tag2-path)))))))
+
(defun org-priority-to-value (s)
"Convert priority string S to its numeric value."
(or (save-match-data
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index f21e52bfd..59b16a62a 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -8508,6 +8508,25 @@ Paragraph<point>"
(org-mode-restart)
(let ((org-tag-alist-for-agenda nil)) (org-tags-expand "{A+}"))))))
+(ert-deftest test-org/tags-sort-hierarchy ()
+ "Test `org-tags-sort-hierarchy' specifications."
+ (let ((org-tag-groups-alist-for-agenda
+ '(("A" "B" "D" "z" "zz")
+ ("B" "y")
+ ("C" "x")
+ ("D" "w")
+ ("E" "C" "v")))
+ (test-list '("v" "w" "x" "y" "zz" "z" "E" "D" "C" "B" "A")))
+ (should (equal
+ '("A" "B" "y" "D" "w" "z" "zz" "E" "C" "x" "v")
+ (sort test-list #'org-tags-sort-hierarchy))))
+ ;; infinite loop (tag "A" should not be in the "A" group)
+ (let ((org-tag-groups-alist-for-agenda
+ '(("A" "A" "B")))
+ (test-list '("B" "A")))
+ (should (equal
+ '("A" "B")
+ (sort test-list #'org-tags-sort-hierarchy)))))
\f
;;; TODO keywords
--
2.45.1
next reply other threads:[~2024-06-15 13:32 UTC|newest]
Thread overview: 5+ messages / expand[flat|nested] mbox.gz Atom feed top
2024-06-15 12:35 Morgan Smith [this message]
2024-06-15 14:25 ` [PATCH] lisp/org.el: Add ability to sort tags by hierarchy Ihor Radchenko
2024-08-28 15:39 ` Ihor Radchenko
2024-08-28 16:10 ` Morgan Smith
2024-09-01 16:23 ` 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
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=CH3PR84MB3424C03A7D026DC66E15DB14C5C32@CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM \
--to=morgan.j.smith@outlook.com \
--cc=emacs-orgmode@gnu.org \
/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 external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.