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

added some small helper functions

This commit is contained in:
petrucci4prez 2018-03-24 00:50:01 -04:00
parent c466eb11de
commit a9956a4e85
2 changed files with 117 additions and 150 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

182
conf.el
View File

@ -226,7 +226,7 @@
(load "ess-site") (load "ess-site")
(setq ess-history-file "session.Rhistory") (setq ess-history-file "session.Rhistory")
(setq ess-history-directory (setq ess-history-directory
(substitute-in-file-name "${XDG_CONFIG_HOME}/r/")) (substitute-in-file-name "${XDG_CONFIG_HOME}/r/"))
(setq org-log-done t) (setq org-log-done t)
(setq org-src-window-setup 'current-window) (setq org-src-window-setup 'current-window)
@ -389,7 +389,6 @@
(tags-todo "-NA-CANCELLED/!" (tags-todo "-NA-CANCELLED/!"
((org-agenda-overriding-header "Stuck Projects") ((org-agenda-overriding-header "Stuck Projects")
(org-agenda-skip-function 'nd/skip-non-stuck-projects) (org-agenda-skip-function 'nd/skip-non-stuck-projects)
(org-agenda-skip-function 'nd/skip-non-blocked-projects)
(org-agenda-sorting-strategy (org-agenda-sorting-strategy
'(category-keep)))) '(category-keep))))
(tags-todo "-NA-HOLD-CANCELLED/!" (tags-todo "-NA-HOLD-CANCELLED/!"
@ -414,53 +413,50 @@
(setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function) (setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function)
;; functions to define headlings relative to project structure (or lack thereof) ;; functions to define headlings relative to project structure (or lack thereof)
(defun nd/is-project-p () (defun nd/is-todoitem-p ()
"todo heading with a todo subheadings" "return t if headline has valid todo keyword"
(save-restriction (member (nth 2 (org-heading-components)) org-todo-keywords-1))
(widen)
(let ((has-subtask)
(subtree-end (save-excursion (org-end-of-subtree t)))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
(save-excursion
(forward-line 1)
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task has-subtask))))
(defun nd/is-subtask-p () (defun nd/todoitem-has-children ()
"todo heading that is part of a project" "returns t if heading is a todoitem and has todoitems in its subtree"
(if (member (nth 2 (org-heading-components)) org-todo-keywords-1) (if (nd/is-todoitem-p)
(let ((is-subproject)) (let ((has-children)
(subtree-end (save-excursion (org-end-of-subtree t))))
(save-excursion (save-excursion
(while (and (not is-subproject) (org-up-heading-safe)) (outline-next-heading)
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1) (while (and (not has-children)
(setq is-subproject t)))) (< (point) subtree-end))
is-subproject))) (when (nd/is-todoitem-p)
(setq has-children t)
(outline-next-heading))))
has-children)))
(defun nd/is-atomic-p () (defun nd/todoitem-has-parent ()
"todo heading with no todo subheadings" "returns t if heading is a todoitem that is in the subtree of another todoitem"
(save-restriction (if (nd/is-todoitem-p)
(widen) (let ((has-parent))
(let ((has-subtask) (save-excursion
(subtree-end (save-excursion (org-end-of-subtree t))) (while (and (not has-parent) (org-up-heading-safe))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1))) (when (nd/is-todoitem-p)
(save-excursion (setq has-parent t))))
(forward-line 1) has-parent)))
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task (not has-subtask)))))
(defun nd/is-project-p ()
(nd/todoitem-has-children))
(defun nd/is-task-p ()
(and (nd/is-todoitem-p) (not nd/todoitem-has-children)))
(defun nd/is-atomic-task-p ()
(and (nd/is-task-p) (not (nd/todoitem-has-parent))))
;; functions to test tasks (which are "atomic") ;; functions to test tasks (which are "atomic")
;; (defun nd/is-scheduled-p () ;; (defun nd/is-scheduled-p ()
;; "task with scheduled property" ;; "task with scheduled property"
;; ((org-entry-get nil "SCHEDULED"))) ;; ((org-entry-get nil "SCHEDULED")))
;; org-forward-heading-same-level
;; task skip functions ;; task skip functions
(defun nd/skip-non-atomic-tasks () (defun nd/skip-non-atomic-tasks ()
(save-restriction (save-restriction
@ -477,60 +473,8 @@
(org-agenda-redo)) (org-agenda-redo))
(message "%s WAITING and SCHEDULED NEXT Tasks" (if nd/hide-scheduled-and-waiting-next-tasks "Hide" "Show"))) (message "%s WAITING and SCHEDULED NEXT Tasks" (if nd/hide-scheduled-and-waiting-next-tasks "Hide" "Show")))
;; this skip function seems inefficient, it looks like we are skipping one headline at a time
;; but searching for NEXT in the entire subtree
;; can I do better?
(defun nd/skip-stuck-projects ()
"Skip trees that are not stuck projects"
;; save narrow buffer state
(save-restriction
;; widen to see the entire buffer
(widen)
;; define next-headline as either the next headline or the end of the buffer
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
;; if headline has subtasks
(if (nd/is-project-p)
;; define subtree-end as the end of the subtree
;; initialize has-next with nil
(let* ((subtree-end (save-excursion (org-end-of-subtree t)))
(has-next ))
;; save where we are pointing
(save-excursion
;; go forward one line
(forward-line 1)
;; while loop which continues if
;; - has-next is nil
;; - we are not at the end of the subtree
;; - there is no NEXT between here and the subtree end
;; this is a loop because there could be multiple NEXT tasks (obviously)
;; the regex search moves the point to the end of the first found NEXT
;; relative to the start point position
;; once it gets to the end of the subtree it returns nil and the loop breaks
(while (and (not has-next)
(< (point) subtree-end)
(re-search-forward "^\\*+ NEXT " subtree-end t))
;; if WAITING is not in tag list
;; i guess this is here because if the loop finds next
;; and the NEXT task also has WAITING (which it would need to inherit
;; because WAITING and NEXT are mutully exclusive) then we keep looping
;; so the Bernt defined stuck projects as those which have WAITING tasks
;; that override a NEXT subtask
(unless (member "WAITING" (org-get-tags-at))
;; set has-next to true
(setq has-next t))))
;; if we have a next task, set to nil (eg don't skip)
(if has-next
nil
;; if no next task, skip to next headline
next-headline)) ; a stuck project, has subtasks but no next task
;; don't skip if not a project
nil))))
(defun nd/skip-non-stuck-projects () (defun nd/skip-non-stuck-projects ()
"Skip trees that are not stuck projects" "Skip trees that are not stuck projects"
;; (nd/list-sublevels-for-projects-indented)
(save-restriction (save-restriction
(widen) (widen)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) (let ((next-headline (save-excursion (or (outline-next-heading) (point-max)))))
@ -549,27 +493,41 @@
nil)) ; a stuck project, has subtasks but no next task nil)) ; a stuck project, has subtasks but no next task
next-headline)))) next-headline))))
(defun nd/skip-non-blocked-projects () ;; project test functions
"Skip trees that are not stuck projects" ;; is state
;; (nd/list-sublevels-for-projects-indented) ;; if project
(save-restriction ;; if order = 1
(widen) ;; return (state is true)
(let ((next-headline (save-excursion (or (outline-next-heading) (point-max))))) ;; else order > 1
(if (nd/is-project-p) ;; call is state (recursive)
(let* ((subtree-end (save-excursion (org-end-of-subtree t))) ;; else if task
(has-next )) ;; return (state is true)
(save-excursion ;; note: this needs to iterate through lines
(forward-line 1) (defun nd/is-active-project-p ()
(while (and (not has-next) "return true if project has at least one
(< (point) subtree-end) NEXT/scheduled task or active subproject"
(re-search-forward "^\\*+ WAITING " subtree-end t)) ;; if not a project then don't bother
(unless (member "WAITING" (org-get-tags-at)) (if (nd/is-project-p)
(setq has-next t)))) (let (((subtree-end (save-excursion (org-end-of-subtree t))))
(if has-next (is-active))
next-headline (save-excursion
nil)) ; a stuck project, has subtasks but no next task (while (and (not is-active)
next-headline)))) (< (point) subtree-end))
(outline-heading-next)
(cond ((nd/is-active-task-p) (setq is-active t))
((nd/is-active-project-p) (setq is-active))))))))
;; (defun nd/skip-non-stuck-projects ()
;; goto next headline
;; if project
;; if project order 1
;; if it has NEXT, WAITING, HOLD, or a scheduled task
;; then skip (return end of subtree)
;; else stuck project, return nil
;; else (order > 1)
;; descend into project (recursion)
;; skip (either an atomic task or non-todo, return next heading)
;; )
(defun nd/skip-non-projects () (defun nd/skip-non-projects ()
"Skip trees that are not projects" "Skip trees that are not projects"

85
conf.org
View File

@ -594,6 +594,7 @@ TODO: add meeting template as scheduled+action item thing
#+END_SRC #+END_SRC
*** filtering functions *** filtering functions
some definitions: some definitions:
- todoitem: heading with todo state
- task: todo heading with no todo headings beneath it - task: todo heading with no todo headings beneath it
- project: todo heading with tasks or other project in subtree - project: todo heading with tasks or other project in subtree
- subtask: task that is part of a project - subtask: task that is part of a project
@ -605,48 +606,43 @@ some definitions:
- etc - etc
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
;; functions to define headlings relative to project structure (or lack thereof) ;; functions to define headlings relative to project structure (or lack thereof)
(defun nd/is-project-p () (defun nd/is-todoitem-p ()
"todo heading with a todo subheadings" "return t if headline has valid todo keyword"
(save-restriction (member (nth 2 (org-heading-components)) org-todo-keywords-1))
(widen)
(let ((has-subtask)
(subtree-end (save-excursion (org-end-of-subtree t)))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1)))
(save-excursion
(forward-line 1)
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task has-subtask))))
(defun nd/is-subtask-p () (defun nd/todoitem-has-children ()
"todo heading that is part of a project" "returns t if heading is a todoitem and has todoitems in its subtree"
(if (member (nth 2 (org-heading-components)) org-todo-keywords-1) (if (nd/is-todoitem-p)
(let ((is-subproject)) (let ((has-children)
(subtree-end (save-excursion (org-end-of-subtree t))))
(save-excursion (save-excursion
(while (and (not is-subproject) (org-up-heading-safe)) (outline-next-heading)
(when (member (nth 2 (org-heading-components)) org-todo-keywords-1) (while (and (not has-children)
(setq is-subproject t)))) (< (point) subtree-end))
is-subproject))) (when (nd/is-todoitem-p)
(setq has-children t)
(outline-next-heading))))
has-children)))
(defun nd/is-atomic-p () (defun nd/todoitem-has-parent ()
"todo heading with no todo subheadings" "returns t if heading is a todoitem that is in the subtree of another todoitem"
(save-restriction (if (nd/is-todoitem-p)
(widen) (let ((has-parent))
(let ((has-subtask) (save-excursion
(subtree-end (save-excursion (org-end-of-subtree t))) (while (and (not has-parent) (org-up-heading-safe))
(is-a-task (member (nth 2 (org-heading-components)) org-todo-keywords-1))) (when (nd/is-todoitem-p)
(save-excursion (setq has-parent t))))
(forward-line 1) has-parent)))
(while (and (not has-subtask)
(< (point) subtree-end)
(re-search-forward "^\*+ " subtree-end t))
(when (member (org-get-todo-state) org-todo-keywords-1)
(setq has-subtask t))))
(and is-a-task (not has-subtask)))))
(defun nd/is-project-p ()
(nd/todoitem-has-children))
(defun nd/is-task-p ()
(and (nd/is-todoitem-p) (not nd/todoitem-has-children)))
(defun nd/is-atomic-task-p ()
(and (nd/is-task-p) (not (nd/todoitem-has-parent))))
;; functions to test tasks (which are "atomic") ;; functions to test tasks (which are "atomic")
;; (defun nd/is-scheduled-p () ;; (defun nd/is-scheduled-p ()
;; "task with scheduled property" ;; "task with scheduled property"
@ -700,6 +696,19 @@ some definitions:
;; else if task ;; else if task
;; return (state is true) ;; return (state is true)
;; note: this needs to iterate through lines ;; note: this needs to iterate through lines
(defun nd/is-active-project-p ()
"return true if project has at least one
NEXT/scheduled task or active subproject"
;; if not a project then don't bother
(if (nd/is-project-p)
(let (((subtree-end (save-excursion (org-end-of-subtree t))))
(is-active))
(save-excursion
(while (and (not is-active)
(< (point) subtree-end))
(outline-heading-next)
(cond ((nd/is-active-task-p) (setq is-active t))
((nd/is-active-project-p) (setq is-active))))))))
;; (defun nd/skip-non-stuck-projects () ;; (defun nd/skip-non-stuck-projects ()
;; goto next headline ;; goto next headline