generalized relation functions
This commit is contained in:
parent
17476fc0c1
commit
a2925e5549
82
conf.el
82
conf.el
|
@ -403,37 +403,44 @@ If it does not have a date, it will return nil."
|
||||||
keyword)))
|
keyword)))
|
||||||
|
|
||||||
(defun nd/is-project-p ()
|
(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 ()
|
(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 ()
|
(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 ()
|
(defun nd/is-periodical-heading-p ()
|
||||||
"return t if headline has property Project_Type=series"
|
(equal "periodical" (org-entry-get nil "PARENT_TYPE" t)))
|
||||||
(equal "series" (org-entry-get nil "Project_Type" t)))
|
|
||||||
|
|
||||||
(defun nd/heading-has-children ()
|
(defun nd/is-iterator-heading-p ()
|
||||||
"returns t if heading has todoitems in its immediate subtree"
|
(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
|
;; TODO make this more efficient (and accurate) by only testing
|
||||||
;; the level immediately below (if it exists)
|
;; the level immediately below (if it exists)
|
||||||
(let ((has-children)
|
(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
|
(save-excursion
|
||||||
|
(setq previous-point (point))
|
||||||
(outline-next-heading)
|
(outline-next-heading)
|
||||||
(while (and (not has-children)
|
(while (and (not has-children)
|
||||||
(< (point) subtree-end))
|
(< previous-point (point) subtree-end))
|
||||||
(when (nd/is-todoitem-p)
|
(when (funcall heading-test)
|
||||||
(setq has-children t))
|
(setq has-children t))
|
||||||
;; (org-forward-heading-same-level 1 t)))
|
(setq previous-point (point))
|
||||||
(outline-next-heading)))
|
(org-forward-heading-same-level 1 t)))
|
||||||
|
;; (outline-next-heading)))
|
||||||
has-children))
|
has-children))
|
||||||
|
|
||||||
(defun nd/heading-has-parent ()
|
(defun nd/heading-has-parent (heading-test)
|
||||||
"returns parent keyword if heading is in the immediate subtree of a todoitem"
|
"returns parent keyword if heading is in the immediate subtree of a heading
|
||||||
(save-excursion (and (org-up-heading-safe) (nd/is-todoitem-p))))
|
that evaluated to t with heading-test function"
|
||||||
|
(save-excursion (and (org-up-heading-safe) (funcall heading-test))))
|
||||||
|
|
||||||
(defun nd/has-discontinuous-parent ()
|
(defun nd/has-discontinuous-parent ()
|
||||||
"returns t if heading has a parent which is not a
|
"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)))
|
(let ((keyword (nd/is-todoitem-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(let ((cur-state
|
(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)
|
(cond ((member keyword nd/project-invalid-todostates) :invalid-todostate)
|
||||||
((nd/is-scheduled-heading-p) :scheduled-project)
|
((nd/is-scheduled-heading-p) :scheduled-project)
|
||||||
((equal keyword "CANC") (if (nd/is-archivable-heading-p)
|
((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")))))
|
(error "unknown statuscode")))))
|
||||||
|
|
||||||
;; helper functions
|
;; helper functions
|
||||||
(defun nd/skip-item ()
|
(defun nd/skip-heading ()
|
||||||
(save-excursion (or (outline-next-heading) (point-max))))
|
(save-excursion (or (outline-next-heading) (point-max))))
|
||||||
|
|
||||||
(defun nd/skip-subtree ()
|
(defun nd/skip-subtree ()
|
||||||
|
@ -622,7 +629,7 @@ test-fun return true"
|
||||||
(let ((keyword (,heading-fun)))
|
(let ((keyword (,heading-fun)))
|
||||||
(message keyword)
|
(message keyword)
|
||||||
(if (not (and keyword ,test-fun))
|
(if (not (and keyword ,test-fun))
|
||||||
(nd/skip-item)))))
|
(nd/skip-heading)))))
|
||||||
|
|
||||||
;; stale headings
|
;; stale headings
|
||||||
;; For archiving headings with old timestamps
|
;; For archiving headings with old timestamps
|
||||||
|
@ -640,9 +647,9 @@ test-fun return true"
|
||||||
(if (not
|
(if (not
|
||||||
(and (nd/is-stale-heading-p)
|
(and (nd/is-stale-heading-p)
|
||||||
(not (member keyword org-done-keywords))
|
(not (member keyword org-done-keywords))
|
||||||
(not (nd/heading-has-children))
|
(not (nd/heading-has-children 'nd/is-todoitem-p))
|
||||||
(not (nd/heading-has-parent))))
|
(not (nd/heading-has-parent 'nd/is-todoitem-p))))
|
||||||
(nd/skip-item)))))
|
(nd/skip-heading)))))
|
||||||
|
|
||||||
;; atomic tasks
|
;; atomic tasks
|
||||||
;; by definition these have no parents, so
|
;; by definition these have no parents, so
|
||||||
|
@ -683,19 +690,19 @@ test-fun return true"
|
||||||
(widen)
|
(widen)
|
||||||
(let ((keyword (nd/is-todoitem-p)))
|
(let ((keyword (nd/is-todoitem-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(if (nd/heading-has-children)
|
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||||||
(if (member keyword nd/project-skip-todostates)
|
(if (member keyword nd/project-skip-todostates)
|
||||||
(nd/skip-subtree)
|
(nd/skip-subtree)
|
||||||
(nd/skip-item))
|
(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-timestamped-heading-p))
|
||||||
(not (nd/is-scheduled-heading-p))
|
(not (nd/is-scheduled-heading-p))
|
||||||
(not (nd/is-deadlined-heading-p))
|
(not (nd/is-deadlined-heading-p))
|
||||||
(equal keyword skip-keyword)))
|
(equal keyword skip-keyword)))
|
||||||
(nd/skip-item)))
|
(nd/skip-heading)))
|
||||||
(nd/skip-item)))))
|
(nd/skip-heading)))))
|
||||||
|
|
||||||
;; task-level errors
|
;; header-level errors
|
||||||
(defun nd/skip-non-discontinuous-project-tasks ()
|
(defun nd/skip-non-discontinuous-project-tasks ()
|
||||||
(nd/skip-heading-with
|
(nd/skip-heading-with
|
||||||
nd/is-todoitem-p
|
nd/is-todoitem-p
|
||||||
|
@ -713,10 +720,17 @@ test-fun return true"
|
||||||
(and (not (member keyword org-done-keywords))
|
(and (not (member keyword org-done-keywords))
|
||||||
(nd/is-closed-heading-p))))
|
(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/skip-heading-with
|
||||||
nd/is-atomic-task-p
|
nd/is-atomic-task-p
|
||||||
(nd/is-series-heading-p)))
|
(nd/is-iterator-heading-p)))
|
||||||
|
|
||||||
;; projects
|
;; projects
|
||||||
(defun nd/skip-projects-without-statuscode (statuscode)
|
(defun nd/skip-projects-without-statuscode (statuscode)
|
||||||
|
@ -725,11 +739,11 @@ test-fun return true"
|
||||||
(let ((keyword (nd/is-project-p)))
|
(let ((keyword (nd/is-project-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(if (and nd/agenda-limit-project-toplevel
|
(if (and nd/agenda-limit-project-toplevel
|
||||||
(nd/heading-has-parent))
|
(nd/heading-has-parent 'nd/is-todoitem-p))
|
||||||
(nd/skip-subtree)
|
(nd/skip-subtree)
|
||||||
(if (not (nd/is-project-status-p statuscode))
|
(if (not (nd/is-project-status-p statuscode))
|
||||||
(nd/skip-item)))
|
(nd/skip-heading)))
|
||||||
(nd/skip-item)))))
|
(nd/skip-heading)))))
|
||||||
|
|
||||||
(defvar nd/agenda-limit-project-toplevel t
|
(defvar nd/agenda-limit-project-toplevel t
|
||||||
"used to filter projects by all levels or top-level only")
|
"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 "Active Series" :active)
|
||||||
,(nd/agenda-base-project-command series-view-match "Waiting Series" :waiting)
|
,(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-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"
|
("r"
|
||||||
"Refile and Critical Errors"
|
"Refile and Critical Errors"
|
||||||
((tags "REFILE"
|
((tags "REFILE"
|
||||||
|
|
43
conf.org
43
conf.org
|
@ -593,13 +593,13 @@ Doubles as a way to further test the todostate in downstream functions
|
||||||
keyword)))
|
keyword)))
|
||||||
|
|
||||||
(defun nd/is-project-p ()
|
(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 ()
|
(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 ()
|
(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
|
#+END_SRC
|
||||||
**** property testing
|
**** property testing
|
||||||
Returns t is heading matches a certian set of properties
|
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
|
**** relational testing
|
||||||
Returns t if heading has certain relationship to other headings
|
Returns t if heading has certain relationship to other headings
|
||||||
#+BEGIN_SRC emacs-lisp
|
#+BEGIN_SRC emacs-lisp
|
||||||
(defun nd/heading-has-children ()
|
(defun nd/heading-has-children (heading-test)
|
||||||
"returns t if heading has todoitems in its immediate subtree"
|
"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
|
;; TODO make this more efficient (and accurate) by only testing
|
||||||
;; the level immediately below (if it exists)
|
;; the level immediately below (if it exists)
|
||||||
(let ((has-children)
|
(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
|
(save-excursion
|
||||||
|
(setq previous-point (point))
|
||||||
(outline-next-heading)
|
(outline-next-heading)
|
||||||
(while (and (not has-children)
|
(while (and (not has-children)
|
||||||
(< (point) subtree-end))
|
(< previous-point (point) subtree-end))
|
||||||
(when (nd/is-todoitem-p)
|
(when (funcall heading-test)
|
||||||
(setq has-children t))
|
(setq has-children t))
|
||||||
;; (org-forward-heading-same-level 1 t)))
|
(setq previous-point (point))
|
||||||
(outline-next-heading)))
|
(org-forward-heading-same-level 1 t)))
|
||||||
|
;; (outline-next-heading)))
|
||||||
has-children))
|
has-children))
|
||||||
|
|
||||||
(defun nd/heading-has-parent ()
|
(defun nd/heading-has-parent (heading-test)
|
||||||
"returns parent keyword if heading is in the immediate subtree of a todoitem"
|
"returns parent keyword if heading is in the immediate subtree of a heading
|
||||||
(save-excursion (and (org-up-heading-safe) (nd/is-todoitem-p))))
|
that evaluated to t with heading-test function"
|
||||||
|
(save-excursion (and (org-up-heading-safe) (funcall heading-test))))
|
||||||
|
|
||||||
(defun nd/has-discontinuous-parent ()
|
(defun nd/has-discontinuous-parent ()
|
||||||
"returns t if heading has a parent which is not a
|
"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)))
|
(let ((keyword (nd/is-todoitem-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(let ((cur-state
|
(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)
|
(cond ((member keyword nd/project-invalid-todostates) :invalid-todostate)
|
||||||
((nd/is-scheduled-heading-p) :scheduled-project)
|
((nd/is-scheduled-heading-p) :scheduled-project)
|
||||||
((equal keyword "CANC") (if (nd/is-archivable-heading-p)
|
((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
|
(if (not
|
||||||
(and (nd/is-stale-heading-p)
|
(and (nd/is-stale-heading-p)
|
||||||
(not (member keyword org-done-keywords))
|
(not (member keyword org-done-keywords))
|
||||||
(not (nd/heading-has-children))
|
(not (nd/heading-has-children 'nd/is-todoitem-p))
|
||||||
(not (nd/heading-has-parent))))
|
(not (nd/heading-has-parent 'nd/is-todoitem-p))))
|
||||||
(nd/skip-heading)))))
|
(nd/skip-heading)))))
|
||||||
|
|
||||||
;; atomic tasks
|
;; atomic tasks
|
||||||
|
@ -887,11 +892,11 @@ tags in the custom commands section but I find this easier to maintain and possi
|
||||||
(widen)
|
(widen)
|
||||||
(let ((keyword (nd/is-todoitem-p)))
|
(let ((keyword (nd/is-todoitem-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(if (nd/heading-has-children)
|
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||||||
(if (member keyword nd/project-skip-todostates)
|
(if (member keyword nd/project-skip-todostates)
|
||||||
(nd/skip-subtree)
|
(nd/skip-subtree)
|
||||||
(nd/skip-heading))
|
(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-timestamped-heading-p))
|
||||||
(not (nd/is-scheduled-heading-p))
|
(not (nd/is-scheduled-heading-p))
|
||||||
(not (nd/is-deadlined-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)))
|
(let ((keyword (nd/is-project-p)))
|
||||||
(if keyword
|
(if keyword
|
||||||
(if (and nd/agenda-limit-project-toplevel
|
(if (and nd/agenda-limit-project-toplevel
|
||||||
(nd/heading-has-parent))
|
(nd/heading-has-parent 'nd/is-todoitem-p))
|
||||||
(nd/skip-subtree)
|
(nd/skip-subtree)
|
||||||
(if (not (nd/is-project-status-p statuscode))
|
(if (not (nd/is-project-status-p statuscode))
|
||||||
(nd/skip-heading)))
|
(nd/skip-heading)))
|
||||||
|
|
Loading…
Reference in New Issue