diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el index ecdfbda..ffffe3a 100644 --- a/local/lib/org-x/org-x.el +++ b/local/lib/org-x/org-x.el @@ -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 diff --git a/local/lib/org-x/test/org-x-test-buffer-state.el b/local/lib/org-x/test/org-x-test-buffer-state.el index 1da9e06..619eeab 100644 --- a/local/lib/org-x/test/org-x-test-buffer-state.el +++ b/local/lib/org-x/test/org-x-test-buffer-state.el @@ -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