REF clean up link functions
This commit is contained in:
parent
909d1f7148
commit
621754f5e8
|
@ -1261,8 +1261,6 @@ used for optimization."
|
||||||
(org-x-dag-ht-add-links id ht-l :fulfilled)))))
|
(org-x-dag-ht-add-links id ht-l :fulfilled)))))
|
||||||
ns))
|
ns))
|
||||||
|
|
||||||
;; TODO check that actions that are linked here are not linked to survival
|
|
||||||
;; goals here (since those can't be planned)
|
|
||||||
(defun org-x-dag-ns-dlp (adjlist links ns)
|
(defun org-x-dag-ns-dlp (adjlist links ns)
|
||||||
(cl-flet
|
(cl-flet
|
||||||
((get-committed
|
((get-committed
|
||||||
|
@ -1276,6 +1274,8 @@ used for optimization."
|
||||||
(let ((qgoals (->> (get-committed ht-w w)
|
(let ((qgoals (->> (get-committed ht-w w)
|
||||||
(get-committed ht-q)))
|
(get-committed ht-q)))
|
||||||
(agoals (get-committed ht-a a)))
|
(agoals (get-committed ht-a a)))
|
||||||
|
;; TODO this check doesn't matter for survival goals since
|
||||||
|
;; those won't be on the quarterly plan
|
||||||
(-if-let (gs (-intersection qgoals agoals))
|
(-if-let (gs (-intersection qgoals agoals))
|
||||||
(progn
|
(progn
|
||||||
(->> (list :scheduled w
|
(->> (list :scheduled w
|
||||||
|
@ -1821,20 +1821,34 @@ Return value is a list like (BUFFER NON-BUFFER)."
|
||||||
(defun org-x-dag-files->ids (files)
|
(defun org-x-dag-files->ids (files)
|
||||||
(-mapcat #'org-x-dag-file->ids files))
|
(-mapcat #'org-x-dag-file->ids files))
|
||||||
|
|
||||||
|
(defun org-x-dag->goal-ids (which)
|
||||||
|
(org-x-dag-file->ids (org-x-dag->goal-file which)))
|
||||||
|
|
||||||
|
(defun org-x-dag->planning-ids (which)
|
||||||
|
(->> (org-x-dag->goal-file which)
|
||||||
|
(org-x-dag-file->ids)))
|
||||||
|
|
||||||
(defun org-x-dag->epg-ids ()
|
(defun org-x-dag->epg-ids ()
|
||||||
(org-x-dag-file->ids (org-x-get-endpoint-goal-file)))
|
(org-x-dag->goal-ids :endpoint))
|
||||||
|
|
||||||
(defun org-x-dag->ltg-ids ()
|
(defun org-x-dag->ltg-ids ()
|
||||||
(org-x-dag-file->ids (org-x-get-lifetime-goal-file)))
|
(org-x-dag->goal-ids :lifetime))
|
||||||
|
|
||||||
(defun org-x-dag->svg-ids ()
|
(defun org-x-dag->svg-ids ()
|
||||||
(org-x-dag-file->ids (org-x-get-survival-goal-file)))
|
(org-x-dag->goal-ids :survival))
|
||||||
|
|
||||||
(defun org-x-dag->qtp-ids ()
|
(defun org-x-dag->qtp-ids ()
|
||||||
(org-x-dag-file->ids (org-x-dag->planning-file :quarterly)))
|
(org-x-dag->planning-ids :quarterly))
|
||||||
|
|
||||||
(defun org-x-dag->wkp-ids ()
|
(defun org-x-dag->wkp-ids ()
|
||||||
(org-x-dag-file->ids (org-x-dag->planning-file :weekly)))
|
(org-x-dag->planning-ids :weekly))
|
||||||
|
|
||||||
|
(defun org-x-dag->dlp-ids ()
|
||||||
|
(org-x-dag->planning-ids :weekly))
|
||||||
|
|
||||||
|
(defun org-x-dag->action-ids ()
|
||||||
|
(->> (org-x-dag->action-files)
|
||||||
|
(org-x-dag-files->ids)))
|
||||||
|
|
||||||
(defun org-x-dag-filter-ids-tags (tags ids)
|
(defun org-x-dag-filter-ids-tags (tags ids)
|
||||||
(--filter (-intersection (org-x-dag-id->tags nil it) tags) ids))
|
(--filter (-intersection (org-x-dag-id->tags nil it) tags) ids))
|
||||||
|
@ -1852,15 +1866,26 @@ Return value is a list like (BUFFER NON-BUFFER)."
|
||||||
#'org-x-dag-weekly-tags-to-date
|
#'org-x-dag-weekly-tags-to-date
|
||||||
date))
|
date))
|
||||||
|
|
||||||
(defun org-x-dag->dlp-ids ()
|
|
||||||
(org-x-dag-file->ids (org-x-dag->planning-file :daily)))
|
|
||||||
|
|
||||||
(defun org-x-dag-date->dlp-ids (date)
|
(defun org-x-dag-date->dlp-ids (date)
|
||||||
(org-x-dag-date->tagged-ids
|
(org-x-dag-date->tagged-ids
|
||||||
(org-x-dag->dlp-ids)
|
(org-x-dag->dlp-ids)
|
||||||
#'org-x-dag-daily-tags-to-date
|
#'org-x-dag-daily-tags-to-date
|
||||||
date))
|
date))
|
||||||
|
|
||||||
|
(defun org-x-dag->current-qtp-ids ()
|
||||||
|
(-> (org-x-dag->selected-date)
|
||||||
|
(org-x-dag-date-to-quarter-start)
|
||||||
|
(org-x-dag-date->qtp-ids)))
|
||||||
|
|
||||||
|
(defun org-x-dag->current-wkp-ids ()
|
||||||
|
(-> (org-x-dag->selected-date)
|
||||||
|
(org-x-dag-date-to-week-start)
|
||||||
|
(org-x-dag-date->wkp-ids)))
|
||||||
|
|
||||||
|
(defun org-x-dag->current-dlp-ids ()
|
||||||
|
(-> (org-x-dag->selected-date)
|
||||||
|
(org-x-dag-date->dlp-ids)))
|
||||||
|
|
||||||
(defun org-x-dag-goal-count-tasks (id)
|
(defun org-x-dag-goal-count-tasks (id)
|
||||||
(->> (org-x-dag-id->children id)
|
(->> (org-x-dag-id->children id)
|
||||||
(-mapcat #'org-x-dag-id->all-buffer-children)
|
(-mapcat #'org-x-dag-id->all-buffer-children)
|
||||||
|
@ -2216,18 +2241,17 @@ FUTURE-LIMIT in a list."
|
||||||
|
|
||||||
;; auxiliary macros
|
;; auxiliary macros
|
||||||
|
|
||||||
(defmacro org-x-dag-with-file-ids (files id-form)
|
(defmacro org-x-dag-with-ids (ids id-form)
|
||||||
(declare (indent 1))
|
(declare (indent 1))
|
||||||
`(with-temp-buffer
|
`(with-temp-buffer
|
||||||
;; TODO this is silly and it adds 0.1 seconds to this function's runtime;
|
;; TODO this is silly and it adds 0.1 seconds to this function's runtime;
|
||||||
;; it is only needed to get the todo keyword the right color
|
;; it is only needed to get the todo keyword the right color
|
||||||
(org-mode)
|
(org-mode)
|
||||||
(->> (org-x-dag-files->ids ,files)
|
(--mapcat ,id-form ,ids)))
|
||||||
(--mapcat ,id-form))))
|
|
||||||
|
|
||||||
(defmacro org-x-dag-with-action-ids (id-form)
|
(defmacro org-x-dag-with-action-ids (id-form)
|
||||||
(declare (indent 0))
|
(declare (indent 0))
|
||||||
`(org-x-dag-with-file-ids (org-x-dag->action-files)
|
`(org-x-dag-with-ids (org-x-dag->action-ids)
|
||||||
,id-form))
|
,id-form))
|
||||||
|
|
||||||
(defmacro org-x-dag-with-files (files pre-form form)
|
(defmacro org-x-dag-with-files (files pre-form form)
|
||||||
|
@ -2440,7 +2464,7 @@ FUTURE-LIMIT in a list."
|
||||||
(format-deadlines todayp sel-date it dead))
|
(format-deadlines todayp sel-date it dead))
|
||||||
(when sched
|
(when sched
|
||||||
(format-scheduleds todayp sel-date it sched))))))))
|
(format-scheduleds todayp sel-date it sched))))))))
|
||||||
(daily (org-x-dag-with-file-ids (org-x-dag->planning-file :daily)
|
(daily (org-x-dag-with-ids (org-x-dag->dlp-ids)
|
||||||
(pcase (either-from-right (org-x-dag-id->bs it) nil)
|
(pcase (either-from-right (org-x-dag-id->bs it) nil)
|
||||||
(`(:daily :active (:sched ,sched))
|
(`(:daily :active (:sched ,sched))
|
||||||
(format-scheduleds todayp sel-date it sched))))))
|
(format-scheduleds todayp sel-date it sched))))))
|
||||||
|
@ -3527,6 +3551,20 @@ review phase)"
|
||||||
(:daily "DLP")
|
(:daily "DLP")
|
||||||
(_ "???")))
|
(_ "???")))
|
||||||
|
|
||||||
|
(defun org-x-dag--format-link-menu-line (id title-fun)
|
||||||
|
(declare (indent 1))
|
||||||
|
(let* ((group (org-x-dag-id->group id))
|
||||||
|
(s (funcall title-fun id group))
|
||||||
|
(g (org-x-dag-group-code group)))
|
||||||
|
(format "%s | %s" g s)))
|
||||||
|
|
||||||
|
(defun org-x-dag--format-link-menu-line-expanded (id)
|
||||||
|
(org-x-dag--format-link-menu-line id
|
||||||
|
(lambda (id group)
|
||||||
|
(if (memq group '(:weekly :daily :quarterly))
|
||||||
|
(org-x-dag-id->title id)
|
||||||
|
(org-x-dag-id->path (eq group :action) id)))))
|
||||||
|
|
||||||
(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
|
||||||
|
@ -3586,8 +3624,6 @@ review phase)"
|
||||||
()
|
()
|
||||||
(either>>= (id-getter)
|
(either>>= (id-getter)
|
||||||
(cond
|
(cond
|
||||||
((org-x-dag-id->ns-key :survivalp it)
|
|
||||||
(either :left "Action has survival goal parents"))
|
|
||||||
((-some->> (org-x-dag-id->planning-datetime :scheduled it)
|
((-some->> (org-x-dag-id->planning-datetime :scheduled it)
|
||||||
(org-x-dag-datetime-split)
|
(org-x-dag-datetime-split)
|
||||||
(nth 1))
|
(nth 1))
|
||||||
|
@ -3598,52 +3634,21 @@ review phase)"
|
||||||
;; child id functions
|
;; child id functions
|
||||||
(action-qtp-getter
|
(action-qtp-getter
|
||||||
()
|
()
|
||||||
(let ((action (->> (org-x-dag->action-files)
|
(let ((action (->> (org-x-dag->action-ids)
|
||||||
(org-x-dag-files->ids)
|
|
||||||
;; TODO could also remove DONE/CANC and things
|
;; TODO could also remove DONE/CANC and things
|
||||||
;; underneath these
|
;; underneath these
|
||||||
(--remove (org-x-dag-id->ns-key :survivalp it))))
|
(--remove (org-x-dag-id->ns-key :survivalp it))))
|
||||||
(qtp (-> (plist-get org-x-dag :selected-date)
|
(append action (org-x-dag->current-qtp-ids)))))
|
||||||
(org-x-dag-date-to-quarter)
|
|
||||||
(org-x-dag-quarter-to-date)
|
|
||||||
(org-x-dag-date->qtp-ids))))
|
|
||||||
(append action qtp)))
|
|
||||||
(svg-action-getter
|
(svg-action-getter
|
||||||
()
|
()
|
||||||
(->> (org-x-dag->action-files)
|
(->> (org-x-dag->action-ids)
|
||||||
(org-x-dag-files->ids)
|
|
||||||
;; TODO could also remove DONE/CANC and things
|
;; TODO could also remove DONE/CANC and things
|
||||||
;; underneath these
|
;; underneath these
|
||||||
(--remove (and (org-x-dag-id->ns-key :committed it)
|
(--remove (and (org-x-dag-id->ns-key :committed it)
|
||||||
(not (org-x-dag-id->ns-key :survivalp it))))))
|
(not (org-x-dag-id->ns-key :survivalp it))))))
|
||||||
(epg-action-qtp-getter
|
(epg-action-qtp-getter
|
||||||
()
|
()
|
||||||
`(,@(org-x-dag->epg-ids) ,@(action-qtp-getter)))
|
`(,@(org-x-dag->epg-ids) ,@(action-qtp-getter))))
|
||||||
(wkp-getter
|
|
||||||
()
|
|
||||||
(-> (plist-get org-x-dag :selected-date)
|
|
||||||
(org-x-dag-date-to-week-number)
|
|
||||||
(org-x-dag-date->wkp-ids)))
|
|
||||||
(dlp-getter
|
|
||||||
()
|
|
||||||
(-> (plist-get org-x-dag :selected-date)
|
|
||||||
(org-x-dag-date->dlp-ids)))
|
|
||||||
|
|
||||||
;; formatters
|
|
||||||
(toplevel-formatter
|
|
||||||
(id)
|
|
||||||
(let* ((group (org-x-dag-id->group id))
|
|
||||||
(s (if (eq group :quarterly)
|
|
||||||
(org-x-dag-id->title id)
|
|
||||||
(org-x-dag-id->path (eq group :action) id)))
|
|
||||||
(g (org-x-dag-group-code group)))
|
|
||||||
(format "%s | %s" g s)))
|
|
||||||
(svg-formatter
|
|
||||||
(id)
|
|
||||||
(org-x-dag-id->path t id))
|
|
||||||
(plan-formatter
|
|
||||||
(id)
|
|
||||||
(org-x-dag-id->title id)))
|
|
||||||
|
|
||||||
(org-x-dag-sync)
|
(org-x-dag-sync)
|
||||||
(let ((f (buffer-file-name)))
|
(let ((f (buffer-file-name)))
|
||||||
|
@ -3652,32 +3657,32 @@ review phase)"
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'leaf-id-getter
|
#'leaf-id-getter
|
||||||
#'epg-action-qtp-getter
|
#'epg-action-qtp-getter
|
||||||
#'toplevel-formatter))
|
#'org-x-dag--format-link-menu-line-expanded))
|
||||||
((equal f (org-x-dag->goal-file :endpoint))
|
((equal f (org-x-dag->goal-file :endpoint))
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'leaf-id-getter
|
#'leaf-id-getter
|
||||||
#'action-qtp-getter
|
#'action-qtp-getter
|
||||||
#'toplevel-formatter))
|
#'org-x-dag--format-link-menu-line-expanded))
|
||||||
((equal f (org-x-dag->goal-file :survival))
|
((equal f (org-x-dag->goal-file :survival))
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'leaf-id-getter
|
#'leaf-id-getter
|
||||||
#'svg-action-getter
|
#'svg-action-getter
|
||||||
#'svg-formatter))
|
(-partial #'org-x-dag-id->path t)))
|
||||||
((member f (org-x-dag->action-files))
|
((member f (org-x-dag->action-files))
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'action-id-getter
|
#'action-id-getter
|
||||||
#'dlp-getter
|
#'org-x-dag->current-dlp-ids
|
||||||
#'plan-formatter))
|
#'org-x-dag-id->title))
|
||||||
((equal f (org-x-dag->planning-file :quarterly))
|
((equal f (org-x-dag->planning-file :quarterly))
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'id-getter
|
#'id-getter
|
||||||
#'wkp-getter
|
#'org-x-dag->current-wkp-ids
|
||||||
#'plan-formatter))
|
#'org-x-dag-id->title))
|
||||||
((equal f (org-x-dag->planning-file :weekly))
|
((equal f (org-x-dag->planning-file :weekly))
|
||||||
(org-x-dag--link-parent-to-child
|
(org-x-dag--link-parent-to-child
|
||||||
#'id-getter
|
#'id-getter
|
||||||
#'dlp-getter
|
#'org-x-dag->current-dlp-ids
|
||||||
#'plan-formatter))
|
#'org-x-dag-id->title))
|
||||||
(t
|
(t
|
||||||
(message "Cannot link child from parent in current file"))))))
|
(message "Cannot link child from parent in current file"))))))
|
||||||
|
|
||||||
|
@ -3735,7 +3740,9 @@ review phase)"
|
||||||
sec)))
|
sec)))
|
||||||
(either-from* (funcall parse-fun)
|
(either-from* (funcall parse-fun)
|
||||||
(message it)
|
(message it)
|
||||||
(if it (update-headline it) (update-tl-section it)))))
|
(if (org-ml-is-type 'headline it)
|
||||||
|
(update-headline it)
|
||||||
|
(update-tl-section it)))))
|
||||||
|
|
||||||
(defun org-x-dag-link-child-to-parent ()
|
(defun org-x-dag-link-child-to-parent ()
|
||||||
(interactive)
|
(interactive)
|
||||||
|
@ -3757,55 +3764,22 @@ review phase)"
|
||||||
(parse-hl)))
|
(parse-hl)))
|
||||||
|
|
||||||
;; parent id getters
|
;; parent id getters
|
||||||
(ltg-getter
|
|
||||||
()
|
|
||||||
(->> (org-x-dag->goal-file :lifetime)
|
|
||||||
(org-x-dag-file->ids)))
|
|
||||||
(tlg-getter
|
(tlg-getter
|
||||||
()
|
()
|
||||||
(->> (org-x-dag->goal-file :endpoint)
|
(append (org-x-dag->epg-ids) (org-x-dag->ltg-ids)))
|
||||||
(org-x-dag-file->ids)
|
|
||||||
(append (ltg-getter))))
|
|
||||||
(goal-getter
|
(goal-getter
|
||||||
()
|
()
|
||||||
(->> (org-x-dag->goal-file :survival)
|
(append (org-x-dag->svg-ids) (tlg-getter)))
|
||||||
(org-x-dag-file->ids)
|
|
||||||
(append (tlg-getter))))
|
|
||||||
(wkp-getter
|
|
||||||
()
|
|
||||||
(->> (plist-get org-x-dag :selected-date)
|
|
||||||
(org-x-dag-date-to-quarter-start)
|
|
||||||
(org-x-dag-date->qtp-ids)))
|
|
||||||
(dlp-getter
|
(dlp-getter
|
||||||
()
|
()
|
||||||
(let ((wkp-ids (->> (plist-get org-x-dag :selected-date)
|
(append (org-x-dag->current-wkp-ids) (org-x-dag->action-ids)))
|
||||||
(org-x-dag-date-to-week-start)
|
|
||||||
(org-x-dag-date->wkp-ids)))
|
|
||||||
(action-ids (->> (org-x-dag->action-files)
|
|
||||||
(org-x-dag-files->ids))))
|
|
||||||
(append wkp-ids action-ids)))
|
|
||||||
|
|
||||||
;; formatters
|
;; formatters
|
||||||
(ltg-formatter
|
|
||||||
(id)
|
|
||||||
(org-x-dag-id->path t id))
|
|
||||||
(goal-formatter
|
(goal-formatter
|
||||||
(id)
|
(id)
|
||||||
(let* ((group (org-x-dag-id->group id))
|
(org-x-dag--format-link-menu-line id
|
||||||
(s (org-x-dag-id->path nil id))
|
(lambda (id _)
|
||||||
(g (org-x-dag-group-code group)))
|
(org-x-dag-id->path nil id)))))
|
||||||
(format "%s | %s" g s)))
|
|
||||||
(plan-formatter
|
|
||||||
(id)
|
|
||||||
(org-x-dag-id->title id))
|
|
||||||
(dlp-formatter
|
|
||||||
(id)
|
|
||||||
(let* ((group (org-x-dag-id->group id))
|
|
||||||
(s (if (eq group :weekly)
|
|
||||||
(org-x-dag-id->title id)
|
|
||||||
(org-x-dag-id->path (eq group :action) id)))
|
|
||||||
(g (org-x-dag-group-code group)))
|
|
||||||
(format "%s | %s" g s))))
|
|
||||||
|
|
||||||
(org-x-dag-sync)
|
(org-x-dag-sync)
|
||||||
(let ((f (buffer-file-name)))
|
(let ((f (buffer-file-name)))
|
||||||
|
@ -3813,8 +3787,8 @@ review phase)"
|
||||||
((equal f (org-x-dag->goal-file :endpoint))
|
((equal f (org-x-dag->goal-file :endpoint))
|
||||||
(org-x-dag--link-child-to-parent
|
(org-x-dag--link-child-to-parent
|
||||||
#'parse-hl
|
#'parse-hl
|
||||||
#'ltg-getter
|
#'org-x-dag->ltg-ids
|
||||||
#'ltg-formatter))
|
(-partial #'org-x-dag-id->path t)))
|
||||||
((member f (org-x-dag->action-files))
|
((member f (org-x-dag->action-files))
|
||||||
(org-x-dag--link-child-to-parent
|
(org-x-dag--link-child-to-parent
|
||||||
#'parse-hl-sec
|
#'parse-hl-sec
|
||||||
|
@ -3828,13 +3802,13 @@ review phase)"
|
||||||
((equal f (org-x-dag->planning-file :weekly))
|
((equal f (org-x-dag->planning-file :weekly))
|
||||||
(org-x-dag--link-child-to-parent
|
(org-x-dag--link-child-to-parent
|
||||||
#'parse-hl
|
#'parse-hl
|
||||||
#'wkp-getter
|
#'org-x-dag->current-qtp-ids
|
||||||
#'plan-formatter))
|
#'org-x-dag-id->title))
|
||||||
((equal f (org-x-dag->planning-file :daily))
|
((equal f (org-x-dag->planning-file :daily))
|
||||||
(org-x-dag--link-child-to-parent
|
(org-x-dag--link-child-to-parent
|
||||||
#'parse-hl
|
#'parse-hl
|
||||||
#'dlp-getter
|
#'dlp-getter
|
||||||
#'dlp-formatter))
|
#'org-x-dag--format-link-menu-line-expanded))
|
||||||
(t
|
(t
|
||||||
(message "Cannot link parent from child in current file"))))))
|
(message "Cannot link parent from child in current file"))))))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue