I reused `org-test-at-time'. Specifically, `org-test-at-time' is now an
alias of `org-at-time'. This "new" macro is what `org-todo-at' uses in
order to set the current time to the time that you provide it.
From 86f7300410ffbb885c3c60d2380411985ae7631f Mon Sep 17 00:00:00 2001
From: ApollonDeParnasse <[email protected]>
Date: Thu, 2 Jul 2026 16:43:08 -0500
Subject: [PATCH] lisp/org.el: New function for calling `org-todo' at a given
time.
* lisp/org.el (org-todo-at): Call `org-todo' at a given
time.
* lisp/org-macs.el (org-at-time): Perform an org action
at a given time.
* testing/org-test.el (org-test-at-time): Call
`org-at-time'.
* testing/lisp/test-org.el
(test-org/auto-repeat-maybe/org-todo-at): New tests
for `org-todo-at'.
(test-org/org-todo-at-interactive): New tests for
`org-todo-at'.
* lisp/org-keys.el (org-mode-map): New keybinding
for `org-todo-at'.
---
doc/org-manual.org | 22 ++++++
etc/ORG-NEWS | 4 +
lisp/org-keys.el | 2 +
lisp/org-macs.el | 66 +++++++++++++++++
lisp/org.el | 30 ++++++++
testing/lisp/test-org.el | 156 +++++++++++++++++++++++++++++++++++++++
testing/org-test.el | 67 +----------------
7 files changed, 281 insertions(+), 66 deletions(-)
diff --git a/doc/org-manual.org b/doc/org-manual.org
index 9201a341a..0eb3159b3 100644
--- a/doc/org-manual.org
+++ b/doc/org-manual.org
@@ -3977,6 +3977,14 @@ The most important commands to work with TODO entries are:
buffer with the {{{kbd(t)}}} command key (see [[*Commands in the
Agenda Buffer]]).
+- {{{kbd(C-c M-t)}}} (~org-todo-at~) ::
+
+ #+kindex: C-c M-t
+ #+cindex: cycling, of TODO states
+ Rotate the TODO state of the current item,
+ just like ~org-todo~. Will ask you for a
+ time for each state change.
+
- {{{kbd(S-RIGHT)}}} {{{kbd(S-LEFT)}}} ::
#+kindex: S-RIGHT
@@ -4369,6 +4377,13 @@ command ~org-todo~ with a prefix argument.
The note is inserted as a list item below the headline, but can also
be placed into a drawer, see [[*Tracking TODO state changes]].
+- {{{kbd(C-u C-c M-t)}}} (~org-todo-at~) ::
+
+ #+kindex: C-u C-M C-t
+ Prompt for a time for the TODO state change and a note.
+ The note is inserted as a list item below the headline,
+ but can also be placed into a drawer, just like ~org-todo~.
+
If you want to be more systematic, Org mode can automatically record a
timestamp and optionally a note when you mark a TODO item as DONE, or
even each time you change the state of a TODO item. This system is
@@ -7002,6 +7017,13 @@ about what to do with it.
Changing the TODO state of an item to DONE automatically stops the
clock if it is running in this same item.
+- {{{kbd(C-c M-t)}}} (~org-todo-at~) ::
+
+ #+kindex: C-c M-t
+ #+findex: org-todo-at
+ Changing the TODO state of an item to DONE automatically stops the
+ clock at the time that you provide if it is running in this same item.
+
- {{{kbd(C-c C-x C-q)}}} (~org-clock-cancel~) ::
#+kindex: C-c C-x C-q
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index 261d5d3be..6e2ffd24b 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -227,6 +227,10 @@ needs. The recommended alternative value is ~itemize~.
Given the completed and total number of tasks, format the percent
cookie =[N%]=.
+*** New function ~org-todo-at~
+
+Like `org-todo', but the first argument is the time that you
+would like change the TODO state of an item.
** Removed or renamed functions and variables
diff --git a/lisp/org-keys.el b/lisp/org-keys.el
index 84eb3bf13..6853e9f3d 100644
--- a/lisp/org-keys.el
+++ b/lisp/org-keys.el
@@ -215,6 +215,7 @@
(declare-function org-timer-start "org-timer" (&optional offset))
(declare-function org-timer-stop "org-timer" ())
(declare-function org-todo "org" (&optional arg1))
+(declare-function org-todo-at "org" (time &optional arg))
(declare-function org-toggle-archive-tag "org-archive" (&optional find-done))
(declare-function org-toggle-checkbox "org-list" (&optional toggle-presence))
(declare-function org-toggle-radio-button "org-list" (&optional arg))
@@ -576,6 +577,7 @@ COMMANDS is a list of alternating OLDDEF NEWDEF command names."
(org-defkey org-mode-map (kbd "C-c C-x q") #'org-toggle-tags-groups)
(org-defkey org-mode-map (kbd "C-c C-j") #'org-goto)
(org-defkey org-mode-map (kbd "C-c C-t") #'org-todo)
+(org-defkey org-mode-map (kbd "C-c M-t") #'org-todo-at)
(org-defkey org-mode-map (kbd "C-c C-q") #'org-set-tags-command)
(org-defkey org-mode-map (kbd "C-c C-s") #'org-schedule)
(org-defkey org-mode-map (kbd "C-c C-d") #'org-deadline)
diff --git a/lisp/org-macs.el b/lisp/org-macs.el
index 2b867818b..f73fe50e8 100644
--- a/lisp/org-macs.el
+++ b/lisp/org-macs.el
@@ -1680,6 +1680,72 @@ Return 0. if S is not recognized as a valid value."
((string-match org-ts-regexp0 s) (org-2ft s))
(t 0.)))))
+(defmacro org-at-time (time &rest body)
+ "Run BODY while pretending that the current time is TIME.
+TIME can be a non-nil Lisp time value, or a string specifying a date and time."
+ (declare (indent 1))
+ (org-with-gensyms (tm at)
+ `(let* ((,tm ,time)
+ (,at (if (stringp ,tm)
+ (org-time-string-to-time ,tm)
+ ,tm)))
+ (cl-flet
+ ((org-at-current-time (_fun &rest _args)
+ ,at)
+ (org-at-current-time-string (fun &optional time &rest args)
+ (apply fun
+ (or time ,at) args))
+ (org-at-current-time-zone (fun &optional time &rest args)
+ (apply fun (or time ,at) args))
+ (org-at-decode-time (fun &optional time zone form)
+ (condition-case nil
+ (funcall fun (or time ,at) zone form)
+ (wrong-number-of-arguments
+ (funcall fun (or time ,at)))))
+ (org-at-encode-time (fun time &rest args)
+ (apply fun (or time ,at) args))
+ (org-at-float-time (fun &optional time)
+ (funcall fun (or time ,at)))
+ (org-at-format-time-string (fun format &optional time &rest args)
+ (apply fun format (or time ,at) args))
+ (org-at-set-file-times (fun file &optional time)
+ (funcall fun file (or time ,at)))
+ (org-at-time-add (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-at-time-equal-p (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-at-time-less-p (fun a b)
+ (funcall fun (or a ,at) (or b ,at)))
+ (org-at-time-subtract (fun a b)
+ (funcall fun (or a ,at) (or b ,at))))
+ (add-function :around (symbol-function 'current-time) #'org-at-current-time)
+ (add-function :around (symbol-function 'current-time-string) #'org-at-current-time-string)
+ (add-function :around (symbol-function 'current-time-zone) #'org-at-current-time-zone)
+ (add-function :around (symbol-function 'decode-time) #'org-at-decode-time)
+ (add-function :around (symbol-function 'encode-time) #'org-at-encode-time)
+ (add-function :around (symbol-function 'float-time) #'org-at-float-time)
+ (add-function :around (symbol-function 'format-time-string) #'org-at-format-time-string)
+ (add-function :around (symbol-function 'set-file-times) #'org-at-set-file-times)
+ (add-function :around (symbol-function 'time-add) #'org-at-time-add)
+ (add-function :around (symbol-function 'time-equal-p) #'org-at-time-equal-p)
+ (add-function :around (symbol-function 'time-less-p) #'org-at-time-less-p)
+ (add-function :around (symbol-function 'time-subtract) #'org-at-time-subtract)
+
+ (unwind-protect
+ (progn ,@body)
+ (remove-function (symbol-function 'current-time) #'org-at-current-time)
+ (remove-function (symbol-function 'current-time-string) #'org-at-current-time-string)
+ (remove-function (symbol-function 'current-time-zone) #'org-at-current-time-zone)
+ (remove-function (symbol-function 'decode-time) #'org-at-decode-time)
+ (remove-function (symbol-function 'encode-time) #'org-at-encode-time)
+ (remove-function (symbol-function 'float-time) #'org-at-float-time)
+ (remove-function (symbol-function 'format-time-string) #'org-at-format-time-string)
+ (remove-function (symbol-function 'set-file-times) #'org-at-set-file-times)
+ (remove-function (symbol-function 'time-add) #'org-at-time-add)
+ (remove-function (symbol-function 'time-equal-p) #'org-at-time-equal-p)
+ (remove-function (symbol-function 'time-less-p) #'org-at-time-less-p)
+ (remove-function (symbol-function 'time-subtract) #'org-at-time-subtract))))))
+
;;; Misc
diff --git a/lisp/org.el b/lisp/org.el
index 294a5eb52..92ef9908f 100644
--- a/lisp/org.el
+++ b/lisp/org.el
@@ -9918,6 +9918,36 @@ When called through Elisp, arg is also interpreted in the following way:
(run-hook-with-args 'org-trigger-hook change-plist)))
(when commentp (org-toggle-comment))))))))
+(defun org-todo-at (time &optional arg)
+ "Like `org-todo' but the time of change will be TIME.
+TIME should be a valid timestamp, e.g., 2014-03-04,
+2024-01-17 8:00, 2012-03-29 16:40, or <2025-10-18 12:00>.
+
+With `\\[universal-argument]' prefix ARG, force logging the state change \
+and take a
+logging note.
+With a `\\[universal-argument] \\[universal-argument]' prefix, switch to the \
+next set of TODO \
+keywords (nextset).
+Another way to achieve this is `S-C-<right>'.
+With a `\\[universal-argument] \\[universal-argument] \\[universal-argument]' \
+prefix, circumvent any state blocking.
+With numeric prefix arg, switch to the Nth state.
+
+With a numeric prefix arg of 0, inhibit note taking for the change.
+With a numeric prefix arg of -1, cancel repeater to allow marking as DONE.
+
+When called through Elisp, arg is also interpreted in the following way:
+`none' -> empty state
+\"\" -> switch to empty state
+`done' -> switch to DONE
+`nextset' -> switch to the next set of keywords
+`previousset' -> switch to the previous set of keywords
+\"WAITING\" -> switch to the specified keyword, but only if it
+ really is a member of `org-todo-keywords'."
+ (interactive (list (org-read-date) current-prefix-arg))
+ (org-at-time time (org-todo arg)))
+
(defun org-block-todo-from-children-or-siblings-or-parent (change-plist)
"Block turning an entry into a TODO, using the hierarchy.
This checks whether the current task should be blocked from state
diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el
index 9e9be9ebc..cbd24d7c0 100644
--- a/testing/lisp/test-org.el
+++ b/testing/lisp/test-org.el
@@ -9168,6 +9168,103 @@ SCHEDULED: <2021-06-15 Tue +1d>"
(org-add-log-note))
(buffer-string))))))
+(ert-deftest test-org/auto-repeat-maybe/org-todo-at ()
+ "Test `org-auto-repeat-maybe' with `org-todo-at'."
+ ;; Handle every repeater type using hours step.
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 02:00 +8h>")
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 +8h>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string)))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 10:00 ++8h>")
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 ++8h>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string)))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 10:35 .+8h>")
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 .+8h>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string)))))
+;; ;; Handle `org-extend-today-until'.
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 ++1d>")
+ (let ((org-extend-today-until 4))
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 ++1d>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string))))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-06 17:00 ++1d>")
+ (let ((org-extend-today-until 4))
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-04 17:00 ++1d>"
+ (org-todo-at "<2014-03-05 18:00>" "DONE")
+ (buffer-string))))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 10:00 ++8h>")
+ (let ((org-extend-today-until 4))
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 ++8h>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string))))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 18:00 .+1d>")
+ (let ((org-extend-today-until 4))
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 .+1d>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string))))))
+ (should
+ (string-match-p
+ (regexp-quote "<2014-03-04 10:35 .+8h>")
+ (let ((org-extend-today-until 4))
+ (org-test-without-dow
+ (org-test-with-temp-text "* TODO H\n<2014-03-03 18:00 .+8h>"
+ (org-todo-at "<2014-03-04 02:35>" "DONE")
+ (buffer-string))))))
+ ;; Do not repeat inactive time stamps with a repeater.
+ (should-not
+ (string-match-p
+ "\\[2014-03-29 .* \\+2y\\]"
+ (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
+ (org-test-with-temp-text
+ "* TODO H\n[2012-03-29 Thu. +2y]"
+ (org-todo-at "2012-03-29 Thu" "DONE")
+ (buffer-string)))))
+ ;; Do not repeat commented time stamps.
+ (should-not
+ (string-prefix-p
+ "<2015-03-04 .* \\+1y>"
+ (let ((org-todo-keywords '((sequence "TODO" "DONE"))))
+ (org-test-with-temp-text
+ "* TODO H\n<2012-03-29 Thu +2y>\n# <2014-03-04 Tue +1y>"
+ (org-todo-at "2012-03-30 Fri" "DONE")
+ (buffer-string)))))
+ ;; Properly advance repeater even when a clock entry is specified
+ ;; and `org-log-repeat' is nil.
+ (should
+ (string-match-p
+ "SCHEDULED: <2014-03-29"
+ (let ((org-log-repeat nil)
+ (org-todo-keywords '((sequence "TODO" "DONE"))))
+ (org-test-with-temp-text
+ "* TODO H
+SCHEDULED: <2012-03-29 Thu +2y>
+CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40"
+ (org-todo-at "2012-03-30 Thu" "DONE")
+ (buffer-string))))))
+
(ert-deftest test-org/org-log-done ()
"Test `org-log-done' specifications.
Behavior can be modified by setting `org-log-done', by keywords in
@@ -9460,6 +9557,65 @@ Behavior can be modified by setting `org-log-into-drawer', by keywords in
(should (eq org-log-note-how 'note))))
(remove-hook 'post-command-hook #'org-add-log-note))))))
+(ert-deftest test-org/org-todo-at-interactive ()
+ "Test `org-todo-at' interactively."
+ (cl-macrolet ((test-org-todo-at-interactive (test-buffer-text
+ test-date
+ test-prefix-arg
+ expected)
+ (let ((current-prefix-arg test-prefix-arg))
+ `(cl-letf (((symbol-function 'org-read-date)
+ (lambda (&rest _args)
+ (org-time-string-to-time ,test-date))))
+ (org-test-with-temp-text ,test-buffer-text
+ (call-interactively #'org-todo-at)
+ (should (string-equal (buffer-string) ,expected)))))))
+
+ ;; no prefix arg
+ (test-org-todo-at-interactive
+ "* TODO H"
+ "2022-03-24 23:30"
+ nil
+ "* DONE H")
+ ;; -1 prefix arg should cancel
+ ;; repeater and mark DONE.
+ (test-org-todo-at-interactive
+ "* TODO H\n<2012-03-29 Thu +2y>"
+ "2012-03-29 Thu"
+ -1
+ "* TODO H
+:PROPERTIES:
+:LAST_REPEAT: [2012-03-29 Thu 00:00]
+:END:\n<2014-03-29 Sat +2y>")
+ (test-org-todo-at-interactive
+ "* TODO H\n<2012-03-29 Thu +2y>"
+ "2012-03-29 Thu 09:59"
+ -
+ "* TODO H
+:PROPERTIES:
+:LAST_REPEAT: [2012-03-29 Thu 09:59]
+:END:\n<2014-03-29 Sat +2y>")
+
+ ;; test with `org-inhibit-logging'
+ (let ((org-inhibit-logging nil))
+ (test-org-todo-at-interactive
+ "* TODO H\n"
+ "2024-09-07 Sat"
+ '(4)
+ "* DONE H\n"))
+ (let ((org-inhibit-logging 'note))
+ (test-org-todo-at-interactive
+ "* TODO H\n"
+ "2024-09-07 Sat"
+ '(4)
+ "* DONE H\n"))
+ (let ((org-inhibit-logging t))
+ (test-org-todo-at-interactive
+ "* TODO H\n"
+ "2024-09-07 Sat"
+ '(4)
+ "* DONE H\n"))))
+
;;; Timestamps API
diff --git a/testing/org-test.el b/testing/org-test.el
index 2928fa08c..1da9a8893 100644
--- a/testing/org-test.el
+++ b/testing/org-test.el
@@ -502,72 +502,7 @@ Load all test files first."
(ert "\\(org\\|ob\\|ox\\)"))
(org-test-kill-all-examples))
-(defmacro org-test-at-time (time &rest body)
- "Run body while pretending that the current time is TIME.
-TIME can be a non-nil Lisp time value, or a string specifying a date and time."
- (declare (indent 1))
- (let ((tm (cl-gensym))
- (at (cl-gensym)))
- `(let* ((,tm ,time)
- (,at (if (stringp ,tm)
- (org-time-string-to-time ,tm)
- ,tm)))
- (cl-flet
- ((org-test-current-time (_fun &rest _args)
- ,at)
- (org-test-current-time-string (fun &optional time &rest args)
- (apply fun
- (or time ,at) args))
- (org-test-current-time-zone (fun &optional time &rest args)
- (apply fun (or time ,at) args))
- (org-test-decode-time (fun &optional time zone form)
- (condition-case nil
- (funcall fun (or time ,at) zone form)
- (wrong-number-of-arguments
- (funcall fun (or time ,at)))))
- (org-test-encode-time (fun time &rest args)
- (apply fun (or time ,at) args))
- (org-test-float-time (fun &optional time)
- (funcall fun (or time ,at)))
- (org-test-format-time-string (fun format &optional time &rest args)
- (apply fun format (or time ,at) args))
- (org-test-set-file-times (fun file &optional time)
- (funcall fun file (or time ,at)))
- (org-test-time-add (fun a b)
- (funcall fun (or a ,at) (or b ,at)))
- (org-test-time-equal-p (fun a b)
- (funcall fun (or a ,at) (or b ,at)))
- (org-test-time-less-p (fun a b)
- (funcall fun (or a ,at) (or b ,at)))
- (org-test-time-subtract (fun a b)
- (funcall fun (or a ,at) (or b ,at))))
- (add-function :around (symbol-function 'current-time) #'org-test-current-time)
- (add-function :around (symbol-function 'current-time-string) #'org-test-current-time-string)
- (add-function :around (symbol-function 'current-time-zone) #'org-test-current-time-zone)
- (add-function :around (symbol-function 'decode-time) #'org-test-decode-time)
- (add-function :around (symbol-function 'encode-time) #'org-test-encode-time)
- (add-function :around (symbol-function 'float-time) #'org-test-float-time)
- (add-function :around (symbol-function 'format-time-string) #'org-test-format-time-string)
- (add-function :around (symbol-function 'set-file-times) #'org-test-set-file-times)
- (add-function :around (symbol-function 'time-add) #'org-test-time-add)
- (add-function :around (symbol-function 'time-equal-p) #'org-test-time-equal-p)
- (add-function :around (symbol-function 'time-less-p) #'org-test-time-less-p)
- (add-function :around (symbol-function 'time-subtract) #'org-test-time-subtract)
-
- (unwind-protect
- (progn ,@body)
- (remove-function (symbol-function 'current-time) #'org-test-current-time)
- (remove-function (symbol-function 'current-time-string) #'org-test-current-time-string)
- (remove-function (symbol-function 'current-time-zone) #'org-test-current-time-zone)
- (remove-function (symbol-function 'decode-time) #'org-test-decode-time)
- (remove-function (symbol-function 'encode-time) #'org-test-encode-time)
- (remove-function (symbol-function 'float-time) #'org-test-float-time)
- (remove-function (symbol-function 'format-time-string) #'org-test-format-time-string)
- (remove-function (symbol-function 'set-file-times) #'org-test-set-file-times)
- (remove-function (symbol-function 'time-add) #'org-test-time-add)
- (remove-function (symbol-function 'time-equal-p) #'org-test-time-equal-p)
- (remove-function (symbol-function 'time-less-p) #'org-test-time-less-p)
- (remove-function (symbol-function 'time-subtract) #'org-test-time-subtract))))))
+(defalias 'org-test-at-time 'org-at-time)
(defmacro org-test-capture-warnings (&rest body)
"Capture all warnings passed to `org-display-warning' within BODY."
--
2.54.0
