ADD tests for timestamp cloner
This commit is contained in:
parent
6427fe55b6
commit
9766604a83
|
@ -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
|
||||||
|
|
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue