ADD functions to jump to current plans
This commit is contained in:
parent
1e54f4f78e
commit
c0ed24a48b
|
@ -173,6 +173,10 @@
|
|||
(- daynum)
|
||||
(org-x-dag-absolute-to-date))))
|
||||
|
||||
(defun org-x-dag-date-to-day-number (date)
|
||||
(->> (org-x-dag-date-to-gregorian date)
|
||||
(calendar-day-number)))
|
||||
|
||||
;; date <-> quarter
|
||||
|
||||
(defun org-x-dag-quarter-to-date (quarter)
|
||||
|
@ -1560,6 +1564,9 @@ If FORCE is non-nil, sync no matter what."
|
|||
(defun org-x-dag->current-date ()
|
||||
(plist-get org-x-dag :current-date))
|
||||
|
||||
(defun org-x-dag->selected-date ()
|
||||
(plist-get org-x-dag :selected-date))
|
||||
|
||||
(defun org-x-dag->file-state ()
|
||||
(plist-get org-x-dag :files))
|
||||
|
||||
|
@ -3064,7 +3071,7 @@ review phase)"
|
|||
(tag (alist-get daynum org-x-dag-weekly-tags)))
|
||||
(org-x-dag-build-planning-headline title tag 3 nil subheadlines)))
|
||||
|
||||
;; id headline builders
|
||||
;; planning headline builders
|
||||
|
||||
(defun org-x-dag-build-planning-id-headline (title level paragraph ids)
|
||||
(let ((sec (-some-> paragraph
|
||||
|
@ -3124,6 +3131,14 @@ review phase)"
|
|||
subtrees)))
|
||||
(list :categories cats :goals goals)))
|
||||
|
||||
(defun org-x-dag-qtp-get-headline (date)
|
||||
(org-x-with-file (org-x-dag->planning-file :quarterly)
|
||||
(-let (((y q) (org-x-dag-date-to-quarter date)))
|
||||
(->> (org-ml-parse-subtrees 'all)
|
||||
(org-x-dag-headlines-find-year y)
|
||||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-headlines-find-quarter q)))))
|
||||
|
||||
(defun org-x-dag-qtp-get (quarter)
|
||||
(org-x-with-file (org-x-qtp-get-file)
|
||||
(-let (((year qnum) quarter))
|
||||
|
@ -3220,15 +3235,26 @@ review phase)"
|
|||
(org-x-dag-build-day-of-week-headline daynum hls))
|
||||
plan))
|
||||
|
||||
(defun org-x-dag-wkp-get (week)
|
||||
(defun org-x-dag-wkp-get-week-headline (date)
|
||||
(org-x-with-file (org-x-get-weekly-plan-file)
|
||||
(-let (((year weeknum) week))
|
||||
(-let (((y _ _) date)
|
||||
(w (org-x-dag-date-to-week-number date)))
|
||||
(->> (org-ml-parse-subtrees 'all)
|
||||
(org-x-dag-headlines-find-year year)
|
||||
(org-x-dag-headlines-find-year y)
|
||||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-headlines-find-week weeknum)
|
||||
(org-x-dag-headlines-find-week w)))))
|
||||
|
||||
(defun org-x-dag-wkp-get-day-headline (date)
|
||||
(-let ((n (org-x-dag-date-to-day-number)))
|
||||
(->> (org-x-dag-wkp-get-week-headline date)
|
||||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-weekly-headlines-to-alist)))))
|
||||
(org-x-dag-headlines-find-day-of-week n))))
|
||||
|
||||
;; TODO these functions need to take dates and not 'week's (whatever those are)
|
||||
(defun org-x-dag-wkp-get (week)
|
||||
(->> (org-x-dag-wkp-get-day-headline date)
|
||||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-weekly-headlines-to-alist)))
|
||||
|
||||
(defun org-x-dag-wkp-set (week plan)
|
||||
(cl-flet*
|
||||
|
@ -3282,7 +3308,7 @@ review phase)"
|
|||
(org-x-dag-wkp-day-add week daynum)))
|
||||
|
||||
;; TODO not DRY
|
||||
(defun org-x-dag-dlp-get (date)
|
||||
(defun org-x-dag-dlp-get-headline (date)
|
||||
(org-x-with-file (org-x-dag->planning-file :daily)
|
||||
(-let (((y m d) date))
|
||||
(->> (org-ml-parse-subtrees 'all)
|
||||
|
@ -3290,8 +3316,11 @@ review phase)"
|
|||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-headlines-find-month m)
|
||||
(org-ml-headline-get-subheadlines)
|
||||
(org-x-dag-headlines-find-day d)
|
||||
(org-ml-headline-get-subheadlines)))))
|
||||
(org-x-dag-headlines-find-day d)))))
|
||||
|
||||
(defun org-x-dag-dlp-get (date)
|
||||
(->> (org-x-dag-dlp-get-headline date)
|
||||
(org-ml-headline-get-subheadlines)))
|
||||
|
||||
(defun org-x-dag-dlp-set (date headlines)
|
||||
(cl-flet*
|
||||
|
@ -3342,6 +3371,8 @@ review phase)"
|
|||
|
||||
;;; INTERACTIVE FUNCTIONS
|
||||
|
||||
;; current date
|
||||
|
||||
(defun org-x-dag-set-date ()
|
||||
(interactive)
|
||||
(let ((date (->> (org-read-date nil t)
|
||||
|
@ -3357,6 +3388,41 @@ review phase)"
|
|||
(->> (plist-get org-x-dag :selected-date)
|
||||
(apply #'message "Org-DAG date is %d-%02d-%02d")))
|
||||
|
||||
;; planning navigation
|
||||
|
||||
(defun org-x-dag--goto-current (what file-key hl-fun)
|
||||
(declare (indent 2))
|
||||
(-if-let (p (->> (org-x-dag->current-date)
|
||||
(funcall hl-fun)
|
||||
(org-ml-get-property :begin)))
|
||||
(progn
|
||||
(find-file (org-x-dag->planning-file file-key))
|
||||
(goto-char p)
|
||||
(org-reveal))
|
||||
(message "%s does not exist for current date" what)))
|
||||
|
||||
(defun org-x-dag-goto-current-quarterly-plan ()
|
||||
(interactive)
|
||||
(org-x-dag--goto-current "Quarterly plan" :quarterly
|
||||
#'org-x-dag-qtp-get-headline))
|
||||
|
||||
(defun org-x-dag-goto-current-weekly-plan ()
|
||||
(interactive)
|
||||
(org-x-dag--goto-current "Weekly plan (week)" :weekly
|
||||
#'org-x-dag-wkp-get-week-headline))
|
||||
|
||||
(defun org-x-dag-goto-current-weekly-plan-day ()
|
||||
(interactive)
|
||||
(org-x-dag--goto-current "Weekly plan (day)" :weekly
|
||||
#'org-x-dag-wkp-get-day-headline))
|
||||
|
||||
(defun org-x-dag-goto-current-daily-plan ()
|
||||
(interactive)
|
||||
(org-x-dag--goto-current "Daily plan" :daily
|
||||
#'org-x-dag-dlp-get-headline))
|
||||
|
||||
;; node navigation
|
||||
|
||||
(defun org-x-dag-group-code (group)
|
||||
(pcase group
|
||||
(:lifetime "LTG")
|
||||
|
|
Loading…
Reference in New Issue