emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] lisp/org.el: Add ability to sort tags by hierarchy
@ 2024-06-15 12:35 Morgan Smith
  2024-06-15 14:25 ` Ihor Radchenko
  0 siblings, 1 reply; 7+ messages in thread
From: Morgan Smith @ 2024-06-15 12:35 UTC (permalink / raw)
  To: emacs-orgmode; +Cc: 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



^ permalink raw reply related	[flat|nested] 7+ messages in thread
end of thread, other threads:[~2024-12-25  8:17 UTC | newest]

Thread overview: 7+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2024-06-15 12:35 [PATCH] lisp/org.el: Add ability to sort tags by hierarchy Morgan Smith
2024-06-15 14:25 ` Ihor Radchenko
2024-08-28 15:39   ` Ihor Radchenko
2024-08-28 16:10     ` Morgan Smith
2024-09-01 16:23       ` Ihor Radchenko
2024-12-24 21:48   ` Morgan Smith
2024-12-25  8:17     ` Ihor Radchenko

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).