ADD comprehensive goal agenda view

This commit is contained in:
Nathan Dwarshuis 2022-02-27 12:05:00 -05:00
parent eb1146b79d
commit 7639dce46a
1 changed files with 103 additions and 44 deletions

View File

@ -387,7 +387,7 @@ Return value is a list like (BUFFER NON-BUFFER)."
(cons buffer-parent (-remove-item buffer-parent parents))
(cons nil parents))))
(defun org-x-dag-id->foreign-parents (id)
(defun org-x-dag-id->linked-parents (id)
"Return non-buffer (foreign) parents of ID."
(cdr (org-x-dag-id->split-parents id)))
@ -399,12 +399,12 @@ Return value is a list like (BUFFER NON-BUFFER)."
(--separate (equal (org-x-dag-id->buffer-parent it) id))))
(defun org-x-dag-id->buffer-children (id)
"Return children of ID that are in the same buffer."
"Return children of ID that are not linked."
(car (org-x-dag-id->split-children id)))
(defun org-x-dag-id->foreign-children (id)
"Return children of ID that are not in the same buffer."
(cdr (org-x-dag-id->split-children id)))
(defun org-x-dag-id->linked-children (id)
"Return children of ID that are linked."
(cadr (org-x-dag-id->split-children id)))
(defmacro org-x-dag-id->with-split-parents (id &rest body)
(declare (indent 1))
@ -1885,7 +1885,7 @@ FUTURE-LIMIT in a list."
((split-parent-goals
(s)
(let ((id (get-text-property 1 'x-id s)))
(-if-let (goal-ids (org-x-dag-id->foreign-parents id))
(-if-let (goal-ids (org-x-dag-id->linked-parents id))
(--map (org-add-props (copy-seq s) nil 'x-goal-id it) goal-ids)
(list (org-add-props s nil 'x-goal-id nil))))))
(->> (org-x-dag-scan-projects)
@ -1967,7 +1967,7 @@ FUTURE-LIMIT in a list."
(org-add-props nil
'x-is-standalone is-standalone
'x-status s))))
(-if-let (goal-ids (org-x-dag-id->foreign-parents key))
(-if-let (goal-ids (org-x-dag-id->linked-parents key))
(--map (org-add-props item nil 'x-goal-id it) goal-ids)
(list (org-add-props item nil 'x-goal-id nil)))))))))))
(org-x-dag-with-files (org-x-get-action-files)
@ -1980,7 +1980,7 @@ FUTURE-LIMIT in a list."
(cl-flet
((format-key
(category is-standalone key)
(-when-let (goal-ids (->> (org-x-dag-id->foreign-parents key)
(-when-let (goal-ids (->> (org-x-dag-id->linked-parents key)
(--filter (org-x-dag-id->is-goal-p :survival it))))
(let ((tags (org-x-dag-id->tags nil key)))
(org-x-dag-with-id key
@ -2013,7 +2013,7 @@ FUTURE-LIMIT in a list."
(-let* (((&plist :key :status :tags) result)
(priority (alist-get status org-x-project-status-priorities)))
(when (>= priority 0)
(-when-let (goal-ids (->> (org-x-dag-id->foreign-parents key)
(-when-let (goal-ids (->> (org-x-dag-id->linked-parents key)
(--filter (org-x-dag-id->is-goal-p :survival it))))
(org-x-dag-with-id key
(let ((item (-> (org-x-dag-format-tag-node cat tags key)
@ -2043,7 +2043,7 @@ FUTURE-LIMIT in a list."
;; (let ((id (get-text-property 1 'x-id s)))
;; ;; ASSUME all foreign parents are actually goals
;; ;; TODO this isn't a great assumption
;; (-if-let (goal-ids (org-x-dag-id->foreign-parents id))
;; (-if-let (goal-ids (org-x-dag-id->linked-parents id))
;; (--map (org-add-props s nil 'x-goal-id it) goal-ids)
;; (list (org-add-props s nil 'x-goal-id nil))))))
;; (->> (org-x-dag-scan-tasks)
@ -2098,58 +2098,83 @@ FUTURE-LIMIT in a list."
(--map (format-key it-category it)))
(list (format-key it-category it)))))))
(defun org-x-dag-scan-ltgs ()
(let ((child-files (append (list (org-x-get-lifetime-goal-file)
(org-x-get-endpoint-goal-file))
(org-x-get-action-files))))
(defun org-x-dag--classify-goal-link (which id)
(let ((f (org-x-dag-id->file id)))
(cond
;; TODO consider combining these into one lookup (the only different
;; between an incubated task and non-incubated is the present of a tag
((member f `(,@(org-x-dag->incubator-files) ,@(org-x-dag->action-files)))
:action)
((equal f (org-x-dag->goal-file which))
:local)
((equal f (org-x-dag->planning-file :quarterly))
:plan)
(t
:other))))
(defun org-x-dag--add-goal-status (item which local-children action-children
invalid-children &optional
goal-parents invalid-parents)
(org-add-props item nil
'x-goal-status (list :type which
:local-children local-children
:action-children action-children
:invalid-children invalid-children
:goal-parents goal-parents
:invalid-parents invalid-parents)))
(defun org-x-dag-scan-toplevel-goals (which)
(let ((child-files `(,(org-x-dag->goal-file which)
,@(org-x-dag->action-files)
,@(org-x-dag->incubator-files))))
(cl-flet
((format-id
(category id)
(let ((toplevelp (org-x-dag-id->is-toplevel-p id))
(has-children (->> (org-x-dag-id->children id)
(--any-p (member (org-x-dag-id->file it)
child-files))))
(tags (org-x-dag-id->tags nil id)))
(-let* (((buffer linked) (org-x-dag-id->split-children id))
((&alist :action :local :plan :other)
(--group-by (org-x-dag--classify-goal-link which it) linked))
(tags (org-x-dag-id->tags nil id)))
(-> (org-x-dag-format-tag-node category tags id)
(org-add-props nil
'x-goal-status (list :type 'ltg
:childlessp (not has-children)
:toplevelp toplevelp
:parentlessp nil))))))
(org-x-dag-with-files (list (org-x-get-lifetime-goal-file))
(org-x-dag--add-goal-status which
(append buffer local)
action
other)))))
(org-x-dag-with-files (list (org-x-dag->goal-file which))
nil
(org-x-dag-with-id it
(list (format-id it-category it)))))))
(defun org-x-dag-scan-epgs ()
(let ((child-files (cons (org-x-get-endpoint-goal-file)
(org-x-get-action-files)))
(parent-files (list (org-x-get-endpoint-goal-file)
(org-x-get-lifetime-goal-file))))
(let ((parent-files `(,(org-x-dag->goal-file :lifetime)
,(org-x-dag->goal-file :survival))))
(cl-flet
((format-id
(category id)
(let ((toplevelp (org-x-dag-id->is-toplevel-p id))
(has-children (->> (org-x-dag-id->children id)
(--any-p (member (org-x-dag-id->file it)
child-files))))
(has-parents (->> (org-x-dag-id->parents id)
(--any-p (member (org-x-dag-id->file it)
parent-files))))
(tags (org-x-dag-id->tags nil id)))
(-let* (((buffer-children linked-children)
(org-x-dag-id->split-children id))
(linked-parents (org-x-dag-id->linked-parents id))
((&alist :action :local :plan :other)
(--group-by (org-x-dag--classify-goal-link :endpoint it) linked-children))
((goal-parents other-parents)
(--separate (member (org-x-dag-id->file it) parent-files)
linked-parents))
(tags (org-x-dag-id->tags nil id)))
(-> (org-x-dag-format-tag-node category tags id)
(org-add-props nil
'x-goal-status (list :type 'epg
:childlessp (not has-children)
:toplevelp toplevelp
:parentlessp (not has-parents)))))))
(org-x-dag-with-files (list (org-x-get-endpoint-goal-file))
(org-x-dag--add-goal-status :endpoint
(append buffer-children local)
action
other
goal-parents
other-parents)))))
(org-x-dag-with-files (list (org-x-dag->goal-file :endpoint))
nil
(org-x-dag-with-id it
(list (format-id it-category it)))))))
(defun org-x-dag-scan-goals ()
(append (org-x-dag-scan-ltgs) (org-x-dag-scan-epgs)))
(append (org-x-dag-scan-toplevel-goals :lifetime)
(org-x-dag-scan-toplevel-goals :survival)
(org-x-dag-scan-epgs)))
(defun org-x-dag-scan-errors ()
(cl-flet
@ -2641,5 +2666,39 @@ FUTURE-LIMIT in a list."
(substring-no-properties))
"0. Unlinked")))))))))
(defun org-x-dag-agenda-goals ()
(interactive)
(let ((match ''org-x-dag-scan-goals))
(nd/org-agenda-call "Goals-0" nil #'org-x-dag-show-nodes match nil
`((org-agenda-sorting-strategy '(user-defined-up category-keep))
(org-super-agenda-groups
'((:auto-map
(lambda (line)
(-let* (((&plist :type y
:local-children lc
:action-children ac
:invalid-children ic
:goal-parents gp
:invalid-parents ip)
(get-text-property 1 'x-goal-status line))
(type (cl-case y
(:endpoint "0. Endpoint")
(:lifetime "1. Lifetime")
(:survival "2. Survival")))
(subtext (cl-case y
(:endpoint
(cond
(ip "Invalid parent links")
((not gp) "Missing toplevel goal")
(ic "Invalid child links")
((and (not lc) (not ac) "Missing action"))
((and lc (not ac)) "Branch")))
((:lifetime :survival)
(cond
(ic "Invalid child links")
((and (not lc) (not ac) "Missing goal/action"))
((and lc (not ac)) "Branch"))))))
(if subtext (format "%s (%s)" type subtext) type))))))))))
(provide 'org-x-dag)
;;; org-x-dag.el ends here