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