add incubator filtering

This commit is contained in:
petrucci4prez 2018-05-15 22:55:11 -04:00
parent b742356b3f
commit 45b6a3a690
2 changed files with 159 additions and 133 deletions

80
conf.el
View File

@ -57,11 +57,11 @@
(spaceline-spacemacs-theme) (spaceline-spacemacs-theme)
(setq spaceline-buffer-size-p nil)) (setq spaceline-buffer-size-p nil))
(use-package dashboard ;; (use-package dashboard
:ensure t ;; :ensure t
:config ;; :config
(dashboard-setup-startup-hook) ;; (dashboard-setup-startup-hook)
(setq dashboard-banner-logo-title "Emacs")) ;; (setq dashboard-banner-logo-title "Emacs"))
;; (setq dashboard-items '((recents . 10)))) ;; (setq dashboard-items '((recents . 10))))
(global-set-key (kbd "C-h a") 'apropos) (global-set-key (kbd "C-h a") 'apropos)
@ -281,7 +281,7 @@
(add-hook 'org-agenda-mode-hook (add-hook 'org-agenda-mode-hook
(lambda () (lambda ()
(local-set-key (kbd "C-c C-c") '(message org-tags-alist)))) (local-set-key (kbd "C-c C-c") 'org-agenda-set-tags)))
(setq org-todo-keywords (setq org-todo-keywords
'((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)") '((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)")
@ -295,28 +295,23 @@
("HOLD" :foreground "violet" :weight bold) ("HOLD" :foreground "violet" :weight bold)
("CANC" :foreground "deep sky blue" :weight bold)))) ("CANC" :foreground "deep sky blue" :weight bold))))
(defun nd/filter-tags-prefix (prefix tags-list) (defun nd/filter-list-prefix (prefix str-list)
"Return a subset of tags-list whose first character matches prefix.' "Return a subset of tags-list whose first character matches prefix.'
tags-list defaults to org-tag-alist if not given" tags-list defaults to org-tag-alist if not given"
(seq-filter (lambda (tag) (seq-filter (lambda (i)
(and (stringp tag) (and (stringp i)
(string-prefix-p prefix tag))) (string-prefix-p prefix i)))
tags-list)) str-list))
(defun nd/add-tag-face (fg-name prefix) (defun nd/add-tag-face (fg-name prefix)
"Adds list of cons cells to org-tag-faces with foreground set to fg-name. "Adds list of cons cells to org-tag-faces with foreground set to fg-name.
Start and end specify the positions in org-tag-alist which define the tags Start and end specify the positions in org-tag-alist which define the tags
to which the faces are applied" to which the faces are applied"
(dolist (tag (nd/filter-tags-prefix prefix (mapcar #'car org-tag-alist))) (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist)))
(push `(,tag . (:foreground ,fg-name)) org-tag-faces))) (push `(,tag . (:foreground ,fg-name)) org-tag-faces)))
;; for some reason, org-mode doesn't like it if the org-tags-alist ;; for some reason, most special chars don't really
;; has special chars before it is loaded (overrides keybindings) ;; work in org-tag-alist, only #, @, %, and _
;; this somewhat convoluted hook works tho...
(defun nd/set-org-tag-alist-and-faces ()
(progn
;; dirty hack to keep org agenda happy
;; (setq org-tag-alist '((:newline)))
(setq org-tag-alist (setq org-tag-alist
'((:startgroup) '((:startgroup)
("@errand" . ?e) ("@errand" . ?e)
@ -329,9 +324,9 @@ to which the faces are applied"
("#tcult" . ?T) ("#tcult" . ?T)
("#phone" . ?O) ("#phone" . ?O)
("$note" . ?n) ("%note" . ?n)
("$inc" . ?i) ("%inc" . ?i)
("$subdiv" . ?s) ("%subdiv" . ?s)
(:startgroup) (:startgroup)
("_env" . ?E) ("_env" . ?E)
@ -348,10 +343,8 @@ to which the faces are applied"
(nd/add-tag-face "PaleGreen" "@") (nd/add-tag-face "PaleGreen" "@")
(nd/add-tag-face "SkyBlue" "#") (nd/add-tag-face "SkyBlue" "#")
(nd/add-tag-face "PaleGoldenrod" "$") (nd/add-tag-face "PaleGoldenrod" "%")
(nd/add-tag-face "violet" "_"))) (nd/add-tag-face "violet" "_")
(add-hook 'org-mode-hook 'nd/set-org-tag-alist-and-faces)
(add-to-list 'org-default-properties "PARENT_TYPE") (add-to-list 'org-default-properties "PARENT_TYPE")
(add-to-list 'org-default-properties "OWNER") (add-to-list 'org-default-properties "OWNER")
@ -475,8 +468,11 @@ If the future flag is set, returns timestamp if it is in the future
(defun nd/heading-has-context-p () (defun nd/heading-has-context-p ()
(let ((tags (org-get-tags-at))) (let ((tags (org-get-tags-at)))
(or (> (length (nd/filter-tags-prefix "#" tags)) 0) (or (> (length (nd/filter-list-prefix "#" tags)) 0)
(> (length (nd/filter-tags-prefix "@" tags)) 0)))) (> (length (nd/filter-list-prefix "@" tags)) 0))))
(defun nd/heading-has-tag-p (tag)
(member tag (org-get-tags-at)))
(defun nd/heading-has-children (heading-test) (defun nd/heading-has-children (heading-test)
"returns t if heading has subheadings that return t when assessed with "returns t if heading has subheadings that return t when assessed with
@ -687,6 +683,17 @@ test-fun return true"
(if (not (and keyword ,test-fun)) (if (not (and keyword ,test-fun))
(nd/skip-heading))))) (nd/skip-heading)))))
(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list)
"Skips headings that have tags in pos-tags-list and also skips
tags that do not have tags in neg-tags-list"
(save-restriction
(widen)
(let ((header-tags (org-get-tags-at)))
(if (and (or (not pos-tags-list)
(intersection pos-tags-list header-tags :test 'equal))
(not (intersection neg-tags-list header-tags :test 'equal)))
(nd/skip-heading)))))
(defun nd/skip-non-stale-headings () (defun nd/skip-non-stale-headings ()
(save-restriction (save-restriction
(widen) (widen)
@ -867,16 +874,14 @@ test-fun return true"
(org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode)) (org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode))
(org-agenda-sorting-strategy '(category-keep))))) (org-agenda-sorting-strategy '(category-keep)))))
(setq org-agenda-tag-filter-preset (list "-%inc")) (let ((task-match "-NA-REFILE-%inc-PARENT_TYPE=\"periodical\"/")
(project-match "-NA-REFILE-%inc-PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(let ((task-match "-NA-REFILE-PARENT_TYPE=\"periodical\"/")
(project-match "-NA-REFILE-PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(periodical-match "-NA-REFILE+PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/") (periodical-match "-NA-REFILE+PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(iterator-match "-NA-REFILE-PARENT_TYPE=\"periodical\"+PARENT_TYPE=\"iterator\"/")) (iterator-match "-NA-REFILE-PARENT_TYPE=\"periodical\"+PARENT_TYPE=\"iterator\"/"))
(setq org-agenda-custom-commands (setq org-agenda-custom-commands
`(("t" `(("t"
"Task View" "Task View"
((agenda "" nil) ((agenda "" (org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc"))))
,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT")) ,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT"))
,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT")) ,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT"))
,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks) ,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)
@ -900,6 +905,13 @@ test-fun return true"
,(nd/agenda-base-project-command iterator-match "Active Iterators" :active) ,(nd/agenda-base-project-command iterator-match "Active Iterators" :active)
,(nd/agenda-base-project-command iterator-match "Waiting Iterators" :waiting) ,(nd/agenda-base-project-command iterator-match "Waiting Iterators" :waiting)
,(nd/agenda-base-project-command iterator-match "Held Iterators" :held))) ,(nd/agenda-base-project-command iterator-match "Held Iterators" :held)))
("I"
"Incubator View"
((agenda "" ((org-agenda-span 7)
(org-agenda-time-grid nil)
(org-agenda-entry-types '(:deadline :timestamp))))
,(nd/agenda-base-task-command "-NA-REFILE+%inc/" "Incubated Tasks" ''nd/skip-non-atomic-tasks)
,(nd/agenda-base-project-command "-NA-REFILE+%inc/" "Incubated Projects" :held)))
("r" ("r"
"Refile and Critical Errors" "Refile and Critical Errors"
((tags "REFILE" ((tags "REFILE"
@ -923,7 +935,7 @@ test-fun return true"
,(nd/agenda-base-project-command iterator-match "Archivable Iterators" :archivable) ,(nd/agenda-base-project-command iterator-match "Archivable Iterators" :archivable)
,(nd/agenda-base-project-command project-match "Archivable Projects" :archivable)))))) ,(nd/agenda-base-project-command project-match "Archivable Projects" :archivable))))))
(setq org-agenda-start-on-weekday 1) (setq org-agenda-start-on-weekday 0)
(setq org-agenda-span 'day) (setq org-agenda-span 'day)
(setq org-agenda-time-grid (quote ((daily today remove-match) (setq org-agenda-time-grid (quote ((daily today remove-match)
#("----------------" 0 16 (org-heading t)) #("----------------" 0 16 (org-heading t))

View File

@ -94,11 +94,11 @@ NOTE: this only works if we start term after gui, and term has light bg. not big
#+END_SRC #+END_SRC
** dashboard ** dashboard
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(use-package dashboard ;; (use-package dashboard
:ensure t ;; :ensure t
:config ;; :config
(dashboard-setup-startup-hook) ;; (dashboard-setup-startup-hook)
(setq dashboard-banner-logo-title "Emacs")) ;; (setq dashboard-banner-logo-title "Emacs"))
;; (setq dashboard-items '((recents . 10)))) ;; (setq dashboard-items '((recents . 10))))
#+END_SRC #+END_SRC
* keybindings * keybindings
@ -430,7 +430,7 @@ the fonts in org headings bug me, make them smaller and less invasive
(add-hook 'org-agenda-mode-hook (add-hook 'org-agenda-mode-hook
(lambda () (lambda ()
(local-set-key (kbd "C-c C-c") '(message org-tags-alist)))) (local-set-key (kbd "C-c C-c") 'org-agenda-set-tags)))
#+END_SRC #+END_SRC
** todo states ** todo states
*** sequences *** sequences
@ -457,31 +457,26 @@ Any tag that is not part of these groups (eg some filetags in the few cases I us
There are several types of tags I use: There are several types of tags I use:
- location: a GTD contexts; these start with "@" - location: a GTD contexts; these start with "@"
- tools: also a GTD contexts; these start with "#" - tools: also a GTD contexts; these start with "#"
- attribute: useful flags for filtering; these start with "." - attribute: useful flags for filtering; these start with "%"
- life areas: key areas of life which define priorities and goals; these start with "_" - life areas: key areas of life which define priorities and goals; these start with "_"
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/filter-tags-prefix (prefix tags-list) (defun nd/filter-list-prefix (prefix str-list)
"Return a subset of tags-list whose first character matches prefix.' "Return a subset of tags-list whose first character matches prefix.'
tags-list defaults to org-tag-alist if not given" tags-list defaults to org-tag-alist if not given"
(seq-filter (lambda (tag) (seq-filter (lambda (i)
(and (stringp tag) (and (stringp i)
(string-prefix-p prefix tag))) (string-prefix-p prefix i)))
tags-list)) str-list))
(defun nd/add-tag-face (fg-name prefix) (defun nd/add-tag-face (fg-name prefix)
"Adds list of cons cells to org-tag-faces with foreground set to fg-name. "Adds list of cons cells to org-tag-faces with foreground set to fg-name.
Start and end specify the positions in org-tag-alist which define the tags Start and end specify the positions in org-tag-alist which define the tags
to which the faces are applied" to which the faces are applied"
(dolist (tag (nd/filter-tags-prefix prefix (mapcar #'car org-tag-alist))) (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist)))
(push `(,tag . (:foreground ,fg-name)) org-tag-faces))) (push `(,tag . (:foreground ,fg-name)) org-tag-faces)))
;; for some reason, org-mode doesn't like it if the org-tags-alist ;; for some reason, most special chars don't really
;; has special chars before it is loaded (overrides keybindings) ;; work in org-tag-alist, only #, @, %, and _
;; this somewhat convoluted hook works tho...
(defun nd/set-org-tag-alist-and-faces ()
(progn
;; dirty hack to keep org agenda happy
;; (setq org-tag-alist '((:newline)))
(setq org-tag-alist (setq org-tag-alist
'((:startgroup) '((:startgroup)
("@errand" . ?e) ("@errand" . ?e)
@ -494,9 +489,9 @@ There are several types of tags I use:
("#tcult" . ?T) ("#tcult" . ?T)
("#phone" . ?O) ("#phone" . ?O)
("$note" . ?n) ("%note" . ?n)
("$inc" . ?i) ("%inc" . ?i)
("$subdiv" . ?s) ("%subdiv" . ?s)
(:startgroup) (:startgroup)
("_env" . ?E) ("_env" . ?E)
@ -513,10 +508,9 @@ There are several types of tags I use:
(nd/add-tag-face "PaleGreen" "@") (nd/add-tag-face "PaleGreen" "@")
(nd/add-tag-face "SkyBlue" "#") (nd/add-tag-face "SkyBlue" "#")
(nd/add-tag-face "PaleGoldenrod" "$") (nd/add-tag-face "PaleGoldenrod" "%")
(nd/add-tag-face "violet" "_"))) (nd/add-tag-face "violet" "_")
(add-hook 'org-mode-hook 'nd/set-org-tag-alist-and-faces)
#+END_SRC #+END_SRC
** properties ** properties
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
@ -670,8 +664,11 @@ Returns t is heading matches a certian set of properties
(defun nd/heading-has-context-p () (defun nd/heading-has-context-p ()
(let ((tags (org-get-tags-at))) (let ((tags (org-get-tags-at)))
(or (> (length (nd/filter-tags-prefix "#" tags)) 0) (or (> (length (nd/filter-list-prefix "#" tags)) 0)
(> (length (nd/filter-tags-prefix "@" tags)) 0)))) (> (length (nd/filter-list-prefix "@" tags)) 0))))
(defun nd/heading-has-tag-p (tag)
(member tag (org-get-tags-at)))
#+END_SRC #+END_SRC
**** relational testing **** relational testing
Returns t if heading has certain relationship to other headings Returns t if heading has certain relationship to other headings
@ -893,10 +890,11 @@ Subunits for skip functions. Not meant to be used or called from the custom comm
(if (not (and keyword ,test-fun)) (if (not (and keyword ,test-fun))
(nd/skip-heading))))) (nd/skip-heading)))))
#+END_SRC #+END_SRC
**** stale headings **** headings
For archiving headings with old timestamps Skip functions for headings which may or may
not be todo-items
Note that these are not always todo items Note in the case of stale headings that
I only care about those that are not part I only care about those that are not part
of projects (projects will get taken care of projects (projects will get taken care
of when the entire project is finished) of when the entire project is finished)
@ -904,6 +902,17 @@ and those that are not DONE/CANC (as
those appear in the regular archive those appear in the regular archive
section) section)
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list)
"Skips headings that have tags in pos-tags-list and also skips
tags that do not have tags in neg-tags-list"
(save-restriction
(widen)
(let ((header-tags (org-get-tags-at)))
(if (and (or (not pos-tags-list)
(intersection pos-tags-list header-tags :test 'equal))
(not (intersection neg-tags-list header-tags :test 'equal)))
(nd/skip-heading)))))
(defun nd/skip-non-stale-headings () (defun nd/skip-non-stale-headings ()
(save-restriction (save-restriction
(widen) (widen)
@ -1128,16 +1137,14 @@ Note that this is used for "normal" projects as well as iterators
(org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode)) (org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode))
(org-agenda-sorting-strategy '(category-keep))))) (org-agenda-sorting-strategy '(category-keep)))))
(setq org-agenda-tag-filter-preset (list "-%inc")) (let ((task-match "-NA-REFILE-%inc-PARENT_TYPE=\"periodical\"/")
(project-match "-NA-REFILE-%inc-PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(let ((task-match "-NA-REFILE-PARENT_TYPE=\"periodical\"/")
(project-match "-NA-REFILE-PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(periodical-match "-NA-REFILE+PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/") (periodical-match "-NA-REFILE+PARENT_TYPE=\"periodical\"-PARENT_TYPE=\"iterator\"/")
(iterator-match "-NA-REFILE-PARENT_TYPE=\"periodical\"+PARENT_TYPE=\"iterator\"/")) (iterator-match "-NA-REFILE-PARENT_TYPE=\"periodical\"+PARENT_TYPE=\"iterator\"/"))
(setq org-agenda-custom-commands (setq org-agenda-custom-commands
`(("t" `(("t"
"Task View" "Task View"
((agenda "" nil) ((agenda "" (org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc"))))
,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT")) ,(nd/agenda-base-task-command task-match "Next Project Tasks" ''(nd/skip-non-keyword-project-tasks "NEXT"))
,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT")) ,(nd/agenda-base-task-command task-match "Waiting Project Tasks" ''(nd/skip-non-keyword-project-tasks "WAIT"))
,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks) ,(nd/agenda-base-task-command project-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)
@ -1161,6 +1168,13 @@ Note that this is used for "normal" projects as well as iterators
,(nd/agenda-base-project-command iterator-match "Active Iterators" :active) ,(nd/agenda-base-project-command iterator-match "Active Iterators" :active)
,(nd/agenda-base-project-command iterator-match "Waiting Iterators" :waiting) ,(nd/agenda-base-project-command iterator-match "Waiting Iterators" :waiting)
,(nd/agenda-base-project-command iterator-match "Held Iterators" :held))) ,(nd/agenda-base-project-command iterator-match "Held Iterators" :held)))
("I"
"Incubator View"
((agenda "" ((org-agenda-span 7)
(org-agenda-time-grid nil)
(org-agenda-entry-types '(:deadline :timestamp))))
,(nd/agenda-base-task-command "-NA-REFILE+%inc/" "Incubated Tasks" ''nd/skip-non-atomic-tasks)
,(nd/agenda-base-project-command "-NA-REFILE+%inc/" "Incubated Projects" :held)))
("r" ("r"
"Refile and Critical Errors" "Refile and Critical Errors"
((tags "REFILE" ((tags "REFILE"
@ -1188,7 +1202,7 @@ Note that this is used for "normal" projects as well as iterators
*** views *** views
**** calendar display **** calendar display
#+BEGIN_SRC emacs-lisp #+BEGIN_SRC emacs-lisp
(setq org-agenda-start-on-weekday 1) (setq org-agenda-start-on-weekday 0)
(setq org-agenda-span 'day) (setq org-agenda-span 'day)
(setq org-agenda-time-grid (quote ((daily today remove-match) (setq org-agenda-time-grid (quote ((daily today remove-match)
#("----------------" 0 16 (org-heading t)) #("----------------" 0 16 (org-heading t))