ADD goal group agenda view

This commit is contained in:
Nathan Dwarshuis 2021-12-28 00:37:00 -05:00
parent e6a3ce3a65
commit 885301efad
2 changed files with 50 additions and 6 deletions

View File

@ -3040,6 +3040,29 @@ In the order of display
`((org-agenda-sorting-strategy '(time-up scheduled-down))
(org-super-agenda-groups ',gs))))))
(defun nd/org-agenda-goal-groups ()
(interactive)
(let ((match (nd/org-mk-match-string
- org-x-tag-incubated
/ org-x-kw-todo
| org-x-kw-next
| org-x-kw-wait
| org-x-kw-hold
| org-x-kw-canc))
(files (org-x-get-action-and-incubator-files)))
(nd/org-agenda-call "Goal Groups" 'tags-todo match (org-x-get-action-files)
`((org-agenda-sorting-strategy '(time-up scheduled-down))
(org-agenda-skip-function #'org-x-task-skip-function)
(org-super-agenda-groups
',(nd/org-def-super-agenda-automap
(let ((is-ind (org-x-headline-is-atomic-task-p))
(goal-status (-if-let ((f . h) (org-x-resolve-goal-id))
(format "%s | %s"
(s-capitalize (f-base f))
(org-ml-get-property :raw-value h))
"No Goal")))
(format "%s | %s" (if is-ind "Indep." "Project") goal-status))))))))
(defun nd/org-agenda-daily ()
"Show the daily agenda view."
(interactive)

View File

@ -1056,6 +1056,20 @@ should be this function again)."
(defvar org-x-agenda-goal-endpoint-ids nil)
(defvar org-x-agenda-lifetime-ids nil)
(defun org-x-get-goal-link-id (&optional inherit)
(-when-let (g (org-entry-get nil org-x-prop-goal inherit))
(-if-let (i (org-x-link-get-id g))
i
(message "WARNING: invalid id found: %s" i))))
(defun org-x-resolve-goal-id ()
(-when-let (i (org-x-get-goal-link-id t))
(-when-let ((f . p) (org-id-find i))
(org-x-with-file f
(save-excursion
(goto-char p)
(cons f (org-ml-parse-this-headline)))))))
(defun org-x-link-get-id (s)
(cadr (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$" s)))
@ -1065,10 +1079,8 @@ should be this function again)."
(cl-flet
((get-goal
()
(-when-let (g (org-entry-get nil org-x-prop-goal))
(-if-let (i (org-x-link-get-id g))
(setq acc (cons i acc))
(message "WARNING: invalid id found: %s" g)))))
(-when-let (i (org-x-get-goal-link-id))
(setq acc (cons i acc)))))
;; TODO need to return nothing if a file has a toplevel prop drawer with
;; a goal in it but no TODO headlines
(goto-char (point-min))
@ -1087,8 +1099,18 @@ should be this function again)."
(--filter (equal f (full-path (cdr it))))
(-map #'car)))))
;; TODO this is necessary since this (rather unintuitively) scans the agenda
;; files, so I need to supply my own files since these are not set
(defun org-x-update-id-locations ()
(interactive)
(let ((files (append (org-x-get-action-and-incubator-files)
(org-x-get-reference-files)
(list (org-x-get-endpoint-goal-file)
(org-x-get-lifetime-goal-file)))))
(call-interactively #'org-id-update-id-locations files)))
(defun org-x-update-goal-link-ids ()
(org-id-update-id-locations)
(org-x-update-id-locations)
(setq org-x-agenda-goal-task-ids
(-mapcat #'org-x-buffer-get-goal-ids (org-files-list))
org-x-agenda-goal-endpoint-ids
@ -1118,7 +1140,6 @@ Assumes point is on a valid headline or org mode file."
;; TODO also add a sanity check for if we are in a goals file or not
(ignore-errors
(org-back-to-heading t))
(print 'hi)
(cl-flet*
((mk-entry
(path base hl)