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
|
||||
|
||||
(defun org-x--reset-headline (headline)
|
||||
(defun org-x--reset-subtree (headline)
|
||||
"Reset HEADLINE node to incomplete state.
|
||||
This includes unchecking all checkboxes, marking keywords as
|
||||
\"TODO\", clearing any unique IDs, etc."
|
||||
(cl-flet*
|
||||
(cl-labels
|
||||
((reset
|
||||
(config created-ts headline)
|
||||
;; set keyword to TODO
|
||||
(->> (if (org-ml-headline-is-done headline)
|
||||
(org-ml-set-property :todo-keyword org-x-kw-todo headline)
|
||||
headline)
|
||||
(org-ml-headline-map-supercontents* config
|
||||
(org-ml-supercontents-set-logbook nil it))
|
||||
(org-ml-headline-set-node-property org-x-prop-created created-ts)
|
||||
(org-ml-headline-map-planning*
|
||||
(if (not it) it
|
||||
(org-ml-planning-set-timestamp! :closed nil it)))
|
||||
(org-ml-headline-set-node-property "ID" nil)
|
||||
;; 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))))
|
||||
;; remove logbook items and clocks
|
||||
(org-ml-headline-map-supercontents* config
|
||||
(-some->> it (org-ml-supercontents-set-logbook nil)))
|
||||
(org-ml-headline-set-node-property org-x-prop-created created-ts)
|
||||
;; remove CLOSED planning entry
|
||||
(org-ml-headline-map-planning*
|
||||
(-some->> it (org-ml-planning-set-timestamp! :closed nil)))
|
||||
;; remove ID property
|
||||
(org-ml-headline-set-node-property "ID" nil)
|
||||
;; 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)
|
||||
(org-ml-unixtime-to-time-long)
|
||||
(org-ml-build-timestamp!)
|
||||
(org-ml-to-string))))
|
||||
(->> (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))))))
|
||||
(reset (org-x-logbook-config) created-ts headline))))
|
||||
|
||||
(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."
|
||||
(cl-flet
|
||||
((shift-timestamps
|
||||
(offset unit mult headline)
|
||||
(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))))
|
||||
(->> (org-ml-clone-node-n n headline)
|
||||
(--map-indexed (org-x--headline-shift-timestamps
|
||||
(* offset (1+ it-index)) unit it))))
|
||||
|
||||
(defun org-x-clone-subtree-with-time-shift (n)
|
||||
"Like `org-clone-subtree-with-time-shift' except reset items and todos.
|
||||
N is the number 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)
|
||||
(org-x-read-shift-from-minibuffer)))
|
||||
(ins (->> (org-x--reset-headline st)
|
||||
(org-x--headline-repeat-shifted n offset unit)
|
||||
(ins (->> (org-x--reset-subtree subtree)
|
||||
(org-x--subtree-repeat-shifted n offset unit)
|
||||
(-map #'org-ml-to-string)
|
||||
(s-join "")))
|
||||
(end (org-ml-get-property :end st)))
|
||||
(end (org-ml-get-property :end subtree)))
|
||||
(org-ml-insert end ins)))
|
||||
|
||||
(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*
|
||||
(let ((new (->> (org-ml-headline-get-subheadlines it)
|
||||
(-last-item)
|
||||
(org-x--reset-headline))))
|
||||
(org-x--reset-subtree))))
|
||||
(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)))))
|
||||
|
||||
;; marking subtrees
|
||||
|
|
|
|||
|
|
@ -63,11 +63,18 @@ Forms are denoted like %(FORM)%."
|
|||
(declare (indent 2))
|
||||
(let ((forms (->> (-partition 4 specs)
|
||||
;; 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
|
||||
(expect (org-ml--with-org-buffer ,buffer ,test)
|
||||
:to-equal
|
||||
,result)))))))
|
||||
,result*)))))))
|
||||
`(describe ,name ,@forms)))
|
||||
|
||||
(org-x--test-buffer-strings "Task status"
|
||||
|
|
@ -259,7 +266,7 @@ Forms are denoted like %(FORM)%."
|
|||
;; TODO this seems error-prone
|
||||
"active (singleton...???)"
|
||||
("* TODO project")
|
||||
=> :stuck
|
||||
=> :undone-complete
|
||||
|
||||
"active (subtask)"
|
||||
("* 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 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)
|
||||
(declare (indent 0))
|
||||
;; 3 args for clarity, currently does nothing functional
|
||||
|
|
|
|||
Loading…
Reference in New Issue