* 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))))) ;;; TODO keywords -- 2.45.1