ENH update task-goal view

This commit is contained in:
Nathan Dwarshuis 2022-02-27 12:35:19 -05:00
parent 7639dce46a
commit a9ca1e57c3
1 changed files with 31 additions and 13 deletions

View File

@ -1880,14 +1880,18 @@ FUTURE-LIMIT in a list."
(not (org-x-dag-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
(format-key it-category it)))) (format-key it-category it))))
(defun org-x-dag--item-add-goal-ids (item ids)
(if ids
(--map (org-add-props (copy-seq item) nil 'x-goal-id it) ids)
(list (org-add-props item nil 'x-goal-id nil))))
(defun org-x-dag-scan-projects-with-goals () (defun org-x-dag-scan-projects-with-goals ()
(cl-flet (cl-flet
((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->linked-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) (org-x-dag--item-add-goal-ids s goal-ids)))))
(list (org-add-props s nil 'x-goal-id nil))))))
(->> (org-x-dag-scan-projects) (->> (org-x-dag-scan-projects)
(--filter (org-x-dag-id->is-toplevel-p (get-text-property 1 'x-id it))) (--filter (org-x-dag-id->is-toplevel-p (get-text-property 1 'x-id it)))
(-mapcat #'split-parent-goals)))) (-mapcat #'split-parent-goals))))
@ -1952,8 +1956,18 @@ FUTURE-LIMIT in a list."
;; TODO wetter than Prince's dreams ;; TODO wetter than Prince's dreams
(defun org-x-dag-scan-tasks-with-goals () (defun org-x-dag-scan-tasks-with-goals ()
(cl-flet (cl-flet*
((format-key ((classify-parent
(id)
(cond
((or (org-x-dag-id->is-goal-p :lifetime id)
(org-x-dag-id->is-goal-p :endpoint id))
:non-survival)
((org-x-dag-id->is-goal-p :survival id)
:survival)
(t
:ignore)))
(format-key
(category is-standalone key) (category is-standalone key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; filter out incubators ;; filter out incubators
@ -1962,17 +1976,21 @@ FUTURE-LIMIT in a list."
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key)))
(p (alist-get s org-x-headline-task-status-priorities))) (p (alist-get s org-x-headline-task-status-priorities)))
(unless (= p -1) (unless (= p -1)
(let ((item (-let (((&alist :non-survival :survival)
(-> (org-x-dag-format-tag-node category tags key) (->> (org-x-dag-id->linked-parents key)
(org-add-props nil (-group-by #'classify-parent))))
'x-is-standalone is-standalone (unless (and survival (not non-survival))
'x-status s)))) (-> (org-x-dag-format-tag-node category tags key)
(-if-let (goal-ids (org-x-dag-id->linked-parents key)) (org-add-props nil
(--map (org-add-props item nil 'x-goal-id it) goal-ids) 'x-is-standalone is-standalone
(list (org-add-props item nil 'x-goal-id nil))))))))))) 'x-status s)
(org-x-dag--item-add-goal-ids non-survival)))))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
(-if-let (project-tasks (org-x-dag-get-task-nodes it)) (-if-let (project-tasks (org-x-dag-get-task-nodes
(lambda (it) (not (member (org-x-dag-id->todo it)
(list org-x-kw-canc org-x-kw-hold))))
it))
(--mapcat (format-key it-category nil it) project-tasks) (--mapcat (format-key it-category nil it) project-tasks)
(format-key it-category t it))))) (format-key it-category t it)))))