ADD tests for timestamp cloner

This commit is contained in:
Nathan Dwarshuis 2021-04-18 20:59:37 -04:00
parent 6427fe55b6
commit 9766604a83
2 changed files with 154 additions and 42 deletions

View File

@ -797,66 +797,70 @@ function will simply return the point of the next headline."
;; cloning ;; cloning
(defun org-x--reset-headline (headline) (defun org-x--reset-subtree (headline)
"Reset HEADLINE node to incomplete state. "Reset HEADLINE node to incomplete state.
This includes unchecking all checkboxes, marking keywords as This includes unchecking all checkboxes, marking keywords as
\"TODO\", clearing any unique IDs, etc." \"TODO\", clearing any unique IDs, etc."
(cl-flet* (cl-labels
((reset ((reset
(config created-ts headline) (config created-ts headline)
;; set keyword to TODO
(->> (if (org-ml-headline-is-done headline) (->> (if (org-ml-headline-is-done headline)
(org-ml-set-property :todo-keyword org-x-kw-todo headline) (org-ml-set-property :todo-keyword org-x-kw-todo headline)
headline) headline)
(org-ml-headline-map-supercontents* config ;; remove logbook items and clocks
(org-ml-supercontents-set-logbook nil it)) (org-ml-headline-map-supercontents* config
(org-ml-headline-set-node-property org-x-prop-created created-ts) (-some->> it (org-ml-supercontents-set-logbook nil)))
(org-ml-headline-map-planning* (org-ml-headline-set-node-property org-x-prop-created created-ts)
(if (not it) it ;; remove CLOSED planning entry
(org-ml-planning-set-timestamp! :closed nil it))) (org-ml-headline-map-planning*
(org-ml-headline-set-node-property "ID" nil) (-some->> it (org-ml-planning-set-timestamp! :closed nil)))
;; this obviously will be wrong if I ever want to use TODO ;; remove ID property
;; statistics but at least they will be reset to zero (org-ml-headline-set-node-property "ID" nil)
(org-ml-headline-update-item-statistics)))) ;; clear item checkboxes
(org-ml-match-map* '(section :any * item)
(org-ml-set-property :checkbox 'off it))
;; update stats cookie; this obviously will be wrong if I ever want to
;; use TODO statistics but at least they will be reset to zero
(org-ml-headline-update-item-statistics)
;; rinse and repeat for subheadlines
(org-ml-headline-map-subheadlines*
(--map (reset config created-ts it) it)))))
(let ((created-ts (-> (float-time) (let ((created-ts (-> (float-time)
(org-ml-unixtime-to-time-long) (org-ml-unixtime-to-time-long)
(org-ml-build-timestamp!) (org-ml-build-timestamp!)
(org-ml-to-string)))) (org-ml-to-string))))
(->> (reset (org-x-logbook-config) created-ts headline) (reset (org-x-logbook-config) created-ts headline))))
(org-ml-match-map* '(:any * item)
(org-ml-set-property :checkbox 'off it))
(org-ml-match-map* '(:any * headline)
(reset config created-ts it))))))
(defun org-x--headline-repeat-shifted (n offset unit headline) (defun org-x--headline-shift-timestamps (offset unit headline)
(->> headline
(org-ml-match-map* '(:any * timestamp)
(org-ml-timestamp-shift offset unit it))
(org-ml-match-map* '(:any * planning)
(->> it
(org-ml-map-property* :scheduled
(when it (org-ml-timestamp-shift offset unit it)))
(org-ml-map-property* :deadline
(when it (org-ml-timestamp-shift offset unit it)))))))
(defun org-x--subtree-repeat-shifted (n offset unit headline)
"Return HEADLINE repeated and shifted by OFFSET UNITs N times." "Return HEADLINE repeated and shifted by OFFSET UNITs N times."
(cl-flet (->> (org-ml-clone-node-n n headline)
((shift-timestamps (--map-indexed (org-x--headline-shift-timestamps
(offset unit mult headline) (* offset (1+ it-index)) unit it))))
(let ((offset* (* offset mult)))
(->> headline
(org-ml-match-map* '(:any * timestamp)
(org-ml-timestamp-shift offset* unit it))
(org-ml-match-map* '(:any * planning)
(->> it
(org-ml-map-property* :scheduled
(when it (org-ml-timestamp-shift offset* unit it)))
(org-ml-map-property* :deadline
(when it (org-ml-timestamp-shift offset* unit it)))))))))
(let ((headlines (org-ml-clone-node-n n headline)))
(--map-indexed (shift-timestamps offset unit (1+ it-index) it) headlines))))
(defun org-x-clone-subtree-with-time-shift (n) (defun org-x-clone-subtree-with-time-shift (n)
"Like `org-clone-subtree-with-time-shift' except reset items and todos. "Like `org-clone-subtree-with-time-shift' except reset items and todos.
N is the number of clones to produce." N is the number of clones to produce."
(interactive "nNumber of clones to produce: ") (interactive "nNumber of clones to produce: ")
(-let* ((st (org-ml-parse-this-subtree)) (-let* ((subtree (org-ml-parse-this-subtree))
((offset unit) (-> (org-entry-get nil org-x-prop-time-shift 'selective) ((offset unit) (-> (org-entry-get nil org-x-prop-time-shift 'selective)
(org-x-read-shift-from-minibuffer))) (org-x-read-shift-from-minibuffer)))
(ins (->> (org-x--reset-headline st) (ins (->> (org-x--reset-subtree subtree)
(org-x--headline-repeat-shifted n offset unit) (org-x--subtree-repeat-shifted n offset unit)
(-map #'org-ml-to-string) (-map #'org-ml-to-string)
(s-join ""))) (s-join "")))
(end (org-ml-get-property :end st))) (end (org-ml-get-property :end subtree)))
(org-ml-insert end ins))) (org-ml-insert end ins)))
(defun org-x-clone-subtree-with-time-shift-toplevel (n) (defun org-x-clone-subtree-with-time-shift-toplevel (n)
@ -868,9 +872,9 @@ N is the number of clones to produce."
(org-ml-update-this-subtree* (org-ml-update-this-subtree*
(let ((new (->> (org-ml-headline-get-subheadlines it) (let ((new (->> (org-ml-headline-get-subheadlines it)
(-last-item) (-last-item)
(org-x--reset-headline)))) (org-x--reset-subtree))))
(org-ml-map-children* (org-ml-map-children*
(append it (org-x--headline-repeat-shifted n offset unit new)) (append it (org-x--subtree-repeat-shifted n offset unit new))
it))))) it)))))
;; marking subtrees ;; marking subtrees

View File

@ -63,11 +63,18 @@ Forms are denoted like %(FORM)%."
(declare (indent 2)) (declare (indent 2))
(let ((forms (->> (-partition 4 specs) (let ((forms (->> (-partition 4 specs)
;; the _op argument is just for looks to make the decl clearer ;; the _op argument is just for looks to make the decl clearer
(--map (-let (((title buffer _op result) it)) (--map (-let* (((title buffer _op result) it)
(result* (if (and (consp result)
(eq (car result) :result))
(->> (cdr result)
(s-join "\n")
(org-x-test-parse-forms))
result)))
(print result*)
`(it ,title `(it ,title
(expect (org-ml--with-org-buffer ,buffer ,test) (expect (org-ml--with-org-buffer ,buffer ,test)
:to-equal :to-equal
,result))))))) ,result*)))))))
`(describe ,name ,@forms))) `(describe ,name ,@forms)))
(org-x--test-buffer-strings "Task status" (org-x--test-buffer-strings "Task status"
@ -259,7 +266,7 @@ Forms are denoted like %(FORM)%."
;; TODO this seems error-prone ;; TODO this seems error-prone
"active (singleton...???)" "active (singleton...???)"
("* TODO project") ("* TODO project")
=> :stuck => :undone-complete
"active (subtask)" "active (subtask)"
("* TODO project" ("* TODO project"
@ -598,6 +605,107 @@ Forms are denoted like %(FORM)%."
(:start-time (2022 1 1 12 0) :range 43200 :offset 78 :filepath "fp")) (:start-time (2022 1 1 12 0) :range 43200 :offset 78 :filepath "fp"))
((:start-time (2022 1 2 0 0) :range 86400 :offset 78 :filepath "fp")))) ((:start-time (2022 1 2 0 0) :range 86400 :offset 78 :filepath "fp"))))
(org-x--test-buffer-strings "Timestamp shifter"
(->> (org-ml-parse-this-subtree)
(org-x--subtree-repeat-shifted 3 1 'day)
(-map #'org-ml-to-string)
(s-join ""))
"headline"
("* TODO headline"
"SCHEDULED: <2020-01-01 Wed>")
=> (:result "* TODO headline"
"SCHEDULED: <2020-01-02 Thu>"
"* TODO headline"
"SCHEDULED: <2020-01-03 Fri>"
"* TODO headline"
"SCHEDULED: <2020-01-04 Sat>"
"")
"subtree"
("* TODO headline"
"SCHEDULED: <2020-01-01 Wed>"
"** TODO headline"
"DEADLINE: <2020-02-01 Sat>")
=> (:result "* TODO headline"
"SCHEDULED: <2020-01-02 Thu>"
"** TODO headline"
"DEADLINE: <2020-02-02 Sun>"
"* TODO headline"
"SCHEDULED: <2020-01-03 Fri>"
"** TODO headline"
"DEADLINE: <2020-02-03 Mon>"
"* TODO headline"
"SCHEDULED: <2020-01-04 Sat>"
"** TODO headline"
"DEADLINE: <2020-02-04 Tue>"
""))
(org-x--test-buffer-strings "Timestamp resetter"
(let ((org-log-into-drawer "LOGGING")
(org-clock-into-drawer "CLOCKING"))
(->> (org-ml-parse-this-subtree)
(org-x--reset-subtree)
(org-ml-to-trimmed-string)))
"closed task"
("* DONE headline [1/1]"
"CLOSED: [2021-04-18 Sun 13:09] SCHEDULED: <2020-01-01 Wed>"
":PROPERTIES:"
":CREATED: [2019-01-01 Tue]"
":ID: deadbeef"
":END:"
":LOGGING:"
"- State \"DONE\" from \"TODO\" [2021-04-18 Sun 13:09]"
":END:"
":CLOCKING:"
"CLOCK: [2021-04-18 Sun 13:02]--[2021-04-18 Sun 13:09] => 0:07"
":END:"
"- [X] resetme")
=> (:result "* TODO headline [0/1]"
"SCHEDULED: <2020-01-01 Wed>"
":PROPERTIES:"
":CREATED: %(org-x-gen-ts 0)%"
":END:"
"- [ ] resetme")
"closed project"
("* TODO top"
"** DONE headline [1/1]"
"CLOSED: [2021-04-18 Sun 13:09] SCHEDULED: <2020-01-01 Wed>"
":PROPERTIES:"
":CREATED: [2019-01-01 Tue]"
":ID: deadbeef"
":END:"
":LOGGING:"
"- State \"DONE\" from \"TODO\" [2021-04-18 Sun 13:09]"
":END:"
":CLOCKING:"
"CLOCK: [2021-04-18 Sun 13:02]--[2021-04-18 Sun 13:09] => 0:07"
":END:"
"- [X] resetme")
=> (:result "* TODO top"
":PROPERTIES:"
":CREATED: %(org-x-gen-ts 0)%"
":END:"
"** TODO headline [0/1]"
"SCHEDULED: <2020-01-01 Wed>"
":PROPERTIES:"
":CREATED: %(org-x-gen-ts 0)%"
":END:"
"- [ ] resetme"))
;; "closed project"
;; ("* DONE headline"
;; "SCHEDULED: <2020-01-01 Wed>"
;; "** CANC headline"
;; "DEADLINE: <2020-02-01 Sat>")
;; => (:result "* TODO headline"
;; "SCHEDULED: <2020-01-01 Wed>"
;; "** TODO headline"
;; "DEADLINE: <2020-02-01 Sat>")
;; )
(defmacro org-x--test-time-splitter-specs (&rest specs) (defmacro org-x--test-time-splitter-specs (&rest specs)
(declare (indent 0)) (declare (indent 0))
;; 3 args for clarity, currently does nothing functional ;; 3 args for clarity, currently does nothing functional