ADD incubator view
This commit is contained in:
parent
9fb3bc7a18
commit
757c36fde9
|
@ -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
|
||||||
|
|
Loading…
Reference in New Issue