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

ENH make action ns error when linking to non-committed epg

This commit is contained in:
Nathan Dwarshuis 2022-04-19 23:20:00 -04:00
parent fdb76e6e43
commit 5bd754e9d1
1 changed files with 20 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1358,26 +1358,31 @@ used for optimization."
:lifetime ht-l :lifetime ht-l
:survival ht-s :survival ht-s
:quarterly ht-q) :quarterly ht-q)
ns)) ns)
(is-committed-leaf-p
(lambda (adjlist id)
(if (not (org-x-dag-ht-get-maybe ht-e id :committed))
(either :left "Linked to non-committed endpoint node")
(org-x-dag-ns-is-leaf-p adjlist id)))))
(org-x-dag-ns-with-valid ns adjlist :action links (org-x-dag-ns-with-valid ns adjlist :action links
'((:survival org-x-dag-ns-is-leaf-p) `((:survival org-x-dag-ns-is-leaf-p)
(:endpoint org-x-dag-ns-is-leaf-p) (:endpoint ,is-committed-leaf-p)
(:lifetime org-x-dag-ns-is-leaf-p)) (:lifetime org-x-dag-ns-is-leaf-p))
(lambda (id this-h res) (lambda (id this-h res)
(-let* (((&alist :survival s :endpoint e :lifetime l) res) (-let (((&alist :survival s :endpoint e :lifetime l) res))
(this-ns (->> (cond
(cond ((and s (or e l))
((and s (or e l)) (->> "Action has both survival and endpoint/lifetime links"
(->> "Action has both survival and endpoint/lifetime links" (either :left)))
(either :left))) (s
(s (either :right `(:committed ,s :survivalp t)))
(either :right `(:committed ,s :survivalp t))) (t
(t (either :right `(:committed (,@e ,@l) :survivalp nil))))
(either :right `(:committed (,@e ,@l) :survivalp nil)))))) (ht-set this-h id this-ns))
(when (org-x-dag-id->planning-timestamp :scheduled id) (when (-some->> (org-x-dag-adjlist-id-hl-meta-prop adjlist :planning id)
(org-ml-get-property :scheduled))
(->> (-union (get-planned ht-e e) (get-planned ht-l l)) (->> (-union (get-planned ht-e e) (get-planned ht-l l))
(org-x-dag-ht-add-links id ht-q :scheduled-actions))) (org-x-dag-ht-add-links id ht-q :scheduled-actions)))
(ht-set this-h id this-ns)
(org-x-dag-ht-add-links id ht-l :fulfilled l) (org-x-dag-ht-add-links id ht-l :fulfilled l)
(org-x-dag-ht-add-links id ht-s :fulfilled s) (org-x-dag-ht-add-links id ht-s :fulfilled s)
(org-x-dag-ht-add-links id ht-e :fulfilled e) (org-x-dag-ht-add-links id ht-e :fulfilled e)