ndwarshuis
/
emacs-config
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

clean up old project code

This commit is contained in:
petrucci4prez 2018-06-26 20:23:45 -04:00
parent 0b3d02efad
commit ec131bc5b5
2 changed files with 72 additions and 453 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

270
conf.el
View File

@ -603,107 +603,10 @@ todoitem which in turn has a parent which is a todoitem"
'("WAIT" "NEXT") '("WAIT" "NEXT")
"projects cannot have these todostates") "projects cannot have these todostates")
(defconst nd/project-statuscodes (defmacro nd/compare-statuscodes (op sc1 sc2 sc-list)
'(:archivable
:complete
:stuck
:held
:waiting
:active
:done-incomplete
:undone-complete
:invalid-todostate
:scheduled-project)
"list of statuscodes to be used in assessing projects
Note they are listed in order of priority (eg items further
down the list override higher items")
(defconst nd/complete-statuscodes
'(:archivable
:complete))
(defconst nd/todo-statuscodes
'(:stuck
:held
:waiting
:active))
(defconst nd/error-statuscodes
'(:done-incomplete
:undone-complete
:invalid-todostate
:scheduled-project))
(defmacro nd/compare-statuscodes0 (op sc1 sc2 sc-list)
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
(defmacro nd/compare-statuscodes (operator statuscode-1 statuscode-2) (defun nd/decend-into-project (allowed-statuscodes trans-tbl get-task-status)
"syntactic suger to compare statuscodes by position"
`(,operator (position ,statuscode-1 nd/project-statuscodes)
(position ,statuscode-2 nd/project-statuscodes)))
(defun nd/status< (statuscode-1 statuscode-2)
"returns t is statuscode-1 is lesser priority than statuscode-2"
(nd/compare-statuscodes < statuscode-1 statuscode-2))
(defun nd/status> (statuscode-1 statuscode-2)
"returns t is statuscode-1 is greater priority than statuscode-2"
(nd/compare-statuscodes > statuscode-1 statuscode-2))
(defun nd/status= (statuscode-1 statuscode-2)
"returns t is statuscode-1 is equal priority than statuscode-2"
(nd/compare-statuscodes = statuscode-1 statuscode-2))
(defun nd/descend-into-project ()
"returns statuscode of project and recursively descends into subprojects"
(let ((project-state :archivable)
(previous-point))
(save-excursion
(setq previous-point (point))
(outline-next-heading)
;; loop breaks if active or higher priority
;; note that all invalid statuscodes are higher
;; thus this function will only return the first
;; encountered error
(while (and (nd/status< project-state :active)
(> (point) previous-point))
(let ((keyword (nd/is-todoitem-p)))
(if keyword
(let ((cur-state
(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)
:archivable
:complete))
((equal keyword "HOLD") :held)
(t (let ((child-statuscode (nd/descend-into-project)))
(cond ((equal keyword "TODO")
(if (nd/status> child-statuscode :complete)
child-statuscode
:undone-complete))
(t (case child-statuscode
(:complete :complete)
(:archivable (if (nd/is-archivable-heading-p)
:archivable
:complete))
(t (if (nd/status= child-statuscode :complete)
:complete
:done-incomplete))))))))
(cond ((equal keyword "HOLD") :held)
((equal keyword "WAIT") :waiting)
((equal keyword "NEXT") :active)
((and (equal keyword "TODO") (nd/is-scheduled-heading-p)) :active)
((equal keyword "TODO") :stuck)
((nd/is-archivable-heading-p) :archivable)
(t :complete)))))
(if (nd/status> cur-state project-state)
(setq project-state cur-state)))))
(setq previous-point (point))
(org-forward-heading-same-level 1 t)))
project-state))
(defun nd/decend-into-project0 (allowed-statuscodes trans-tbl get-task-status)
(let ((project-status (first allowed-statuscodes)) (let ((project-status (first allowed-statuscodes))
(breaker-status (car (last allowed-statuscodes))) (breaker-status (car (last allowed-statuscodes)))
(previous-point)) (previous-point))
@ -736,7 +639,7 @@ down the list override higher items")
;; (message (format "%s" (concat "new status: " (symbol-name new-status)))) ;; (message (format "%s" (concat "new status: " (symbol-name new-status))))
;; (message (format "%s" (concat "project status: " (symbol-name project-status)))) ;; (message (format "%s" (concat "project status: " (symbol-name project-status))))
;; (message (format "%s" keyword)) ;; (message (format "%s" keyword))
(if (nd/compare-statuscodes0 > new-status project-status allowed-statuscodes) (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes)
(setq project-status new-status))))) (setq project-status new-status)))))
(setq previous-point (point)) (setq previous-point (point))
(org-forward-heading-same-level 1 t))) (org-forward-heading-same-level 1 t)))
@ -754,7 +657,7 @@ down the list override higher items")
;; these require descending into the project subtasks ;; these require descending into the project subtasks
((equal keyword "CANC") ((equal keyword "CANC")
(nd/decend-into-project0 (nd/decend-into-project
'(:archivable :complete) '(:archivable :complete)
'((:stuck . 1) '((:stuck . 1)
(:held . 1) (:held . 1)
@ -769,7 +672,7 @@ down the list override higher items")
(nd/is-archivable-heading-p)) 0 1)))) (nd/is-archivable-heading-p)) 0 1))))
((equal keyword "DONE") ((equal keyword "DONE")
(nd/decend-into-project0 (nd/decend-into-project
'(:archivable :complete :done-incomplete) '(:archivable :complete :done-incomplete)
'((:stuck . 2) '((:stuck . 2)
(:held . 2) (:held . 2)
@ -784,7 +687,7 @@ down the list override higher items")
2)))) 2))))
((equal keyword "TODO") ((equal keyword "TODO")
(nd/decend-into-project0 (nd/decend-into-project
'(:undone-complete :stuck :held :waiting :active) '(:undone-complete :stuck :held :waiting :active)
'((:complete . 0) '((:complete . 0)
(:archivable . 0) (:archivable . 0)
@ -792,79 +695,14 @@ down the list override higher items")
(:invalid-todostate . 1) (:invalid-todostate . 1)
(:done-incomplete . 1)) (:done-incomplete . 1))
(lambda (k) (lambda (k)
(cond ((equal k "TODO") 1) (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1))
((equal k "HOLD") 2) ((equal k "HOLD") 2)
((equal k "WAIT") 3) ((equal k "WAIT") 3)
((equal k "NEXT") 4) ((equal k "NEXT") 4)
((and (equal k "TODO") (nd/is-scheduled-heading-p)) 4)
(t 0))))) (t 0)))))
(t (error (concat "invalid keyword detected: " keyword)))))) (t (error (concat "invalid keyword detected: " keyword))))))
(defmacro nd/is-project-keyword-status-p (test-keyword operator statuscode)
"tests if a project has toplevel heading of top-keyword and
child status equal to status code and returns keyword if
both are true"
`(and
(equal ,keyword ,test-keyword)
(nd/compare-statuscodes ,operator (nd/descend-into-project) ,statuscode)))
(defun nd/is-project-status-p (statuscode)
"Returns t if project matches statuscode given.
Note that this assumes the headline being tested is a valid project"
(case statuscode
;; projects closed more than 30 days ago
;; note CANC overrides all subtasks/projects
(:archivable
(if (nd/is-archivable-heading-p)
(or (equal keyword "CANC")
(nd/is-project-keyword-status-p "DONE" = :archivable))))
;; projects closed less than 30 days ago
;; note CANC overrides all subtasks/projects
(:complete
(if (not (nd/is-archivable-heading-p))
(or (equal keyword "CANC")
(nd/is-project-keyword-status-p "DONE" = :complete))))
;; projects with no waiting, held, or active components
(:stuck
(nd/is-project-keyword-status-p "TODO" = :stuck))
;; held projects
;; note toplevel HOLD overrides all subtasks/projects
(:held
(or (equal keyword "HOLD")
(nd/is-project-keyword-status-p "TODO" = :held)))
;; projects with at least one waiting component
(:waiting
(nd/is-project-keyword-status-p "TODO" = :waiting))
;; projects with at least one active component
(:active
(nd/is-project-keyword-status-p "TODO" = :active))
;; projects marked DONE but still have undone subtasks
(:done-incomplete
(nd/is-project-keyword-status-p "DONE" > :complete))
;; projects marked TODO but all subtasks are done
(:undone-complete
(nd/is-project-keyword-status-p "TODO" < :stuck))
;; projects with invalid todo keywords
(:invalid-todostate
(member keyword nd/project-invalid-todostates))
;; projects with scheduled heading (only subtasks should be scheduled)
(:scheduled-project
(nd/is-scheduled-heading-p))
;; error if not known
(t (if (not (member statuscode nd/project-statuscodes))
(error "unknown statuscode")))))
(defconst nd/iter-future-time (* 7 24 60 60)) (defconst nd/iter-future-time (* 7 24 60 60))
(defconst nd/iter-statuscodes '(:uninit :empty :active)) (defconst nd/iter-statuscodes '(:uninit :empty :active))
@ -888,7 +726,7 @@ Note that this assumes the headline being tested is a valid project"
nd/iter-future-time t) nd/iter-future-time t)
:active :active
:empty)) :empty))
(if (nd/compare-statuscodes0 > new-status iter-status nd/iter-statuscodes) (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes)
(setq iter-status new-status))))) (setq iter-status new-status)))))
(outline-next-heading))) (outline-next-heading)))
iter-status)) iter-status))
@ -1054,18 +892,6 @@ tags that do not have tags in neg-tags-list"
nd/is-task-p nd/is-task-p
(not (nd/heading-has-effort-p)))) (not (nd/heading-has-effort-p))))
(defun nd/skip-projects-without-statuscode (statuscode)
(save-restriction
(widen)
(let ((keyword (nd/is-project-p)))
(if keyword
(if (and nd/agenda-limit-project-toplevel
(nd/heading-has-parent 'nd/is-todoitem-p))
(nd/skip-subtree)
(if (not (nd/is-project-status-p statuscode))
(nd/skip-heading)))
(nd/skip-heading)))))
(defun nd/skip-non-projects () (defun nd/skip-non-projects ()
(save-restriction (save-restriction
(widen) (widen)
@ -1175,17 +1001,6 @@ set as a text property for further sorting"
(org-agenda-todo-ignore-with-date t) (org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy ,sort)))) (org-agenda-sorting-strategy ,sort))))
(defun nd/agenda-base-proj-cmd (match header statuscode)
`(tags-todo
,match
((org-agenda-overriding-header
(concat (and nd/agenda-limit-project-toplevel "Toplevel ") ,header))
(org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode))
;;(org-agenda-before-sorting-filter-function 'nd/sorting-filter-demo)
;; (nd/apply-statuscodes t)
;; (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(category-keep)))))
(let* ((actionable "-NA-REFILE-%inc") (let* ((actionable "-NA-REFILE-%inc")
(periodical "PARENT_TYPE=\"periodical\"") (periodical "PARENT_TYPE=\"periodical\"")
(iterator "PARENT_TYPE=\"iterator\"") (iterator "PARENT_TYPE=\"iterator\"")
@ -1217,27 +1032,21 @@ set as a text property for further sorting"
"Projects")) "Projects"))
(org-agenda-skip-function '(nd/skip-non-projects)) (org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function (org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:stuck :waiting :held :active) 'nd/get-project-status l))) (lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
(org-agenda-cmp-user-defined (org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b))) (lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")"))) (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))) (org-agenda-sorting-strategy '(user-defined-down category-keep))))))
;; ("p"
;; "Project View"
;; (,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Stuck Projects"
;; :stuck)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Waiting Projects"
;; :waiting)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Active Projects"
;; :active)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Held Projects"
;; :held)))
("P" ("P"
"Periodical View" "Periodical View"
(,(nd/agenda-base-header-cmd peri-match (,(nd/agenda-base-header-cmd peri-match
@ -1282,9 +1091,18 @@ set as a text property for further sorting"
"Incubated Projects")) "Incubated Projects"))
(org-agenda-skip-function '(nd/skip-non-projects)) (org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function (org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:stuck :waiting :held :active) 'nd/get-project-status l))) (lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
(org-agenda-cmp-user-defined (org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b))) (lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:active :held)
a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")"))) (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))) (org-agenda-sorting-strategy '(user-defined-down category-keep))))))
@ -1295,29 +1113,13 @@ set as a text property for further sorting"
(org-tags-match-list-sublevels nil)) (org-tags-match-list-sublevels nil))
,(nd/agenda-base-task-cmd task-match ,(nd/agenda-base-task-cmd task-match
"Discontinous Project" "Discontinous Project"
''nd/skip-non-discontinuous-project-tasks))) ''nd/skip-non-discontinuous-project-tasks)
,(nd/agenda-base-header-cmd task-match
("e"
"Non-critical Errors"
(,(nd/agenda-base-header-cmd task-match
"Undone Closed" "Undone Closed"
''nd/skip-non-undone-closed-todoitems) ''nd/skip-non-undone-closed-todoitems)
,(nd/agenda-base-header-cmd (concat actionable "-" periodical) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Done Unclosed" "Done Unclosed"
''nd/skip-non-done-unclosed-todoitems) ''nd/skip-non-done-unclosed-todoitems)))
(tags-todo
,act-no-rep-match
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Project Errors"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) 'nd/get-project-status l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
("A" ("A"
"Archivable Tasks and Projects" "Archivable Tasks and Projects"
@ -1327,9 +1129,9 @@ set as a text property for further sorting"
,(nd/agenda-base-header-cmd (concat actionable "-" periodical) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Stale Tasks" "Stale Tasks"
''nd/skip-non-stale-headings) ''nd/skip-non-stale-headings)
,(nd/agenda-base-proj-cmd (concat actionable "-" periodical "+" iterator) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical "+" iterator)
"Archivable Iterators" "Archivable Iterators"
:archivable) ''nd/skip-non-archivable-atomic-tasks)
(tags-todo (tags-todo
,(concat actionable "-" periodical "-" iterator) ,(concat actionable "-" periodical "-" iterator)
((org-agenda-overriding-header ((org-agenda-overriding-header

255
conf.org
View File

@ -832,107 +832,10 @@ Returns t if heading has certain relationship to other headings
'("WAIT" "NEXT") '("WAIT" "NEXT")
"projects cannot have these todostates") "projects cannot have these todostates")
(defconst nd/project-statuscodes (defmacro nd/compare-statuscodes (op sc1 sc2 sc-list)
'(:archivable
:complete
:stuck
:held
:waiting
:active
:done-incomplete
:undone-complete
:invalid-todostate
:scheduled-project)
"list of statuscodes to be used in assessing projects
Note they are listed in order of priority (eg items further
down the list override higher items")
(defconst nd/complete-statuscodes
'(:archivable
:complete))
(defconst nd/todo-statuscodes
'(:stuck
:held
:waiting
:active))
(defconst nd/error-statuscodes
'(:done-incomplete
:undone-complete
:invalid-todostate
:scheduled-project))
(defmacro nd/compare-statuscodes0 (op sc1 sc2 sc-list)
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
(defmacro nd/compare-statuscodes (operator statuscode-1 statuscode-2) (defun nd/decend-into-project (allowed-statuscodes trans-tbl get-task-status)
"syntactic suger to compare statuscodes by position"
`(,operator (position ,statuscode-1 nd/project-statuscodes)
(position ,statuscode-2 nd/project-statuscodes)))
(defun nd/status< (statuscode-1 statuscode-2)
"returns t is statuscode-1 is lesser priority than statuscode-2"
(nd/compare-statuscodes < statuscode-1 statuscode-2))
(defun nd/status> (statuscode-1 statuscode-2)
"returns t is statuscode-1 is greater priority than statuscode-2"
(nd/compare-statuscodes > statuscode-1 statuscode-2))
(defun nd/status= (statuscode-1 statuscode-2)
"returns t is statuscode-1 is equal priority than statuscode-2"
(nd/compare-statuscodes = statuscode-1 statuscode-2))
(defun nd/descend-into-project ()
"returns statuscode of project and recursively descends into subprojects"
(let ((project-state :archivable)
(previous-point))
(save-excursion
(setq previous-point (point))
(outline-next-heading)
;; loop breaks if active or higher priority
;; note that all invalid statuscodes are higher
;; thus this function will only return the first
;; encountered error
(while (and (nd/status< project-state :active)
(> (point) previous-point))
(let ((keyword (nd/is-todoitem-p)))
(if keyword
(let ((cur-state
(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)
:archivable
:complete))
((equal keyword "HOLD") :held)
(t (let ((child-statuscode (nd/descend-into-project)))
(cond ((equal keyword "TODO")
(if (nd/status> child-statuscode :complete)
child-statuscode
:undone-complete))
(t (case child-statuscode
(:complete :complete)
(:archivable (if (nd/is-archivable-heading-p)
:archivable
:complete))
(t (if (nd/status= child-statuscode :complete)
:complete
:done-incomplete))))))))
(cond ((equal keyword "HOLD") :held)
((equal keyword "WAIT") :waiting)
((equal keyword "NEXT") :active)
((and (equal keyword "TODO") (nd/is-scheduled-heading-p)) :active)
((equal keyword "TODO") :stuck)
((nd/is-archivable-heading-p) :archivable)
(t :complete)))))
(if (nd/status> cur-state project-state)
(setq project-state cur-state)))))
(setq previous-point (point))
(org-forward-heading-same-level 1 t)))
project-state))
(defun nd/decend-into-project0 (allowed-statuscodes trans-tbl get-task-status)
(let ((project-status (first allowed-statuscodes)) (let ((project-status (first allowed-statuscodes))
(breaker-status (car (last allowed-statuscodes))) (breaker-status (car (last allowed-statuscodes)))
(previous-point)) (previous-point))
@ -965,7 +868,7 @@ down the list override higher items")
;; (message (format "%s" (concat "new status: " (symbol-name new-status)))) ;; (message (format "%s" (concat "new status: " (symbol-name new-status))))
;; (message (format "%s" (concat "project status: " (symbol-name project-status)))) ;; (message (format "%s" (concat "project status: " (symbol-name project-status))))
;; (message (format "%s" keyword)) ;; (message (format "%s" keyword))
(if (nd/compare-statuscodes0 > new-status project-status allowed-statuscodes) (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes)
(setq project-status new-status))))) (setq project-status new-status)))))
(setq previous-point (point)) (setq previous-point (point))
(org-forward-heading-same-level 1 t))) (org-forward-heading-same-level 1 t)))
@ -983,7 +886,7 @@ down the list override higher items")
;; these require descending into the project subtasks ;; these require descending into the project subtasks
((equal keyword "CANC") ((equal keyword "CANC")
(nd/decend-into-project0 (nd/decend-into-project
'(:archivable :complete) '(:archivable :complete)
'((:stuck . 1) '((:stuck . 1)
(:held . 1) (:held . 1)
@ -998,7 +901,7 @@ down the list override higher items")
(nd/is-archivable-heading-p)) 0 1)))) (nd/is-archivable-heading-p)) 0 1))))
((equal keyword "DONE") ((equal keyword "DONE")
(nd/decend-into-project0 (nd/decend-into-project
'(:archivable :complete :done-incomplete) '(:archivable :complete :done-incomplete)
'((:stuck . 2) '((:stuck . 2)
(:held . 2) (:held . 2)
@ -1013,7 +916,7 @@ down the list override higher items")
2)))) 2))))
((equal keyword "TODO") ((equal keyword "TODO")
(nd/decend-into-project0 (nd/decend-into-project
'(:undone-complete :stuck :held :waiting :active) '(:undone-complete :stuck :held :waiting :active)
'((:complete . 0) '((:complete . 0)
(:archivable . 0) (:archivable . 0)
@ -1021,78 +924,13 @@ down the list override higher items")
(:invalid-todostate . 1) (:invalid-todostate . 1)
(:done-incomplete . 1)) (:done-incomplete . 1))
(lambda (k) (lambda (k)
(cond ((equal k "TODO") 1) (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1))
((equal k "HOLD") 2) ((equal k "HOLD") 2)
((equal k "WAIT") 3) ((equal k "WAIT") 3)
((equal k "NEXT") 4) ((equal k "NEXT") 4)
((and (equal k "TODO") (nd/is-scheduled-heading-p)) 4)
(t 0))))) (t 0)))))
(t (error (concat "invalid keyword detected: " keyword)))))) (t (error (concat "invalid keyword detected: " keyword))))))
(defmacro nd/is-project-keyword-status-p (test-keyword operator statuscode)
"tests if a project has toplevel heading of top-keyword and
child status equal to status code and returns keyword if
both are true"
`(and
(equal ,keyword ,test-keyword)
(nd/compare-statuscodes ,operator (nd/descend-into-project) ,statuscode)))
(defun nd/is-project-status-p (statuscode)
"Returns t if project matches statuscode given.
Note that this assumes the headline being tested is a valid project"
(case statuscode
;; projects closed more than 30 days ago
;; note CANC overrides all subtasks/projects
(:archivable
(if (nd/is-archivable-heading-p)
(or (equal keyword "CANC")
(nd/is-project-keyword-status-p "DONE" = :archivable))))
;; projects closed less than 30 days ago
;; note CANC overrides all subtasks/projects
(:complete
(if (not (nd/is-archivable-heading-p))
(or (equal keyword "CANC")
(nd/is-project-keyword-status-p "DONE" = :complete))))
;; projects with no waiting, held, or active components
(:stuck
(nd/is-project-keyword-status-p "TODO" = :stuck))
;; held projects
;; note toplevel HOLD overrides all subtasks/projects
(:held
(or (equal keyword "HOLD")
(nd/is-project-keyword-status-p "TODO" = :held)))
;; projects with at least one waiting component
(:waiting
(nd/is-project-keyword-status-p "TODO" = :waiting))
;; projects with at least one active component
(:active
(nd/is-project-keyword-status-p "TODO" = :active))
;; projects marked DONE but still have undone subtasks
(:done-incomplete
(nd/is-project-keyword-status-p "DONE" > :complete))
;; projects marked TODO but all subtasks are done
(:undone-complete
(nd/is-project-keyword-status-p "TODO" < :stuck))
;; projects with invalid todo keywords
(:invalid-todostate
(member keyword nd/project-invalid-todostates))
;; projects with scheduled heading (only subtasks should be scheduled)
(:scheduled-project
(nd/is-scheduled-heading-p))
;; error if not known
(t (if (not (member statuscode nd/project-statuscodes))
(error "unknown statuscode")))))
#+END_SRC #+END_SRC
**** iterator testing **** iterator testing
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -1119,7 +957,7 @@ Note that this assumes the headline being tested is a valid project"
nd/iter-future-time t) nd/iter-future-time t)
:active :active
:empty)) :empty))
(if (nd/compare-statuscodes0 > new-status iter-status nd/iter-statuscodes) (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes)
(setq iter-status new-status))))) (setq iter-status new-status)))))
(outline-next-heading))) (outline-next-heading)))
iter-status)) iter-status))
@ -1347,18 +1185,6 @@ Projects are handled quite simply. They have statuscodes
for which I test, and this can all be handled by one function. for which I test, and this can all be handled by one function.
Note that this is used for "normal" projects as well as iterators Note that this is used for "normal" projects as well as iterators
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/skip-projects-without-statuscode (statuscode)
(save-restriction
(widen)
(let ((keyword (nd/is-project-p)))
(if keyword
(if (and nd/agenda-limit-project-toplevel
(nd/heading-has-parent 'nd/is-todoitem-p))
(nd/skip-subtree)
(if (not (nd/is-project-status-p statuscode))
(nd/skip-heading)))
(nd/skip-heading)))))
(defun nd/skip-non-projects () (defun nd/skip-non-projects ()
(save-restriction (save-restriction
(widen) (widen)
@ -1474,17 +1300,6 @@ set as a text property for further sorting"
(org-agenda-todo-ignore-with-date t) (org-agenda-todo-ignore-with-date t)
(org-agenda-sorting-strategy ,sort)))) (org-agenda-sorting-strategy ,sort))))
(defun nd/agenda-base-proj-cmd (match header statuscode)
`(tags-todo
,match
((org-agenda-overriding-header
(concat (and nd/agenda-limit-project-toplevel "Toplevel ") ,header))
(org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode))
;;(org-agenda-before-sorting-filter-function 'nd/sorting-filter-demo)
;; (nd/apply-statuscodes t)
;; (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(category-keep)))))
(let* ((actionable "-NA-REFILE-%inc") (let* ((actionable "-NA-REFILE-%inc")
(periodical "PARENT_TYPE=\"periodical\"") (periodical "PARENT_TYPE=\"periodical\"")
(iterator "PARENT_TYPE=\"iterator\"") (iterator "PARENT_TYPE=\"iterator\"")
@ -1516,9 +1331,18 @@ set as a text property for further sorting"
"Projects")) "Projects"))
(org-agenda-skip-function '(nd/skip-non-projects)) (org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function (org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:stuck :waiting :held :active) 'nd/get-project-status l))) (lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
(org-agenda-cmp-user-defined (org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b))) (lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")"))) (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))) (org-agenda-sorting-strategy '(user-defined-down category-keep))))))
@ -1566,9 +1390,18 @@ set as a text property for further sorting"
"Incubated Projects")) "Incubated Projects"))
(org-agenda-skip-function '(nd/skip-non-projects)) (org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function (org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:stuck :waiting :held :active) 'nd/get-project-status l))) (lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
(org-agenda-cmp-user-defined (org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b))) (lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:active :held)
a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")"))) (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))) (org-agenda-sorting-strategy '(user-defined-down category-keep))))))
@ -1579,29 +1412,13 @@ set as a text property for further sorting"
(org-tags-match-list-sublevels nil)) (org-tags-match-list-sublevels nil))
,(nd/agenda-base-task-cmd task-match ,(nd/agenda-base-task-cmd task-match
"Discontinous Project" "Discontinous Project"
''nd/skip-non-discontinuous-project-tasks))) ''nd/skip-non-discontinuous-project-tasks)
,(nd/agenda-base-header-cmd task-match
("e"
"Non-critical Errors"
(,(nd/agenda-base-header-cmd task-match
"Undone Closed" "Undone Closed"
''nd/skip-non-undone-closed-todoitems) ''nd/skip-non-undone-closed-todoitems)
,(nd/agenda-base-header-cmd (concat actionable "-" periodical) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Done Unclosed" "Done Unclosed"
''nd/skip-non-done-unclosed-todoitems) ''nd/skip-non-done-unclosed-todoitems)))
(tags-todo
,act-no-rep-match
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Project Errors"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) 'nd/get-project-status l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
("A" ("A"
"Archivable Tasks and Projects" "Archivable Tasks and Projects"
@ -1611,9 +1428,9 @@ set as a text property for further sorting"
,(nd/agenda-base-header-cmd (concat actionable "-" periodical) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Stale Tasks" "Stale Tasks"
''nd/skip-non-stale-headings) ''nd/skip-non-stale-headings)
,(nd/agenda-base-proj-cmd (concat actionable "-" periodical "+" iterator) ,(nd/agenda-base-header-cmd (concat actionable "-" periodical "+" iterator)
"Archivable Iterators" "Archivable Iterators"
:archivable) ''nd/skip-non-archivable-atomic-tasks)
(tags-todo (tags-todo
,(concat actionable "-" periodical "-" iterator) ,(concat actionable "-" periodical "-" iterator)
((org-agenda-overriding-header ((org-agenda-overriding-header