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

ADD incubator view

This commit is contained in:
Nathan Dwarshuis 2022-04-05 19:42:38 -04:00
parent 9fb3bc7a18
commit 757c36fde9
1 changed files with 102 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -1853,7 +1853,7 @@ used for optimization."
#'org-x-dag-bs-action-subiter #'org-x-dag-bs-action-subiter
(lambda (node-data child-bss) (lambda (node-data child-bss)
(either<$> (org-x-dag-bs-action-iter-inner node-data child-bss) (either<$> (org-x-dag-bs-action-iter-inner node-data child-bss)
(cons :sp-proj it))))) (cons :sp-iter it)))))
(defun org-x-dag-bs-action-project (tree) (defun org-x-dag-bs-action-project (tree)
(if (org-x-dag-node-is-iterator-p (car tree)) (if (org-x-dag-node-is-iterator-p (car tree))
@ -2220,8 +2220,7 @@ used for optimization."
((propagate ((propagate
(adjlist htbl id to-set) (adjlist htbl id to-set)
(->> (-if-let (node (ht-get htbl id)) (->> (-if-let (node (ht-get htbl id))
(either<$> node (either<$> node (funcall set-fun it to-set))
(funcall set-fun it to-set))
(either :right (funcall def-fun to-set))) (either :right (funcall def-fun to-set)))
(ht-set htbl id)) (ht-set htbl id))
(--each (org-x-dag-get-children adjlist id) (--each (org-x-dag-get-children adjlist id)
@ -2239,10 +2238,10 @@ used for optimization."
(lambda (h id) (lambda (h id)
(org-x-dag-ht-get-maybe h id s-key)) (org-x-dag-ht-get-maybe h id s-key))
(lambda (plist to-set) (lambda (plist to-set)
(org-x-dag-plist-map plist s-key (org-x-dag-plist-map (-copy plist) s-key
(lambda (x) (append x to-set)))) (lambda (x) (append x to-set))))
(lambda (to-set) (lambda (to-set)
(list s-key to-set)))) (list s-key (-copy to-set)))))
(defun org-x-dag-ht-propagate-up (adjlist h-key s-key ns) (defun org-x-dag-ht-propagate-up (adjlist h-key s-key ns)
(cl-labels (cl-labels
@ -2299,7 +2298,10 @@ used for optimization."
`(,committed ,(plist-get it :survivalp))))) `(,committed ,(plist-get it :survivalp)))))
(lambda (plist to-set) (lambda (plist to-set)
(-let (((committed survivalp) to-set)) (-let (((committed survivalp) to-set))
(-> (plist-put plist :survivalp survivalp) ;; copy is needed here for some reason, otherwise other parts of the
;; hash table are affected
(-> (-copy plist)
(plist-put :survivalp survivalp)
(org-x-dag-plist-map :committed (org-x-dag-plist-map :committed
(lambda (x) (append x committed)))))) (lambda (x) (append x committed))))))
(lambda (to-set) (lambda (to-set)
@ -3311,30 +3313,65 @@ except it ignores inactive timestamps."
(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-incubated () (defun org-x-dag-id->is-active-iterator-child-p (id)
;; (cl-flet (-> (org-x-dag-id->buffer-parent id)
;; ((format-key (org-x-dag-id->bs)
;; (category key) (either-from-right nil)
;; (let ((tags (org-x-dag-id->tags nil key))) (cadr)
;; (when (member org-x-tag-incubated tags) (eq :iter-active)))
;; (org-x-dag-with-id key
;; (let* ((sch (org-x-dag-headline-is-scheduled-p t)) (defun org-x-dag-scan-incubated ()
;; (dead (org-x-dag-headline-is-deadlined-p t)) (org-x-dag-with-action-ids
;; (is-project (org-x-dag-id->buffer-children key))) (-when-let (type (pcase (either-from-right (org-x-dag-id->bs it) nil)
;; (-> (org-x-dag-format-tag-node category tags key) (`(:sp-proj :proj-complete ,_) nil)
;; (org-add-props nil (`(:sp-task :task-complete ,_) nil)
;; 'x-project-p is-project (`(:sp-iter :iter-complete ,_) nil)
;; 'x-scheduled sch (`(:sp-subiter :si-complete ,_) nil)
;; 'x-deadlined dead)))))))) (`(:sp-proj . ,_) :proj)
;; (org-x-dag-with-action-ids (`(:sp-task . ,_ ) :task)
;; (-when-let ((comptime is-project) (`(:sp-iter . ,_) :iter)
;; (pcase (either-from-right (org-x-dag-id->bs it) nil) (`(:sp-subiter . ,_) :subiter)))
;; (`(:sp-proj :proj-complete ,c) `(,c t)) (-let (((&plist :committed c :planned p :survivalp s)
;; (`(:sp-task :task-complete ,c) `(,c nil)))) (-some-> (org-x-dag-id->ns it)
;; (org-x-dag-with-files (org-x-dag->action-files) (either-from-right nil))))
;; (and (org-x-dag-id->is-toplevel-p it) (when (not p)
;; (not (org-x-dag-id->is-done-p it))) (let ((tags (org-x-dag-id->tags nil it))
;; (list (format-key it-category it))))) (toplevelp (pcase type
((or :proj :task)
(org-x-dag-id->is-toplevel-p it))
(:subiter
(org-x-dag-id->is-active-iterator-child-p it)))))
(-> (org-x-dag-format-tag-node tags it)
(org-add-props nil
'x-type type
'x-toplevelp toplevelp
'x-survivalp s
'x-committedp (and c t))
(list))))))))
;; (cl-flet
;; ((format-key
;; (category key)
;; (let ((tags (org-x-dag-id->tags nil key)))
;; (when (member org-x-tag-incubated tags)
;; (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-action-ids
;; (-when-let ((comptime is-project)
;; (pcase (either-from-right (org-x-dag-id->bs it) nil)
;; (`(:sp-proj :proj-complete ,c) `(,c t))
;; (`(:sp-task :task-complete ,c) `(,c nil))))
;; (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 ()
(org-x-dag-with-action-ids (org-x-dag-with-action-ids
@ -3349,11 +3386,7 @@ except it ignores inactive timestamps."
(org-x-dag-id->is-toplevel-p it)) (org-x-dag-id->is-toplevel-p it))
(eq type :iter) (eq type :iter)
(and (eq type :subiter) (and (eq type :subiter)
(-> (org-x-dag-id->buffer-parent it) (org-x-dag-id->is-active-iterator-child-p it))))
(org-x-dag-id->bs)
(either-from-right nil)
(cadr)
(eq :iter-active)))))
(-let ((epoch (plist-get comptime :epoch))) (-let ((epoch (plist-get comptime :epoch)))
(when (org-x-dag-time-is-archivable-p epoch) (when (org-x-dag-time-is-archivable-p epoch)
(let ((tags (org-x-dag-id->tags nil it))) (let ((tags (org-x-dag-id->tags nil it)))
@ -3951,5 +3984,39 @@ except it ignores inactive timestamps."
((and lc (not ac)) "Branch")))))) ((and lc (not ac)) "Branch"))))))
(if subtext (format "%s (%s)" type subtext) type)))))))))) (if subtext (format "%s (%s)" type subtext) type))))))))))
(defun org-x-dag-agenda-incubated ()
(interactive)
(let ((match ''org-x-dag-scan-incubated))
(nd/org-agenda-call "Incubated-0" nil #'org-x-dag-show-nodes match nil
`((org-agenda-sorting-strategy '(user-defined-up category-keep))
(org-super-agenda-groups
'((:auto-map
(lambda (line)
(-let* ((type (get-text-property 1 'x-type line))
(toplevelp (get-text-property 1 'x-toplevelp line))
(survivalp (get-text-property 1 'x-survivalp line))
(committedp (get-text-property 1 'x-committedp line))
((rank type)
(pcase type
(:task
(if toplevelp '(1 "Standalone Task")
'(2 "Task")))
(:proj
(if toplevelp '(3 "Toplevel Project")
'(4 "Project")))
(:iter
'(5 "Iterator"))
(:subiter
(if toplevelp '(6 "Parent Subiterator")
'(7 "Subiterator")))))
((srank stype) (cond
((and committedp survivalp)
'(1 "Survival"))
(committedp
'(2 "Non-Survival"))
(t
'(3 "Uncommitted")))))
(format "%d.%d %s (%s)" srank rank type stype))))))))))
(provide 'org-x-dag) (provide 'org-x-dag)
;;; org-x-dag.el ends here ;;; org-x-dag.el ends here