ENH make weekly plan start on proper day of week

This commit is contained in:
Nathan Dwarshuis 2022-06-01 18:55:22 -04:00
parent 6aaa513856
commit c1998b6ede
1 changed files with 18 additions and 11 deletions

View File

@ -178,9 +178,17 @@
;; date <-> week ;; date <-> week
;; (defun org-x-dag-date-to-day-of-week (date) (defvar org-x-dag-weekday-start 1
;; (->> (org-x-dag-date-to-gregorian date) "Index of day to be considered start of week.
;; (calendar-day-of-week))) Must be an integer from 0 - 6, with 0 = Sunday.")
(defun org-x-dag-abs-to-day-of-week (abs)
(-> (- abs org-x-dag-weekday-start)
(mod 7)))
(defun org-x-dag-date-to-day-of-week (date)
(-> (org-x-dag-date-to-absolute date)
(org-x-dag-abs-to-day-of-week)))
(defun org-x-dag-date-to-week-number (date) (defun org-x-dag-date-to-week-number (date)
(-let* (((y m d) date) (-let* (((y m d) date)
@ -205,10 +213,6 @@
(+ start-abs start-diff) (+ start-abs start-diff)
(org-x-dag-absolute-to-date)))) (org-x-dag-absolute-to-date))))
(defvar org-x-dag-weekday-start 1
"Index of day to be considered start of week.
Must be an integer from 0 - 6, with 0 = Sunday.")
(defun org-x-dag-date-to-week-start (date) (defun org-x-dag-date-to-week-start (date)
"" ""
(let* ((abs (-> (org-x-dag-date-to-absolute date) (let* ((abs (-> (org-x-dag-date-to-absolute date)
@ -283,6 +287,11 @@ relative shift in days from ABS."
(5 . "Friday") (5 . "Friday")
(6 . "Saturday"))) (6 . "Saturday")))
(defun org-x-dag-day-of-week-to-tag (n)
(-> (+ n org-x-dag-weekday-start)
(mod 7)
(alist-get org-x-dag-weekly-tags)))
(defun org-x-dag--parse-date-tag (prefix tag) (defun org-x-dag--parse-date-tag (prefix tag)
(let ((re (format "%s\\([0-9]+\\)" prefix))) (let ((re (format "%s\\([0-9]+\\)" prefix)))
(-some->> (s-match re tag) (-some->> (s-match re tag)
@ -3156,8 +3165,7 @@ FUTURE-LIMIT in a list."
(org-x-dag-with-ids files (org-x-dag-with-ids files
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:weekly :leaf :active ,abs) (`(:weekly :leaf :active ,abs)
(let ((day (->> (calendar-gregorian-from-absolute abs) (let ((day (org-x-dag-abs-to-day-of-week abs)))
(calendar-day-of-week))))
(when (interval-contains-p abs span) (when (interval-contains-p abs span)
(let ((ns (-some-> (org-x-dag-id->ns it) (let ((ns (-some-> (org-x-dag-id->ns it)
(either-from (-const nil) #'identity))) (either-from (-const nil) #'identity)))
@ -4992,8 +5000,7 @@ In the order of display
(lambda (line) (lambda (line)
(-let* ((ns (get-text-property 1 'x-network-status line)) (-let* ((ns (get-text-property 1 'x-network-status line))
(day (get-text-property 1 'x-day line)) (day (get-text-property 1 'x-day line))
;; TODO not sure if this will work anymore (day-name (org-x-dag-day-of-week-to-tag day))
(day-name (alist-get day org-x-dag-weekly-tags))
((rank text) ((rank text)
(if (not ns) '(0 "No Network Status") (if (not ns) '(0 "No Network Status")
(-let (((&plist :planned p :committed c) ns)) (-let (((&plist :planned p :committed c) ns))