REF clean up timestamp shifter code and docs
This commit is contained in:
parent
7c595ddb91
commit
261cfa4fb9
|
@ -734,6 +734,10 @@ Allowed statuscodes are in list `nd/get-iter-statuscodes.' where
|
||||||
|
|
||||||
;; periodicals
|
;; periodicals
|
||||||
|
|
||||||
|
(defconst org-x--first-active-ts-pattern
|
||||||
|
'(:first :any * (:and timestamp (:or (:type 'active) (:type 'active-range))))
|
||||||
|
"Pattern for first active timestamp to be supplied to `org-ml-match' et al.")
|
||||||
|
|
||||||
(defun org-x-get-periodical-status ()
|
(defun org-x-get-periodical-status ()
|
||||||
"Get the status of a periodical.
|
"Get the status of a periodical.
|
||||||
Allowed statuscodes are in list `nd/get-peri-statuscodes.' where
|
Allowed statuscodes are in list `nd/get-peri-statuscodes.' where
|
||||||
|
@ -746,9 +750,7 @@ latter codes in the list trump earlier ones."
|
||||||
;; wrap in a section here because the matcher needs a single node
|
;; wrap in a section here because the matcher needs a single node
|
||||||
;; and not a list
|
;; and not a list
|
||||||
(apply #'org-ml-build-section)
|
(apply #'org-ml-build-section)
|
||||||
(org-ml-match '(:first :any * (:and timestamp
|
(org-ml-match org-x--first-active-ts-pattern)
|
||||||
(:or (:type 'active)
|
|
||||||
(:type 'active-range)))))
|
|
||||||
(car)
|
(car)
|
||||||
(org-ml-timestamp-get-start-time)
|
(org-ml-timestamp-get-start-time)
|
||||||
(org-ml-time-to-unixtime)))
|
(org-ml-time-to-unixtime)))
|
||||||
|
@ -881,9 +883,7 @@ timestamp in the contents of the headline will be shifted."
|
||||||
;; wrap in a section here because the matcher needs a single node
|
;; wrap in a section here because the matcher needs a single node
|
||||||
;; and not a list
|
;; and not a list
|
||||||
(->> (apply #'org-ml-build-section it)
|
(->> (apply #'org-ml-build-section it)
|
||||||
(org-ml-match-map* '(:first :any * (:and timestamp
|
(org-ml-match-map* org-x--first-active-ts-pattern
|
||||||
(:or (:type 'active)
|
|
||||||
(:type 'active-range))))
|
|
||||||
(org-ml-timestamp-shift offset unit it))
|
(org-ml-timestamp-shift offset unit it))
|
||||||
(org-ml-get-children))
|
(org-ml-get-children))
|
||||||
subtree)))
|
subtree)))
|
||||||
|
@ -929,28 +929,14 @@ N is the number of clones to produce."
|
||||||
it)))))
|
it)))))
|
||||||
|
|
||||||
(defun org-x-subtree-shift-timestamps ()
|
(defun org-x-subtree-shift-timestamps ()
|
||||||
"Shift all scheduled and deadlined timestamps in the current subtree."
|
"Shift all timestamps in the current subtree.
|
||||||
|
Only deadline/scheduled timestamp are shifted (tasks) or the
|
||||||
|
first active timestamp in the contents (non-tasks)."
|
||||||
(interactive)
|
(interactive)
|
||||||
(-let (((offset unit) (org-x--read-shift-from-minibuffer)))
|
(-let (((offset unit) (org-x--read-shift-from-minibuffer)))
|
||||||
(org-ml-update-this-subtree*
|
(org-ml-update-this-subtree*
|
||||||
(org-x--subtree-shift-timestamps offset unit it))))
|
(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
|
||||||
|
|
Loading…
Reference in New Issue