From b8cc188103baec26c7af337417f8ef84c2af81da Mon Sep 17 00:00:00 2001 From: Jack Kamm Date: Sun, 29 Dec 2024 00:52:59 -0800 Subject: [PATCH 2/2] org-datetree: Add additional tree types (e.g. quarter, month+week) * lisp/org-capture.el (org-capture-templates): Update docstring for new datetree tree-type options. (org-capture-set-target-location): Allow tree-type to be a set, and switch to using `org-datetree-find-create-entry' to support this. * lisp/org-datetree.el: Add requirements on cal-iso and org-element. (org-datetree-find-date-create,org-datetree-find-month-create): Replace `org-datetree--find-create-group' with `org-datetree-find-create-entry'. (org-datetree--find-create-group): Removed in favor of `org-datetree-find-create-entry'. (org-datetree-find-iso-week-create): Turn into a wrapper for `org-datetree-find-create-entry'. (org-datetree-find-create-entry): Generalizes the now removed `org-datetree--find-create-group' to handle more general tree type sets. It is in turn a wrapper around `org-datetree-find-create-hierarchy' which allows for constructing other datetree hierarchies. (org-datetree--compare-fun-from-regex): Generator for string-comparison functions, used by `org-datetree-find-create-entry' when calling `org-datetree-find-create-hierarchy'. (org-datetree-find-create-hierarchy): New function that allows constructing generic types of datetrees for other calendar systems. (org-datetree-insert-line): Delete undocumented helper function. (org-datetree--find-create-subheading): Generic replacement for `org-datetree--find-create', that doesn't assume year/month/day calendar system. * testing/lisp/test-org-datetree.el (test-org-datetree/find-quarter-month-create): Test year-quarter-month datetree. (test-org-datetree/find-quarter-month-day-create): Test year-quarter-month-day datetree. (test-org-datetree/find-quarter-week-create): Test year-quarter-week datetree. (test-org-datetree/find-month-week-create): Test year-month-week datetree. --- doc/org-manual.org | 13 +- etc/ORG-NEWS | 43 ++++ lisp/org-capture.el | 13 +- lisp/org-datetree.el | 372 +++++++++++++++++------------- testing/lisp/test-org-datetree.el | 48 ++++ 5 files changed, 325 insertions(+), 164 deletions(-) diff --git a/doc/org-manual.org b/doc/org-manual.org index 1b3c33f96..93786f3f3 100644 --- a/doc/org-manual.org +++ b/doc/org-manual.org @@ -8177,10 +8177,15 @@ Now lets look at the elements of a template definition. Each entry in - ~:tree-type~ :: - Use ~week~ to make a week tree instead of the month-day tree, - i.e., place the headings for each day under a heading with the - current ISO week. Use ~month~ to group entries by month - only. Default is to group entries by day. + Default is to group entries by day. Use ~week~ to make a week + tree instead of the month-day tree, i.e., place the headings for + each day under a heading with the current ISO week. Use ~month~ + to group entries by month only. Use any subset of ~(year quarter + month week day)~ to group by the specified levels. In case + ~month~ and ~week~ are both specified, weeks are assigned to the + month containing Thursday, to be consistent with the ISO year-week + rule. In case ~quarter~ and ~week~ but not ~month~ are specified, + quarters are 13-week periods; otherwise they are 3-month periods. - ~:unnarrowed~ :: diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS index 85411ecc1..eb9967e96 100644 --- a/etc/ORG-NEWS +++ b/etc/ORG-NEWS @@ -141,6 +141,30 @@ See the new [[info:org#Repeating commands]["Repeating commands"]] section in Org Tables copied into the clipboard from LibreOffice Calc documents can now be pasted as an Org table using ~yank-media~. +*** New datetree capture ~:tree-type~ options +:PROPERTIES: +:CUSTOM_ID: 9.8-datetree-treetype +:END: + +For datetree capture, ~:tree-type~ can now be any subset of ~(year +quarter month week day)~ to construct a datetree with the specified +levels. For back-compatibility, the default value of ~nil~ is an +alias for ~(year month day)~, ~month~ is an alias for ~(year month)~, +and ~week~ is an alias for ~(year week day)~. + +If ~:tree-type~ is a superset of ~(month week)~, then weeks are +assigned to the month containing Thursday, to be consistent with the +ISO-8601 year-week rule. If ~:tree-type~ contains ~(quarter week)~ +but does not contain ~month~, then quarters are defined as 13-week +periods (the final quarter of a 53-week year has 14-weeks). +Otherwise, quarters are defined as 3-month periods. + +Furthermore, the new elisp function ~org-datetree-find-create-entry~ +generalizes ~org-datetree-find-date-create~, +~org-datetree-find-month-create~, and +~org-datetree-find-iso-week-create~ to handle the new available +datetree hierarchies. + ** New and changed options # Changes deadling with changing default values of customizations, @@ -281,6 +305,18 @@ leave extra prompts after evaluation, and skipping the prompt filtering can be more robust for such languages (as this avoids removing false positive prompts). +*** Elisp functions for new datetree tree-types + +Accompanying the [[#9.8-datetree-treetype][new datetree capture ~:tree-type~ options]], on the +elisp level ~org-datetree-find-create-entry~ provides the new tree +type options to generalize ~org-datetree-find-date-create~, +~org-datetree-find-month-create~, and +~org-datetree-find-iso-week-create~. + +In addition, ~org-datetree-find-create-hierarchy~ provides a mechanism +for constructing datetrees for other calendar systems (e.g. lunar +calendar, school semesters, the retail 4-4-5 calendar, etc). + ** Removed or renamed functions and variables *** ~org-cycle-display-inline-images~ is renamed to ~org-cycle-display-link-previews~ @@ -299,6 +335,13 @@ previews of supported link types besides image links. The behavior is unchanged, except in that the new variable now affects previews of supported link types besides image links. +*** Obsolete functions and variables removed from ~org-datetree~ + +Due to the refactoring of ~org-datetree~ to support the [[#9.8-datetree-treetype][new datetree +capture ~:tree-type~ options]], the internal variable +~org-datetree-base-level~ has been removed, as well as the +undocumented helper function ~org-datetree-insert-line~. + ** Miscellaneous *** Org mode no longer prevents =flyspell= from spell-checking inside =LOGBOOK= drawers diff --git a/lisp/org-capture.el b/lisp/org-capture.el index 486304df2..5d6f1df2d 100644 --- a/lisp/org-capture.el +++ b/lisp/org-capture.el @@ -293,7 +293,9 @@ (defcustom org-capture-templates nil :tree-type When `week', make a week tree instead of the month-day tree. When `month', make a month tree instead of the - month-day tree. + month-day tree. When any subset of + `(year quarter month week day)', create a datetree + hierarchy with the specified levels. :unnarrowed Do not narrow the target buffer, simply show the full buffer. Default is to narrow it so that you @@ -1090,10 +1092,13 @@ (defun org-capture-set-target-location (&optional target) ;; yesterday, if we are extending dates for a couple of ;; hours) (funcall + #'org-datetree-find-create-entry (pcase (org-capture-get :tree-type) - (`week #'org-datetree-find-iso-week-create) - (`month #'org-datetree-find-month-create) - (_ #'org-datetree-find-date-create)) + (`week '(year week day)) + (`month '(year month)) + (`day '(year month day)) + ((pred not) '(year month day)) + (grouping grouping)) (calendar-gregorian-from-absolute (cond (org-overriding-default-time diff --git a/lisp/org-datetree.el b/lisp/org-datetree.el index d0cc1fabb..7101cbf93 100644 --- a/lisp/org-datetree.el +++ b/lisp/org-datetree.el @@ -24,23 +24,20 @@ ;; ;;; Commentary: -;; This file contains code to create entries in a tree where the top-level -;; nodes represent years, the level 2 nodes represent the months, and the -;; level 1 entries days. +;; This file contains code to create entries in a tree where the +;; top-level nodes represent years, the level 2 nodes represent the +;; months, and the level 1 entries days. It also implements +;; extensions to the datetree that allow for other levels such as +;; quarters and weeks. ;;; Code: (require 'org-macs) (org-assert-version) +(require 'cal-iso) (require 'org) - -(defvar org-datetree-base-level 1 - "The level at which years should be placed in the date tree. -This is normally one, but if the buffer has an entry with a -DATE_TREE (or WEEK_TREE for ISO week entries) property (any -value), the date tree will become a subtree under that entry, so -the base level will be properly adjusted.") +(require 'org-element) (defcustom org-datetree-add-timestamp nil "When non-nil, add a time stamp matching date of entry. @@ -59,174 +56,237 @@ (defun org-datetree-find-date-create (d &optional keep-restriction) When it is nil, the buffer will be widened to make sure an existing date tree can be found. If it is the symbol `subtree-at-point', then the tree will be built under the headline at point." - (org-datetree--find-create-group d 'day keep-restriction)) + (org-datetree-find-create-entry '(year month day) d keep-restriction)) ;;;###autoload (defun org-datetree-find-month-create (d &optional keep-restriction) "Find or create a month entry for date D. Compared to `org-datetree-find-date-create' this function creates -entries grouped by month instead of days. +entries grouped by year-month instead of year-month-day. If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is nil, the buffer will be widened to make sure an existing date tree can be found. If it is the symbol `subtree-at-point', then the tree will be built under the headline at point." - (org-datetree--find-create-group d 'month keep-restriction)) - -(defun org-datetree--find-create-group - (d time-grouping &optional keep-restriction) - "Find or create an entry for date D. -If time-period is day, group entries by day. -If time-period is month, then group entries by month." - (setq-local org-datetree-base-level 1) - (save-restriction - (if (eq keep-restriction 'subtree-at-point) - (progn - (unless (org-at-heading-p) (error "Not at heading")) - (widen) - (org-narrow-to-subtree) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1))) - (unless keep-restriction (widen)) - ;; Support the old way of tree placement, using a property - (let ((prop (org-find-property "DATE_TREE"))) - (when prop - (goto-char prop) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) - (org-narrow-to-subtree)))) - (goto-char (point-min)) - (let ((year (calendar-extract-year d)) - (month (calendar-extract-month d)) - (day (calendar-extract-day d))) - (org-datetree--find-create - "\\([12][0-9]\\{3\\}\\)" - year nil nil nil t) - (org-datetree--find-create - "%d-\\([01][0-9]\\) \\w+" - year month nil nil t) - (when (eq time-grouping 'day) - (org-datetree--find-create - "%d-%02d-\\([0123][0-9]\\) \\w+" - year month day nil t))))) + (org-datetree-find-create-entry '(year month) d keep-restriction)) ;;;###autoload (defun org-datetree-find-iso-week-create (d &optional keep-restriction) "Find or create an ISO week entry for date D. Compared to `org-datetree-find-date-create' this function creates -entries ordered by week instead of months. -When it is nil, the buffer will be widened to make sure an existing date -tree can be found. If it is the symbol `subtree-at-point', then the tree -will be built under the headline at point." - (setq-local org-datetree-base-level 1) - (save-restriction - (if (eq keep-restriction 'subtree-at-point) - (progn - (unless (org-at-heading-p) (error "Not at heading")) - (widen) - (org-narrow-to-subtree) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1))) - (unless keep-restriction (widen)) - ;; Support the old way of tree placement, using a property - (let ((prop (org-find-property "WEEK_TREE"))) - (when prop - (goto-char prop) - (setq-local org-datetree-base-level - (org-get-valid-level (org-current-level) 1)) - (org-narrow-to-subtree)))) - (goto-char (point-min)) - (require 'cal-iso) - (let* ((year (calendar-extract-year d)) - (month (calendar-extract-month d)) - (day (calendar-extract-day d)) - (time (org-encode-time 0 0 0 day month year)) - (iso-date (calendar-iso-from-absolute - (calendar-absolute-from-gregorian d))) - (weekyear (nth 2 iso-date)) - (week (nth 0 iso-date))) - ;; ISO 8601 week format is %G-W%V(-%u) - (org-datetree--find-create - "\\([12][0-9]\\{3\\}\\)" - weekyear nil nil (format-time-string "%G" time) t) - (org-datetree--find-create - "%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 - "%d-%02d-\\([0123][0-9]\\) \\w+" year month day nil t)))) +entries grouped by year-week-day instead of year-month-day. If +KEEP-RESTRICTION is non-nil, do not widen the buffer. When it is +nil, the buffer will be widened to make sure an existing date +tree can be found. If it is the symbol `subtree-at-point', then +the tree will be built under the headline at point." + (org-datetree-find-create-entry '(year week day) d keep-restriction)) -(defun org-datetree--find-create - (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. +;;;###autoload +(defun org-datetree-find-create-entry + (time-grouping d &optional keep-restriction) + "Find or create an entry for date D. +TIME-GROUPING specifies the grouping levels of the datetree, and +should be a subset of `(year quarter month week day)'. Weeks are +assigned to years according to ISO-8601. If TIME-GROUPING +contains both `month' and `week', then weeks are assigned to the +month containing Thursday, for consistency with the ISO-8601 +year-week rule. If TIME-GROUPING contains `quarter' and `week' +but not `month', quarters are defined as 13-week periods; +otherwise they are defined as 3-month periods. -If MATCH-TITLE is non-nil, REGEX-TEMPLATE is matched against -heading title and the exact regexp matched against heading line is: +If KEEP-RESTRICTION is non-nil, do not widen the buffer. When it +is nil, the buffer will be widened to make sure an existing date +tree can be found. If it is the symbol `subtree-at-point', then +the tree will be built under the headline at point." + (let* ((year (calendar-extract-year d)) + (month (calendar-extract-month d)) + (day (calendar-extract-day d)) + (time (org-encode-time 0 0 0 day month year)) + (iso-date (calendar-iso-from-absolute + (calendar-absolute-from-gregorian d))) + (week (nth 0 iso-date)) + (nominal-year + (if (memq 'week time-grouping) + (nth 2 iso-date) + year)) + (nominal-month + (if (memq 'week time-grouping) + (calendar-extract-month + ;; anchor on Thurs, to be consistent with weekyear + (calendar-gregorian-from-absolute + (calendar-iso-to-absolute + `(,week 4 ,nominal-year)))) + month)) + (quarter (if (and (memq 'week time-grouping) + (not (memq 'month time-grouping))) + (min 4 (1+ (/ (1- week) 13))) + (1+ (/ (1- nominal-month) 3))))) + (org-datetree-find-create-hierarchy + (append + (when (memq 'year time-grouping) + (list (list (number-to-string nominal-year) + (org-datetree--compare-fun-from-regex + "\\([12][0-9]\\{3\\}\\)")))) + (when (memq 'quarter time-grouping) + (list (list (format "%d-Q%d" nominal-year quarter) + (org-datetree--compare-fun-from-regex + "\\([12][0-9]\\{3\\}-Q[1-4]\\)")))) + (when (memq 'month time-grouping) + (list (list (format-time-string + "%Y-%m %B" (org-encode-time 0 0 0 1 nominal-month + nominal-year)) + (org-datetree--compare-fun-from-regex + "\\([12][0-9]\\{3\\}-[01][0-9]\\) \\w+")))) + (when (memq 'week time-grouping) + (list (list (format-time-string "%G-W%V" time) + (org-datetree--compare-fun-from-regex + "\\([12][0-9]\\{3\\}-W[0-5][0-9]\\)")))) + (when (memq 'day time-grouping) + ;; Use regular date instead of ISO-week year/month + (list (list (format-time-string + "%Y-%m-%d %A" (org-encode-time 0 0 0 day month year)) + (org-datetree--compare-fun-from-regex + "\\([12][0-9]\\{3\\}-[01][0-9]-[0123][0-9]\\) \\w+"))))) + keep-restriction + ;; Support the old way of tree placement, using a property + (cond + ((seq-set-equal-p time-grouping '(year month day)) + "DATE_TREE") + ((seq-set-equal-p time-grouping '(year month)) + "DATE_TREE") + ((seq-set-equal-p time-grouping '(year week day)) + "WEEK_TREE"))) + (when (memq 'day time-grouping) + (when org-datetree-add-timestamp + (save-excursion + (end-of-line) + (insert "\n") + (org-indent-line) + (org-insert-timestamp + (org-encode-time 0 0 0 day month year) + nil + (eq org-datetree-add-timestamp 'inactive))))))) - (format org-complex-heading-regexp-format - (format regex-template year month day)) +(defun org-datetree--compare-fun-from-regex (sibling-regex) + "Construct comparison function based on regular expression. +SIBLING-REGEX should be a regex that matches the headline and its +siblings, with 1 match group. Headlines are compared by the +lexicographic ordering of match group 1." + (lambda (sibling-title new-title) + (let ((target-match (and (string-match sibling-regex new-title) + (match-string 1 new-title))) + (sibling-match (and (string-match sibling-regex sibling-title) + (match-string 1 sibling-title)))) + (cond + ((not (and target-match sibling-match)) nil) + ((string< sibling-match target-match) -1) + ((string> sibling-match target-match) 1) + (t 0))))) -If MATCH-TITLE is nil, the regexp matched against heading line is -REGEX-TEMPLATE: +(defun org-datetree-find-create-hierarchy + (hier-pairs &optional keep-restriction legacy-prop) + "Insert a new entry into a datetree from the entry's full date hierarchy. +HIER-PAIRS is a list whose first entry corresponds to the outermost element +(e.g. year) and last entry corresponds to the innermost (e.g. day). +Each entry of the list is a pair, the car is the headline for that level +(e.g. \"2024\" or \"2024-12-28\"), and the cadr is a string +comparison function for sorting each headline among its siblings. +The comparison function should take 2 arguments, corresponding to +the titles of 2 headlines, and return a negative number of the +first headline precedes the second, a positive number of the +second has precedence, 0 if the headlines are at the same time, +or `nil' if a headline isn't a valid datetree subheading. For +example, HIER-PAIRS could look like - (format regex-template year month day) + ((\"2024\" compare-year-fun) + (\"2024-12 December\" compare-month-fun) + (\"2024-12-28 Saturday\" compare-day-fun)) -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)) - ;; 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)) - (< (string-to-number (match-string 1)) (or day month year)))) - (cond - ((not match) - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (org-datetree-insert-line year month day insert)) - ((= (string-to-number (match-string 1)) (or day month year)) - (forward-line 0)) - (t - (forward-line 0) - (org-datetree-insert-line year month day insert))))) +where compare-month-fun would be some function where +(compare-month-fun \"2024-12-December\" \"2024-12-November\") is +negative, and (compare-month-fun \"2024-12-December\" \"Potato\") +is nil. -(defun org-datetree-insert-line (year &optional month day text) - (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) - (when (org--blank-before-heading-p) (insert "\n")) - (insert "\n" (make-string org-datetree-base-level ?*) " \n") - (backward-char) - (when month (org-do-demote)) - (when day (org-do-demote)) - (if text - (insert text) - (insert (format "%d" year)) - (when month +If KEEP-RESTRICTION is non-nil, do not widen the buffer. +When it is nil, the buffer will be widened to make sure an existing date +tree can be found. If it is the symbol `subtree-at-point', then the tree +will be built under the headline at point. + +If LEGACY-PROP is non-nil, the tree is located by searching for a +headline with property LEGACY-PROP, supporting the old way of +tree placement via a property." + (let (tree) + (save-restriction + ;; get the datetree base and narrow to it + (if (eq keep-restriction 'subtree-at-point) + (progn + (unless (org-at-heading-p) (error "Not at heading")) + (widen) + (org-narrow-to-subtree) + (setq tree (car (org-element-contents (org-element-parse-buffer 'headline))))) + (unless keep-restriction (widen)) + ;; Support the old way of tree placement, using a property + (let ((prop (and legacy-prop (org-find-property legacy-prop)))) + (if prop + (progn + (goto-char prop) + (org-narrow-to-subtree) + (setq tree (car (org-element-contents (org-element-parse-buffer 'headline))))) + (setq tree (org-element-parse-buffer))))) + (cl-loop + for pair in hier-pairs + do + (setq tree + (org-datetree--find-create-subheading + (cadr pair) (car pair) tree))) + tree))) + +(defun org-datetree--find-create-subheading + (compare-fun new-title tree) + "Find datetree subheading, or create it if it doesn't exist. +After insertion, move point to beginning of the subheading, and +narrow to its subtree. NEW-TITLE is the subheading to be found +or created. TREE is the parent headline, or an element of type +`org-data' if NEW-TITLE is to be at level 1. COMPARE-FUN is a +function of 2 arguments for comparing headline titles; it should +return a negative number if the first headline precedes the +second, a positive number if the second number has precedence, 0 +if the headlines are at the same time, and `nil' if a headline +isn't a valid datetree subheading at this level." + (let* ((level (if (eq (org-element-type tree) 'org-data) + 1 + (1+ (org-element-property :level tree)))) + (sibling (org-element-map tree 'headline + (lambda (d) + (when (= (org-element-property :level d) level) + (let ((compare-result + (funcall compare-fun + (org-element-property :raw-value d) + new-title))) + (and compare-result (>= compare-result 0) d)))) + nil t))) + ;; go to headline, or first successor sibling, or end of buffer + (if sibling + (goto-char (org-element-property :begin sibling)) + (goto-char (point-max)) + (unless (bolp) (insert "\n"))) + (if (and sibling + (= 0 (funcall compare-fun + (org-element-property :raw-value sibling) + new-title))) + ;; narrow and return the matched headline + (progn + (org-narrow-to-subtree) + sibling) + ;; insert new headline, narrow, and return it + (delete-region (save-excursion (skip-chars-backward " \t\n") (point)) (point)) + (when (org--blank-before-heading-p) (insert "\n")) (insert - (if day - (format-time-string "-%m-%d %A" (org-encode-time 0 0 0 day month year)) - (format-time-string "-%m %B" (org-encode-time 0 0 0 1 month year)))))) - (when (and day org-datetree-add-timestamp) - (save-excursion - (insert "\n") - (org-indent-line) - (org-insert-timestamp - (org-encode-time 0 0 0 day month year) - nil - (eq org-datetree-add-timestamp 'inactive)))) - (forward-line 0)) + (format "\n%s %s\n" + (make-string (if org-odd-levels-only (1- (* 2 level)) level) ?*) + new-title)) + (forward-line -1) + (org-narrow-to-subtree) + (org-element-at-point)))) (defun org-datetree-file-entry-under (txt d) "Insert a node TXT into the date tree under date D." diff --git a/testing/lisp/test-org-datetree.el b/testing/lisp/test-org-datetree.el index 620a916df..585bd692c 100644 --- a/testing/lisp/test-org-datetree.el +++ b/testing/lisp/test-org-datetree.el @@ -160,6 +160,54 @@ (ert-deftest test-org-datetree/find-month-create () (org-datetree-find-month-create '(3 29 2012))) (org-trim (buffer-string))))))) +(ert-deftest test-org-datetree/find-quarter-month-create () + "Test `org-datetree-find-quarter-month-create' specifications." + (let ((org-blank-before-new-entry '((heading . t)))) + ;; When date is missing, create it with the entry under month. + (should + (string-match + "\\`\\* 2012\n\n\\*\\* 2012-Q1\n\n\\*\\*\\* 2012-03 .*\\'" + (org-test-with-temp-text "" + (let ((org-datetree-add-timestamp nil)) + (org-datetree-find-create-entry '(year quarter month) '(3 29 2012))) + (org-trim (buffer-string))))))) + +(ert-deftest test-org-datetree/find-quarter-month-day-create () + "Test `org-datetree-find-quarter-month-day-create' specifications." + (let ((org-blank-before-new-entry '((heading . t)))) + ;; When date is missing, create it with the entry under month. + (should + (string-match + "\\`\\* 2012\n\n\\*\\* 2012-Q1\n\n\\*\\*\\* 2012-03 .*\n\n\\*\\*\\*\\* 2012-03-29 .*\\'" + (org-test-with-temp-text "" + (let ((org-datetree-add-timestamp nil)) + (org-datetree-find-create-entry '(year quarter month day) '(3 29 2012))) + (org-trim (buffer-string))))))) + +(ert-deftest test-org-datetree/find-quarter-week-create () + "Test `org-datetree-find-quarter-week-create' specifications." + (let ((org-blank-before-new-entry '((heading . t)))) + ;; When date is missing, create it with the entry under month. + (should + (string-match + "\\`\\* 2024\n\n\\*\\* 2024-Q4\n\n\\*\\*\\* 2024-W52\\'" + (org-test-with-temp-text "" + (let ((org-datetree-add-timestamp nil)) + (org-datetree-find-create-entry '(year quarter week) '(12 27 2024))) + (org-trim (buffer-string))))))) + +(ert-deftest test-org-datetree/find-month-week-create () + "Test `org-datetree-find-month-week-create' specifications." + (let ((org-blank-before-new-entry '((heading . t)))) + ;; When date is missing, create it with the entry under month. + (should + (string-match + "\\`\\* 2024\n\n\\*\\* 2024-12 .*\n\n\\*\\*\\* 2024-W52\\'" + (org-test-with-temp-text "" + (let ((org-datetree-add-timestamp nil)) + (org-datetree-find-create-entry '(year month week) '(12 27 2024))) + (org-trim (buffer-string))))))) + (ert-deftest test-org-datetree/find-iso-week-create () "Test `org-datetree-find-iso-date-create' specification." (let ((org-blank-before-new-entry '((heading . t)))) -- 2.47.1