ADD comprehensive goal agenda view
This commit is contained in:
parent
eb1146b79d
commit
7639dce46a
|
@ -387,7 +387,7 @@ Return value is a list like (BUFFER NON-BUFFER)."
|
||||||
(cons buffer-parent (-remove-item buffer-parent parents))
|
(cons buffer-parent (-remove-item buffer-parent parents))
|
||||||
(cons nil 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."
|
"Return non-buffer (foreign) parents of ID."
|
||||||
(cdr (org-x-dag-id->split-parents 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))))
|
(--separate (equal (org-x-dag-id->buffer-parent it) id))))
|
||||||
|
|
||||||
(defun org-x-dag-id->buffer-children (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)))
|
(car (org-x-dag-id->split-children id)))
|
||||||
|
|
||||||
(defun org-x-dag-id->foreign-children (id)
|
(defun org-x-dag-id->linked-children (id)
|
||||||
"Return children of ID that are not in the same buffer."
|
"Return children of ID that are linked."
|
||||||
(cdr (org-x-dag-id->split-children id)))
|
(cadr (org-x-dag-id->split-children id)))
|
||||||
|
|
||||||
(defmacro org-x-dag-id->with-split-parents (id &rest body)
|
(defmacro org-x-dag-id->with-split-parents (id &rest body)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
|
@ -1885,7 +1885,7 @@ FUTURE-LIMIT in a list."
|
||||||
((split-parent-goals
|
((split-parent-goals
|
||||||
(s)
|
(s)
|
||||||
(let ((id (get-text-property 1 'x-id 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)
|
(--map (org-add-props (copy-seq s) nil 'x-goal-id it) goal-ids)
|
||||||
(list (org-add-props s nil 'x-goal-id nil))))))
|
(list (org-add-props s nil 'x-goal-id nil))))))
|
||||||
(->> (org-x-dag-scan-projects)
|
(->> (org-x-dag-scan-projects)
|
||||||
|
@ -1967,7 +1967,7 @@ FUTURE-LIMIT in a list."
|
||||||
(org-add-props nil
|
(org-add-props nil
|
||||||
'x-is-standalone is-standalone
|
'x-is-standalone is-standalone
|
||||||
'x-status s))))
|
'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)
|
(--map (org-add-props item nil 'x-goal-id it) goal-ids)
|
||||||
(list (org-add-props item nil 'x-goal-id nil)))))))))))
|
(list (org-add-props item nil 'x-goal-id nil)))))))))))
|
||||||
(org-x-dag-with-files (org-x-get-action-files)
|
(org-x-dag-with-files (org-x-get-action-files)
|
||||||
|
@ -1980,7 +1980,7 @@ FUTURE-LIMIT in a list."
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((format-key
|
((format-key
|
||||||
(category is-standalone 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))))
|
(--filter (org-x-dag-id->is-goal-p :survival it))))
|
||||||
(let ((tags (org-x-dag-id->tags nil key)))
|
(let ((tags (org-x-dag-id->tags nil key)))
|
||||||
(org-x-dag-with-id key
|
(org-x-dag-with-id key
|
||||||
|
@ -2013,7 +2013,7 @@ FUTURE-LIMIT in a list."
|
||||||
(-let* (((&plist :key :status :tags) result)
|
(-let* (((&plist :key :status :tags) result)
|
||||||
(priority (alist-get status org-x-project-status-priorities)))
|
(priority (alist-get status org-x-project-status-priorities)))
|
||||||
(when (>= priority 0)
|
(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))))
|
(--filter (org-x-dag-id->is-goal-p :survival it))))
|
||||||
(org-x-dag-with-id key
|
(org-x-dag-with-id key
|
||||||
(let ((item (-> (org-x-dag-format-tag-node cat tags 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)))
|
;; (let ((id (get-text-property 1 'x-id s)))
|
||||||
;; ;; ASSUME all foreign parents are actually goals
|
;; ;; ASSUME all foreign parents are actually goals
|
||||||
;; ;; TODO this isn't a great assumption
|
;; ;; 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)
|
;; (--map (org-add-props s nil 'x-goal-id it) goal-ids)
|
||||||
;; (list (org-add-props s nil 'x-goal-id nil))))))
|
;; (list (org-add-props s nil 'x-goal-id nil))))))
|
||||||
;; (->> (org-x-dag-scan-tasks)
|
;; (->> (org-x-dag-scan-tasks)
|
||||||
|
@ -2098,58 +2098,83 @@ FUTURE-LIMIT in a list."
|
||||||
(--map (format-key it-category it)))
|
(--map (format-key it-category it)))
|
||||||
(list (format-key it-category it)))))))
|
(list (format-key it-category it)))))))
|
||||||
|
|
||||||
(defun org-x-dag-scan-ltgs ()
|
(defun org-x-dag--classify-goal-link (which id)
|
||||||
(let ((child-files (append (list (org-x-get-lifetime-goal-file)
|
(let ((f (org-x-dag-id->file id)))
|
||||||
(org-x-get-endpoint-goal-file))
|
(cond
|
||||||
(org-x-get-action-files))))
|
;; 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
|
(cl-flet
|
||||||
((format-id
|
((format-id
|
||||||
(category id)
|
(category id)
|
||||||
(let ((toplevelp (org-x-dag-id->is-toplevel-p id))
|
(-let* (((buffer linked) (org-x-dag-id->split-children id))
|
||||||
(has-children (->> (org-x-dag-id->children id)
|
((&alist :action :local :plan :other)
|
||||||
(--any-p (member (org-x-dag-id->file it)
|
(--group-by (org-x-dag--classify-goal-link which it) linked))
|
||||||
child-files))))
|
|
||||||
(tags (org-x-dag-id->tags nil id)))
|
(tags (org-x-dag-id->tags nil id)))
|
||||||
(-> (org-x-dag-format-tag-node category tags id)
|
(-> (org-x-dag-format-tag-node category tags id)
|
||||||
(org-add-props nil
|
(org-x-dag--add-goal-status which
|
||||||
'x-goal-status (list :type 'ltg
|
(append buffer local)
|
||||||
:childlessp (not has-children)
|
action
|
||||||
:toplevelp toplevelp
|
other)))))
|
||||||
:parentlessp nil))))))
|
(org-x-dag-with-files (list (org-x-dag->goal-file which))
|
||||||
(org-x-dag-with-files (list (org-x-get-lifetime-goal-file))
|
|
||||||
nil
|
nil
|
||||||
(org-x-dag-with-id it
|
(org-x-dag-with-id it
|
||||||
(list (format-id it-category it)))))))
|
(list (format-id it-category it)))))))
|
||||||
|
|
||||||
(defun org-x-dag-scan-epgs ()
|
(defun org-x-dag-scan-epgs ()
|
||||||
(let ((child-files (cons (org-x-get-endpoint-goal-file)
|
(let ((parent-files `(,(org-x-dag->goal-file :lifetime)
|
||||||
(org-x-get-action-files)))
|
,(org-x-dag->goal-file :survival))))
|
||||||
(parent-files (list (org-x-get-endpoint-goal-file)
|
|
||||||
(org-x-get-lifetime-goal-file))))
|
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((format-id
|
((format-id
|
||||||
(category id)
|
(category id)
|
||||||
(let ((toplevelp (org-x-dag-id->is-toplevel-p id))
|
(-let* (((buffer-children linked-children)
|
||||||
(has-children (->> (org-x-dag-id->children id)
|
(org-x-dag-id->split-children id))
|
||||||
(--any-p (member (org-x-dag-id->file it)
|
(linked-parents (org-x-dag-id->linked-parents id))
|
||||||
child-files))))
|
((&alist :action :local :plan :other)
|
||||||
(has-parents (->> (org-x-dag-id->parents id)
|
(--group-by (org-x-dag--classify-goal-link :endpoint it) linked-children))
|
||||||
(--any-p (member (org-x-dag-id->file it)
|
((goal-parents other-parents)
|
||||||
parent-files))))
|
(--separate (member (org-x-dag-id->file it) parent-files)
|
||||||
|
linked-parents))
|
||||||
(tags (org-x-dag-id->tags nil id)))
|
(tags (org-x-dag-id->tags nil id)))
|
||||||
(-> (org-x-dag-format-tag-node category tags id)
|
(-> (org-x-dag-format-tag-node category tags id)
|
||||||
(org-add-props nil
|
(org-x-dag--add-goal-status :endpoint
|
||||||
'x-goal-status (list :type 'epg
|
(append buffer-children local)
|
||||||
:childlessp (not has-children)
|
action
|
||||||
:toplevelp toplevelp
|
other
|
||||||
:parentlessp (not has-parents)))))))
|
goal-parents
|
||||||
(org-x-dag-with-files (list (org-x-get-endpoint-goal-file))
|
other-parents)))))
|
||||||
|
(org-x-dag-with-files (list (org-x-dag->goal-file :endpoint))
|
||||||
nil
|
nil
|
||||||
(org-x-dag-with-id it
|
(org-x-dag-with-id it
|
||||||
(list (format-id it-category it)))))))
|
(list (format-id it-category it)))))))
|
||||||
|
|
||||||
(defun org-x-dag-scan-goals ()
|
(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 ()
|
(defun org-x-dag-scan-errors ()
|
||||||
(cl-flet
|
(cl-flet
|
||||||
|
@ -2641,5 +2666,39 @@ FUTURE-LIMIT in a list."
|
||||||
(substring-no-properties))
|
(substring-no-properties))
|
||||||
"0. Unlinked")))))))))
|
"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)
|
(provide 'org-x-dag)
|
||||||
;;; org-x-dag.el ends here
|
;;; org-x-dag.el ends here
|
||||||
|
|
Loading…
Reference in New Issue