ADD tests for timestamp cloner

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
+          ;; 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)
                           (org-ml-unixtime-to-time-long)
                           (org-ml-build-timestamp!)
                           (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."
-  (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)
   "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)
+          (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)
                  (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

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