FIX compile errors
This commit is contained in:
parent
24dd5e68e0
commit
5f7f6feab6
|
@ -1271,7 +1271,7 @@ used for optimization."
|
||||||
;; NOTE this valid-fun doesn't just have to return a Right ID upon
|
;; NOTE this valid-fun doesn't just have to return a Right ID upon
|
||||||
;; success, it can return a Right anything which might be useful
|
;; success, it can return a Right anything which might be useful
|
||||||
;; downstream
|
;; downstream
|
||||||
(funcall valid-fun adjlist id))
|
(funcall valid-fun id))
|
||||||
(t
|
(t
|
||||||
(either :right id))))
|
(either :right id))))
|
||||||
(reduce-valid
|
(reduce-valid
|
||||||
|
@ -1315,7 +1315,7 @@ used for optimization."
|
||||||
(defun org-x-dag-ns-epg (adjlist links ns)
|
(defun org-x-dag-ns-epg (adjlist links ns)
|
||||||
(-let (((&alist :lifetime ht-l) ns))
|
(-let (((&alist :lifetime ht-l) ns))
|
||||||
(org-x-dag-ns-with-valid ns adjlist :endpoint links
|
(org-x-dag-ns-with-valid ns adjlist :endpoint links
|
||||||
'((:lifetime org-x-dag-ns-is-leaf-p)
|
`((:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))
|
||||||
(:endpoint))
|
(:endpoint))
|
||||||
(lambda (id this-h res)
|
(lambda (id this-h res)
|
||||||
(-let (((&alist :lifetime l) res)
|
(-let (((&alist :lifetime l) res)
|
||||||
|
@ -1330,8 +1330,8 @@ used for optimization."
|
||||||
(defun org-x-dag-ns-qtp (adjlist links ns)
|
(defun org-x-dag-ns-qtp (adjlist links ns)
|
||||||
(-let (((&alist :lifetime ht-l :endpoint ht-e) ns))
|
(-let (((&alist :lifetime ht-l :endpoint ht-e) ns))
|
||||||
(org-x-dag-ns-with-valid ns adjlist :quarterly links
|
(org-x-dag-ns-with-valid ns adjlist :quarterly links
|
||||||
'((:lifetime org-x-dag-ns-is-leaf-p)
|
`((:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))
|
||||||
(:endpoint org-x-dag-ns-is-leaf-p))
|
(:endpoint (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))))
|
||||||
(lambda (id this-h res)
|
(lambda (id this-h res)
|
||||||
(-let (((&alist :lifetime l :endpoint e) res))
|
(-let (((&alist :lifetime l :endpoint e) res))
|
||||||
(ht-set this-h id (either :right `(:committed (,@e ,@l))))
|
(ht-set this-h id (either :right `(:committed (,@e ,@l))))
|
||||||
|
@ -1343,7 +1343,7 @@ used for optimization."
|
||||||
(defun org-x-dag-ns-wkp (adjlist links ns)
|
(defun org-x-dag-ns-wkp (adjlist links ns)
|
||||||
(-let (((&alist :quarterly ht-q) ns))
|
(-let (((&alist :quarterly ht-q) ns))
|
||||||
(org-x-dag-ns-with-valid ns adjlist :weekly links
|
(org-x-dag-ns-with-valid ns adjlist :weekly links
|
||||||
'((:quarterly org-x-dag-ns-is-leaf-p))
|
`((:quarterly (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))))
|
||||||
(lambda (id this-h res)
|
(lambda (id this-h res)
|
||||||
(-let (((&alist :quarterly q) res))
|
(-let (((&alist :quarterly q) res))
|
||||||
(ht-set this-h id (either :right `(:committed ,q)))
|
(ht-set this-h id (either :right `(:committed ,q)))
|
||||||
|
@ -1360,15 +1360,15 @@ used for optimization."
|
||||||
:quarterly ht-q)
|
:quarterly ht-q)
|
||||||
ns)
|
ns)
|
||||||
(is-committed-leaf-p
|
(is-committed-leaf-p
|
||||||
(lambda (adjlist id)
|
(lambda (id)
|
||||||
(if (org-x-dag-ht-get-maybe ht-e id :committed)
|
(if (org-x-dag-ht-get-maybe ht-e id :committed)
|
||||||
(org-x-dag-ns-is-leaf-p adjlist id)
|
(org-x-dag-ns-is-leaf-p adjlist id)
|
||||||
(->> (list "Linked to non-committed endpoint node" id)
|
(->> (list "Linked to non-committed endpoint node" id)
|
||||||
(either :left))))))
|
(either :left))))))
|
||||||
(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 (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id)))
|
||||||
(:endpoint ,is-committed-leaf-p)
|
(:endpoint ,is-committed-leaf-p)
|
||||||
(:lifetime org-x-dag-ns-is-leaf-p))
|
(:lifetime (lambda (id) (org-x-dag-ns-is-leaf-p ,adjlist id))))
|
||||||
(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))
|
||||||
(->> (cond
|
(->> (cond
|
||||||
|
@ -1392,7 +1392,7 @@ used for optimization."
|
||||||
(->> (--mapcat (org-x-dag-ht-get-maybe ht-e it :committed) e)
|
(->> (--mapcat (org-x-dag-ht-get-maybe ht-e it :committed) e)
|
||||||
(org-x-dag-ht-add-links id ht-l :fulfilled))))))))
|
(org-x-dag-ht-add-links id ht-l :fulfilled))))))))
|
||||||
|
|
||||||
(defun org-x-dag-ns-dlp (sel-date adjlist links ns)
|
(defun org-x-dag-ns-dlp (adjlist links ns)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((get-planned-ht
|
((get-planned-ht
|
||||||
(htbl ids)
|
(htbl ids)
|
||||||
|
@ -1419,11 +1419,11 @@ used for optimization."
|
||||||
:weekly ht-w)
|
:weekly ht-w)
|
||||||
ns)
|
ns)
|
||||||
(get-planned
|
(get-planned
|
||||||
(lambda (id committed-ids)
|
(lambda (committed-ids)
|
||||||
(->> (get-planned-ht ht-l committed-ids)
|
(->> (get-planned-ht ht-l committed-ids)
|
||||||
(-union (get-planned-ht ht-e committed-ids)))))
|
(-union (get-planned-ht ht-e committed-ids)))))
|
||||||
(is-scheduled-action
|
(is-scheduled-action
|
||||||
(lambda (adjlist id committed-ids)
|
(lambda (id committed-ids)
|
||||||
(-if-let (sched (get-sched id))
|
(-if-let (sched (get-sched id))
|
||||||
;; ASSUME if the node's timestamp does not coincide with
|
;; ASSUME if the node's timestamp does not coincide with
|
||||||
;; the actual day in the plan it will be reflected in the
|
;; the actual day in the plan it will be reflected in the
|
||||||
|
@ -1433,20 +1433,20 @@ used for optimization."
|
||||||
(->> (list "Linked to action with HH:MM timestamp" id)
|
(->> (list "Linked to action with HH:MM timestamp" id)
|
||||||
(either :left))
|
(either :left))
|
||||||
(if (org-x-dag-ht-get-maybe ht-a id :survivalp)
|
(if (org-x-dag-ht-get-maybe ht-a id :survivalp)
|
||||||
(to-valid id survival committed-ids)
|
(to-valid id :survival committed-ids)
|
||||||
(-if-let (q (funcall get-planned id committed-ids))
|
(-if-let (q (funcall get-planned id committed-ids))
|
||||||
(to-valid id :quarterly q)
|
(to-valid id :quarterly q)
|
||||||
(->> (list "Linked to scheduled action that isn't on QTP" id)
|
(->> (list "Linked to scheduled action that isn't on QTP" id)
|
||||||
(either :left))))))
|
(either :left))))))
|
||||||
(-if-let (w (->> (funcall get-planned id committed-ids)
|
(-if-let (w (->> (funcall get-planned committed-ids)
|
||||||
(--mapcat (org-x-dag-ht-get-maybe ht-q it :planned))))
|
(--mapcat (org-x-dag-ht-get-maybe ht-q it :planned))))
|
||||||
(to-valid id :weekly w)
|
(to-valid id :weekly w)
|
||||||
(->> (list "Linked to unscheduled action that isn't on WKP" id)
|
(->> (list "Linked to unscheduled action that isn't on WKP" id)
|
||||||
(either :left))))))
|
(either :left))))))
|
||||||
(is-valid-action
|
(is-valid-action
|
||||||
(lambda (adjlist id)
|
(lambda (id)
|
||||||
(-if-let (c (org-x-dag-ht-get-maybe ht-a id :committed))
|
(-if-let (c (org-x-dag-ht-get-maybe ht-a id :committed))
|
||||||
(funcall is-scheduled-action adjlist id c)
|
(funcall is-scheduled-action id c)
|
||||||
(either :left (list "Linked to uncommitted action" id))))))
|
(either :left (list "Linked to uncommitted action" id))))))
|
||||||
(org-x-dag-ns-with-valid ns adjlist :daily links
|
(org-x-dag-ns-with-valid ns adjlist :daily links
|
||||||
`((:action ,is-valid-action))
|
`((:action ,is-valid-action))
|
||||||
|
@ -1580,9 +1580,6 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
|
||||||
(--each (ht-keys h)
|
(--each (ht-keys h)
|
||||||
(propagate h it )))))
|
(propagate h it )))))
|
||||||
|
|
||||||
(defun org-x-dag-adjlist-ids-filter-tags (adjlist tag-getter date ids)
|
|
||||||
(--filter (equal date (funcall tag-getter (org-x-dag-adjlist-id-tags it))) ids))
|
|
||||||
|
|
||||||
(defun org-x-dag-get-network-status (sel-date adjlist links)
|
(defun org-x-dag-get-network-status (sel-date adjlist links)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((cur-links
|
((cur-links
|
||||||
|
@ -1641,7 +1638,7 @@ DEF-FUN and the output from GET-FUN (type :: a -> NS)."
|
||||||
(org-x-dag-ht-propagate-up adjlist :survival :fulfilled ns)
|
(org-x-dag-ht-propagate-up adjlist :survival :fulfilled ns)
|
||||||
(org-x-dag-ht-propagate-action-down adjlist ns)
|
(org-x-dag-ht-propagate-action-down adjlist ns)
|
||||||
|
|
||||||
(org-x-dag-ns-dlp sel-date adjlist cur-d ns)
|
(org-x-dag-ns-dlp adjlist cur-d ns)
|
||||||
(org-x-dag-ht-propagate-down adjlist :action :planned ns)
|
(org-x-dag-ht-propagate-down adjlist :action :planned ns)
|
||||||
|
|
||||||
ns)))
|
ns)))
|
||||||
|
@ -2351,8 +2348,7 @@ FUTURE-LIMIT in a list."
|
||||||
(defun org-x-dag-format-tag-node (tags id)
|
(defun org-x-dag-format-tag-node (tags id)
|
||||||
(-let* ((marker (org-agenda-new-marker (org-x-dag-id->marker id)))
|
(-let* ((marker (org-agenda-new-marker (org-x-dag-id->marker id)))
|
||||||
((ts . ts-type) (org-x-dag-id->agenda-timestamp id))
|
((ts . ts-type) (org-x-dag-id->agenda-timestamp id))
|
||||||
(item (org-x-dag-format-item id "" tags nil))
|
(item (org-x-dag-format-item id "" tags nil)))
|
||||||
(priority (org-get-priority item)))
|
|
||||||
(-> (org-x-dag-add-default-props item id)
|
(-> (org-x-dag-add-default-props item id)
|
||||||
(org-add-props nil
|
(org-add-props nil
|
||||||
;; face
|
;; face
|
||||||
|
@ -3958,7 +3954,7 @@ FUTURE-LIMIT in a list."
|
||||||
(e right)
|
(e right)
|
||||||
(either-from e (lambda (e) (list (format "Error: %s" e))) right))
|
(either-from e (lambda (e) (list (format "Error: %s" e))) right))
|
||||||
(format-bs
|
(format-bs
|
||||||
(id bs)
|
(bs)
|
||||||
(->> (format-either bs (lambda (b) (list (org-x-dag--format-bs b))))
|
(->> (format-either bs (lambda (b) (list (org-x-dag--format-bs b))))
|
||||||
(format-header "Buffer Status")))
|
(format-header "Buffer Status")))
|
||||||
(format-ns-either
|
(format-ns-either
|
||||||
|
@ -3980,7 +3976,7 @@ FUTURE-LIMIT in a list."
|
||||||
(let* ((id (org-x-dag-headline-get-id hl))
|
(let* ((id (org-x-dag-headline-get-id hl))
|
||||||
(bs (-some->> id
|
(bs (-some->> id
|
||||||
(org-x-dag-id->bs)
|
(org-x-dag-id->bs)
|
||||||
(format-bs id))))
|
(format-bs))))
|
||||||
(if (not bs) (message "Headline is not node")
|
(if (not bs) (message "Headline is not node")
|
||||||
(let ((lps (->> (org-x-dag-id->linked-parents id)
|
(let ((lps (->> (org-x-dag-id->linked-parents id)
|
||||||
(format-ids "Parent Links")))
|
(format-ids "Parent Links")))
|
||||||
|
|
Loading…
Reference in New Issue