diff --git a/conf.el b/conf.el index 7a96553..9ff0a28 100644 --- a/conf.el +++ b/conf.el @@ -403,37 +403,44 @@ If it does not have a date, it will return nil." keyword))) (defun nd/is-project-p () - (and (nd/heading-has-children) (nd/is-todoitem-p))) + (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) (defun nd/is-task-p () - (and (not (nd/heading-has-children)) (nd/is-todoitem-p))) + (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) (defun nd/is-atomic-task-p () - (and (not (nd/heading-has-parent)) (nd/is-task-p))) + (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) -(defun nd/is-series-heading-p () - "return t if headline has property Project_Type=series" - (equal "series" (org-entry-get nil "Project_Type" t))) +(defun nd/is-periodical-heading-p () + (equal "periodical" (org-entry-get nil "PARENT_TYPE" t))) -(defun nd/heading-has-children () - "returns t if heading has todoitems in its immediate subtree" +(defun nd/is-iterator-heading-p () + (equal "iterator" (org-entry-get nil "PARENT_TYPE" t))) + +(defun nd/heading-has-children (heading-test) + "returns t if heading has subheadings that return t when assessed with +heading-test function" ;; TODO make this more efficient (and accurate) by only testing ;; the level immediately below (if it exists) (let ((has-children) - (subtree-end (save-excursion (org-end-of-subtree t)))) + (subtree-end (save-excursion (org-end-of-subtree t))) + (previous-point)) (save-excursion + (setq previous-point (point)) (outline-next-heading) (while (and (not has-children) - (< (point) subtree-end)) - (when (nd/is-todoitem-p) + (< previous-point (point) subtree-end)) + (when (funcall heading-test) (setq has-children t)) -;; (org-forward-heading-same-level 1 t))) - (outline-next-heading))) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + ;; (outline-next-heading))) has-children)) -(defun nd/heading-has-parent () - "returns parent keyword if heading is in the immediate subtree of a todoitem" - (save-excursion (and (org-up-heading-safe) (nd/is-todoitem-p)))) +(defun nd/heading-has-parent (heading-test) + "returns parent keyword if heading is in the immediate subtree of a heading +that evaluated to t with heading-test function" + (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) (defun nd/has-discontinuous-parent () "returns t if heading has a parent which is not a @@ -500,7 +507,7 @@ down the list override higher items") (let ((keyword (nd/is-todoitem-p))) (if keyword (let ((cur-state - (if (nd/heading-has-children) + (if (nd/heading-has-children 'nd/is-todoitem-p) (cond ((member keyword nd/project-invalid-todostates) :invalid-todostate) ((nd/is-scheduled-heading-p) :scheduled-project) ((equal keyword "CANC") (if (nd/is-archivable-heading-p) @@ -598,7 +605,7 @@ Note that this assumes the headline being tested is a valid project" (error "unknown statuscode"))))) ;; helper functions -(defun nd/skip-item () +(defun nd/skip-heading () (save-excursion (or (outline-next-heading) (point-max)))) (defun nd/skip-subtree () @@ -622,7 +629,7 @@ test-fun return true" (let ((keyword (,heading-fun))) (message keyword) (if (not (and keyword ,test-fun)) - (nd/skip-item))))) + (nd/skip-heading))))) ;; stale headings ;; For archiving headings with old timestamps @@ -640,9 +647,9 @@ test-fun return true" (if (not (and (nd/is-stale-heading-p) (not (member keyword org-done-keywords)) - (not (nd/heading-has-children)) - (not (nd/heading-has-parent)))) - (nd/skip-item))))) + (not (nd/heading-has-children 'nd/is-todoitem-p)) + (not (nd/heading-has-parent 'nd/is-todoitem-p)))) + (nd/skip-heading))))) ;; atomic tasks ;; by definition these have no parents, so @@ -683,19 +690,19 @@ test-fun return true" (widen) (let ((keyword (nd/is-todoitem-p))) (if keyword - (if (nd/heading-has-children) + (if (nd/heading-has-children 'nd/is-todoitem-p) (if (member keyword nd/project-skip-todostates) (nd/skip-subtree) - (nd/skip-item)) - (if (not (and (nd/heading-has-parent) + (nd/skip-heading)) + (if (not (and (nd/heading-has-parent 'nd/is-todoitem-p) (not (nd/is-timestamped-heading-p)) (not (nd/is-scheduled-heading-p)) (not (nd/is-deadlined-heading-p)) (equal keyword skip-keyword))) - (nd/skip-item))) - (nd/skip-item))))) + (nd/skip-heading))) + (nd/skip-heading))))) -;; task-level errors +;; header-level errors (defun nd/skip-non-discontinuous-project-tasks () (nd/skip-heading-with nd/is-todoitem-p @@ -713,10 +720,17 @@ test-fun return true" (and (not (member keyword org-done-keywords)) (nd/is-closed-heading-p)))) -(defun nd/skip-non-series-atomic-tasks () +(defun nd/skip-non-untimestamped-periodical-headers () + (save-restriction + (widen) + (if (not (and (nd/is-periodical-p) + (not (nd/is-timestamped-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-iterator-atomic-tasks () (nd/skip-heading-with nd/is-atomic-task-p - (nd/is-series-heading-p))) + (nd/is-iterator-heading-p))) ;; projects (defun nd/skip-projects-without-statuscode (statuscode) @@ -725,11 +739,11 @@ test-fun return true" (let ((keyword (nd/is-project-p))) (if keyword (if (and nd/agenda-limit-project-toplevel - (nd/heading-has-parent)) + (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/skip-subtree) (if (not (nd/is-project-status-p statuscode)) - (nd/skip-item))) - (nd/skip-item))))) + (nd/skip-heading))) + (nd/skip-heading))))) (defvar nd/agenda-limit-project-toplevel t "used to filter projects by all levels or top-level only") @@ -792,7 +806,7 @@ test-fun return true" ,(nd/agenda-base-project-command series-view-match "Active Series" :active) ,(nd/agenda-base-project-command series-view-match "Waiting Series" :waiting) ,(nd/agenda-base-project-command series-view-match "Held Series" :held) - ,(nd/agenda-base-task-command series-view-match "Uninitialized Series" ''nd/skip-non-series-atomic-tasks))) + ,(nd/agenda-base-task-command series-view-match "Uninitialized Series" ''nd/skip-non-iterator-atomic-tasks))) ("r" "Refile and Critical Errors" ((tags "REFILE" diff --git a/conf.org b/conf.org index 82dd9fa..8b5cc5d 100644 --- a/conf.org +++ b/conf.org @@ -593,13 +593,13 @@ Doubles as a way to further test the todostate in downstream functions keyword))) (defun nd/is-project-p () - (and (nd/heading-has-children) (nd/is-todoitem-p))) + (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) (defun nd/is-task-p () - (and (not (nd/heading-has-children)) (nd/is-todoitem-p))) + (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) (defun nd/is-atomic-task-p () - (and (not (nd/heading-has-parent)) (nd/is-task-p))) + (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) #+END_SRC **** property testing Returns t is heading matches a certian set of properties @@ -613,25 +613,30 @@ Returns t is heading matches a certian set of properties **** relational testing Returns t if heading has certain relationship to other headings #+BEGIN_SRC emacs-lisp - (defun nd/heading-has-children () - "returns t if heading has todoitems in its immediate subtree" + (defun nd/heading-has-children (heading-test) + "returns t if heading has subheadings that return t when assessed with + heading-test function" ;; TODO make this more efficient (and accurate) by only testing ;; the level immediately below (if it exists) (let ((has-children) - (subtree-end (save-excursion (org-end-of-subtree t)))) + (subtree-end (save-excursion (org-end-of-subtree t))) + (previous-point)) (save-excursion + (setq previous-point (point)) (outline-next-heading) (while (and (not has-children) - (< (point) subtree-end)) - (when (nd/is-todoitem-p) + (< previous-point (point) subtree-end)) + (when (funcall heading-test) (setq has-children t)) - ;; (org-forward-heading-same-level 1 t))) - (outline-next-heading))) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + ;; (outline-next-heading))) has-children)) - (defun nd/heading-has-parent () - "returns parent keyword if heading is in the immediate subtree of a todoitem" - (save-excursion (and (org-up-heading-safe) (nd/is-todoitem-p)))) + (defun nd/heading-has-parent (heading-test) + "returns parent keyword if heading is in the immediate subtree of a heading + that evaluated to t with heading-test function" + (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) (defun nd/has-discontinuous-parent () "returns t if heading has a parent which is not a @@ -700,7 +705,7 @@ Returns t if heading has certain relationship to other headings (let ((keyword (nd/is-todoitem-p))) (if keyword (let ((cur-state - (if (nd/heading-has-children) + (if (nd/heading-has-children 'nd/is-todoitem-p) (cond ((member keyword nd/project-invalid-todostates) :invalid-todostate) ((nd/is-scheduled-heading-p) :scheduled-project) ((equal keyword "CANC") (if (nd/is-archivable-heading-p) @@ -844,8 +849,8 @@ tags in the custom commands section but I find this easier to maintain and possi (if (not (and (nd/is-stale-heading-p) (not (member keyword org-done-keywords)) - (not (nd/heading-has-children)) - (not (nd/heading-has-parent)))) + (not (nd/heading-has-children 'nd/is-todoitem-p)) + (not (nd/heading-has-parent 'nd/is-todoitem-p)))) (nd/skip-heading))))) ;; atomic tasks @@ -887,11 +892,11 @@ tags in the custom commands section but I find this easier to maintain and possi (widen) (let ((keyword (nd/is-todoitem-p))) (if keyword - (if (nd/heading-has-children) + (if (nd/heading-has-children 'nd/is-todoitem-p) (if (member keyword nd/project-skip-todostates) (nd/skip-subtree) (nd/skip-heading)) - (if (not (and (nd/heading-has-parent) + (if (not (and (nd/heading-has-parent 'nd/is-todoitem-p) (not (nd/is-timestamped-heading-p)) (not (nd/is-scheduled-heading-p)) (not (nd/is-deadlined-heading-p)) @@ -936,7 +941,7 @@ tags in the custom commands section but I find this easier to maintain and possi (let ((keyword (nd/is-project-p))) (if keyword (if (and nd/agenda-limit-project-toplevel - (nd/heading-has-parent)) + (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/skip-subtree) (if (not (nd/is-project-status-p statuscode)) (nd/skip-heading)))