ENH make buffer status trees accululate scheduled timestamps
This commit is contained in:
parent
a74dd98e4d
commit
69237c720e
|
@ -933,18 +933,18 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(-when-let (p (alist-get org-x-prop-parent-type props nil nil #'equal))
|
(-when-let (p (alist-get org-x-prop-parent-type props nil nil #'equal))
|
||||||
(equal p org-x-prop-parent-type-iterator))))
|
(equal p org-x-prop-parent-type-iterator))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name)
|
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name
|
||||||
(declare (indent 2))
|
success-fun
|
||||||
(let ((ret `(,(if child-bss :si-proj :si-task) ,comptime)))
|
childless-fun)
|
||||||
|
(declare (indent 3))
|
||||||
(org-x-dag-bs-action-check-children child-bss
|
(org-x-dag-bs-action-check-children child-bss
|
||||||
(either :left "Completed sub-iterators cannot have active children")
|
(org-x-dag-left "Completed %s cannot have active children" type-name)
|
||||||
(either :right ret)
|
(either :right (funcall success-fun comptime))
|
||||||
ret
|
(funcall childless-fun comptime)
|
||||||
(lambda (local)
|
(lambda (local)
|
||||||
(pcase local
|
(pcase local
|
||||||
(`(:si-task :task-complete ,_) t)
|
((or `(:si-task :task-complete ,_) `(:si-proj :proj-complete ,_)) t)
|
||||||
(`(:si-proj :proj-complete ,_) t)
|
(_ nil)))))
|
||||||
(_ nil))))))
|
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun)
|
(defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
|
@ -985,13 +985,13 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(`(,_ ,_) (either :right nil))))
|
(`(,_ ,_) (either :right nil))))
|
||||||
(lambda (next)
|
(lambda (next)
|
||||||
(pcase next
|
(pcase next
|
||||||
((or (:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t)
|
((or `(:si-task :task-active ,_) `(:si-proj :proj-active ,_)) t)
|
||||||
(_ nil)))
|
(_ nil)))
|
||||||
(lambda (next)
|
(lambda (next)
|
||||||
(pcase next
|
(pcase next
|
||||||
(`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
|
(`(:si-proj :proj-active ,d) (plist-get d :child-scheds))
|
||||||
(`(:si-task :task-active ,d) (list (plist-get d :sched)))
|
(`(:si-task :task-active ,d) (list (plist-get d :sched)))
|
||||||
(,_ nil)))
|
(_ nil)))
|
||||||
trans-fun))
|
trans-fun))
|
||||||
|
|
||||||
(defun org-x-dag-node-is-iterator-p (node)
|
(defun org-x-dag-node-is-iterator-p (node)
|
||||||
|
@ -1009,16 +1009,10 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
`(:si-proj :proj-complete ,it-comptime)
|
`(:si-proj :proj-complete ,it-comptime)
|
||||||
`(:si-task :task-complete ,it-comptime))
|
`(:si-task :task-complete ,it-comptime))
|
||||||
|
|
||||||
(let ((ret `(:si-proj :proj-complete ,comptime)))
|
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
|
||||||
(org-x-dag-bs-action-check-children child-bss
|
"sub-iterators"
|
||||||
(either :left "Completed sub-iterators cannot have active children")
|
(lambda (c) `(:si-proj :proj-complete ,c))
|
||||||
(either :right ret)
|
(lambda (c) `(:si-task :task-complete ,c)))
|
||||||
ret
|
|
||||||
(lambda (local)
|
|
||||||
(pcase local
|
|
||||||
(`(:si-task :task-complete ,_) t)
|
|
||||||
(`(:si-proj :proj-complete ,_) t)
|
|
||||||
(_ nil)))))
|
|
||||||
|
|
||||||
(-let (((sched dead) (-some->> it-planning
|
(-let (((sched dead) (-some->> it-planning
|
||||||
(org-ml-get-properties '(:scheduled :deadline)))))
|
(org-ml-get-properties '(:scheduled :deadline)))))
|
||||||
|
@ -1036,8 +1030,8 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
`(:si-task :task-active (:sched ,sched :dead ,dead))
|
`(:si-task :task-active (:sched ,sched :dead ,dead))
|
||||||
(lambda (acc cs)
|
(lambda (acc cs)
|
||||||
(pcase acc
|
(pcase acc
|
||||||
((or (:si-proj :proj-complete ,_)
|
((or `(:si-proj :proj-complete ,_)
|
||||||
(:si-task :task-complete ,_))
|
`(:si-task :task-complete ,_))
|
||||||
(-> "Active sub-iterator must have at least one active child"
|
(-> "Active sub-iterator must have at least one active child"
|
||||||
(org-x-dag-left)))
|
(org-x-dag-left)))
|
||||||
(`(:si-proj :proj-active ,ts-data)
|
(`(:si-proj :proj-active ,ts-data)
|
||||||
|
@ -1050,79 +1044,29 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))))
|
(org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-subiter-complete-fold (child-bss comptime type-name
|
|
||||||
child-key childless-key)
|
|
||||||
(declare (indent 2))
|
|
||||||
(let ((ret `(,(if child-bss child-key childless-key) ,comptime)))
|
|
||||||
(org-x-dag-bs-action-check-children child-bss
|
|
||||||
(org-x-dag-left "Completed %s cannot have active children" type-name)
|
|
||||||
(either :right ret)
|
|
||||||
ret
|
|
||||||
(lambda (local)
|
|
||||||
(pcase local
|
|
||||||
(`(:si-task :task-complete ,_) t)
|
|
||||||
(`(:si-proj :proj-complete ,_) t)
|
|
||||||
(_ nil))))))
|
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-iter-todo-fold (child-bss default trans-fun)
|
|
||||||
(declare (indent 2))
|
|
||||||
(org-x-dag-bs-action-rankfold-children child-bss default
|
|
||||||
(lambda (acc next)
|
|
||||||
(pcase `(,acc ,next)
|
|
||||||
(`((:si-active ,a) (:si-active ,b))
|
|
||||||
(-let (((&plist :scheds as :dead ad) a)
|
|
||||||
((&plist :scheds bs :dead bd) b))
|
|
||||||
(cond
|
|
||||||
((or (xor as bs) (xor ad bd))
|
|
||||||
(->> "All sub-iters must have the same planning configuration"
|
|
||||||
(either :left)))
|
|
||||||
((and as bs (xor (org-ml-time-is-long as) (org-ml-time-is-long bs)))
|
|
||||||
(->> "Sub-iters must have scheduled timestamp with same length"
|
|
||||||
(either :left)))
|
|
||||||
((and ad bd (xor (org-ml-time-is-long ad) (org-ml-time-is-long bd)))
|
|
||||||
(->> "Sub-iters must have deadline timestamp with same length"
|
|
||||||
(either :left)))
|
|
||||||
;; ASSUME this won't fail since the datetimes are assumed to be the
|
|
||||||
;; same length as per rules above
|
|
||||||
((and ad bd)
|
|
||||||
(->> (org-x-dag-datetime< (org-ml-timestamp-get-start-time ad)
|
|
||||||
(org-ml-timestamp-get-start-time bd))
|
|
||||||
(either :right)))
|
|
||||||
(t
|
|
||||||
(->> (org-x-dag-datetime< (org-ml-timestamp-get-start-time as)
|
|
||||||
(org-ml-timestamp-get-start-time bs))
|
|
||||||
(either :right))))))
|
|
||||||
(`((:si-active ,_) ,_) (either :right nil))
|
|
||||||
(`(,_ (:si-active ,_)) (either :right t))
|
|
||||||
(`(,_ ,_) (either :right nil))))
|
|
||||||
(lambda (next)
|
|
||||||
(pcase next
|
|
||||||
(`(:si-active ,_) t)
|
|
||||||
(_ nil)))
|
|
||||||
trans-fun))
|
|
||||||
|
|
||||||
(defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
|
(defun org-x-dag-bs-action-iter-inner (node-data ancestry child-bss)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((new-active-iter
|
((new-active-iter
|
||||||
(d s cs)
|
(d s cs)
|
||||||
(->> (list :dead d :child-scheds cs :leading-sched s)
|
(->> (list :dead d :child-scheds cs :leading-sched s)
|
||||||
(list :iter-active)
|
(list :iter-nonempty :nonempty-active)
|
||||||
(either :right))))
|
(either :right))))
|
||||||
(org-x-dag-bs-action-with-closed node-data ancestry "iterators"
|
(org-x-dag-bs-action-with-closed node-data ancestry "iterators"
|
||||||
`(:iter-complete ,it-comptime)
|
`(:iter-empty :empty-complete ,it-comptime)
|
||||||
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime
|
(org-x-dag-bs-action-subiter-complete-fold child-bss it-comptime "iterators"
|
||||||
"iterators" :iter-complete)
|
(lambda (c) `(:iter-nonempty :nonempty-complete ,c))
|
||||||
|
(lambda (c) `(:iter-empty :empty-complete ,c)))
|
||||||
(cond
|
(cond
|
||||||
(it-planning
|
(it-planning
|
||||||
(either :left "Iterators cannot be scheduled or deadlined"))
|
(either :left "Iterators cannot be scheduled or deadlined"))
|
||||||
;; TODO also check for timeshift and archive props
|
;; TODO also check for timeshift and archive props
|
||||||
((equal it-todo org-x-kw-todo)
|
((equal it-todo org-x-kw-todo)
|
||||||
(org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty)
|
(org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty :empty-active)
|
||||||
(lambda (acc cs)
|
(lambda (acc cs)
|
||||||
(pcase acc
|
(pcase acc
|
||||||
((or `(:si-task :task-complete ,_)
|
((or `(:si-task :task-complete ,_)
|
||||||
`(:si-proj :proj-complete ,_))
|
`(:si-proj :proj-complete ,_))
|
||||||
(either :right '(:iter-empty)))
|
(either :right '(:iter-nonempty :nonempty-complete)))
|
||||||
(`(:si-task :task-active ,ts-data)
|
(`(:si-task :task-active ,ts-data)
|
||||||
(-let (((&plist :dead d :sched s) ts-data))
|
(-let (((&plist :dead d :sched s) ts-data))
|
||||||
(new-active-iter d s cs)))
|
(new-active-iter d s cs)))
|
||||||
|
|
Loading…
Reference in New Issue