From 0044ff5872a40c0a0bb3ea2821891d878cb75707 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 20 Apr 2021 22:58:05 -0400 Subject: [PATCH] REF move skip functions to org-x file --- etc/conf.org | 111 ++++-------------------------------- local/lib/org-x/org-x.el | 120 +++++++++++++++++++++++++++++++++++++++ 2 files changed, 132 insertions(+), 99 deletions(-) diff --git a/etc/conf.org b/etc/conf.org index faf905a..3e5f0db 100644 --- a/etc/conf.org +++ b/etc/conf.org @@ -2558,10 +2558,10 @@ By default I want block agendas to sort based on the todo keyword (with NEXT bei :END: These agenda commands are the center of the gtd workflow. #+BEGIN_SRC emacs-lisp -(defmacro nd/org-x-mk-skip-function (&rest body) - "Return a skip function with BODY. -The only thing this function does is `save-excursion' and `widen'." - `(lambda () (save-excursion (widen) ,@body))) +;; (defmacro org-x-mk-skip-function (&rest body) +;; "Return a skip function with BODY. +;; The only thing this function does is `save-excursion' and `widen'." +;; `(lambda () (save-excursion (widen) ,@body))) (defmacro nd/org-x-mk-super-agenda-pred (&rest body) "Return a predicate function with BODY. @@ -2611,9 +2611,7 @@ original org entry before executing BODY." "Calendar View" ((agenda "" - ((org-agenda-skip-function - '(org-x-skip-headings-with-tags - (list org-x-tag-no-agenda org-x-tag-maybe org-x-tag-refile))) + ((org-agenda-skip-function #'org-x-calendar-skip-function) (org-agenda-sorting-strategy '(time-up deadline-up scheduled-up category-keep)) (org-agenda-include-diary t) (org-super-agenda-groups @@ -2645,28 +2643,7 @@ original org entry before executing BODY." | org-x-kw-hold | org-x-kw-canc) ((org-agenda-overriding-header "Tasks") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (let ((keyword (org-x-is-todoitem-p))) - ;; currently we assume that periodicals have no TODOs - (cond - ;; skip over held/canc projects - ((and (member keyword org-x-project-skip-todostates) - (org-x-is-project-p)) - (org-x-skip-subtree)) - ;; skip iterators - ((org-x-is-iterator-heading-p) - (org-x-skip-heading)) - ;; skip project headings - ((org-x-is-project-p) - (org-x-skip-heading)) - ;; skip canceled tasks - ((and (equal keyword org-x-kw-canc) - (org-x-is-task-p)) - (org-x-skip-heading)) - ;; skip habits - ((org-x-is-habit-heading-p) - (org-x-skip-heading)))))) + (org-agenda-skip-function #'org-x-task-skip-function) (org-agenda-todo-ignore-with-date t) (org-agenda-sorting-strategy '(user-defined-up category-keep)) (org-super-agenda-groups @@ -2697,13 +2674,7 @@ original org entry before executing BODY." - org-x-tag-refile - org-x-tag-incubated) ((org-agenda-overriding-header "Projects") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (cond ((or (org-x-is-iterator-heading-p) - (org-x-is-periodical-heading-p)) - (org-x-skip-subtree)) - ((not (org-x-is-project-p)) - (org-x-skip-heading))))) + (org-agenda-skip-function #'org-x-project-skip-function) (org-agenda-sorting-strategy '(category-keep)) (org-super-agenda-groups `((:auto-map @@ -2735,24 +2706,7 @@ original org entry before executing BODY." - org-x-tag-refile + org-x-tag-incubated) ((org-agenda-overriding-header "Incubator") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (let ((keyword (org-x-is-todoitem-p))) - (cond - ;; skip done/canc projects - ((and (member keyword org-done-keywords) - (org-x-is-project-p)) - (org-x-skip-subtree)) - ;; skip project tasks - ((and keyword (org-x-is-project-task-p)) - (org-x-skip-heading)) - ;; skip done/canc tasks - ((member keyword org-done-keywords) - (org-x-skip-heading)) - ;; skip non-tasks if they don't have a timestamp - ((and (not keyword) - (not (org-x-is-timestamped-heading-p))) - (org-x-skip-heading)))))) + (org-agenda-skip-function #'org-x-incubator-skip-function) (org-agenda-sorting-strategy '(category-keep)) (org-super-agenda-groups `((:name "Past Deadlines" :deadline past) @@ -2781,13 +2735,7 @@ original org entry before executing BODY." ((tags ,(nd/org-x-mk-match-string - org-x-tag-no-agenda - org-x-tag-refile) ((org-agenda-overriding-header "Iterator Status") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (cond - ((not (org-x-is-periodical-heading-p)) - (org-x-skip-heading)) - ((org-x-headline-has-parent 'org-x-is-periodical-heading-p) - (org-x-skip-heading))))) + (org-agenda-skip-function #'org-x-periodical-skip-function) (org-agenda-sorting-strategy '(category-keep)) (org-super-agenda-groups `((:auto-map @@ -2804,13 +2752,7 @@ original org entry before executing BODY." ((tags ,(nd/org-x-mk-match-string - org-x-tag-no-agenda - org-x-tag-refile) ((org-agenda-overriding-header "Iterator Status") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (cond - ((not (org-x-is-iterator-heading-p)) - (org-x-skip-heading)) - ((org-x-headline-has-parent 'org-x-is-iterator-heading-p) - (org-x-skip-heading))))) + (org-agenda-skip-function #'org-x-iterator-skip-function) (org-agenda-sorting-strategy '(category-keep)) (org-super-agenda-groups `((:auto-map @@ -2838,13 +2780,7 @@ original org entry before executing BODY." - org-x-tag-refile - org-x-tag-incubated) ((org-agenda-overriding-header "Critical Errors") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (cond - ((org-x-is-habit-heading-p) - (org-x-skip-heading)) - ((org-x-is-periodical-heading-p) - (org-x-skip-subtree))))) + (org-agenda-skip-function #'org-x-critical-error-skip-function) (org-super-agenda-groups `((:name "Discontinuous Projects" :pred ,(nd/org-x-mk-super-agenda-pred @@ -2890,30 +2826,7 @@ original org entry before executing BODY." ((tags ,(nd/org-x-mk-match-string - org-x-tag-no-agenda - org-x-tag-refile) ((org-agenda-overriding-header "Archive") - (org-agenda-skip-function - ,(nd/org-x-mk-skip-function - (let ((keyword (org-x-is-todoitem-p))) - (cond - ;; skip all non-archivable projects - ((and keyword - (org-x-is-project-p) - (not (eq :archivable (org-x-get-project-status)))) - (org-x-skip-subtree)) - ;; skip all incubator tasks - ((org-x-headline-has-tag-p org-x-tag-incubated) - (org-x-skip-heading)) - ;; skip all project tasks - ((and keyword (org-x-is-project-task-p)) - (org-x-skip-heading)) - ;; skip all tasks not marked done or archivable - ((and keyword - (org-x-is-task-p) - (not (eq :archivable (org-x-task-status)))) - (org-x-skip-heading)) - ;; skip all non-todoitems that are not stale - ((and (not keyword) - (not (org-x-is-stale-heading-p))) - (org-x-skip-heading)))))) + (org-agenda-skip-function #'org-x-skip-function-archivable) (org-agenda-sorting-strategy '(category-keep)) (org-super-agenda-groups `((:name "Atomic Tasks" :pred diff --git a/local/lib/org-x/org-x.el b/local/lib/org-x/org-x.el index ebc7344..7e6780f 100644 --- a/local/lib/org-x/org-x.el +++ b/local/lib/org-x/org-x.el @@ -1305,5 +1305,125 @@ If ARG is non-nil use long timestamp format." (add-hook 'org-capture-before-finalize-hook #'org-x-set-creation-time) +;; skip functions (all of them) + +(defmacro org-x-mk-skip-function (&rest body) + "Return a skip function with BODY. +The only thing this function does is `save-excursion' and `widen'." + `(lambda () (save-excursion (widen) ,@body))) + +(defun org-x-calendar-skip-function () + (org-x-skip-headings-with-tags + (list org-x-tag-no-agenda + org-x-tag-maybe org-x-tag-refile))) + +(defun org-x-task-skip-function () + (save-excursion + (widen) + (let ((keyword (org-x-is-todoitem-p))) + ;; currently we assume that periodicals have no TODOs + (cond + ;; skip over held/canc projects + ((and (member keyword org-x-project-skip-todostates) + (org-x-is-project-p)) + (org-x-skip-subtree)) + ;; skip iterators + ((org-x-is-iterator-heading-p) + (org-x-skip-heading)) + ;; skip project headings + ((org-x-is-project-p) + (org-x-skip-heading)) + ;; skip canceled tasks + ((and (equal keyword org-x-kw-canc) + (org-x-is-task-p)) + (org-x-skip-heading)) + ;; skip habits + ((org-x-is-habit-heading-p) + (org-x-skip-heading)))))) + +(defun org-x-project-skip-function () + (save-excursion + (widen) + (cond + ((or (org-x-is-iterator-heading-p) (org-x-is-periodical-heading-p)) + (org-x-skip-subtree)) + ((not (org-x-is-project-p)) + (org-x-skip-heading))))) + +(defun org-x-incubator-skip-function () + (save-excursion + (widen) + (let ((keyword (org-x-is-todoitem-p))) + (cond + ;; skip done/canc projects + ((and (member keyword org-done-keywords) + (org-x-is-project-p)) + (org-x-skip-subtree)) + ;; skip project tasks + ((and keyword (org-x-is-project-task-p)) + (org-x-skip-heading)) + ;; skip done/canc tasks + ((member keyword org-done-keywords) + (org-x-skip-heading)) + ;; skip non-tasks if they don't have a timestamp + ((and (not keyword) + (not (org-x-is-timestamped-heading-p))) + (org-x-skip-heading)))))) + +(defun org-x-periodical-skip-function () + (save-excursion + (widen) + (cond + ((not (org-x-is-periodical-heading-p)) + (org-x-skip-heading)) + ((org-x-headline-has-parent #'org-x-is-periodical-heading-p) + (org-x-skip-heading))))) + +(defun org-x-iterator-skip-function () + (save-excursion + (widen) + (cond + ((not (org-x-is-iterator-heading-p)) + (org-x-skip-heading)) + ((org-x-headline-has-parent #'org-x-is-iterator-heading-p) + (org-x-skip-heading))))) + +(defun org-x-critical-error-skip-function () + (save-excursion + (widen) + (cond + ((org-x-is-habit-heading-p) + (org-x-skip-heading)) + ((org-x-is-periodical-heading-p) + (org-x-skip-subtree))))) + +(defun org-x-skip-function-archivable () + ;; (org-x-mk-skip-function + (save-excursion + (widen) + (let ((keyword (org-get-todo-state))) + (cond + ;; skip all non-archivable projects + ((and keyword + ;; TODO gets the keyword again + (org-x-is-project-p) + (not (eq :archivable (org-x-get-project-status)))) + (org-x-skip-subtree)) + ;; skip all incubator tasks + ((org-x-headline-has-tag-p org-x-tag-incubated) + (org-x-skip-heading)) + ;; skip all project tasks + ((and keyword (org-x-is-project-task-p)) + (org-x-skip-heading)) + ;; skip all tasks not marked done or archivable + ((and keyword + ;; TODO gets the keyword again + (org-x-is-task-p) + (not (eq :archivable (org-x-task-status)))) + (org-x-skip-heading)) + ;; skip all non-todoitems that are not stale + ((and (not keyword) (not (org-x-is-stale-heading-p))) + (org-x-skip-heading)))))) + (provide 'org-x) ;;; org-x.el ends here