ADD a bunch of functions to make new/blank plans
This commit is contained in:
parent
6fc7535ba3
commit
9fa38bee29
|
|
@ -3096,7 +3096,50 @@ review phase)"
|
||||||
(->> (org-x-dag-build-planning-id-headline title 4 paragraph ids)
|
(->> (org-x-dag-build-planning-id-headline title 4 paragraph ids)
|
||||||
(org-ml-headline-set-planning pl))))
|
(org-ml-headline-set-planning pl))))
|
||||||
|
|
||||||
;; buffer manipulation
|
;; crazy nested build-or-add-headline thing
|
||||||
|
|
||||||
|
(defun org-x-dag-headline-get-nested (path find-funs)
|
||||||
|
(declare (indent 1))
|
||||||
|
(cl-labels
|
||||||
|
((get-subheadlines
|
||||||
|
(find-funs hls)
|
||||||
|
(-let* (((next . rest) find-funs))
|
||||||
|
(-when-let (found (funcall next hls))
|
||||||
|
(if (not rest) found
|
||||||
|
(->> (org-ml-headline-get-subheadlines found)
|
||||||
|
(get-subheadlines rest)))))))
|
||||||
|
(org-x-with-file path
|
||||||
|
(->> (org-ml-parse-subtrees 'all)
|
||||||
|
(get-subheadlines find-funs)))))
|
||||||
|
|
||||||
|
(defun org-x-dag-headline-set-nested (path to-set hierachy-funs)
|
||||||
|
(declare (indent 2))
|
||||||
|
(cl-labels
|
||||||
|
((update-subheadlines
|
||||||
|
(funs hls)
|
||||||
|
(-let ((((find-fun build-fun) . rest) funs))
|
||||||
|
(-if-let (hl (funcall find-fun hls))
|
||||||
|
(if rest (->> (org-ml-headline-get-subheadlines hl)
|
||||||
|
(update-subheadlines rest))
|
||||||
|
(org-ml-update* (org-ml-set-children to-set it) hl)
|
||||||
|
(org-ml-get-property :begin hl))
|
||||||
|
(let ((end (1+ (org-ml-get-property :end (-last-item hls)))))
|
||||||
|
(->> (-map #'cadr funs)
|
||||||
|
(reverse)
|
||||||
|
(--reduce-from (list (funcall it acc)) to-set)
|
||||||
|
(org-ml-insert end))
|
||||||
|
end)))))
|
||||||
|
(org-x-with-file path
|
||||||
|
(->> (org-ml-parse-subtrees 'all)
|
||||||
|
(update-subheadlines hierachy-funs)))))
|
||||||
|
|
||||||
|
;; quarterly plan
|
||||||
|
|
||||||
|
(defun org-x-dag-qtp-empty ()
|
||||||
|
(->> (-map #'cdr org-x-life-categories)
|
||||||
|
(--map (org-ml-build-headline! :level 3
|
||||||
|
:title-text (plist-get it :desc)
|
||||||
|
:tags `(,(plist-get it :tag))))))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-to-children (qt-plan)
|
(defun org-x-dag-qtp-to-children (qt-plan)
|
||||||
(-let* (((&plist :categories :goals) qt-plan)
|
(-let* (((&plist :categories :goals) qt-plan)
|
||||||
|
|
@ -3132,12 +3175,10 @@ review phase)"
|
||||||
(list :categories cats :goals goals)))
|
(list :categories cats :goals goals)))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-get-headline (date)
|
(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)))
|
||||||
(-let (((y q) (org-x-dag-date-to-quarter date)))
|
(org-x-dag-headline-get-nested (org-x-dag->planning-file :quarterly)
|
||||||
(->> (org-ml-parse-subtrees 'all)
|
(list (-partial #'org-x-dag-headlines-find-year y)
|
||||||
(org-x-dag-headlines-find-year y)
|
(-partial #'org-x-dag-headlines-find-quarter q)))))
|
||||||
(org-ml-headline-get-subheadlines)
|
|
||||||
(org-x-dag-headlines-find-quarter q)))))
|
|
||||||
|
|
||||||
(defun org-x-dag-qtp-get (quarter)
|
(defun org-x-dag-qtp-get (quarter)
|
||||||
(org-x-with-file (org-x-qtp-get-file)
|
(org-x-with-file (org-x-qtp-get-file)
|
||||||
|
|
@ -3149,80 +3190,97 @@ review phase)"
|
||||||
(org-ml-get-children)
|
(org-ml-get-children)
|
||||||
(org-x-dag-qtp-from-children)))))
|
(org-x-dag-qtp-from-children)))))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-set (quarter qt-plan)
|
(defun org-x-dag-qtp-set-headlines (date headlines)
|
||||||
(cl-flet
|
(-let* (((y q) (org-x-dag-date-to-quarter date))
|
||||||
((build-yr-headline
|
(path (org-x-dag->planning-file :quarterly))
|
||||||
(year qnum section children)
|
(find-year (-partial #'org-x-dag-headlines-find-year y))
|
||||||
(->> (org-x-dag-build-quarter-headline qnum section children)
|
(find-quarter (-partial #'org-x-dag-headlines-find-quarter q))
|
||||||
(list)
|
(build-year (-partial #'org-x-dag-build-year-headline y))
|
||||||
(org-x-dag-build-year-headline year))))
|
(build-quarter (-partial #'org-x-dag-build-quarter-headline q nil)))
|
||||||
(org-x-with-file (org-x-dag->planning-file :quarterly)
|
(org-x-dag-headline-set-nested path headlines
|
||||||
(-let* (((year qnum) quarter)
|
`((,find-year ,build-year)
|
||||||
(sts (org-ml-parse-subtrees 'all))
|
(,find-quarter ,build-quarter)))))
|
||||||
((section subhls) (org-x-dag-qtp-to-children qt-plan)))
|
|
||||||
(-if-let (st-yr (org-x-dag-headlines-find-year year sts))
|
|
||||||
(-if-let (st-qt (->> (org-ml-headline-get-subheadlines st-yr)
|
|
||||||
(org-x-dag-headlines-find-quarter qnum)))
|
|
||||||
(org-ml-update* (org-ml-set-children subhls it) st-qt)
|
|
||||||
(org-ml-update*
|
|
||||||
(->> (org-x-dag-build-quarter-headline qnum section subhls)
|
|
||||||
(-snoc it))
|
|
||||||
st-yr))
|
|
||||||
(let ((end (1+ (org-ml-get-property :end (-last-item sts)))))
|
|
||||||
(org-ml-insert end (build-yr-headline year qnum section subhls))))))))
|
|
||||||
|
|
||||||
(defmacro org-x-dag-qtp-map (quarter form)
|
;; (defun org-x-dag-qtp-set (quarter qt-plan)
|
||||||
(declare (indent 1))
|
;; (cl-flet
|
||||||
`(let ((it (org-x-dag-qtp-get ,quarter)))
|
;; ((build-yr-headline
|
||||||
(org-x-dag-qtp-set ,quarter ,form)))
|
;; (year qnum section children)
|
||||||
|
;; (->> (org-x-dag-build-quarter-headline qnum section children)
|
||||||
|
;; (list)
|
||||||
|
;; (org-x-dag-build-year-headline year))))
|
||||||
|
;; (org-x-with-file (org-x-dag->planning-file :quarterly)
|
||||||
|
;; (-let* (((year qnum) quarter)
|
||||||
|
;; (sts (org-ml-parse-subtrees 'all))
|
||||||
|
;; ((section subhls) (org-x-dag-qtp-to-children qt-plan)))
|
||||||
|
;; (-if-let (st-yr (org-x-dag-headlines-find-year year sts))
|
||||||
|
;; (-if-let (st-qt (->> (org-ml-headline-get-subheadlines st-yr)
|
||||||
|
;; (org-x-dag-headlines-find-quarter qnum)))
|
||||||
|
;; (org-ml-update* (org-ml-set-children subhls it) st-qt)
|
||||||
|
;; (org-ml-update*
|
||||||
|
;; (->> (org-x-dag-build-quarter-headline qnum section subhls)
|
||||||
|
;; (-snoc it))
|
||||||
|
;; st-yr))
|
||||||
|
;; (let ((end (1+ (org-ml-get-property :end (-last-item sts)))))
|
||||||
|
;; (org-ml-insert end (build-yr-headline year qnum section subhls))))))))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-get-key (key quarter)
|
;; (defmacro org-x-dag-qtp-map (quarter form)
|
||||||
(plist-get (org-x-dag-qtp-get quarter) key))
|
;; (declare (indent 1))
|
||||||
|
;; `(let ((it (org-x-dag-qtp-get ,quarter)))
|
||||||
|
;; (org-x-dag-qtp-set ,quarter ,form)))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-set-key (quarter key xs)
|
;; (defun org-x-dag-qtp-get-key (key quarter)
|
||||||
(org-x-dag-qtp-map quarter
|
;; (plist-get (org-x-dag-qtp-get quarter) key))
|
||||||
(plist-put it key xs)))
|
|
||||||
|
|
||||||
(defun org-x-qtp-get-buckets (quarter)
|
;; (defun org-x-dag-qtp-set-key (quarter key xs)
|
||||||
(org-x-dag-qtp-get-key :categories quarter))
|
;; (org-x-dag-qtp-map quarter
|
||||||
|
;; (plist-put it key xs)))
|
||||||
|
|
||||||
(defun org-x-qtp-get-goals (quarter)
|
;; (defun org-x-qtp-get-buckets (quarter)
|
||||||
(org-x-dag-qtp-get-key :goals quarter))
|
;; (org-x-dag-qtp-get-key :categories quarter))
|
||||||
|
|
||||||
(defun org-x-qtp-get-goal-ids (quarter)
|
;; (defun org-x-qtp-get-goals (quarter)
|
||||||
(->> (org-x-qtp-get-goals quarter)
|
;; (org-x-dag-qtp-get-key :goals quarter))
|
||||||
(--map (org-ml-headline-get-node-property "ID" it))))
|
|
||||||
|
|
||||||
(defun org-x-qtp-get-goal-parent-ids (quarter)
|
;; (defun org-x-qtp-get-goal-ids (quarter)
|
||||||
(->> (org-x-qtp-get-goals quarter)
|
;; (->> (org-x-qtp-get-goals quarter)
|
||||||
(-mapcat #'org-x-dag-headline-get-parent-links)))
|
;; (--map (org-ml-headline-get-node-property "ID" it))))
|
||||||
|
|
||||||
(defun org-x-qtp-set-categories (quarter categories)
|
;; (defun org-x-qtp-get-goal-parent-ids (quarter)
|
||||||
(org-x-dag-qtp-set-key quarter :categories categories))
|
;; (->> (org-x-qtp-get-goals quarter)
|
||||||
|
;; (-mapcat #'org-x-dag-headline-get-parent-links)))
|
||||||
|
|
||||||
(defun org-x-qtp-set-goals (quarter goals)
|
;; (defun org-x-qtp-set-categories (quarter categories)
|
||||||
(org-x-dag-qtp-set-key quarter :goals goals))
|
;; (org-x-dag-qtp-set-key quarter :categories categories))
|
||||||
|
|
||||||
(defmacro org-x-qtp-map-categories (quarter form)
|
;; (defun org-x-qtp-set-goals (quarter goals)
|
||||||
`(let ((it (org-x-qtp-get-buckets ,quarter)))
|
;; (org-x-dag-qtp-set-key quarter :goals goals))
|
||||||
(org-x-qtp-set-categories ,quarter ,form)))
|
|
||||||
|
|
||||||
(defmacro org-x-qtp-map-goals (quarter form)
|
;; (defmacro org-x-qtp-map-categories (quarter form)
|
||||||
`(let ((it (org-x-qtp-get-goals ,quarter)))
|
;; `(let ((it (org-x-qtp-get-buckets ,quarter)))
|
||||||
(org-x-qtp-set-goals ,quarter ,form)))
|
;; (org-x-qtp-set-categories ,quarter ,form)))
|
||||||
|
|
||||||
(defun org-x-qtp-add-goal (quarter headline)
|
;; (defmacro org-x-qtp-map-goals (quarter form)
|
||||||
(org-x-qtp-map-goals quarter (cons headline it)))
|
;; `(let ((it (org-x-qtp-get-goals ,quarter)))
|
||||||
|
;; (org-x-qtp-set-goals ,quarter ,form)))
|
||||||
|
|
||||||
(defun org-x-dag-headline-get-id (headline)
|
;; (defun org-x-qtp-add-goal (quarter headline)
|
||||||
(org-ml-headline-get-node-property "ID" headline))
|
;; (org-x-qtp-map-goals quarter (cons headline it)))
|
||||||
|
|
||||||
(defun org-x-dag-headline-add-id (headline)
|
;; (defun org-x-dag-headline-get-id (headline)
|
||||||
(org-ml-headline-set-node-property "ID" (org-id-new) headline))
|
;; (org-ml-headline-get-node-property "ID" headline))
|
||||||
|
|
||||||
(defun org-x-qtp-add-goal-ids (quarter ids title allocation)
|
;; (defun org-x-dag-headline-add-id (headline)
|
||||||
(->> (org-x-dag-build-qtp-headline title nil ids allocation)
|
;; (org-ml-headline-set-node-property "ID" (org-id-new) headline))
|
||||||
(org-x-qtp-add-goal quarter)))
|
|
||||||
|
;; (defun org-x-qtp-add-goal-ids (quarter ids title allocation)
|
||||||
|
;; (->> (org-x-dag-build-qtp-headline title nil ids allocation)
|
||||||
|
;; (org-x-qtp-add-goal quarter)))
|
||||||
|
|
||||||
|
;; weekly plan
|
||||||
|
|
||||||
|
(defun org-x-dag-wkp-empty ()
|
||||||
|
(->> (-map #'car org-x-dag-weekly-tags)
|
||||||
|
(--map (org-x-dag-build-day-of-week-headline it nil))))
|
||||||
|
|
||||||
(defun org-x-dag-weekly-headlines-to-alist (headlines)
|
(defun org-x-dag-weekly-headlines-to-alist (headlines)
|
||||||
(->> (-map #'car org-x-dag-weekly-tags)
|
(->> (-map #'car org-x-dag-weekly-tags)
|
||||||
|
|
@ -3236,13 +3294,11 @@ review phase)"
|
||||||
plan))
|
plan))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-get-week-headline (date)
|
(defun org-x-dag-wkp-get-week-headline (date)
|
||||||
(org-x-with-file (org-x-get-weekly-plan-file)
|
|
||||||
(-let (((y _ _) date)
|
(-let (((y _ _) date)
|
||||||
(w (org-x-dag-date-to-week-number date)))
|
(w (org-x-dag-date-to-week-number date)))
|
||||||
(->> (org-ml-parse-subtrees 'all)
|
(org-x-dag-headline-get-nested (org-x-dag->planning-file :weekly)
|
||||||
(org-x-dag-headlines-find-year y)
|
(list (-partial #'org-x-dag-headlines-find-year y)
|
||||||
(org-ml-headline-get-subheadlines)
|
(-partial #'org-x-dag-headlines-find-week w)))))
|
||||||
(org-x-dag-headlines-find-week w)))))
|
|
||||||
|
|
||||||
(defun org-x-dag-wkp-get-day-headline (date)
|
(defun org-x-dag-wkp-get-day-headline (date)
|
||||||
(-let ((n (org-x-dag-date-to-day-number)))
|
(-let ((n (org-x-dag-date-to-day-number)))
|
||||||
|
|
@ -3250,64 +3306,77 @@ review phase)"
|
||||||
(org-ml-headline-get-subheadlines)
|
(org-ml-headline-get-subheadlines)
|
||||||
(org-x-dag-headlines-find-day-of-week n))))
|
(org-x-dag-headlines-find-day-of-week n))))
|
||||||
|
|
||||||
|
(defun org-x-dag-wkp-set-headlines (date headlines)
|
||||||
|
(-let* (((y _ _) date)
|
||||||
|
(w (org-x-dag-date-to-week-number date))
|
||||||
|
(path (org-x-dag->planning-file :weekly))
|
||||||
|
(find-year (-partial #'org-x-dag-headlines-find-year y))
|
||||||
|
(find-week (-partial #'org-x-dag-headlines-find-week w))
|
||||||
|
(build-year (-partial #'org-x-dag-build-year-headline y))
|
||||||
|
(build-week (-partial #'org-x-dag-build-week-headline y w)))
|
||||||
|
(org-x-dag-headline-set-nested path headlines
|
||||||
|
`((,find-year ,build-year)
|
||||||
|
(,find-week ,build-week)))))
|
||||||
|
|
||||||
;; TODO these functions need to take dates and not 'week's (whatever those are)
|
;; TODO these functions need to take dates and not 'week's (whatever those are)
|
||||||
(defun org-x-dag-wkp-get (week)
|
(defun org-x-dag-wkp-get (week)
|
||||||
(->> (org-x-dag-wkp-get-day-headline date)
|
(->> (org-x-dag-wkp-get-day-headline date)
|
||||||
(org-ml-headline-get-subheadlines)
|
(org-ml-headline-get-subheadlines)
|
||||||
(org-x-dag-weekly-headlines-to-alist)))
|
(org-x-dag-weekly-headlines-to-alist)))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-set (week plan)
|
;; (defun org-x-dag-wkp-set (week plan)
|
||||||
(cl-flet*
|
;; (cl-flet*
|
||||||
((build-yr-headline
|
;; ((build-yr-headline
|
||||||
(year weeknum children)
|
;; (year weeknum children)
|
||||||
(->> (org-x-dag-build-week-headline year weeknum children)
|
;; (->> (org-x-dag-build-week-headline year weeknum children)
|
||||||
(list)
|
;; (list)
|
||||||
(org-x-dag-build-year-headline year))))
|
;; (org-x-dag-build-year-headline year))))
|
||||||
(org-x-with-file (org-x-get-weekly-plan-file)
|
;; (org-x-with-file (org-x-get-weekly-plan-file)
|
||||||
(-let* (((year weeknum) week)
|
;; (-let* (((year weeknum) week)
|
||||||
(sts (org-ml-parse-subtrees 'all))
|
;; (sts (org-ml-parse-subtrees 'all))
|
||||||
(children (org-x-dag-weekly-alist-to-headlines plan)))
|
;; (children (org-x-dag-weekly-alist-to-headlines plan)))
|
||||||
(-if-let (st-yr (org-x-dag-headlines-find-year year sts))
|
;; (-if-let (st-yr (org-x-dag-headlines-find-year year sts))
|
||||||
(-if-let (st-wk (->> (org-ml-headline-get-subheadlines st-yr)
|
;; (-if-let (st-wk (->> (org-ml-headline-get-subheadlines st-yr)
|
||||||
(org-x-dag-headlines-find-week weeknum)))
|
;; (org-x-dag-headlines-find-week weeknum)))
|
||||||
(org-ml-update* (org-ml-set-children children it) st-wk)
|
;; (org-ml-update* (org-ml-set-children children it) st-wk)
|
||||||
(org-ml-update*
|
;; (org-ml-update*
|
||||||
(-snoc it (org-x-dag-build-week-headline year weeknum children))
|
;; (-snoc it (org-x-dag-build-week-headline year weeknum children))
|
||||||
st-yr))
|
;; st-yr))
|
||||||
(let ((end (1+ (org-ml-get-property :end (-last-item sts)))))
|
;; (let ((end (1+ (org-ml-get-property :end (-last-item sts)))))
|
||||||
(org-ml-insert end (build-yr-headline year weeknum children))))))))
|
;; (org-ml-insert end (build-yr-headline year weeknum children))))))))
|
||||||
|
|
||||||
(defmacro org-x-dag-wkp-map (week form)
|
;; (defmacro org-x-dag-wkp-map (week form)
|
||||||
(declare (indent 1))
|
;; (declare (indent 1))
|
||||||
(let ((w (make-symbol "--week")))
|
;; (let ((w (make-symbol "--week")))
|
||||||
`(let* ((,w ,week)
|
;; `(let* ((,w ,week)
|
||||||
(it (org-x-dag-wkp-get ,w)))
|
;; (it (org-x-dag-wkp-get ,w)))
|
||||||
(org-x-dag-wkp-set ,w ,form))))
|
;; (org-x-dag-wkp-set ,w ,form))))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-day-get (week daynum)
|
;; (defun org-x-dag-wkp-day-get (week daynum)
|
||||||
(alist-get daynum (org-x-dag-wkp-get week)))
|
;; (alist-get daynum (org-x-dag-wkp-get week)))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-day-set (week daynum headlines)
|
;; (defun org-x-dag-wkp-day-set (week daynum headlines)
|
||||||
(org-x-dag-wkp-map week
|
;; (org-x-dag-wkp-map week
|
||||||
(--replace-where (= daynum (car it)) (cons daynum headlines) it)))
|
;; (--replace-where (= daynum (car it)) (cons daynum headlines) it)))
|
||||||
|
|
||||||
(defmacro org-x-dag-wkp-day-map (week daynum form)
|
;; (defmacro org-x-dag-wkp-day-map (week daynum form)
|
||||||
(declare (indent 2))
|
;; (declare (indent 2))
|
||||||
(let ((w (make-symbol "--week"))
|
;; (let ((w (make-symbol "--week"))
|
||||||
(d (make-symbol "--daynum")))
|
;; (d (make-symbol "--daynum")))
|
||||||
`(let* ((,w ,week)
|
;; `(let* ((,w ,week)
|
||||||
(,d ,daynum)
|
;; (,d ,daynum)
|
||||||
(it (org-x-dag-wkp-day-get ,w ,d)))
|
;; (it (org-x-dag-wkp-day-get ,w ,d)))
|
||||||
(org-x-dag-wkp-day-set ,w ,d ,form))))
|
;; (org-x-dag-wkp-day-set ,w ,d ,form))))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-day-add (week daynum headline)
|
;; (defun org-x-dag-wkp-day-add (week daynum headline)
|
||||||
(org-x-dag-wkp-day-map week daynum (cons headline it)))
|
;; (org-x-dag-wkp-day-map week daynum (cons headline it)))
|
||||||
|
|
||||||
(defun org-x-dag-wkp-add-goal (week daynum title ids desc)
|
;; (defun org-x-dag-wkp-add-goal (week daynum title ids desc)
|
||||||
(->> (org-x-dag-build-wkp-headline title desc ids)
|
;; (->> (org-x-dag-build-wkp-headline title desc ids)
|
||||||
(org-x-dag-wkp-day-add week daynum)))
|
;; (org-x-dag-wkp-day-add week daynum)))
|
||||||
|
|
||||||
|
;; daily plan
|
||||||
|
|
||||||
;; TODO not DRY
|
|
||||||
(defun org-x-dag-dlp-get-headline (date)
|
(defun org-x-dag-dlp-get-headline (date)
|
||||||
(org-x-with-file (org-x-dag->planning-file :daily)
|
(org-x-with-file (org-x-dag->planning-file :daily)
|
||||||
(-let (((y m d) date))
|
(-let (((y m d) date))
|
||||||
|
|
@ -3323,36 +3392,18 @@ review phase)"
|
||||||
(org-ml-headline-get-subheadlines)))
|
(org-ml-headline-get-subheadlines)))
|
||||||
|
|
||||||
(defun org-x-dag-dlp-set (date headlines)
|
(defun org-x-dag-dlp-set (date headlines)
|
||||||
(cl-flet*
|
(-let* (((y m d) date)
|
||||||
((build-mo-headline
|
(path (org-x-dag->planning-file :daily))
|
||||||
(date headlines)
|
(find-year (-partial #'org-x-dag-headlines-find-year y))
|
||||||
(-let (((_ m _) date))
|
(find-month (-partial #'org-x-dag-headlines-find-month m))
|
||||||
(->> (org-x-dag-build-day-headline date headlines)
|
(find-day (-partial #'org-x-dag-headlines-find-day d))
|
||||||
(list)
|
(build-year (-partial #'org-x-dag-build-year-headline y))
|
||||||
(org-x-dag-build-month-headline m))))
|
(build-month (-partial #'org-x-dag-build-month-headline m))
|
||||||
(build-yr-headline
|
(build-day (-partial #'org-x-dag-build-day-headline date)))
|
||||||
(date headlines)
|
(org-x-dag-headline-set-nested path headlines
|
||||||
(-let* (((y _ _) date))
|
`((,find-year ,build-year)
|
||||||
(->> (build-mo-headline date headlines)
|
(,find-month ,build-month)
|
||||||
(list)
|
(,find-day ,build-day)))))
|
||||||
(org-x-dag-build-year-headline y)))))
|
|
||||||
(org-x-with-file (org-x-get-daily-plan-file)
|
|
||||||
(-let (((y m d) date)
|
|
||||||
(sts (org-ml-parse-subtrees 'all)))
|
|
||||||
(-if-let (st-yr (org-x-dag-headlines-find-year y sts))
|
|
||||||
(-if-let (st-mo (->> (org-ml-headline-get-subheadlines st-yr)
|
|
||||||
(org-x-dag-headlines-find-month m)))
|
|
||||||
(-if-let (st-day (->> (org-ml-headline-get-subheadlines st-mo)
|
|
||||||
(org-x-dag-headlines-find-day d)))
|
|
||||||
(org-ml-update* (org-ml-set-children headlines it) st-day)
|
|
||||||
(org-ml-update*
|
|
||||||
(-snoc it (org-x-dag-build-day-headline date headlines))
|
|
||||||
st-mo))
|
|
||||||
(org-ml-update*
|
|
||||||
(-snoc it (build-mo-headline date headlines))
|
|
||||||
st-yr))
|
|
||||||
(let ((end (1+ (org-ml-get-property :end (-last-item sts)))))
|
|
||||||
(org-ml-insert end (build-yr-headline date headlines))))))))
|
|
||||||
|
|
||||||
(defmacro org-x-dag-dlp-map (date form)
|
(defmacro org-x-dag-dlp-map (date form)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
|
|
@ -3388,28 +3439,65 @@ review phase)"
|
||||||
(->> (plist-get org-x-dag :selected-date)
|
(->> (plist-get org-x-dag :selected-date)
|
||||||
(apply #'message "Org-DAG date is %d-%02d-%02d")))
|
(apply #'message "Org-DAG date is %d-%02d-%02d")))
|
||||||
|
|
||||||
|
;; blank plans
|
||||||
|
|
||||||
|
(defmacro org-x-dag--new-plan-maybe (get-form new-form)
|
||||||
|
(declare (indent 0))
|
||||||
|
`(let ((it (org-x-dag->selected-date)))
|
||||||
|
(unless ,get-form
|
||||||
|
,new-form)))
|
||||||
|
|
||||||
|
(defun org-x-dag--new-qtp (date)
|
||||||
|
(org-x-dag-qtp-set-headlines date (org-x-dag-qtp-empty)))
|
||||||
|
|
||||||
|
(defun org-x-dag--new-wkp (date)
|
||||||
|
(org-x-dag-wkp-set-headlines date (org-x-dag-wkp-empty)))
|
||||||
|
|
||||||
|
(defun org-x-dag-new-qtp ()
|
||||||
|
(interactive)
|
||||||
|
(org-x-dag--new-plan-maybe
|
||||||
|
(org-x-dag-qtp-get-headline it)
|
||||||
|
(org-x-dag--new-qtp it)))
|
||||||
|
|
||||||
|
(defun org-x-dag-new-wkp ()
|
||||||
|
(interactive)
|
||||||
|
(org-x-dag--new-plan-maybe
|
||||||
|
(org-x-dag-wkp-get-week-headline it)
|
||||||
|
(org-x-dag--new-wkp it)))
|
||||||
|
|
||||||
;; planning navigation
|
;; planning navigation
|
||||||
|
|
||||||
(defun org-x-dag--goto-current (what file-key hl-fun)
|
(defun org-x-dag--goto-current (what file-key hl-fun &optional create-fun)
|
||||||
(declare (indent 2))
|
(declare (indent 2))
|
||||||
(-if-let (p (->> (org-x-dag->current-date)
|
(cl-flet
|
||||||
(funcall hl-fun)
|
((goto
|
||||||
(org-ml-get-property :begin)))
|
(point)
|
||||||
(progn
|
|
||||||
(find-file (org-x-dag->planning-file file-key))
|
(find-file (org-x-dag->planning-file file-key))
|
||||||
(goto-char p)
|
(goto-char point)
|
||||||
(org-reveal))
|
(org-reveal)))
|
||||||
(message "%s does not exist for current date" what)))
|
(let ((d (org-x-dag->selected-date))
|
||||||
|
(msg ))
|
||||||
|
(-if-let (p (-some->> (funcall hl-fun d)
|
||||||
|
(org-ml-get-property :begin)))
|
||||||
|
(goto p)
|
||||||
|
(let ((msg (format "%s does not exist for current date." what)))
|
||||||
|
(if create-fun
|
||||||
|
(when (yes-or-no-p (format "%s Make new?" msg))
|
||||||
|
(->> (funcall create-fun d)
|
||||||
|
(goto)))
|
||||||
|
(message msg)))))))
|
||||||
|
|
||||||
(defun org-x-dag-goto-current-quarterly-plan ()
|
(defun org-x-dag-goto-current-quarterly-plan ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(org-x-dag--goto-current "Quarterly plan" :quarterly
|
(org-x-dag--goto-current "Quarterly plan" :quarterly
|
||||||
#'org-x-dag-qtp-get-headline))
|
#'org-x-dag-qtp-get-headline
|
||||||
|
#'org-x-dag--new-qtp))
|
||||||
|
|
||||||
(defun org-x-dag-goto-current-weekly-plan ()
|
(defun org-x-dag-goto-current-weekly-plan ()
|
||||||
(interactive)
|
(interactive)
|
||||||
(org-x-dag--goto-current "Weekly plan (week)" :weekly
|
(org-x-dag--goto-current "Weekly plan (week)" :weekly
|
||||||
#'org-x-dag-wkp-get-week-headline))
|
#'org-x-dag-wkp-get-week-headline
|
||||||
|
#'org-x-dag--new-wkp))
|
||||||
|
|
||||||
(defun org-x-dag-goto-current-weekly-plan-day ()
|
(defun org-x-dag-goto-current-weekly-plan-day ()
|
||||||
(interactive)
|
(interactive)
|
||||||
|
|
@ -3421,7 +3509,9 @@ review phase)"
|
||||||
(org-x-dag--goto-current "Daily plan" :daily
|
(org-x-dag--goto-current "Daily plan" :daily
|
||||||
#'org-x-dag-dlp-get-headline))
|
#'org-x-dag-dlp-get-headline))
|
||||||
|
|
||||||
;; node navigation
|
;; parent -> child linkers
|
||||||
|
;;
|
||||||
|
;; functions to set the current headline as a parent link for a child headline
|
||||||
|
|
||||||
(defun org-x-dag-group-code (group)
|
(defun org-x-dag-group-code (group)
|
||||||
(pcase group
|
(pcase group
|
||||||
|
|
@ -3434,10 +3524,6 @@ review phase)"
|
||||||
(:daily "DLP")
|
(:daily "DLP")
|
||||||
(_ "???")))
|
(_ "???")))
|
||||||
|
|
||||||
;; parent -> child linkers
|
|
||||||
;;
|
|
||||||
;; functions to set the current headline as a parent link for a child headline
|
|
||||||
|
|
||||||
(defun org-x-dag--link-parent-to-child (parent-id-fun child-id-fun fmt-fun)
|
(defun org-x-dag--link-parent-to-child (parent-id-fun child-id-fun fmt-fun)
|
||||||
(cl-flet*
|
(cl-flet*
|
||||||
(;; (is-valid-node
|
(;; (is-valid-node
|
||||||
|
|
@ -3774,25 +3860,27 @@ review phase)"
|
||||||
"Time must be like HH:MM (24 hour)")))
|
"Time must be like HH:MM (24 hour)")))
|
||||||
(org-x-dag-dlp-add-task date title nil time)))
|
(org-x-dag-dlp-add-task date title nil time)))
|
||||||
|
|
||||||
(defun org-x-dag-qtp-new ()
|
;; make blank plans
|
||||||
(interactive)
|
|
||||||
(-let* ((cur-q (->> (plist-get org-x-dag :selected-date)
|
;; (defun org-x-dag-qtp-new ()
|
||||||
(org-x-dag-date-to-quarter)))
|
;; (interactive)
|
||||||
((last-plan last-q)
|
;; (-let* ((cur-q (->> (plist-get org-x-dag :selected-date)
|
||||||
(->> cur-q
|
;; (org-x-dag-date-to-quarter)))
|
||||||
(--unfold
|
;; ((last-plan last-q)
|
||||||
(if (not it) nil
|
;; (->> cur-q
|
||||||
(let ((plan (org-x-dag-qtp-get it)))
|
;; (--unfold
|
||||||
`((,plan ,it) .
|
;; (if (not it) nil
|
||||||
,(unless (or (plist-get plan :categories)
|
;; (let ((plan (org-x-dag-qtp-get it)))
|
||||||
(plist-get plan :goals))
|
;; `((,plan ,it) .
|
||||||
(org-x-dag-shift-quarter it -1 'quarter))))))
|
;; ,(unless (or (plist-get plan :categories)
|
||||||
(-last-item))))
|
;; (plist-get plan :goals))
|
||||||
(if (equal cur-q last-q)
|
;; (org-x-dag-shift-quarter it -1 'quarter))))))
|
||||||
(apply #'message "Quarterly plan already initialized for %d-Q%d" cur-q)
|
;; (-last-item))))
|
||||||
(let ((c (plist-get last-plan :categories)))
|
;; (if (equal cur-q last-q)
|
||||||
(org-x-dag-qtp-set cur-q `(:categories ,c :goals nil))
|
;; (apply #'message "Quarterly plan already initialized for %d-Q%d" cur-q)
|
||||||
(apply #'message "Created new quaterly plan for %d-Q%d" cur-q)))))
|
;; (let ((c (plist-get last-plan :categories)))
|
||||||
|
;; (org-x-dag-qtp-set cur-q `(:categories ,c :goals nil))
|
||||||
|
;; (apply #'message "Created new quaterly plan for %d-Q%d" cur-q)))))
|
||||||
|
|
||||||
(provide 'org-x-dag)
|
(provide 'org-x-dag)
|
||||||
;;; org-x-dag.el ends here
|
;;; org-x-dag.el ends here
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue