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

added atomic skip function

This commit is contained in:
petrucci4prez 2018-03-22 00:32:17 -04:00
parent 8b4e91f55e
commit ce338e1fbe
2 changed files with 54 additions and 178 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
conf.el
View File

@ -365,7 +365,7 @@
(if nd/hide-scheduled-and-waiting-next-tasks (if nd/hide-scheduled-and-waiting-next-tasks
"" ""
" (including WAITING and SCHEDULED tasks)"))) " (including WAITING and SCHEDULED tasks)")))
(org-agenda-skip-function 'nd/skip-project-tasks) (org-agenda-skip-function 'nd/skip-non-atomic-tasks)
(org-agenda-todo-ignore-with-date 'all) (org-agenda-todo-ignore-with-date 'all)
(org-agenda-sorting-strategy (org-agenda-sorting-strategy
'(category-keep)))) '(category-keep))))
@ -413,23 +413,9 @@
(setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function) (setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function)
(defun nd/find-project-task () ;; functions to define headlings relative to project structure (or lack thereof)
"Move point to the parent (project) task if any"
(save-restriction
(widen)
(let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
;; go up to parent heading (no error)
(while (org-up-heading-safe)
;; in case the parent has no todo keyword, keep going
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq parent-task (point))))
;; when parent found, go there and return its position
(goto-char parent-task)
parent-task)))
;; keep
(defun nd/is-project-p () (defun nd/is-project-p ()
"Any task with a todo keyword subtask" "todo heading with a todo subheadings"
(save-restriction (save-restriction
(widen) (widen)
(let ((has-subtask) (let ((has-subtask)
@ -444,63 +430,18 @@
(setq has-subtask t)))) (setq has-subtask t))))
(and is-a-task has-subtask)))) (and is-a-task has-subtask))))
;; old version
;; (defun nd/is-subtask-p ()
;; "Any task with a todo keyword that is in a project subtree.
;; Callers of this function already widen the buffer view."
;; ;; go back up to heading
;; (let ((task (save-excursion (org-back-to-heading 'invisible-ok)
;; (point))))
;; (save-excursion
;; (nd/find-project-task)
;; ;; go up to parent heading
;; (if (equal (point) task)
;; nil
;; t))))
;; (defun nd/is-subproject-p ()
;; "Any task which is a subtask of another project"
;; (let ((is-subproject)
;; ;; is-a-task is true if it has a valid TODO keyword
;; (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
;; (save-excursion
;; ;; loop up through headings until we encounter a task or the top level
;; (while (and (not is-subproject) (org-up-heading-safe))
;; (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; (setq is-subproject t))))
;; (and is-a-task is-subproject)))
(defun nd/is-subtask-p () (defun nd/is-subtask-p ()
"Any task with a todo keyword that is in a project subtree. "todo heading that is part of a project"
Callers of this function already widen the buffer view." (if (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; go back up to heading (let ((is-subproject))
(let ((task (save-excursion (org-back-to-heading 'invisible-ok) (save-excursion
(point)))) (while (and (not is-subproject) (org-up-heading-safe))
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq is-subproject t))))
is-subproject)))
(save-excursion (defun nd/is-atomic-p ()
(nd/find-project-task) "todo heading with no todo subheadings"
;; go up to parent heading
(if (equal (point) task)
nil
t))))
;; (defun nd/find-project-task ()
;; "Move point to the parent (project) task if any"
;; (save-restriction
;; (widen)
;; (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
;; ;; go up to parent heading (no error)
;; (while (org-up-heading-safe)
;; ;; in case the parent has no todo keyword, keep going
;; (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; (setq parent-task (point))))
;; ;; when parent found, go there and return its position
;; (goto-char parent-task)
;; parent-task)))
(defun nd/is-atomic-task-p ()
"Any task with a todo keyword and no subtask"
(save-restriction (save-restriction
(widen) (widen)
(let ((has-subtask) (let ((has-subtask)
@ -514,21 +455,18 @@ Callers of this function already widen the buffer view."
(when (member (org-get-todo-state) org-todo-keywords-1) (when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t)))) (setq has-subtask t))))
(and is-a-task (not has-subtask))))) (and is-a-task (not has-subtask)))))
;; (defun nd/list-sublevels-for-projects-indented ()
;; "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
;; This is normally used by skipping functions where this variable is already local to the agenda."
;; (if (marker-buffer org-agenda-restrict-begin)
;; (setq org-tags-match-list-sublevels 'indented)
;; (setq org-tags-match-list-sublevels nil))
;; nil)
;; (defun nd/list-sublevels-for-projects () ;; functions to test tasks (which are "atomic")
;; "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks. ;; (defun nd/is-scheduled-p ()
;; This is normally used by skipping functions where this variable is already local to the agenda." ;; "task with scheduled property"
;; (if (marker-buffer org-agenda-restrict-begin) ;; ((org-entry-get nil "SCHEDULED")))
;; (setq org-tags-match-list-sublevels t)
;; (setq org-tags-match-list-sublevels nil)) ;; task skip functions
;; nil) (defun nd/skip-non-atomic-tasks ()
(save-restriction
(widen)
(if (not (nd/is-atomic-p))
(save-excursion (or (outline-next-heading) (point-max))))))
(defvar nd/hide-scheduled-and-waiting-next-tasks t) (defvar nd/hide-scheduled-and-waiting-next-tasks t)
@ -643,7 +581,7 @@ Callers of this function already widen the buffer view."
(cond (cond
((nd/is-project-p) ((nd/is-project-p)
nil) nil)
((and (nd/is-subtask-p) (not (nd/is-atomic-task-p))) ((and (nd/is-subtask-p) (not (nd/is-atomic-p)))
nil) nil)
(t (t
subtree-end)))) subtree-end))))
@ -656,7 +594,7 @@ Skip project and sub-project tasks, habits, and project related tasks."
(widen) (widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(cond (cond
((nd/is-atomic-task-p) ((nd/is-atomic-p)
nil) nil)
(t (t
next-headline))))) next-headline)))))
@ -687,7 +625,7 @@ Skip project and sub-project tasks, habits, and project related tasks."
next-headline) next-headline)
((nd/is-project-p) ((nd/is-project-p)
next-headline) next-headline)
((and (nd/is-atomic-task-p) (not (nd/is-subtask-p))) ((and (nd/is-atomic-p) (not (nd/is-subtask-p)))
next-headline) next-headline)
(t (t
nil))))) nil)))))

