Hello!
I have updated the patch with many improvements and tests.
Ihor Radchenko <yanta...@posteo.net> writes:
> Morgan Smith <morgan.j.sm...@outlook.com> writes:
>
>> * 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.
>
>> + "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'."
>
> Thanks for the patch, but may you please elaborate what kind of sorting
> order does your function imply? In particular, I am wondering about the
> ordering of tags from different groups?
Hopefully the test case I added shows how the sorting work. The tags
end up sorted as this:
("group_a" "tag_a_1" "tag_a_2" "groupless" "lonely" "tag_b_1" "tag_b_2")
Things end up with other things of their group. Things higher in the
heirarchy end up earlier. When things are on the same level (like
tag_a_1 and tag_a_2 or group_a and groupless) they are sorted using
`org-sort-function'.
> Also, what happens when there
> are no tag groups defined? (These questions should be answered in the
> docstring and the etc/ORG-NEWS entry you need to add, announcing the new
> feature)
Fallback to `org-sort-function'.
> Also, sorting may not be alphabetical, depending on the value of
> `org-sort-function'.
I have corrected this in the documentation.
>From 3f25374bbfd4134cea6ce0708633d500e8b41a89 Mon Sep 17 00:00:00 2001
From: Morgan Smith <morgan.j.sm...@outlook.com>
Date: Fri, 14 Jun 2024 17:38:41 -0400
Subject: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy
* lisp/org.el (org-tags-sort-hierarchy): New function.
(org-tags-sort-function): Add new function to type.
* testing/lisp/test-org-agenda.el (test-org-agenda/tags-sorting): Test
sorting with a value of 'org-tags-sort-hierarchy.
* etc/ORG-NEWS: Announce the new feature.
---
etc/ORG-NEWS | 7 ++++++
lisp/org.el | 41 ++++++++++++++++++++++++++++++++-
testing/lisp/test-org-agenda.el | 32 ++++++++++++++++++++-----
3 files changed, 73 insertions(+), 7 deletions(-)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 4c41f981c..62e8bb4ca 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -196,6 +196,13 @@ English. The default value is ~t~ as the CSL standard assumes that
English titles are specified in sentence-case but the bibtex
bibliography format requires them to be written in title-case.
+*** New tags sorting function ~org-tags-sort-hierarchy~
+
+By setting ~org-tags-sort-function~ to ~org-tags-sort-hierarchy~, tags
+are sorted taking their hierarchy into account. See ~org-tag-alist~
+for how to set up a tag hierarchy. Secondary sorting is done using
+~org-sort-function~.
+
** New functions and changes in function arguments
# This also includes changes in function behavior from Elisp perspective.
diff --git a/lisp/org.el b/lisp/org.el
index 748f258a2..6f5bf066d 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -231,6 +231,7 @@ Stars are put in group 1 and the trimmed body in group 2.")
(defvar org-element--timestamp-regexp)
(defvar org-indent-indentation-per-level)
(defvar org-radio-target-regexp)
+(defvar org-sort-function)
(defvar org-target-link-regexp)
(defvar org-target-regexp)
(defvar org-id-overriding-file-name)
@@ -2966,7 +2967,8 @@ default."
(const :tag "Default sorting" nil)
(const :tag "Alphabetical" org-string<)
(const :tag "Reverse alphabetical" org-string>)
- (function :tag "Custom function" nil)))
+ (const :tag "Sort by hierarchy" org-tags-sort-hierarchy)
+ (function :tag "Custom function" nil)))
(defvar org-tags-history nil
"History of minibuffer reads for tags.")
@@ -4275,6 +4277,43 @@ 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.
+See `org-tag-alist' for how to set up a tag hierarchy. Secondary
+sorting is done using `org-sort-function'. This function is intended to
+be a value of `org-tags-sort-function'."
+ (let ((group-alist (or org-tag-groups-alist-for-agenda
+ org-tag-groups-alist)))
+ (if (not (and org-group-tags
+ group-alist))
+ (funcall org-sort-function 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)
+ ;; Prevent infinite loop
+ (not (member tag (cdr result))))
+ 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 and does not allow us to use
+ ;; `org-sort-function'.
+ ;; (value< tag1-path tag2-path)
+ (catch :result
+ (dotimes (n (min (length tag1-path) (length tag2-path)))
+ ;; find the first difference and sort on that
+ (unless (string-equal (nth n tag1-path) (nth n tag2-path))
+ (throw :result (funcall org-sort-function (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-agenda.el b/testing/lisp/test-org-agenda.el
index 06d5abc43..d623389d4 100644
--- a/testing/lisp/test-org-agenda.el
+++ b/testing/lisp/test-org-agenda.el
@@ -663,18 +663,34 @@ Sunday 7 January 2024
(org-agenda-overriding-header "")
(org-agenda-prefix-format "")
(org-agenda-remove-tags t)
- (org-agenda-sorting-strategy '(tag-up)))))))
+ (org-agenda-sorting-strategy '(tag-up))))))
+ (org-tag-alist
+ '((:startgrouptag)
+ ("group_a")
+ (:grouptags)
+ ("tag_a_1")
+ ("tag_a_2")
+ ("group_a") ;; try to create infinite loop
+ (:endgrouptag)
+ (:startgroup)
+ ("tag_b_1")
+ ("tag_b_1") ;; duplicated
+ ("tag_b_2")
+ (:endgroup)
+ ("groupless")
+ ("lonely"))))
(org-test-agenda-with-agenda
(string-join
'("* TODO group_a :group_a:"
- "* TODO tag_a_1 :tag_a_1:"
+ "* TODO groupless :groupless:"
"* TODO tag_a_2 :tag_a_2:"
- "* TODO tag_b_1 :tag_b_1:"
"* TODO tag_b_2 :tag_b_2:"
- "* TODO groupless :groupless:"
+ "* TODO tag_a_1 :tag_a_1:"
+ "* TODO tag_b_1 :tag_b_1:"
"* TODO lonely :lonely:")
"\n")
- (dolist (org-tags-sort-function '(nil org-string< org-string> ignore))
+ (dolist (org-tags-sort-function '(nil org-string< org-string>
+ ignore org-tags-sort-hierarchy))
(should
(string-equal
(string-trim
@@ -685,7 +701,7 @@ Sunday 7 January 2024
;; Not sorted
('ignore
(string-join
- '("group_a" "tag_a_1" "tag_a_2" "tag_b_1" "tag_b_2" "groupless" "lonely")
+ '("group_a" "groupless" "tag_a_2" "tag_b_2" "tag_a_1" "tag_b_1" "lonely")
"\n"))
((or 'nil 'org-string<)
(string-join
@@ -694,6 +710,10 @@ Sunday 7 January 2024
('org-string>
(string-join
'("tag_b_2" "tag_b_1" "tag_a_2" "tag_a_1" "lonely" "groupless" "group_a")
+ "\n"))
+ ('org-tags-sort-hierarchy
+ (string-join
+ '("group_a" "tag_a_1" "tag_a_2" "groupless" "lonely" "tag_b_1" "tag_b_2")
"\n")))))))))
(ert-deftest test-org-agenda/goto-date ()
--
2.47.1
