ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ENH remove all tag-based incubator code to use goal-status

This commit is contained in:
Nathan Dwarshuis 2022-02-28 19:08:25 -05:00
parent 59ae74ef5a
commit 09cabee82f
1 changed files with 83 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

115
local/lib/org-x/org-x-dag.el
View File

@ -439,8 +439,8 @@ Return value is a list like (BUFFER NON-BUFFER)."
,(org-x-dag->goal-file :lifetime))) ,(org-x-dag->goal-file :lifetime)))
:non-survival) :non-survival)
(t (t
:other)))))) :other)))))
(cond (status (cond
((null ks) ((null ks)
:no-goals) :no-goals)
((memq :other ks) ((memq :other ks)
@ -452,6 +452,7 @@ Return value is a list like (BUFFER NON-BUFFER)."
(t (t
(let ((gs (org-x-dag->qtp-goal-ids which))) (let ((gs (org-x-dag->qtp-goal-ids which)))
(if (--any-p (member it gs) ps) :planned :committed)))))) (if (--any-p (member it gs) ps) :planned :committed))))))
(list ps status)))
;; id predicates/identities ;; id predicates/identities
@ -662,7 +663,8 @@ be uncommitted if it is also incubated."
,(org-x-dag->goal-file :lifetime)))) ,(org-x-dag->goal-file :lifetime))))
(->> (org-x-dag->qtp-ids which) (->> (org-x-dag->qtp-ids which)
(-mapcat #'org-x-dag-id->linked-parents) (-mapcat #'org-x-dag-id->linked-parents)
(--filter (member (org-x-dag-id->file it) fs))))) (--filter (member (org-x-dag-id->file it) fs))
(-uniq))))
;; (defun org-x-dag-date->dlp-parent-ids (date) ;; (defun org-x-dag-date->dlp-parent-ids (date)
;; (let ((dlp-ids (org-x-dag-date->dlp-ids date))) ;; (let ((dlp-ids (org-x-dag-date->dlp-ids date)))
@ -1912,8 +1914,7 @@ FUTURE-LIMIT in a list."
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; TODO don't hardcode these things ;; TODO don't hardcode these things
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (or (org-x-dag-id->is-incubated 'current key) (unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned))
;; (member org-x-tag-incubated tags)
(org-x-dag-headline-is-iterator-p)) (org-x-dag-headline-is-iterator-p))
(-some->> (org-x-dag-id->buffer-children key) (-some->> (org-x-dag-id->buffer-children key)
(org-x-dag-headline-get-project-status key tags) (org-x-dag-headline-get-project-status key tags)
@ -1977,7 +1978,7 @@ FUTURE-LIMIT in a list."
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; filter out incubators ;; filter out incubators
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (or (member org-x-tag-incubated tags) (unless (or (not (eq (cadr (org-x-dag-id->goal-status 'current key)) :planned))
(org-x-dag-headline-is-scheduled-p nil) (org-x-dag-headline-is-scheduled-p nil)
(org-x-dag-headline-is-deadlined-p nil)) (org-x-dag-headline-is-deadlined-p nil))
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key)))
@ -2012,22 +2013,20 @@ FUTURE-LIMIT in a list."
:ignore))) :ignore)))
(format-key (format-key
(category is-standalone key) (category is-standalone key)
(let ((tags (org-x-dag-id->tags nil key))) (-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key)))
;; filter out incubators (when (memq goal-status '(:planned :committed))
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (member org-x-tag-incubated tags)
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key)))
(p (alist-get s org-x-headline-task-status-priorities))) (p (alist-get s org-x-headline-task-status-priorities))
(tags (org-x-dag-id->tags nil key)))
(unless (= p -1) (unless (= p -1)
(-let (((&alist :non-survival :survival) ;; ASSUME only ids with at least one valid goal will get this
(->> (org-x-dag-id->linked-parents key) ;; far
(-group-by #'classify-parent))))
(unless (and survival (not non-survival))
(-> (org-x-dag-format-tag-node category tags key) (-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil (org-add-props nil
'x-is-standalone is-standalone 'x-is-standalone is-standalone
'x-status s) 'x-status s)
(org-x-dag--item-add-goal-ids non-survival))))))))))) (org-x-dag--item-add-goal-ids goal-ids)))))))))
(org-x-dag-with-files (org-x-get-action-files) (org-x-dag-with-files (org-x-get-action-files)
(org-x-dag-id->is-toplevel-p it) (org-x-dag-id->is-toplevel-p it)
(-if-let (project-tasks (org-x-dag-get-task-nodes (-if-let (project-tasks (org-x-dag-get-task-nodes
@ -2041,20 +2040,18 @@ FUTURE-LIMIT in a list."
(cl-flet (cl-flet
((format-key ((format-key
(category is-standalone key) (category is-standalone key)
(-when-let (goal-ids (->> (org-x-dag-id->linked-parents key) (-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key)))
(--filter (org-x-dag-id->is-goal-p :survival it)))) (when (eq goal-status :survival)
(let ((tags (org-x-dag-id->tags nil key)))
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (member org-x-tag-incubated tags)
(let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key))) (let* ((s (org-x-headline-get-task-status-0 (org-x-dag-id->todo key)))
(p (alist-get s org-x-headline-task-status-priorities))) (p (alist-get s org-x-headline-task-status-priorities))
(tags (org-x-dag-id->tags nil key)))
(unless (= p -1) (unless (= p -1)
(let ((item
(-> (org-x-dag-format-tag-node category tags key) (-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil (org-add-props nil
'x-is-standalone is-standalone 'x-is-standalone is-standalone
'x-status s)))) 'x-status s)
(--map (org-add-props item nil 'x-goal-id it) goal-ids)))))))))) (org-x-dag--item-add-goal-ids goal-ids)))))))))
(org-x-dag-with-files (org-x-dag->action-files) (org-x-dag-with-files (org-x-dag->action-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-with-id it (not (org-x-dag-with-id it
@ -2074,68 +2071,57 @@ FUTURE-LIMIT in a list."
(-let* (((&plist :key :status :tags) result) (-let* (((&plist :key :status :tags) result)
(priority (alist-get status org-x-project-status-priorities))) (priority (alist-get status org-x-project-status-priorities)))
(when (>= priority 0) (when (>= priority 0)
(-when-let (goal-ids (->> (org-x-dag-id->linked-parents key) (-let (((goal-ids goal-status) (org-x-dag-id->goal-status 'current key)))
(--filter (org-x-dag-id->is-goal-p :survival it)))) (when (eq goal-status :survival)
(org-x-dag-with-id key (org-x-dag-with-id key
(let ((item (-> (org-x-dag-format-tag-node cat tags key) (-> (org-x-dag-format-tag-node cat tags key)
(org-add-props nil (org-add-props nil
'x-toplevelp (org-x-dag-id->is-toplevel-p key) 'x-toplevelp (org-x-dag-id->is-toplevel-p key)
'x-status status 'x-status status
'x-priority priority)))) 'x-priority priority)
(--map (org-add-props item nil 'x-goal-id it) goal-ids))))))) (org-x-dag--item-add-goal-ids goal-ids))))))))
(format-key (format-key
(cat key) (cat key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
;; TODO don't hardcode these things ;; TODO don't hardcode these things
(org-x-dag-with-id key (org-x-dag-with-id key
(unless (member org-x-tag-incubated tags)
(-some->> (org-x-dag-id->buffer-children key) (-some->> (org-x-dag-id->buffer-children key)
(org-x-dag-headline-get-project-status key tags) (org-x-dag-headline-get-project-status key tags)
(--mapcat (format-result cat it)))))))) (--mapcat (format-result cat it)))))))
;; TODO this is hella-inefficient, just get the child links from the
;; survival goal file and start from there
(org-x-dag-with-files (org-x-dag->action-files) (org-x-dag-with-files (org-x-dag->action-files)
(and (org-x-dag-id->is-toplevel-p it) (and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-id->is-done-p it))) (not (org-x-dag-id->is-done-p it)))
(format-key it-category it)))) (format-key it-category it))))
;; (defun org-x-dag-scan-tasks-with-goals () ;; (defun org-x-dag-scan-incubated ()
;; (cl-flet ;; (cl-flet
;; ((split-parent-goals ;; ((format-key
;; (s) ;; (category key)
;; (let ((id (get-text-property 1 'x-id s))) ;; (let ((tags (org-x-dag-id->tags nil key)))
;; ;; ASSUME all foreign parents are actually goals ;; (when (member org-x-tag-incubated tags)
;; ;; TODO this isn't a great assumption ;; (org-x-dag-with-id key
;; (-if-let (goal-ids (org-x-dag-id->linked-parents id)) ;; (let* ((sch (org-x-dag-headline-is-scheduled-p t))
;; (--map (org-add-props s nil 'x-goal-id it) goal-ids) ;; (dead (org-x-dag-headline-is-deadlined-p t))
;; (list (org-add-props s nil 'x-goal-id nil)))))) ;; (is-project (org-x-dag-id->buffer-children key)))
;; (->> (org-x-dag-scan-tasks) ;; (-> (org-x-dag-format-tag-node category tags key)
;; (-mapcat #'split-parent-goals)))) ;; (org-add-props nil
;; 'x-project-p is-project
(defun org-x-dag-scan-incubated () ;; 'x-scheduled sch
(cl-flet ;; 'x-deadlined dead))))))))
((format-key ;; (org-x-dag-with-files (org-x-dag->action-files)
(category key) ;; (and (org-x-dag-id->is-toplevel-p it)
(let ((tags (org-x-dag-id->tags nil key))) ;; (not (org-x-dag-id->is-done-p it)))
(when (member org-x-tag-incubated tags) ;; (list (format-key it-category it)))))
(org-x-dag-with-id key
(let* ((sch (org-x-dag-headline-is-scheduled-p t))
(dead (org-x-dag-headline-is-deadlined-p t))
(is-project (org-x-dag-id->buffer-children key)))
(-> (org-x-dag-format-tag-node category tags key)
(org-add-props nil
'x-project-p is-project
'x-scheduled sch
'x-deadlined dead))))))))
(org-x-dag-with-files (org-x-dag->action-files)
(and (org-x-dag-id->is-toplevel-p it)
(not (org-x-dag-id->is-done-p it)))
(list (format-key it-category it)))))
(defun org-x-dag-scan-archived () (defun org-x-dag-scan-archived ()
(cl-flet (cl-flet
((format-key ((format-key
(category key) (category key)
(let ((tags (org-x-dag-id->tags nil key))) (let ((tags (org-x-dag-id->tags nil key)))
(unless (member org-x-tag-incubated tags) ;; TODO is this what I actually want?
(when (memq (cadr (org-x-dag-id->goal-status 'current key)) '(:planned :committed))
(org-x-dag-with-id key (org-x-dag-with-id key
(-let (((is-archivable is-project) (-let (((is-archivable is-project)
(-if-let (children (org-x-dag-id->buffer-children key)) (-if-let (children (org-x-dag-id->buffer-children key))
@ -2262,13 +2248,14 @@ FUTURE-LIMIT in a list."
(todayp sel-date cat id pts get-datetimes-fun format-datetime-fun) (todayp sel-date cat id pts get-datetimes-fun format-datetime-fun)
(-when-let (datetimes (funcall get-datetimes-fun sel-date pts)) (-when-let (datetimes (funcall get-datetimes-fun sel-date pts))
(let ((tags (org-x-dag-id->tags nil id))) (let ((tags (org-x-dag-id->tags nil id)))
(unless (member org-x-tag-incubated tags) ;; TODO this will show all tasks regardless of if they have a
;; goal/plan or not
(-let (((&plist :pos) pts) (-let (((&plist :pos) pts)
(donep (org-x-dag-id->is-done-p id))) (donep (org-x-dag-id->is-done-p id)))
(--> datetimes (--> datetimes
(--remove (and donep (not (org-x-dag-datetime= (-take 3 it) sel-date))) it) (--remove (and donep (not (org-x-dag-datetime= (-take 3 it) sel-date))) it)
(if (not todayp) (--remove (org-x-dag-datetime< (-take 3 it) sel-date) it) it) (if (not todayp) (--remove (org-x-dag-datetime< (-take 3 it) sel-date) it) it)
(--map (funcall format-datetime-fun sel-date pos it cat tags id) it))))))) (--map (funcall format-datetime-fun sel-date pos it cat tags id) it))))))
(format-id (format-id
(todayp cat id) (todayp cat id)
(org-x-dag-with-id id (org-x-dag-with-id id