diff --git a/conf.el b/conf.el index edee8df..c42fce5 100644 --- a/conf.el +++ b/conf.el @@ -475,25 +475,32 @@ and retrieve the keyword" ;; org-forward-heading-same-level ;; project level testing +(defun nd/test-first-order-project () + "tests the state of a project assuming first order. +if not first order, this function will iterate to the next project +and descend into it by calling itelf recursively. +function is not meant to be called independently." + (let ((found-active) + (previous-point)) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not found-active) + (> (point) previous-point)) + (when (or (and (nd/is-project-p) + (nd/test-first-order-project)) + (nd/is-active-task-p)) + (setq found-active t)) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + found-active)) + (defun nd/is-active-project-p () "return keyword if project has at least one active task or project" (let ((keyword (nd/is-project-p))) (if keyword - (let ((found-active) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (outline-next-heading) - (while (and (not found-active) - (< (point) subtree-end)) - (when (or (nd/is-active-project-p) (nd/is-active-task-p)) - (setq found-active t)) - ;; TODO; this is not very efficient as we test for project twice - (if (nd/is-project-p) - (org-forward-heading-same-level 1 t) - (outline-next-heading)))) - (and found-active - keyword))))) + (nd/test-first-order-project)))) ;; task skip functions (defun nd/skip-non-atomic-tasks () diff --git a/conf.org b/conf.org index 03fc3af..a205172 100644 --- a/conf.org +++ b/conf.org @@ -592,7 +592,7 @@ TODO: add meeting template as scheduled+action item thing (setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function) #+END_SRC -*** COMMENT filtering functions +*** filtering functions some definitions: - todoitem: heading with todo state - task: todo heading with no todo headings beneath it @@ -668,25 +668,32 @@ some definitions: ;; org-forward-heading-same-level ;; project level testing + (defun nd/test-first-order-project () + "tests the state of a project assuming first order. + if not first order, this function will iterate to the next project + and descend into it by calling itelf recursively. + function is not meant to be called independently." + (let ((found-active) + (previous-point)) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not found-active) + (> (point) previous-point)) + (when (or (and (nd/is-project-p) + (nd/test-first-order-project)) + (nd/is-active-task-p)) + (setq found-active t)) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + found-active)) + (defun nd/is-active-project-p () "return keyword if project has at least one active task or project" (let ((keyword (nd/is-project-p))) (if keyword - (let ((found-active) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (outline-next-heading) - (while (and (not found-active) - (< (point) subtree-end)) - (when (or (nd/is-active-project-p) (nd/is-active-task-p)) - (setq found-active t)) - ;; TODO; this is not very efficient as we test for project twice - (if (nd/is-project-p) - (org-forward-heading-same-level 1 t) - (outline-next-heading)))) - (and found-active - keyword))))) + (nd/test-first-order-project)))) ;; task skip functions (defun nd/skip-non-atomic-tasks ()