116
conf.org
View File

@ -542,7 +542,7 @@ TODO: add meeting template as scheduled+action item thing
(if nd/hide-scheduled-and-waiting-next-tasks (if nd/hide-scheduled-and-waiting-next-tasks
"" ""
" (including WAITING and SCHEDULED tasks)"))) " (including WAITING and SCHEDULED tasks)")))
(org-agenda-skip-function 'nd/skip-project-tasks) (org-agenda-skip-function 'nd/skip-non-atomic-tasks)
(org-agenda-todo-ignore-with-date 'all) (org-agenda-todo-ignore-with-date 'all)
(org-agenda-sorting-strategy (org-agenda-sorting-strategy
'(category-keep)))) '(category-keep))))
@ -595,23 +595,9 @@ TODO: add meeting template as scheduled+action item thing
#+END_SRC #+END_SRC
*** filtering functions *** filtering functions
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/find-project-task () ;; functions to define headlings relative to project structure (or lack thereof)
"Move point to the parent (project) task if any"
(save-restriction
(widen)
(let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
;; go up to parent heading (no error)
(while (org-up-heading-safe)
;; in case the parent has no todo keyword, keep going
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq parent-task (point))))
;; when parent found, go there and return its position
(goto-char parent-task)
parent-task)))
;; keep
(defun nd/is-project-p () (defun nd/is-project-p ()
"Any task with a todo keyword subtask" "todo heading with a todo subheadings"
(save-restriction (save-restriction
(widen) (widen)
(let ((has-subtask) (let ((has-subtask)
@ -626,63 +612,18 @@ TODO: add meeting template as scheduled+action item thing
(setq has-subtask t)))) (setq has-subtask t))))
(and is-a-task has-subtask)))) (and is-a-task has-subtask))))
;; old version
;; (defun nd/is-subtask-p ()
;; "Any task with a todo keyword that is in a project subtree.
;; Callers of this function already widen the buffer view."
;; ;; go back up to heading
;; (let ((task (save-excursion (org-back-to-heading 'invisible-ok)
;; (point))))
;; (save-excursion
;; (nd/find-project-task)
;; ;; go up to parent heading
;; (if (equal (point) task)
;; nil
;; t))))
;; (defun nd/is-subproject-p ()
;; "Any task which is a subtask of another project"
;; (let ((is-subproject)
;; ;; is-a-task is true if it has a valid TODO keyword
;; (is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
;; (save-excursion
;; ;; loop up through headings until we encounter a task or the top level
;; (while (and (not is-subproject) (org-up-heading-safe))
;; (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; (setq is-subproject t))))
;; (and is-a-task is-subproject)))
(defun nd/is-subtask-p () (defun nd/is-subtask-p ()
"Any task with a todo keyword that is in a project subtree. "todo heading that is part of a project"
Callers of this function already widen the buffer view." (if (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; go back up to heading (let ((is-subproject))
(let ((task (save-excursion (org-back-to-heading 'invisible-ok) (save-excursion
(point)))) (while (and (not is-subproject) (org-up-heading-safe))
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
(setq is-subproject t))))
is-subproject)))
(save-excursion (defun nd/is-atomic-p ()
(nd/find-project-task) "todo heading with no todo subheadings"
;; go up to parent heading
(if (equal (point) task)
nil
t))))
;; (defun nd/find-project-task ()
;; "Move point to the parent (project) task if any"
;; (save-restriction
;; (widen)
;; (let ((parent-task (save-excursion (org-back-to-heading 'invisible-ok) (point))))
;; ;; go up to parent heading (no error)
;; (while (org-up-heading-safe)
;; ;; in case the parent has no todo keyword, keep going
;; (when (member (nth 2 (org-heading-components)) org-todo-keywords-1)
;; (setq parent-task (point))))
;; ;; when parent found, go there and return its position
;; (goto-char parent-task)
;; parent-task)))
(defun nd/is-atomic-task-p ()
"Any task with a todo keyword and no subtask"
(save-restriction (save-restriction
(widen) (widen)
(let ((has-subtask) (let ((has-subtask)
@ -696,21 +637,18 @@ TODO: add meeting template as scheduled+action item thing
(when (member (org-get-todo-state) org-todo-keywords-1) (when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t)))) (setq has-subtask t))))
(and is-a-task (not has-subtask))))) (and is-a-task (not has-subtask)))))
;; (defun nd/list-sublevels-for-projects-indented ()
;; "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks.
;; This is normally used by skipping functions where this variable is already local to the agenda."
;; (if (marker-buffer org-agenda-restrict-begin)
;; (setq org-tags-match-list-sublevels 'indented)
;; (setq org-tags-match-list-sublevels nil))
;; nil)
;; (defun nd/list-sublevels-for-projects () ;; functions to test tasks (which are "atomic")
;; "Set org-tags-match-list-sublevels so when restricted to a subtree we list all subtasks. ;; (defun nd/is-scheduled-p ()
;; This is normally used by skipping functions where this variable is already local to the agenda." ;; "task with scheduled property"
;; (if (marker-buffer org-agenda-restrict-begin) ;; ((org-entry-get nil "SCHEDULED")))
;; (setq org-tags-match-list-sublevels t)
;; (setq org-tags-match-list-sublevels nil)) ;; task skip functions
;; nil) (defun nd/skip-non-atomic-tasks ()
(save-restriction
(widen)
(if (not (and ((nd/is-atomic-p) (not (nd/is-subtask-p)))))
(save-excursion (or (outline-next-heading) (point-max))))))
(defvar nd/hide-scheduled-and-waiting-next-tasks t) (defvar nd/hide-scheduled-and-waiting-next-tasks t)
@ -825,7 +763,7 @@ TODO: add meeting template as scheduled+action item thing
(cond (cond
((nd/is-project-p) ((nd/is-project-p)
nil) nil)
((and (nd/is-subtask-p) (not (nd/is-atomic-task-p))) ((and (nd/is-subtask-p) (not (nd/is-atomic-p)))
nil) nil)
(t (t
subtree-end)))) subtree-end))))
@ -838,7 +776,7 @@ TODO: add meeting template as scheduled+action item thing
(widen) (widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
(cond (cond
((nd/is-atomic-task-p) ((nd/is-atomic-p)
nil) nil)
(t (t
next-headline))))) next-headline)))))
@ -869,7 +807,7 @@ TODO: add meeting template as scheduled+action item thing
next-headline) next-headline)
((nd/is-project-p) ((nd/is-project-p)
next-headline) next-headline)
((and (nd/is-atomic-task-p) (not (nd/is-subtask-p))) ((and (nd/is-atomic-p) (not (nd/is-subtask-p)))
next-headline) next-headline)
(t (t
nil))))) nil)))))