added archivable atomic tasks to agenda

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 "-NA-REFILE-ATOMIC/!" "Stuck" 10))
-          ,(macroexpand '(nd/agenda-base-project-command "Waiting" 30))
+          ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Waiting" 30))
-          ,(macroexpand '(nd/agenda-base-project-command "Active" 40))
+          ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Active" 40))
-          ,(macroexpand '(nd/agenda-base-project-command "Held" 20))))
+          ,(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 "-NA-REFILE-ATOMIC/!" "Unmarked Completed" 0))
-          ;;,(macroexpand '(nd/agenda-base-project-command "Invalid" 50))
+          ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/" "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))))))
         ("a"
          "Archive"
          ((tags "-REFILE/"
-                ((org-agenda-overriding-header "Tasks to Archive")
+                ((org-agenda-overriding-header "Atomic Tasks to Archive")
-                 (org-agenda-skip-function 'bh/skip-non-archivable-tasks)
+                 (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
+  `(tags
-    "-NA-REFILE-ATOMIC/!"
+    ,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)))

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 "-NA-REFILE-ATOMIC/!" "Stuck" 10))
-            ,(macroexpand '(nd/agenda-base-project-command "Waiting" 30))
+            ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Waiting" 30))
-            ,(macroexpand '(nd/agenda-base-project-command "Active" 40))
+            ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/!" "Active" 40))
-            ,(macroexpand '(nd/agenda-base-project-command "Held" 20))))
+            ,(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 "-NA-REFILE-ATOMIC/!" "Unmarked Completed" 0))
-            ;;,(macroexpand '(nd/agenda-base-project-command "Invalid" 50))
+            ,(macroexpand '(nd/agenda-base-project-command "-NA-REFILE-ATOMIC/" "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))))))
           ("a"
            "Archive"
-           ((tags "-REFILE/"
+           ((tags "-NA-REFILE/"
-                  ((org-agenda-overriding-header "Tasks to Archive")
+                  ((org-agenda-overriding-header "Atomic Tasks to Archive")
-                   (org-agenda-skip-function 'bh/skip-non-archivable-tasks)
+                   (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
+    `(tags
-      "-NA-REFILE-ATOMIC/!"
+      ,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)))