ADD getter function for weekly plan
This commit is contained in:
parent
89c076cc5e
commit
2c99fdb930
|
@ -236,14 +236,28 @@ A date like (YEAR MONTH DAY).")
|
||||||
(-let (((y m _) date))
|
(-let (((y m _) date))
|
||||||
(setq org-x-dag-selected-quarter `(,y ,(/ m 3)))))
|
(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)
|
(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)
|
(let ((greg (org-x-dag-date-to-gregorian date)))
|
||||||
(calendar-absolute-from-gregorian)
|
(while (not (= (calendar-day-of-week greg) org-x-dag-week-start-index))
|
||||||
(1-)
|
(setq greg (->> (calendar-absolute-from-gregorian greg)
|
||||||
(calendar-gregorian-from-absolute)
|
(1-)
|
||||||
(org-x-dag-gregorian-to-date))))
|
(calendar-gregorian-from-absolute))))
|
||||||
date)
|
(org-x-dag-gregorian-to-date greg)))
|
||||||
|
|
||||||
(defun org-x-dag-set-planning-week-at-date (date)
|
(defun org-x-dag-set-planning-week-at-date (date)
|
||||||
(setq org-x-dag-selected-week 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-build-goal-headline ids title)
|
||||||
(org-x-qtp-add-goal quarter)))
|
(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
|
;;; BUFFER SCANNING
|
||||||
|
|
||||||
(defun org-x-dag-get-local-property (prop)
|
(defun org-x-dag-get-local-property (prop)
|
||||||
|
|
Loading…
Reference in New Issue