ADD goals agenda view

local/lib/org-x/org-x-dag.el

@@ -2401,6 +2401,35 @@ FUTURE-LIMIT in a list."
                     'x-committedp (and c t))
                 (list))))))))
 
+(defun org-x-dag-itemize-tl-goals (files)
+  (let ((plan-ids (org-x-dag->current-qtp-ids)))
+    (cl-flet
+        ((mk-item
+          (id type plannedp fulfilledp committedp)
+          (let ((tags (org-x-dag-id->tags nil id))
+                (leafp (org-x-dag-id->is-buffer-leaf-p id)))
+            (-> (org-x-dag-format-tag-node tags id)
+                (org-add-props nil
+                    'x-type type
+                    'x-leafp leafp
+                    'x-plannedp (-intersection plannedp plan-ids)
+                    'x-fulfilledp fulfilledp
+                    'x-committedp committedp)
+                (list)))))
+      (org-x-dag-with-ids files
+        (pcase (either-from-right (org-x-dag-id->bs it) nil)
+          (`(:lifetime :active)
+           (-when-let (ns (org-x-dag-id->ns it))
+             (-let (((&plist :planned p :fulfilled f)
+                     (either-from-right ns nil)))
+               (mk-item it :lifetime p f nil))))
+          ;; TODO not sure how I want to handle deadlines yet here
+          (`(:endpoint :active ,_)
+           (-when-let (ns (org-x-dag-id->ns it))
+             (-let (((&plist :planned p :fulfilled f :committed c)
+                     (either-from-right ns nil)))
+               (mk-item it :endpoint p f c)))))))))
+
 (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)
@@ -3595,8 +3624,27 @@ The title will have the form 'LEVEL1.LEVEL2 STATUS (SUBTITLE)'."
                    (s-titleize))))
     (format "%s.%s %s (%s)" level1 level2 status* subtitle)))
 
+(defmacro org-x-dag-with-advice (adlist &rest body)
+  "Execute BODY with temporary advice in ADLIST.
+
+Each element of ADLIST should be a list of the form
+  (SYMBOL WHERE FUNCTION [PROPS])
+suitable for passing to `advice-add'.  The BODY is wrapped in an
+`unwind-protect' form, so the advice will be removed even in the
+event of an error or nonlocal exit."
+  (declare (debug ((&rest (&rest form)) body))
+           (indent 1))
+  `(progn
+     ,@(mapcar (lambda (adform)
+                 (cons 'advice-add adform))
+               adlist)
+     (unwind-protect (progn ,@body)
+       ,@(mapcar (lambda (adform)
+                   `(advice-remove ,(car adform) ,(nth 2 adform)))
+                 adlist))))
+
 (defun org-x-dag-run-series-advice (fun name settings)
-  (nd/with-advice
+  (org-x-dag-with-advice
       ((#'org-agenda-list :override #'org-x-dag-show-daily-nodes))
     ;; TODO why the if?
     (-if-let (org-agenda-files (->> (nth 1 settings)
@@ -3613,6 +3661,12 @@ The title will have the form 'LEVEL1.LEVEL2 STATUS (SUBTITLE)'."
 
 ;; agenda views
 
+;; TODO these functions can't bootstrap themselves in the sense that files won't
+;; be known until sync (which happens after `org-agenda-prepare'. The best
+;; (maybe?) way around this is to advice `org-agenda-files' (the function) to
+;; understand `org-agenda-files' (the variable) as pointing to a function which
+;; references files in the dag after the dag is initialized
+
 (defun org-x-dag-agenda-timeblock ()
   "Show the timeblock agenda view.
 
@@ -3641,25 +3695,36 @@ In the order of display
            (:name "Deadlined" :order 3 :deadline t)
            (:name "Scheduled" :order 4 :scheduled t)))))))
 
-;; (defun org-x-dag-agenda-goals ()
+(defun org-x-dag-agenda-goals ()
-;;   (interactive)
+  (interactive)
-;;   (let ((files (->> (list :lifetime :endpoint :survival)
+  (let ((files (->> (list :lifetime :endpoint :survival)
-;;                     (-map #'org-x-dag->goal-file))))
+                    (-map #'org-x-dag->goal-file))))
-;;     (org-x-dag-agenda-show-nodes "Goals" #'org-x-dag-scan-goals files
+    (org-x-dag-agenda-show-nodes "Goals" #'org-x-dag-itemize-tl-goals files
-;;       `((org-agenda-sorting-strategy '(user-defined-up category-keep))
+      `((org-agenda-sorting-strategy '(user-defined-up category-keep))
-;;         (org-super-agenda-groups
+        (org-super-agenda-groups
-;;          '((:auto-map
+         '((:auto-map
-;;             (lambda (line)
+            (lambda (line)
-;;               (-let* (((&plist :type :childlessp :toplevelp :parentlessp)
+              (-let* ((c (get-text-property 1 'x-committedp line))
-;;                        (get-text-property 1 'x-goal-status line))
+                      (f (get-text-property 1 'x-fulfilledp line))
-;;                       (type* (cl-case type
+                      (p (get-text-property 1 'x-plannedp line))
-;;                                (ltg "Lifetime")
+                      (l (get-text-property 1 'x-leafp line))
-;;                                (epg "Endpoint")))
+                      (type (get-text-property 1 'x-type line))
-;;                       (subtext (cond
+                      ((krank key) (pcase type
-;;                                 ((and (eq type 'epg) parentlessp) "Parentless")
+                                     (:lifetime '(0 "Lifetime"))
-;;                                 (childlessp "Childless")
+                                     (:endpoint '(1 "Endpoint"))))
-;;                                 ((not toplevelp) "Branch"))))
+                      ((srank subtext)
-;;                 (if subtext (format "%s (%s)" type* subtext) type*))))))))))
+                       (cond
+                        ((and (eq type :endpoint) (not c) p f)
+                         '(0 "Uncommitted"))
+                        ((and p f)
+                         '(4 "Fulfilled | Planned"))
+                        ((and (not p) f)
+                         '(3 "Fulfilled | Unplanned"))
+                        ((and p (not f))
+                         '(2 "Unfulfilled | Planned"))
+                        (t
+                         '(1 "Unfulfilled | Unplanned")))))
+                (format "%d.%d %s (%s)" krank srank key subtext))))))))))
 
 (defun org-x-dag-agenda-tasks ()
   "Show the tasks agenda view.