ADD daily metablock buffer status function
This commit is contained in:
parent
a2494f2370
commit
9f75fd1905
|
@ -1408,10 +1408,12 @@ used for optimization."
|
||||||
|
|
||||||
(defmacro org-x-dag-bs-fmap (bs form)
|
(defmacro org-x-dag-bs-fmap (bs form)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
`(pcase ,bs
|
(let ((b (make-symbol "--bs")))
|
||||||
(`(:error ,_) ',bs)
|
`(let ((,b ,bs))
|
||||||
(`(:valid ,it) (org-x-dag-bs :valid ,form))
|
(pcase ,b
|
||||||
(e (error "Learn to use functors, dummy; this isn't one: %s" e))))
|
(`(:error ,_) ,b)
|
||||||
|
(`(:valid ,it) (org-x-dag-bs :valid ,form))
|
||||||
|
(e (error "Learn to use functors, dummy; this isn't one: %s" e))))))
|
||||||
|
|
||||||
(defun org-x-dag-bs-error-p (bs)
|
(defun org-x-dag-bs-error-p (bs)
|
||||||
(eq (car bs) :error))
|
(eq (car bs) :error))
|
||||||
|
@ -1904,6 +1906,31 @@ used for optimization."
|
||||||
(t
|
(t
|
||||||
(org-x-dag-bs-error-kw "WKP" it-todo))))))
|
(org-x-dag-bs-error-kw "WKP" it-todo))))))
|
||||||
|
|
||||||
|
(defun org-x-dag-dlp-bs-inner (node-data)
|
||||||
|
(org-x-dag-bs-action-with-closed node-data "daily metablock"
|
||||||
|
`(:complete ,it-comptime)
|
||||||
|
(org-x-dag-bs :valid `(:complete ,it-comptime))
|
||||||
|
(-let (((sched dead) (-some->> it-planning
|
||||||
|
(org-ml-get-properties '(:scheduled :deadline)))))
|
||||||
|
(cond
|
||||||
|
(dead
|
||||||
|
(org-x-dag-bs :error "Daily metablocks cannot be deadlined"))
|
||||||
|
((equal it-todo org-x-kw-todo)
|
||||||
|
(-if-let ((sched-date sched-time) (-some->> it-planning
|
||||||
|
(org-ml-get-property :scheduled)
|
||||||
|
(org-ml-timestamp-get-start-time)
|
||||||
|
(org-x-dag-datetime-split)))
|
||||||
|
(if (not sched-time)
|
||||||
|
(org-x-dag-bs :error "Daily metablocks must have scheduled time")
|
||||||
|
(-let* (((&plist :tags) node-data)
|
||||||
|
(tag-date (org-x-dag-daily-tags-to-date tags)))
|
||||||
|
(if (org-x-dag-datetime= tag-date sched-date)
|
||||||
|
(org-x-dag-bs :valid `(:active))
|
||||||
|
(org-x-dag-bs :error "Daily metablocks must be scheduled within their date"))))
|
||||||
|
(org-x-dag-bs :error "Daily metablocks must be scheduled")))
|
||||||
|
(t
|
||||||
|
(org-x-dag-bs-error-kw "Daily metablock" it-todo))))))
|
||||||
|
|
||||||
(defun org-x-dag-with-treetop-error (tree)
|
(defun org-x-dag-with-treetop-error (tree)
|
||||||
(declare (indent 3))
|
(declare (indent 3))
|
||||||
(-let* (((node . children) tree)
|
(-let* (((node . children) tree)
|
||||||
|
@ -1931,7 +1958,7 @@ used for optimization."
|
||||||
(-let (((n ns) (org-x-dag-with-treetop tree #'org-x-dag-qtp-bs-inner)))
|
(-let (((n ns) (org-x-dag-with-treetop tree #'org-x-dag-qtp-bs-inner)))
|
||||||
(--map (org-x-dag-node-fmap it
|
(--map (org-x-dag-node-fmap it
|
||||||
(org-x-dag-bs-fmap it
|
(org-x-dag-bs-fmap it
|
||||||
`(:quarterly ,it)))
|
`(:weekly ,it)))
|
||||||
`(,n ,@ns))))
|
`(,n ,@ns))))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-bs (tree)
|
(defun org-x-dag-wkp-bs (tree)
|
||||||
|
@ -1941,6 +1968,13 @@ used for optimization."
|
||||||
`(:quarterly ,it)))
|
`(:quarterly ,it)))
|
||||||
`(,n ,@ns))))
|
`(,n ,@ns))))
|
||||||
|
|
||||||
|
(defun org-x-dag-dlp-bs (tree)
|
||||||
|
(-let (((n ns) (org-x-dag-with-treetop tree #'org-x-dag-dlp-bs-inner)))
|
||||||
|
(--map (org-x-dag-node-fmap it
|
||||||
|
(org-x-dag-bs-fmap it
|
||||||
|
`(:daily ,it)))
|
||||||
|
`(,n ,@ns))))
|
||||||
|
|
||||||
(defun org-x-dag-get-file-nodes (file group)
|
(defun org-x-dag-get-file-nodes (file group)
|
||||||
(let* ((meta (list :file file
|
(let* ((meta (list :file file
|
||||||
:group group
|
:group group
|
||||||
|
|
Loading…
Reference in New Issue