FIX archive bugs

This commit is contained in:
Nathan Dwarshuis 2022-04-04 22:53:03 -04:00
parent 8b68d8a993
commit 9fb3bc7a18
1 changed files with 31 additions and 12 deletions

View File

@ -1499,7 +1499,9 @@ used for optimization."
;; rankings ;; rankings
;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete ;; *-active > proj-wait > proj-held > (proj-stuck == iter-empty) > *-complete
(org-x-dag-bs-action-with-closed node-data "projects" (org-x-dag-bs-action-with-closed node-data "projects"
`(:sp-proj :proj-complete ,it-comptime) (if child-bss
`(:sp-proj :proj-complete ,it-comptime)
`(:sp-task :task-complete ,it-comptime))
;; done form ;; done form
(org-x-dag-bs-fold-children child-bss `(:sp-task :task-complete ,it-comptime) (org-x-dag-bs-fold-children child-bss `(:sp-task :task-complete ,it-comptime)
@ -3324,6 +3326,11 @@ except it ignores inactive timestamps."
;; 'x-project-p is-project ;; 'x-project-p is-project
;; 'x-scheduled sch ;; 'x-scheduled sch
;; 'x-deadlined dead)))))))) ;; '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) ;; (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)))
@ -3331,17 +3338,29 @@ except it ignores inactive timestamps."
(defun org-x-dag-scan-archived () (defun org-x-dag-scan-archived ()
(org-x-dag-with-action-ids (org-x-dag-with-action-ids
(-when-let ((comptime is-project) (-let (((comptime type)
(pcase (either-from-right (org-x-dag-id->bs it) nil) (pcase (either-from-right (org-x-dag-id->bs it) nil)
(`(:sp-proj :proj-complete ,c) `(,c t)) (`(:sp-proj :proj-complete ,c) `(,c :proj))
(`(:sp-task :task-complete ,c) `(,c nil)))) (`(:sp-task :task-complete ,c) `(,c :task))
(-let ((epoch (plist-get comptime :epoch))) (`(:sp-iter :iter-complete ,c) `(,c :iter))
(when (org-x-dag-time-is-archivable-p epoch) (`(:sp-subiter :si-complete ,c) `(,c :subiter)))))
(let ((tags (org-x-dag-id->tags nil it))) (when (and comptime
(-> (org-x-dag-format-tag-node tags it) (or (and (memq type '(:proj :task))
(org-add-props nil (org-x-dag-id->is-toplevel-p it))
'x-project-p is-project) (eq type :iter)
(list)))))))) (and (eq type :subiter)
(-> (org-x-dag-id->buffer-parent it)
(org-x-dag-id->bs)
(either-from-right nil)
(cadr)
(eq :iter-active)))))
(-let ((epoch (plist-get comptime :epoch)))
(when (org-x-dag-time-is-archivable-p epoch)
(let ((tags (org-x-dag-id->tags nil it)))
(-> (org-x-dag-format-tag-node tags it)
(org-add-props nil
'x-type type)
(list)))))))))
(defun org-x-dag--classify-goal-link (which which-goal id) (defun org-x-dag--classify-goal-link (which which-goal id)
(let ((f (org-x-dag-id->file id))) (let ((f (org-x-dag-id->file id)))