ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Merge branch 'plan_trees'

This commit is contained in:
Nathan Dwarshuis 2022-06-01 22:58:10 -04:00
parent 40ec33fa5c 5df1cdfa77
commit e4a5de7ea2
4 changed files with 364 additions and 165 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
etc/conf.org
View File

@ -3762,12 +3762,7 @@ Initialize by running =nd/mu-init=.
"gmail" "gmail"
"natedwarshuis@gmail.com" "natedwarshuis@gmail.com"
"smtp.gmail.com" "smtp.gmail.com"
'delete) 'delete)))
(nd/make-mu4e-context "gatech"
"gatech"
"ndwarshuis3@gatech.edu"
"smtp.office365.com"
'sent)))
;; enable visual line mode and spell checking ;; enable visual line mode and spell checking
(add-hook 'mu4e-compose-mode-hook 'turn-off-auto-fill) (add-hook 'mu4e-compose-mode-hook 'turn-off-auto-fill)
@ -3836,13 +3831,9 @@ Initialize by running =nd/mu-init=.
(s-trim))) (s-trim)))
(defun nd/xoauth2-get-secrets (host user port) (defun nd/xoauth2-get-secrets (host user port)
(when (when (and (string= host "smtp.gmail.com")
(or (and (string= host "smtp.office365.com") (string= user "natedwarshuis@gmail.com")
(string= user "ndwarshuis3@gatech.edu") (string= port "587"))
(string= port "587"))
(and (string= host "smtp.gmail.com")
(string= user "natedwarshuis@gmail.com")
(string= port "587")))
(list :token-url (nd/lookup-oauth-secret "token_url" user) (list :token-url (nd/lookup-oauth-secret "token_url" user)
:client-id (nd/lookup-oauth-secret "client_id" user) :client-id (nd/lookup-oauth-secret "client_id" user)
:client-secret (nd/lookup-oauth-secret "client_secret" user) :client-secret (nd/lookup-oauth-secret "client_secret" user)

4
local/lib/either/either.el
View File

@ -151,5 +151,9 @@ left/right slots."
(!cons (cadr it) acc-left))) (!cons (cadr it) acc-left)))
`(,(nreverse acc-left) ,(nreverse acc-right)))) `(,(nreverse acc-left) ,(nreverse acc-right))))
(defun either-maybe (fun either)
"Return nil if EITHER is left and apply FUN otherwise."
(either-from either (-const nil) fun))
(provide 'either) (provide 'either)
;;; either.el ends here ;;; either.el ends here

4
local/lib/org-x/org-x-const.el
View File

