Hello Earl! I apologize for the delay. Your most recent patch has now sat unreviewed for almost a month. It was not my intention to let it sit that long.
I also apologize for changing my mind a few times in this thread. This is my first proper review and I am a bit of perfectionist. We have had more back and forth then is probably necessary due to my lack of experience. I have thought about this for a while and I have decided that presenting a refined patch in response to someone's patch is perfectly reasonable (and just FYI is something I've had reviewers do to me on many occasions). However, I don't believe the language I used when presenting the patch in this thread was ideal. It did indeed sound like I was "taking over" this issue. My intention was to collaborate and thus in the future I will try to use language that emphasizes that intention. I do stand by a pretty important idea that I have been trying to communicate in this thread: do 1 clear change per commit. You're still trying to do both the API change over and reorganization in 1 commit. Moving some of the functionality of the monolithic function into multiple, smaller, well documented functions could make the code more readable. However, I'm not convinced your reorganization accomplishes this. As I've said previously (although probably not communicated the best), the reorganization can wait until a future thread where we take advantage of some reorganization to implement some new features. To repeat: I do want the code reorganized. I just want to do that at a later time when we're implementing new features. See attached two patches. The first one is the new tests you've submitted. I refactored them a little but they are mostly untouched. They are good tests! Thank you very much for creating them! > I added week, month and years tests I don't see any tests for year repeaters. Not strictly necessary but it would be nice to have some. > In the future, it would be good to actually ... assert the correct errors are > thrown for each type of malformed data. ERT has ways to check for the type of error (ex. calc does `(signal 'math-overflow nil)`) but it does not have a way of checking the error message as far as I know. I would also be interested in testing errors more precisely. I've split the tests out into its own commit so we can run these new tests before and after our changes are applied. The second commit is I believe actually identical to the first patch I sent you. Using the following git command you can see the logic and ordering is the same while only switching out the API git show --word-diff=color --word-diff-regex='[^[:space:]()]+' --diff-algorithm=histogram HEAD If you're happy with those two commits, then I can apply them and we can close out this thread. The commits have already passed my fairly comprehensive local CI system. Tests pass after each patch on emacs 30.2. Tests pass after final patch on emacs 28 and 29 and a recent emacs/master build. Tests pass after final patch with TZ set to UTC, Europe/Istanbul, and America/New_York. Tests pass after final patch with the locale set to C, en_US, fr_FR, de_DE, and he_IL. > Is there any reason specifically that I should use `pcase' over `cl-case'? It was just a nitpick. cl-case is a simpler function that does exactly what you where trying to do. Logically the solutions are identical. I would imagine cl-case is faster but I haven't tested it. I really do appreciate the work you've put into this. Overall you've submitted some really high quality patches! I do hope we can continue to work together on some things. I'm sorry this has dragged on so long and I appreciate your patience as I learn some communication skills and develop my standards for contributions. You've helped me in many ways in this thread :)
>From 2b2f3b21c0d9147892942634a546150c2be7c496 Mon Sep 17 00:00:00 2001 From: ApollonDeParnasse <[email protected]> Date: Mon, 13 Jul 2026 16:24:13 -0400 Subject: [PATCH 1/2] Testing: New org-habit tests * testing/lisp/test-org-habit.el (org-test-habit): Fix docstring typo. (test-org-habit/simple-habit/week) (test-org-habit/simple-habit/month) (test-org-habit/bad-habit-bad-repeater): New tests (test-org-habit/bad-habit-short-repeater) (test-org-habit/bad-habit-no-scheduled): Add more test cases --- testing/lisp/test-org-habit.el | 100 ++++++++++++++++++++++++++++++--- 1 file changed, 92 insertions(+), 8 deletions(-) diff --git a/testing/lisp/test-org-habit.el b/testing/lisp/test-org-habit.el index 7bd3ee53a..20f9a4522 100644 --- a/testing/lisp/test-org-habit.el +++ b/testing/lisp/test-org-habit.el @@ -122,6 +122,68 @@ test-org-habit/simple-habit (org-agenda nil "f") (buffer-string))))))))) +(ert-deftest test-org-habit/simple-habit/week () + "Test the agenda view for a simple habit." + (org-test-with-timezone "UTC0" + (org-test-at-time "2026-06-16" + (let ((org-agenda-custom-commands + org-test-habit-no-fluff-agenda) + (org-habit-graph-column 5)) + (org-test-agenda-with-agenda + "* TODO habit +SCHEDULED: <2026-06-16 Tue +1w> +:PROPERTIES: +:STYLE: habit +:END: +- State \"DONE\" from \"TODO\" [2026-06-16 Tue] +- State \"DONE\" from \"TODO\" [2026-06-09 Tue] +- State \"DONE\" from \"TODO\" [2026-06-02 Tue] +- State \"DONE\" from \"TODO\" [2026-05-26 Tue] +- State \"DONE\" from \"TODO\" [2026-05-12 Tue] +- State \"DONE\" from \"TODO\" [2026-05-05 Tue] +- State \"DONE\" from \"TODO\" [2026-04-28 Tue] +- State \"DONE\" from \"TODO\" [2026-04-21 Tue] +- State \"DONE\" from \"TODO\" [2026-04-14 Tue] +- State \"DONE\" from \"TODO\" [2026-04-07 Tue] +- State \"DONE\" from \"TODO\" [2026-03-31 Tue]" + (should + (string-equal + "\nhabit* * * * \n" + (progn + (org-agenda nil "f") + (buffer-string))))))))) + +(ert-deftest test-org-habit/simple-habit/month () + "Test the agenda view for a simple habit." + ;; Avoid DST when TZ="Europe/Istanbul". See `test-org-habit/dst'. + (org-test-with-timezone "UTC0" + (org-test-at-time "2026-06-17" + (let ((org-agenda-custom-commands + org-test-habit-no-fluff-agenda) + (org-habit-graph-column 5)) + (org-test-agenda-with-agenda + "* TODO habit +SCHEDULED: <2026-06-17 Wed .+1m/3m> +:PROPERTIES: +:STYLE: habit +:LAST_REPEAT: [2026-05-17 Mon 00:36] +:END: +- State \"DONE\" from \"TODO\" [2026-05-17 Sun] +- State \"DONE\" from \"TODO\" [2026-04-16 Thu] +- State \"DONE\" from \"TODO\" [2026-03-17 Tue] +- State \"DONE\" from \"TODO\" [2026-02-14 Sat] +- State \"DONE\" from \"TODO\" [2025-12-15 Mon] +- State \"DONE\" from \"TODO\" [2025-11-15 Sat] +- State \"DONE\" from \"TODO\" [2025-09-15 Mon] +- State \"DONE\" from \"TODO\" [2025-08-16 Sat] +- State \"DONE\" from \"TODO\" [2025-07-16 Wed]" + (should + (string-equal + "\nhabit ! \n" + (progn + (org-agenda nil "f") + (buffer-string))))))))) + (ert-deftest test-org-habit/org-extend-today-until () "Test habit graph with `org-extend-today-until' set." :expected-result :failed @@ -376,16 +438,30 @@ test-org-habit/bad-habit-no-repeater (should-error (org-agenda nil "a")))) -(ert-deftest test-org-habit/bad-habit-short-repeater () - "Test a habit with a period of less then 1 day." - (org-test-agenda-with-agenda - "* TODO repeat period less then 1 day -SCHEDULED: <2009-10-17 Sat +0d> +(ert-deftest test-org-habit/bad-habit-bad-repeater () + "Test a habit with a bad repeater." + (dolist (repeater '("7d" "12w" "3m" ".+7" "+7" "++2")) + (org-test-agenda-with-agenda + (concat "* TODO bad repeater +SCHEDULED: <2026-01-21 Wed " repeater "> :PROPERTIES: :STYLE: habit -:END:" - (should-error - (org-agenda nil "a")))) +:END:") + (should-error + (org-agenda nil "a"))))) + +(ert-deftest test-org-habit/bad-habit-short-repeater () + "Test a habit with a period of less then 1 day." + (dolist (repeater '("+0d" "+0w" "+1h" "+23h")) + (org-test-agenda-with-agenda + (concat + "* TODO repeat period less then 1 day +SCHEDULED: <2009-10-17 Sat " repeater "> +:PROPERTIES: +:STYLE: habit +:END:") + (should-error + (org-agenda nil "a"))))) (ert-deftest test-org-habit/bad-habit-no-scheduled () "Test a habit that is not scheduled." @@ -393,6 +469,14 @@ test-org-habit/bad-habit-no-scheduled "* TODO no scheduled <2009-10-17 Sat +1d> :PROPERTIES: :STYLE: habit +:END:" + (should-error + (org-agenda nil "a"))) + + (org-test-agenda-with-agenda + "* TODO no scheduled <2026-06-17 Wed 11:59 +1d> +:PROPERTIES: +:STYLE: habit :END:" (should-error (org-agenda nil "a")))) -- 2.54.0
>From a69efcc2fe4de7990fe5481a7a6c89bf13abaf94 Mon Sep 17 00:00:00 2001 From: ApollonDeParnasse <[email protected]> Date: Sun, 19 Jan 2025 17:27:05 -0500 Subject: [PATCH 2/2] org-habit.el: Rewrite using element API * lisp/org-habit.el (org-habit-repeater-to-days): New function. (org-habit-duration-to-days): Use `org-habit-repeater-to-days'. (org-habit-parse-todo): Accept an element as an argument. Use org-element getters. Move `save-excursion' to only be around section that modifies point. Co-authored-by: Morgan Smith <[email protected]> --- lisp/org-habit.el | 147 ++++++++++++++++++++++++++-------------------- 1 file changed, 83 insertions(+), 64 deletions(-) diff --git a/lisp/org-habit.el b/lisp/org-habit.el index 8d0108639..bf52e50e8 100644 --- a/lisp/org-habit.el +++ b/lisp/org-habit.el @@ -159,13 +159,23 @@ org-habit-overdue-future-face :group 'org-habit :group 'org-faces) +(defun org-habit-repeater-to-days (value unit) + (floor (* value + (cdr (or + (assoc unit + '((day . 1) + (week . 7) + (month . 30.4) + (year . 365.25))) + (error "Unsupported duration unit: %s" unit)))))) + (defun org-habit-duration-to-days (ts) (if (string-match "\\([0-9]+\\)\\([dwmy]\\)" ts) ;; lead time is specified. - (floor (* (string-to-number (match-string 1 ts)) - (cdr (assoc (match-string 2 ts) - '(("d" . 1) ("w" . 7) - ("m" . 30.4) ("y" . 365.25)))))) + (org-habit-repeater-to-days (string-to-number (match-string 1 ts)) + (cdr (assoc (match-string 2 ts) + '(("d" . day) ("w" . week) + ("m" . month) ("y" . year))))) (error "Invalid duration string: %s" ts))) (defun org-is-habit-p (&optional epom) @@ -173,77 +183,86 @@ org-is-habit-p EPOM is an element, marker, or buffer position." (string= "habit" (org-entry-get epom "STYLE" 'selective))) -(defun org-habit-parse-todo (&optional pom) - "Parse the TODO surrounding point for its habit-related data. +(defun org-habit-parse-todo (&optional epom) + "Parse the TODO EPOM for its habit-related data. +EPOM is an element, marker, or buffer position. + 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 - 4: A list of all the past dates this todo was mark closed + 4: A list of all the past dates this todo was marked done 5: Repeater type as a string This list represents a \"habit\" for the rest of this module." - (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))) + (let ((todo (org-element-at-point epom))) + (cl-assert (org-is-habit-p todo)) + (let* ((habit-entry (org-no-properties (org-element-property :title todo))) + (scheduled + (or (org-element-property :scheduled todo) + (error "Habit %s has no scheduled date" habit-entry))) + (scheduled-repeat-value (org-element-property :repeater-value scheduled)) + (scheduled-repeat-unit (org-element-property :repeater-unit scheduled)) + (scheduled-repeat-deadline-value (org-element-property :repeater-deadline-value scheduled)) + (scheduled-repeat-deadline-unit (org-element-property :repeater-deadline-unit scheduled)) + (sr-type (pcase (org-element-property :repeater-type scheduled) + (`cumulate "+") (`catch-up "++") (`restart ".+"))) + closed-dates deadline dr-days sr-days ) + (setq scheduled (time-to-days (org-timestamp-to-time scheduled))) + (unless (and scheduled-repeat-value scheduled-repeat-unit) + (error + "Habit `%s' has no scheduled repeat period or has an incorrect one" + habit-entry)) + (setq sr-days (org-habit-repeater-to-days scheduled-repeat-value scheduled-repeat-unit)) (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) + (error "Habit %s scheduled repeat period is less than 1d" habit-entry)) + (when (and scheduled-repeat-deadline-value scheduled-repeat-deadline-unit) + (setq dr-days (org-habit-repeater-to-days + scheduled-repeat-deadline-value + scheduled-repeat-deadline-unit)) + (if (<= dr-days sr-days) + (error "Habit %s deadline repeat period is less than or equal to scheduled repeat" + habit-entry)) + (setq deadline (+ scheduled (- dr-days sr-days)))) (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)))) + (reversed org-log-states-order-reversed) + (search (if reversed 're-search-forward 're-search-backward)) + (start (if reversed + (org-element-contents-begin todo) + (org-element-contents-end todo))) + (limit (if reversed + (org-element-contents-end todo) + (org-element-contents-begin todo))) + (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" . ".*?"))))))))) + (save-excursion + (goto-char start) + (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))))) (defsubst org-habit-scheduled (habit) (nth 0 habit)) -- 2.54.0
