Ihor Radchenko <yanta...@posteo.net> writes:

Ilya Chernyshov <ichernysho...@gmail.com> writes:

 (defun org-datetree--find-create
@@ -169,18 +167,19 @@ component. If INSERT is non-nil and there is no match then it is
 inserted into the buffer."
   (when (or month day)
     (org-narrow-to-subtree))
-  (let ((re (format regex-template year month day))
+  (let ((re (format org-complex-heading-regexp-format
+                    (format regex-template year month day)))

These changes make the docstring for `org-datetree--find-create'
incorrect:

    (defun org-datetree--find-create
        (regex-template year &optional month day insert)
"Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY. REGEX-TEMPLATE is passed to `format' with YEAR, MONTH, and DAY as arguments. Match group 1 is compared against the specified date component. If INSERT is non-nil and there is no match then it is
    inserted into the buffer."

Please update the docstring to reflect the new behaviour.

Hi!

Since the last patch, I've made the following changes, thanks to your
recommendations in Matrix chat:

1. Added a new optional argument MATCH-TITLE to
`org-datetree--find-create' that controls whether to match
REGEX-TEMPLATE against heading title inside complex heading (the match
is done via `org-complex-heading-regexp-format') or to match
REGEX-TEMPLATE against the whole heading line(old behavior). That way,
we won't break old calls to the function.

2. Added `replace-match' call that renames the first implicitly numbered match group inside REGEX-TEMPLATE to first explicitly numbered one. The
replace is performed only if MATCH-TITLE is non-nil(that is,
`org-complex-heading-regexp-format' is used). That way we ensure that
even if in the future `org-complex-heading-regexp-format' will be
changed (the number of match groups will be different), we can get
access to the right group matching a date component without modifying the source code of the function. Is there a better way to ensure that?

>From 481d8b4049f09cf880b584635a778e976a609f5c Mon Sep 17 00:00:00 2001
From: Ilya Chernyshov <ichernysho...@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): Add optional argument
MATCH-TITLE that controls whether to match REGEX-TEMPLATE against
heading title inside complex heading or to match REGEX-TEMPLATE
against the whole heading line.

* org-datetree.el (org-datetree--find-create-group,
org-datetree-find-iso-week-create): Allow finding a datetree with TODO
state, priority, tags, statistics cookies, or COMMENT keyword.

* 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 be complex):
Document the change.

* doc/org-manual.org: Update datetree definition.
---
 doc/org-manual.org                |  3 +-
 etc/ORG-NEWS                      |  6 ++++
 lisp/org-datetree.el              | 57 ++++++++++++++++++++-----------
 testing/lisp/test-org-datetree.el | 16 +++++++++
 4 files changed, 61 insertions(+), 21 deletions(-)

diff --git a/doc/org-manual.org b/doc/org-manual.org
index f3b77ebad..f816f8725 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -22507,7 +22507,8 @@ level.
 ,*** 2022-10-08 Saturday
 #+end_example
 
-Tags are allowed in the tree structure.
+TODO state, priority, tags, statistics cookies, and COMMENT 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..0aeb76f2f 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -55,6 +55,12 @@ document header:
 ,#+LATEX_HEADER: \DefineVerbatimEnvironment{lstlisting}{Verbatim}{...whatever...}
 #+END_src
 
+** New features
+*** Datetree structure headlines can now be complex
+
+TODO state, priority, tags, statistics cookies, and COMMENT keywords
+are allowed in the tree structure.
+
 * Version 9.6
 
 ** Important announcements and breaking changes
diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el
index 035ef047a..8a617e90c 100644
--- a/lisp/org-datetree.el
+++ b/lisp/org-datetree.el
@@ -99,16 +99,15 @@ If time-period is month, then group entries by month."
 	  (month (calendar-extract-month d))
 	  (day (calendar-extract-day d)))
       (org-datetree--find-create
-       "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
-       year)
+       "\\([12][0-9]\\{3\\}\\)"
+       year nil nil nil t)
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-\\([01][0-9]\\) \\w+$"
-       year month)
+       "%d-\\([01][0-9]\\) \\w+"
+       year month nil nil t)
       (when (eq time-grouping 'day)
 	(org-datetree--find-create
-	 "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
-	 year month day)))))
+         "%d-%02d-\\([0123][0-9]\\) \\w+"
+	 year month day nil t)))))
 
 ;;;###autoload
 (defun org-datetree-find-iso-week-create (d &optional keep-restriction)
@@ -147,33 +146,51 @@ will be built under the headline at point."
 	   (week (nth 0 iso-date)))
       ;; ISO 8601 week format is %G-W%V(-%u)
       (org-datetree--find-create
-       "^\\*+[ \t]+\\([12][0-9]\\{3\\}\\)\\(\\s-*?\
-\\([ \t]:[[:alnum:]:_@#%%]+:\\)?\\s-*$\\)"
-       weekyear nil nil
-       (format-time-string "%G" time))
+       "\\([12][0-9]\\{3\\}\\)"
+       weekyear nil nil (format-time-string "%G" time) t)
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-W\\([0-5][0-9]\\)$"
-       weekyear week nil
-       (format-time-string "%G-W%V" time))
+       "%d-W\\([0-5][0-9]\\)"
+       weekyear week nil (format-time-string "%G-W%V" time) t)
       ;; For the actual day we use the regular date instead of ISO week.
       (org-datetree--find-create
-       "^\\*+[ \t]+%d-%02d-\\([0123][0-9]\\) \\w+$"
-       year month day))))
+       "%d-%02d-\\([0123][0-9]\\) \\w+" year month day nil t))))
 
 (defun org-datetree--find-create
-    (regex-template year &optional month day insert)
+    (regex-template year &optional month day insert match-title)
   "Find the datetree matched by REGEX-TEMPLATE for YEAR, MONTH, or DAY.
 REGEX-TEMPLATE is passed to `format' with YEAR, MONTH, and DAY as
-arguments.  Match group 1 is compared against the specified date
+arguments.
+
+If MATCH-TITLE is non-nil, REGEX-TEMPLATE is matched against
+heading title and the exact regexp matched against heading line is:
+
+  (format org-complex-heading-regexp-format
+          (format regex-template year month day))
+
+If MATCH-TITLE is nil, the regexp matched against heading line is
+REGEX-TEMPLATE:
+
+  (format regex-template year month day)
+
+Match group 1 in REGEX-TEMPLATE is compared against the specified date
 component.  If INSERT is non-nil and there is no match then it is
 inserted into the buffer."
   (when (or month day)
     (org-narrow-to-subtree))
-  (let ((re (format regex-template year month day))
+  ;; ensure that the first match group in REGEX-TEMPLATE
+  ;; is the first inside `org-complex-heading-regexp-format'
+  (when (and match-title
+             (not (string-match-p "\\\\(\\?1:" regex-template))
+             (string-match "\\\\(" regex-template))
+    (setq regex-template (replace-match "\\(?1:" nil t regex-template)))
+  (let ((re (if match-title
+                (format org-complex-heading-regexp-format
+                        (format regex-template year month day))
+              (format regex-template year month day)))
 	match)
     (goto-char (point-min))
     (while (and (setq match (re-search-forward re nil t))
-		(goto-char (match-beginning 1))
+                (goto-char (match-beginning 1))
 		(< (string-to-number (match-string 1)) (or day month year))))
     (cond
      ((not match)
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


--
Best,
Ilya

Reply via email to