ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

64
local/lib/org-x/org-x.el
View File

@ -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)
;; remove logbook items and clocks
(org-ml-headline-map-supercontents* config
(org-ml-supercontents-set-logbook nil it))
(-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*
(if (not it) it
(org-ml-planning-set-timestamp! :closed nil it)))
(-some->> it (org-ml-planning-set-timestamp! :closed nil)))
;; remove ID property
(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))))
;; 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)
"Return HEADLINE repeated and shifted by OFFSET UNITs N times."
(cl-flet
((shift-timestamps
(offset unit mult headline)
(let ((offset* (* offset mult)))
(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-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)))
(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))))
(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."
(->> (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

114
local/lib/org-x/test/org-x-test-buffer-state.el
View File

@ -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