ENH sort goals based on which are not properly linke

This commit is contained in:
Nathan Dwarshuis 2021-12-25 22:07:54 -05:00
parent f5046e1f1e
commit e59a5f8afd
2 changed files with 75 additions and 34 deletions

View File

@ -3242,25 +3242,58 @@ In the order of display
(:name "Calendar" :order 1 :time-grid t)
(:discard (:anything t)))))))
(defvar nd/org-agenda-goal-task-ids nil)
(defun nd/org-agenda-goals ()
"Show the goals agenda view."
(interactive)
;; TODO this will only fire when the agenda view is first made, redo doesn't
;; call it again
(setq nd/org-agenda-goal-task-ids (org-x-get-goal-ids))
(cl-flet*
((mk-pred
(prop id-list)
(nd/org-mk-super-agenda-pred
`((not (member (org-entry-get nil ,prop) ,id-list)))))
(mk-parent-pred
(id-list)
(mk-pred "ID" id-list))
(mk-child-pred
(id-list)
(mk-pred org-x-prop-goal id-list))
(mk-header
(category subtitle plist)
(let* ((c (s-capitalize category))
(n (if subtitle (format "%s (%s)" c subtitle) c)))
`(:name ,n ,@plist)))
(mk-memberless
(cat subname fun id-list)
(mk-header cat subname `(:and (:category ,cat :pred ,(funcall fun id-list)))))
(mk-childless
(cat id-list)
(mk-memberless cat "Childless" #'mk-parent-pred id-list))
(mk-parentless
(cat id-list)
(mk-memberless cat "Parentless" #'mk-child-pred id-list))
(mk-branch
(cat)
(mk-header cat "Branch" `(:and (:category ,cat :children todo))))
(mk-leaf
(cat)
(mk-header cat nil `(:category ,cat))))
(let* ((lt-ids '(append org-x-agenda-goal-task-ids
org-x-agenda-goal-endpoint-ids))
(gs
`((:order 6 ,@(mk-branch "lifetime"))
(:order 7 ,@(mk-branch "endpoint"))
(:order 1 ,@(mk-childless "lifetime" lt-ids))
(:order 2 ,@(mk-childless "endpoint" 'org-x-agenda-goal-task-ids))
(:order 3 ,@(mk-parentless "endpoint" 'org-x-agenda-lifetime-ids))
(:order 4 ,@(mk-leaf "lifetime"))
(:order 5 ,@(mk-leaf "endpoint")))))
(org-x-update-goal-link-ids)
(nd/org-agenda-call "Goals" 'todo org-x-kw-todo
`((org-agenda-overriding-header "Goals")
(org-agenda-files
'("~/Org/reference/goals"))
(org-agenda-skip-function #'org-x-goal-skip-function)
(org-agenda-sorting-strategy
'(time-up scheduled-down))
(org-super-agenda-groups
`(,(nd/org-def-super-agenda-pred "Childless"
(not (member (org-entry-get nil "ID") nd/org-agenda-goal-task-ids)))
(:auto-category))))))
(org-agenda-files '("~/Org/reference/goals"))
(org-agenda-sorting-strategy '(time-up scheduled-down))
(org-super-agenda-groups ',gs))))))
(defun nd/org-agenda-daily ()
"Show the daily agenda view."

View File

@ -952,14 +952,23 @@ should be this function again)."
;; goals
(defun org-x-buffer-get-goal-links (file)
(defvar org-x-agenda-goal-task-ids nil)
(defvar org-x-agenda-goal-endpoint-ids nil)
(defvar org-x-agenda-lifetime-ids nil)
(defun org-x-link-get-id (s)
(cadr (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$" s)))
(defun org-x-buffer-get-goal-ids (file)
(org-x-with-file file
(let ((acc))
(cl-flet
((get-goal
()
(-when-let (g (org-entry-get nil org-x-prop-goal))
(setq acc (cons g acc)))))
(-if-let (i (org-x-link-get-id g))
(setq acc (cons i acc))
(message "WARNING: invalid id found: %s" g)))))
;; 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))
@ -968,25 +977,24 @@ should be this function again)."
(get-goal))
acc))))
(defun org-x-get-goal-links ()
(-mapcat #'org-x-buffer-get-goal-links (org-files-list)))
(defun org-x-get-ids-in-file (file)
(cl-flet
((full-path
(p)
(f-canonical (f-expand p))))
(let ((f (full-path file)))
(->> (ht-to-alist org-id-locations)
(--filter (equal f (full-path (cdr it))))
(-map #'car)))))
(defun org-x-get-goal-ids ()
(--map (cadr (s-match "^\\[\\[id:\\(.*\\)\\]\\[.*\\]\\]$" it))
(org-x-get-goal-links)))
(defmacro org-x-id-get-ids-with (form)
""
`(--filter (let ((it (cdr it))) ,form) (ht->alist org-id-locations)))
(defun org-x-id-get-goal-ids ()
(let ((goals-file (f-canonical (f-expand "~/Org/reference/goals.org"))))
(->> (org-x-id-get-ids-with (equal (f-canonical (f-expand it)) goals-file))
(-map #'car))))
(defun org-x-get-leaf-goals ()
""
())
(defun org-x-update-goal-link-ids ()
(org-id-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
(org-x-buffer-get-goal-ids "~/Org/reference/goals/endpoint.org")
org-x-agenda-lifetime-ids
(org-x-get-ids-in-file "~/Org/reference/goals/lifetime.org.org")))
;; iterators