@ -196,6 +196,10 @@ org tag and a long name respectively for the category.")
;; all follow the nomenclature `org-x-prop-PROPNAME' (key) or ;; all follow the nomenclature `org-x-prop-PROPNAME' (key) or
;; `org-x-prop-PROPNAME-VALNAME' (value) ;; `org-x-prop-PROPNAME-VALNAME' (value)
(defconst org-x-prop-week-len "X-WEEK-LEN"
"The length of a week in the weekly plan.
Should be an integer greater than 1.")
(defconst org-x-prop-parent-type "PARENT_TYPE" (defconst org-x-prop-parent-type "PARENT_TYPE"
"Property denoting iterator/periodical headline.") "Property denoting iterator/periodical headline.")

504
local/lib/org-x/org-x-dag.el
View File

@ -62,6 +62,12 @@
(defun org-x-dag-time-is-archivable-p (epochtime) (defun org-x-dag-time-is-archivable-p (epochtime)
(< (* 60 60 24 org-x-archive-delay) (- (float-time) epochtime))) (< (* 60 60 24 org-x-archive-delay) (- (float-time) epochtime)))
;; org ml wrappers
(defun org-x-dag-timestamp-to-epoch (ts)
(->> (org-ml-timestamp-get-start-time ts)
(org-ml-time-to-unixtime)))
;; calendar interface ;; calendar interface
(defun org-x-dag-gregorian-to-date (greg) (defun org-x-dag-gregorian-to-date (greg)
@ -172,9 +178,17 @@
;; date <-> week ;; date <-> week
;; (defun org-x-dag-date-to-day-of-week (date) (defvar org-x-dag-weekday-start 1
;; (->> (org-x-dag-date-to-gregorian date) "Index of day to be considered start of week.
;; (calendar-day-of-week))) Must be an integer from 0 - 6, with 0 = Sunday.")
(defun org-x-dag-abs-to-day-of-week (abs)
(-> (- abs org-x-dag-weekday-start)
(mod 7)))
(defun org-x-dag-date-to-day-of-week (date)
(-> (org-x-dag-date-to-absolute date)
(org-x-dag-abs-to-day-of-week)))
(defun org-x-dag-date-to-week-number (date) (defun org-x-dag-date-to-week-number (date)
(-let* (((y m d) date) (-let* (((y m d) date)
@ -199,10 +213,6 @@
(+ start-abs start-diff) (+ start-abs start-diff)
(org-x-dag-absolute-to-date)))) (org-x-dag-absolute-to-date))))
(defvar org-x-dag-weekday-start 1
"Index of day to be considered start of week.
Must be an integer from 0 - 6, with 0 = Sunday.")
(defun org-x-dag-date-to-week-start (date) (defun org-x-dag-date-to-week-start (date)
"" ""
(let* ((abs (-> (org-x-dag-date-to-absolute date) (let* ((abs (-> (org-x-dag-date-to-absolute date)
@ -232,7 +242,7 @@ relative shift in days from ABS."
acc) acc)
`((,abs . ,offset) ,@acc))))) `((,abs . ,offset) ,@acc)))))
(->> (-reduce-from #'to-interval nil date-offsets) (->> (-reduce-from #'to-interval nil date-offsets)
(--map `(,(car it) ,(+ 1 (car it) (cdr it))))))) (--map `(,(car it) ,(+ (car it) (cdr it)))))))
;; date <-> quarter ;; date <-> quarter
@ -277,6 +287,11 @@ relative shift in days from ABS."
(5 . "Friday") (5 . "Friday")
(6 . "Saturday"))) (6 . "Saturday")))
(defun org-x-dag-day-of-week-to-tag (n)
(-> (+ n org-x-dag-weekday-start)
(mod 7)
(alist-get org-x-dag-weekly-tags)))
(defun org-x-dag--parse-date-tag (prefix tag) (defun org-x-dag--parse-date-tag (prefix tag)
(let ((re (format "%s\\([0-9]+\\)" prefix))) (let ((re (format "%s\\([0-9]+\\)" prefix)))
(-some->> (s-match re tag) (-some->> (s-match re tag)
@ -815,7 +830,7 @@ deadline (eg via epoch time) or if it has a repeater."
`(:sp-proj :proj-wait) `(:sp-proj :proj-wait)
`(:sp-proj :proj-held) `(:sp-proj :proj-held)
`(:sp-proj :proj-stuck) `(:sp-proj :proj-stuck)
`(:sp-iter :iter-active) `(:sp-iter :iter-active ,_)
`(:sp-iter :iter-empty)) `(:sp-iter :iter-empty))
(:sp-task :task-active ,d)) (:sp-task :task-active ,d))
(is-next d)) (is-next d))
@ -906,9 +921,8 @@ deadline (eg via epoch time) or if it has a repeater."
(`(:si-complete ,_) t) (`(:si-complete ,_) t)
(_ nil))))) (_ nil)))))
(defun org-x-dag-bs-action-subiter-todo-fold (child-bss type-name active-key (defun org-x-dag-bs-action-subiter-todo-fold (child-bss default trans-fun)
default) (declare (indent 2))
(declare (indent 1))
(org-x-dag-bs-action-rankfold-children child-bss default (org-x-dag-bs-action-rankfold-children child-bss default
(lambda (acc next) (lambda (acc next)
(pcase `(,acc ,next) (pcase `(,acc ,next)
@ -942,14 +956,7 @@ deadline (eg via epoch time) or if it has a repeater."
(pcase next (pcase next
(`(:si-active ,_) t) (`(:si-active ,_) t)
(_ nil))) (_ nil)))
(lambda (acc) trans-fun))
(pcase acc
(`(:si-complete ,_)
(->> type-name
(org-x-dag-left "Active %s must have at least one active child")))
(`(:si-active ,ts-data)
(either :right `(,active-key ,ts-data)))
(e (error "Invalid pattern: %s" e))))))
(defun org-x-dag-node-is-iterator-p (node) (defun org-x-dag-node-is-iterator-p (node)
(org-x-dag-node-data-is-iterator-p (plist-get node :node-meta))) (org-x-dag-node-data-is-iterator-p (plist-get node :node-meta)))
@ -972,8 +979,14 @@ deadline (eg via epoch time) or if it has a repeater."
(either :left "Sub-iterator deadline must not start after parent")) (either :left "Sub-iterator deadline must not start after parent"))
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(org-x-dag-bs-action-subiter-todo-fold child-bss (org-x-dag-bs-action-subiter-todo-fold child-bss
"sub-iterator" :si-active `(:si-active (:sched ,sched :dead ,dead))
`(:si-active (:sched ,sched :dead ,dead)))) (lambda (acc)
(pcase acc
(`(:si-complete ,_)
(org-x-dag-left "Active sub-iterator must have at least one active child"))
(`(:si-active ,ts-data)
(either :right `(:si-active ,ts-data)))
(e (error "Invalid pattern: %s" e))))))
(t (t
(org-x-dag-bs-error-kw "Sub-iterator" it-todo)))))) (org-x-dag-bs-error-kw "Sub-iterator" it-todo))))))
@ -987,9 +1000,13 @@ deadline (eg via epoch time) or if it has a repeater."
(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 (org-x-dag-bs-action-subiter-todo-fold child-bss '(:iter-empty)
"iterator" :iter-active (lambda (acc)
'(:iter-empty))) (pcase acc
(`(:si-complete ,_) (either :right '(:iter-empty)))
(`(:si-active ,ts-data)
(either :right `(:iter-active ,ts-data)))
(e (error "Invalid pattern: %s" e))))))
(t (t
(org-x-dag-bs-error-kw "Iterator" it-todo))))) (org-x-dag-bs-error-kw "Iterator" it-todo)))))
@ -1056,6 +1073,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))
@ -1202,48 +1221,72 @@ deadline (eg via epoch time) or if it has a repeater."
(date-abs (org-x-dag-date-to-absolute date))) (date-abs (org-x-dag-date-to-absolute date)))
(cl-flet (cl-flet
((mk-right ((mk-right
(dead date) (dead)
(either :right `(:active (:deadline ,dead :date ,date-abs))))) (either :right `(:active (:deadline ,dead :date ,date-abs)))))
(org-x-dag-bs-with-closed node-data "quarterly plan" (org-x-dag-bs-with-closed node-data "quarterly plan"
`(:complete (,@it-comptime :date ,date-abs)) `(:complete (,@it-comptime :date ,date-abs))
(either :right `(:complete (,@it-comptime :date ,date-abs))) (either :right `(:complete (,@it-comptime :date ,date-abs)))
(cond (cond
((-some->> it-planning (org-ml-get-properties :scheduled)) ((-some->> it-planning (org-ml-get-property :scheduled))
(either :left "QTPs cannot be scheduled")) (either :left "QTPs cannot be scheduled"))
((equal it-todo org-x-kw-todo) ((equal it-todo org-x-kw-todo)
(-if-let (dead (-some->> it-planning (-if-let (dead (-some->> it-planning
(org-ml-get-properties :deadline))) (org-ml-get-property :deadline)))
;; ASSUME :parent-tags will contain the date tags as the level of ;; ASSUME :parent-tags will contain the date tags as the level of
;; the plan will never exceed one ;; the plan will never exceed one
(let ((dead-dt (->> (org-ml-timestamp-get-start-time dead) (let ((dead-dt (->> (org-ml-timestamp-get-start-time dead)
(org-x-dag-datetime-split) (org-x-dag-datetime-split)
(car)))) (car))))
(if (org-x-dag-datetime< date dead-dt) (if (org-x-dag-datetime< date dead-dt)
(mk-right dead date-abs) (mk-right dead)
(->> "QTP deadlines must be due after the quarter starts" (->> "QTP deadlines must be due after the quarter starts"
(either :left)))) (either :left))))
(mk-right nil date-abs))) (mk-right nil date-abs)))
(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) (either>>= ancestry
(date-abs (->> (org-x-dag-tags-to-date y m d) (if child-bss (either :left "Weekly plan nodes cannot have children")
(org-x-dag-date-to-absolute))) (org-x-dag-bs-with-closed node-data "weekly plan"
(offset (org-x-dag-tag-to-offset o)) `(:leaf :complete ,it-comptime)
(pair `(:date ,date-abs :offset ,offset))) (either :right `(:leaf :complete ,it-comptime))
(cond
((-some->> it-planning (org-ml-get-property :scheduled))
(either :left "WKPs cannot be scheduled"))
((-some->> it-planning (org-ml-get-property :deadline))
(either :left "WKPs cannot be deadlined"))
((equal it-todo org-x-kw-todo)
(either :right `(:leaf :active ,it)))
(t
(org-x-dag-bs-error-kw "WKP" it-todo)))))))
(defun org-x-dag-bs-wkp-branch-inner (node-data ancestry _)
(either>>= ancestry
(org-x-dag-bs-with-closed node-data "weekly plan" (org-x-dag-bs-with-closed node-data "weekly plan"
`(:complete (,@it-comptime ,@pair)) `(:branch :complete ,it-comptime)
(either :right `(:complete (,@it-comptime ,@pair))) (either :right `(:branch :complete ,it-comptime))
(cond (cond
((-some->> it-planning (org-ml-get-properties :scheduled)) ((-some->> it-planning (org-ml-get-property :deadline))
(either :left "WKPs cannot be scheduled")) (either :left "WKP day nodes cannot be deadlined"))
((-some->> it-planning (org-ml-get-properties :deadline))
(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 `(:branch :active ,it)))
(t (t
(org-x-dag-bs-error-kw "WKP" it-todo)))))) (org-x-dag-bs-error-kw "WKP day node" it-todo))))))
(defun org-x-dag-bs-wkp-root-inner (node-data ancestry _)
(either>>= ancestry
(org-x-dag-bs-with-closed node-data "weekly plan"
`(:root :complete ,it-comptime)
;; TODO need to check the week length and the scheduled children
(either :right `(:root :complete ,it-comptime))
(cond
((-some->> it-planning (org-ml-get-property :deadline))
(either :left "WKP root nodes cannot be deadlined"))
((equal it-todo org-x-kw-todo)
(either :right `(:root :active ,it)))
(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"
@ -1276,8 +1319,70 @@ 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)
(-let ((ancestry
(either-from ancestry
(-const (either :left "Parent error"))
(lambda (date-offset)
(-let (((&plist :node-meta m) (car tree)))
(-if-let (sched (-some->> (plist-get m :planning)
(org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time)))
(if (org-ml-time-is-long sched)
(either :left "WKP branch node must be short scheduled")
(-let (((&plist :date d :offset o) date-offset)
(this-abs (org-x-dag-date-to-absolute sched)))
(if (and (<= d this-abs) (< this-abs (+ d o)))
(either :right this-abs)
(either :left "WKP branch node must be scheduled"))))
(either :left "WKP branch node must be scheduled")))))))
(org-x-dag-bs-with-children-1
tree
ancestry
(lambda (_ ancestry)
(if (either-is-left-p ancestry)
(either :left "Parent error")
ancestry))
#'org-x-dag-bs-wkp-leaf
#'org-x-dag-bs-wkp-branch-inner)))
;; TODO there are likely at least 10 patterns here that can be abstracted
;; out to make this cleaner
(defun org-x-dag-bs-wkp-root (tree)
(-let* (((&plist :node-meta m) (car tree))
(datetime (->> (plist-get m :planning)
(org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time)))
(props (plist-get m :props))
;; ASSUME anything that isn't actually a number will be converted to
;; a zero and will fail the test below
(offset (->> (alist-get org-x-prop-week-len props nil nil #'equal)
(string-to-number)))
(ancestry (cond
((or (not datetime) (org-ml-time-is-long datetime))
(either :left "WKP root nodes must be short scheduled"))
((< offset 1)
(either :left "WKP root week length must be an int >= 1"))
(t
(let ((date (org-x-dag-date-to-absolute datetime)))
(either :right `(:date ,date :offset ,offset)))))))
(org-x-dag-bs-with-children-1
tree
ancestry
(lambda (_ ancestry) ancestry)
#'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-wkp-root tree)))
(org-x-dag-bs-prefix :weekly `(,n ,@ns)))) (org-x-dag-bs-prefix :weekly `(,n ,@ns))))
(defun org-x-dag-bs-dlp (tree) (defun org-x-dag-bs-dlp (tree)
@ -1379,8 +1484,8 @@ deadline (eg via epoch time) or if it has a repeater."
(either-from (org-x-dag-adjlist-id-bs adjlist id) (either-from (org-x-dag-adjlist-id-bs adjlist id)
(-const nil) (-const nil)
(lambda (r) (lambda (r)
(-let (((_ _ (&plist :date d :offset o)) r)) (pcase r
(+ d o))))) (`(:weekly ,(or :root :branch :leaf) :active ,d) d)))))
(defun org-x-dag-get-children (adjlist id) (defun org-x-dag-get-children (adjlist id)
(->> (plist-get (ht-get adjlist id) :children) (->> (plist-get (ht-get adjlist id) :children)
@ -1526,14 +1631,25 @@ denoted by CUR-KEY with any errors that are found."
(org-x-dag-ht-add-links id ht-e :planned e) (org-x-dag-ht-add-links id ht-e :planned e)
(org-x-dag-ht-add-links id ht-l :planned l)))))) (org-x-dag-ht-add-links id ht-l :planned l))))))
;; TODO need to somehow puke when anything but a leaf node has a link on it
(defun org-x-dag-ns-wkp (adjlist links ns) (defun org-x-dag-ns-wkp (adjlist links ns)
(-let (((&alist :quarterly ht-q) ns)) (cl-flet
(org-x-dag-ns-with-valid ns adjlist :weekly links ((is-valid-leaf-p
`((:quarterly ,(-partial #'org-x-dag-ns-is-leaf-p adjlist))) (id)
(lambda (id this-h res) (-when-let (bs (-> (org-x-dag-adjlist-id-bs adjlist id)
(-let (((&alist :quarterly q) res)) (either-from-right nil)))
(ht-set this-h id (either :right `(:committed ,q))) (eq (nth 1 bs) :leaf))))
(org-x-dag-ht-add-links id ht-q :planned q)))))) (-let (((&alist :quarterly ht-q) ns))
(org-x-dag-ns-with-valid ns adjlist :weekly links
`((:quarterly ,(-partial #'org-x-dag-ns-is-leaf-p adjlist)))
(lambda (id this-h res)
(-let (((&alist :quarterly q) res))
(->> (if (is-valid-leaf-p id)
(either :right `(:committed ,q))
(-> "WKP links can only originate from leaves"
(org-x-dag--ns-err (list id))))
(ht-set this-h id))
(org-x-dag-ht-add-links id ht-q :planned q)))))))
(defun org-x-dag-ns-action (adjlist links ns) (defun org-x-dag-ns-action (adjlist links ns)
(cl-flet (cl-flet
@ -1563,9 +1679,7 @@ denoted by CUR-KEY with any errors that are found."
;; TODO what about repeaters? ;; TODO what about repeaters?
(-when-let (sched (org-x-dag-adjlist-id-planning-datetime (-when-let (sched (org-x-dag-adjlist-id-planning-datetime
adjlist :scheduled id)) adjlist :scheduled id))
(when (and ;;(org-x-dag-date<= week-start sched) (when (and (not (org-x-dag-adjlist-id-done-p adjlist id))
;;(org-x-dag-date<= sched week-end)
(not (org-x-dag-adjlist-id-done-p adjlist id))
committed-ids) committed-ids)
(->> q-committed (->> q-committed
(--filter (-intersection committed-ids (cdr it))) (--filter (-intersection committed-ids (cdr it)))
@ -1831,7 +1945,7 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
(q-cur-p (-partial #'cur-p #'org-x-dag-adjlist-id-qtp-abs qspan)) (q-cur-p (-partial #'cur-p #'org-x-dag-adjlist-id-qtp-abs qspan))
(w-cur-p (-partial #'cur-p #'org-x-dag-adjlist-id-wkp-abs wspan)) (w-cur-p (-partial #'cur-p #'org-x-dag-adjlist-id-wkp-abs wspan))
(cur-q (-filter q-cur-p q)) (cur-q (-filter q-cur-p q))
(cur-w (-filter w-cur-p w)) (cur-w (when wspan (-filter w-cur-p w)))
(cur-d (-filter #'d-cur-p d))) (cur-d (-filter #'d-cur-p d)))
;; add all links to the network status object (ew side effects) ;; add all links to the network status object (ew side effects)
(org-x-dag-ns-ltg adjlist l ns) (org-x-dag-ns-ltg adjlist l ns)
@ -1948,7 +2062,8 @@ removed from, added to, or edited within the DAG respectively."
(:action (list org-x-prop-parent-type (:action (list org-x-prop-parent-type
org-x-prop-time-shift org-x-prop-time-shift
org-x-prop-routine org-x-prop-routine
"ARCHIVE"))) "ARCHIVE"))
(:weekly (list org-x-prop-week-len)))
(append def-props))) (append def-props)))
(bs-fun (pcase group (bs-fun (pcase group
(:action #'org-x-dag-bs-action) (:action #'org-x-dag-bs-action)
@ -2007,19 +2122,23 @@ removed from, added to, or edited within the DAG respectively."
(defun org-x-dag-weekly-span (date) (defun org-x-dag-weekly-span (date)
(cl-flet (cl-flet
((bs2date-offset ((id-date-offset
(bs) (adjlist id)
(-let (((_ _ (&plist :date d :offset o)) bs)) (either-from (org-x-dag-adjlist-id-bs adjlist id)
`(,d ,o)))) (-const nil)
(lambda (r)
(pcase r
(`(:weekly :root :active ,p)
(-let (((&plist :date d :offset o) p))
`(,d ,o))))))))
(-let* (((&plist :dag d :file->ids f) org-x-dag) (-let* (((&plist :dag d :file->ids f) org-x-dag)
(adjlist (dag-get-adjacency-list d)) (adjlist (dag-get-adjacency-list d))
(weekly-file (-> (plist-get org-x-dag-files :plan-files) (weekly-file (-> (plist-get org-x-dag-files :plan-files)
(plist-get :weekly))) (plist-get :weekly)))
(abs (org-x-dag-date-to-absolute date)) (abs (org-x-dag-date-to-absolute date))
(ints (->> (ht-get f weekly-file) (ints (->> (ht-get f weekly-file)
(--map (org-x-dag-adjlist-id-bs adjlist it)) (--map (id-date-offset adjlist it))
(either-rights) (-non-nil)
(-map #'bs2date-offset)
(org-x-dag-weekly-intervals) (org-x-dag-weekly-intervals)
(interval-sort)))) (interval-sort))))
(-when-let (overlaps (nth 0 (interval-overlaps ints))) (-when-let (overlaps (nth 0 (interval-overlaps ints)))
@ -2455,13 +2574,13 @@ Return value is a list like (BUFFER NON-BUFFER)."
(org-x-dag-date->qtp-ids))) (org-x-dag-date->qtp-ids)))
(defun org-x-dag->current-wkp-ids () (defun org-x-dag->current-wkp-ids ()
(let ((span (org-x-dag->weekly-span))) (-when-let (span (org-x-dag->weekly-span))
(cl-flet (cl-flet
((in-span ((in-span
(id) (id)
(-when-let (bs (either-from-right (org-x-dag-id->bs id) id)) (pcase (either-from-right (org-x-dag-id->bs id) id)
(-let (((_ _ (&plist :date d :offset o)) bs)) (`(:weekly :leaf :active ,abs)
(interval-contains-p (+ d o) span))))) (interval-contains-p abs span)))))
(->> (org-x-dag->wkp-ids) (->> (org-x-dag->wkp-ids)
(-filter #'in-span))))) (-filter #'in-span)))))
@ -2594,7 +2713,6 @@ encountered will be returned."
(unless (car it) (unless (car it)
(let* ((next (org-x-dag-datetime-shift (cdr it) shift shifttype)) (let* ((next (org-x-dag-datetime-shift (cdr it) shift shifttype))
(futurep (org-x-dag-datetime< sel-datetime next))) (futurep (org-x-dag-datetime< sel-datetime next)))
;; (futurep (org-x-dag-date< sel-datetime next)))
`(,next . (,futurep . ,next))))) `(,next . (,futurep . ,next)))))
(-last-item))) (-last-item)))
('restart ('restart
@ -2613,23 +2731,27 @@ If REP is nil, return a singleton list just containing DATETIME.
If REP is non-nil, return DATETIME and all repeaters up until If REP is non-nil, return DATETIME and all repeaters up until
FUTURE-LIMIT in a list." FUTURE-LIMIT in a list."
;; ASSUME pts and future-limit are both long or short timestamps ;; ASSUME pts and future-limit are both long or short timestamps
(unless (org-x-dag-datetime< future-limit datetime) (when (org-x-dag-datetime< datetime future-limit)
(pcase rep (pcase rep
(`nil `(,datetime)) (`nil `(,datetime))
(`(,value ,unit ,reptype) (`(,value ,unit ,reptype)
(->> (org-x-dag-repeater-get-next cur datetime value unit reptype) (let* ((next (org-x-dag-repeater-get-next cur datetime value unit reptype))
(--unfold (unless (org-x-dag-datetime< future-limit it) (reps
(cons it (org-x-dag-datetime-shift it value unit)))) (--unfold (when (org-x-dag-datetime< it future-limit)
(cons datetime)))))) (cons it (org-x-dag-datetime-shift it value unit)))
next)))
(if (org-x-dag-datetime= next datetime) reps
(cons datetime reps)))))))
(defun org-x-dag-get-scheduled-at (sel-date pts) (defun org-x-dag-get-scheduled-at (sel-date pts)
(-let* (((&plist :datetime d :repeater r) pts) (-let* (((&plist :datetime d :repeater r) pts)
(islongp (org-ml-time-is-long d)) (islongp (org-ml-time-is-long d))
(sel-date+ (org-x-dag-datetime-shift sel-date 1 'submonth))
((future-limit cur) ((future-limit cur)
(if islongp (if islongp
`((,@sel-date 23 59) `((,@sel-date+ 0 0)
,(org-x-dag-current-datetime)) ,(org-x-dag-current-datetime))
`(,sel-date ,(org-x-dag-current-date))))) `(,sel-date+ ,(org-x-dag-current-date)))))
(org-x-dag-unfold-timestamp cur d r future-limit))) (org-x-dag-unfold-timestamp cur d r future-limit)))
(defun org-x-dag-get-deadlines-at (sel-date pts) (defun org-x-dag-get-deadlines-at (sel-date pts)
@ -2644,7 +2766,9 @@ FUTURE-LIMIT in a list."
`(,(org-x-dag-date-at-current-time sel-date) `(,(org-x-dag-date-at-current-time sel-date)
,(org-x-dag-current-datetime)) ,(org-x-dag-current-datetime))
`(,sel-date ,(org-x-dag-current-date)))) `(,sel-date ,(org-x-dag-current-date))))
(future-limit (org-x-dag-datetime-shift sel-datetime warn-shift warn-shifttype))) (future-limit (org-x-dag-datetime-shift sel-datetime
(1+ warn-shift)
warn-shifttype)))
(org-x-dag-unfold-timestamp cur d r future-limit))) (org-x-dag-unfold-timestamp cur d r future-limit)))
(defun org-x-dag-id->marker (id &optional point) (defun org-x-dag-id->marker (id &optional point)
@ -2913,16 +3037,31 @@ FUTURE-LIMIT in a list."
(list)))))))))) (list))))))))))
(defun org-x-dag-itemize-iterators (files) (defun org-x-dag-itemize-iterators (files)
(org-x-dag-with-unmasked-action-ids files (cl-flet
(pcase it-local ((get-status
(`(:sp-iter . ,status-data) (data)
(let ((status (car status-data))) (pcase data
(when (memq status '(:iter-empty :iter-active)) (`(:iter-empty) :empty)
(let ((tags (org-x-dag-id->tags it))) (`(:iter-active ,data)
(-> (org-x-dag-format-tag-node tags it) (-let* (((&plist :dead d :sched s) data)
(org-add-props nil (d* (-some->> d (org-x-dag-timestamp-to-epoch)))
'x-status status) (s* (-some->> s (org-x-dag-timestamp-to-epoch))))
(list))))))))) (-if-let (epoch (if (and d* s*) (min d* s*) (or s* d*)))
(if (< (+ (float-time) org-x-iterator-active-future-offset)
epoch)
:active
:refill)
:unknown)))
(`(:iter-complete ,_) :complete))))
(org-x-dag-with-unmasked-action-ids files
(pcase it-local
(`(:sp-iter . ,status-data)
(let ((status (get-status status-data))
(tags (org-x-dag-id->tags it)))
(-> (org-x-dag-format-tag-node tags it)
(org-add-props nil
'x-status status)
(list))))))))
(defun org-x-dag-itemize-incubated (files) (defun org-x-dag-itemize-incubated (files)
(org-x-dag-with-unmasked-action-ids files (org-x-dag-with-unmasked-action-ids files
@ -2994,12 +3133,15 @@ FUTURE-LIMIT in a list."
((map-ns ((map-ns
(ns) (ns)
(-let (((&plist :planned p :committed c :scheduled-actions s) ns)) (-let (((&plist :planned p :committed c :scheduled-actions s) ns))
(list (-intersection p wkp-ids) c s)))) (list :planned (-intersection p wkp-ids)
:committed c
:scheduled-actions s))))
(org-x-dag-with-ids files (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:quarterly :active ,dead) (`(:quarterly :active ,p)
(let* ((tags (org-x-dag-id->tags it)) (-let* (((&plist :deadline dead) p)
(date (org-x-dag-quarter-tags-to-date tags))) (tags (org-x-dag-id->tags it))
(date (org-x-dag-quarter-tags-to-date tags)))
(when (org-x-dag-datetime= q-date date) (when (org-x-dag-datetime= q-date date)
;; TODO this network status thing should probably be a feature ;; TODO this network status thing should probably be a feature
;; in all planning nodes, since we are guaranteed to have a ;; in all planning nodes, since we are guaranteed to have a
@ -3019,14 +3161,11 @@ FUTURE-LIMIT in a list."
;; and not doing these convoluted date checks (which won't work in all cases ;; and not doing these convoluted date checks (which won't work in all cases
;; anyways because they assume the week start will never change) ;; anyways because they assume the week start will never change)
(defun org-x-dag-itemize-wkp (files) (defun org-x-dag-itemize-wkp (files)
(let ((span (org-x-dag->weekly-span))) (-when-let (span (org-x-dag->weekly-span))
(org-x-dag-with-ids files (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:weekly :active ,p) (`(:weekly :leaf :active ,abs)
(-let* (((&plist :date d :offset o) p) (let ((day (org-x-dag-abs-to-day-of-week abs)))
(abs (+ d o))
(day (->> (calendar-gregorian-from-absolute abs)
(calendar-day-of-week))))
(when (interval-contains-p abs span) (when (interval-contains-p abs span)
(let ((ns (-some-> (org-x-dag-id->ns it) (let ((ns (-some-> (org-x-dag-id->ns it)
(either-from (-const nil) #'identity))) (either-from (-const nil) #'identity)))
@ -3165,29 +3304,45 @@ FUTURE-LIMIT in a list."
(defun org-x-dag-itemize-agenda (files sel-date) (defun org-x-dag-itemize-agenda (files sel-date)
(let ((todayp (org-x-dag-date= (org-x-dag-current-date) sel-date))) (let ((todayp (org-x-dag-date= (org-x-dag-current-date) sel-date)))
(cl-flet* (cl-flet*
((get-datetimes ((past-p
(donep dt-fun pts) (datetime)
(org-x-dag-date< datetime sel-date))
(get-datetimes
(donep keep-most-recent-p dt-fun pts)
(if donep (if donep
(-let (((&plist :datetime) pts)) (-let (((&plist :datetime) pts))
(when (org-x-dag-date= datetime sel-date) (when (org-x-dag-date= datetime sel-date)
`(,datetime))) `(,datetime)))
(-when-let (datetimes (funcall dt-fun sel-date pts)) (-when-let (datetimes (funcall dt-fun sel-date pts))
(if todayp datetimes (cond
(--drop-while (org-x-dag-date< it sel-date) datetimes))))) (todayp
datetimes)
(keep-most-recent-p
(-let (((past rest) (-split-with #'past-p datetimes)))
(if past (cons (-last-item past) rest) rest)))
(t
(-drop-while #'past-p datetimes))))))
(expand-datetimes (expand-datetimes
(id donep which dt-fun) (id donep keep-past-p which dt-fun post-fun)
(-when-let (pts (-some->> (org-x-dag-id->planning-timestamp which id) (-when-let (pts (-some->> (org-x-dag-id->planning-timestamp which id)
(org-x-dag-partition-timestamp))) (org-x-dag-partition-timestamp)))
(-when-let (ds (get-datetimes donep dt-fun pts)) (-when-let (ds (get-datetimes donep keep-past-p dt-fun pts))
(-let ((tags (org-x-dag-id->tags id)) (-let ((tags (org-x-dag-id->tags id))
((&plist :pos) pts)) ((&plist :pos) pts))
(--map (list :pos pos :datetime it :tags tags :id id) ds))))) (->> (-map post-fun ds)
(--map (list :pos pos :datetime it :tags tags :id id)))))))
(scheduled-datetimes (scheduled-datetimes
(id donep) (id donep)
(expand-datetimes id donep :scheduled #'org-x-dag-get-scheduled-at)) (expand-datetimes id donep nil :scheduled
#'org-x-dag-get-scheduled-at
#'identity))
(deadlined-datetimes (deadlined-datetimes
(id donep) (id donep)
(expand-datetimes id donep :deadline #'org-x-dag-get-deadlines-at)) (expand-datetimes id donep t :deadline
#'org-x-dag-get-deadlines-at
(lambda (datetime)
(if (org-x-dag-date= datetime sel-date) datetime
(car (org-x-dag-datetime-split datetime))))))
(add-sched (add-sched
(acc id donep) (acc id donep)
(-let (((acc-d acc-s) acc) (-let (((acc-d acc-s) acc)
@ -3390,6 +3545,19 @@ FUTURE-LIMIT in a list."
(-> (org-x-dag-format-month-tag month) (-> (org-x-dag-format-month-tag month)
(org-x-dag-headlines-find-tag headlines))) (org-x-dag-headlines-find-tag headlines)))
(defun org-x-dag-headlines-find-date (date headlines)
(cl-flet
((has-date-p
(date headline)
(-when-let (sched (-some->> (org-ml-headline-get-planning headline)
(org-ml-get-property :scheduled)
(org-ml-timestamp-get-start-time)
(org-x-dag-datetime-split)
(car)
(org-x-dag-date-to-absolute)))
(= sched date))))
(--find (has-date-p date it) headlines)))
(defun org-x-dag-headlines-find-day (day headlines) (defun org-x-dag-headlines-find-day (day headlines)
(-> (org-x-dag-format-day-tag day) (-> (org-x-dag-format-day-tag day)
(org-x-dag-headlines-find-tag headlines))) (org-x-dag-headlines-find-tag headlines)))
@ -3430,16 +3598,36 @@ FUTURE-LIMIT in a list."
(tag (org-x-dag-format-month-tag month))) (tag (org-x-dag-format-month-tag month)))
(org-x-dag-build-planning-headline title tag 2 nil subheadlines))) (org-x-dag-build-planning-headline title tag 2 nil subheadlines)))
(defun org-x-dag-build-week-headline (y m d level subheadlines)
(let ((title (format "%d-%02d-%02d" y m d)))
(->> (apply #'org-ml-build-headline!
:title-text title
:level level
:todo-keyword org-x-kw-todo
:planning `(:scheduled (,y ,m ,d))
subheadlines)
(org-ml-headline-set-node-property org-x-prop-week-len "7")
(org-x-dag-headline-add-id))))
(defun org-x-dag-build-day-of-week-headline (level date subheadlines)
(-let* (((y m d) date)
(daynum (->> (org-x-dag-date-to-gregorian date)
(calendar-day-of-week)))
(title (elt calendar-day-name-array daynum)))
(->> (apply #'org-ml-build-headline!
:title-text title
:level level
:todo-keyword org-x-kw-todo
:planning `(:scheduled (,y ,m ,d))
subheadlines)
(org-x-dag-headline-add-id))))
(defun org-x-dag-build-day-headline (date subheadlines) (defun org-x-dag-build-day-headline (date subheadlines)
(-let* (((y m d) date) (-let* (((y m d) date)
(title (format "%d-%02d-%02d" y m d)) (title (format "%d-%02d-%02d" y m d))
(tag (org-x-dag-format-day-tag d))) (tag (org-x-dag-format-day-tag d)))
(org-x-dag-build-planning-headline title tag 3 nil subheadlines))) (org-x-dag-build-planning-headline title tag 3 nil subheadlines)))
(defun org-x-dag-build-day-of-week-headline (daynum offset subheadlines)
(let ((title (elt calendar-day-name-array daynum))
(tag (org-x-dag-format-offset-tag offset)))
(org-x-dag-build-planning-headline title tag 3 nil subheadlines)))
;; headline ids ;; headline ids
@ -3482,11 +3670,15 @@ FUTURE-LIMIT in a list."
:title-text (plist-get it :desc) :title-text (plist-get it :desc)
:tags `(,(plist-get it :tag)))))) :tags `(,(plist-get it :tag))))))
(defun org-x-dag-wkp-empty () (defun org-x-dag-wkp-empty (date)
(->> (-iterate #'1+ 0 7) (let ((abs (-if-let (span (org-x-dag-weekly-span date))
(--annotate (mod (+ org-x-dag-weekday-start it) 7)) (car span)
(--map (org-x-dag-build-day-of-week-headline (car it) (cdr it) nil)))) (->> (org-x-dag-date-to-week-start date)
(org-x-dag-date-to-absolute)))))
(->> (-iterate #'1+ 0 7)
(--map (org-x-dag-absolute-to-date (+ abs it)))
(--map (org-x-dag-build-day-of-week-headline 4 it nil)))))
;;; stateful buffer function ;;; stateful buffer function
;; nested headline manipulation ;; nested headline manipulation
@ -3670,43 +3862,45 @@ FUTURE-LIMIT in a list."
;; (org-x-dag-build-day-of-week-headline daynum hls)) ;; (org-x-dag-build-day-of-week-headline daynum hls))
;; plan)) ;; plan))
(defun org-x-dag-wkp-get-headline-inner (y m d) (defun org-x-dag-wkp-get-headline-inner (date-abs)
(org-x-with-file (org-x-dag->planning-file :weekly) (org-x-with-file (org-x-dag->planning-file :weekly)
(->> (org-ml-parse-subtrees 'all) (-let (((m _ y) (calendar-gregorian-from-absolute date-abs)))
(org-x-dag-headlines-find-year y) (->> (org-ml-parse-subtrees 'all)
(org-ml-headline-get-subheadlines) (org-x-dag-headlines-find-year y)
(org-x-dag-headlines-find-month m) (org-ml-headline-get-subheadlines)
(org-ml-headline-get-subheadlines) (org-x-dag-headlines-find-month m)
(org-x-dag-headlines-find-day d)))) (org-ml-headline-get-subheadlines)
(org-x-dag-headlines-find-date date-abs)))))
(defun org-x-dag-wkp-get-week-headline (date) (defun org-x-dag-wkp-get-week-headline (date)
(-let (((y m d) (->> (org-x-dag-weekly-span date) (-when-let (abs (car (org-x-dag-weekly-span date)))
(car) (org-x-dag-wkp-get-headline-inner abs)))
(org-x-dag-absolute-to-date))))
(org-x-dag-wkp-get-headline-inner y m d)))
(defun org-x-dag-wkp-get-day-headline (date) (defun org-x-dag-wkp-get-day-headline (date)
(-let ((abs (car (org-x-dag-weekly-span date))) (-when-let (abs (car (org-x-dag-weekly-span date)))
((y m d) (org-x-dag-absolute-to-date abs)) (let ((day-abs (org-x-dag-date-to-absolute date)))
(offset (- (org-x-dag-date-to-absolute date) abs))) (->> (org-x-dag-wkp-get-headline-inner abs)
(->> (org-x-dag-wkp-get-headline-inner y m d) (org-ml-headline-get-subheadlines)
(org-x-dag-headlines-find-offset o)))) (org-x-dag-headlines-find-date day-abs)))))
(defun org-x-dag-wkp-set-headlines (date headlines) (defun org-x-dag-wkp-set-headlines (date headlines)
(-let* (((y m d) (->> (org-x-dag->weekly-span) (-let* ((abs (or (car (org-x-dag->weekly-span))
(car) ;; TODO this should all be one command (get weekly span or
(org-x-dag-absolute-to-date))) ;; make a new one if not found)
(->> (org-x-dag-date-to-week-start date)
(org-x-dag-date-to-absolute))))
((y m d) (org-x-dag-absolute-to-date abs))
(path (org-x-dag->planning-file :weekly)) (path (org-x-dag->planning-file :weekly))
(find-year (-partial #'org-x-dag-headlines-find-year y)) (find-year (-partial #'org-x-dag-headlines-find-year y))
(find-month (-partial #'org-x-dag-headlines-find-month m)) (find-month (-partial #'org-x-dag-headlines-find-month m))
(find-day (-partial #'org-x-dag-headlines-find-day d)) (find-date (-partial #'org-x-dag-headlines-find-date abs))
(build-year (-partial #'org-x-dag-build-year-headline y)) (build-year (-partial #'org-x-dag-build-year-headline y))
(build-month (-partial #'org-x-dag-build-month-headline m)) (build-month (-partial #'org-x-dag-build-month-headline m))
(build-day (-partial #'org-x-dag-build-day-headline date))) (build-day (-partial #'org-x-dag-build-week-headline y m d 3)))
(org-x-dag-headline-set-nested path headlines (org-x-dag-headline-set-nested path headlines
`((,find-year ,build-year) `((,find-year ,build-year)
(,find-month ,build-month) (,find-month ,build-month)
(,find-day ,build-day))))) (,find-date ,build-day)))))
;; TODO these functions need to take dates and not 'week's (whatever those are) ;; TODO these functions need to take dates and not 'week's (whatever those are)
;; (defun org-x-dag-wkp-get (date) ;; (defun org-x-dag-wkp-get (date)
@ -3886,7 +4080,7 @@ FUTURE-LIMIT in a list."
(org-x-dag-qtp-set-headlines date (org-x-dag-qtp-empty))) (org-x-dag-qtp-set-headlines date (org-x-dag-qtp-empty)))
(defun org-x-dag--new-wkp (date) (defun org-x-dag--new-wkp (date)
(org-x-dag-wkp-set-headlines date (org-x-dag-wkp-empty))) (org-x-dag-wkp-set-headlines date (org-x-dag-wkp-empty date)))
(defun org-x-dag-new-qtp () (defun org-x-dag-new-qtp ()
(interactive) (interactive)
@ -4353,17 +4547,18 @@ FUTURE-LIMIT in a list."
(ancestry-status (plist-get a :canceled-parent-p))) (ancestry-status (plist-get a :canceled-parent-p)))
(list "Active" (format "Mask Status: %s" ancestry-status)))) (list "Active" (format "Mask Status: %s" ancestry-status))))
(`(:quarterly :active ,dead) (`(:quarterly :active ,p)
(->> (if dead (->> (org-ml-to-trimmed-string dead) (-let (((&plist :deadline dl) p))
(->> (if dl (->> (org-ml-to-trimmed-string dl)
(format "deadline: %s")) (format "deadline: %s"))
"no deadline") "no deadline")
(format "Active with %s") (format "Active with %s")
(list))) (list))))
(`(:quarterly :complete ,comptime) (`(:quarterly :complete ,comptime)
(list (format-comptime "quarterly plan" comptime))) (list (format-comptime "quarterly plan" comptime)))
(`(:weekly :active) (`(:weekly :leaf :active ,_)
"Active") '("Active"))
(`(:weekly :complete ,comptime) (`(:weekly :leaf :complete ,comptime)
(list (format-comptime "weekly plan" comptime))) (list (format-comptime "weekly plan" comptime)))
(`(:daily :active (:sched ,sched)) (`(:daily :active (:sched ,sched))
(-let (((y m d H M) (org-ml-timestamp-get-start-time sched))) (-let (((y m d H M) (org-ml-timestamp-get-start-time sched)))
@ -4773,7 +4968,10 @@ In the order of display
(-let* ((ns (get-text-property 1 'x-network-status line)) (-let* ((ns (get-text-property 1 'x-network-status line))
((rank text) ((rank text)
(if (not ns) '(0 "No Network Status") (if (not ns) '(0 "No Network Status")
(-let (((p s c) ns)) (-let (((&plist :planned p
:scheduled-actions s
:committed c)
ns))
(cond (cond
((and s c) ((and s c)
'(5 "Committed | Scheduled")) '(5 "Committed | Scheduled"))
@ -4802,8 +5000,7 @@ In the order of display
(lambda (line) (lambda (line)
(-let* ((ns (get-text-property 1 'x-network-status line)) (-let* ((ns (get-text-property 1 'x-network-status line))
(day (get-text-property 1 'x-day line)) (day (get-text-property 1 'x-day line))
;; TODO not sure if this will work anymore (day-name (org-x-dag-day-of-week-to-tag day))
(day-name (alist-get day org-x-dag-weekly-tags))
((rank text) ((rank text)
(if (not ns) '(0 "No Network Status") (if (not ns) '(0 "No Network Status")
(-let (((&plist :planned p :committed c) ns)) (-let (((&plist :planned p :committed c) ns))
@ -4880,8 +5077,11 @@ review phase)"
(lambda (line) (lambda (line)
(let ((s (get-text-property 1 'x-status line))) (let ((s (get-text-property 1 'x-status line)))
(pcase s (pcase s
(:iter-empty "1. Empty") (:unknown "0. Unknown")
(:iter-active "2. Active"))))))))))) (:complete "1. Refill")
(:empty "2. Empty")
(:refill "3. Refill")
(:active "4. Active")))))))))))
(defun org-x-dag-agenda-errors () (defun org-x-dag-agenda-errors ()
"Show the critical errors agenda view." "Show the critical errors agenda view."