From 757c36fde96504ddecace3dd780e945c35140a11 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 5 Apr 2022 19:42:38 -0400 Subject: [PATCH] ADD incubator view --- local/lib/org-x/org-x-dag.el | 137 ++++++++++++++++++++++++++--------- 1 file changed, 102 insertions(+), 35 deletions(-) diff --git a/local/lib/org-x/org-x-dag.el b/local/lib/org-x/org-x-dag.el index 0688508..1c72e43 100644 --- a/local/lib/org-x/org-x-dag.el +++ b/local/lib/org-x/org-x-dag.el @@ -1853,7 +1853,7 @@ used for optimization." #'org-x-dag-bs-action-subiter (lambda (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) (if (org-x-dag-node-is-iterator-p (car tree)) @@ -2220,8 +2220,7 @@ used for optimization." ((propagate (adjlist htbl id to-set) (->> (-if-let (node (ht-get htbl id)) - (either<$> node - (funcall set-fun it to-set)) + (either<$> node (funcall set-fun it to-set)) (either :right (funcall def-fun to-set))) (ht-set htbl id)) (--each (org-x-dag-get-children adjlist id) @@ -2239,10 +2238,10 @@ used for optimization." (lambda (h id) (org-x-dag-ht-get-maybe h id s-key)) (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 (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) (cl-labels @@ -2299,7 +2298,10 @@ used for optimization." `(,committed ,(plist-get it :survivalp))))) (lambda (plist 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 (lambda (x) (append x committed)))))) (lambda (to-set) @@ -3311,30 +3313,65 @@ except it ignores inactive timestamps." (not (org-x-dag-id->is-done-p it))) (format-key it-category it)))) -;; (defun org-x-dag-scan-incubated () -;; (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-id->is-active-iterator-child-p (id) + (-> (org-x-dag-id->buffer-parent id) + (org-x-dag-id->bs) + (either-from-right nil) + (cadr) + (eq :iter-active))) + +(defun org-x-dag-scan-incubated () + (org-x-dag-with-action-ids + (-when-let (type (pcase (either-from-right (org-x-dag-id->bs it) nil) + (`(:sp-proj :proj-complete ,_) nil) + (`(:sp-task :task-complete ,_) nil) + (`(:sp-iter :iter-complete ,_) nil) + (`(:sp-subiter :si-complete ,_) nil) + (`(:sp-proj . ,_) :proj) + (`(:sp-task . ,_ ) :task) + (`(:sp-iter . ,_) :iter) + (`(:sp-subiter . ,_) :subiter))) + (-let (((&plist :committed c :planned p :survivalp s) + (-some-> (org-x-dag-id->ns it) + (either-from-right nil)))) + (when (not p) + (let ((tags (org-x-dag-id->tags nil 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 () (org-x-dag-with-action-ids @@ -3349,11 +3386,7 @@ except it ignores inactive timestamps." (org-x-dag-id->is-toplevel-p it)) (eq type :iter) (and (eq type :subiter) - (-> (org-x-dag-id->buffer-parent it) - (org-x-dag-id->bs) - (either-from-right nil) - (cadr) - (eq :iter-active))))) + (org-x-dag-id->is-active-iterator-child-p it)))) (-let ((epoch (plist-get comptime :epoch))) (when (org-x-dag-time-is-archivable-p epoch) (let ((tags (org-x-dag-id->tags nil it))) @@ -3951,5 +3984,39 @@ except it ignores inactive timestamps." ((and lc (not ac)) "Branch")))))) (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) ;;; org-x-dag.el ends here