branch: externals/org commit 23d219693ccf0e185bacaf00f8a7d9e609e635b8 Author: Morgan Smith <morgan.j.sm...@outlook.com> Commit: Ihor Radchenko <yanta...@posteo.net>
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 and docstring. * etc/ORG-NEWS: Announce the new feature. * testing/lisp/test-org-agenda.el (test-org-agenda/tags-sorting): Test sorting with a value of 'org-tags-sort-hierarchy. --- etc/ORG-NEWS | 7 +++++++ lisp/org.el | 43 ++++++++++++++++++++++++++++++++++++++++- testing/lisp/test-org-agenda.el | 31 +++++++++++++++++++++++++++-- 3 files changed, 78 insertions(+), 3 deletions(-) diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index a7763ef517..08d2bd9381 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -364,6 +364,13 @@ properties. Subsequent sorting functions will be used if two tags are found to be equivalent. See docstring for more information. +*** 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 +[[info:org#Tag Hierarchy][Tag Hierarchy]] for how to set up a tag +hierarchy. + *** New option ~org-cite-basic-complete-key-crm-separator~ This option makes ~org-cite~'s ~basic~ insert processor use diff --git a/lisp/org.el b/lisp/org.el index 178611f8e8..65abfbe1a3 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -3019,12 +3019,16 @@ that both tags are deemed equal and they will then be sorted by the next sort function in the list. A sort function can call `org-tag-sort' which will use the next sort -function in the list." +function in the list. + +For an example of a function that uses this advanced sorting system, see +`org-tags-sort-hierarchy'." :group 'org-tags :type '(choice (const :tag "Default sorting" nil) (const :tag "Alphabetical" org-string<) (const :tag "Reverse alphabetical" org-string>) + (const :tag "Sort by hierarchy" org-tags-sort-hierarchy) (function :tag "Custom function" nil) (repeat function))) @@ -4373,6 +4377,43 @@ See `org-tag-alist' for their structure." (t ; tag1 = tag2 'continue-loop))))))) +(defun org-tags-sort-hierarchy (tag1 tag2) + "Sort tags TAG1 and TAG2 by the tag hierarchy. + +See Info node `(org) Tag Hierarchy' or `org-tag-alist' for how to set up +a tag hierarchy. + +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)) + (org-tags-sort 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 (and + ;; Prevent infinite loop + (not (member tag (cdr result))) + (setq tag + (map-some + (lambda (key tags) + (when (member tag tags) + key)) + group-alist))) + (push tag result)) + result))) + (tag1-path (funcall tag-path-function tag1)) + (tag2-path (funcall tag-path-function tag2))) + (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 (org-tags-sort (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 3c2102905e..e59461bdb4 100644 --- a/testing/lisp/test-org-agenda.el +++ b/testing/lisp/test-org-agenda.el @@ -665,7 +665,24 @@ 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 + ;; Tag "blueberry" is intentionally not in this variable but + ;; used in testing + '((: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:" @@ -681,7 +698,9 @@ Sunday 7 January 2024 org-string< org-string> ignore ,string-length< (,string-length<) - (,string-length< org-string<))) + (,string-length< org-string<) + org-tags-sort-hierarchy + (org-tags-sort-hierarchy org-string>))) (should (string-equal (string-trim @@ -710,6 +729,14 @@ Sunday 7 January 2024 (`(,string-length< org-string<) (string-join '("lonely" "group_a" "tag_a_1" "tag_a_2" "tag_b_1" "tag_b_2" "blueberry" "groupless") + "\n")) + ('org-tags-sort-hierarchy + (string-join + '("blueberry" "group_a" "tag_a_1" "tag_a_2" "groupless" "lonely" "tag_b_1" "tag_b_2") + "\n")) + ('(org-tags-sort-hierarchy org-string>) + (string-join + '("tag_b_2" "tag_b_1" "lonely" "groupless" "group_a" "tag_a_2" "tag_a_1" "blueberry") "\n"))))))))) (ert-deftest test-org-agenda/goto-date ()