From df1d1c328bee54cbe55328efd1e9048af3644ad0 Mon Sep 17 00:00:00 2001 From: petrucci4prez Date: Sat, 14 Apr 2018 01:25:14 -0400 Subject: [PATCH] added archivable atomic tasks to agenda --- conf.el | 85 +++++++++++++++++++++++++++---------------------------- conf.org | 86 ++++++++++++++++++++++++++++---------------------------- 2 files changed, 85 insertions(+), 86 deletions(-) diff --git a/conf.el b/conf.el index efafa82..ff62049 100644 --- a/conf.el +++ b/conf.el @@ -328,55 +328,23 @@ ,(macroexpand '(nd/agenda-base-task-command "Held Project" 'nd/skip-non-held-project-tasks)))) ("o" "Project Overview" - (,(macroexpand '(nd/agenda-base-project-command "Stuck" 10)) - ,(macroexpand '(nd/agenda-base-project-command "Waiting" 30)) - ,(macroexpand '(nd/agenda-base-project-command "Active" 40)) - ,(macroexpand '(nd/agenda-base-project-command "Held" 20)))) + (,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Stuck" 10)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Waiting" 30)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Active" 40)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Held" 20)))) ("r" "Refile and errors" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) (org-tags-match-list-sublevels nil)) ,(macroexpand '(nd/agenda-base-task-command "Discontinous Project" 'nd/skip-non-discontinuous-project-tasks)) - ,(macroexpand '(nd/agenda-base-project-command "Unmarked Completed" 0)) - ;;,(macroexpand '(nd/agenda-base-project-command "Invalid" 50)) - (tags - "-NA-REFILE-ATOMIC/" - ((org-agenda-overriding-header (concat - (and nd/agenda-limit-project-toplevel "Toplevel ") - "Invalud Projects")) - (org-agenda-skip-function (if nd/agenda-limit-project-toplevel - '(nd/skip-subprojects-without-statuscode 50) - '(nd/skip-projects-without-statuscode 50))) - (org-agenda-sorting-strategy '(category-keep)))))) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Unmarked Completed" 0)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/" "Invalid" 50)))) ("a" "Archive" ((tags "-REFILE/" - ((org-agenda-overriding-header "Tasks to Archive") - (org-agenda-skip-function 'bh/skip-non-archivable-tasks) + ((org-agenda-overriding-header "Atomic Tasks to Archive") + (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks) (org-tags-match-list-sublevels nil))))))) -(defun bh/skip-non-archivable-tasks () - "Skip trees that are not available for archiving" - (save-restriction - (widen) - ;; Consider only tasks with done todo headings as archivable candidates - (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (if (member (org-get-todo-state) org-todo-keywords-1) - (if (member (org-get-todo-state) org-done-keywords) - (let* ((daynr (string-to-int (format-time-string "%d" (current-time)))) - (a-month-ago (* 60 60 24 (+ daynr 1))) - (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago)))) - (this-month (format-time-string "%Y-%m-" (current-time))) - (subtree-is-current (save-excursion - (forward-line 1) - (and (< (point) subtree-end) - (re-search-forward (concat last-month "\\|" this-month) subtree-end t))))) - (if subtree-is-current - subtree-end ; Has a date in this month or last month, skip it - nil)) ; available to archive - (or subtree-end (point-max))) - next-headline)))) - (defvar nd/agenda-limit-project-toplevel t "used to filter projects by all levels or top-level only") @@ -396,10 +364,10 @@ (org-agenda-todo-ignore-with-date 'all) (org-agenda-sorting-strategy '(category-keep))))) -(defmacro nd/agenda-base-project-command (keyword statuscode) +(defmacro nd/agenda-base-project-command (match keyword statuscode) "shorter syntax to define project agenda commands" - `(tags-todo - "-NA-REFILE-ATOMIC/!" + `(tags + ,match ((org-agenda-overriding-header (concat (and nd/agenda-limit-project-toplevel "Toplevel ") ,keyword @@ -458,6 +426,13 @@ (if (or (nd/heading-has-parent) (not (nd/is-project-status-p statuscode))) (save-excursion (or (outline-next-heading) (point-max)))))) +;; archiving +(defun nd/skip-non-archivable-atomic-tasks () + (save-restriction + (widen) + (if (not (nd/is-archivable-atomic-task-p)) + (save-excursion (or (outline-next-heading) (point-max)))))) + (defun nd/is-todoitem-p () "return todo keyword if present in headline (which defines the heading as a todoitem) this is used to both test if a heading is a todoitem and retrieving the keyword" @@ -485,6 +460,30 @@ this is used to both test if a heading is a todoitem and retrieving the keyword" "return timestamp if headline is scheduled" (org-entry-get nil "SCHEDULED")) +(defun nd/is-closed-heading-p () + "return timestamp if headline is closed" + (let ((timestamp (org-entry-get nil "CLOSED"))) + (if timestamp (float-time (date-to-time timestamp))))) + +(defvar nd/archive-delay-days 30 + "the number of days to wait before tasks show up in the archive view") + +(defun nd/is-archivable-heading-p () + "return timestamp if todoitem is closed and older than specified time" + (let ((timestamp (nd/is-closed-heading-p))) + ;; NOTE we do not ensure that the todo state is in done keywords + ;; this is to allow easier error correction in slip functions + (if (and timestamp (> (- (float-time) timestamp) (* 60 60 24 nd/archive-delay-days))) + timestamp))) + +(defun nd/is-archivable-atomic-task-p () + "return keyword if heading is an archivable task" + (and (nd/is-archivable-heading-p) (nd/is-atomic-task-p))) + +(defun nd/is-archivable-project-p () + "return keyword if heading is an archivable task" + (and (nd/is-archivable-heading-p) (nd/is-project-p))) + (defun nd/is-active-task-p () "return keyword if task is either NEXT or scheduled" (let ((keyword (nd/is-task-p))) diff --git a/conf.org b/conf.org index 3bd4e19..e6b4ea6 100644 --- a/conf.org +++ b/conf.org @@ -493,54 +493,23 @@ I use tags for filtering in the agenda view to narrow down tasks by project/cont ,(macroexpand '(nd/agenda-base-task-command "Held Project" 'nd/skip-non-held-project-tasks)))) ("o" "Project Overview" - (,(macroexpand '(nd/agenda-base-project-command "Stuck" 10)) - ,(macroexpand '(nd/agenda-base-project-command "Waiting" 30)) - ,(macroexpand '(nd/agenda-base-project-command "Active" 40)) - ,(macroexpand '(nd/agenda-base-project-command "Held" 20)))) + (,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Stuck" 10)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Waiting" 30)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Active" 40)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Held" 20)))) ("r" "Refile and errors" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) (org-tags-match-list-sublevels nil)) ,(macroexpand '(nd/agenda-base-task-command "Discontinous Project" 'nd/skip-non-discontinuous-project-tasks)) - ,(macroexpand '(nd/agenda-base-project-command "Unmarked Completed" 0)) - ;;,(macroexpand '(nd/agenda-base-project-command "Invalid" 50)) - (tags - "-NA-REFILE-ATOMIC/" - ((org-agenda-overriding-header (concat - (and nd/agenda-limit-project-toplevel "Toplevel ") - "Invalud Projects")) - (org-agenda-skip-function (if nd/agenda-limit-project-toplevel - '(nd/skip-subprojects-without-statuscode 50) - '(nd/skip-projects-without-statuscode 50))) - (org-agenda-sorting-strategy '(category-keep)))))) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Unmarked Completed" 0)) + ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/" "Invalid" 50)))) ("a" "Archive" - ((tags "-REFILE/" - ((org-agenda-overriding-header "Tasks to Archive") - (org-agenda-skip-function 'bh/skip-non-archivable-tasks) + ((tags "-NA-REFILE/" + ((org-agenda-overriding-header "Atomic Tasks to Archive") + (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks) (org-tags-match-list-sublevels nil))))))) - (defun bh/skip-non-archivable-tasks () - "Skip trees that are not available for archiving" - (save-restriction - (widen) - ;; Consider only tasks with done todo headings as archivable candidates - (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (if (member (org-get-todo-state) org-todo-keywords-1) - (if (member (org-get-todo-state) org-done-keywords) - (let* ((daynr (string-to-int (format-time-string "%d" (current-time)))) - (a-month-ago (* 60 60 24 (+ daynr 1))) - (last-month (format-time-string "%Y-%m-" (time-subtract (current-time) (seconds-to-time a-month-ago)))) - (this-month (format-time-string "%Y-%m-" (current-time))) - (subtree-is-current (save-excursion - (forward-line 1) - (and (< (point) subtree-end) - (re-search-forward (concat last-month "\\|" this-month) subtree-end t))))) - (if subtree-is-current - subtree-end ; Has a date in this month or last month, skip it - nil)) ; available to archive - (or subtree-end (point-max))) - next-headline)))) #+END_SRC *** interactive view functions #+BEGIN_SRC emacs-lisp @@ -563,10 +532,10 @@ I use tags for filtering in the agenda view to narrow down tasks by project/cont (org-agenda-todo-ignore-with-date 'all) (org-agenda-sorting-strategy '(category-keep))))) - (defmacro nd/agenda-base-project-command (keyword statuscode) + (defmacro nd/agenda-base-project-command (match keyword statuscode) "shorter syntax to define project agenda commands" - `(tags-todo - "-NA-REFILE-ATOMIC/!" + `(tags + ,match ((org-agenda-overriding-header (concat (and nd/agenda-limit-project-toplevel "Toplevel ") ,keyword @@ -629,6 +598,13 @@ tags in the custom commands section but I find this easier to maintain and possi (widen) (if (or (nd/heading-has-parent) (not (nd/is-project-status-p statuscode))) (save-excursion (or (outline-next-heading) (point-max)))))) + + ;; archiving + (defun nd/skip-non-archivable-atomic-tasks () + (save-restriction + (widen) + (if (not (nd/is-archivable-atomic-task-p)) + (save-excursion (or (outline-next-heading) (point-max)))))) #+END_SRC *** task helper functions These are the building blocks for skip functions. @@ -660,6 +636,30 @@ These are the building blocks for skip functions. "return timestamp if headline is scheduled" (org-entry-get nil "SCHEDULED")) + (defun nd/is-closed-heading-p () + "return timestamp if headline is closed" + (let ((timestamp (org-entry-get nil "CLOSED"))) + (if timestamp (float-time (date-to-time timestamp))))) + + (defvar nd/archive-delay-days 30 + "the number of days to wait before tasks show up in the archive view") + + (defun nd/is-archivable-heading-p () + "return timestamp if todoitem is closed and older than specified time" + (let ((timestamp (nd/is-closed-heading-p))) + ;; NOTE we do not ensure that the todo state is in done keywords + ;; this is to allow easier error correction in slip functions + (if (and timestamp (> (- (float-time) timestamp) (* 60 60 24 nd/archive-delay-days))) + timestamp))) + + (defun nd/is-archivable-atomic-task-p () + "return keyword if heading is an archivable task" + (and (nd/is-archivable-heading-p) (nd/is-atomic-task-p))) + + (defun nd/is-archivable-project-p () + "return keyword if heading is an archivable task" + (and (nd/is-archivable-heading-p) (nd/is-project-p))) + (defun nd/is-active-task-p () "return keyword if task is either NEXT or scheduled" (let ((keyword (nd/is-task-p)))