[PATCH] org-datetree.el: Allow datetrees with TODO, priority, tags

[Ilya Chernyshov <ichernyshovvv@gmail.com>]

[-- Attachment #1.1: Type: text/plain, Size: 327 bytes --]

Hi,

Here is a patch that allows to find datetree headlines that contain tags,
TODO or priority keywords.

Sometimes you need to set TODOs or tags to such headlines. When you do
this, next time you capture under this datetree, you get a new datetree
with the same date in the same file, which is annoying. This patch fixes it.

[-- Attachment #1.2: Type: text/html, Size: 417 bytes --]

[-- Attachment #2: 0001-lisp-org-datetree.el-Allow-datetrees-with-TODO-prior.patch --]
[-- Type: text/x-patch, Size: 6206 bytes --]

From 4d3194adf417ae5bad78c35a783ebca7974b8167 Mon Sep 17 00:00:00 2001
From: Ilya Chernyshov <ichernyshovvv@gmail.com>
Date: Thu, 15 Dec 2022 02:08:15 +0600
Subject: [PATCH] lisp/org-datetree.el: Allow datetrees with TODO, priority,
 tags

* org-datetree.el (org-datetree--find-create-group,
org-datetree-find-iso-week-create): Allow finding a datetree with
TODO keyword, priority keyword or tag group.

* testing/lisp/test-org-datetree.el
(test-org-datetree/find-date-create,
test-org-datetree/find-iso-week-create): Add tests for a datetree with
tags, TODO or priority keywords.

* etc/ORG-NEWS (Datetree structure headlines can now have tags, TODO, priority keywords): Document the change.

* doc/org-manual.org: Update datetree definition.
---
 doc/org-manual.org                |  2 +-
 etc/ORG-NEWS                      |  7 ++++++
 lisp/org-datetree.el              | 42 +++++++++++++++++++++++--------
 testing/lisp/test-org-datetree.el | 16 ++++++++++++
 4 files changed, 56 insertions(+), 11 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index f3b77ebad..4dfa91a94 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -22507,7 +22507,7 @@ level.
 ,*** 2022-10-08 Saturday
 #+end_example
 
-Tags are allowed in the tree structure.
+Tags, TODO, priority keywords are allowed in the tree structure.
 
 [fn:31] This is always the other, not the user.  See the variable
 ~org-link-from-user-regexp~.
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index c5d9bdf6e..794bdf143 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -55,6 +55,13 @@ document header:
 ,#+LATEX_HEADER: \DefineVerbatimEnvironment{lstlisting}{Verbatim}{...whatever...}
 #+END_src
 
+** New features
+*** Datetree structure headlines can now have tags, TODO, priority keywords
+
+~org-datetree-find-iso-week-create~ and
+~org-datetree--find-create-group~ functions can now find datetree
+headlines with tags, TODO or priority keywords
+
 * Version 9.6
 
 ** Important announcements and breaking changes
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 035ef047a..37e1ddf96 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -97,17 +97,28 @@ If time-period is month, then group entries by month."
     (goto-char (point-min))
     (let ((year (calendar-extract-year d))
 	  (month (calendar-extract-month d))
-	  (day (calendar-extract-day d)))
+	  (day (calendar-extract-day d))
+          (regexp-prefix (concat "^\\*+\\(?: +" (regexp-opt org-todo-keywords-1) "\\)?"
+                                 "\\(?: +\\[#.\\]\\)?"))
+          (tags-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?[ \t]*$"))
       (org-datetree--find-create
-       "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+       (concat
+        regexp-prefix
+        " +\\([12][0-9]\\{3\\}\\)"
+        tags-re)
        year)
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
+       (concat
+        regexp-prefix
+        " +%d-\\([01][0-9]\\) \\w+"
+        tags-re)
        year month)
       (when (eq time-grouping 'day)
 	(org-datetree--find-create
-	 "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+         (concat
+          regexp-prefix
+          " +%d-%02d-\\([0123][0-9]\\) \\w+"
+          tags-re)
 	 year month day)))))
 
 ;;;###autoload
@@ -144,20 +155,31 @@ will be built under the headline at point."
 	   (iso-date (calendar-iso-from-absolute
 		      (calendar-absolute-from-gregorian d)))
 	   (weekyear (nth 2 iso-date))
-	   (week (nth 0 iso-date)))
+	   (week (nth 0 iso-date))
+           (regexp-prefix (concat "^\\*+\\(?: +" (regexp-opt org-todo-keywords-1) "\\)?"
+                                  "\\(?: +\\[#.\\]\\)?"))
+           (tags-re "\\(?:[ \t]+:[[:alnum:]_@#%%:]+:\\)?[ \t]*$"))
       ;; ISO 8601 week format is %G-W%V(-%u)
       (org-datetree--find-create
-       "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
+       (concat
+        regexp-prefix
+        " +\\([12][0-9]\\{3\\}\\)"
+        tags-re)
        weekyear nil nil
        (format-time-string "%G" time))
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
+       (concat
+        regexp-prefix
+        " +%d-W\\([0-5][0-9]\\)"
+        tags-re)
        weekyear week nil
        (format-time-string "%G-W%V" time))
       ;; For the actual day we use the regular date instead of ISO week.
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
+       (concat
+        regexp-prefix
+        " +%d-%02d-\\([0123][0-9]\\) \\w+"
+        tags-re)
        year month day))))
 
 (defun org-datetree--find-create
diff --git a/testing/lisp/test-org-datetree.el b/testing/lisp/test-org-datetree.el
index 59ef8c33b..bd06462f2 100644
--- a/testing/lisp/test-org-datetree.el
+++ b/testing/lisp/test-org-datetree.el
@@ -58,6 +58,14 @@
         (let ((org-datetree-add-timestamp nil))
 	  (org-datetree-find-date-create '(3 29 2012)))
         (org-trim (buffer-string)))))
+    ;; Do not create new day node when one exists.
+    (should
+     (string-match
+      "\\`\\* DONE 2012 :tag1:tag2:\n\n\\*\\* TODO 2012-03 .*\n\n\\*\\*\\* \\[#A\\] 2012-03-29 .*\\'"
+      (org-test-with-temp-text "* DONE 2012 :tag1:tag2:\n\n** TODO 2012-03 month\n\n*** [#A] 2012-03-29 day :tag3:"
+        (let ((org-datetree-add-timestamp nil))
+	  (org-datetree-find-date-create '(3 29 2012)))
+        (org-trim (buffer-string)))))
     ;; Sort new entry in right place.
     (should
      (string-match
@@ -163,6 +171,14 @@
         (let ((org-datetree-add-timestamp nil))
 	  (org-datetree-find-iso-week-create '(12 31 2014)))
         (org-trim (buffer-string)))))
+    ;; Do not create new day node when one exists.
+    (should
+     (string-match
+      "\\`\\* TODO \\[#B\\] 2015\n\n\\*\\* 2015-W01 :tag1:\n\n\\*\\*\\* 2014-12-31 .*\\'"
+      (org-test-with-temp-text "* TODO [#B] 2015\n\n** 2015-W01 :tag1:\n\n*** 2014-12-31 day"
+        (let ((org-datetree-add-timestamp nil))
+	  (org-datetree-find-iso-week-create '(12 31 2014)))
+        (org-trim (buffer-string)))))
     ;; Sort new entry in right place.
     (should
      (string-match
-- 
2.39.0