Le lun. 1 juin 2026 à 14:26, Morgan Smith <[email protected]> a écrit : > > Thank you very much for this patch! I am very excited to get some > extension machinery into org-habit! > > Earl Chase <[email protected]> writes: > > > This is a complete refactor of `org-habit-parse-todo'. > > Well it's a refactor + the addition of some extension machinery. > Ideally this would be two patches to make reasoning about this a little > easier. >
I removed the extension code for now so that we can focus on just the refactor. > > I have also added tests in order to make sure the behavior of > > `org-habit-parse-todo' did not change. > > I do like tests and they are very important. However, we should avoid > duplicate tests to keep the test suite maintainable. I belive the tests > you've added only test situations that the current suite already tests. > Please let me know if this isn't the case. > I removed the new tests I added for org-habit-parse-todo. However, I think we should keep the new tests that I added for `org-habit--get-done-dates-for-todo'. I think it's important to be able to test the code that just fetches state change notes in complete isolation. Those tests will also certainly come in handy for the next stage of this process, which is refactoring `org-habit-build-graph'. I think there is a way to have `org-habit--get-done-dates-for-todo' fetch dates for more intelligently than it does now. > > Going forward, the key HABIT-TYPE can optionally be used > > to set the type of a habit. I have assigned the symbol `log-done' to > > the current and only habit-type supported by org-habit. > > `org-habit--get-rx-for-state-change-notes', > > `org-habit--get-done-dates-for-repeater', > > `org-habit--parse-todo-with-repeater' and `org-habit-parse-todo' take > > a habit-type as one of their arguments. They will only receive > > `log-done' for that value until other habit-types are implemented. The > > plan is to use those functions for numeric habits. This refactor will > > also simplify the process of adding time based habits. > > I get that you wanted to split things up into smaller functions but I > think you might have gone too small. I would put the functionality of > `org-habit--get-scheduled-date', > `org-habit--get-repeater-deadline-days-and-date', and > `org-habit--get-repeater-days-and-type' directly into > `org-habit--parse-todo-with-repeater'. > Yeah I went a little overboard there. I replaced `org-habit--get-repeater-deadline-days-and-date' and `org-habit--get-repeater-days-and-type' with `org-habit--get-repeater-and-deadline-data'. I also removed `org-habit--parse-todo-with-repeater' so that we could focus on just the refactor. > The way the code is now is a little hard to follow and the function > arguments aren't very well documented (see below). > > If you later need to split them out you can do that at a later time. > > Also we should probably deprecate `org-habit-duration-to-days' as you've > removed all uses of it. > > Done. > > From 881c039fab3dbdda3f5bfd01b1bb4e499d238050 Mon Sep 17 00:00:00 2001 > > From: ApollonDeParnasse <[email protected]> > > Date: Sun, 31 May 2026 13:10:27 -0500 > > Subject: [PATCH] org-habit.el: `org-habit-parse-todo' refactor > > > > +(defun org-habit--repeater-value-to-days (repeater-unit repeater-value) > > Would it be possible to use `org-agenda-span-to-ndays' instead? > Done. Honestly I was looking for a function like this originally. I only wrote that because I couldn't find anything. > > +(defun org-habit--get-scheduled-date (timestamp-element) > > + "Get the scheduled date in days for TIMESTAMP-ELEMENT." > > This gets the absolute number of days of the timestamp argument. > Nothing here is "scheduled" specific which is a little confusing. > You are right. I changed the name to `org-habit--convert-timestamp-to-days' and I updated the docstirng. To address your earlier comment, I am keeping this as a separate function as I think it could be useful elsewhere. > > +(defun org-habit--get-rx-for-state-change-notes (habit-type) > > + "Returns a regex for the state changes notes. > > +HABIT-TYPE should be `log-done'." > > + (let ((headings-key (pcase-exhaustive habit-type > > + (`log-done 'done) > > + (_ (error "Not implemented yet"))))) > > + (format > > + "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)" > > + (regexp-opt org-done-keywords) > > + org-ts-regexp-inactive > > + (let ((value (alist-get headings-key org-log-note-headings))) > > + (if (not value) "" > > + (concat "\\|" > > + (org-replace-escapes > > + (regexp-quote value) > > + `(("%d" . ,org-ts-regexp-inactive) > > + ("%D" . ,org-ts-regexp) > > + ("%s" . "\"\\S-+\"") > > + ("%S" . "\"\\S-+\"") > > + ("%t" . ,org-ts-regexp-inactive) > > + ("%T" . ,org-ts-regexp) > > + ("%u" . ".*?") > > + ("%U" . ".*?"))))))))) > > Would it be possible to use `org--log-note-format-regexp' here? > Slawomir just added this function very recently. > Done. > > +(defun org-habit--get-done-dates-for-repeater (element habit-type) > > + "Get closed dates from ELEMENT for HABIT-TYPE. > > +ELEMENT should be an org-element. > > An org-element of what type? Removed this function. > > > +(defun org-habit--parse-todo-with-repeater (element habit-type) > > + "Get data from ELEMENT with repeater for HABIT-TYPE. > > +ELEMENT should be an org-element. > > An org-element of what type? > Removed this function. > > +(defun org-habit--parse-todo (element habit-type) > > + "Get data for HABIT-TYPE from ELEMENT. > > +ELEMENT should be an org-element. > > An org-element of what type? > Removed this function. > > > I apologize if my criticisms seem harsh. It is not entirely clear to me > how you plan to eventually implement other habit styles. I see some of > these changes as needlessly complicating some rather straight forward > code. I'm sure I'd be more accepting of these changes if I could > understand your vision. > No problem, looking back this wasn't great code. I was too excited to get the ball rolling. As I said, this is going to be a long process so it's important for us to get on the same page. > I would really love for you to send me 3 patches. > > 1. A code refactor and cleanup that does not add any extension machinery > > 2. Add the extension machinery > > 3. Add another habit style > For the next patch, I am actually going to refactor `org-habit-build-graph'. Extension machinery will be completed in a future patch. > > If you send me a simple refactor I can approve and apply it right away. > > If you send me a patch adding extension machinery without an example > that uses it, I am very unlikely to accept it. > > Thank you very much for working on this and I hope you persevere and > see this through! > > Morgan
From 4ebbde7208f26d53840ef505acd33a839d114774 Mon Sep 17 00:00:00 2001 From: ApollonDeParnasse <[email protected]> Date: Sun, 31 May 2026 13:10:27 -0500 Subject: [PATCH] org-habit.el: `org-habit-parse-todo' refactor * lisp/org-habit.el (org-habit-parse-todo): Use `org-habit--get-repeater-and-deadline-data' and `org-habit--get-done-dates-for-todo' to get the list of data that represents a habit. (org-habit--get-done-dates-for-todo): Get the dates a todo with a repeater was completed. (org-habit--get-repeater-and-deadline-data): Get the date a habit is scheduled to repeat, the repeater value, as well as the deadline date and the deadline value in days if the repeater has a deadline. (org-habit--get-scheduled-date): Convert a timestamp element into a number of days since the epoch. (org-habit-build-graph): Use repeater symbols instead of the actual string repeater values. * testing/lisp/test-org-habit.el (org-habit--get-done-dates-for-todo-asserter): Helper function to create asserters for `org-habit--get-done-dates-for-todo' tests. (test-org-habit--get-done-dates-for-todo/log-done): Tests for `org-habit--get-done-dates-for-todo'. --- lisp/org-habit.el | 139 ++++++++++++++++++--------------- testing/lisp/test-org-habit.el | 132 +++++++++++++++++++++++++++++++ 2 files changed, 210 insertions(+), 61 deletions(-) diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 8d0108639..4276a6e54 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -35,6 +35,11 @@ (require 'org) (require 'org-agenda) +(declare-function org-element-property "org-element-ast" (property node)) +(declare-function org-element-end "org-element" (node)) +(declare-function org-agenda-span-to-ndays "org-agenda" (span &optional start-day)) +(declare-function org--log-note-format-regexp "org" (format)) + (defgroup org-habit nil "Options concerning habit tracking in Org mode." :tag "Org Habit" @@ -160,6 +165,7 @@ means of creating calendar-based reminders." :group 'org-faces) (defun org-habit-duration-to-days (ts) + (declare (obsolete nil "9.8")) (if (string-match "\\([0-9]+\\)\\([dwmy]\\)" ts) ;; lead time is specified. (floor (* (string-to-number (match-string 1 ts)) @@ -173,6 +179,64 @@ means of creating calendar-based reminders." EPOM is an element, marker, or buffer position." (string= "habit" (org-entry-get epom "STYLE" 'selective))) +(defun org-habit--convert-timestamp-to-days (timestamp-element) + "Convert TIMESTAMP-ELEMENT into a number of days since the epoch." + (if-let* ((time-string (org-element-property :raw-value timestamp-element))) + (time-to-days (org-time-string-to-time time-string)) + (error "Habit %s has no scheduled date" (org-element-property :title timestamp-element)))) + +(defun org-habit--get-repeater-and-deadline-data (timestamp-element) + "Extract repeater and deadline data from TIMESTAMP-ELEMENT. +Returns a list with the following elements: + +0: Scheduled date for the habit (may be in the past) +1: \".+\"-style repeater for the schedule, in days +2: Optional deadline (nil if not present) +3: If deadline, the repeater for the deadline, otherwise nil." + (let* ((scheduled-date-in-days (org-habit--convert-timestamp-to-days timestamp-element)) + (repeater-unit (org-element-property :repeater-unit timestamp-element)) + (repeater-value (org-element-property :repeater-value timestamp-element)) + (repeater-value-in-days (* repeater-value (org-agenda-span-to-ndays repeater-unit))) + (deadline-unit (org-element-property :repeater-deadline-unit timestamp-element)) + (deadline-value (org-element-property :repeater-deadline-value timestamp-element)) + (deadline-value-in-days (when deadline-value (* deadline-value (org-agenda-span-to-ndays deadline-unit)))) + (deadline-date-in-days (when (and deadline-value deadline-value-in-days) (+ scheduled-date-in-days (- deadline-value-in-days repeater-value-in-days))))) + (cond + ((<= repeater-value-in-days 0) (error "Habit %s scheduled repeat period is less than 1d" (org-element-property :title timestamp-element))) + ((and deadline-value-in-days (<= deadline-value-in-days repeater-value-in-days)) (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)" + (org-element-property :title timestamp-element) + repeater-value-in-days)) + (t (list scheduled-date-in-days repeater-value-in-days deadline-date-in-days deadline-value-in-days))))) + +(defun org-habit--get-done-dates-for-todo (headline-element) + "Get the dates a todo with a repeater was marked done. +HEADLINE-ELEMENT should be a headline element with a +TODO and state changes notes." + (org-back-to-heading t) + (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days)) + (reversed org-log-states-order-reversed) + (search (if reversed 're-search-forward 're-search-backward)) + (end (org-element-end headline-element)) + (limit (if reversed end (point))) + (count 0) + (done-dates) + (re (format + "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)" + (regexp-opt org-done-keywords) + org-ts-regexp-inactive + (let ((value (alist-get 'done org-log-note-headings))) + (if (not value) "" + (concat "\\|" (org--log-note-format-regexp value))))))) + (unless reversed (goto-char end)) + (while (and (< count maxdays) (funcall search re limit t)) + (push (time-to-days + (org-time-string-to-time + (or (match-string-no-properties 1) + (match-string-no-properties 2)))) + done-dates) + (setq count (1+ count))) + done-dates)) + (defun org-habit-parse-todo (&optional pom) "Parse the TODO surrounding point for its habit-related data. Returns a list with the following elements: @@ -181,69 +245,22 @@ Returns a list with the following elements: 1: \".+\"-style repeater for the schedule, in days 2: Optional deadline (nil if not present) 3: If deadline, the repeater for the deadline, otherwise nil - 4: A list of all the past dates this todo was mark closed - 5: Repeater type as a string + 4: A list of all the past dates this todo was mark done + 5: Symbol of the repeater type -This list represents a \"habit\" for the rest of this module." +This list represents a \"habit\" for the rest of this module. +When POM is non-nil, it should be a marker or point." (save-excursion (if pom (goto-char pom)) (cl-assert (org-is-habit-p (point))) - (let* ((scheduled (org-get-scheduled-time (point))) - (scheduled-repeat (org-get-repeat (org-entry-get (point) "SCHEDULED"))) - (end (org-entry-end-position)) - (habit-entry (org-no-properties (nth 4 (org-heading-components)))) - closed-dates deadline dr-days sr-days sr-type) - (if scheduled - (setq scheduled (time-to-days scheduled)) - (error "Habit %s has no scheduled date" habit-entry)) - (unless scheduled-repeat - (error - "Habit `%s' has no scheduled repeat period or has an incorrect one" - habit-entry)) - (setq sr-days (org-habit-duration-to-days scheduled-repeat) - sr-type (progn (string-match "[\\.+]?\\+" scheduled-repeat) - (match-string-no-properties 0 scheduled-repeat))) - (unless (> sr-days 0) - (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) - (when (string-match "/\\([0-9]+[dwmy]\\)" scheduled-repeat) - (setq dr-days (org-habit-duration-to-days - (match-string-no-properties 1 scheduled-repeat))) - (if (<= dr-days sr-days) - (error "Habit %s deadline repeat period is less than or equal to scheduled (%s)" - habit-entry scheduled-repeat)) - (setq deadline (+ scheduled (- dr-days sr-days)))) - (org-back-to-heading t) - (let* ((maxdays (+ org-habit-preceding-days org-habit-following-days)) - (reversed org-log-states-order-reversed) - (search (if reversed 're-search-forward 're-search-backward)) - (limit (if reversed end (point))) - (count 0) - (re (format - "^[ \t]*-[ \t]+\\(?:State \"%s\".*%s%s\\)" - (regexp-opt org-done-keywords) - org-ts-regexp-inactive - (let ((value (cdr (assq 'done org-log-note-headings)))) - (if (not value) "" - (concat "\\|" - (org-replace-escapes - (regexp-quote value) - `(("%d" . ,org-ts-regexp-inactive) - ("%D" . ,org-ts-regexp) - ("%s" . "\"\\S-+\"") - ("%S" . "\"\\S-+\"") - ("%t" . ,org-ts-regexp-inactive) - ("%T" . ,org-ts-regexp) - ("%u" . ".*?") - ("%U" . ".*?"))))))))) - (unless reversed (goto-char end)) - (while (and (< count maxdays) (funcall search re limit t)) - (push (time-to-days - (org-time-string-to-time - (or (match-string-no-properties 1) - (match-string-no-properties 2)))) - closed-dates) - (setq count (1+ count)))) - (list scheduled sr-days deadline dr-days closed-dates sr-type)))) + (let* ((headline-element (org-element-at-point)) + (scheduled-timestamp (org-element-property :scheduled headline-element)) + (repeater-type (org-element-property :repeater-type scheduled-timestamp)) + (repeater-and-deadline-data (if repeater-type + (org-habit--get-repeater-and-deadline-data scheduled-timestamp) + (error "Habit `%s' has no scheduled repeat period or has an incorrect one" (org-element-property :title headline-element)))) + (done-dates (org-habit--get-done-dates-for-todo headline-element))) + (append repeater-and-deadline-data (list done-dates repeater-type))))) (defsubst org-habit-scheduled (habit) (nth 0 habit)) @@ -363,8 +380,8 @@ current time." ;; At the last done date, use current ;; scheduling in all cases. ((null done-dates) scheduled) - ((equal type ".+") (+ last-done-date s-repeat)) - ((equal type "+") + ((equal type 'restart) (+ last-done-date s-repeat)) + ((equal type 'completed) ;; Since LAST-DONE-DATE, each done mark ;; shifted scheduled date by S-REPEAT. (- scheduled (* (length done-dates) s-repeat))) diff --git a/testing/lisp/test-org-habit.el b/testing/lisp/test-org-habit.el index b79bdf068..a4664f635 100644 --- a/testing/lisp/test-org-habit.el +++ b/testing/lisp/test-org-habit.el @@ -410,6 +410,138 @@ SCHEDULED: <2009-10-17 Sat +2d/" deadline "> (should-error (org-agenda nil "a"))))) +(defun org-habit--get-done-dates-for-todo-asserter (text expected-value) + "Helper for `org-habit--get-done-dates-for-todo' tests. +Creates an org buffer with TEXT. Assert the actual value +returned by `org-habit--get-done-dates-for-todo' is equal +to EXPECTED-VALUE." + (org-test-with-temp-text text (org-element-at-point) + (should (equal (org-habit--get-done-dates-for-todo (org-element-at-point)) expected-value)))) + +(ert-deftest test-org-habit--get-done-dates-for-todo () + "Test `org-habit--get-done-dates-for-todo'." + ;; no logbook + (org-habit--get-done-dates-for-todo-asserter + "* TODO habit +SCHEDULED: <2009-10-21 Sat ++2d> +:PROPERTIES: +:STYLE: habit +:END: +- State \"DONE\" from \"TODO\" [2009-10-19 Sun] +- State \"DONE\" from \"TODO\" [2009-10-17 Sun]" + (list 733697 733699)) + + (org-habit--get-done-dates-for-todo-asserter + "** TODO Read + SCHEDULED: <2026-05-31 Sun .+1d> + :PROPERTIES: + :LAST_REPEAT: [2026-05-30 Sat 23:03] + :STYLE: habit + :ORDERED: t + :END: + - State \"DONE\" from \"TODO\" [2026-05-30 Sat 23:03] + CLOCK: [2026-05-30 Sat 22:58]--[2026-05-30 Sat 23:03] => 0:05 + - State \"DONE\" from \"TODO\" [2026-05-29 Fri 23:31] + CLOCK: [2026-05-29 Fri 23:04]--[2026-05-29 Fri 23:31] => 0:27 + CLOCK: [2026-05-28 Thu 22:18]--[2026-05-28 Thu 22:43] => 0:25 + CLOCK: [2026-05-28 Thu 10:28]--[2026-05-28 Thu 10:33] => 0:05 + - State \"DONE\" from \"TODO\" [2026-05-28 Thu 10:05] + CLOCK: [2026-05-28 Thu 09:59]--[2026-05-28 Thu 10:05] => 0:06 + CLOCK: [2026-05-27 Wed 22:19]--[2026-05-27 Wed 22:40] => 0:21 + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 09:31]" + (list 739763 739764 739765 739766)) + + (org-habit--get-done-dates-for-todo-asserter + "* TODO Brush teeth + SCHEDULED: <2026-06-01 Mon .+1d> + :PROPERTIES: + :STYLE: habit + :LAST_REPEAT: [2026-05-31 Sun 05:09] + :END: + - State \"DONE\" from \"TODO\" [2026-05-31 Sun 05:09] + - State \"DONE\" from \"TODO\" [2026-05-30 Sat 22:36] + - State \"DONE\" from \"TODO\" [2026-05-30 Sat 07:26] + - State \"DONE\" from \"TODO\" [2026-05-29 Fri 05:09] + - State \"DONE\" from \"TODO\" [2026-05-28 Thu 23:02] + - State \"DONE\" from \"TODO\" [2026-05-28 Thu 05:09] + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 22:18] + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 05:11] + - State \"DONE\" from \"TODO\" [2026-05-26 Tue 22:26] + - State \"DONE\" from \"TODO\" [2026-05-26 Tue 05:09]" + (list 739762 739762 739763 739763 739764 739764 739765 739766 739766 739767)) + + ;; with logbook + (org-habit--get-done-dates-for-todo-asserter + "* TODO Read + SCHEDULED: <2026-05-31 Sun .+1d> + :PROPERTIES: + :STYLE: habit + :LAST_REPEAT: [2026-05-30 Sat 16:53] + :END: + :LOGBOOK: + CLOCK: [2026-05-30 Sat 23:08]--[2026-05-30 Sat 23:21] => 0:13 + - State \"DONE\" from \"TODO\" [2026-05-30 Sat 16:53] + CLOCK: [2026-05-30 Sat 16:38]--[2026-05-30 Sat 16:53] => 0:15 + CLOCK: [2026-05-29 Fri 23:42]--[2026-05-29 Fri 23:48] => 0:06 + CLOCK: [2026-05-29 Fri 19:44]--[2026-05-29 Fri 19:57] => 0:13 + - State \"DONE\" from \"TODO\" [2026-05-29 Fri 15:23] + CLOCK: [2026-05-29 Fri 15:09]--[2026-05-29 Fri 15:23] => 0:14 + CLOCK: [2026-05-28 Thu 23:02]--[2026-05-28 Thu 23:26] => 0:24 + CLOCK: [2026-05-28 Thu 18:40]--[2026-05-28 Thu 18:59] => 0:19 + CLOCK: [2026-05-28 Thu 13:41]--[2026-05-28 Thu 14:12] => 0:31 + CLOCK: [2026-05-27 Wed 22:43]--[2026-05-27 Wed 22:48] => 0:05 + CLOCK: [2026-05-27 Wed 19:21]--[2026-05-27 Wed 19:31] => 0:10 + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 12:58] + CLOCK: [2026-05-27 Wed 12:47]--[2026-05-27 Wed 12:58] => 0:11 + CLOCK: [2026-05-26 Tue 22:53]--[2026-05-26 Tue 23:10] => 0:17 + - State \"DONE\" from \"TODO\" [2026-05-26 Tue 17:03] + :END:" + (list 739762 739763 739765 739766)) + + (org-habit--get-done-dates-for-todo-asserter + "** TODO Good Habit + SCHEDULED: <2026-06-01 Mon .+3d> + :PROPERTIES: + :LAST_REPEAT: [2026-05-29 Fri 18:51] + :STYLE: habit + :END: + :LOGBOOK: + - State \"DONE\" from \"TODO\" [2026-05-29 Fri 18:51] + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 19:12] + - State \"DONE\" from \"TODO\" [2026-05-24 Sun 19:13] + - State \"DONE\" from \"TODO\" [2026-05-23 Sat 00:17] + - State \"DONE\" from \"TODO\" [2026-05-20 Wed 17:12] + - State \"DONE\" from \"TODO\" [2026-05-20 Wed 17:10] + - State \"DONE\" from \"TODO\" [2026-05-13 Wed 12:55] + - State \"DONE\" from \"TODO\" [2026-05-11 Mon 17:32] + - State \"DONE\" from \"TODO\" [2026-05-07 Thu 12:18] + - State \"DONE\" from \"TODO\" [2026-05-03 Sun 17:47] + :END:" + (list 739739 739743 739747 739749 739756 739756 739759 739760 739763 739765)) + + (org-habit--get-done-dates-for-todo-asserter + "*** TODO Write + SCHEDULED: <2026-05-31 Sun .+1d> + :PROPERTIES: + :LAST_REPEAT: [2026-05-30 Sat 23:03] + :STYLE: habit + :ID: bd4bd850-a1c7-40c9-b076-f5c4219d44dc + :ORDERED: t + :END: + :LOGBOOK: + - State \"DONE\" from \"TODO\" [2026-05-30 Sat 23:03] + CLOCK: [2026-05-30 Sat 22:58]--[2026-05-30 Sat 23:03] => 0:05 + - State \"DONE\" from \"TODO\" [2026-05-29 Fri 23:31] + CLOCK: [2026-05-29 Fri 23:04]--[2026-05-29 Fri 23:31] => 0:27 + CLOCK: [2026-05-28 Thu 22:18]--[2026-05-28 Thu 22:43] => 0:25 + CLOCK: [2026-05-28 Thu 10:28]--[2026-05-28 Thu 10:33] => 0:05 + - State \"DONE\" from \"TODO\" [2026-05-28 Thu 10:05] + CLOCK: [2026-05-28 Thu 09:59]--[2026-05-28 Thu 10:05] => 0:06 + CLOCK: [2026-05-27 Wed 22:19]--[2026-05-27 Wed 22:40] => 0:21 + - State \"DONE\" from \"TODO\" [2026-05-27 Wed 09:31] + :END:" + (list 739763 739764 739765 739766))) + (provide 'test-org-habit) -- 2.54.0
