ADD tests for timestamp shifter
This commit is contained in:
parent
9766604a83
commit
7c595ddb91
|
@ -3999,7 +3999,7 @@ These are for mode-specific bindings that can/should be outside of the evil maps
|
||||||
(local-set-key (kbd "C-c C-x c") 'org-x-clone-subtree-with-time-shift)
|
(local-set-key (kbd "C-c C-x c") 'org-x-clone-subtree-with-time-shift)
|
||||||
|
|
||||||
;; add time shifter
|
;; add time shifter
|
||||||
(local-set-key (kbd "C-c C-x t") 'org-x-time-shift)
|
(local-set-key (kbd "C-c C-x t") 'org-x-subtree-shift-timestamps)
|
||||||
|
|
||||||
;; add clock in/out functions for tomato mode
|
;; add clock in/out functions for tomato mode
|
||||||
(local-set-key (kbd "C-x C-c C-x C-i") 'org-tomato-user-hl-clock-in)
|
(local-set-key (kbd "C-x C-c C-x C-i") 'org-tomato-user-hl-clock-in)
|
||||||
|
|
|
@ -743,6 +743,9 @@ latter codes in the list trump earlier ones."
|
||||||
()
|
()
|
||||||
(-some->> (org-ml-parse-this-headline)
|
(-some->> (org-ml-parse-this-headline)
|
||||||
(org-ml-headline-get-contents (org-x-logbook-config))
|
(org-ml-headline-get-contents (org-x-logbook-config))
|
||||||
|
;; wrap in a section here because the matcher needs a single node
|
||||||
|
;; and not a list
|
||||||
|
(apply #'org-ml-build-section)
|
||||||
(org-ml-match '(:first :any * (:and timestamp
|
(org-ml-match '(:first :any * (:and timestamp
|
||||||
(:or (:type 'active)
|
(:or (:type 'active)
|
||||||
(:type 'active-range)))))
|
(:type 'active-range)))))
|
||||||
|
@ -795,7 +798,33 @@ function will simply return the point of the next headline."
|
||||||
|
|
||||||
;;; INTERACTIVE FUNCTIONS
|
;;; INTERACTIVE FUNCTIONS
|
||||||
|
|
||||||
;; cloning
|
;; timestamp shifting
|
||||||
|
|
||||||
|
(defun org-x--read-shift-from-minibuffer (&optional default)
|
||||||
|
"Read a timestamp shift from the minibuffer.
|
||||||
|
|
||||||
|
If DEFAULT is a string, process this instead of reading a string
|
||||||
|
from the minubuffer.
|
||||||
|
|
||||||
|
Valid shifts are like +/-(DIGIT)(UNIT) (eg like '+1w') similar to
|
||||||
|
`org-clone-subtree-with-time-shift'. If invalid throw an error.
|
||||||
|
Else return a list like (OFFSET UNIT) where OFFSET is the numeric
|
||||||
|
value of the shift (negative goes back in time) and UNIT is the
|
||||||
|
unit of the shift. These are later consumed by
|
||||||
|
`org-ml-timestamp-shift'"
|
||||||
|
(let* ((out (or default (read-from-minibuffer "Date shift (e.g. +1w): ")))
|
||||||
|
(match (s-match "\\`[ \t]*\\([\\+\\-]?[0-9]+\\)\\([MHdwmy]\\)[ \t]*\\'" out)))
|
||||||
|
(if (not match) (error "Invalid shift: %s" out)
|
||||||
|
(-let* (((_ mag unit) match)
|
||||||
|
((mult unit*) (pcase unit
|
||||||
|
("M" '(1 minute))
|
||||||
|
("H" '(1 hour))
|
||||||
|
("d" '(1 day))
|
||||||
|
("w" '(7 day))
|
||||||
|
("m" '(1 month))
|
||||||
|
("y" '(1 year))
|
||||||
|
(_ (error "Unsupported time unit")))))
|
||||||
|
(list (* mult (string-to-number mag)) unit*)))))
|
||||||
|
|
||||||
(defun org-x--reset-subtree (headline)
|
(defun org-x--reset-subtree (headline)
|
||||||
"Reset HEADLINE node to incomplete state.
|
"Reset HEADLINE node to incomplete state.
|
||||||
|
@ -832,21 +861,43 @@ This includes unchecking all checkboxes, marking keywords as
|
||||||
(org-ml-to-string))))
|
(org-ml-to-string))))
|
||||||
(reset (org-x-logbook-config) created-ts headline))))
|
(reset (org-x-logbook-config) created-ts headline))))
|
||||||
|
|
||||||
(defun org-x--headline-shift-timestamps (offset unit headline)
|
(defun org-x--subtree-shift-timestamps (offset unit subtree)
|
||||||
(->> headline
|
"Return SUBTREE with timestamps shifted OFFSET UNITs.
|
||||||
(org-ml-match-map* '(:any * timestamp)
|
In the case of task headlines, only scheduled/deadlined
|
||||||
(org-ml-timestamp-shift offset unit it))
|
timestamps will be shifted. Otherwise only the first active
|
||||||
(org-ml-match-map* '(:any * planning)
|
timestamp in the contents of the headline will be shifted."
|
||||||
|
(cl-labels
|
||||||
|
((shift-timestamps
|
||||||
|
(offset unit subtree)
|
||||||
|
(if (org-ml-get-property :todo-keyword subtree)
|
||||||
|
(org-ml-headline-map-planning*
|
||||||
(->> it
|
(->> it
|
||||||
(org-ml-map-property* :scheduled
|
(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
|
(org-ml-map-property* :deadline
|
||||||
(when it (org-ml-timestamp-shift offset unit it)))))))
|
(when it (org-ml-timestamp-shift offset unit it))))
|
||||||
|
subtree)
|
||||||
|
(org-ml-headline-map-contents* (org-x-logbook-config)
|
||||||
|
;; wrap in a section here because the matcher needs a single node
|
||||||
|
;; and not a list
|
||||||
|
(->> (apply #'org-ml-build-section it)
|
||||||
|
(org-ml-match-map* '(:first :any * (:and timestamp
|
||||||
|
(:or (:type 'active)
|
||||||
|
(:type 'active-range))))
|
||||||
|
(org-ml-timestamp-shift offset unit it))
|
||||||
|
(org-ml-get-children))
|
||||||
|
subtree)))
|
||||||
|
(shift
|
||||||
|
(offset unit subtree)
|
||||||
|
(->> (shift-timestamps offset unit subtree)
|
||||||
|
(org-ml-headline-map-subheadlines*
|
||||||
|
(--map (shift offset unit it) it)))))
|
||||||
|
(shift offset unit subtree)))
|
||||||
|
|
||||||
(defun org-x--subtree-repeat-shifted (n offset unit headline)
|
(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."
|
||||||
(->> (org-ml-clone-node-n n headline)
|
(->> (org-ml-clone-node-n n headline)
|
||||||
(--map-indexed (org-x--headline-shift-timestamps
|
(--map-indexed (org-x--subtree-shift-timestamps
|
||||||
(* offset (1+ it-index)) unit it))))
|
(* offset (1+ it-index)) unit it))))
|
||||||
|
|
||||||
(defun org-x-clone-subtree-with-time-shift (n)
|
(defun org-x-clone-subtree-with-time-shift (n)
|
||||||
|
@ -855,7 +906,7 @@ N is the number of clones to produce."
|
||||||
(interactive "nNumber of clones to produce: ")
|
(interactive "nNumber of clones to produce: ")
|
||||||
(-let* ((subtree (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-subtree subtree)
|
(ins (->> (org-x--reset-subtree subtree)
|
||||||
(org-x--subtree-repeat-shifted n offset unit)
|
(org-x--subtree-repeat-shifted n offset unit)
|
||||||
(-map #'org-ml-to-string)
|
(-map #'org-ml-to-string)
|
||||||
|
@ -868,7 +919,7 @@ N is the number of clones to produce."
|
||||||
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 (((offset unit) (-> (org-entry-get nil org-x-prop-time-shift 'selective)
|
(-let (((offset unit) (-> (org-entry-get nil org-x-prop-time-shift 'selective)
|
||||||
(org-x-read-shift-from-minibuffer))))
|
(org-x--read-shift-from-minibuffer))))
|
||||||
(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)
|
||||||
|
@ -877,6 +928,29 @@ N is the number of clones to produce."
|
||||||
(append it (org-x--subtree-repeat-shifted n offset unit new))
|
(append it (org-x--subtree-repeat-shifted n offset unit new))
|
||||||
it)))))
|
it)))))
|
||||||
|
|
||||||
|
(defun org-x-subtree-shift-timestamps ()
|
||||||
|
"Shift all scheduled and deadlined timestamps in the current subtree."
|
||||||
|
(interactive)
|
||||||
|
(-let (((offset unit) (org-x--read-shift-from-minibuffer)))
|
||||||
|
(org-ml-update-this-subtree*
|
||||||
|
(org-x--subtree-shift-timestamps offset unit it))))
|
||||||
|
|
||||||
|
;; (save-excursion
|
||||||
|
;; (org-back-to-heading) ;; trigger error here if not at heading
|
||||||
|
;; (-let* ((end (save-excursion (org-end-of-subtree)))
|
||||||
|
;; ((mag unit) (org-x--read-shift-from-minibuffer))
|
||||||
|
;; (shift-ts-maybe
|
||||||
|
;; (lambda (type)
|
||||||
|
;; (let ((bound (save-excursion (outline-next-heading))))
|
||||||
|
;; (save-excursion
|
||||||
|
;; (when (re-search-forward (org-re-timestamp type) bound t)
|
||||||
|
;; (org-timestamp-change mag unit)))))))
|
||||||
|
;; (while (< (point) end)
|
||||||
|
;; (funcall shift-ts-maybe 'scheduled)
|
||||||
|
;; (funcall shift-ts-maybe 'deadline)
|
||||||
|
;; (outline-next-heading)))))
|
||||||
|
|
||||||
|
|
||||||
;; marking subtrees
|
;; marking subtrees
|
||||||
|
|
||||||
;; put this in terms of org-ml
|
;; put this in terms of org-ml
|
||||||
|
@ -1097,42 +1171,6 @@ If BACK is t seek backward, else forward. Ignore blank lines."
|
||||||
(interactive)
|
(interactive)
|
||||||
(org-x-agenda--seek-heading))
|
(org-x-agenda--seek-heading))
|
||||||
|
|
||||||
;; timestamp shifter
|
|
||||||
|
|
||||||
(defun org-x-read-shift-from-minibuffer (&optional default)
|
|
||||||
(let* ((out (or default (read-from-minibuffer "Date shift (e.g. +1w): ")))
|
|
||||||
(match (s-match "\\`[ \t]*\\([\\+\\-]?[0-9]+\\)\\([MHdwmy]\\)[ \t]*\\'" out)))
|
|
||||||
(if (not match) (error "Invalid shift: %s" out)
|
|
||||||
(-let* (((_ mag unit) match)
|
|
||||||
((mult unit*) (pcase unit
|
|
||||||
("M" '(1 minute))
|
|
||||||
("H" '(1 hour))
|
|
||||||
("d" '(1 day))
|
|
||||||
("w" '(7 day))
|
|
||||||
("m" '(1 month))
|
|
||||||
("y" '(1 year))
|
|
||||||
(_ (error "Unsupported time unit")))))
|
|
||||||
(list (* mult (string-to-number mag)) unit*)))))
|
|
||||||
|
|
||||||
;; TODO refactor in terms of org-ml to make cleaner/safer
|
|
||||||
(defun org-x-time-shift ()
|
|
||||||
"Shift all scheduled and deadlined timestamps in the current subtree."
|
|
||||||
(interactive)
|
|
||||||
(save-excursion
|
|
||||||
(org-back-to-heading) ;; trigger error here if not at heading
|
|
||||||
(-let* ((end (save-excursion (org-end-of-subtree)))
|
|
||||||
((mag unit) (org-x-read-shift-from-minibuffer))
|
|
||||||
(shift-ts-maybe
|
|
||||||
(lambda (type)
|
|
||||||
(let ((bound (save-excursion (outline-next-heading))))
|
|
||||||
(save-excursion
|
|
||||||
(when (re-search-forward (org-re-timestamp type) bound t)
|
|
||||||
(org-timestamp-change mag unit)))))))
|
|
||||||
(while (< (point) end)
|
|
||||||
(funcall shift-ts-maybe 'scheduled)
|
|
||||||
(funcall shift-ts-maybe 'deadline)
|
|
||||||
(outline-next-heading)))))
|
|
||||||
|
|
||||||
;; agenda filtering
|
;; agenda filtering
|
||||||
|
|
||||||
;; In order to implement the =hasprop= filter, the functions
|
;; In order to implement the =hasprop= filter, the functions
|
||||||
|
|
|
@ -606,12 +606,130 @@ Forms are denoted like %(FORM)%."
|
||||||
((: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-x--test-buffer-strings "Timestamp shifter"
|
||||||
|
(let ((org-log-into-drawer "LOGGING")
|
||||||
|
(org-clock-into-drawer "CLOCKING"))
|
||||||
|
(->> (org-ml-parse-this-subtree)
|
||||||
|
(org-x--subtree-shift-timestamps 1 'day)
|
||||||
|
(org-ml-to-trimmed-string)))
|
||||||
|
|
||||||
|
;; none of these should touch anything in the logbook or properties drawer
|
||||||
|
|
||||||
|
"task (scheduled)"
|
||||||
|
("* TODO headline"
|
||||||
|
"SCHEDULED: <2020-01-01 Wed>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
=> (:result "* TODO headline"
|
||||||
|
"SCHEDULED: <2020-01-02 Thu>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
|
||||||
|
"task (deadlined)"
|
||||||
|
("* TODO headline"
|
||||||
|
"DEADLINE: <2020-01-01 Wed>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
=> (:result "* TODO headline"
|
||||||
|
"DEADLINE: <2020-01-02 Thu>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
|
||||||
|
"subtask"
|
||||||
|
("* top"
|
||||||
|
"** TODO headline"
|
||||||
|
"DEADLINE: <2020-01-01 Wed>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
=> (:result "* top"
|
||||||
|
"** TODO headline"
|
||||||
|
"DEADLINE: <2020-01-02 Thu>"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:")
|
||||||
|
|
||||||
|
"non-task"
|
||||||
|
("* headline"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:"
|
||||||
|
"something"
|
||||||
|
"something more"
|
||||||
|
"[2020-01-02 Thu]"
|
||||||
|
"<2020-01-01 Wed>"
|
||||||
|
"<2020-01-01 Wed>")
|
||||||
|
=> (:result "* headline"
|
||||||
|
":PROPERTIES:"
|
||||||
|
":CREATED: [2019-01-01 Tue]"
|
||||||
|
":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:"
|
||||||
|
"something"
|
||||||
|
"something more"
|
||||||
|
"[2020-01-02 Thu]"
|
||||||
|
"<2020-01-02 Thu>"
|
||||||
|
"<2020-01-01 Wed>")
|
||||||
|
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
(org-x--test-buffer-strings "Timestamp cloner"
|
||||||
(->> (org-ml-parse-this-subtree)
|
(->> (org-ml-parse-this-subtree)
|
||||||
(org-x--subtree-repeat-shifted 3 1 'day)
|
(org-x--subtree-repeat-shifted 3 1 'day)
|
||||||
(-map #'org-ml-to-string)
|
(-map #'org-ml-to-string)
|
||||||
(s-join ""))
|
(s-join ""))
|
||||||
|
|
||||||
"headline"
|
"task"
|
||||||
("* TODO headline"
|
("* TODO headline"
|
||||||
"SCHEDULED: <2020-01-01 Wed>")
|
"SCHEDULED: <2020-01-01 Wed>")
|
||||||
=> (:result "* TODO headline"
|
=> (:result "* TODO headline"
|
||||||
|
@ -622,7 +740,7 @@ Forms are denoted like %(FORM)%."
|
||||||
"SCHEDULED: <2020-01-04 Sat>"
|
"SCHEDULED: <2020-01-04 Sat>"
|
||||||
"")
|
"")
|
||||||
|
|
||||||
"subtree"
|
"project"
|
||||||
("* TODO headline"
|
("* TODO headline"
|
||||||
"SCHEDULED: <2020-01-01 Wed>"
|
"SCHEDULED: <2020-01-01 Wed>"
|
||||||
"** TODO headline"
|
"** TODO headline"
|
||||||
|
|
Loading…
Reference in New Issue