WIP use trees to compute buffer status for weekly plan
This commit is contained in:
parent
9a82ddc696
commit
db518f8049
|
@ -1056,6 +1056,8 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
;; TODO this is super inefficient, make a plist mapper function
|
;; TODO this is super inefficient, make a plist mapper function
|
||||||
(-let* (((node . children) tree)
|
(-let* (((node . children) tree)
|
||||||
((&plist :id i :parents ps :node-meta m) node)
|
((&plist :id i :parents ps :node-meta m) node)
|
||||||
|
;; TODO don't calculate this unless there are actually children
|
||||||
|
;; that need to use it
|
||||||
(new-ancestry (funcall ancestry-fun m ancestry))
|
(new-ancestry (funcall ancestry-fun m ancestry))
|
||||||
((shallow rest) (->> children
|
((shallow rest) (->> children
|
||||||
(--map (funcall child-fun it new-ancestry))
|
(--map (funcall child-fun it new-ancestry))
|
||||||
|
@ -1226,25 +1228,52 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "QTP" it-todo)))))))
|
(org-x-dag-bs-error-kw "QTP" it-todo)))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-wkp-inner (node-data)
|
(defun org-x-dag-bs-wkp-leaf-inner (node-data ancestry child-bss)
|
||||||
(-let* (((&plist :parent-tags (o d m y)) node-data)
|
(if (child-bss) (either :left "Weekly plan nodes cannot have children")
|
||||||
(date-abs (->> (org-x-dag-tags-to-date y m d)
|
|
||||||
(org-x-dag-date-to-absolute)))
|
|
||||||
(offset (org-x-dag-tag-to-offset o))
|
|
||||||
(pair `(:date ,date-abs :offset ,offset)))
|
|
||||||
(org-x-dag-bs-with-closed node-data "weekly plan"
|
(org-x-dag-bs-with-closed node-data "weekly plan"
|
||||||
`(:complete (,@it-comptime ,@pair))
|
`(:complete ,it-comptime)
|
||||||
(either :right `(:complete (,@it-comptime ,@pair)))
|
(either :right `(:complete ,it-comptime))
|
||||||
(cond
|
(cond
|
||||||
((-some->> it-planning (org-ml-get-properties :scheduled))
|
((-some->> it-planning (org-ml-get-properties :scheduled))
|
||||||
(either :left "WKPs cannot be scheduled"))
|
(either :left "WKPs cannot be scheduled"))
|
||||||
((-some->> it-planning (org-ml-get-properties :deadline))
|
((-some->> it-planning (org-ml-get-properties :deadline))
|
||||||
(either :left "WKPs cannot be deadlined"))
|
(either :left "WKPs cannot be deadlined"))
|
||||||
((equal it-todo org-x-kw-todo)
|
((equal it-todo org-x-kw-todo)
|
||||||
(either :right `(:active ,pair)))
|
(either :right `(:active)))
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "WKP" it-todo))))))
|
(org-x-dag-bs-error-kw "WKP" it-todo))))))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-wkp-branch-inner (node-data ancestry child-bss)
|
||||||
|
(org-x-dag-bs-with-closed node-data "weekly plan"
|
||||||
|
`(:complete ,it-comptime)
|
||||||
|
(either :right `(:complete ,it-comptime))
|
||||||
|
(let ((sched (-some->> it-planning (org-ml-get-properties :scheduled))))
|
||||||
|
(cond
|
||||||
|
((or (not sched) (org-ml-time-is-long sched))
|
||||||
|
(either :left "WKP day nodes must be short scheduled"))
|
||||||
|
((-some->> it-planning (org-ml-get-properties :deadline))
|
||||||
|
(either :left "WKP day nodes cannot be deadlined"))
|
||||||
|
((equal it-todo org-x-kw-todo)
|
||||||
|
(either :right `(:active)))
|
||||||
|
(t
|
||||||
|
(org-x-dag-bs-error-kw "WKP day node" it-todo))))))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-wkp-root-inner (node-data ancestry child-bss)
|
||||||
|
(org-x-dag-bs-with-closed node-data "weekly plan"
|
||||||
|
`(:complete ,it-comptime)
|
||||||
|
;; TODO need to check the week length and the scheduled children
|
||||||
|
(either :right `(:complete ,it-comptime))
|
||||||
|
(let ((sched (-some->> it-planning (org-ml-get-properties :scheduled))))
|
||||||
|
(cond
|
||||||
|
((or (not sched) (org-ml-time-is-long sched))
|
||||||
|
(either :left "WKP root nodes must be short scheduled"))
|
||||||
|
((-some->> it-planning (org-ml-get-properties :deadline))
|
||||||
|
(either :left "WKP root nodes cannot be deadlined"))
|
||||||
|
((equal it-todo org-x-kw-todo)
|
||||||
|
(either :right `(:active)))
|
||||||
|
(t
|
||||||
|
(org-x-dag-bs-error-kw "WKP day node" it-todo))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-dlp-inner (node-data)
|
(defun org-x-dag-bs-dlp-inner (node-data)
|
||||||
(org-x-dag-bs-with-closed node-data "daily metablock"
|
(org-x-dag-bs-with-closed node-data "daily metablock"
|
||||||
`(:complete ,it-comptime)
|
`(:complete ,it-comptime)
|
||||||
|
@ -1276,6 +1305,30 @@ deadline (eg via epoch time) or if it has a repeater."
|
||||||
(-let (((n ns) (org-x-dag-bs-with-treetop tree #'org-x-dag-bs-qtp-inner)))
|
(-let (((n ns) (org-x-dag-bs-with-treetop tree #'org-x-dag-bs-qtp-inner)))
|
||||||
(org-x-dag-bs-prefix :quarterly `(,n ,@ns))))
|
(org-x-dag-bs-prefix :quarterly `(,n ,@ns))))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-wkp-leaf (tree ancestry)
|
||||||
|
(org-x-dag-bs-with-children-1
|
||||||
|
tree
|
||||||
|
ancestry
|
||||||
|
(lambda (_ _) nil)
|
||||||
|
#'org-x-dag-bs-wkp-leaf
|
||||||
|
#'org-x-dag-bs-wkp-leaf-inner))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-wkp-branch (tree ancestry)
|
||||||
|
(org-x-dag-bs-with-children-1
|
||||||
|
tree
|
||||||
|
ancestry
|
||||||
|
(lambda (_ _) nil)
|
||||||
|
#'org-x-dag-bs-wkp-leaf
|
||||||
|
#'org-x-dag-bs-wkp-branch-inner))
|
||||||
|
|
||||||
|
(defun org-x-dag-bs-wkp-root (tree ancestry)
|
||||||
|
(org-x-dag-bs-with-children-1
|
||||||
|
tree
|
||||||
|
ancestry
|
||||||
|
(lambda (_ _) nil)
|
||||||
|
#'org-x-dag-bs-wkp-branch
|
||||||
|
#'org-x-dag-bs-wkp-root-inner))
|
||||||
|
|
||||||
(defun org-x-dag-bs-wkp (tree)
|
(defun org-x-dag-bs-wkp (tree)
|
||||||
(-let (((n ns) (org-x-dag-bs-with-treetop tree #'org-x-dag-bs-wkp-inner)))
|
(-let (((n ns) (org-x-dag-bs-with-treetop tree #'org-x-dag-bs-wkp-inner)))
|
||||||
(org-x-dag-bs-prefix :weekly `(,n ,@ns))))
|
(org-x-dag-bs-prefix :weekly `(,n ,@ns))))
|
||||||
|
|
Loading…
Reference in New Issue