From 2c99fdb93017afc1d738746db46e42296b757d36 Mon Sep 17 00:00:00 2001
From: ndwarshuis <ndwar@yavin4.ch>
Date: Sat, 12 Feb 2022 19:44:04 -0500
Subject: [PATCH] ADD getter function for weekly plan

---
 local/lib/org-x/org-x-dag.el | 75 ++++++++++++++++++++++++++++++++----
 1 file changed, 68 insertions(+), 7 deletions(-)

diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el
index bb81597..0f8123e 100644
--- a/local/lib/org-x/org-x-dag.el
+++ b/local/lib/org-x/org-x-dag.el
@@ -236,14 +236,28 @@ A date like (YEAR MONTH DAY).")
   (-let (((y m _) date))
     (setq org-x-dag-selected-quarter `(,y ,(/ m 3)))))
 
+(defun org-x-dag-date-to-week-number (date)
+  (-let* (((y m d) date)
+          (greg (org-x-dag-date-to-gregorian date))
+          (abs (calendar-absolute-from-gregorian greg))
+          (daynum (calendar-day-of-week greg))
+          ;; Catch the special case where the first few days of January might
+          ;; belong to the previous year
+          (start-year (if (and (= 1 m) (< d (1+ daynum))) (1- y)))
+          (start-greg `(1 1 ,start-year))
+          (start-daynum (calendar-day-of-week start-greg))
+          (start-abs (calendar-absolute-from-gregorian start-greg))
+          (start-diff (if (= 0 start-daynum) 0 (- 7 start-daynum))))
+    (1+ (/ (- abs start-abs start-diff) 7))))
+
 (defun org-x-dag-date-to-week-start (date)
-  (while (not (= (calendar-day-of-week date) org-x-dag-week-start-index))
-    (setq date (->> (org-x-dag-date-to-gregorian date)
-                    (calendar-absolute-from-gregorian)
-                    (1-)
-                    (calendar-gregorian-from-absolute)
-                    (org-x-dag-gregorian-to-date))))
-  date)
+  ""
+  (let ((greg (org-x-dag-date-to-gregorian date)))
+    (while (not (= (calendar-day-of-week greg) org-x-dag-week-start-index))
+      (setq greg (->> (calendar-absolute-from-gregorian greg)
+                      (1-)
+                      (calendar-gregorian-from-absolute))))
+    (org-x-dag-gregorian-to-date greg)))
 
 (defun org-x-dag-set-planning-week-at-date (date)
   (setq org-x-dag-selected-week date))
@@ -383,6 +397,53 @@ A date like (YEAR MONTH DAY).")
   (->> (org-x-qtp-build-goal-headline ids title)
        (org-x-qtp-add-goal quarter)))
 
+(defun org-x-dag-headline-find-year (year headlines)
+  (let ((tag (format "Y%d" (mod year 2000))))
+    (--find (org-ml-headline-has-tag tag it) headlines)))
+
+(defun org-x-dag-headline-find-week (weeknum headlines)
+  (let ((tag (format "W%02d" weeknum)))
+    (--find (org-ml-headline-has-tag tag it) headlines)))
+
+(defun org-x-dag-headline-find-day (daynum headlines)
+  (let ((tag (pcase daynum
+               (0 "SUN")
+               (1 "MON")
+               (2 "TUE")
+               (3 "WED")
+               (4 "THU")
+               (5 "FRI")
+               (6 "SAT"))))
+    (--find (org-ml-headline-has-tag tag it) headlines)))
+
+(defconst org-x-dag-weekly-tags
+  '((0 . "SUN")
+    (1 . "MON")
+    (2 . "TUE")
+    (3 . "WED")
+    (4 . "THU")
+    (5 . "FRI")
+    (6 . "SAT")))
+
+(defun org-x-dag-weekly-headlines-to-alist (headlines)
+  (->> headlines
+       (--map (-when-let (weeknum (-> (org-ml-get-property :tags it)
+                                      (car)
+                                      (rassoc org-x-dag-weekly-tags)
+                                      (car)))
+                (cons weeknum (org-ml-headline-get-subheadlines it))))
+       (-non-nil)))
+
+(defun org-x-dag-wkp-get (week)
+  (org-x-with-file (org-x-get-weekly-plan-file)
+    (-let (((year weeknum) week))
+      (->> (org-ml-parse-subtrees 'all)
+           (org-x-dag-headline-find-year year)
+           (org-ml-headline-get-subheadlines)
+           (org-x-dag-headline-find-week weeknum)
+           (org-ml-headline-get-subheadlines)
+           (org-x-dag-weekly-headlines-to-alist)))))
+
 ;;; BUFFER SCANNING
 
 (defun org-x-dag-get-local-property (prop)