[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[PATCH] lisp/org.el: Add ability to sort tags by hierarchy
From: |
Morgan Smith |
Subject: |
[PATCH] lisp/org.el: Add ability to sort tags by hierarchy |
Date: |
Sat, 15 Jun 2024 08:35:46 -0400 |
* 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
- [PATCH] lisp/org.el: Add ability to sort tags by hierarchy,
Morgan Smith <=