[PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Morgan Smith]

* 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

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Ihor Radchenko]

Morgan Smith <Morgan.J.Smith@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? 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)

Also, sorting may not be alphabetical, depending on the value of
`org-sort-function'.

-- 
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>

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Ihor Radchenko]

Ihor Radchenko <yantar92@posteo.net> writes:

> ... may you please elaborate what kind of sorting
> order does your function imply? ...

It has been over a month. Have you had a chance to look into my
questions?

-- 
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>

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Morgan Smith]

Ihor Radchenko <yantar92@posteo.net> writes:

> Ihor Radchenko <yantar92@posteo.net> writes:
>
>> ... may you please elaborate what kind of sorting
>> order does your function imply? ...
>
> It has been over a month. Have you had a chance to look into my
> questions?

After you asked that question, I decided to demonstrate the changes I
wanted to make by also submitting a test.  However, I thought it prudent
to first test what we already have.  So I was waiting for a response to
my other patch (linked below) adding that test before continuing with
this thread.

I didn't make my intentions clear.  Sorry about that.  Thanks for
following up!  I appreciate that.

https://list.orgmode.org/CH3PR84MB342464F6458F91EE5800545AC5C32@CH3PR84MB3424.NAMPRD84.PROD.OUTLOOK.COM/

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Ihor Radchenko]

Morgan Smith <morgan.j.smith@outlook.com> writes:

>> It has been over a month. Have you had a chance to look into my
>> questions?
>
> After you asked that question, I decided to demonstrate the changes I
> wanted to make by also submitting a test.  However, I thought it prudent
> to first test what we already have.  So I was waiting for a response to
> my other patch (linked below) adding that test before continuing with
> this thread.

I replied in that thread.
We can come back to the patch herein after finalizing the other patch.

-- 
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>

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Morgan Smith]

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

Hello!

I have updated the patch with many improvements and tests.

Ihor Radchenko <yantar92@posteo.net> writes:

> Morgan Smith <Morgan.J.Smith@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.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-lisp-org.el-Add-ability-to-sort-tags-by-hierarchy.patch --]
[-- Type: text/x-patch, Size: 6912 bytes --]

From 3f25374bbfd4134cea6ce0708633d500e8b41a89 Mon Sep 17 00:00:00 2001
From: Morgan Smith <Morgan.J.Smith@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

Re: [PATCH] lisp/org.el: Add ability to sort tags by hierarchy

[Ihor Radchenko]

Morgan Smith <morgan.j.smith@outlook.com> writes:

>> 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'.

I am not sure if it is the best idea to hard-code using
`org-sort-function' here.

What if a user wants specific `org-sort-function' for, say, table
sorting, but something else for tags?
Secondary sorting would better be customizeable.

Maybe you can have a function generator that will work like

(org-tags-sort-hierarchy-by org-sort-function)
or
(org-tags-sort-hierarchy-by #'string<)

-- 
Ihor Radchenko // yantar92,
Org mode maintainer,
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>