From c310a3483aa9e5d48d84ba9e3ff22eb915526d1d Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 11 Dec 2018 20:16:02 -0500 Subject: [PATCH] moved org config to separate file --- conf/main.el | 1480 +------------------------------------ conf/main.org | 1802 +--------------------------------------------- conf/org/org.el | 1479 +++++++++++++++++++++++++++++++++++++ conf/org/org.org | 1802 ++++++++++++++++++++++++++++++++++++++++++++++ 4 files changed, 3284 insertions(+), 3279 deletions(-) create mode 100644 conf/org/org.el create mode 100644 conf/org/org.org diff --git a/conf/main.el b/conf/main.el index fc29fdb..d25936c 100644 --- a/conf/main.el +++ b/conf/main.el @@ -305,1485 +305,7 @@ (add-hook 'LaTeX-mode-hook (lambda () (flyspell-mode 1))) -(use-package org - :delight - ;; source of indent-mode required here - (org-indent-mode nil org-indent) - (visual-line-mode) - :hook - (org-mode . visual-line-mode) - :config - (setq org-startup-indented t - org-directory "~/Org" - org-modules '(org-habit org-protocol)) - - (require 'org-protocol)) - -(setq org-special-ctrl-a/e t - org-special-ctrl-k t - org-yank-adjusted-subtrees t) - -(defun nd/org-save-all-org-buffers () - "Save org buffers without confirmation or message (unlike default)." - (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) - (when (featurep 'org-id) (org-id-locations-save))) - -(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers) - -(setq org-log-into-drawer "LOGBOOK") - -(setq org-log-done 'time - org-log-redeadline 'time - org-log-reschedule 'time) - -(setq org-log-repeat 'note) - -(use-package org-bullets - :ensure t - :hook - (org-mode . org-bullets-mode)) - -(add-hook 'org-mode-hook - (lambda () - (let ((heading-height 1.15)) - (set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height) - (set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height) - (set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height) - (set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height) - (set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height)))) - -(setq org-src-window-setup 'current-window - org-src-fontify-natively t - org-edit-src-content-indentation 0) - -(add-to-list 'org-structure-template-alist - '("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC")) - -(setq org-insert-heading-respect-content t) - -(defun nd/mark-subtree-keyword (new-keyword &optional exclude) - "Mark all tasks in a subtree with NEW-KEYWORD unless original -keyword is in the optional argument EXCLUDE." - (let ((subtree-end (save-excursion (org-end-of-subtree t)))) - (if (not (listp exclude)) - (error "exlude must be a list if provided")) - (save-excursion - (while (< (point) subtree-end) - (let ((keyword (nd/is-todoitem-p))) - (if (and keyword (not (member keyword exclude))) - (org-todo new-keyword))) - (outline-next-heading))))) - -(defun nd/mark-subtree-done () - "Mark all tasks in subtree as DONE unless they are already CANC." - (interactive) - (nd/mark-subtree-keyword "DONE" '("CANC"))) - -(defun nd/org-clone-subtree-with-time-shift (n &optional shift) - "Like `org-clone-subtree-with-time-shift' except it resets checkboxes -and reverts all todo keywords to TODO." - (interactive "nNumber of clones to produce: ") - - (let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective) - (read-from-minibuffer - "Date shift per clone (e.g. +1w, empty to copy unchanged): ")))) - (condition-case err - (progn - (save-excursion - ;; clone once and reset - (org-clone-subtree-with-time-shift 1 shift) - (org-forward-heading-same-level 1 t) - (org-reset-checkbox-state-subtree) - (nd/mark-subtree-keyword "TODO") - (call-interactively 'nd/org-log-delete) - (org-cycle) - ;; clone reset tree again if we need more than one clone - (if (> n 1) - (let ((additional-trees (- n 1))) - (org-clone-subtree-with-time-shift additional-trees shift) - (dotimes (i additional-trees) - (org-forward-heading-same-level 1 t) - (org-cycle)))))) - (error (message "%s" (error-message-string err)))))) - -(defun nd/org-log-delete () - "Delete logbook drawer of subtree." - (interactive) - (save-excursion - (goto-char (org-log-beginning)) - (when (save-excursion - (save-match-data - (beginning-of-line 0) - (search-forward-regexp org-drawer-regexp) - (goto-char (match-beginning 1)) - (looking-at "LOGBOOK"))) - (org-mark-element) - (delete-region (region-beginning) (region-end)) - (org-remove-empty-drawer-at (point))))) - -(defun nd/org-insert-todo-heading-inactive-timestamp () - "Insert a todo heading but also insert inactive timestamp set to now." - (interactive) - ;; a bit redundant and hacky, with the advantage of being effective - (when (not (org-insert-item 'checkbox)) - (call-interactively 'org-insert-todo-heading) - (insert "\n") - (funcall-interactively 'org-time-stamp-inactive '(16)) - (forward-line -1))) - -(defun nd/org-delete-subtree () - "Delete the entire subtree under the current heading without sending to kill ring." - (interactive) - (org-back-to-heading t) - (delete-region (point) (+ 1 (save-excursion (org-end-of-subtree))))) - -(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body) - "Wraps commands in BODY in necessary code to allow commands to be -called from the agenda buffer. Particularly, this wrapper will -navigate to the original header, execute BODY, then update the agenda -buffer." - '(org-agenda-check-no-diary) - `(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - ,@body - (when ,get-head (setq newhead (org-get-heading)))) - (if ,get-head - (org-agenda-change-all-lines newhead hdmarker) - (org-agenda-redo)) - (beginning-of-line 1)))) - -(defun nd/org-agenda-toggle-checkbox () - "Toggle checkboxes in org agenda view using `org-toggle-checkbox'." - (interactive) - (nd/org-agenda-cmd-wrapper - t - (call-interactively #'org-toggle-checkbox))) - -(defun nd/org-agenda-clone-subtree-with-time-shift () - "Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry. -It will clone the last entry in the selected subtree." - (interactive) - (nd/org-agenda-cmd-wrapper - nil - (org-end-of-subtree) - (call-interactively #'nd/org-clone-subtree-with-time-shift))) - -(defun nd/org-agenda-delete-subtree () - "Apply `nd/org-delete-subtree' to an agenda entry." - (interactive) - (nd/org-agenda-cmd-wrapper - nil - (call-interactively #'nd/org-delete-subtree))) - -(setq org-columns-default-format - "%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)") - -(set-face-attribute 'org-column nil :background "#1e2023") -;; org-columns-summary-types - -(use-package calfw - :ensure t - :config - (setq cfw:fchar-junction ?╋ - cfw:fchar-vertical-line ?┃ - cfw:fchar-horizontal-line ?━ - cfw:fchar-left-junction ?┣ - cfw:fchar-right-junction ?┫ - cfw:fchar-top-junction ?┯ - cfw:fchar-top-left-corner ?┏ - cfw:fchar-top-right-corner ?┓)) - -(use-package calfw-org - :ensure t - :after calfw - :config - (setq cfw:org-agenda-schedule-args - '(:deadline :timestamp))) - -(defun nd/org-todo-position (buffer alist) - (let ((win (car (cl-delete-if-not - (lambda (window) - (with-current-buffer (window-buffer window) - (memq major-mode - '(org-mode org-agenda-mode)))) - (window-list))))) - (when win - (let ((new (split-window win -4 'below))) - (set-window-buffer new buffer) - new)))) - -(defun nd/org-todo-window-advice (orig-fn) - "Advice to fix window placement in `org-fast-todo-selection'." - (let ((override '("\\*Org todo\\*" nd/org-todo-position))) - (add-to-list 'display-buffer-alist override) - (nd/with-advice - ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) - (unwind-protect (funcall orig-fn) - (setq display-buffer-alist - (delete override display-buffer-alist)))))) - -(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice) - -(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table) - "Advice to fix window placement in `org-fast-tags-selection'." - (nd/with-advice - ((#'delete-other-windows :override #'ignore) - ;; pretty sure I just got lucky here... - (#'split-window-vertically :override #'(lambda (&optional size) - (split-window-below (or size -9))))) - (unwind-protect (funcall orig-fn current inherited table todo-table)))) - -(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice) - -(defun nd/org-capture-position (buffer alist) - (let ((new (split-window (get-buffer-window) -14 'below))) - (set-window-buffer new buffer) - new)) - -(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials) - "Advice to fix window placement in `org-capture-select-template'." - (let ((override '("\\*Org Select\\*" nd/org-capture-position))) - (add-to-list 'display-buffer-alist override) - (nd/with-advice - ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) - (unwind-protect (funcall orig-fn table title prompt specials) - (setq display-buffer-alist - (delete override display-buffer-alist)))))) - -(advice-add #'org-mks :around #'nd/org-capture-window-advice) - -(setq org-html-doctype "html5") - -(setq org-latex-pdf-process (list "latexmk -shell-escape -bibtex -f -pdf %f")) - -;; (defvar nd/org-export-publishing-directory -;; (expand-file-name "~/Downloads/org-exports") -;; "The target directory to for all org exports.") - -;; (defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir) -;; "Change the target export directory for org exports." -;; (unless pub-dir -;; (setq pub-dir nd/org-export-publishing-directory) -;; (unless (file-directory-p pub-dir) -;; (make-directory pub-dir))) -;; (apply orig-fun extension subtreep pub-dir nil)) - -;; (advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name) - -(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/") -(require 'org-gantt) - -(add-to-list 'org-structure-template-alist - '("og" "#+BEGIN: org-gantt-chart\n?\n#+END")) - -(setq org-todo-keywords - '((sequence - ;; default undone state - "TODO(t/!)" - - ;; undone but available to do now (projects only) - "NEXT(n/!)" "|" - - ;; done and complete - "DONE(d/!)") - - (sequence - ;; undone and waiting on some external dependency - "WAIT(w@/!)" - - ;; undone but signifies tasks on which I don't wish to focus at the moment - "HOLD(h@/!)" "|" - - ;; done but not complete - "CANC(c@/!)"))) - -(setq org-todo-keyword-faces - '(("TODO" :foreground "light coral" :weight bold) - ("NEXT" :foreground "khaki" :weight bold) - ("DONE" :foreground "light green" :weight bold) - ("WAIT" :foreground "orange" :weight bold) - ("HOLD" :foreground "violet" :weight bold) - ("CANC" :foreground "deep sky blue" :weight bold))) - -(setq org-tag-alist - ;; (@) gtd location context - '((:startgroup) - ("@errand" . ?e) - ("@home" . ?h) - ("@work" . ?w) - ("@travel" . ?r) - (:endgroup) - - ;; (#) gtd resource context - ("#laptop" . ?l) - ("#tcult" . ?t) - ("#phone" . ?p) - - ;; (%) misc tags - ;; denotes reference information - ("%note" . ?n) - - ;; incubator - ("%inc" . ?i) - - ;; denotes tasks that need further subdivision to turn into true project - ("%subdiv" . ?s) - - ;; catchall to mark important headings, usually for meetings - ("%flag" . ?f) - - ;; (_) life categories, used for gtd priority context - (:startgroup) - ("_env" . ?E) - ("_fin" . ?F) - ("_int" . ?I) - ("_met" . ?M) - ("_phy" . ?H) - ("_pro" . ?P) - ("_rec" . ?R) - ("_soc" . ?S) - (:endgroup))) - -(defun nd/add-tag-face (fg-name prefix) - "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 - to which the faces are applied" - (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist))) - (push `(,tag . (:foreground ,fg-name)) org-tag-faces))) - -(setq org-tag-faces '()) - -(nd/add-tag-face "PaleGreen" "@") -(nd/add-tag-face "SkyBlue" "#") -(nd/add-tag-face "PaleGoldenrod" "%") -(nd/add-tag-face "violet" "_") - -(mapc (lambda (i) (add-to-list 'org-default-properties i)) - ;; defines a repeater group - '("PARENT_TYPE" - ;; defines the time shift for repeater groups - - "TIME_SHIFT" - ;; assigns another person/entity to a task (experimental) - - "DELEGATE" - - ;; defines a goal (not currently used) - "GOAL")) - -(setq org-global-properties - '(("PARENT_TYPE_ALL" . "periodical iterator") - ("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")) - - org-use-property-inheritance - '("PARENT_TYPE" "TIME_SHIFT")) - -(defun nd/org-timestamp-future (days) - "Inserts an active org timestamp DAYS after the current time." - (format-time-string (org-time-stamp-format nil) - (time-add (current-time) (days-to-time 1)))) - -(let ((capfile "~/Org/capture.org")) - (setq org-capture-templates - ;; regular TODO task - `(("t" "todo" entry (file ,capfile) - "* TODO %?\n%U\ndeliverable: \n") - - ;; for useful reference information that may be grouped with tasks - ("n" "note" entry (file ,capfile) - "* %? :\\%note:\n%U\n") - - ;; for non-actionable events that happen at a certain time - ("a" "appointment" entry (file ,capfile) - "* %?\n%U\n%^t\n") - - ;; like appointment but multiple days - ("s" "appointment-span" entry (file ,capfile) - "* %?\n%U\n%^t--%^t\n") - - ;; task with a deadline - ("d" "deadline" entry (file ,capfile) - "* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n") - - ;; for converting mu4e emails to tasks, defaults to next-day deadline - ("e" "email" entry (file ,capfile) - "* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%U\n%a\n") - - ;; for interruptions that produce useful reference material - ("m" "meeting" entry (file ,capfile) - "* meeting with%? :\\%note:\n%U\n") - - ;; for capturing web pages with web browser - ("p" "org-protocol" entry (file ,capfile) - "* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE" - :immediate-finish t) - - ;; or capturing links with web browser - ("L" "org-protocol link" entry (file ,capfile) - "* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U" - :immediate-finish t)))) - -(add-hook 'org-capture-mode-hook (lambda () (evil-append 1))) - -(setq org-refile-targets '((nil :maxlevel . 9) - ("~/Org/reference/idea.org" :maxlevel . 9) - (org-agenda-files :maxlevel . 9)) - org-refile-use-outline-path t - org-outline-path-complete-in-steps nil - org-refile-allow-creating-parent-nodes 'confirm - org-indirect-buffer-display 'current-window) - -(setq org-refile-target-verify-function - (lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords)))) - -;; TODO this no work, although does work if var is global -;; redfining the targets works for now -(add-hook 'org-agenda-mode-hook - (lambda () - (when (equal (buffer-name) "*Org Agenda(A)*") - (setq-local org-refile-targets - '(("~/Org/journal/goals.org" :maxlevel . 9)))))) -;; (lambda () (when (org-entry-get nil "GOAL") t)))))) -;; (setq org-refile-targets '((nil :maxlevel . 9) -;; ("~/Org/reference/idea.org" :maxlevel . 9) -;; ("~/Org/journal/goals.org" :maxlevel . 9) -;; (org-agenda-files :maxlevel . 9)) - -(setq org-clock-history-length 23 - org-clock-out-when-done t - org-clock-persist t - org-clock-report-include-clocking-task t) - -(defun nd/are-conflicting-p (ts-a ts-b) - "Return t if timestamps TS-A and TS-B conflict." - (let* ((earlier-a (car ts-a)) - (earlier-b (car ts-b)) - (later-b (+ earlier-b (nth 1 ts-b)))) - (and (>= earlier-a earlier-b) (<= earlier-a later-b)))) - -(defun nd/detect-conflict (ts ts-list conlist) - "Recursively determine if timestamp TS conflicts with anything in TS-LIST. -If detected, conflict pair is added to CONLIST." - (let ((next-ts (car ts-list)) - (rem-ts (cdr ts-list))) - (if (nd/are-conflicting-p ts next-ts) - (progn - (setq conlist (cons (list ts next-ts) conlist)) - (if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist)) - conlist))) - -(defun nd/build-conlist (ts-list conlist) - "Recursively build a list of timestamp conflicts from TS-LIST. - -TS-LIST is comprised of entries in the form (staring-ts timerange marker) -where timerange is 0 for singular timestamps and a positive number for -anything with to times or a timestamp range. -Detected conflicts are stored in CONLIST as pairs of conflicting ts -entries from the TS-LIST." - (let ((cur-ts (car ts-list)) - (rem-ts (cdr ts-list))) - (if rem-ts - (nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist)) - conlist))) - -(defconst nd/org-tsm-regexp - "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" - "Regular expression for timestamps with two times.") - -(defun nd/get-timestamps () - "Get the org-marker and timestamp(s) (multiple if range) or current heading." - ;; TODO, what if I care about more than just TIMESTAMPs - (let* ((ts (org-entry-get nil "TIMESTAMP")) - (marker (point-marker)) - (ts-range 0) - (ts-entry)) - (when ts - (cond - ;; match timestamps that have two times - ((string-match nd/org-tsm-regexp ts) - (let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts))) - (ts2 (concat (match-string 1 ts) (match-string 3 ts))) - (ft1 (org-2ft ts1)) - (ft2 (org-2ft ts2))) - (setq ts-entry ft1) - (setq ts-range (- ft2 ft1)))) - - ;; match timestamps that have a range (eq two timestamps) - ((string-match org-tr-regexp ts) - (let* ((ts1 (match-string 1 ts)) - (ts2 (match-string 2 ts)) - (ft1 (org-2ft ts1)) - (ft2 (org-2ft ts2))) - (setq ts-entry ft1) - (setq ts-range (- ft2 ft1)))) - - ;; match timestamps with only one time - (t (setq ts-entry (org-2ft ts)))) - (list ts-entry ts-range marker ts)))) - -(defun nd/build-conflict-list () - "Scan all org files and make a list of all timestamps that conflict." - (let ((files (org-agenda-files)) - max-reached ts-list cur-index conflicts) - ;; get all timestamps from org buffers - (dolist (f files ts-list) - (with-current-buffer - (find-file-noselect f) - (goto-char (point-min)) - (when (not (outline-on-heading-p)) (outline-next-heading)) - (setq max-reached nil) - (while (not max-reached) - (let ((new-ts (nd/get-timestamps))) - (if new-ts (setq ts-list (cons new-ts ts-list)))) - (unless (outline-next-heading) (setq max-reached t))))) - - ;; sort the timestamp list - ;; TODO, need to make range-aware - (setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b))))) - - ;; build a list of conflicts - (nd/build-conlist ts-list conflicts))) - -(defun nd/get-conflict-header-text (conflict-marker) - "Return string with text properties representing the org header for -MARKER for use in the conflict agenda view." - (let* ((props (list - 'face nil - 'done-face 'org-agenda-done - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight)) - ;; 'help-echo - ;; (format "mouse-2 or RET jump to org file %s" - ;; (abbreviate-file-name buffer-file-name)))) - marker priority category level tags todo-state - ts-date ts-date-type ts-date-pair - txt beg end inherited-tags todo-state-end-pos) - - (with-current-buffer (marker-buffer conflict-marker) - (save-excursion - (goto-char conflict-marker) - - (setq marker (org-agenda-new-marker (point)) - category (org-get-category) - ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) - ts-date (car ts-date-pair) - ts-date-type (cdr ts-date-pair) - txt (org-get-heading t) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'todo org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? ) - txt (org-agenda-format-item "" txt level category tags t) - priority (1+ (org-get-priority txt))) - - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'priority priority - 'level level - 'ts-date ts-date - 'type "timestamp"))))) - -(defun nd/org-conflicts (&optional arg) - (interactive "P") - - (if org-agenda-overriding-arguments - (setq arg org-agenda-overriding-arguments)) - - (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) - - (let* ((today (org-today)) - (date (calendar-gregorian-from-absolute today)) - (completion-ignore-case t) - (org-agenda-prefix-format '((agenda . " %-12:c %-5:e "))) - rtn rtnall files file pos) - - (catch 'exit - (when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*")) - - (org-agenda-prepare) - ;; (org-compile-prefix-format 'todo) - (org-compile-prefix-format 'agenda) - ;; (org-set-sorting-strategy 'todo) - - (setq org-agenda-redo-command '(nd/org-conflicts)) - - (insert "Conflicting Headings: \n") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading "Conflicts")) - (org-agenda-mark-header-line (point-min)) - - (setq rtnall (nd/build-conflict-list)) - (when rtnall - (mapc - (lambda (c) - (insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n")) - (insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n")) - (insert "\n")) - rtnall)) - - ;; clean up and finalize - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties - (point-min) (point-max) - `(org-agenda-type agenda - org-last-args ,arg - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (org-agenda-finalize) - (setq buffer-read-only t)))) - -(setq org-agenda-files '("~/Org" - "~/Org/projects" - "~/Org/reference/peripheral.org")) - -(setq org-agenda-sticky t) - -(add-hook 'org-finalize-agenda-hook - (lambda () (setq org-agenda-tags-column (- 4 (window-width))) - (org-agenda-align-tags))) - -(setq org-agenda-prefix-format - '((agenda . " %-12:c %-5:e %?-12t% s") - (todo . " %-12:c") - (tags . " %-12:c %-5:e ") - (search . " %-12:c"))) - -(setq org-agenda-dim-blocked-tasks nil - org-agenda-compact-blocks t - org-agenda-window-setup 'current-window - org-agenda-start-on-weekday 0 - org-agenda-span 'day - org-agenda-current-time-string "### -- NOW -- ###") - -(setq org-habit-graph-column 50) - -(defun nd/org-agenda-filter-non-context () - "Filter all tasks with context tags." - (interactive) - (let* ((tags-list (mapcar #'car org-tag-alist)) - (context-tags (append - (nd/filter-list-prefix "@" tags-list) - (nd/filter-list-prefix "#" tags-list)))) - (setq org-agenda-tag-filter - (mapcar (lambda (tag) (concat "-" tag)) context-tags)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - -(defun nd/org-agenda-filter-non-peripheral () - "Filter all tasks that don't have peripheral tags." - (interactive) - (let* ((peripheral-tags '("PERIPHERAL"))) - (setq org-agenda-tag-filter - (mapcar (lambda (tag) (concat "-" tag)) peripheral-tags)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - -(defun nd/org-agenda-filter-non-effort () - "Filter agenda by non-effort tasks." - (interactive) - (setq org-agenda-hasprop-filter '("-Effort")) - (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) - -(defun nd/org-agenda-filter-delegate () - "Filter agenda by tasks with an external delegate." - (interactive) - (setq org-agenda-hasprop-filter '("+DELEGATE")) - (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) - -;; initialize new filters -(defvar org-agenda-hasprop-filter nil) - -(defun nd/org-agenda-filter-make-matcher-prop - (filter type &rest args) - "Return matching matcher form for FILTER and TYPE where TYPE is not -in the regular `org-agenda-filter-make-matcher' function. This is -intended to be uses as :before-until advice and will return nil if -the type is not valid (which is currently 'prop')" - (let (f f1) - ;; has property - (cond - ((eq type 'hasprop) - (dolist (x filter) - (push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f)))) - (if f (cons 'and (nreverse f))))) - -(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h) - "Returns form to test the presence or absence of properties H. -H is a string like +prop or -prop" - (let (op) - (let* ((op (string-to-char h)) - (h (substring h 1)) - (f `(save-excursion - (let ((m (org-get-at-bol 'org-hd-marker))) - (with-current-buffer - (marker-buffer m) - (goto-char m) - (org-entry-get nil ,h)))))) - (if (eq op ?-) (list 'not f) f)))) - -(defun nd/org-agenda-filter-show-all-hasprop nil - (org-agenda-remove-filter 'hasprop)) - -(advice-add #'org-agenda-filter-make-matcher :before-until - #'nd/org-agenda-filter-make-matcher-prop) - -(advice-add #'org-agenda-filter-remove-all :before - (lambda () (when org-agenda-hasprop-filter - (nd/org-agenda-filter-show-all-hasprop)))) - -(setq org-agenda-bulk-custom-functions - '((?D nd/org-agenda-delete-subtree))) - -(setq holiday-bahai-holidays nil - holiday-hebrew-holidays nil - holiday-oriental-holidays nil - holiday-islamic-holidays nil) - -(setq calendar-holidays (append holiday-general-holidays - holiday-christian-holidays)) - -(defconst nd/iter-future-time (* 7 24 60 60) - "Iterators must have at least one task greater into the future to be active.") - -(defconst nd/iter-statuscodes '(:uninit :empty :active) - "Iterators can have these statuscodes.") - -(defconst nd/peri-future-time nd/iter-future-time - "Periodicals must have at least one heading greater into the future to be fresh.") - -(defconst nd/peri-statuscodes '(:uninit :stale :fresh)) - -(defconst nd/project-invalid-todostates - '("WAIT" "NEXT") - "Projects cannot have these todostates.") - -(defvar nd/agenda-limit-project-toplevel t - "If true, filter projects by all levels or top level only.") - -(defvar nd/agenda-hide-incubator-tags t - "If true, don't show incubator headings.") - -(defconst nd/org-agenda-todo-sort-order - '("NEXT" "WAIT" "HOLD" "TODO") - "Defines the order in which todo keywords should be sorted.") - -(defconst nd/project-skip-todostates - '("HOLD" "CANC") - "These keywords override all contents within their subtrees. -Currently used to tell skip functions when they can hop over -entire subtrees to save time and ignore tasks") - -(defun nd/get-date-property (timestamp-property) - "Get TIMESTAMP-PROPERTY on current heading and convert to a number. -If it does not have a date, it will return nil." - (let ((ts (org-entry-get nil timestamp-property))) - (when ts (org-2ft ts)))) - -(defun nd/heading-compare-timestamp (timestamp-fun - &optional ref-time future) - "Returns the timestamp (from TIMESTAMP-FUM on the current heading) -if timestamp is futher back in time compared to a REF-TIME (default to -0 which is now, where negative is past and positive is future). If the -FUTURE flag is t, returns timestamp if it is in the future compared -to REF-TIME. Returns nil if no timestamp is found." - (let* ((timestamp (funcall timestamp-fun)) - (ref-time (or ref-time 0))) - (if (and timestamp - (if future - (> (- timestamp (float-time)) ref-time) - (<= (- timestamp (float-time)) ref-time))) - timestamp))) - -(defun nd/is-ia-timestamped-heading-p () - "Get active timestamp of current heading." - (nd/get-date-property "TIMESTAMP_IA")) - -(defun nd/is-timestamped-heading-p () - "Get active timestamp of current heading." - (nd/get-date-property "TIMESTAMP")) - -(defun nd/is-scheduled-heading-p () - "Get scheduled timestamp of current heading." - (nd/get-date-property "SCHEDULED")) - -(defun nd/is-deadlined-heading-p () - "Get deadline timestamp of current heading." - (nd/get-date-property "DEADLINE")) - -(defun nd/is-closed-heading-p () - "Get closed timestamp of current heading." - (nd/get-date-property "CLOSED")) - -(defun nd/is-stale-heading-p (&optional ts-prop) - "Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale." - (nd/heading-compare-timestamp - (lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP")))) - (when (and ts (not (find ?+ ts))) (org-2ft ts)))))) - -(defun nd/is-fresh-heading-p () - "Return timestamp if current heading is fresh." - (nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t)) - -(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 current heading is archivable." - (nd/heading-compare-timestamp - 'nd/is-closed-heading-p - (- (* 60 60 24 nd/archive-delay-days)))) - -(defun nd/is-todoitem-p () - "Return todo keyword if heading has one." - (let ((keyword (nth 2 (org-heading-components)))) - (if (member keyword org-todo-keywords-1) - keyword))) - -(defun nd/is-project-p () - "Return todo keyword if heading has todoitem children." - (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) - -(defun nd/is-task-p () - "Return todo keyword if heading has todoitem children." - (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) - -(defun nd/is-project-task-p () - "Return todo keyword if heading has todoitem parents." - (and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p))) - -(defun nd/is-atomic-task-p () - "Return todo keyword if heading has no todoitem parents or children." - (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) - -(defun nd/is-periodical-heading-p () - "Return t if heading is a periodical." - (equal "periodical" (org-entry-get nil "PARENT_TYPE" t))) - -(defun nd/is-iterator-heading-p () - "Return t if heading is an iterator." - (equal "iterator" (org-entry-get nil "PARENT_TYPE" t))) - -(defun nd/heading-has-effort-p () - "Return t if heading has an effort." - (org-entry-get nil "Effort")) - -(defun nd/heading-has-context-p () - "Return t if heading has a context." - (let ((tags (org-get-tags-at))) - (or (> (length (nd/filter-list-prefix "#" tags)) 0) - (> (length (nd/filter-list-prefix "@" tags)) 0)))) - -(defun nd/heading-has-tag-p (tag) - "Return t if heading has tag TAG." - (member tag (org-get-tags-at))) - -(defun nd/heading-has-children (heading-test) - "Return t if heading has a child for whom HEADING-TEST is t." - (let ((subtree-end (save-excursion (org-end-of-subtree t))) - has-children previous-point) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not has-children) - (< previous-point (point) subtree-end)) - (when (funcall heading-test) - (setq has-children t)) - (setq previous-point (point)) - (org-forward-heading-same-level 1 t))) - has-children)) - -(defun nd/heading-has-parent (heading-test) - "Return t if heading has parent for whom HEADING-TEST is t." - (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) - -(defun nd/has-discontinuous-parent () - "Return t if heading has a non-todoitem parent which in turn has a todoitem parent." - (let ((has-todoitem-parent) - (has-non-todoitem-parent)) - (save-excursion - (while (and (org-up-heading-safe) - (not has-todoitem-parent)) - (if (nd/is-todoitem-p) - (setq has-todoitem-parent t) - (setq has-non-todoitem-parent t)))) - (and has-todoitem-parent has-non-todoitem-parent))) - -(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list) - "Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP." - `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) - -(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status) - "Loop through (sub)project and return overall statuscode. - -The returned statuscode is chosen from list ALLOWED-STATUSCODES where -later entries in the list trump earlier ones. - -When a subproject is encountered, this function will obtain the -statuscode of that project and use TRANS-TBL to translate the -subproject statuscode to one in ALLOWED-STATUSCODES (if not found an -error will be raised). TRANS-TBL is given as an alist of two-member -cons cells where the first member is the subproject statuscode and the - second is the index in ALLOWED-STATUSCODES to which the subproject -statuscode will be translated. - -When a task is encountered, function GET-TASK-STATUS will be applied to -obtain a statuscode-equivalent of the status of the tasks." - ;; define "breaker-status" as the last of the allowed-statuscodes - ;; when this is encountered the loop is broken because we are done - ;; (the last entry trumps all others) - (let ((project-status (first allowed-statuscodes)) - (breaker-status (car (last allowed-statuscodes))) - (previous-point)) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - ;; loop through subproject tasks until breaker-status found - (while (and (not (eq project-status breaker-status)) - (> (point) previous-point)) - (let ((keyword (nd/is-todoitem-p))) - (if keyword - (let ((new-status - ;; if project then descend recursively - (if (nd/heading-has-children 'nd/is-todoitem-p) - (let ((n (nd/get-project-status))) - ;; if project returns an allowed status - ;; then use that - (or (and (member n allowed-statuscodes) n) - ;; otherwise look up the value in the - ;; translation table and return error - ;; if not found - (nth (or (alist-get n trans-tbl) - (error (concat "status not found: " n))) - allowed-statuscodes))) - ;; if tasks then use get-task-status to obtain status - (nth (funcall get-task-status keyword) - allowed-statuscodes)))) - (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes) - (setq project-status new-status))))) - (setq previous-point (point)) - (org-forward-heading-same-level 1 t))) - project-status)) - -(defun nd/get-project-status () - "Return project heading statuscode (assumes it is indeed a project)." - (let ((keyword (nd/is-todoitem-p))) - ;; - ;; these first three are easy because they only require - ;; testing the project headline and nothing underneath - ;; - (cond - ;; it does not make sense for projects to be scheduled - ((nd/is-scheduled-heading-p) :scheduled-project) - - ;; held projects do not care what is underneath them - ((equal keyword "HOLD") :held) - - ;; projects with invalid todostates are nonsense - ((member keyword nd/project-invalid-todostates) - :invalid-todostate) - - ;; - ;; these require descending into the project subtasks - ;; - - ;; canceled projects can either be archivable or complete - ;; any errors or undone tasks are irrelevant - ((equal keyword "CANC") - (nd/descend-into-project - '(:archivable :complete) - '((:stuck . 1) - (:held . 1) - (:waiting . 1) - (:active . 1) - (:scheduled-project . 1) - (:invalid-todostate . 1) - (:undone-complete . 1) - (:done-incomplete . 1)) - (lambda (k) - (if (and (member k org-done-keywords) - (nd/is-archivable-heading-p)) 0 1)))) - - ;; done projects are like canceled projects but can also be incomplete - ((equal keyword "DONE") - (nd/descend-into-project - '(:archivable :complete :done-incomplete) - '((:stuck . 2) - (:held . 2) - (:waiting . 2) - (:active . 2) - (:scheduled-project . 2) - (:invalid-todostate . 2) - (:undone-complete . 2)) - (lambda (k) - (if (member k org-done-keywords) - (if (nd/is-archivable-heading-p) 0 1) - 2)))) - - ;; project with TODO states could be basically any status - ((equal keyword "TODO") - (nd/descend-into-project - '(:undone-complete :stuck :held :waiting :active) - '((:complete . 0) - (:archivable . 0) - (:scheduled-project . 1) - (:invalid-todostate . 1) - (:done-incomplete . 1)) - (lambda (k) - (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1)) - ((equal k "HOLD") 2) - ((equal k "WAIT") 3) - ((equal k "NEXT") 4) - (t 0))))) - - (t (error (concat "invalid keyword detected: " keyword)))))) - -(defun nd/get-iterator-status () - "Get the status of an iterator where allowed statuscodes are in list - `nd/get-iter-statuscodes.' where latter codes in the list trump -earlier ones." - (let ((iter-status (first nd/iter-statuscodes)) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not (eq iter-status :active)) - (< (point) subtree-end)) - (let ((keyword (nd/is-atomic-task-p)) - (new-status)) - (if keyword - (progn - (setq new-status (if (nd/heading-compare-timestamp - (lambda () - (or (nd/is-scheduled-heading-p) - (nd/is-deadlined-heading-p))) - nd/iter-future-time t) - :active - :empty)) - (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes) - (setq iter-status new-status))))) - (outline-next-heading))) - iter-status)) - -(defun nd/get-periodical-status () - "Get the status of a periodical where allowed statuscodes are in list - `nd/get-peri-statuscodes.' where latter codes in the list trump -earlier ones." - (let ((peri-status :uninit) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not (eq peri-status :fresh)) - (< (point) subtree-end)) - (if (and (nd/is-periodical-heading-p) - (not (nd/heading-has-children 'nd/is-periodical-heading-p))) - (let ((new-status - (if (nd/heading-compare-timestamp - 'nd/is-timestamped-heading-p - nd/iter-future-time t) - :fresh - :stale))) - (if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes) - (setq peri-status new-status)))) - (outline-next-heading))) - peri-status)) - -(defun nd/skip-heading () - "Skip forward to next heading." - (save-excursion (or (outline-next-heading) (point-max)))) - -(defun nd/skip-subtree () - "Skip forward to next subtree." - (save-excursion (or (org-end-of-subtree t) (point-max)))) - - -(defmacro nd/skip-heading-without (heading-fun test-fun) - "Skip headings accoring to certain characteristics. - -HEADING-FUN is a function that tests the heading and returns the -todoitem keyword on success. TEST-FUN is a function that further tests -the identity of the heading and may or may not use the keyword output -supplied by the HEADING-FUN. This function will not skip if -HEADING-FUN and TEST-FUN return true" - `(save-restriction - (widen) - (let ((keyword (,heading-fun))) - ;; (message keyword) - (if (not (and keyword ,test-fun)) - (nd/skip-heading))))) - -(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list) - "Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST." - (save-restriction - (widen) - (let ((heading-tags (org-get-tags-at))) - (if (and (or (not pos-tags-list) - (intersection pos-tags-list heading-tags :test 'equal)) - (not (intersection neg-tags-list heading-tags :test 'equal))) - (nd/skip-heading))))) - -(defun nd/skip-non-stale-headings () - "Skip headings that do not have stale timestamps and are not part of projects." - (save-restriction - (widen) - (let ((keyword (nd/is-todoitem-p))) - (if (not - (and (nd/is-stale-heading-p) - (not (member keyword org-done-keywords)) - (not (nd/heading-has-children 'nd/is-todoitem-p)) - (not (nd/heading-has-parent 'nd/is-todoitem-p)))) - (nd/skip-heading))))) - -(defun nd/skip-non-ia-timestamped-tasks () - "Skip tasks that do not have an inactive timestamp." - (save-excursion - (widen) - (if (not (and (nd/is-task-p) - (not (nd/is-ia-timestamped-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-atomic-tasks () - "Skip headings that are not atomic tasks." - (save-excursion - (widen) - (if (not (nd/is-atomic-task-p)) - (nd/skip-heading)))) - -(defun nd/skip-non-closed-atomic-tasks () - "Skip headings that are not complete (but not archivable) atomic tasks." - (nd/skip-heading-without - nd/is-atomic-task-p - (and (member keyword org-done-keywords) - (not (nd/is-archivable-heading-p))))) - -(defun nd/skip-non-archivable-atomic-tasks () - "Skip headings that are not archivable atomic tasks." - (nd/skip-heading-without - nd/is-atomic-task-p - (nd/is-archivable-heading-p))) - -(defun nd/skip-non-iterator-parent-headings () - "Skip headings that are not toplevel iterator headings." - (save-restriction - (widen) - (if (not (and (nd/is-iterator-heading-p) - (not (nd/heading-has-parent 'nd/is-iterator-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-iterator-unscheduled () - "Skip all headings that are not unscheduled iterator children." - (nd/skip-heading-without - nd/is-atomic-task-p - (not (or (nd/is-scheduled-heading-p) - (nd/is-deadlined-heading-p))))) - -(defun nd/skip-non-periodical-parent-headings () - "Skip headings that are not toplevel periodical headings." - (save-restriction - (widen) - (if (not (and (nd/is-periodical-heading-p) - (not (nd/heading-has-parent 'nd/is-periodical-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-periodical-untimestamped () - "Skip all headings that are not periodical children without a timestamp." - (save-restriction - (widen) - (if (not (and (nd/is-periodical-heading-p) - (not (nd/is-timestamped-heading-p)) - (not (nd/heading-has-children 'nd/is-periodical-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-project-tasks () - "Skip headings that are not project tasks." - (save-restriction - (widen) - (let ((keyword (nd/is-todoitem-p))) - (if keyword - (if (nd/heading-has-children 'nd/is-todoitem-p) - (if (member keyword nd/project-skip-todostates) - (nd/skip-subtree) - (nd/skip-heading)) - (if (not (nd/heading-has-parent 'nd/is-todoitem-p)) - (nd/skip-heading))) - (nd/skip-heading))))) - -(defun nd/skip-non-discontinuous-project-tasks () - "Skip headings that are not discontinuous within projects." - (nd/skip-heading-without - nd/is-todoitem-p - (nd/has-discontinuous-parent))) - -(defun nd/skip-non-done-unclosed-todoitems () - "Skip headings that are not completed without a closed timestamp." - (nd/skip-heading-without - nd/is-todoitem-p - (and (member keyword org-done-keywords) - (not (nd/is-closed-heading-p))))) - -(defun nd/skip-non-undone-closed-todoitems () - "Skip headings that are not incomplete with a closed timestamp." - (nd/skip-heading-without - nd/is-todoitem-p - (and (not (member keyword org-done-keywords)) - (nd/is-closed-heading-p)))) - -(defun nd/skip-non-projects (&optional ignore-toplevel) - "Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)." - (save-restriction - (widen) - (let ((keyword (nd/is-project-p))) - (if keyword - (if (and nd/agenda-limit-project-toplevel - (not ignore-toplevel) - (nd/heading-has-parent 'nd/is-todoitem-p)) - (nd/skip-subtree)) - (nd/skip-heading))))) - -(defun nd/org-agenda-filter-status (filter status-fun a-line - &optional filter-only) - "Filter for `org-agenda-before-sorting-filter-function' intended for -agenda project views (eg makes the assumption that all entries are -from projects in the original org buffer) wherein this function will -filter project headings based on their statuscodes. - -It works by going to the original org buffer and determining the -project status using STATUS-FUN, after which it will check if -status is in FILTER (a list of statuscodes). If true, the flag string -in the prefix is replaced with the status, and the status is set as a -text property for further sorting. - -If option FILTER-ONLY is t, function only return the unmodified a-line -or nil to act as a filter (eg does not touch text properties)." - (let* ((m (get-text-property 1 'org-marker a-line)) - (s (with-current-buffer (marker-buffer m) - (goto-char m) - (funcall status-fun)))) - (if (member s filter) - (if filter-only - a-line - (org-add-props (replace-regexp-in-string - "xxxx" (symbol-name s) a-line) - nil 'project-status s))))) - -(defun nd/org-agenda-sort-prop (prop order a b) - "Sort a block agenda view by text property PROP given a list ORDER -of said text properties in the desired order and lines A and B as -inputs. To be used with `org-agenda-cmp-user-defined'." - (let* ((ta (get-text-property 1 prop a)) - (tb (get-text-property 1 prop b)) - (pa (position ta order :test (if (stringp ta) #'equal))) - (pb (position tb order :test (if (stringp tb) #'equal)))) - (cond ((or (null pa) (null pb)) nil) - ((< pa pb) +1) - ((> pa pb) -1)))) - -(defun nd/agenda-base-heading-cmd (match header skip-fun) - "Make a tags agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN." - `(tags - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-sorting-strategy '(category-keep))))) - -(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort) - "Make a tags-todo agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN. Also -takes a sorting structure SORT which is passed to -`org-agenda-sorting-strategy'" - (or sort (setq sort ''(category-keep))) - `(tags-todo - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-todo-ignore-with-date t) - (org-agenda-sorting-strategy ,sort)))) - -(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun - &optional todo status-px) - "Make a tags-todo agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN. KW-LIST -is a list of keywords to be used in filtering and sorting (the order -in the list defines the sort order). STATUS-FUN is a function used to -get the statuscode of the current line in the agenda. Optional arg -TODO determines if this is a tags-todo (t) or tags (nil) block, and -STATUS-PX as t enables the statuscode to be formatted into the prefix -string." - `(,(if 'tags-todo 'tags) - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-before-sorting-filter-function - (lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l))) - (org-agenda-cmp-user-defined - (lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b))) - (org-agenda-prefix-format '((tags . ,(if status-px - " %-12:c %(format \"xxxx: \")" - " %-12:c ")))) - (org-agenda-sorting-strategy '(user-defined-down category-keep))))) - -(defun nd/toggle-project-toplevel-display () - "Toggle all project headings and toplevel only headings in project blocks." - (interactive) - (setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel)) - (when (equal major-mode 'org-agenda-mode) - (org-agenda-redo)) - (message "Showing %s project view in agenda" - (if nd/agenda-limit-project-toplevel "toplevel" "complete"))) - -(defun nd/org-tags-view-advice (orig-fn &optional todo-only match) - "Advice to include done states in `org-tags-view' for tags-todo agenda types." - (nd/with-advice - ((#'org-make-tags-matcher - :around (lambda (f m) - (let ((org--matcher-tags-todo-only nil)) - (funcall f m))))) - (funcall orig-fn todo-only match))) - -(advice-add #'org-tags-view :around #'nd/org-tags-view-advice) - -(setq org-agenda-tags-todo-honor-ignore-options t) - -(setq org-agenda-cmp-user-defined - '(lambda (a b) - (let ((pa (- (length (member - (get-text-property 1 'todo-state a) - nd/org-agenda-todo-sort-order)))) - (pb (- (length (member - (get-text-property 1 'todo-state b) - nd/org-agenda-todo-sort-order))))) - (cond ((or (null pa) (null pb)) nil) - ((> pa pb) +1) - ((< pa pb) -1))))) - -(let* ((actionable "-NA-REFILE-%inc") - (periodical "PARENT_TYPE=\"periodical\"") - (iterator "PARENT_TYPE=\"iterator\"") - (habit "STYLE=\"habit\"") - (task-match (concat actionable "-" periodical "-" habit "/!")) - (act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!")) - (peri-match (concat actionable "+" periodical "-" iterator "-" habit)) - (iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!"))) - - (setq - org-agenda-custom-commands - `(("a" - "Calendar View" - ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE"))) - (org-agenda-include-diary t))))) - - ("t" - "Task View" - (,(nd/agenda-base-task-cmd act-no-rep-match - "Project Tasks" - ''nd/skip-non-project-tasks - ''(user-defined-up category-keep)) - ,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks))) - - ("p" - "Project View" - (,(nd/agenda-base-project-cmd - act-no-rep-match - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects") - ''nd/skip-non-projects - ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete - :stuck :waiting :held :active) - ''nd/get-project-status t t))) - - ("i" - "Incubator View" - ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc"))) - (org-agenda-span 7) - (org-agenda-time-grid nil) - (org-agenda-entry-types '(:deadline :timestamp :scheduled)))) - ,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc" - "Stale Incubated Timestamps" - ''nd/skip-non-stale-headings) - ,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!" - "Incubated Tasks" - ''nd/skip-non-atomic-tasks) - ,(nd/agenda-base-project-cmd - "-NA-REFILE+%inc/!" - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects") - ''nd/skip-non-projects - ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete - :stuck :waiting :held :active) - ''nd/get-project-status - t t))) - - ("P" - "Periodical View" - (,(nd/agenda-base-project-cmd - (concat actionable "-" iterator "+" periodical "-" habit) - "Periodical Status" - ''nd/skip-non-periodical-parent-headings - 'nd/peri-statuscodes ''nd/get-periodical-status nil t) - ,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\"" - "Untimestamped" - ''nd/skip-non-periodical-untimestamped))) - - ("I" - "Iterator View" - (,(nd/agenda-base-project-cmd - "-NA-REFILE+PARENT_TYPE=\"iterator\"" - "Iterator Status" - ''nd/skip-non-iterator-parent-headings - 'nd/iter-statuscodes ''nd/get-iterator-status nil t) - ,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!" - "Unscheduled or Undeaded" - ''nd/skip-non-iterator-unscheduled))) - - ("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) - (org-tags-match-list-sublevels nil)))) - - ("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks"))))) - - ("e" - "Critical Errors" - (,(nd/agenda-base-task-cmd task-match - "Discontinous Project" - ''nd/skip-non-discontinuous-project-tasks) - ,(nd/agenda-base-heading-cmd task-match - "Undone Closed" - ''nd/skip-non-undone-closed-todoitems) - ,(nd/agenda-base-heading-cmd (concat actionable "-" periodical) - "Done Unclosed" - ''nd/skip-non-done-unclosed-todoitems) - ,(nd/agenda-base-task-cmd (concat task-match) - "Missing Creation Timestamp" - ''nd/skip-non-ia-timestamped-tasks))) - - - ("A" - "Archivable Tasks and Projects" - ((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC") - ((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators") - (org-agenda-sorting-strategy '(category-keep)) - (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks))) - ,(nd/agenda-base-heading-cmd (concat actionable "-" habit) - "Stale Tasks and Periodicals" - ''nd/skip-non-stale-headings) - ,(nd/agenda-base-project-cmd - (concat actionable "-" periodical "-" iterator "-" habit) - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects") - ''nd/skip-non-projects ''(:archivable) ''nd/get-project-status)))))) +(org-babel-load-file (expand-file-name "org/org.org" nd/conf-dir)) (defun nd/helm-set-printer-name () "Set the printer name using helm-completion to select printer." diff --git a/conf/main.org b/conf/main.org index 4043773..878617e 100644 --- a/conf/main.org +++ b/conf/main.org @@ -423,1807 +423,9 @@ Spell checking is important for prose (add-hook 'LaTeX-mode-hook (lambda () (flyspell-mode 1))) #+END_SRC * org-mode -** major mode -*** package -Enable =visual-line-mode= and =org-indent-mode= by default and delight them. Also load =org-protocol= after org is loaded and set default org directory to something obvious. +My org config is massive and therefore stored in another file. #+BEGIN_SRC emacs-lisp -(use-package org - :delight - ;; source of indent-mode required here - (org-indent-mode nil org-indent) - (visual-line-mode) - :hook - (org-mode . visual-line-mode) - :config - (setq org-startup-indented t - org-directory "~/Org" - org-modules '(org-habit org-protocol)) - - (require 'org-protocol)) -#+END_SRC -*** special key behavior -These don't work in evil mode (using the usual line commands). -#+BEGIN_SRC emacs-lisp -(setq org-special-ctrl-a/e t - org-special-ctrl-k t - org-yank-adjusted-subtrees t) -#+END_SRC -*** autosave -Save all org buffers 1 minute before the hour. -#+BEGIN_SRC emacs-lisp -(defun nd/org-save-all-org-buffers () - "Save org buffers without confirmation or message (unlike default)." - (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) - (when (featurep 'org-id) (org-id-locations-save))) - -(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers) -#+END_SRC -*** logging -**** drawer -I prefer all logging to go in a seperate drawer (aptly named) which allows easier navigation and parsing for data analytics. -#+BEGIN_SRC emacs-lisp -(setq org-log-into-drawer "LOGBOOK") -#+END_SRC -**** events -Events are nice to record because it enables tracking of my behavior (eg how often I reschedule, which may indicate how well I can predict when things should happen). -#+BEGIN_SRC emacs-lisp -(setq org-log-done 'time - org-log-redeadline 'time - org-log-reschedule 'time) -#+END_SRC -**** repeated tasks -In these cases, it is nice to know what happened during each cycle, so force notes. -#+BEGIN_SRC emacs-lisp -(setq org-log-repeat 'note) -#+END_SRC -*** bullets -These are just so much better to read -#+BEGIN_SRC emacs-lisp -(use-package org-bullets - :ensure t - :hook - (org-mode . org-bullets-mode)) -#+END_SRC -*** font height -The fonts in org headings bug me; make them smaller and less invasive. -#+BEGIN_SRC emacs-lisp -(add-hook 'org-mode-hook - (lambda () - (let ((heading-height 1.15)) - (set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height) - (set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height) - (set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height) - (set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height) - (set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height)))) -#+END_SRC -*** src blocks -Enable shortcuts for embedding code in org text bodies. -#+BEGIN_SRC emacs-lisp -(setq org-src-window-setup 'current-window - org-src-fontify-natively t - org-edit-src-content-indentation 0) - -(add-to-list 'org-structure-template-alist - '("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC")) -#+END_SRC -*** todo insertion -Make todo insertion respect contents -#+BEGIN_SRC emacs-lisp -(setq org-insert-heading-respect-content t) -#+END_SRC -*** interactive commands -Some useful additional commands for org buffers. -#+BEGIN_SRC emacs-lisp -(defun nd/mark-subtree-keyword (new-keyword &optional exclude) - "Mark all tasks in a subtree with NEW-KEYWORD unless original -keyword is in the optional argument EXCLUDE." - (let ((subtree-end (save-excursion (org-end-of-subtree t)))) - (if (not (listp exclude)) - (error "exlude must be a list if provided")) - (save-excursion - (while (< (point) subtree-end) - (let ((keyword (nd/is-todoitem-p))) - (if (and keyword (not (member keyword exclude))) - (org-todo new-keyword))) - (outline-next-heading))))) - -(defun nd/mark-subtree-done () - "Mark all tasks in subtree as DONE unless they are already CANC." - (interactive) - (nd/mark-subtree-keyword "DONE" '("CANC"))) - -(defun nd/org-clone-subtree-with-time-shift (n &optional shift) - "Like `org-clone-subtree-with-time-shift' except it resets checkboxes -and reverts all todo keywords to TODO." - (interactive "nNumber of clones to produce: ") - - (let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective) - (read-from-minibuffer - "Date shift per clone (e.g. +1w, empty to copy unchanged): ")))) - (condition-case err - (progn - (save-excursion - ;; clone once and reset - (org-clone-subtree-with-time-shift 1 shift) - (org-forward-heading-same-level 1 t) - (org-reset-checkbox-state-subtree) - (nd/mark-subtree-keyword "TODO") - (call-interactively 'nd/org-log-delete) - (org-cycle) - ;; clone reset tree again if we need more than one clone - (if (> n 1) - (let ((additional-trees (- n 1))) - (org-clone-subtree-with-time-shift additional-trees shift) - (dotimes (i additional-trees) - (org-forward-heading-same-level 1 t) - (org-cycle)))))) - (error (message "%s" (error-message-string err)))))) - -(defun nd/org-log-delete () - "Delete logbook drawer of subtree." - (interactive) - (save-excursion - (goto-char (org-log-beginning)) - (when (save-excursion - (save-match-data - (beginning-of-line 0) - (search-forward-regexp org-drawer-regexp) - (goto-char (match-beginning 1)) - (looking-at "LOGBOOK"))) - (org-mark-element) - (delete-region (region-beginning) (region-end)) - (org-remove-empty-drawer-at (point))))) - -(defun nd/org-insert-todo-heading-inactive-timestamp () - "Insert a todo heading but also insert inactive timestamp set to now." - (interactive) - ;; a bit redundant and hacky, with the advantage of being effective - (when (not (org-insert-item 'checkbox)) - (call-interactively 'org-insert-todo-heading) - (insert "\n") - (funcall-interactively 'org-time-stamp-inactive '(16)) - (forward-line -1))) - -(defun nd/org-delete-subtree () - "Delete the entire subtree under the current heading without sending to kill ring." - (interactive) - (org-back-to-heading t) - (delete-region (point) (+ 1 (save-excursion (org-end-of-subtree))))) - -#+END_SRC -*** interactive agenda commands -These are executed directly from agenda views and affect their source org buffers. The trick is that all of them must somehow go back to the heading to which they alude, execute, then update the agenda view with whatever changes have been made. -#+BEGIN_SRC emacs-lisp -(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body) - "Wraps commands in BODY in necessary code to allow commands to be -called from the agenda buffer. Particularly, this wrapper will -navigate to the original header, execute BODY, then update the agenda -buffer." - '(org-agenda-check-no-diary) - `(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) - (org-agenda-error))) - (buffer (marker-buffer hdmarker)) - (pos (marker-position hdmarker)) - (inhibit-read-only t) - newhead) - (org-with-remote-undo buffer - (with-current-buffer buffer - (widen) - (goto-char pos) - (org-show-context 'agenda) - ,@body - (when ,get-head (setq newhead (org-get-heading)))) - (if ,get-head - (org-agenda-change-all-lines newhead hdmarker) - (org-agenda-redo)) - (beginning-of-line 1)))) - -(defun nd/org-agenda-toggle-checkbox () - "Toggle checkboxes in org agenda view using `org-toggle-checkbox'." - (interactive) - (nd/org-agenda-cmd-wrapper - t - (call-interactively #'org-toggle-checkbox))) - -(defun nd/org-agenda-clone-subtree-with-time-shift () - "Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry. -It will clone the last entry in the selected subtree." - (interactive) - (nd/org-agenda-cmd-wrapper - nil - (org-end-of-subtree) - (call-interactively #'nd/org-clone-subtree-with-time-shift))) - -(defun nd/org-agenda-delete-subtree () - "Apply `nd/org-delete-subtree' to an agenda entry." - (interactive) - (nd/org-agenda-cmd-wrapper - nil - (call-interactively #'nd/org-delete-subtree))) -#+END_SRC -** column view -#+BEGIN_SRC emacs-lisp - (setq org-columns-default-format - "%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)") - - (set-face-attribute 'org-column nil :background "#1e2023") - ;; org-columns-summary-types -#+END_SRC -** calfw -This is a nifty calendar...sometimes way faster than the agenda buffer for looking at long term things. -#+BEGIN_SRC emacs-lisp -(use-package calfw - :ensure t - :config - (setq cfw:fchar-junction ?╋ - cfw:fchar-vertical-line ?┃ - cfw:fchar-horizontal-line ?━ - cfw:fchar-left-junction ?┣ - cfw:fchar-right-junction ?┫ - cfw:fchar-top-junction ?┯ - cfw:fchar-top-left-corner ?┏ - cfw:fchar-top-right-corner ?┓)) - -(use-package calfw-org - :ensure t - :after calfw - :config - (setq cfw:org-agenda-schedule-args - '(:deadline :timestamp))) -#+END_SRC -** window splitting -Org mode is great and all, but the windows never show up in the right place. The solutions here are simple, but have the downside that the window sizing must be changed when tags/capture templates/todo items are changed. This is because the buffer size is not known at window creation time and I didn't feel like making a function to predict it -*** todo selection -I only need a teeny tiny window below my current window for todo selection -#+BEGIN_SRC emacs-lisp -(defun nd/org-todo-position (buffer alist) - (let ((win (car (cl-delete-if-not - (lambda (window) - (with-current-buffer (window-buffer window) - (memq major-mode - '(org-mode org-agenda-mode)))) - (window-list))))) - (when win - (let ((new (split-window win -4 'below))) - (set-window-buffer new buffer) - new)))) - -(defun nd/org-todo-window-advice (orig-fn) - "Advice to fix window placement in `org-fast-todo-selection'." - (let ((override '("\\*Org todo\\*" nd/org-todo-position))) - (add-to-list 'display-buffer-alist override) - (nd/with-advice - ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) - (unwind-protect (funcall orig-fn) - (setq display-buffer-alist - (delete override display-buffer-alist)))))) - -(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice) -#+END_SRC -*** tag selection -By default, the tag selection window obliterates all but the current window...how disorienting :/ -#+BEGIN_SRC emacs-lisp -(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table) - "Advice to fix window placement in `org-fast-tags-selection'." - (nd/with-advice - ((#'delete-other-windows :override #'ignore) - ;; pretty sure I just got lucky here... - (#'split-window-vertically :override #'(lambda (&optional size) - (split-window-below (or size -9))))) - (unwind-protect (funcall orig-fn current inherited table todo-table)))) - -(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice) -#+END_SRC -*** capture -Capture should show up in the bottom of any currently active buffer -#+BEGIN_SRC emacs-lisp -(defun nd/org-capture-position (buffer alist) - (let ((new (split-window (get-buffer-window) -14 'below))) - (set-window-buffer new buffer) - new)) - -(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials) - "Advice to fix window placement in `org-capture-select-template'." - (let ((override '("\\*Org Select\\*" nd/org-capture-position))) - (add-to-list 'display-buffer-alist override) - (nd/with-advice - ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) - (unwind-protect (funcall orig-fn table title prompt specials) - (setq display-buffer-alist - (delete override display-buffer-alist)))))) - -(advice-add #'org-mks :around #'nd/org-capture-window-advice) -#+END_SRC -** exporting -The default is XHTML for some reason (which few use and makes certain barbaric word processors complain). Use the much-superior html5. -#+BEGIN_SRC emacs-lisp -(setq org-html-doctype "html5") -#+END_SRC - -Need to export the bibliography when using org mode. Use =latexmk= instead of =pdflatex= because it is better at handling this. -#+BEGIN_SRC emacs-lisp -(setq org-latex-pdf-process (list "latexmk -shell-escape -bibtex -f -pdf %f")) -#+END_SRC - -By default org export files to the same location as the buffer. Apparently old org versions used to have =org-export-publishing-directory=, but they took it out. Oh well. -#+BEGIN_SRC emacs-lisp -;; (defvar nd/org-export-publishing-directory -;; (expand-file-name "~/Downloads/org-exports") -;; "The target directory to for all org exports.") - -;; (defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir) -;; "Change the target export directory for org exports." -;; (unless pub-dir -;; (setq pub-dir nd/org-export-publishing-directory) -;; (unless (file-directory-p pub-dir) -;; (make-directory pub-dir))) -;; (apply orig-fun extension subtreep pub-dir nil)) - -;; (advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name) -#+END_SRC -** gantt charts -This is custom, non-MELPA package, so it must be loaded manually. See [[https://github.com/swillner/org-gantt/blob/master/org-gantt-manual.org][here]] for guide. -#+BEGIN_SRC emacs-lisp -(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/") -(require 'org-gantt) -#+END_SRC - -It is also useful to define a block template for gantt chart creation -#+BEGIN_SRC emacs-lisp -(add-to-list 'org-structure-template-alist - '("og" "#+BEGIN: org-gantt-chart\n?\n#+END")) -#+END_SRC -** gtd implementation -*** overview -This section is meant to be a big-picture overview of how GTD works in this setup. For specifics, see each section following this for further explanation and code. I should also say that most of the ideas for the code came from [[http://doc.norang.ca/org-mode.html#OrgFileStructure][Bernt Hansen's]] very detailed guide. -**** workflow -GTD as described in its [[https://en.wikipedia.org/wiki/Getting_Things_Done][original form]] is divided into asynchronous and synchronous workflows where the asynchronous components happen at any given time and the synchronous components happen on a set schedule. Org mode lends itself quite well to this, and the feature I primarily use in this implementation are custom agenda views (with lots of skip functions). - -async: -1. capture (see =org-capture-templates= below) - - emails as I read them (mu4e) - - ideas that pop into my head - - tasks that I remember to do - - appointments/deadlines in the future - - interruptions from pointy-haired bosses - -sync: -1. process (daily) - - decide if actionable/not - - assign to incubator, references, specific project, or general task file -2. organize (daily) - - add tags (context or resources) - - add properties (effort and delegation) - - note that some tags are automatically added in the proces stage above (mostly priority buckets used for the 7 areas of life, see tags below) -3. review (weekly) - - check project status - - check for scheduling conflicts - - move to/from incubator depending on how adevnturous I feel -4. doing (as planned) - - work through scheduled tasks and deadlines for day - - work through project tasks depending on context/effort/piority - - use clocking to track progress and encourage clean breaks b/t tasks -**** file hierarchy and structure -All org files are kept in one directory in =$HOME=. This is futher subdivided into directories for project (as per terms and definitions, these are any tasks that involve at least on subtask) and reference files. At the top level are files for incubated tasks, captured tasks, and catchall general tasks (which also includes small projects that don't fit anywhere else). - -In order to make sorting easier and minimize work during processing, the files are further subdivided using tags at the file level and heading level that will automatically categorize tasks when they are refiled to a certain location. For example, some project may be to create a computer program, so I would set =#+FILETAGS: #laptop= because every task in this project will require a laptop. See the tags section below for more information on tags. -**** repetition -This deserves special attention because it comprises a significant percentage of tasks I do (and likely everyone does). I personally never liked the org's repeated task functionality. It is way too temporally rigid to be useful to me, and offers very little flexibility in mutating a task as it moves forward. Habits (which I use) are a partial fix for the first problem but do not aleviate the mutability problem. - -My (somewhat convoluted) solution was to use =org-clone-subtree-with-time-shift=, which creates an easy way to make repeated tasks from some template, but also allows modification. The only problem with the vanilla implementation is that it lacks automation and agenda-block awareness (they all get treated as regular tasks which I don't want). This is partially fixed with =nd/org-clone-subtree-with-time-shift= (modifed original) which automaticlly cleans tasks which are cloned (for some reason the original does not clear checkboxes and such). The remainding problems I fixed by defining several properties to be applied to repeated groupings under a heading (see properties). - -The first property is called =PARENT_TYPE= and has two values =iterator= and =periodical=. The first applies to repeated tasks and second which applies to timestamped headings such as appointments. These are mostly useful for agenda sorting, where I have views specifically for managing repeated tasks. The second property is =TIME_SHIFT=; =nd/org-clone-subtree-with-time-shift= is aware of this value and automatically shifts cloned tasks accordingly if available. - -In practice, I use this for tasks like workouts, paying bills, maintenance, grocery shopping, work meetings, GTD reviews, etc. These are all *almost* consistent but may change slightly in their timing, action items, effort, context, etc. If any of these change, it is easy enough to modify one heading without disrupting the rest. - -In an org tree these look like this: -#+BEGIN_SRC org -***** clean room -:PROPERTIES: -:PARENT_TYPE: iterator -:TIME_SHIFT: +1m -:END: -****** DONE clean room [0/2] -CLOSED: [2018-11-21 Wed 22:13] SCHEDULED: <2018-10-29 Mon> -:PROPERTIES: -:Effort: 0:15 -:END: -- [ ] vacuum -- [ ] throw away trash -****** TODO clean room [0/2] -SCHEDULED: <2018-11-29 Thu> -:PROPERTIES: -:Effort: 0:30 -:END: -- [ ] vacuum room -- [ ] throw away trash -#+END_SRC -**** block agenda views -The heart of this implementation is an army of block agenda views (basically filters on the underlying org trees that bring whatever I need into focus). These have become tailored enough to my workflow that I don't even use the built-in views anymore (I also have not found an "easy" way to turn these off). Besides projects, these agenda views are primarily driven using skip functions. -***** projects -When it comes to the agenda view, I never liked how org-mode by default handled "projects" (see how that is defined in "terms and definitions"). It mostly falls short because of the number of todo keywords I insist on using. The solution I implemented was to used "statuscodes" (which are just keywords in lisp) to define higher-level descriptions based on the keyword content of a project. For example a "stuck" project (with statuscode =:stuck=) is a project with only =TODO= keywords. Adding a =NEXT= status turns the statuscode to =:active=. Likewise =WAIT= makes =:waiting=. This seems straightforward, except that =NEXT= trumps =WAIT=, =WAIT= trumps =HOLD=, etc. Furthermore, there are errors I wish to catch to ensure subtrees get efficiently cleaned out, such as a project heading with =DONE= that still has a =TODO= underneath. - -I used to take care of this problem with lots of skip functions, but it turned out to be unmaintainable and offered poor performance (eg if I wanted a block agenda for =N= statuscodes, I needed to scan the entire org tree =N= times). A far easier way to implement this was to embed the statuscodes in text properties in each agenda line, which could then be sorted and the prefix string formatted with the status code for identification in the block agenda view. Since this only requires one block, it only requires one scan, and is very fast. -***** repeaters -Similarly to projects, repeaters (eg iterators and periodicals) are assessed via a statuscode (after all they are a group of headings and thus depending on the evaluation of todo keywoards and timestamps in aggregate). These prove much simpler than projects as essentially all I need are codes for uninitialized (there is nothing in the repeater), empty (all subheadings are in the past and therefore irrelevant), and active (there are some subtasks in the future). -**** terms and definitions -These conventions are used throughout to be precise when naming functions/variables and describing their effects -***** headings -- heading: the topmost part after the bullet in an org outline. Org-mode cannot seem to make up it's mind in calling it a header, heading, or headline, so I picked heading -- todoitem: any heading with a todo keyword -- task: a todoitem with no todoitem children - - atomic: further specifies that the task is not part of a project -- project: a todoitem with that has todoitem children or other projects - - status(code): a keyword used to describe the overall status of a project. See skip functions in the block agenda section for their implementation. -***** time -- stale: refers to timestamps that are in the past/present - - archivable: further specifies that the timestamp is older than some cutoff that defines when tasks can be archived (usually 30 days) -- fresh: refers to timestamps that are in the future -*** todo states -**** list -These keywords are used universally for all org files (see below on quick explanation for each, they are all quite straightforward). Note that projects have a more specific meaning for these keywords in defining project status (see the library of agenda function). Also, it looks way better in the agenda buffer when they are all the same number of chars. - -In terms of logging, I like to record the time of each change upon leaving any state, and I like recording information in notes when waiting, holding, or canceling (as these usually have some external trigger or barrier that should be specified). -#+BEGIN_SRC emacs-lisp -(setq org-todo-keywords - '((sequence - ;; default undone state - "TODO(t/!)" - - ;; undone but available to do now (projects only) - "NEXT(n/!)" "|" - - ;; done and complete - "DONE(d/!)") - - (sequence - ;; undone and waiting on some external dependency - "WAIT(w@/!)" - - ;; undone but signifies tasks on which I don't wish to focus at the moment - "HOLD(h@/!)" "|" - - ;; done but not complete - "CANC(c@/!)"))) -#+END_SRC -**** colors -Aesthetically, I like all my keywords to have bold colors. -#+BEGIN_SRC emacs-lisp -(setq org-todo-keyword-faces - '(("TODO" :foreground "light coral" :weight bold) - ("NEXT" :foreground "khaki" :weight bold) - ("DONE" :foreground "light green" :weight bold) - ("WAIT" :foreground "orange" :weight bold) - ("HOLD" :foreground "violet" :weight bold) - ("CANC" :foreground "deep sky blue" :weight bold))) -#+END_SRC -*** tags -**** alist -I use tags for agenda filtering (primarily for GTD contexts, see below). Each tag here starts with a symbol to define its group (note, only the special chars "_", "@", "#", and "%" seem to be allowed; anything else will do weird things in the hotkey prompt). Some groups are mutually exclusive. By convention, any tag not part of these groups is ALLCAPS (not very common) and set at the file level. -#+BEGIN_SRC emacs-lisp -(setq org-tag-alist - ;; (@) gtd location context - '((:startgroup) - ("@errand" . ?e) - ("@home" . ?h) - ("@work" . ?w) - ("@travel" . ?r) - (:endgroup) - - ;; (#) gtd resource context - ("#laptop" . ?l) - ("#tcult" . ?t) - ("#phone" . ?p) - - ;; (%) misc tags - ;; denotes reference information - ("%note" . ?n) - - ;; incubator - ("%inc" . ?i) - - ;; denotes tasks that need further subdivision to turn into true project - ("%subdiv" . ?s) - - ;; catchall to mark important headings, usually for meetings - ("%flag" . ?f) - - ;; (_) life categories, used for gtd priority context - (:startgroup) - ("_env" . ?E) - ("_fin" . ?F) - ("_int" . ?I) - ("_met" . ?M) - ("_phy" . ?H) - ("_pro" . ?P) - ("_rec" . ?R) - ("_soc" . ?S) - (:endgroup))) -#+END_SRC -**** colors -Each group also has its own color, defined by its prefix symbol. -#+BEGIN_SRC emacs-lisp -(defun nd/add-tag-face (fg-name prefix) - "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 - to which the faces are applied" - (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist))) - (push `(,tag . (:foreground ,fg-name)) org-tag-faces))) - -(setq org-tag-faces '()) - -(nd/add-tag-face "PaleGreen" "@") -(nd/add-tag-face "SkyBlue" "#") -(nd/add-tag-face "PaleGoldenrod" "%") -(nd/add-tag-face "violet" "_") -#+END_SRC -*** properties -The built-in =effort= is used as the fourth and final homonymous GTD context (the other three being covered above using tags). It is further restricted with =Effort_All= to allow easier filtering in the agenda. - -Also here are the properties for repeated tasks and a few others (see comments in code). -#+BEGIN_SRC emacs-lisp -(mapc (lambda (i) (add-to-list 'org-default-properties i)) - ;; defines a repeater group - '("PARENT_TYPE" - ;; defines the time shift for repeater groups - - "TIME_SHIFT" - ;; assigns another person/entity to a task (experimental) - - "DELEGATE" - - ;; defines a goal (not currently used) - "GOAL")) - -(setq org-global-properties - '(("PARENT_TYPE_ALL" . "periodical iterator") - ("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")) - - org-use-property-inheritance - '("PARENT_TYPE" "TIME_SHIFT")) -#+END_SRC -*** capture -**** templates -As per Bernt's guide, capture is meant to be fast. The dispatcher is bound to =F2= (see keybindings section) which allows access in just about every mode and brings a template up in two keystrokes. -#+BEGIN_SRC emacs-lisp -(defun nd/org-timestamp-future (days) - "Inserts an active org timestamp DAYS after the current time." - (format-time-string (org-time-stamp-format nil) - (time-add (current-time) (days-to-time 1)))) - -(let ((capfile "~/Org/capture.org")) - (setq org-capture-templates - ;; regular TODO task - `(("t" "todo" entry (file ,capfile) - "* TODO %?\n%U\ndeliverable: \n") - - ;; for useful reference information that may be grouped with tasks - ("n" "note" entry (file ,capfile) - "* %? :\\%note:\n%U\n") - - ;; for non-actionable events that happen at a certain time - ("a" "appointment" entry (file ,capfile) - "* %?\n%U\n%^t\n") - - ;; like appointment but multiple days - ("s" "appointment-span" entry (file ,capfile) - "* %?\n%U\n%^t--%^t\n") - - ;; task with a deadline - ("d" "deadline" entry (file ,capfile) - "* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n") - - ;; for converting mu4e emails to tasks, defaults to next-day deadline - ("e" "email" entry (file ,capfile) - "* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%U\n%a\n") - - ;; for interruptions that produce useful reference material - ("m" "meeting" entry (file ,capfile) - "* meeting with%? :\\%note:\n%U\n") - - ;; for capturing web pages with web browser - ("p" "org-protocol" entry (file ,capfile) - "* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE" - :immediate-finish t) - - ;; or capturing links with web browser - ("L" "org-protocol link" entry (file ,capfile) - "* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U" - :immediate-finish t)))) -#+END_SRC -**** insert mode -To save one more keystroke (since I use evil mode), trigger insert mode upon opening capture template. -#+BEGIN_SRC emacs-lisp -(add-hook 'org-capture-mode-hook (lambda () (evil-append 1))) -#+END_SRC -*** refile -Refile (like capture) should be fast, and I search all org file simultaneously using helm (setting =org-outline-path-complete-in-steps= to =nil= makes search happen for entire trees at once and not just the current level). Refiling is easiest to do from a block agenda view (see below) where headings can be moved in bulk. -#+BEGIN_SRC emacs-lisp -(setq org-refile-targets '((nil :maxlevel . 9) - ("~/Org/reference/idea.org" :maxlevel . 9) - (org-agenda-files :maxlevel . 9)) - org-refile-use-outline-path t - org-outline-path-complete-in-steps nil - org-refile-allow-creating-parent-nodes 'confirm - org-indirect-buffer-display 'current-window) -#+END_SRC - -Prevent accidental refiling under tasks with done keywords -#+BEGIN_SRC emacs-lisp -(setq org-refile-target-verify-function - (lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords)))) - -;; TODO this no work, although does work if var is global -;; redfining the targets works for now -(add-hook 'org-agenda-mode-hook - (lambda () - (when (equal (buffer-name) "*Org Agenda(A)*") - (setq-local org-refile-targets - '(("~/Org/journal/goals.org" :maxlevel . 9)))))) -;; (lambda () (when (org-entry-get nil "GOAL") t)))))) -;; (setq org-refile-targets '((nil :maxlevel . 9) -;; ("~/Org/reference/idea.org" :maxlevel . 9) -;; ("~/Org/journal/goals.org" :maxlevel . 9) -;; (org-agenda-files :maxlevel . 9)) -#+END_SRC -*** clocking -Clocking is still new and experimental (I'm not a ninja like Bernt yet). I mostly use clocking now as a way to make clean breaks between tasks (eg to discourage "mixing" tasks which is a slippery multitasking slope). I bound =F4= to =org-clock-goto= as an easy way to find my current/last clocked task in any mode (see keybindigs). -#+BEGIN_SRC emacs-lisp -(setq org-clock-history-length 23 - org-clock-out-when-done t - org-clock-persist t - org-clock-report-include-clocking-task t) -#+END_SRC -*** conflict detection -Somehow org-mode has no way to detect conflicts between tasks with timestamps (!!??). Luckily I can make my own. -**** backend -The algoithm to detect conflicts scans all org files and stores conflicts in a list of pairs of each heading with a conflicting timestamp. - -Steps for this algorithm: -1. make a list of all entries with timestamps -2. sort timestamp list -3. Walk through list and compare entries immediately after (sorting ensures that entries can be skipped once one non-conflict is found). If conflicts are found push the pair to a new list (this is what is used to make the display) - -This should be O(n) (best case/no conflicts) to O(n^2) (worst case/everything conflicts) -#+BEGIN_SRC emacs-lisp -(defun nd/are-conflicting-p (ts-a ts-b) - "Return t if timestamps TS-A and TS-B conflict." - (let* ((earlier-a (car ts-a)) - (earlier-b (car ts-b)) - (later-b (+ earlier-b (nth 1 ts-b)))) - (and (>= earlier-a earlier-b) (<= earlier-a later-b)))) - -(defun nd/detect-conflict (ts ts-list conlist) - "Recursively determine if timestamp TS conflicts with anything in TS-LIST. -If detected, conflict pair is added to CONLIST." - (let ((next-ts (car ts-list)) - (rem-ts (cdr ts-list))) - (if (nd/are-conflicting-p ts next-ts) - (progn - (setq conlist (cons (list ts next-ts) conlist)) - (if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist)) - conlist))) - -(defun nd/build-conlist (ts-list conlist) - "Recursively build a list of timestamp conflicts from TS-LIST. - -TS-LIST is comprised of entries in the form (staring-ts timerange marker) -where timerange is 0 for singular timestamps and a positive number for -anything with to times or a timestamp range. -Detected conflicts are stored in CONLIST as pairs of conflicting ts -entries from the TS-LIST." - (let ((cur-ts (car ts-list)) - (rem-ts (cdr ts-list))) - (if rem-ts - (nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist)) - conlist))) - -(defconst nd/org-tsm-regexp - "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" - "Regular expression for timestamps with two times.") - -(defun nd/get-timestamps () - "Get the org-marker and timestamp(s) (multiple if range) or current heading." - ;; TODO, what if I care about more than just TIMESTAMPs - (let* ((ts (org-entry-get nil "TIMESTAMP")) - (marker (point-marker)) - (ts-range 0) - (ts-entry)) - (when ts - (cond - ;; match timestamps that have two times - ((string-match nd/org-tsm-regexp ts) - (let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts))) - (ts2 (concat (match-string 1 ts) (match-string 3 ts))) - (ft1 (org-2ft ts1)) - (ft2 (org-2ft ts2))) - (setq ts-entry ft1) - (setq ts-range (- ft2 ft1)))) - - ;; match timestamps that have a range (eq two timestamps) - ((string-match org-tr-regexp ts) - (let* ((ts1 (match-string 1 ts)) - (ts2 (match-string 2 ts)) - (ft1 (org-2ft ts1)) - (ft2 (org-2ft ts2))) - (setq ts-entry ft1) - (setq ts-range (- ft2 ft1)))) - - ;; match timestamps with only one time - (t (setq ts-entry (org-2ft ts)))) - (list ts-entry ts-range marker ts)))) - -(defun nd/build-conflict-list () - "Scan all org files and make a list of all timestamps that conflict." - (let ((files (org-agenda-files)) - max-reached ts-list cur-index conflicts) - ;; get all timestamps from org buffers - (dolist (f files ts-list) - (with-current-buffer - (find-file-noselect f) - (goto-char (point-min)) - (when (not (outline-on-heading-p)) (outline-next-heading)) - (setq max-reached nil) - (while (not max-reached) - (let ((new-ts (nd/get-timestamps))) - (if new-ts (setq ts-list (cons new-ts ts-list)))) - (unless (outline-next-heading) (setq max-reached t))))) - - ;; sort the timestamp list - ;; TODO, need to make range-aware - (setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b))))) - - ;; build a list of conflicts - (nd/build-conlist ts-list conflicts))) -#+END_SRC -**** frontend -To display any conflicts, I could just fetch the org headings and throw them into a new buffer. But that's boring, and quite limiting. I basically want all the perks of an agenda buffer...tab-follow, the nice parent display at the bottom, time adjust hotkeys, etc. So the obvious and hacky solution is to throw together a quick-n-dirty agenda buffer which displays each conflict pair in sequentional fashion. -#+BEGIN_SRC emacs-lisp -(defun nd/get-conflict-header-text (conflict-marker) - "Return string with text properties representing the org header for -MARKER for use in the conflict agenda view." - (let* ((props (list - 'face nil - 'done-face 'org-agenda-done - 'org-not-done-regexp org-not-done-regexp - 'org-todo-regexp org-todo-regexp - 'org-complex-heading-regexp org-complex-heading-regexp - 'mouse-face 'highlight)) - ;; 'help-echo - ;; (format "mouse-2 or RET jump to org file %s" - ;; (abbreviate-file-name buffer-file-name)))) - marker priority category level tags todo-state - ts-date ts-date-type ts-date-pair - txt beg end inherited-tags todo-state-end-pos) - - (with-current-buffer (marker-buffer conflict-marker) - (save-excursion - (goto-char conflict-marker) - - (setq marker (org-agenda-new-marker (point)) - category (org-get-category) - ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) - ts-date (car ts-date-pair) - ts-date-type (cdr ts-date-pair) - txt (org-get-heading t) - inherited-tags - (or (eq org-agenda-show-inherited-tags 'always) - (and (listp org-agenda-show-inherited-tags) - (memq 'todo org-agenda-show-inherited-tags)) - (and (eq org-agenda-show-inherited-tags t) - (or (eq org-agenda-use-tag-inheritance t) - (memq 'todo org-agenda-use-tag-inheritance)))) - tags (org-get-tags-at nil (not inherited-tags)) - level (make-string (org-reduced-level (org-outline-level)) ? ) - txt (org-agenda-format-item "" txt level category tags t) - priority (1+ (org-get-priority txt))) - - (org-add-props txt props - 'org-marker marker 'org-hd-marker marker - 'priority priority - 'level level - 'ts-date ts-date - 'type "timestamp"))))) - -(defun nd/org-conflicts (&optional arg) - (interactive "P") - - (if org-agenda-overriding-arguments - (setq arg org-agenda-overriding-arguments)) - - (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) - - (let* ((today (org-today)) - (date (calendar-gregorian-from-absolute today)) - (completion-ignore-case t) - (org-agenda-prefix-format '((agenda . " %-12:c %-5:e "))) - rtn rtnall files file pos) - - (catch 'exit - (when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*")) - - (org-agenda-prepare) - ;; (org-compile-prefix-format 'todo) - (org-compile-prefix-format 'agenda) - ;; (org-set-sorting-strategy 'todo) - - (setq org-agenda-redo-command '(nd/org-conflicts)) - - (insert "Conflicting Headings: \n") - (add-text-properties (point-min) (1- (point)) - (list 'face 'org-agenda-structure - 'short-heading "Conflicts")) - (org-agenda-mark-header-line (point-min)) - - (setq rtnall (nd/build-conflict-list)) - (when rtnall - (mapc - (lambda (c) - (insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n")) - (insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n")) - (insert "\n")) - rtnall)) - - ;; clean up and finalize - (goto-char (point-min)) - (or org-agenda-multi (org-agenda-fit-window-to-buffer)) - (add-text-properties - (point-min) (point-max) - `(org-agenda-type agenda - org-last-args ,arg - org-redo-cmd ,org-agenda-redo-command - org-series-cmd ,org-cmd)) - (org-agenda-finalize) - (setq buffer-read-only t)))) -#+END_SRC -*** agenda -**** targets -The agenda files are limited to as few as possible to keep scanning and startup reasonably fast. -#+BEGIN_SRC emacs-lisp -(setq org-agenda-files '("~/Org" - "~/Org/projects" - "~/Org/reference/peripheral.org")) -#+END_SRC -**** appearence -***** sticky agendas -I personally like having sticky agendas by default so I can use multiple windows -#+BEGIN_SRC emacs-lisp -(setq org-agenda-sticky t) -#+END_SRC -***** tag alignment -The agenda does not do this by default...it's annoying -#+BEGIN_SRC emacs-lisp -(add-hook 'org-finalize-agenda-hook - (lambda () (setq org-agenda-tags-column (- 4 (window-width))) - (org-agenda-align-tags))) -#+END_SRC -***** prefix format -This controls what each line on the block agenda looks like. This is reformated to include effort and remove icons. -#+BEGIN_SRC emacs-lisp -(setq org-agenda-prefix-format - '((agenda . " %-12:c %-5:e %?-12t% s") - (todo . " %-12:c") - (tags . " %-12:c %-5:e ") - (search . " %-12:c"))) -#+END_SRC -***** misc -These are just some options to enable/disable some aesthetic things. -#+BEGIN_SRC emacs-lisp -(setq org-agenda-dim-blocked-tasks nil - org-agenda-compact-blocks t - org-agenda-window-setup 'current-window - org-agenda-start-on-weekday 0 - org-agenda-span 'day - org-agenda-current-time-string "### -- NOW -- ###") -#+END_SRC - -Based on my screen size and usage patterns, this seems to be a good value to enable the maximum habit history to be shown without compromising aesthetics. -#+BEGIN_SRC emacs-lisp -(setq org-habit-graph-column 50) -#+END_SRC -**** interactive filters -Rather than define infinite views for different tasks (I already have plenty of views) I use filtering to sort through the noise. Some of the built-in filters don't cut it, so I made a few of my own. -***** custom filtering functions -Some custom filters that are applied to the agenda view. Note that some of these use alternative filter types that are implemented via advising functions (see below). -#+BEGIN_SRC emacs-lisp -(defun nd/org-agenda-filter-non-context () - "Filter all tasks with context tags." - (interactive) - (let* ((tags-list (mapcar #'car org-tag-alist)) - (context-tags (append - (nd/filter-list-prefix "@" tags-list) - (nd/filter-list-prefix "#" tags-list)))) - (setq org-agenda-tag-filter - (mapcar (lambda (tag) (concat "-" tag)) context-tags)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - -(defun nd/org-agenda-filter-non-peripheral () - "Filter all tasks that don't have peripheral tags." - (interactive) - (let* ((peripheral-tags '("PERIPHERAL"))) - (setq org-agenda-tag-filter - (mapcar (lambda (tag) (concat "-" tag)) peripheral-tags)) - (org-agenda-filter-apply org-agenda-tag-filter 'tag))) - -(defun nd/org-agenda-filter-non-effort () - "Filter agenda by non-effort tasks." - (interactive) - (setq org-agenda-hasprop-filter '("-Effort")) - (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) - -(defun nd/org-agenda-filter-delegate () - "Filter agenda by tasks with an external delegate." - (interactive) - (setq org-agenda-hasprop-filter '("+DELEGATE")) - (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) -#+END_SRC -***** filter advice -In order to implement the =hasprop= filter, the functions =org-agenda-filter-make-matcher= and =org-agenda-filter-remove-all= need to be advised in order to add the functionality for the =hasprop= filter type. - -As it is, this allows any filter using =hasprop= to be applied and removed using the standard =org-agenda-filter-apply= function with the =org-agenda-hasprop-filter= variable (obviously these can all be extended to different filter types). Note this does not give a shiny indicator at the bottom of spaceline like the built-in filter does...oh well. -#+BEGIN_SRC emacs-lisp -;; initialize new filters -(defvar org-agenda-hasprop-filter nil) - -(defun nd/org-agenda-filter-make-matcher-prop - (filter type &rest args) - "Return matching matcher form for FILTER and TYPE where TYPE is not -in the regular `org-agenda-filter-make-matcher' function. This is -intended to be uses as :before-until advice and will return nil if -the type is not valid (which is currently 'prop')" - (let (f f1) - ;; has property - (cond - ((eq type 'hasprop) - (dolist (x filter) - (push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f)))) - (if f (cons 'and (nreverse f))))) - -(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h) - "Returns form to test the presence or absence of properties H. -H is a string like +prop or -prop" - (let (op) - (let* ((op (string-to-char h)) - (h (substring h 1)) - (f `(save-excursion - (let ((m (org-get-at-bol 'org-hd-marker))) - (with-current-buffer - (marker-buffer m) - (goto-char m) - (org-entry-get nil ,h)))))) - (if (eq op ?-) (list 'not f) f)))) - -(defun nd/org-agenda-filter-show-all-hasprop nil - (org-agenda-remove-filter 'hasprop)) - -(advice-add #'org-agenda-filter-make-matcher :before-until - #'nd/org-agenda-filter-make-matcher-prop) - -(advice-add #'org-agenda-filter-remove-all :before - (lambda () (when org-agenda-hasprop-filter - (nd/org-agenda-filter-show-all-hasprop)))) -#+END_SRC -**** bulk actions -These add to the existing bulk actions in the agenda view. -#+BEGIN_SRC emacs-lisp -(setq org-agenda-bulk-custom-functions - '((?D nd/org-agenda-delete-subtree))) -#+END_SRC -**** holidays and birthdays -If I don't include this, I actually forget about major holidays. -#+BEGIN_SRC emacs-lisp -(setq holiday-bahai-holidays nil - holiday-hebrew-holidays nil - holiday-oriental-holidays nil - holiday-islamic-holidays nil) - -(setq calendar-holidays (append holiday-general-holidays - holiday-christian-holidays)) -#+END_SRC -**** block agenda library -These are functions and variables exclusively for agenda block manipulation within the context of =org-custom-agenda-commands=. -***** variables -#+BEGIN_SRC emacs-lisp -(defconst nd/iter-future-time (* 7 24 60 60) - "Iterators must have at least one task greater into the future to be active.") - -(defconst nd/iter-statuscodes '(:uninit :empty :active) - "Iterators can have these statuscodes.") - -(defconst nd/peri-future-time nd/iter-future-time - "Periodicals must have at least one heading greater into the future to be fresh.") - -(defconst nd/peri-statuscodes '(:uninit :stale :fresh)) - -(defconst nd/project-invalid-todostates - '("WAIT" "NEXT") - "Projects cannot have these todostates.") - -(defvar nd/agenda-limit-project-toplevel t - "If true, filter projects by all levels or top level only.") - -(defvar nd/agenda-hide-incubator-tags t - "If true, don't show incubator headings.") - -(defconst nd/org-agenda-todo-sort-order - '("NEXT" "WAIT" "HOLD" "TODO") - "Defines the order in which todo keywords should be sorted.") - -(defconst nd/project-skip-todostates - '("HOLD" "CANC") - "These keywords override all contents within their subtrees. -Currently used to tell skip functions when they can hop over -entire subtrees to save time and ignore tasks") -#+END_SRC -***** task helper functions -These are the building blocks for skip functions. -****** timestamps -#+BEGIN_SRC emacs-lisp -(defun nd/get-date-property (timestamp-property) - "Get TIMESTAMP-PROPERTY on current heading and convert to a number. -If it does not have a date, it will return nil." - (let ((ts (org-entry-get nil timestamp-property))) - (when ts (org-2ft ts)))) - -(defun nd/heading-compare-timestamp (timestamp-fun - &optional ref-time future) - "Returns the timestamp (from TIMESTAMP-FUM on the current heading) -if timestamp is futher back in time compared to a REF-TIME (default to -0 which is now, where negative is past and positive is future). If the -FUTURE flag is t, returns timestamp if it is in the future compared -to REF-TIME. Returns nil if no timestamp is found." - (let* ((timestamp (funcall timestamp-fun)) - (ref-time (or ref-time 0))) - (if (and timestamp - (if future - (> (- timestamp (float-time)) ref-time) - (<= (- timestamp (float-time)) ref-time))) - timestamp))) - -(defun nd/is-ia-timestamped-heading-p () - "Get active timestamp of current heading." - (nd/get-date-property "TIMESTAMP_IA")) - -(defun nd/is-timestamped-heading-p () - "Get active timestamp of current heading." - (nd/get-date-property "TIMESTAMP")) - -(defun nd/is-scheduled-heading-p () - "Get scheduled timestamp of current heading." - (nd/get-date-property "SCHEDULED")) - -(defun nd/is-deadlined-heading-p () - "Get deadline timestamp of current heading." - (nd/get-date-property "DEADLINE")) - -(defun nd/is-closed-heading-p () - "Get closed timestamp of current heading." - (nd/get-date-property "CLOSED")) - -(defun nd/is-stale-heading-p (&optional ts-prop) - "Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale." - (nd/heading-compare-timestamp - (lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP")))) - (when (and ts (not (find ?+ ts))) (org-2ft ts)))))) - -(defun nd/is-fresh-heading-p () - "Return timestamp if current heading is fresh." - (nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t)) - -(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 current heading is archivable." - (nd/heading-compare-timestamp - 'nd/is-closed-heading-p - (- (* 60 60 24 nd/archive-delay-days)))) -#+END_SRC -****** task level testing -#+BEGIN_SRC emacs-lisp -(defun nd/is-todoitem-p () - "Return todo keyword if heading has one." - (let ((keyword (nth 2 (org-heading-components)))) - (if (member keyword org-todo-keywords-1) - keyword))) - -(defun nd/is-project-p () - "Return todo keyword if heading has todoitem children." - (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) - -(defun nd/is-task-p () - "Return todo keyword if heading has todoitem children." - (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) - -(defun nd/is-project-task-p () - "Return todo keyword if heading has todoitem parents." - (and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p))) - -(defun nd/is-atomic-task-p () - "Return todo keyword if heading has no todoitem parents or children." - (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) -#+END_SRC -****** property testing -#+BEGIN_SRC emacs-lisp -(defun nd/is-periodical-heading-p () - "Return t if heading is a periodical." - (equal "periodical" (org-entry-get nil "PARENT_TYPE" t))) - -(defun nd/is-iterator-heading-p () - "Return t if heading is an iterator." - (equal "iterator" (org-entry-get nil "PARENT_TYPE" t))) - -(defun nd/heading-has-effort-p () - "Return t if heading has an effort." - (org-entry-get nil "Effort")) - -(defun nd/heading-has-context-p () - "Return t if heading has a context." - (let ((tags (org-get-tags-at))) - (or (> (length (nd/filter-list-prefix "#" tags)) 0) - (> (length (nd/filter-list-prefix "@" tags)) 0)))) - -(defun nd/heading-has-tag-p (tag) - "Return t if heading has tag TAG." - (member tag (org-get-tags-at))) -#+END_SRC -****** relational testing -Returns t if heading has certain relationship to other headings -#+BEGIN_SRC emacs-lisp -(defun nd/heading-has-children (heading-test) - "Return t if heading has a child for whom HEADING-TEST is t." - (let ((subtree-end (save-excursion (org-end-of-subtree t))) - has-children previous-point) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not has-children) - (< previous-point (point) subtree-end)) - (when (funcall heading-test) - (setq has-children t)) - (setq previous-point (point)) - (org-forward-heading-same-level 1 t))) - has-children)) - -(defun nd/heading-has-parent (heading-test) - "Return t if heading has parent for whom HEADING-TEST is t." - (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) - -(defun nd/has-discontinuous-parent () - "Return t if heading has a non-todoitem parent which in turn has a todoitem parent." - (let ((has-todoitem-parent) - (has-non-todoitem-parent)) - (save-excursion - (while (and (org-up-heading-safe) - (not has-todoitem-parent)) - (if (nd/is-todoitem-p) - (setq has-todoitem-parent t) - (setq has-non-todoitem-parent t)))) - (and has-todoitem-parent has-non-todoitem-parent))) -#+END_SRC -****** project level testing -Projects are tested according to their statuscodes, which in turn are a function of the todo keywords and timestamps of their individual subtasks. -#+BEGIN_SRC emacs-lisp -(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list) - "Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP." - `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) - -(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status) - "Loop through (sub)project and return overall statuscode. - -The returned statuscode is chosen from list ALLOWED-STATUSCODES where -later entries in the list trump earlier ones. - -When a subproject is encountered, this function will obtain the -statuscode of that project and use TRANS-TBL to translate the -subproject statuscode to one in ALLOWED-STATUSCODES (if not found an -error will be raised). TRANS-TBL is given as an alist of two-member -cons cells where the first member is the subproject statuscode and the - second is the index in ALLOWED-STATUSCODES to which the subproject -statuscode will be translated. - -When a task is encountered, function GET-TASK-STATUS will be applied to -obtain a statuscode-equivalent of the status of the tasks." - ;; define "breaker-status" as the last of the allowed-statuscodes - ;; when this is encountered the loop is broken because we are done - ;; (the last entry trumps all others) - (let ((project-status (first allowed-statuscodes)) - (breaker-status (car (last allowed-statuscodes))) - (previous-point)) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - ;; loop through subproject tasks until breaker-status found - (while (and (not (eq project-status breaker-status)) - (> (point) previous-point)) - (let ((keyword (nd/is-todoitem-p))) - (if keyword - (let ((new-status - ;; if project then descend recursively - (if (nd/heading-has-children 'nd/is-todoitem-p) - (let ((n (nd/get-project-status))) - ;; if project returns an allowed status - ;; then use that - (or (and (member n allowed-statuscodes) n) - ;; otherwise look up the value in the - ;; translation table and return error - ;; if not found - (nth (or (alist-get n trans-tbl) - (error (concat "status not found: " n))) - allowed-statuscodes))) - ;; if tasks then use get-task-status to obtain status - (nth (funcall get-task-status keyword) - allowed-statuscodes)))) - (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes) - (setq project-status new-status))))) - (setq previous-point (point)) - (org-forward-heading-same-level 1 t))) - project-status)) - -(defun nd/get-project-status () - "Return project heading statuscode (assumes it is indeed a project)." - (let ((keyword (nd/is-todoitem-p))) - ;; - ;; these first three are easy because they only require - ;; testing the project headline and nothing underneath - ;; - (cond - ;; it does not make sense for projects to be scheduled - ((nd/is-scheduled-heading-p) :scheduled-project) - - ;; held projects do not care what is underneath them - ((equal keyword "HOLD") :held) - - ;; projects with invalid todostates are nonsense - ((member keyword nd/project-invalid-todostates) - :invalid-todostate) - - ;; - ;; these require descending into the project subtasks - ;; - - ;; canceled projects can either be archivable or complete - ;; any errors or undone tasks are irrelevant - ((equal keyword "CANC") - (nd/descend-into-project - '(:archivable :complete) - '((:stuck . 1) - (:held . 1) - (:waiting . 1) - (:active . 1) - (:scheduled-project . 1) - (:invalid-todostate . 1) - (:undone-complete . 1) - (:done-incomplete . 1)) - (lambda (k) - (if (and (member k org-done-keywords) - (nd/is-archivable-heading-p)) 0 1)))) - - ;; done projects are like canceled projects but can also be incomplete - ((equal keyword "DONE") - (nd/descend-into-project - '(:archivable :complete :done-incomplete) - '((:stuck . 2) - (:held . 2) - (:waiting . 2) - (:active . 2) - (:scheduled-project . 2) - (:invalid-todostate . 2) - (:undone-complete . 2)) - (lambda (k) - (if (member k org-done-keywords) - (if (nd/is-archivable-heading-p) 0 1) - 2)))) - - ;; project with TODO states could be basically any status - ((equal keyword "TODO") - (nd/descend-into-project - '(:undone-complete :stuck :held :waiting :active) - '((:complete . 0) - (:archivable . 0) - (:scheduled-project . 1) - (:invalid-todostate . 1) - (:done-incomplete . 1)) - (lambda (k) - (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1)) - ((equal k "HOLD") 2) - ((equal k "WAIT") 3) - ((equal k "NEXT") 4) - (t 0))))) - - (t (error (concat "invalid keyword detected: " keyword)))))) -#+END_SRC -****** repeater testing -Iterators and periodicals are tested similarly to projects in that they have statuscodes. -#+BEGIN_SRC emacs-lisp -(defun nd/get-iterator-status () - "Get the status of an iterator where allowed statuscodes are in list - `nd/get-iter-statuscodes.' where latter codes in the list trump -earlier ones." - (let ((iter-status (first nd/iter-statuscodes)) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not (eq iter-status :active)) - (< (point) subtree-end)) - (let ((keyword (nd/is-atomic-task-p)) - (new-status)) - (if keyword - (progn - (setq new-status (if (nd/heading-compare-timestamp - (lambda () - (or (nd/is-scheduled-heading-p) - (nd/is-deadlined-heading-p))) - nd/iter-future-time t) - :active - :empty)) - (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes) - (setq iter-status new-status))))) - (outline-next-heading))) - iter-status)) - -(defun nd/get-periodical-status () - "Get the status of a periodical where allowed statuscodes are in list - `nd/get-peri-statuscodes.' where latter codes in the list trump -earlier ones." - (let ((peri-status :uninit) - (subtree-end (save-excursion (org-end-of-subtree t)))) - (save-excursion - (setq previous-point (point)) - (outline-next-heading) - (while (and (not (eq peri-status :fresh)) - (< (point) subtree-end)) - (if (and (nd/is-periodical-heading-p) - (not (nd/heading-has-children 'nd/is-periodical-heading-p))) - (let ((new-status - (if (nd/heading-compare-timestamp - 'nd/is-timestamped-heading-p - nd/iter-future-time t) - :fresh - :stale))) - (if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes) - (setq peri-status new-status)))) - (outline-next-heading))) - peri-status)) -#+END_SRC -***** skip functions -These are the primary means used to sort through tasks and build agenda block views -****** helper skip functions and macros -Subunits for skip functions. Not meant to be used or called from the custom commands api -#+BEGIN_SRC emacs-lisp -(defun nd/skip-heading () - "Skip forward to next heading." - (save-excursion (or (outline-next-heading) (point-max)))) - -(defun nd/skip-subtree () - "Skip forward to next subtree." - (save-excursion (or (org-end-of-subtree t) (point-max)))) - - -(defmacro nd/skip-heading-without (heading-fun test-fun) - "Skip headings accoring to certain characteristics. - -HEADING-FUN is a function that tests the heading and returns the -todoitem keyword on success. TEST-FUN is a function that further tests -the identity of the heading and may or may not use the keyword output -supplied by the HEADING-FUN. This function will not skip if -HEADING-FUN and TEST-FUN return true" - `(save-restriction - (widen) - (let ((keyword (,heading-fun))) - ;; (message keyword) - (if (not (and keyword ,test-fun)) - (nd/skip-heading))))) -#+END_SRC -****** headings -Skip functions for headings which may or may not be todo-items. -#+BEGIN_SRC emacs-lisp -(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list) - "Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST." - (save-restriction - (widen) - (let ((heading-tags (org-get-tags-at))) - (if (and (or (not pos-tags-list) - (intersection pos-tags-list heading-tags :test 'equal)) - (not (intersection neg-tags-list heading-tags :test 'equal))) - (nd/skip-heading))))) - -(defun nd/skip-non-stale-headings () - "Skip headings that do not have stale timestamps and are not part of projects." - (save-restriction - (widen) - (let ((keyword (nd/is-todoitem-p))) - (if (not - (and (nd/is-stale-heading-p) - (not (member keyword org-done-keywords)) - (not (nd/heading-has-children 'nd/is-todoitem-p)) - (not (nd/heading-has-parent 'nd/is-todoitem-p)))) - (nd/skip-heading))))) -#+END_SRC -****** tasks -A few functions apply to both atomic tasks and project tasks the same. -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-ia-timestamped-tasks () - "Skip tasks that do not have an inactive timestamp." - (save-excursion - (widen) - (if (not (and (nd/is-task-p) - (not (nd/is-ia-timestamped-heading-p)))) - (nd/skip-heading)))) -#+END_SRC -****** atomic tasks -By definition these have no parents, so I don't need to worry about skipping over projects. Any todo state is valid and we only sort by done/canc -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-atomic-tasks () - "Skip headings that are not atomic tasks." - (save-excursion - (widen) - (if (not (nd/is-atomic-task-p)) - (nd/skip-heading)))) - -(defun nd/skip-non-closed-atomic-tasks () - "Skip headings that are not complete (but not archivable) atomic tasks." - (nd/skip-heading-without - nd/is-atomic-task-p - (and (member keyword org-done-keywords) - (not (nd/is-archivable-heading-p))))) - -(defun nd/skip-non-archivable-atomic-tasks () - "Skip headings that are not archivable atomic tasks." - (nd/skip-heading-without - nd/is-atomic-task-p - (nd/is-archivable-heading-p))) -#+END_SRC -****** repeaters -These are headings marked with PARENT_TYPE property that have timestamped headings as children. They are to be refilled when all children are stale. Note that I only care about the parent headings as the children should always show up in the agenda simply because they have timestamps. Parents can be either fresh (at least one child in the future) or stale (all children in the past). -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-iterator-parent-headings () - "Skip headings that are not toplevel iterator headings." - (save-restriction - (widen) - (if (not (and (nd/is-iterator-heading-p) - (not (nd/heading-has-parent 'nd/is-iterator-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-iterator-unscheduled () - "Skip all headings that are not unscheduled iterator children." - (nd/skip-heading-without - nd/is-atomic-task-p - (not (or (nd/is-scheduled-heading-p) - (nd/is-deadlined-heading-p))))) - -(defun nd/skip-non-periodical-parent-headings () - "Skip headings that are not toplevel periodical headings." - (save-restriction - (widen) - (if (not (and (nd/is-periodical-heading-p) - (not (nd/heading-has-parent 'nd/is-periodical-heading-p)))) - (nd/skip-heading)))) - -(defun nd/skip-non-periodical-untimestamped () - "Skip all headings that are not periodical children without a timestamp." - (save-restriction - (widen) - (if (not (and (nd/is-periodical-heading-p) - (not (nd/is-timestamped-heading-p)) - (not (nd/heading-has-children 'nd/is-periodical-heading-p)))) - (nd/skip-heading)))) -#+END_SRC -****** project tasks -Note that I don't care about the timestamp in these cases because I don't archive these; I archive their parent projects. The keywords I care about are NEXT, WAIT, and HOLD because these are definitive project tasks that require/inhibit futher action. (TODO = stuck which I take care of at the project level, and DONE/CANC = archivable which is dealt with similarly) - -For performance, I need to assess if the parent project is skippable, in which case I jump to the next subtree. -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-project-tasks () - "Skip headings that are not project tasks." - (save-restriction - (widen) - (let ((keyword (nd/is-todoitem-p))) - (if keyword - (if (nd/heading-has-children 'nd/is-todoitem-p) - (if (member keyword nd/project-skip-todostates) - (nd/skip-subtree) - (nd/skip-heading)) - (if (not (nd/heading-has-parent 'nd/is-todoitem-p)) - (nd/skip-heading))) - (nd/skip-heading))))) -#+END_SRC -****** heading-level errors -Some headings are invalid under certain conditions; these are tested here. -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-discontinuous-project-tasks () - "Skip headings that are not discontinuous within projects." - (nd/skip-heading-without - nd/is-todoitem-p - (nd/has-discontinuous-parent))) - -(defun nd/skip-non-done-unclosed-todoitems () - "Skip headings that are not completed without a closed timestamp." - (nd/skip-heading-without - nd/is-todoitem-p - (and (member keyword org-done-keywords) - (not (nd/is-closed-heading-p))))) - -(defun nd/skip-non-undone-closed-todoitems () - "Skip headings that are not incomplete with a closed timestamp." - (nd/skip-heading-without - nd/is-todoitem-p - (and (not (member keyword org-done-keywords)) - (nd/is-closed-heading-p)))) -#+END_SRC -****** projects -Projects are handled quite simply. They have statuscodes for which I test, and this can all be handled by one function. Note that this is used for "normal" projects as well as repeaters. -#+BEGIN_SRC emacs-lisp -(defun nd/skip-non-projects (&optional ignore-toplevel) - "Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)." - (save-restriction - (widen) - (let ((keyword (nd/is-project-p))) - (if keyword - (if (and nd/agenda-limit-project-toplevel - (not ignore-toplevel) - (nd/heading-has-parent 'nd/is-todoitem-p)) - (nd/skip-subtree)) - (nd/skip-heading))))) -#+END_SRC -***** sorting and filtering -These are used to filter and sort within block agendas (note this is different from the other filtering functions above as these are non-interactive). -#+BEGIN_SRC emacs-lisp -(defun nd/org-agenda-filter-status (filter status-fun a-line - &optional filter-only) - "Filter for `org-agenda-before-sorting-filter-function' intended for -agenda project views (eg makes the assumption that all entries are -from projects in the original org buffer) wherein this function will -filter project headings based on their statuscodes. - -It works by going to the original org buffer and determining the -project status using STATUS-FUN, after which it will check if -status is in FILTER (a list of statuscodes). If true, the flag string -in the prefix is replaced with the status, and the status is set as a -text property for further sorting. - -If option FILTER-ONLY is t, function only return the unmodified a-line -or nil to act as a filter (eg does not touch text properties)." - (let* ((m (get-text-property 1 'org-marker a-line)) - (s (with-current-buffer (marker-buffer m) - (goto-char m) - (funcall status-fun)))) - (if (member s filter) - (if filter-only - a-line - (org-add-props (replace-regexp-in-string - "xxxx" (symbol-name s) a-line) - nil 'project-status s))))) - -(defun nd/org-agenda-sort-prop (prop order a b) - "Sort a block agenda view by text property PROP given a list ORDER -of said text properties in the desired order and lines A and B as -inputs. To be used with `org-agenda-cmp-user-defined'." - (let* ((ta (get-text-property 1 prop a)) - (tb (get-text-property 1 prop b)) - (pa (position ta order :test (if (stringp ta) #'equal))) - (pb (position tb order :test (if (stringp tb) #'equal)))) - (cond ((or (null pa) (null pb)) nil) - ((< pa pb) +1) - ((> pa pb) -1)))) -#+END_SRC -***** block view building macros -Some useful shorthands to create block agenda views -#+BEGIN_SRC emacs-lisp -(defun nd/agenda-base-heading-cmd (match header skip-fun) - "Make a tags agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN." - `(tags - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-sorting-strategy '(category-keep))))) - -(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort) - "Make a tags-todo agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN. Also -takes a sorting structure SORT which is passed to -`org-agenda-sorting-strategy'" - (or sort (setq sort ''(category-keep))) - `(tags-todo - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-todo-ignore-with-date t) - (org-agenda-sorting-strategy ,sort)))) - -(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun - &optional todo status-px) - "Make a tags-todo agenda view that matches tags in string MATCH with -header given as string HEADER and with skip function SKIP-FUN. KW-LIST -is a list of keywords to be used in filtering and sorting (the order -in the list defines the sort order). STATUS-FUN is a function used to -get the statuscode of the current line in the agenda. Optional arg -TODO determines if this is a tags-todo (t) or tags (nil) block, and -STATUS-PX as t enables the statuscode to be formatted into the prefix -string." - `(,(if 'tags-todo 'tags) - ,match - ((org-agenda-overriding-header ,header) - (org-agenda-skip-function ,skip-fun) - (org-agenda-before-sorting-filter-function - (lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l))) - (org-agenda-cmp-user-defined - (lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b))) - (org-agenda-prefix-format '((tags . ,(if status-px - " %-12:c %(format \"xxxx: \")" - " %-12:c ")))) - (org-agenda-sorting-strategy '(user-defined-down category-keep))))) -#+END_SRC -***** interactive functions -This is basically a filter but since it is implemented through skip functions it makes more sense to include it here. It allows distinguishing between toplevel projects and projects that are subprojects of the toplevel project (I usually only care about the former). -#+BEGIN_SRC emacs-lisp -(defun nd/toggle-project-toplevel-display () - "Toggle all project headings and toplevel only headings in project blocks." - (interactive) - (setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel)) - (when (equal major-mode 'org-agenda-mode) - (org-agenda-redo)) - (message "Showing %s project view in agenda" - (if nd/agenda-limit-project-toplevel "toplevel" "complete"))) -#+END_SRC -***** advising -Some org functions don't do exactly what I want. Re-educate them here -****** org-tags-view done keywords -The =org-tags-view= can filter tags for only headings with TODO keywords (with type tags-todo), but this automatically excludes keywords in =org-done-keywords=. Therefore, if I want to include these in any custom agenda blocks, I need to use type tags instead and skip the unwanted TODO keywords with a skip function. This is far slower as it applies the skip function to EVERY heading. - -Fix that here by nullifying =org--matcher-tags-todo-only= which controls how the matcher is created for tags and tags-todo. Now I can select done keywords using a match string like "+tag/DONE|CANC" (also much clearer in my opinion). - -While this is usually more efficient, it may be counterproductive in cases where skip functions can be used to ignore huge sections of an org file (which is rarely for me; most only skip ahead to the next heading). -#+BEGIN_SRC emacs-lisp -(defun nd/org-tags-view-advice (orig-fn &optional todo-only match) - "Advice to include done states in `org-tags-view' for tags-todo agenda types." - (nd/with-advice - ((#'org-make-tags-matcher - :around (lambda (f m) - (let ((org--matcher-tags-todo-only nil)) - (funcall f m))))) - (funcall orig-fn todo-only match))) - -(advice-add #'org-tags-view :around #'nd/org-tags-view-advice) -#+END_SRC -**** block agenda views -***** default sorting -This gives more flexibility in ignoring items with timestamps -#+BEGIN_SRC emacs-lisp -(setq org-agenda-tags-todo-honor-ignore-options t) -#+END_SRC - -By default I want block agendas to sort based on the todo keyword (with NEXT being up top as these have priority). -#+BEGIN_SRC emacs-lisp -(setq org-agenda-cmp-user-defined - '(lambda (a b) - (let ((pa (- (length (member - (get-text-property 1 'todo-state a) - nd/org-agenda-todo-sort-order)))) - (pb (- (length (member - (get-text-property 1 'todo-state b) - nd/org-agenda-todo-sort-order))))) - (cond ((or (null pa) (null pb)) nil) - ((> pa pb) +1) - ((< pa pb) -1))))) - -#+END_SRC -***** custom commands -These agenda commands are the center of the gtd workflow. Some are slower than dirt but that's ok becuase the load times are far less than the that I would waste rifling through each org file trying to find a task. -#+BEGIN_SRC emacs-lisp -(let* ((actionable "-NA-REFILE-%inc") - (periodical "PARENT_TYPE=\"periodical\"") - (iterator "PARENT_TYPE=\"iterator\"") - (habit "STYLE=\"habit\"") - (task-match (concat actionable "-" periodical "-" habit "/!")) - (act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!")) - (peri-match (concat actionable "+" periodical "-" iterator "-" habit)) - (iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!"))) - - (setq - org-agenda-custom-commands - `(("a" - "Calendar View" - ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE"))) - (org-agenda-include-diary t))))) - - ("t" - "Task View" - (,(nd/agenda-base-task-cmd act-no-rep-match - "Project Tasks" - ''nd/skip-non-project-tasks - ''(user-defined-up category-keep)) - ,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks))) - - ("p" - "Project View" - (,(nd/agenda-base-project-cmd - act-no-rep-match - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects") - ''nd/skip-non-projects - ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete - :stuck :waiting :held :active) - ''nd/get-project-status t t))) - - ("i" - "Incubator View" - ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc"))) - (org-agenda-span 7) - (org-agenda-time-grid nil) - (org-agenda-entry-types '(:deadline :timestamp :scheduled)))) - ,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc" - "Stale Incubated Timestamps" - ''nd/skip-non-stale-headings) - ,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!" - "Incubated Tasks" - ''nd/skip-non-atomic-tasks) - ,(nd/agenda-base-project-cmd - "-NA-REFILE+%inc/!" - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects") - ''nd/skip-non-projects - ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete - :stuck :waiting :held :active) - ''nd/get-project-status - t t))) - - ("P" - "Periodical View" - (,(nd/agenda-base-project-cmd - (concat actionable "-" iterator "+" periodical "-" habit) - "Periodical Status" - ''nd/skip-non-periodical-parent-headings - 'nd/peri-statuscodes ''nd/get-periodical-status nil t) - ,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\"" - "Untimestamped" - ''nd/skip-non-periodical-untimestamped))) - - ("I" - "Iterator View" - (,(nd/agenda-base-project-cmd - "-NA-REFILE+PARENT_TYPE=\"iterator\"" - "Iterator Status" - ''nd/skip-non-iterator-parent-headings - 'nd/iter-statuscodes ''nd/get-iterator-status nil t) - ,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!" - "Unscheduled or Undeaded" - ''nd/skip-non-iterator-unscheduled))) - - ("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) - (org-tags-match-list-sublevels nil)))) - - ("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks"))))) - - ("e" - "Critical Errors" - (,(nd/agenda-base-task-cmd task-match - "Discontinous Project" - ''nd/skip-non-discontinuous-project-tasks) - ,(nd/agenda-base-heading-cmd task-match - "Undone Closed" - ''nd/skip-non-undone-closed-todoitems) - ,(nd/agenda-base-heading-cmd (concat actionable "-" periodical) - "Done Unclosed" - ''nd/skip-non-done-unclosed-todoitems) - ,(nd/agenda-base-task-cmd (concat task-match) - "Missing Creation Timestamp" - ''nd/skip-non-ia-timestamped-tasks))) - - - ("A" - "Archivable Tasks and Projects" - ((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC") - ((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators") - (org-agenda-sorting-strategy '(category-keep)) - (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks))) - ,(nd/agenda-base-heading-cmd (concat actionable "-" habit) - "Stale Tasks and Periodicals" - ''nd/skip-non-stale-headings) - ,(nd/agenda-base-project-cmd - (concat actionable "-" periodical "-" iterator "-" habit) - '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects") - ''nd/skip-non-projects ''(:archivable) ''nd/get-project-status)))))) +(org-babel-load-file (expand-file-name "org/org.org" nd/conf-dir)) #+END_SRC * tools ** printing diff --git a/conf/org/org.el b/conf/org/org.el new file mode 100644 index 0000000..fb3da1f --- /dev/null +++ b/conf/org/org.el @@ -0,0 +1,1479 @@ +(use-package org + :delight + ;; source of indent-mode required here + (org-indent-mode nil org-indent) + (visual-line-mode) + :hook + (org-mode . visual-line-mode) + :config + (setq org-startup-indented t + org-directory "~/Org" + org-modules '(org-habit org-protocol)) + + (require 'org-protocol)) + +(setq org-special-ctrl-a/e t + org-special-ctrl-k t + org-yank-adjusted-subtrees t) + +(defun nd/org-save-all-org-buffers () + "Save org buffers without confirmation or message (unlike default)." + (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) + (when (featurep 'org-id) (org-id-locations-save))) + +(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers) + +(setq org-log-into-drawer "LOGBOOK") + +(setq org-log-done 'time + org-log-redeadline 'time + org-log-reschedule 'time) + +(setq org-log-repeat 'note) + +(use-package org-bullets + :ensure t + :hook + (org-mode . org-bullets-mode)) + +(add-hook 'org-mode-hook + (lambda () + (let ((heading-height 1.15)) + (set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height) + (set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height) + (set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height) + (set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height) + (set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height)))) + +(setq org-src-window-setup 'current-window + org-src-fontify-natively t + org-edit-src-content-indentation 0) + +(add-to-list 'org-structure-template-alist + '("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC")) + +(setq org-insert-heading-respect-content t) + +(defun nd/mark-subtree-keyword (new-keyword &optional exclude) + "Mark all tasks in a subtree with NEW-KEYWORD unless original +keyword is in the optional argument EXCLUDE." + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (if (not (listp exclude)) + (error "exlude must be a list if provided")) + (save-excursion + (while (< (point) subtree-end) + (let ((keyword (nd/is-todoitem-p))) + (if (and keyword (not (member keyword exclude))) + (org-todo new-keyword))) + (outline-next-heading))))) + +(defun nd/mark-subtree-done () + "Mark all tasks in subtree as DONE unless they are already CANC." + (interactive) + (nd/mark-subtree-keyword "DONE" '("CANC"))) + +(defun nd/org-clone-subtree-with-time-shift (n &optional shift) + "Like `org-clone-subtree-with-time-shift' except it resets checkboxes +and reverts all todo keywords to TODO." + (interactive "nNumber of clones to produce: ") + + (let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ")))) + (condition-case err + (progn + (save-excursion + ;; clone once and reset + (org-clone-subtree-with-time-shift 1 shift) + (org-forward-heading-same-level 1 t) + (org-reset-checkbox-state-subtree) + (nd/mark-subtree-keyword "TODO") + (call-interactively 'nd/org-log-delete) + (org-cycle) + ;; clone reset tree again if we need more than one clone + (if (> n 1) + (let ((additional-trees (- n 1))) + (org-clone-subtree-with-time-shift additional-trees shift) + (dotimes (i additional-trees) + (org-forward-heading-same-level 1 t) + (org-cycle)))))) + (error (message "%s" (error-message-string err)))))) + +(defun nd/org-log-delete () + "Delete logbook drawer of subtree." + (interactive) + (save-excursion + (goto-char (org-log-beginning)) + (when (save-excursion + (save-match-data + (beginning-of-line 0) + (search-forward-regexp org-drawer-regexp) + (goto-char (match-beginning 1)) + (looking-at "LOGBOOK"))) + (org-mark-element) + (delete-region (region-beginning) (region-end)) + (org-remove-empty-drawer-at (point))))) + +(defun nd/org-insert-todo-heading-inactive-timestamp () + "Insert a todo heading but also insert inactive timestamp set to now." + (interactive) + ;; a bit redundant and hacky, with the advantage of being effective + (when (not (org-insert-item 'checkbox)) + (call-interactively 'org-insert-todo-heading) + (insert "\n") + (funcall-interactively 'org-time-stamp-inactive '(16)) + (forward-line -1))) + +(defun nd/org-delete-subtree () + "Delete the entire subtree under the current heading without sending to kill ring." + (interactive) + (org-back-to-heading t) + (delete-region (point) (+ 1 (save-excursion (org-end-of-subtree))))) + +(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body) + "Wraps commands in BODY in necessary code to allow commands to be +called from the agenda buffer. Particularly, this wrapper will +navigate to the original header, execute BODY, then update the agenda +buffer." + '(org-agenda-check-no-diary) + `(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + ,@body + (when ,get-head (setq newhead (org-get-heading)))) + (if ,get-head + (org-agenda-change-all-lines newhead hdmarker) + (org-agenda-redo)) + (beginning-of-line 1)))) + +(defun nd/org-agenda-toggle-checkbox () + "Toggle checkboxes in org agenda view using `org-toggle-checkbox'." + (interactive) + (nd/org-agenda-cmd-wrapper + t + (call-interactively #'org-toggle-checkbox))) + +(defun nd/org-agenda-clone-subtree-with-time-shift () + "Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry. +It will clone the last entry in the selected subtree." + (interactive) + (nd/org-agenda-cmd-wrapper + nil + (org-end-of-subtree) + (call-interactively #'nd/org-clone-subtree-with-time-shift))) + +(defun nd/org-agenda-delete-subtree () + "Apply `nd/org-delete-subtree' to an agenda entry." + (interactive) + (nd/org-agenda-cmd-wrapper + nil + (call-interactively #'nd/org-delete-subtree))) + +(setq org-columns-default-format + "%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)") + +(set-face-attribute 'org-column nil :background "#1e2023") +;; org-columns-summary-types + +(use-package calfw + :ensure t + :config + (setq cfw:fchar-junction ?╋ + cfw:fchar-vertical-line ?┃ + cfw:fchar-horizontal-line ?━ + cfw:fchar-left-junction ?┣ + cfw:fchar-right-junction ?┫ + cfw:fchar-top-junction ?┯ + cfw:fchar-top-left-corner ?┏ + cfw:fchar-top-right-corner ?┓)) + +(use-package calfw-org + :ensure t + :after calfw + :config + (setq cfw:org-agenda-schedule-args + '(:deadline :timestamp))) + +(defun nd/org-todo-position (buffer alist) + (let ((win (car (cl-delete-if-not + (lambda (window) + (with-current-buffer (window-buffer window) + (memq major-mode + '(org-mode org-agenda-mode)))) + (window-list))))) + (when win + (let ((new (split-window win -4 'below))) + (set-window-buffer new buffer) + new)))) + +(defun nd/org-todo-window-advice (orig-fn) + "Advice to fix window placement in `org-fast-todo-selection'." + (let ((override '("\\*Org todo\\*" nd/org-todo-position))) + (add-to-list 'display-buffer-alist override) + (nd/with-advice + ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) + (unwind-protect (funcall orig-fn) + (setq display-buffer-alist + (delete override display-buffer-alist)))))) + +(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice) + +(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table) + "Advice to fix window placement in `org-fast-tags-selection'." + (nd/with-advice + ((#'delete-other-windows :override #'ignore) + ;; pretty sure I just got lucky here... + (#'split-window-vertically :override #'(lambda (&optional size) + (split-window-below (or size -9))))) + (unwind-protect (funcall orig-fn current inherited table todo-table)))) + +(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice) + +(defun nd/org-capture-position (buffer alist) + (let ((new (split-window (get-buffer-window) -14 'below))) + (set-window-buffer new buffer) + new)) + +(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials) + "Advice to fix window placement in `org-capture-select-template'." + (let ((override '("\\*Org Select\\*" nd/org-capture-position))) + (add-to-list 'display-buffer-alist override) + (nd/with-advice + ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) + (unwind-protect (funcall orig-fn table title prompt specials) + (setq display-buffer-alist + (delete override display-buffer-alist)))))) + +(advice-add #'org-mks :around #'nd/org-capture-window-advice) + +(setq org-html-doctype "html5") + +(setq org-latex-pdf-process (list "latexmk -shell-escape -bibtex -f -pdf %f")) + +;; (defvar nd/org-export-publishing-directory +;; (expand-file-name "~/Downloads/org-exports") +;; "The target directory to for all org exports.") + +;; (defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir) +;; "Change the target export directory for org exports." +;; (unless pub-dir +;; (setq pub-dir nd/org-export-publishing-directory) +;; (unless (file-directory-p pub-dir) +;; (make-directory pub-dir))) +;; (apply orig-fun extension subtreep pub-dir nil)) + +;; (advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name) + +(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/") +(require 'org-gantt) + +(add-to-list 'org-structure-template-alist + '("og" "#+BEGIN: org-gantt-chart\n?\n#+END")) + +(setq org-todo-keywords + '((sequence + ;; default undone state + "TODO(t/!)" + + ;; undone but available to do now (projects only) + "NEXT(n/!)" "|" + + ;; done and complete + "DONE(d/!)") + + (sequence + ;; undone and waiting on some external dependency + "WAIT(w@/!)" + + ;; undone but signifies tasks on which I don't wish to focus at the moment + "HOLD(h@/!)" "|" + + ;; done but not complete + "CANC(c@/!)"))) + +(setq org-todo-keyword-faces + '(("TODO" :foreground "light coral" :weight bold) + ("NEXT" :foreground "khaki" :weight bold) + ("DONE" :foreground "light green" :weight bold) + ("WAIT" :foreground "orange" :weight bold) + ("HOLD" :foreground "violet" :weight bold) + ("CANC" :foreground "deep sky blue" :weight bold))) + +(setq org-tag-alist + ;; (@) gtd location context + '((:startgroup) + ("@errand" . ?e) + ("@home" . ?h) + ("@work" . ?w) + ("@travel" . ?r) + (:endgroup) + + ;; (#) gtd resource context + ("#laptop" . ?l) + ("#tcult" . ?t) + ("#phone" . ?p) + + ;; (%) misc tags + ;; denotes reference information + ("%note" . ?n) + + ;; incubator + ("%inc" . ?i) + + ;; denotes tasks that need further subdivision to turn into true project + ("%subdiv" . ?s) + + ;; catchall to mark important headings, usually for meetings + ("%flag" . ?f) + + ;; (_) life categories, used for gtd priority context + (:startgroup) + ("_env" . ?E) + ("_fin" . ?F) + ("_int" . ?I) + ("_met" . ?M) + ("_phy" . ?H) + ("_pro" . ?P) + ("_rec" . ?R) + ("_soc" . ?S) + (:endgroup))) + +(defun nd/add-tag-face (fg-name prefix) + "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 + to which the faces are applied" + (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist))) + (push `(,tag . (:foreground ,fg-name)) org-tag-faces))) + +(setq org-tag-faces '()) + +(nd/add-tag-face "PaleGreen" "@") +(nd/add-tag-face "SkyBlue" "#") +(nd/add-tag-face "PaleGoldenrod" "%") +(nd/add-tag-face "violet" "_") + +(mapc (lambda (i) (add-to-list 'org-default-properties i)) + ;; defines a repeater group + '("PARENT_TYPE" + ;; defines the time shift for repeater groups + + "TIME_SHIFT" + ;; assigns another person/entity to a task (experimental) + + "DELEGATE" + + ;; defines a goal (not currently used) + "GOAL")) + +(setq org-global-properties + '(("PARENT_TYPE_ALL" . "periodical iterator") + ("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")) + + org-use-property-inheritance + '("PARENT_TYPE" "TIME_SHIFT")) + +(defun nd/org-timestamp-future (days) + "Inserts an active org timestamp DAYS after the current time." + (format-time-string (org-time-stamp-format nil) + (time-add (current-time) (days-to-time 1)))) + +(let ((capfile "~/Org/capture.org")) + (setq org-capture-templates + ;; regular TODO task + `(("t" "todo" entry (file ,capfile) + "* TODO %?\n%U\ndeliverable: \n") + + ;; for useful reference information that may be grouped with tasks + ("n" "note" entry (file ,capfile) + "* %? :\\%note:\n%U\n") + + ;; for non-actionable events that happen at a certain time + ("a" "appointment" entry (file ,capfile) + "* %?\n%U\n%^t\n") + + ;; like appointment but multiple days + ("s" "appointment-span" entry (file ,capfile) + "* %?\n%U\n%^t--%^t\n") + + ;; task with a deadline + ("d" "deadline" entry (file ,capfile) + "* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n") + + ;; for converting mu4e emails to tasks, defaults to next-day deadline + ("e" "email" entry (file ,capfile) + "* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%U\n%a\n") + + ;; for interruptions that produce useful reference material + ("m" "meeting" entry (file ,capfile) + "* meeting with%? :\\%note:\n%U\n") + + ;; for capturing web pages with web browser + ("p" "org-protocol" entry (file ,capfile) + "* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE" + :immediate-finish t) + + ;; or capturing links with web browser + ("L" "org-protocol link" entry (file ,capfile) + "* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U" + :immediate-finish t)))) + +(add-hook 'org-capture-mode-hook (lambda () (evil-append 1))) + +(setq org-refile-targets '((nil :maxlevel . 9) + ("~/Org/reference/idea.org" :maxlevel . 9) + (org-agenda-files :maxlevel . 9)) + org-refile-use-outline-path t + org-outline-path-complete-in-steps nil + org-refile-allow-creating-parent-nodes 'confirm + org-indirect-buffer-display 'current-window) + +(setq org-refile-target-verify-function + (lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords)))) + +;; TODO this no work, although does work if var is global +;; redfining the targets works for now +(add-hook 'org-agenda-mode-hook + (lambda () + (when (equal (buffer-name) "*Org Agenda(A)*") + (setq-local org-refile-targets + '(("~/Org/journal/goals.org" :maxlevel . 9)))))) +;; (lambda () (when (org-entry-get nil "GOAL") t)))))) +;; (setq org-refile-targets '((nil :maxlevel . 9) +;; ("~/Org/reference/idea.org" :maxlevel . 9) +;; ("~/Org/journal/goals.org" :maxlevel . 9) +;; (org-agenda-files :maxlevel . 9)) + +(setq org-clock-history-length 23 + org-clock-out-when-done t + org-clock-persist t + org-clock-report-include-clocking-task t) + +(defun nd/are-conflicting-p (ts-a ts-b) + "Return t if timestamps TS-A and TS-B conflict." + (let* ((earlier-a (car ts-a)) + (earlier-b (car ts-b)) + (later-b (+ earlier-b (nth 1 ts-b)))) + (and (>= earlier-a earlier-b) (<= earlier-a later-b)))) + +(defun nd/detect-conflict (ts ts-list conlist) + "Recursively determine if timestamp TS conflicts with anything in TS-LIST. +If detected, conflict pair is added to CONLIST." + (let ((next-ts (car ts-list)) + (rem-ts (cdr ts-list))) + (if (nd/are-conflicting-p ts next-ts) + (progn + (setq conlist (cons (list ts next-ts) conlist)) + (if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist)) + conlist))) + +(defun nd/build-conlist (ts-list conlist) + "Recursively build a list of timestamp conflicts from TS-LIST. + +TS-LIST is comprised of entries in the form (staring-ts timerange marker) +where timerange is 0 for singular timestamps and a positive number for +anything with to times or a timestamp range. +Detected conflicts are stored in CONLIST as pairs of conflicting ts +entries from the TS-LIST." + (let ((cur-ts (car ts-list)) + (rem-ts (cdr ts-list))) + (if rem-ts + (nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist)) + conlist))) + +(defconst nd/org-tsm-regexp + "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" + "Regular expression for timestamps with two times.") + +(defun nd/get-timestamps () + "Get the org-marker and timestamp(s) (multiple if range) or current heading." + ;; TODO, what if I care about more than just TIMESTAMPs + (let* ((ts (org-entry-get nil "TIMESTAMP")) + (marker (point-marker)) + (ts-range 0) + (ts-entry)) + (when ts + (cond + ;; match timestamps that have two times + ((string-match nd/org-tsm-regexp ts) + (let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts))) + (ts2 (concat (match-string 1 ts) (match-string 3 ts))) + (ft1 (org-2ft ts1)) + (ft2 (org-2ft ts2))) + (setq ts-entry ft1) + (setq ts-range (- ft2 ft1)))) + + ;; match timestamps that have a range (eq two timestamps) + ((string-match org-tr-regexp ts) + (let* ((ts1 (match-string 1 ts)) + (ts2 (match-string 2 ts)) + (ft1 (org-2ft ts1)) + (ft2 (org-2ft ts2))) + (setq ts-entry ft1) + (setq ts-range (- ft2 ft1)))) + + ;; match timestamps with only one time + (t (setq ts-entry (org-2ft ts)))) + (list ts-entry ts-range marker ts)))) + +(defun nd/build-conflict-list () + "Scan all org files and make a list of all timestamps that conflict." + (let ((files (org-agenda-files)) + max-reached ts-list cur-index conflicts) + ;; get all timestamps from org buffers + (dolist (f files ts-list) + (with-current-buffer + (find-file-noselect f) + (goto-char (point-min)) + (when (not (outline-on-heading-p)) (outline-next-heading)) + (setq max-reached nil) + (while (not max-reached) + (let ((new-ts (nd/get-timestamps))) + (if new-ts (setq ts-list (cons new-ts ts-list)))) + (unless (outline-next-heading) (setq max-reached t))))) + + ;; sort the timestamp list + ;; TODO, need to make range-aware + (setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b))))) + + ;; build a list of conflicts + (nd/build-conlist ts-list conflicts))) + +(defun nd/get-conflict-header-text (conflict-marker) + "Return string with text properties representing the org header for +MARKER for use in the conflict agenda view." + (let* ((props (list + 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight)) + ;; 'help-echo + ;; (format "mouse-2 or RET jump to org file %s" + ;; (abbreviate-file-name buffer-file-name)))) + marker priority category level tags todo-state + ts-date ts-date-type ts-date-pair + txt beg end inherited-tags todo-state-end-pos) + + (with-current-buffer (marker-buffer conflict-marker) + (save-excursion + (goto-char conflict-marker) + + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) + ts-date (car ts-date-pair) + ts-date-type (cdr ts-date-pair) + txt (org-get-heading t) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? ) + txt (org-agenda-format-item "" txt level category tags t) + priority (1+ (org-get-priority txt))) + + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'priority priority + 'level level + 'ts-date ts-date + 'type "timestamp"))))) + +(defun nd/org-conflicts (&optional arg) + (interactive "P") + + (if org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) + + (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) + + (let* ((today (org-today)) + (date (calendar-gregorian-from-absolute today)) + (completion-ignore-case t) + (org-agenda-prefix-format '((agenda . " %-12:c %-5:e "))) + rtn rtnall files file pos) + + (catch 'exit + (when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*")) + + (org-agenda-prepare) + ;; (org-compile-prefix-format 'todo) + (org-compile-prefix-format 'agenda) + ;; (org-set-sorting-strategy 'todo) + + (setq org-agenda-redo-command '(nd/org-conflicts)) + + (insert "Conflicting Headings: \n") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading "Conflicts")) + (org-agenda-mark-header-line (point-min)) + + (setq rtnall (nd/build-conflict-list)) + (when rtnall + (mapc + (lambda (c) + (insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n")) + (insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n")) + (insert "\n")) + rtnall)) + + ;; clean up and finalize + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type agenda + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) + +(setq org-agenda-files '("~/Org" + "~/Org/projects" + "~/Org/reference/peripheral.org")) + +(setq org-agenda-sticky t) + +(add-hook 'org-finalize-agenda-hook + (lambda () (setq org-agenda-tags-column (- 4 (window-width))) + (org-agenda-align-tags))) + +(setq org-agenda-prefix-format + '((agenda . " %-12:c %-5:e %?-12t% s") + (todo . " %-12:c") + (tags . " %-12:c %-5:e ") + (search . " %-12:c"))) + +(setq org-agenda-dim-blocked-tasks nil + org-agenda-compact-blocks t + org-agenda-window-setup 'current-window + org-agenda-start-on-weekday 0 + org-agenda-span 'day + org-agenda-current-time-string "### -- NOW -- ###") + +(setq org-habit-graph-column 50) + +(defun nd/org-agenda-filter-non-context () + "Filter all tasks with context tags." + (interactive) + (let* ((tags-list (mapcar #'car org-tag-alist)) + (context-tags (append + (nd/filter-list-prefix "@" tags-list) + (nd/filter-list-prefix "#" tags-list)))) + (setq org-agenda-tag-filter + (mapcar (lambda (tag) (concat "-" tag)) context-tags)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) + +(defun nd/org-agenda-filter-non-peripheral () + "Filter all tasks that don't have peripheral tags." + (interactive) + (let* ((peripheral-tags '("PERIPHERAL"))) + (setq org-agenda-tag-filter + (mapcar (lambda (tag) (concat "-" tag)) peripheral-tags)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) + +(defun nd/org-agenda-filter-non-effort () + "Filter agenda by non-effort tasks." + (interactive) + (setq org-agenda-hasprop-filter '("-Effort")) + (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) + +(defun nd/org-agenda-filter-delegate () + "Filter agenda by tasks with an external delegate." + (interactive) + (setq org-agenda-hasprop-filter '("+DELEGATE")) + (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) + +;; initialize new filters +(defvar org-agenda-hasprop-filter nil) + +(defun nd/org-agenda-filter-make-matcher-prop + (filter type &rest args) + "Return matching matcher form for FILTER and TYPE where TYPE is not +in the regular `org-agenda-filter-make-matcher' function. This is +intended to be uses as :before-until advice and will return nil if +the type is not valid (which is currently 'prop')" + (let (f f1) + ;; has property + (cond + ((eq type 'hasprop) + (dolist (x filter) + (push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f)))) + (if f (cons 'and (nreverse f))))) + +(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h) + "Returns form to test the presence or absence of properties H. +H is a string like +prop or -prop" + (let (op) + (let* ((op (string-to-char h)) + (h (substring h 1)) + (f `(save-excursion + (let ((m (org-get-at-bol 'org-hd-marker))) + (with-current-buffer + (marker-buffer m) + (goto-char m) + (org-entry-get nil ,h)))))) + (if (eq op ?-) (list 'not f) f)))) + +(defun nd/org-agenda-filter-show-all-hasprop nil + (org-agenda-remove-filter 'hasprop)) + +(advice-add #'org-agenda-filter-make-matcher :before-until + #'nd/org-agenda-filter-make-matcher-prop) + +(advice-add #'org-agenda-filter-remove-all :before + (lambda () (when org-agenda-hasprop-filter + (nd/org-agenda-filter-show-all-hasprop)))) + +(setq org-agenda-bulk-custom-functions + '((?D nd/org-agenda-delete-subtree))) + +(setq holiday-bahai-holidays nil + holiday-hebrew-holidays nil + holiday-oriental-holidays nil + holiday-islamic-holidays nil) + +(setq calendar-holidays (append holiday-general-holidays + holiday-christian-holidays)) + +(defconst nd/iter-future-time (* 7 24 60 60) + "Iterators must have at least one task greater into the future to be active.") + +(defconst nd/iter-statuscodes '(:uninit :empty :active) + "Iterators can have these statuscodes.") + +(defconst nd/peri-future-time nd/iter-future-time + "Periodicals must have at least one heading greater into the future to be fresh.") + +(defconst nd/peri-statuscodes '(:uninit :stale :fresh)) + +(defconst nd/project-invalid-todostates + '("WAIT" "NEXT") + "Projects cannot have these todostates.") + +(defvar nd/agenda-limit-project-toplevel t + "If true, filter projects by all levels or top level only.") + +(defvar nd/agenda-hide-incubator-tags t + "If true, don't show incubator headings.") + +(defconst nd/org-agenda-todo-sort-order + '("NEXT" "WAIT" "HOLD" "TODO") + "Defines the order in which todo keywords should be sorted.") + +(defconst nd/project-skip-todostates + '("HOLD" "CANC") + "These keywords override all contents within their subtrees. +Currently used to tell skip functions when they can hop over +entire subtrees to save time and ignore tasks") + +(defun nd/get-date-property (timestamp-property) + "Get TIMESTAMP-PROPERTY on current heading and convert to a number. +If it does not have a date, it will return nil." + (let ((ts (org-entry-get nil timestamp-property))) + (when ts (org-2ft ts)))) + +(defun nd/heading-compare-timestamp (timestamp-fun + &optional ref-time future) + "Returns the timestamp (from TIMESTAMP-FUM on the current heading) +if timestamp is futher back in time compared to a REF-TIME (default to +0 which is now, where negative is past and positive is future). If the +FUTURE flag is t, returns timestamp if it is in the future compared +to REF-TIME. Returns nil if no timestamp is found." + (let* ((timestamp (funcall timestamp-fun)) + (ref-time (or ref-time 0))) + (if (and timestamp + (if future + (> (- timestamp (float-time)) ref-time) + (<= (- timestamp (float-time)) ref-time))) + timestamp))) + +(defun nd/is-ia-timestamped-heading-p () + "Get active timestamp of current heading." + (nd/get-date-property "TIMESTAMP_IA")) + +(defun nd/is-timestamped-heading-p () + "Get active timestamp of current heading." + (nd/get-date-property "TIMESTAMP")) + +(defun nd/is-scheduled-heading-p () + "Get scheduled timestamp of current heading." + (nd/get-date-property "SCHEDULED")) + +(defun nd/is-deadlined-heading-p () + "Get deadline timestamp of current heading." + (nd/get-date-property "DEADLINE")) + +(defun nd/is-closed-heading-p () + "Get closed timestamp of current heading." + (nd/get-date-property "CLOSED")) + +(defun nd/is-stale-heading-p (&optional ts-prop) + "Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale." + (nd/heading-compare-timestamp + (lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP")))) + (when (and ts (not (find ?+ ts))) (org-2ft ts)))))) + +(defun nd/is-fresh-heading-p () + "Return timestamp if current heading is fresh." + (nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t)) + +(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 current heading is archivable." + (nd/heading-compare-timestamp + 'nd/is-closed-heading-p + (- (* 60 60 24 nd/archive-delay-days)))) + +(defun nd/is-todoitem-p () + "Return todo keyword if heading has one." + (let ((keyword (nth 2 (org-heading-components)))) + (if (member keyword org-todo-keywords-1) + keyword))) + +(defun nd/is-project-p () + "Return todo keyword if heading has todoitem children." + (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) + +(defun nd/is-task-p () + "Return todo keyword if heading has todoitem children." + (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) + +(defun nd/is-project-task-p () + "Return todo keyword if heading has todoitem parents." + (and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p))) + +(defun nd/is-atomic-task-p () + "Return todo keyword if heading has no todoitem parents or children." + (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) + +(defun nd/is-periodical-heading-p () + "Return t if heading is a periodical." + (equal "periodical" (org-entry-get nil "PARENT_TYPE" t))) + +(defun nd/is-iterator-heading-p () + "Return t if heading is an iterator." + (equal "iterator" (org-entry-get nil "PARENT_TYPE" t))) + +(defun nd/heading-has-effort-p () + "Return t if heading has an effort." + (org-entry-get nil "Effort")) + +(defun nd/heading-has-context-p () + "Return t if heading has a context." + (let ((tags (org-get-tags-at))) + (or (> (length (nd/filter-list-prefix "#" tags)) 0) + (> (length (nd/filter-list-prefix "@" tags)) 0)))) + +(defun nd/heading-has-tag-p (tag) + "Return t if heading has tag TAG." + (member tag (org-get-tags-at))) + +(defun nd/heading-has-children (heading-test) + "Return t if heading has a child for whom HEADING-TEST is t." + (let ((subtree-end (save-excursion (org-end-of-subtree t))) + has-children previous-point) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not has-children) + (< previous-point (point) subtree-end)) + (when (funcall heading-test) + (setq has-children t)) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + has-children)) + +(defun nd/heading-has-parent (heading-test) + "Return t if heading has parent for whom HEADING-TEST is t." + (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) + +(defun nd/has-discontinuous-parent () + "Return t if heading has a non-todoitem parent which in turn has a todoitem parent." + (let ((has-todoitem-parent) + (has-non-todoitem-parent)) + (save-excursion + (while (and (org-up-heading-safe) + (not has-todoitem-parent)) + (if (nd/is-todoitem-p) + (setq has-todoitem-parent t) + (setq has-non-todoitem-parent t)))) + (and has-todoitem-parent has-non-todoitem-parent))) + +(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list) + "Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP." + `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) + +(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status) + "Loop through (sub)project and return overall statuscode. + +The returned statuscode is chosen from list ALLOWED-STATUSCODES where +later entries in the list trump earlier ones. + +When a subproject is encountered, this function will obtain the +statuscode of that project and use TRANS-TBL to translate the +subproject statuscode to one in ALLOWED-STATUSCODES (if not found an +error will be raised). TRANS-TBL is given as an alist of two-member +cons cells where the first member is the subproject statuscode and the + second is the index in ALLOWED-STATUSCODES to which the subproject +statuscode will be translated. + +When a task is encountered, function GET-TASK-STATUS will be applied to +obtain a statuscode-equivalent of the status of the tasks." + ;; define "breaker-status" as the last of the allowed-statuscodes + ;; when this is encountered the loop is broken because we are done + ;; (the last entry trumps all others) + (let ((project-status (first allowed-statuscodes)) + (breaker-status (car (last allowed-statuscodes))) + (previous-point)) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + ;; loop through subproject tasks until breaker-status found + (while (and (not (eq project-status breaker-status)) + (> (point) previous-point)) + (let ((keyword (nd/is-todoitem-p))) + (if keyword + (let ((new-status + ;; if project then descend recursively + (if (nd/heading-has-children 'nd/is-todoitem-p) + (let ((n (nd/get-project-status))) + ;; if project returns an allowed status + ;; then use that + (or (and (member n allowed-statuscodes) n) + ;; otherwise look up the value in the + ;; translation table and return error + ;; if not found + (nth (or (alist-get n trans-tbl) + (error (concat "status not found: " n))) + allowed-statuscodes))) + ;; if tasks then use get-task-status to obtain status + (nth (funcall get-task-status keyword) + allowed-statuscodes)))) + (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes) + (setq project-status new-status))))) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + project-status)) + +(defun nd/get-project-status () + "Return project heading statuscode (assumes it is indeed a project)." + (let ((keyword (nd/is-todoitem-p))) + ;; + ;; these first three are easy because they only require + ;; testing the project headline and nothing underneath + ;; + (cond + ;; it does not make sense for projects to be scheduled + ((nd/is-scheduled-heading-p) :scheduled-project) + + ;; held projects do not care what is underneath them + ((equal keyword "HOLD") :held) + + ;; projects with invalid todostates are nonsense + ((member keyword nd/project-invalid-todostates) + :invalid-todostate) + + ;; + ;; these require descending into the project subtasks + ;; + + ;; canceled projects can either be archivable or complete + ;; any errors or undone tasks are irrelevant + ((equal keyword "CANC") + (nd/descend-into-project + '(:archivable :complete) + '((:stuck . 1) + (:held . 1) + (:waiting . 1) + (:active . 1) + (:scheduled-project . 1) + (:invalid-todostate . 1) + (:undone-complete . 1) + (:done-incomplete . 1)) + (lambda (k) + (if (and (member k org-done-keywords) + (nd/is-archivable-heading-p)) 0 1)))) + + ;; done projects are like canceled projects but can also be incomplete + ((equal keyword "DONE") + (nd/descend-into-project + '(:archivable :complete :done-incomplete) + '((:stuck . 2) + (:held . 2) + (:waiting . 2) + (:active . 2) + (:scheduled-project . 2) + (:invalid-todostate . 2) + (:undone-complete . 2)) + (lambda (k) + (if (member k org-done-keywords) + (if (nd/is-archivable-heading-p) 0 1) + 2)))) + + ;; project with TODO states could be basically any status + ((equal keyword "TODO") + (nd/descend-into-project + '(:undone-complete :stuck :held :waiting :active) + '((:complete . 0) + (:archivable . 0) + (:scheduled-project . 1) + (:invalid-todostate . 1) + (:done-incomplete . 1)) + (lambda (k) + (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1)) + ((equal k "HOLD") 2) + ((equal k "WAIT") 3) + ((equal k "NEXT") 4) + (t 0))))) + + (t (error (concat "invalid keyword detected: " keyword)))))) + +(defun nd/get-iterator-status () + "Get the status of an iterator where allowed statuscodes are in list + `nd/get-iter-statuscodes.' where latter codes in the list trump +earlier ones." + (let ((iter-status (first nd/iter-statuscodes)) + (subtree-end (save-excursion (org-end-of-subtree t)))) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not (eq iter-status :active)) + (< (point) subtree-end)) + (let ((keyword (nd/is-atomic-task-p)) + (new-status)) + (if keyword + (progn + (setq new-status (if (nd/heading-compare-timestamp + (lambda () + (or (nd/is-scheduled-heading-p) + (nd/is-deadlined-heading-p))) + nd/iter-future-time t) + :active + :empty)) + (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes) + (setq iter-status new-status))))) + (outline-next-heading))) + iter-status)) + +(defun nd/get-periodical-status () + "Get the status of a periodical where allowed statuscodes are in list + `nd/get-peri-statuscodes.' where latter codes in the list trump +earlier ones." + (let ((peri-status :uninit) + (subtree-end (save-excursion (org-end-of-subtree t)))) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not (eq peri-status :fresh)) + (< (point) subtree-end)) + (if (and (nd/is-periodical-heading-p) + (not (nd/heading-has-children 'nd/is-periodical-heading-p))) + (let ((new-status + (if (nd/heading-compare-timestamp + 'nd/is-timestamped-heading-p + nd/iter-future-time t) + :fresh + :stale))) + (if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes) + (setq peri-status new-status)))) + (outline-next-heading))) + peri-status)) + +(defun nd/skip-heading () + "Skip forward to next heading." + (save-excursion (or (outline-next-heading) (point-max)))) + +(defun nd/skip-subtree () + "Skip forward to next subtree." + (save-excursion (or (org-end-of-subtree t) (point-max)))) + + +(defmacro nd/skip-heading-without (heading-fun test-fun) + "Skip headings accoring to certain characteristics. + +HEADING-FUN is a function that tests the heading and returns the +todoitem keyword on success. TEST-FUN is a function that further tests +the identity of the heading and may or may not use the keyword output +supplied by the HEADING-FUN. This function will not skip if +HEADING-FUN and TEST-FUN return true" + `(save-restriction + (widen) + (let ((keyword (,heading-fun))) + ;; (message keyword) + (if (not (and keyword ,test-fun)) + (nd/skip-heading))))) + +(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list) + "Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST." + (save-restriction + (widen) + (let ((heading-tags (org-get-tags-at))) + (if (and (or (not pos-tags-list) + (intersection pos-tags-list heading-tags :test 'equal)) + (not (intersection neg-tags-list heading-tags :test 'equal))) + (nd/skip-heading))))) + +(defun nd/skip-non-stale-headings () + "Skip headings that do not have stale timestamps and are not part of projects." + (save-restriction + (widen) + (let ((keyword (nd/is-todoitem-p))) + (if (not + (and (nd/is-stale-heading-p) + (not (member keyword org-done-keywords)) + (not (nd/heading-has-children 'nd/is-todoitem-p)) + (not (nd/heading-has-parent 'nd/is-todoitem-p)))) + (nd/skip-heading))))) + +(defun nd/skip-non-ia-timestamped-tasks () + "Skip tasks that do not have an inactive timestamp." + (save-excursion + (widen) + (if (not (and (nd/is-task-p) + (not (nd/is-ia-timestamped-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-atomic-tasks () + "Skip headings that are not atomic tasks." + (save-excursion + (widen) + (if (not (nd/is-atomic-task-p)) + (nd/skip-heading)))) + +(defun nd/skip-non-closed-atomic-tasks () + "Skip headings that are not complete (but not archivable) atomic tasks." + (nd/skip-heading-without + nd/is-atomic-task-p + (and (member keyword org-done-keywords) + (not (nd/is-archivable-heading-p))))) + +(defun nd/skip-non-archivable-atomic-tasks () + "Skip headings that are not archivable atomic tasks." + (nd/skip-heading-without + nd/is-atomic-task-p + (nd/is-archivable-heading-p))) + +(defun nd/skip-non-iterator-parent-headings () + "Skip headings that are not toplevel iterator headings." + (save-restriction + (widen) + (if (not (and (nd/is-iterator-heading-p) + (not (nd/heading-has-parent 'nd/is-iterator-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-iterator-unscheduled () + "Skip all headings that are not unscheduled iterator children." + (nd/skip-heading-without + nd/is-atomic-task-p + (not (or (nd/is-scheduled-heading-p) + (nd/is-deadlined-heading-p))))) + +(defun nd/skip-non-periodical-parent-headings () + "Skip headings that are not toplevel periodical headings." + (save-restriction + (widen) + (if (not (and (nd/is-periodical-heading-p) + (not (nd/heading-has-parent 'nd/is-periodical-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-periodical-untimestamped () + "Skip all headings that are not periodical children without a timestamp." + (save-restriction + (widen) + (if (not (and (nd/is-periodical-heading-p) + (not (nd/is-timestamped-heading-p)) + (not (nd/heading-has-children 'nd/is-periodical-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-project-tasks () + "Skip headings that are not project tasks." + (save-restriction + (widen) + (let ((keyword (nd/is-todoitem-p))) + (if keyword + (if (nd/heading-has-children 'nd/is-todoitem-p) + (if (member keyword nd/project-skip-todostates) + (nd/skip-subtree) + (nd/skip-heading)) + (if (not (nd/heading-has-parent 'nd/is-todoitem-p)) + (nd/skip-heading))) + (nd/skip-heading))))) + +(defun nd/skip-non-discontinuous-project-tasks () + "Skip headings that are not discontinuous within projects." + (nd/skip-heading-without + nd/is-todoitem-p + (nd/has-discontinuous-parent))) + +(defun nd/skip-non-done-unclosed-todoitems () + "Skip headings that are not completed without a closed timestamp." + (nd/skip-heading-without + nd/is-todoitem-p + (and (member keyword org-done-keywords) + (not (nd/is-closed-heading-p))))) + +(defun nd/skip-non-undone-closed-todoitems () + "Skip headings that are not incomplete with a closed timestamp." + (nd/skip-heading-without + nd/is-todoitem-p + (and (not (member keyword org-done-keywords)) + (nd/is-closed-heading-p)))) + +(defun nd/skip-non-projects (&optional ignore-toplevel) + "Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)." + (save-restriction + (widen) + (let ((keyword (nd/is-project-p))) + (if keyword + (if (and nd/agenda-limit-project-toplevel + (not ignore-toplevel) + (nd/heading-has-parent 'nd/is-todoitem-p)) + (nd/skip-subtree)) + (nd/skip-heading))))) + +(defun nd/org-agenda-filter-status (filter status-fun a-line + &optional filter-only) + "Filter for `org-agenda-before-sorting-filter-function' intended for +agenda project views (eg makes the assumption that all entries are +from projects in the original org buffer) wherein this function will +filter project headings based on their statuscodes. + +It works by going to the original org buffer and determining the +project status using STATUS-FUN, after which it will check if +status is in FILTER (a list of statuscodes). If true, the flag string +in the prefix is replaced with the status, and the status is set as a +text property for further sorting. + +If option FILTER-ONLY is t, function only return the unmodified a-line +or nil to act as a filter (eg does not touch text properties)." + (let* ((m (get-text-property 1 'org-marker a-line)) + (s (with-current-buffer (marker-buffer m) + (goto-char m) + (funcall status-fun)))) + (if (member s filter) + (if filter-only + a-line + (org-add-props (replace-regexp-in-string + "xxxx" (symbol-name s) a-line) + nil 'project-status s))))) + +(defun nd/org-agenda-sort-prop (prop order a b) + "Sort a block agenda view by text property PROP given a list ORDER +of said text properties in the desired order and lines A and B as +inputs. To be used with `org-agenda-cmp-user-defined'." + (let* ((ta (get-text-property 1 prop a)) + (tb (get-text-property 1 prop b)) + (pa (position ta order :test (if (stringp ta) #'equal))) + (pb (position tb order :test (if (stringp tb) #'equal)))) + (cond ((or (null pa) (null pb)) nil) + ((< pa pb) +1) + ((> pa pb) -1)))) + +(defun nd/agenda-base-heading-cmd (match header skip-fun) + "Make a tags agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN." + `(tags + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-sorting-strategy '(category-keep))))) + +(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort) + "Make a tags-todo agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN. Also +takes a sorting structure SORT which is passed to +`org-agenda-sorting-strategy'" + (or sort (setq sort ''(category-keep))) + `(tags-todo + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-todo-ignore-with-date t) + (org-agenda-sorting-strategy ,sort)))) + +(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun + &optional todo status-px) + "Make a tags-todo agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN. KW-LIST +is a list of keywords to be used in filtering and sorting (the order +in the list defines the sort order). STATUS-FUN is a function used to +get the statuscode of the current line in the agenda. Optional arg +TODO determines if this is a tags-todo (t) or tags (nil) block, and +STATUS-PX as t enables the statuscode to be formatted into the prefix +string." + `(,(if 'tags-todo 'tags) + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-before-sorting-filter-function + (lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l))) + (org-agenda-cmp-user-defined + (lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b))) + (org-agenda-prefix-format '((tags . ,(if status-px + " %-12:c %(format \"xxxx: \")" + " %-12:c ")))) + (org-agenda-sorting-strategy '(user-defined-down category-keep))))) + +(defun nd/toggle-project-toplevel-display () + "Toggle all project headings and toplevel only headings in project blocks." + (interactive) + (setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel)) + (when (equal major-mode 'org-agenda-mode) + (org-agenda-redo)) + (message "Showing %s project view in agenda" + (if nd/agenda-limit-project-toplevel "toplevel" "complete"))) + +(defun nd/org-tags-view-advice (orig-fn &optional todo-only match) + "Advice to include done states in `org-tags-view' for tags-todo agenda types." + (nd/with-advice + ((#'org-make-tags-matcher + :around (lambda (f m) + (let ((org--matcher-tags-todo-only nil)) + (funcall f m))))) + (funcall orig-fn todo-only match))) + +(advice-add #'org-tags-view :around #'nd/org-tags-view-advice) + +(setq org-agenda-tags-todo-honor-ignore-options t) + +(setq org-agenda-cmp-user-defined + '(lambda (a b) + (let ((pa (- (length (member + (get-text-property 1 'todo-state a) + nd/org-agenda-todo-sort-order)))) + (pb (- (length (member + (get-text-property 1 'todo-state b) + nd/org-agenda-todo-sort-order))))) + (cond ((or (null pa) (null pb)) nil) + ((> pa pb) +1) + ((< pa pb) -1))))) + +(let* ((actionable "-NA-REFILE-%inc") + (periodical "PARENT_TYPE=\"periodical\"") + (iterator "PARENT_TYPE=\"iterator\"") + (habit "STYLE=\"habit\"") + (task-match (concat actionable "-" periodical "-" habit "/!")) + (act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!")) + (peri-match (concat actionable "+" periodical "-" iterator "-" habit)) + (iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!"))) + + (setq + org-agenda-custom-commands + `(("a" + "Calendar View" + ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE"))) + (org-agenda-include-diary t))))) + + ("t" + "Task View" + (,(nd/agenda-base-task-cmd act-no-rep-match + "Project Tasks" + ''nd/skip-non-project-tasks + ''(user-defined-up category-keep)) + ,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks))) + + ("p" + "Project View" + (,(nd/agenda-base-project-cmd + act-no-rep-match + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects") + ''nd/skip-non-projects + ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete + :stuck :waiting :held :active) + ''nd/get-project-status t t))) + + ("i" + "Incubator View" + ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc"))) + (org-agenda-span 7) + (org-agenda-time-grid nil) + (org-agenda-entry-types '(:deadline :timestamp :scheduled)))) + ,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc" + "Stale Incubated Timestamps" + ''nd/skip-non-stale-headings) + ,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!" + "Incubated Tasks" + ''nd/skip-non-atomic-tasks) + ,(nd/agenda-base-project-cmd + "-NA-REFILE+%inc/!" + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects") + ''nd/skip-non-projects + ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete + :stuck :waiting :held :active) + ''nd/get-project-status + t t))) + + ("P" + "Periodical View" + (,(nd/agenda-base-project-cmd + (concat actionable "-" iterator "+" periodical "-" habit) + "Periodical Status" + ''nd/skip-non-periodical-parent-headings + 'nd/peri-statuscodes ''nd/get-periodical-status nil t) + ,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\"" + "Untimestamped" + ''nd/skip-non-periodical-untimestamped))) + + ("I" + "Iterator View" + (,(nd/agenda-base-project-cmd + "-NA-REFILE+PARENT_TYPE=\"iterator\"" + "Iterator Status" + ''nd/skip-non-iterator-parent-headings + 'nd/iter-statuscodes ''nd/get-iterator-status nil t) + ,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!" + "Unscheduled or Undeaded" + ''nd/skip-non-iterator-unscheduled))) + + ("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) + (org-tags-match-list-sublevels nil)))) + + ("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks"))))) + + ("e" + "Critical Errors" + (,(nd/agenda-base-task-cmd task-match + "Discontinous Project" + ''nd/skip-non-discontinuous-project-tasks) + ,(nd/agenda-base-heading-cmd task-match + "Undone Closed" + ''nd/skip-non-undone-closed-todoitems) + ,(nd/agenda-base-heading-cmd (concat actionable "-" periodical) + "Done Unclosed" + ''nd/skip-non-done-unclosed-todoitems) + ,(nd/agenda-base-task-cmd (concat task-match) + "Missing Creation Timestamp" + ''nd/skip-non-ia-timestamped-tasks))) + + + ("A" + "Archivable Tasks and Projects" + ((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC") + ((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators") + (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks))) + ,(nd/agenda-base-heading-cmd (concat actionable "-" habit) + "Stale Tasks and Periodicals" + ''nd/skip-non-stale-headings) + ,(nd/agenda-base-project-cmd + (concat actionable "-" periodical "-" iterator "-" habit) + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects") + ''nd/skip-non-projects ''(:archivable) ''nd/get-project-status)))))) diff --git a/conf/org/org.org b/conf/org/org.org new file mode 100644 index 0000000..92b2543 --- /dev/null +++ b/conf/org/org.org @@ -0,0 +1,1802 @@ +* major mode +** package +Enable =visual-line-mode= and =org-indent-mode= by default and delight them. Also load =org-protocol= after org is loaded and set default org directory to something obvious. +#+BEGIN_SRC emacs-lisp +(use-package org + :delight + ;; source of indent-mode required here + (org-indent-mode nil org-indent) + (visual-line-mode) + :hook + (org-mode . visual-line-mode) + :config + (setq org-startup-indented t + org-directory "~/Org" + org-modules '(org-habit org-protocol)) + + (require 'org-protocol)) +#+END_SRC +** special key behavior +These don't work in evil mode (using the usual line commands). +#+BEGIN_SRC emacs-lisp +(setq org-special-ctrl-a/e t + org-special-ctrl-k t + org-yank-adjusted-subtrees t) +#+END_SRC +** autosave +Save all org buffers 1 minute before the hour. +#+BEGIN_SRC emacs-lisp +(defun nd/org-save-all-org-buffers () + "Save org buffers without confirmation or message (unlike default)." + (save-some-buffers t (lambda () (derived-mode-p 'org-mode))) + (when (featurep 'org-id) (org-id-locations-save))) + +(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers) +#+END_SRC +** logging +*** drawer +I prefer all logging to go in a seperate drawer (aptly named) which allows easier navigation and parsing for data analytics. +#+BEGIN_SRC emacs-lisp +(setq org-log-into-drawer "LOGBOOK") +#+END_SRC +*** events +Events are nice to record because it enables tracking of my behavior (eg how often I reschedule, which may indicate how well I can predict when things should happen). +#+BEGIN_SRC emacs-lisp +(setq org-log-done 'time + org-log-redeadline 'time + org-log-reschedule 'time) +#+END_SRC +*** repeated tasks +In these cases, it is nice to know what happened during each cycle, so force notes. +#+BEGIN_SRC emacs-lisp +(setq org-log-repeat 'note) +#+END_SRC +** bullets +These are just so much better to read +#+BEGIN_SRC emacs-lisp +(use-package org-bullets + :ensure t + :hook + (org-mode . org-bullets-mode)) +#+END_SRC +** font height +The fonts in org headings bug me; make them smaller and less invasive. +#+BEGIN_SRC emacs-lisp +(add-hook 'org-mode-hook + (lambda () + (let ((heading-height 1.15)) + (set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height) + (set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height) + (set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height) + (set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height) + (set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height)))) +#+END_SRC +** src blocks +Enable shortcuts for embedding code in org text bodies. +#+BEGIN_SRC emacs-lisp +(setq org-src-window-setup 'current-window + org-src-fontify-natively t + org-edit-src-content-indentation 0) + +(add-to-list 'org-structure-template-alist + '("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC")) +#+END_SRC +** todo insertion +Make todo insertion respect contents +#+BEGIN_SRC emacs-lisp +(setq org-insert-heading-respect-content t) +#+END_SRC +** interactive commands +Some useful additional commands for org buffers. +#+BEGIN_SRC emacs-lisp +(defun nd/mark-subtree-keyword (new-keyword &optional exclude) + "Mark all tasks in a subtree with NEW-KEYWORD unless original +keyword is in the optional argument EXCLUDE." + (let ((subtree-end (save-excursion (org-end-of-subtree t)))) + (if (not (listp exclude)) + (error "exlude must be a list if provided")) + (save-excursion + (while (< (point) subtree-end) + (let ((keyword (nd/is-todoitem-p))) + (if (and keyword (not (member keyword exclude))) + (org-todo new-keyword))) + (outline-next-heading))))) + +(defun nd/mark-subtree-done () + "Mark all tasks in subtree as DONE unless they are already CANC." + (interactive) + (nd/mark-subtree-keyword "DONE" '("CANC"))) + +(defun nd/org-clone-subtree-with-time-shift (n &optional shift) + "Like `org-clone-subtree-with-time-shift' except it resets checkboxes +and reverts all todo keywords to TODO." + (interactive "nNumber of clones to produce: ") + + (let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective) + (read-from-minibuffer + "Date shift per clone (e.g. +1w, empty to copy unchanged): ")))) + (condition-case err + (progn + (save-excursion + ;; clone once and reset + (org-clone-subtree-with-time-shift 1 shift) + (org-forward-heading-same-level 1 t) + (org-reset-checkbox-state-subtree) + (nd/mark-subtree-keyword "TODO") + (call-interactively 'nd/org-log-delete) + (org-cycle) + ;; clone reset tree again if we need more than one clone + (if (> n 1) + (let ((additional-trees (- n 1))) + (org-clone-subtree-with-time-shift additional-trees shift) + (dotimes (i additional-trees) + (org-forward-heading-same-level 1 t) + (org-cycle)))))) + (error (message "%s" (error-message-string err)))))) + +(defun nd/org-log-delete () + "Delete logbook drawer of subtree." + (interactive) + (save-excursion + (goto-char (org-log-beginning)) + (when (save-excursion + (save-match-data + (beginning-of-line 0) + (search-forward-regexp org-drawer-regexp) + (goto-char (match-beginning 1)) + (looking-at "LOGBOOK"))) + (org-mark-element) + (delete-region (region-beginning) (region-end)) + (org-remove-empty-drawer-at (point))))) + +(defun nd/org-insert-todo-heading-inactive-timestamp () + "Insert a todo heading but also insert inactive timestamp set to now." + (interactive) + ;; a bit redundant and hacky, with the advantage of being effective + (when (not (org-insert-item 'checkbox)) + (call-interactively 'org-insert-todo-heading) + (insert "\n") + (funcall-interactively 'org-time-stamp-inactive '(16)) + (forward-line -1))) + +(defun nd/org-delete-subtree () + "Delete the entire subtree under the current heading without sending to kill ring." + (interactive) + (org-back-to-heading t) + (delete-region (point) (+ 1 (save-excursion (org-end-of-subtree))))) + +#+END_SRC +** interactive agenda commands +These are executed directly from agenda views and affect their source org buffers. The trick is that all of them must somehow go back to the heading to which they alude, execute, then update the agenda view with whatever changes have been made. +#+BEGIN_SRC emacs-lisp +(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body) + "Wraps commands in BODY in necessary code to allow commands to be +called from the agenda buffer. Particularly, this wrapper will +navigate to the original header, execute BODY, then update the agenda +buffer." + '(org-agenda-check-no-diary) + `(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker) + (org-agenda-error))) + (buffer (marker-buffer hdmarker)) + (pos (marker-position hdmarker)) + (inhibit-read-only t) + newhead) + (org-with-remote-undo buffer + (with-current-buffer buffer + (widen) + (goto-char pos) + (org-show-context 'agenda) + ,@body + (when ,get-head (setq newhead (org-get-heading)))) + (if ,get-head + (org-agenda-change-all-lines newhead hdmarker) + (org-agenda-redo)) + (beginning-of-line 1)))) + +(defun nd/org-agenda-toggle-checkbox () + "Toggle checkboxes in org agenda view using `org-toggle-checkbox'." + (interactive) + (nd/org-agenda-cmd-wrapper + t + (call-interactively #'org-toggle-checkbox))) + +(defun nd/org-agenda-clone-subtree-with-time-shift () + "Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry. +It will clone the last entry in the selected subtree." + (interactive) + (nd/org-agenda-cmd-wrapper + nil + (org-end-of-subtree) + (call-interactively #'nd/org-clone-subtree-with-time-shift))) + +(defun nd/org-agenda-delete-subtree () + "Apply `nd/org-delete-subtree' to an agenda entry." + (interactive) + (nd/org-agenda-cmd-wrapper + nil + (call-interactively #'nd/org-delete-subtree))) +#+END_SRC +* column view +#+BEGIN_SRC emacs-lisp + (setq org-columns-default-format + "%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)") + + (set-face-attribute 'org-column nil :background "#1e2023") + ;; org-columns-summary-types +#+END_SRC +* calfw +This is a nifty calendar...sometimes way faster than the agenda buffer for looking at long term things. +#+BEGIN_SRC emacs-lisp +(use-package calfw + :ensure t + :config + (setq cfw:fchar-junction ?╋ + cfw:fchar-vertical-line ?┃ + cfw:fchar-horizontal-line ?━ + cfw:fchar-left-junction ?┣ + cfw:fchar-right-junction ?┫ + cfw:fchar-top-junction ?┯ + cfw:fchar-top-left-corner ?┏ + cfw:fchar-top-right-corner ?┓)) + +(use-package calfw-org + :ensure t + :after calfw + :config + (setq cfw:org-agenda-schedule-args + '(:deadline :timestamp))) +#+END_SRC +* window splitting +Org mode is great and all, but the windows never show up in the right place. The solutions here are simple, but have the downside that the window sizing must be changed when tags/capture templates/todo items are changed. This is because the buffer size is not known at window creation time and I didn't feel like making a function to predict it +** todo selection +I only need a teeny tiny window below my current window for todo selection +#+BEGIN_SRC emacs-lisp +(defun nd/org-todo-position (buffer alist) + (let ((win (car (cl-delete-if-not + (lambda (window) + (with-current-buffer (window-buffer window) + (memq major-mode + '(org-mode org-agenda-mode)))) + (window-list))))) + (when win + (let ((new (split-window win -4 'below))) + (set-window-buffer new buffer) + new)))) + +(defun nd/org-todo-window-advice (orig-fn) + "Advice to fix window placement in `org-fast-todo-selection'." + (let ((override '("\\*Org todo\\*" nd/org-todo-position))) + (add-to-list 'display-buffer-alist override) + (nd/with-advice + ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) + (unwind-protect (funcall orig-fn) + (setq display-buffer-alist + (delete override display-buffer-alist)))))) + +(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice) +#+END_SRC +** tag selection +By default, the tag selection window obliterates all but the current window...how disorienting :/ +#+BEGIN_SRC emacs-lisp +(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table) + "Advice to fix window placement in `org-fast-tags-selection'." + (nd/with-advice + ((#'delete-other-windows :override #'ignore) + ;; pretty sure I just got lucky here... + (#'split-window-vertically :override #'(lambda (&optional size) + (split-window-below (or size -9))))) + (unwind-protect (funcall orig-fn current inherited table todo-table)))) + +(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice) +#+END_SRC +** capture +Capture should show up in the bottom of any currently active buffer +#+BEGIN_SRC emacs-lisp +(defun nd/org-capture-position (buffer alist) + (let ((new (split-window (get-buffer-window) -14 'below))) + (set-window-buffer new buffer) + new)) + +(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials) + "Advice to fix window placement in `org-capture-select-template'." + (let ((override '("\\*Org Select\\*" nd/org-capture-position))) + (add-to-list 'display-buffer-alist override) + (nd/with-advice + ((#'org-switch-to-buffer-other-window :override #'pop-to-buffer)) + (unwind-protect (funcall orig-fn table title prompt specials) + (setq display-buffer-alist + (delete override display-buffer-alist)))))) + +(advice-add #'org-mks :around #'nd/org-capture-window-advice) +#+END_SRC +* exporting +The default is XHTML for some reason (which few use and makes certain barbaric word processors complain). Use the much-superior html5. +#+BEGIN_SRC emacs-lisp +(setq org-html-doctype "html5") +#+END_SRC + +Need to export the bibliography when using org mode. Use =latexmk= instead of =pdflatex= because it is better at handling this. +#+BEGIN_SRC emacs-lisp +(setq org-latex-pdf-process (list "latexmk -shell-escape -bibtex -f -pdf %f")) +#+END_SRC + +By default org export files to the same location as the buffer. Apparently old org versions used to have =org-export-publishing-directory=, but they took it out. Oh well. +#+BEGIN_SRC emacs-lisp +;; (defvar nd/org-export-publishing-directory +;; (expand-file-name "~/Downloads/org-exports") +;; "The target directory to for all org exports.") + +;; (defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir) +;; "Change the target export directory for org exports." +;; (unless pub-dir +;; (setq pub-dir nd/org-export-publishing-directory) +;; (unless (file-directory-p pub-dir) +;; (make-directory pub-dir))) +;; (apply orig-fun extension subtreep pub-dir nil)) + +;; (advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name) +#+END_SRC +* gantt charts +This is custom, non-MELPA package, so it must be loaded manually. See [[https://github.com/swillner/org-gantt/blob/master/org-gantt-manual.org][here]] for guide. +#+BEGIN_SRC emacs-lisp +(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/") +(require 'org-gantt) +#+END_SRC + +It is also useful to define a block template for gantt chart creation +#+BEGIN_SRC emacs-lisp +(add-to-list 'org-structure-template-alist + '("og" "#+BEGIN: org-gantt-chart\n?\n#+END")) +#+END_SRC +* gtd implementation +** overview +This section is meant to be a big-picture overview of how GTD works in this setup. For specifics, see each section following this for further explanation and code. I should also say that most of the ideas for the code came from [[http://doc.norang.ca/org-mode.html#OrgFileStructure][Bernt Hansen's]] very detailed guide. +*** workflow +GTD as described in its [[https://en.wikipedia.org/wiki/Getting_Things_Done][original form]] is divided into asynchronous and synchronous workflows where the asynchronous components happen at any given time and the synchronous components happen on a set schedule. Org mode lends itself quite well to this, and the feature I primarily use in this implementation are custom agenda views (with lots of skip functions). + +async: +1. capture (see =org-capture-templates= below) + - emails as I read them (mu4e) + - ideas that pop into my head + - tasks that I remember to do + - appointments/deadlines in the future + - interruptions from pointy-haired bosses + +sync: +1. process (daily) + - decide if actionable/not + - assign to incubator, references, specific project, or general task file +2. organize (daily) + - add tags (context or resources) + - add properties (effort and delegation) + - note that some tags are automatically added in the proces stage above (mostly priority buckets used for the 7 areas of life, see tags below) +3. review (weekly) + - check project status + - check for scheduling conflicts + - move to/from incubator depending on how adevnturous I feel +4. doing (as planned) + - work through scheduled tasks and deadlines for day + - work through project tasks depending on context/effort/piority + - use clocking to track progress and encourage clean breaks b/t tasks +*** file hierarchy and structure +All org files are kept in one directory in =$HOME=. This is futher subdivided into directories for project (as per terms and definitions, these are any tasks that involve at least on subtask) and reference files. At the top level are files for incubated tasks, captured tasks, and catchall general tasks (which also includes small projects that don't fit anywhere else). + +In order to make sorting easier and minimize work during processing, the files are further subdivided using tags at the file level and heading level that will automatically categorize tasks when they are refiled to a certain location. For example, some project may be to create a computer program, so I would set =#+FILETAGS: #laptop= because every task in this project will require a laptop. See the tags section below for more information on tags. +*** repetition +This deserves special attention because it comprises a significant percentage of tasks I do (and likely everyone does). I personally never liked the org's repeated task functionality. It is way too temporally rigid to be useful to me, and offers very little flexibility in mutating a task as it moves forward. Habits (which I use) are a partial fix for the first problem but do not aleviate the mutability problem. + +My (somewhat convoluted) solution was to use =org-clone-subtree-with-time-shift=, which creates an easy way to make repeated tasks from some template, but also allows modification. The only problem with the vanilla implementation is that it lacks automation and agenda-block awareness (they all get treated as regular tasks which I don't want). This is partially fixed with =nd/org-clone-subtree-with-time-shift= (modifed original) which automaticlly cleans tasks which are cloned (for some reason the original does not clear checkboxes and such). The remainding problems I fixed by defining several properties to be applied to repeated groupings under a heading (see properties). + +The first property is called =PARENT_TYPE= and has two values =iterator= and =periodical=. The first applies to repeated tasks and second which applies to timestamped headings such as appointments. These are mostly useful for agenda sorting, where I have views specifically for managing repeated tasks. The second property is =TIME_SHIFT=; =nd/org-clone-subtree-with-time-shift= is aware of this value and automatically shifts cloned tasks accordingly if available. + +In practice, I use this for tasks like workouts, paying bills, maintenance, grocery shopping, work meetings, GTD reviews, etc. These are all *almost* consistent but may change slightly in their timing, action items, effort, context, etc. If any of these change, it is easy enough to modify one heading without disrupting the rest. + +In an org tree these look like this: +#+BEGIN_SRC org +**** clean room +:PROPERTIES: +:PARENT_TYPE: iterator +:TIME_SHIFT: +1m +:END: +***** DONE clean room [0/2] +CLOSED: [2018-11-21 Wed 22:13] SCHEDULED: <2018-10-29 Mon> +:PROPERTIES: +:Effort: 0:15 +:END: +- [ ] vacuum +- [ ] throw away trash +***** TODO clean room [0/2] +SCHEDULED: <2018-11-29 Thu> +:PROPERTIES: +:Effort: 0:30 +:END: +- [ ] vacuum room +- [ ] throw away trash +#+END_SRC +*** block agenda views +The heart of this implementation is an army of block agenda views (basically filters on the underlying org trees that bring whatever I need into focus). These have become tailored enough to my workflow that I don't even use the built-in views anymore (I also have not found an "easy" way to turn these off). Besides projects, these agenda views are primarily driven using skip functions. +**** projects +When it comes to the agenda view, I never liked how org-mode by default handled "projects" (see how that is defined in "terms and definitions"). It mostly falls short because of the number of todo keywords I insist on using. The solution I implemented was to used "statuscodes" (which are just keywords in lisp) to define higher-level descriptions based on the keyword content of a project. For example a "stuck" project (with statuscode =:stuck=) is a project with only =TODO= keywords. Adding a =NEXT= status turns the statuscode to =:active=. Likewise =WAIT= makes =:waiting=. This seems straightforward, except that =NEXT= trumps =WAIT=, =WAIT= trumps =HOLD=, etc. Furthermore, there are errors I wish to catch to ensure subtrees get efficiently cleaned out, such as a project heading with =DONE= that still has a =TODO= underneath. + +I used to take care of this problem with lots of skip functions, but it turned out to be unmaintainable and offered poor performance (eg if I wanted a block agenda for =N= statuscodes, I needed to scan the entire org tree =N= times). A far easier way to implement this was to embed the statuscodes in text properties in each agenda line, which could then be sorted and the prefix string formatted with the status code for identification in the block agenda view. Since this only requires one block, it only requires one scan, and is very fast. +**** repeaters +Similarly to projects, repeaters (eg iterators and periodicals) are assessed via a statuscode (after all they are a group of headings and thus depending on the evaluation of todo keywoards and timestamps in aggregate). These prove much simpler than projects as essentially all I need are codes for uninitialized (there is nothing in the repeater), empty (all subheadings are in the past and therefore irrelevant), and active (there are some subtasks in the future). +*** terms and definitions +These conventions are used throughout to be precise when naming functions/variables and describing their effects +**** headings +- heading: the topmost part after the bullet in an org outline. Org-mode cannot seem to make up it's mind in calling it a header, heading, or headline, so I picked heading +- todoitem: any heading with a todo keyword +- task: a todoitem with no todoitem children + - atomic: further specifies that the task is not part of a project +- project: a todoitem with that has todoitem children or other projects + - status(code): a keyword used to describe the overall status of a project. See skip functions in the block agenda section for their implementation. +**** time +- stale: refers to timestamps that are in the past/present + - archivable: further specifies that the timestamp is older than some cutoff that defines when tasks can be archived (usually 30 days) +- fresh: refers to timestamps that are in the future +** todo states +*** list +These keywords are used universally for all org files (see below on quick explanation for each, they are all quite straightforward). Note that projects have a more specific meaning for these keywords in defining project status (see the library of agenda function). Also, it looks way better in the agenda buffer when they are all the same number of chars. + +In terms of logging, I like to record the time of each change upon leaving any state, and I like recording information in notes when waiting, holding, or canceling (as these usually have some external trigger or barrier that should be specified). +#+BEGIN_SRC emacs-lisp +(setq org-todo-keywords + '((sequence + ;; default undone state + "TODO(t/!)" + + ;; undone but available to do now (projects only) + "NEXT(n/!)" "|" + + ;; done and complete + "DONE(d/!)") + + (sequence + ;; undone and waiting on some external dependency + "WAIT(w@/!)" + + ;; undone but signifies tasks on which I don't wish to focus at the moment + "HOLD(h@/!)" "|" + + ;; done but not complete + "CANC(c@/!)"))) +#+END_SRC +*** colors +Aesthetically, I like all my keywords to have bold colors. +#+BEGIN_SRC emacs-lisp +(setq org-todo-keyword-faces + '(("TODO" :foreground "light coral" :weight bold) + ("NEXT" :foreground "khaki" :weight bold) + ("DONE" :foreground "light green" :weight bold) + ("WAIT" :foreground "orange" :weight bold) + ("HOLD" :foreground "violet" :weight bold) + ("CANC" :foreground "deep sky blue" :weight bold))) +#+END_SRC +** tags +*** alist +I use tags for agenda filtering (primarily for GTD contexts, see below). Each tag here starts with a symbol to define its group (note, only the special chars "_", "@", "#", and "%" seem to be allowed; anything else will do weird things in the hotkey prompt). Some groups are mutually exclusive. By convention, any tag not part of these groups is ALLCAPS (not very common) and set at the file level. +#+BEGIN_SRC emacs-lisp +(setq org-tag-alist + ;; (@) gtd location context + '((:startgroup) + ("@errand" . ?e) + ("@home" . ?h) + ("@work" . ?w) + ("@travel" . ?r) + (:endgroup) + + ;; (#) gtd resource context + ("#laptop" . ?l) + ("#tcult" . ?t) + ("#phone" . ?p) + + ;; (%) misc tags + ;; denotes reference information + ("%note" . ?n) + + ;; incubator + ("%inc" . ?i) + + ;; denotes tasks that need further subdivision to turn into true project + ("%subdiv" . ?s) + + ;; catchall to mark important headings, usually for meetings + ("%flag" . ?f) + + ;; (_) life categories, used for gtd priority context + (:startgroup) + ("_env" . ?E) + ("_fin" . ?F) + ("_int" . ?I) + ("_met" . ?M) + ("_phy" . ?H) + ("_pro" . ?P) + ("_rec" . ?R) + ("_soc" . ?S) + (:endgroup))) +#+END_SRC +*** colors +Each group also has its own color, defined by its prefix symbol. +#+BEGIN_SRC emacs-lisp +(defun nd/add-tag-face (fg-name prefix) + "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 + to which the faces are applied" + (dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist))) + (push `(,tag . (:foreground ,fg-name)) org-tag-faces))) + +(setq org-tag-faces '()) + +(nd/add-tag-face "PaleGreen" "@") +(nd/add-tag-face "SkyBlue" "#") +(nd/add-tag-face "PaleGoldenrod" "%") +(nd/add-tag-face "violet" "_") +#+END_SRC +** properties +The built-in =effort= is used as the fourth and final homonymous GTD context (the other three being covered above using tags). It is further restricted with =Effort_All= to allow easier filtering in the agenda. + +Also here are the properties for repeated tasks and a few others (see comments in code). +#+BEGIN_SRC emacs-lisp +(mapc (lambda (i) (add-to-list 'org-default-properties i)) + ;; defines a repeater group + '("PARENT_TYPE" + ;; defines the time shift for repeater groups + + "TIME_SHIFT" + ;; assigns another person/entity to a task (experimental) + + "DELEGATE" + + ;; defines a goal (not currently used) + "GOAL")) + +(setq org-global-properties + '(("PARENT_TYPE_ALL" . "periodical iterator") + ("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")) + + org-use-property-inheritance + '("PARENT_TYPE" "TIME_SHIFT")) +#+END_SRC +** capture +*** templates +As per Bernt's guide, capture is meant to be fast. The dispatcher is bound to =F2= (see keybindings section) which allows access in just about every mode and brings a template up in two keystrokes. +#+BEGIN_SRC emacs-lisp +(defun nd/org-timestamp-future (days) + "Inserts an active org timestamp DAYS after the current time." + (format-time-string (org-time-stamp-format nil) + (time-add (current-time) (days-to-time 1)))) + +(let ((capfile "~/Org/capture.org")) + (setq org-capture-templates + ;; regular TODO task + `(("t" "todo" entry (file ,capfile) + "* TODO %?\n%U\ndeliverable: \n") + + ;; for useful reference information that may be grouped with tasks + ("n" "note" entry (file ,capfile) + "* %? :\\%note:\n%U\n") + + ;; for non-actionable events that happen at a certain time + ("a" "appointment" entry (file ,capfile) + "* %?\n%U\n%^t\n") + + ;; like appointment but multiple days + ("s" "appointment-span" entry (file ,capfile) + "* %?\n%U\n%^t--%^t\n") + + ;; task with a deadline + ("d" "deadline" entry (file ,capfile) + "* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n") + + ;; for converting mu4e emails to tasks, defaults to next-day deadline + ("e" "email" entry (file ,capfile) + "* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%U\n%a\n") + + ;; for interruptions that produce useful reference material + ("m" "meeting" entry (file ,capfile) + "* meeting with%? :\\%note:\n%U\n") + + ;; for capturing web pages with web browser + ("p" "org-protocol" entry (file ,capfile) + "* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE" + :immediate-finish t) + + ;; or capturing links with web browser + ("L" "org-protocol link" entry (file ,capfile) + "* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U" + :immediate-finish t)))) +#+END_SRC +*** insert mode +To save one more keystroke (since I use evil mode), trigger insert mode upon opening capture template. +#+BEGIN_SRC emacs-lisp +(add-hook 'org-capture-mode-hook (lambda () (evil-append 1))) +#+END_SRC +** refile +Refile (like capture) should be fast, and I search all org file simultaneously using helm (setting =org-outline-path-complete-in-steps= to =nil= makes search happen for entire trees at once and not just the current level). Refiling is easiest to do from a block agenda view (see below) where headings can be moved in bulk. +#+BEGIN_SRC emacs-lisp +(setq org-refile-targets '((nil :maxlevel . 9) + ("~/Org/reference/idea.org" :maxlevel . 9) + (org-agenda-files :maxlevel . 9)) + org-refile-use-outline-path t + org-outline-path-complete-in-steps nil + org-refile-allow-creating-parent-nodes 'confirm + org-indirect-buffer-display 'current-window) +#+END_SRC + +Prevent accidental refiling under tasks with done keywords +#+BEGIN_SRC emacs-lisp +(setq org-refile-target-verify-function + (lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords)))) + +;; TODO this no work, although does work if var is global +;; redfining the targets works for now +(add-hook 'org-agenda-mode-hook + (lambda () + (when (equal (buffer-name) "*Org Agenda(A)*") + (setq-local org-refile-targets + '(("~/Org/journal/goals.org" :maxlevel . 9)))))) +;; (lambda () (when (org-entry-get nil "GOAL") t)))))) +;; (setq org-refile-targets '((nil :maxlevel . 9) +;; ("~/Org/reference/idea.org" :maxlevel . 9) +;; ("~/Org/journal/goals.org" :maxlevel . 9) +;; (org-agenda-files :maxlevel . 9)) +#+END_SRC +** clocking +Clocking is still new and experimental (I'm not a ninja like Bernt yet). I mostly use clocking now as a way to make clean breaks between tasks (eg to discourage "mixing" tasks which is a slippery multitasking slope). I bound =F4= to =org-clock-goto= as an easy way to find my current/last clocked task in any mode (see keybindigs). +#+BEGIN_SRC emacs-lisp +(setq org-clock-history-length 23 + org-clock-out-when-done t + org-clock-persist t + org-clock-report-include-clocking-task t) +#+END_SRC +** conflict detection +Somehow org-mode has no way to detect conflicts between tasks with timestamps (!!??). Luckily I can make my own. +*** backend +The algoithm to detect conflicts scans all org files and stores conflicts in a list of pairs of each heading with a conflicting timestamp. + +Steps for this algorithm: +1. make a list of all entries with timestamps +2. sort timestamp list +3. Walk through list and compare entries immediately after (sorting ensures that entries can be skipped once one non-conflict is found). If conflicts are found push the pair to a new list (this is what is used to make the display) + +This should be O(n) (best case/no conflicts) to O(n^2) (worst case/everything conflicts) +#+BEGIN_SRC emacs-lisp +(defun nd/are-conflicting-p (ts-a ts-b) + "Return t if timestamps TS-A and TS-B conflict." + (let* ((earlier-a (car ts-a)) + (earlier-b (car ts-b)) + (later-b (+ earlier-b (nth 1 ts-b)))) + (and (>= earlier-a earlier-b) (<= earlier-a later-b)))) + +(defun nd/detect-conflict (ts ts-list conlist) + "Recursively determine if timestamp TS conflicts with anything in TS-LIST. +If detected, conflict pair is added to CONLIST." + (let ((next-ts (car ts-list)) + (rem-ts (cdr ts-list))) + (if (nd/are-conflicting-p ts next-ts) + (progn + (setq conlist (cons (list ts next-ts) conlist)) + (if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist)) + conlist))) + +(defun nd/build-conlist (ts-list conlist) + "Recursively build a list of timestamp conflicts from TS-LIST. + +TS-LIST is comprised of entries in the form (staring-ts timerange marker) +where timerange is 0 for singular timestamps and a positive number for +anything with to times or a timestamp range. +Detected conflicts are stored in CONLIST as pairs of conflicting ts +entries from the TS-LIST." + (let ((cur-ts (car ts-list)) + (rem-ts (cdr ts-list))) + (if rem-ts + (nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist)) + conlist))) + +(defconst nd/org-tsm-regexp + "\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)" + "Regular expression for timestamps with two times.") + +(defun nd/get-timestamps () + "Get the org-marker and timestamp(s) (multiple if range) or current heading." + ;; TODO, what if I care about more than just TIMESTAMPs + (let* ((ts (org-entry-get nil "TIMESTAMP")) + (marker (point-marker)) + (ts-range 0) + (ts-entry)) + (when ts + (cond + ;; match timestamps that have two times + ((string-match nd/org-tsm-regexp ts) + (let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts))) + (ts2 (concat (match-string 1 ts) (match-string 3 ts))) + (ft1 (org-2ft ts1)) + (ft2 (org-2ft ts2))) + (setq ts-entry ft1) + (setq ts-range (- ft2 ft1)))) + + ;; match timestamps that have a range (eq two timestamps) + ((string-match org-tr-regexp ts) + (let* ((ts1 (match-string 1 ts)) + (ts2 (match-string 2 ts)) + (ft1 (org-2ft ts1)) + (ft2 (org-2ft ts2))) + (setq ts-entry ft1) + (setq ts-range (- ft2 ft1)))) + + ;; match timestamps with only one time + (t (setq ts-entry (org-2ft ts)))) + (list ts-entry ts-range marker ts)))) + +(defun nd/build-conflict-list () + "Scan all org files and make a list of all timestamps that conflict." + (let ((files (org-agenda-files)) + max-reached ts-list cur-index conflicts) + ;; get all timestamps from org buffers + (dolist (f files ts-list) + (with-current-buffer + (find-file-noselect f) + (goto-char (point-min)) + (when (not (outline-on-heading-p)) (outline-next-heading)) + (setq max-reached nil) + (while (not max-reached) + (let ((new-ts (nd/get-timestamps))) + (if new-ts (setq ts-list (cons new-ts ts-list)))) + (unless (outline-next-heading) (setq max-reached t))))) + + ;; sort the timestamp list + ;; TODO, need to make range-aware + (setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b))))) + + ;; build a list of conflicts + (nd/build-conlist ts-list conflicts))) +#+END_SRC +*** frontend +To display any conflicts, I could just fetch the org headings and throw them into a new buffer. But that's boring, and quite limiting. I basically want all the perks of an agenda buffer...tab-follow, the nice parent display at the bottom, time adjust hotkeys, etc. So the obvious and hacky solution is to throw together a quick-n-dirty agenda buffer which displays each conflict pair in sequentional fashion. +#+BEGIN_SRC emacs-lisp +(defun nd/get-conflict-header-text (conflict-marker) + "Return string with text properties representing the org header for +MARKER for use in the conflict agenda view." + (let* ((props (list + 'face nil + 'done-face 'org-agenda-done + 'org-not-done-regexp org-not-done-regexp + 'org-todo-regexp org-todo-regexp + 'org-complex-heading-regexp org-complex-heading-regexp + 'mouse-face 'highlight)) + ;; 'help-echo + ;; (format "mouse-2 or RET jump to org file %s" + ;; (abbreviate-file-name buffer-file-name)))) + marker priority category level tags todo-state + ts-date ts-date-type ts-date-pair + txt beg end inherited-tags todo-state-end-pos) + + (with-current-buffer (marker-buffer conflict-marker) + (save-excursion + (goto-char conflict-marker) + + (setq marker (org-agenda-new-marker (point)) + category (org-get-category) + ts-date-pair (org-agenda-entry-get-agenda-timestamp (point)) + ts-date (car ts-date-pair) + ts-date-type (cdr ts-date-pair) + txt (org-get-heading t) + inherited-tags + (or (eq org-agenda-show-inherited-tags 'always) + (and (listp org-agenda-show-inherited-tags) + (memq 'todo org-agenda-show-inherited-tags)) + (and (eq org-agenda-show-inherited-tags t) + (or (eq org-agenda-use-tag-inheritance t) + (memq 'todo org-agenda-use-tag-inheritance)))) + tags (org-get-tags-at nil (not inherited-tags)) + level (make-string (org-reduced-level (org-outline-level)) ? ) + txt (org-agenda-format-item "" txt level category tags t) + priority (1+ (org-get-priority txt))) + + (org-add-props txt props + 'org-marker marker 'org-hd-marker marker + 'priority priority + 'level level + 'ts-date ts-date + 'type "timestamp"))))) + +(defun nd/org-conflicts (&optional arg) + (interactive "P") + + (if org-agenda-overriding-arguments + (setq arg org-agenda-overriding-arguments)) + + (if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil)) + + (let* ((today (org-today)) + (date (calendar-gregorian-from-absolute today)) + (completion-ignore-case t) + (org-agenda-prefix-format '((agenda . " %-12:c %-5:e "))) + rtn rtnall files file pos) + + (catch 'exit + (when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*")) + + (org-agenda-prepare) + ;; (org-compile-prefix-format 'todo) + (org-compile-prefix-format 'agenda) + ;; (org-set-sorting-strategy 'todo) + + (setq org-agenda-redo-command '(nd/org-conflicts)) + + (insert "Conflicting Headings: \n") + (add-text-properties (point-min) (1- (point)) + (list 'face 'org-agenda-structure + 'short-heading "Conflicts")) + (org-agenda-mark-header-line (point-min)) + + (setq rtnall (nd/build-conflict-list)) + (when rtnall + (mapc + (lambda (c) + (insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n")) + (insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n")) + (insert "\n")) + rtnall)) + + ;; clean up and finalize + (goto-char (point-min)) + (or org-agenda-multi (org-agenda-fit-window-to-buffer)) + (add-text-properties + (point-min) (point-max) + `(org-agenda-type agenda + org-last-args ,arg + org-redo-cmd ,org-agenda-redo-command + org-series-cmd ,org-cmd)) + (org-agenda-finalize) + (setq buffer-read-only t)))) +#+END_SRC +** agenda +*** targets +The agenda files are limited to as few as possible to keep scanning and startup reasonably fast. +#+BEGIN_SRC emacs-lisp +(setq org-agenda-files '("~/Org" + "~/Org/projects" + "~/Org/reference/peripheral.org")) +#+END_SRC +*** appearence +**** sticky agendas +I personally like having sticky agendas by default so I can use multiple windows +#+BEGIN_SRC emacs-lisp +(setq org-agenda-sticky t) +#+END_SRC +**** tag alignment +The agenda does not do this by default...it's annoying +#+BEGIN_SRC emacs-lisp +(add-hook 'org-finalize-agenda-hook + (lambda () (setq org-agenda-tags-column (- 4 (window-width))) + (org-agenda-align-tags))) +#+END_SRC +**** prefix format +This controls what each line on the block agenda looks like. This is reformated to include effort and remove icons. +#+BEGIN_SRC emacs-lisp +(setq org-agenda-prefix-format + '((agenda . " %-12:c %-5:e %?-12t% s") + (todo . " %-12:c") + (tags . " %-12:c %-5:e ") + (search . " %-12:c"))) +#+END_SRC +**** misc +These are just some options to enable/disable some aesthetic things. +#+BEGIN_SRC emacs-lisp +(setq org-agenda-dim-blocked-tasks nil + org-agenda-compact-blocks t + org-agenda-window-setup 'current-window + org-agenda-start-on-weekday 0 + org-agenda-span 'day + org-agenda-current-time-string "### -- NOW -- ###") +#+END_SRC + +Based on my screen size and usage patterns, this seems to be a good value to enable the maximum habit history to be shown without compromising aesthetics. +#+BEGIN_SRC emacs-lisp +(setq org-habit-graph-column 50) +#+END_SRC +*** interactive filters +Rather than define infinite views for different tasks (I already have plenty of views) I use filtering to sort through the noise. Some of the built-in filters don't cut it, so I made a few of my own. +**** custom filtering functions +Some custom filters that are applied to the agenda view. Note that some of these use alternative filter types that are implemented via advising functions (see below). +#+BEGIN_SRC emacs-lisp +(defun nd/org-agenda-filter-non-context () + "Filter all tasks with context tags." + (interactive) + (let* ((tags-list (mapcar #'car org-tag-alist)) + (context-tags (append + (nd/filter-list-prefix "@" tags-list) + (nd/filter-list-prefix "#" tags-list)))) + (setq org-agenda-tag-filter + (mapcar (lambda (tag) (concat "-" tag)) context-tags)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) + +(defun nd/org-agenda-filter-non-peripheral () + "Filter all tasks that don't have peripheral tags." + (interactive) + (let* ((peripheral-tags '("PERIPHERAL"))) + (setq org-agenda-tag-filter + (mapcar (lambda (tag) (concat "-" tag)) peripheral-tags)) + (org-agenda-filter-apply org-agenda-tag-filter 'tag))) + +(defun nd/org-agenda-filter-non-effort () + "Filter agenda by non-effort tasks." + (interactive) + (setq org-agenda-hasprop-filter '("-Effort")) + (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) + +(defun nd/org-agenda-filter-delegate () + "Filter agenda by tasks with an external delegate." + (interactive) + (setq org-agenda-hasprop-filter '("+DELEGATE")) + (org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop)) +#+END_SRC +**** filter advice +In order to implement the =hasprop= filter, the functions =org-agenda-filter-make-matcher= and =org-agenda-filter-remove-all= need to be advised in order to add the functionality for the =hasprop= filter type. + +As it is, this allows any filter using =hasprop= to be applied and removed using the standard =org-agenda-filter-apply= function with the =org-agenda-hasprop-filter= variable (obviously these can all be extended to different filter types). Note this does not give a shiny indicator at the bottom of spaceline like the built-in filter does...oh well. +#+BEGIN_SRC emacs-lisp +;; initialize new filters +(defvar org-agenda-hasprop-filter nil) + +(defun nd/org-agenda-filter-make-matcher-prop + (filter type &rest args) + "Return matching matcher form for FILTER and TYPE where TYPE is not +in the regular `org-agenda-filter-make-matcher' function. This is +intended to be uses as :before-until advice and will return nil if +the type is not valid (which is currently 'prop')" + (let (f f1) + ;; has property + (cond + ((eq type 'hasprop) + (dolist (x filter) + (push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f)))) + (if f (cons 'and (nreverse f))))) + +(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h) + "Returns form to test the presence or absence of properties H. +H is a string like +prop or -prop" + (let (op) + (let* ((op (string-to-char h)) + (h (substring h 1)) + (f `(save-excursion + (let ((m (org-get-at-bol 'org-hd-marker))) + (with-current-buffer + (marker-buffer m) + (goto-char m) + (org-entry-get nil ,h)))))) + (if (eq op ?-) (list 'not f) f)))) + +(defun nd/org-agenda-filter-show-all-hasprop nil + (org-agenda-remove-filter 'hasprop)) + +(advice-add #'org-agenda-filter-make-matcher :before-until + #'nd/org-agenda-filter-make-matcher-prop) + +(advice-add #'org-agenda-filter-remove-all :before + (lambda () (when org-agenda-hasprop-filter + (nd/org-agenda-filter-show-all-hasprop)))) +#+END_SRC +*** bulk actions +These add to the existing bulk actions in the agenda view. +#+BEGIN_SRC emacs-lisp +(setq org-agenda-bulk-custom-functions + '((?D nd/org-agenda-delete-subtree))) +#+END_SRC +*** holidays and birthdays +If I don't include this, I actually forget about major holidays. +#+BEGIN_SRC emacs-lisp +(setq holiday-bahai-holidays nil + holiday-hebrew-holidays nil + holiday-oriental-holidays nil + holiday-islamic-holidays nil) + +(setq calendar-holidays (append holiday-general-holidays + holiday-christian-holidays)) +#+END_SRC +*** block agenda library +These are functions and variables exclusively for agenda block manipulation within the context of =org-custom-agenda-commands=. +**** variables +#+BEGIN_SRC emacs-lisp +(defconst nd/iter-future-time (* 7 24 60 60) + "Iterators must have at least one task greater into the future to be active.") + +(defconst nd/iter-statuscodes '(:uninit :empty :active) + "Iterators can have these statuscodes.") + +(defconst nd/peri-future-time nd/iter-future-time + "Periodicals must have at least one heading greater into the future to be fresh.") + +(defconst nd/peri-statuscodes '(:uninit :stale :fresh)) + +(defconst nd/project-invalid-todostates + '("WAIT" "NEXT") + "Projects cannot have these todostates.") + +(defvar nd/agenda-limit-project-toplevel t + "If true, filter projects by all levels or top level only.") + +(defvar nd/agenda-hide-incubator-tags t + "If true, don't show incubator headings.") + +(defconst nd/org-agenda-todo-sort-order + '("NEXT" "WAIT" "HOLD" "TODO") + "Defines the order in which todo keywords should be sorted.") + +(defconst nd/project-skip-todostates + '("HOLD" "CANC") + "These keywords override all contents within their subtrees. +Currently used to tell skip functions when they can hop over +entire subtrees to save time and ignore tasks") +#+END_SRC +**** task helper functions +These are the building blocks for skip functions. +***** timestamps +#+BEGIN_SRC emacs-lisp +(defun nd/get-date-property (timestamp-property) + "Get TIMESTAMP-PROPERTY on current heading and convert to a number. +If it does not have a date, it will return nil." + (let ((ts (org-entry-get nil timestamp-property))) + (when ts (org-2ft ts)))) + +(defun nd/heading-compare-timestamp (timestamp-fun + &optional ref-time future) + "Returns the timestamp (from TIMESTAMP-FUM on the current heading) +if timestamp is futher back in time compared to a REF-TIME (default to +0 which is now, where negative is past and positive is future). If the +FUTURE flag is t, returns timestamp if it is in the future compared +to REF-TIME. Returns nil if no timestamp is found." + (let* ((timestamp (funcall timestamp-fun)) + (ref-time (or ref-time 0))) + (if (and timestamp + (if future + (> (- timestamp (float-time)) ref-time) + (<= (- timestamp (float-time)) ref-time))) + timestamp))) + +(defun nd/is-ia-timestamped-heading-p () + "Get active timestamp of current heading." + (nd/get-date-property "TIMESTAMP_IA")) + +(defun nd/is-timestamped-heading-p () + "Get active timestamp of current heading." + (nd/get-date-property "TIMESTAMP")) + +(defun nd/is-scheduled-heading-p () + "Get scheduled timestamp of current heading." + (nd/get-date-property "SCHEDULED")) + +(defun nd/is-deadlined-heading-p () + "Get deadline timestamp of current heading." + (nd/get-date-property "DEADLINE")) + +(defun nd/is-closed-heading-p () + "Get closed timestamp of current heading." + (nd/get-date-property "CLOSED")) + +(defun nd/is-stale-heading-p (&optional ts-prop) + "Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale." + (nd/heading-compare-timestamp + (lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP")))) + (when (and ts (not (find ?+ ts))) (org-2ft ts)))))) + +(defun nd/is-fresh-heading-p () + "Return timestamp if current heading is fresh." + (nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t)) + +(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 current heading is archivable." + (nd/heading-compare-timestamp + 'nd/is-closed-heading-p + (- (* 60 60 24 nd/archive-delay-days)))) +#+END_SRC +***** task level testing +#+BEGIN_SRC emacs-lisp +(defun nd/is-todoitem-p () + "Return todo keyword if heading has one." + (let ((keyword (nth 2 (org-heading-components)))) + (if (member keyword org-todo-keywords-1) + keyword))) + +(defun nd/is-project-p () + "Return todo keyword if heading has todoitem children." + (and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p))) + +(defun nd/is-task-p () + "Return todo keyword if heading has todoitem children." + (and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p))) + +(defun nd/is-project-task-p () + "Return todo keyword if heading has todoitem parents." + (and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p))) + +(defun nd/is-atomic-task-p () + "Return todo keyword if heading has no todoitem parents or children." + (and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p))) +#+END_SRC +***** property testing +#+BEGIN_SRC emacs-lisp +(defun nd/is-periodical-heading-p () + "Return t if heading is a periodical." + (equal "periodical" (org-entry-get nil "PARENT_TYPE" t))) + +(defun nd/is-iterator-heading-p () + "Return t if heading is an iterator." + (equal "iterator" (org-entry-get nil "PARENT_TYPE" t))) + +(defun nd/heading-has-effort-p () + "Return t if heading has an effort." + (org-entry-get nil "Effort")) + +(defun nd/heading-has-context-p () + "Return t if heading has a context." + (let ((tags (org-get-tags-at))) + (or (> (length (nd/filter-list-prefix "#" tags)) 0) + (> (length (nd/filter-list-prefix "@" tags)) 0)))) + +(defun nd/heading-has-tag-p (tag) + "Return t if heading has tag TAG." + (member tag (org-get-tags-at))) +#+END_SRC +***** relational testing +Returns t if heading has certain relationship to other headings +#+BEGIN_SRC emacs-lisp +(defun nd/heading-has-children (heading-test) + "Return t if heading has a child for whom HEADING-TEST is t." + (let ((subtree-end (save-excursion (org-end-of-subtree t))) + has-children previous-point) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not has-children) + (< previous-point (point) subtree-end)) + (when (funcall heading-test) + (setq has-children t)) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + has-children)) + +(defun nd/heading-has-parent (heading-test) + "Return t if heading has parent for whom HEADING-TEST is t." + (save-excursion (and (org-up-heading-safe) (funcall heading-test)))) + +(defun nd/has-discontinuous-parent () + "Return t if heading has a non-todoitem parent which in turn has a todoitem parent." + (let ((has-todoitem-parent) + (has-non-todoitem-parent)) + (save-excursion + (while (and (org-up-heading-safe) + (not has-todoitem-parent)) + (if (nd/is-todoitem-p) + (setq has-todoitem-parent t) + (setq has-non-todoitem-parent t)))) + (and has-todoitem-parent has-non-todoitem-parent))) +#+END_SRC +***** project level testing +Projects are tested according to their statuscodes, which in turn are a function of the todo keywords and timestamps of their individual subtasks. +#+BEGIN_SRC emacs-lisp +(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list) + "Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP." + `(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list))) + +(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status) + "Loop through (sub)project and return overall statuscode. + +The returned statuscode is chosen from list ALLOWED-STATUSCODES where +later entries in the list trump earlier ones. + +When a subproject is encountered, this function will obtain the +statuscode of that project and use TRANS-TBL to translate the +subproject statuscode to one in ALLOWED-STATUSCODES (if not found an +error will be raised). TRANS-TBL is given as an alist of two-member +cons cells where the first member is the subproject statuscode and the + second is the index in ALLOWED-STATUSCODES to which the subproject +statuscode will be translated. + +When a task is encountered, function GET-TASK-STATUS will be applied to +obtain a statuscode-equivalent of the status of the tasks." + ;; define "breaker-status" as the last of the allowed-statuscodes + ;; when this is encountered the loop is broken because we are done + ;; (the last entry trumps all others) + (let ((project-status (first allowed-statuscodes)) + (breaker-status (car (last allowed-statuscodes))) + (previous-point)) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + ;; loop through subproject tasks until breaker-status found + (while (and (not (eq project-status breaker-status)) + (> (point) previous-point)) + (let ((keyword (nd/is-todoitem-p))) + (if keyword + (let ((new-status + ;; if project then descend recursively + (if (nd/heading-has-children 'nd/is-todoitem-p) + (let ((n (nd/get-project-status))) + ;; if project returns an allowed status + ;; then use that + (or (and (member n allowed-statuscodes) n) + ;; otherwise look up the value in the + ;; translation table and return error + ;; if not found + (nth (or (alist-get n trans-tbl) + (error (concat "status not found: " n))) + allowed-statuscodes))) + ;; if tasks then use get-task-status to obtain status + (nth (funcall get-task-status keyword) + allowed-statuscodes)))) + (if (nd/compare-statuscodes > new-status project-status allowed-statuscodes) + (setq project-status new-status))))) + (setq previous-point (point)) + (org-forward-heading-same-level 1 t))) + project-status)) + +(defun nd/get-project-status () + "Return project heading statuscode (assumes it is indeed a project)." + (let ((keyword (nd/is-todoitem-p))) + ;; + ;; these first three are easy because they only require + ;; testing the project headline and nothing underneath + ;; + (cond + ;; it does not make sense for projects to be scheduled + ((nd/is-scheduled-heading-p) :scheduled-project) + + ;; held projects do not care what is underneath them + ((equal keyword "HOLD") :held) + + ;; projects with invalid todostates are nonsense + ((member keyword nd/project-invalid-todostates) + :invalid-todostate) + + ;; + ;; these require descending into the project subtasks + ;; + + ;; canceled projects can either be archivable or complete + ;; any errors or undone tasks are irrelevant + ((equal keyword "CANC") + (nd/descend-into-project + '(:archivable :complete) + '((:stuck . 1) + (:held . 1) + (:waiting . 1) + (:active . 1) + (:scheduled-project . 1) + (:invalid-todostate . 1) + (:undone-complete . 1) + (:done-incomplete . 1)) + (lambda (k) + (if (and (member k org-done-keywords) + (nd/is-archivable-heading-p)) 0 1)))) + + ;; done projects are like canceled projects but can also be incomplete + ((equal keyword "DONE") + (nd/descend-into-project + '(:archivable :complete :done-incomplete) + '((:stuck . 2) + (:held . 2) + (:waiting . 2) + (:active . 2) + (:scheduled-project . 2) + (:invalid-todostate . 2) + (:undone-complete . 2)) + (lambda (k) + (if (member k org-done-keywords) + (if (nd/is-archivable-heading-p) 0 1) + 2)))) + + ;; project with TODO states could be basically any status + ((equal keyword "TODO") + (nd/descend-into-project + '(:undone-complete :stuck :held :waiting :active) + '((:complete . 0) + (:archivable . 0) + (:scheduled-project . 1) + (:invalid-todostate . 1) + (:done-incomplete . 1)) + (lambda (k) + (cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1)) + ((equal k "HOLD") 2) + ((equal k "WAIT") 3) + ((equal k "NEXT") 4) + (t 0))))) + + (t (error (concat "invalid keyword detected: " keyword)))))) +#+END_SRC +***** repeater testing +Iterators and periodicals are tested similarly to projects in that they have statuscodes. +#+BEGIN_SRC emacs-lisp +(defun nd/get-iterator-status () + "Get the status of an iterator where allowed statuscodes are in list + `nd/get-iter-statuscodes.' where latter codes in the list trump +earlier ones." + (let ((iter-status (first nd/iter-statuscodes)) + (subtree-end (save-excursion (org-end-of-subtree t)))) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not (eq iter-status :active)) + (< (point) subtree-end)) + (let ((keyword (nd/is-atomic-task-p)) + (new-status)) + (if keyword + (progn + (setq new-status (if (nd/heading-compare-timestamp + (lambda () + (or (nd/is-scheduled-heading-p) + (nd/is-deadlined-heading-p))) + nd/iter-future-time t) + :active + :empty)) + (if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes) + (setq iter-status new-status))))) + (outline-next-heading))) + iter-status)) + +(defun nd/get-periodical-status () + "Get the status of a periodical where allowed statuscodes are in list + `nd/get-peri-statuscodes.' where latter codes in the list trump +earlier ones." + (let ((peri-status :uninit) + (subtree-end (save-excursion (org-end-of-subtree t)))) + (save-excursion + (setq previous-point (point)) + (outline-next-heading) + (while (and (not (eq peri-status :fresh)) + (< (point) subtree-end)) + (if (and (nd/is-periodical-heading-p) + (not (nd/heading-has-children 'nd/is-periodical-heading-p))) + (let ((new-status + (if (nd/heading-compare-timestamp + 'nd/is-timestamped-heading-p + nd/iter-future-time t) + :fresh + :stale))) + (if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes) + (setq peri-status new-status)))) + (outline-next-heading))) + peri-status)) +#+END_SRC +**** skip functions +These are the primary means used to sort through tasks and build agenda block views +***** helper skip functions and macros +Subunits for skip functions. Not meant to be used or called from the custom commands api +#+BEGIN_SRC emacs-lisp +(defun nd/skip-heading () + "Skip forward to next heading." + (save-excursion (or (outline-next-heading) (point-max)))) + +(defun nd/skip-subtree () + "Skip forward to next subtree." + (save-excursion (or (org-end-of-subtree t) (point-max)))) + + +(defmacro nd/skip-heading-without (heading-fun test-fun) + "Skip headings accoring to certain characteristics. + +HEADING-FUN is a function that tests the heading and returns the +todoitem keyword on success. TEST-FUN is a function that further tests +the identity of the heading and may or may not use the keyword output +supplied by the HEADING-FUN. This function will not skip if +HEADING-FUN and TEST-FUN return true" + `(save-restriction + (widen) + (let ((keyword (,heading-fun))) + ;; (message keyword) + (if (not (and keyword ,test-fun)) + (nd/skip-heading))))) +#+END_SRC +***** headings +Skip functions for headings which may or may not be todo-items. +#+BEGIN_SRC emacs-lisp +(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list) + "Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST." + (save-restriction + (widen) + (let ((heading-tags (org-get-tags-at))) + (if (and (or (not pos-tags-list) + (intersection pos-tags-list heading-tags :test 'equal)) + (not (intersection neg-tags-list heading-tags :test 'equal))) + (nd/skip-heading))))) + +(defun nd/skip-non-stale-headings () + "Skip headings that do not have stale timestamps and are not part of projects." + (save-restriction + (widen) + (let ((keyword (nd/is-todoitem-p))) + (if (not + (and (nd/is-stale-heading-p) + (not (member keyword org-done-keywords)) + (not (nd/heading-has-children 'nd/is-todoitem-p)) + (not (nd/heading-has-parent 'nd/is-todoitem-p)))) + (nd/skip-heading))))) +#+END_SRC +***** tasks +A few functions apply to both atomic tasks and project tasks the same. +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-ia-timestamped-tasks () + "Skip tasks that do not have an inactive timestamp." + (save-excursion + (widen) + (if (not (and (nd/is-task-p) + (not (nd/is-ia-timestamped-heading-p)))) + (nd/skip-heading)))) +#+END_SRC +***** atomic tasks +By definition these have no parents, so I don't need to worry about skipping over projects. Any todo state is valid and we only sort by done/canc +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-atomic-tasks () + "Skip headings that are not atomic tasks." + (save-excursion + (widen) + (if (not (nd/is-atomic-task-p)) + (nd/skip-heading)))) + +(defun nd/skip-non-closed-atomic-tasks () + "Skip headings that are not complete (but not archivable) atomic tasks." + (nd/skip-heading-without + nd/is-atomic-task-p + (and (member keyword org-done-keywords) + (not (nd/is-archivable-heading-p))))) + +(defun nd/skip-non-archivable-atomic-tasks () + "Skip headings that are not archivable atomic tasks." + (nd/skip-heading-without + nd/is-atomic-task-p + (nd/is-archivable-heading-p))) +#+END_SRC +***** repeaters +These are headings marked with PARENT_TYPE property that have timestamped headings as children. They are to be refilled when all children are stale. Note that I only care about the parent headings as the children should always show up in the agenda simply because they have timestamps. Parents can be either fresh (at least one child in the future) or stale (all children in the past). +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-iterator-parent-headings () + "Skip headings that are not toplevel iterator headings." + (save-restriction + (widen) + (if (not (and (nd/is-iterator-heading-p) + (not (nd/heading-has-parent 'nd/is-iterator-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-iterator-unscheduled () + "Skip all headings that are not unscheduled iterator children." + (nd/skip-heading-without + nd/is-atomic-task-p + (not (or (nd/is-scheduled-heading-p) + (nd/is-deadlined-heading-p))))) + +(defun nd/skip-non-periodical-parent-headings () + "Skip headings that are not toplevel periodical headings." + (save-restriction + (widen) + (if (not (and (nd/is-periodical-heading-p) + (not (nd/heading-has-parent 'nd/is-periodical-heading-p)))) + (nd/skip-heading)))) + +(defun nd/skip-non-periodical-untimestamped () + "Skip all headings that are not periodical children without a timestamp." + (save-restriction + (widen) + (if (not (and (nd/is-periodical-heading-p) + (not (nd/is-timestamped-heading-p)) + (not (nd/heading-has-children 'nd/is-periodical-heading-p)))) + (nd/skip-heading)))) +#+END_SRC +***** project tasks +Note that I don't care about the timestamp in these cases because I don't archive these; I archive their parent projects. The keywords I care about are NEXT, WAIT, and HOLD because these are definitive project tasks that require/inhibit futher action. (TODO = stuck which I take care of at the project level, and DONE/CANC = archivable which is dealt with similarly) + +For performance, I need to assess if the parent project is skippable, in which case I jump to the next subtree. +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-project-tasks () + "Skip headings that are not project tasks." + (save-restriction + (widen) + (let ((keyword (nd/is-todoitem-p))) + (if keyword + (if (nd/heading-has-children 'nd/is-todoitem-p) + (if (member keyword nd/project-skip-todostates) + (nd/skip-subtree) + (nd/skip-heading)) + (if (not (nd/heading-has-parent 'nd/is-todoitem-p)) + (nd/skip-heading))) + (nd/skip-heading))))) +#+END_SRC +***** heading-level errors +Some headings are invalid under certain conditions; these are tested here. +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-discontinuous-project-tasks () + "Skip headings that are not discontinuous within projects." + (nd/skip-heading-without + nd/is-todoitem-p + (nd/has-discontinuous-parent))) + +(defun nd/skip-non-done-unclosed-todoitems () + "Skip headings that are not completed without a closed timestamp." + (nd/skip-heading-without + nd/is-todoitem-p + (and (member keyword org-done-keywords) + (not (nd/is-closed-heading-p))))) + +(defun nd/skip-non-undone-closed-todoitems () + "Skip headings that are not incomplete with a closed timestamp." + (nd/skip-heading-without + nd/is-todoitem-p + (and (not (member keyword org-done-keywords)) + (nd/is-closed-heading-p)))) +#+END_SRC +***** projects +Projects are handled quite simply. They have statuscodes for which I test, and this can all be handled by one function. Note that this is used for "normal" projects as well as repeaters. +#+BEGIN_SRC emacs-lisp +(defun nd/skip-non-projects (&optional ignore-toplevel) + "Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)." + (save-restriction + (widen) + (let ((keyword (nd/is-project-p))) + (if keyword + (if (and nd/agenda-limit-project-toplevel + (not ignore-toplevel) + (nd/heading-has-parent 'nd/is-todoitem-p)) + (nd/skip-subtree)) + (nd/skip-heading))))) +#+END_SRC +**** sorting and filtering +These are used to filter and sort within block agendas (note this is different from the other filtering functions above as these are non-interactive). +#+BEGIN_SRC emacs-lisp +(defun nd/org-agenda-filter-status (filter status-fun a-line + &optional filter-only) + "Filter for `org-agenda-before-sorting-filter-function' intended for +agenda project views (eg makes the assumption that all entries are +from projects in the original org buffer) wherein this function will +filter project headings based on their statuscodes. + +It works by going to the original org buffer and determining the +project status using STATUS-FUN, after which it will check if +status is in FILTER (a list of statuscodes). If true, the flag string +in the prefix is replaced with the status, and the status is set as a +text property for further sorting. + +If option FILTER-ONLY is t, function only return the unmodified a-line +or nil to act as a filter (eg does not touch text properties)." + (let* ((m (get-text-property 1 'org-marker a-line)) + (s (with-current-buffer (marker-buffer m) + (goto-char m) + (funcall status-fun)))) + (if (member s filter) + (if filter-only + a-line + (org-add-props (replace-regexp-in-string + "xxxx" (symbol-name s) a-line) + nil 'project-status s))))) + +(defun nd/org-agenda-sort-prop (prop order a b) + "Sort a block agenda view by text property PROP given a list ORDER +of said text properties in the desired order and lines A and B as +inputs. To be used with `org-agenda-cmp-user-defined'." + (let* ((ta (get-text-property 1 prop a)) + (tb (get-text-property 1 prop b)) + (pa (position ta order :test (if (stringp ta) #'equal))) + (pb (position tb order :test (if (stringp tb) #'equal)))) + (cond ((or (null pa) (null pb)) nil) + ((< pa pb) +1) + ((> pa pb) -1)))) +#+END_SRC +**** block view building macros +Some useful shorthands to create block agenda views +#+BEGIN_SRC emacs-lisp +(defun nd/agenda-base-heading-cmd (match header skip-fun) + "Make a tags agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN." + `(tags + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-sorting-strategy '(category-keep))))) + +(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort) + "Make a tags-todo agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN. Also +takes a sorting structure SORT which is passed to +`org-agenda-sorting-strategy'" + (or sort (setq sort ''(category-keep))) + `(tags-todo + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-todo-ignore-with-date t) + (org-agenda-sorting-strategy ,sort)))) + +(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun + &optional todo status-px) + "Make a tags-todo agenda view that matches tags in string MATCH with +header given as string HEADER and with skip function SKIP-FUN. KW-LIST +is a list of keywords to be used in filtering and sorting (the order +in the list defines the sort order). STATUS-FUN is a function used to +get the statuscode of the current line in the agenda. Optional arg +TODO determines if this is a tags-todo (t) or tags (nil) block, and +STATUS-PX as t enables the statuscode to be formatted into the prefix +string." + `(,(if 'tags-todo 'tags) + ,match + ((org-agenda-overriding-header ,header) + (org-agenda-skip-function ,skip-fun) + (org-agenda-before-sorting-filter-function + (lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l))) + (org-agenda-cmp-user-defined + (lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b))) + (org-agenda-prefix-format '((tags . ,(if status-px + " %-12:c %(format \"xxxx: \")" + " %-12:c ")))) + (org-agenda-sorting-strategy '(user-defined-down category-keep))))) +#+END_SRC +**** interactive functions +This is basically a filter but since it is implemented through skip functions it makes more sense to include it here. It allows distinguishing between toplevel projects and projects that are subprojects of the toplevel project (I usually only care about the former). +#+BEGIN_SRC emacs-lisp +(defun nd/toggle-project-toplevel-display () + "Toggle all project headings and toplevel only headings in project blocks." + (interactive) + (setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel)) + (when (equal major-mode 'org-agenda-mode) + (org-agenda-redo)) + (message "Showing %s project view in agenda" + (if nd/agenda-limit-project-toplevel "toplevel" "complete"))) +#+END_SRC +**** advising +Some org functions don't do exactly what I want. Re-educate them here +***** org-tags-view done keywords +The =org-tags-view= can filter tags for only headings with TODO keywords (with type tags-todo), but this automatically excludes keywords in =org-done-keywords=. Therefore, if I want to include these in any custom agenda blocks, I need to use type tags instead and skip the unwanted TODO keywords with a skip function. This is far slower as it applies the skip function to EVERY heading. + +Fix that here by nullifying =org--matcher-tags-todo-only= which controls how the matcher is created for tags and tags-todo. Now I can select done keywords using a match string like "+tag/DONE|CANC" (also much clearer in my opinion). + +While this is usually more efficient, it may be counterproductive in cases where skip functions can be used to ignore huge sections of an org file (which is rarely for me; most only skip ahead to the next heading). +#+BEGIN_SRC emacs-lisp +(defun nd/org-tags-view-advice (orig-fn &optional todo-only match) + "Advice to include done states in `org-tags-view' for tags-todo agenda types." + (nd/with-advice + ((#'org-make-tags-matcher + :around (lambda (f m) + (let ((org--matcher-tags-todo-only nil)) + (funcall f m))))) + (funcall orig-fn todo-only match))) + +(advice-add #'org-tags-view :around #'nd/org-tags-view-advice) +#+END_SRC +*** block agenda views +**** default sorting +This gives more flexibility in ignoring items with timestamps +#+BEGIN_SRC emacs-lisp +(setq org-agenda-tags-todo-honor-ignore-options t) +#+END_SRC + +By default I want block agendas to sort based on the todo keyword (with NEXT being up top as these have priority). +#+BEGIN_SRC emacs-lisp +(setq org-agenda-cmp-user-defined + '(lambda (a b) + (let ((pa (- (length (member + (get-text-property 1 'todo-state a) + nd/org-agenda-todo-sort-order)))) + (pb (- (length (member + (get-text-property 1 'todo-state b) + nd/org-agenda-todo-sort-order))))) + (cond ((or (null pa) (null pb)) nil) + ((> pa pb) +1) + ((< pa pb) -1))))) + +#+END_SRC +**** custom commands +These agenda commands are the center of the gtd workflow. Some are slower than dirt but that's ok becuase the load times are far less than the that I would waste rifling through each org file trying to find a task. +#+BEGIN_SRC emacs-lisp +(let* ((actionable "-NA-REFILE-%inc") + (periodical "PARENT_TYPE=\"periodical\"") + (iterator "PARENT_TYPE=\"iterator\"") + (habit "STYLE=\"habit\"") + (task-match (concat actionable "-" periodical "-" habit "/!")) + (act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!")) + (peri-match (concat actionable "+" periodical "-" iterator "-" habit)) + (iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!"))) + + (setq + org-agenda-custom-commands + `(("a" + "Calendar View" + ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE"))) + (org-agenda-include-diary t))))) + + ("t" + "Task View" + (,(nd/agenda-base-task-cmd act-no-rep-match + "Project Tasks" + ''nd/skip-non-project-tasks + ''(user-defined-up category-keep)) + ,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks))) + + ("p" + "Project View" + (,(nd/agenda-base-project-cmd + act-no-rep-match + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects") + ''nd/skip-non-projects + ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete + :stuck :waiting :held :active) + ''nd/get-project-status t t))) + + ("i" + "Incubator View" + ((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc"))) + (org-agenda-span 7) + (org-agenda-time-grid nil) + (org-agenda-entry-types '(:deadline :timestamp :scheduled)))) + ,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc" + "Stale Incubated Timestamps" + ''nd/skip-non-stale-headings) + ,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!" + "Incubated Tasks" + ''nd/skip-non-atomic-tasks) + ,(nd/agenda-base-project-cmd + "-NA-REFILE+%inc/!" + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects") + ''nd/skip-non-projects + ''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete + :stuck :waiting :held :active) + ''nd/get-project-status + t t))) + + ("P" + "Periodical View" + (,(nd/agenda-base-project-cmd + (concat actionable "-" iterator "+" periodical "-" habit) + "Periodical Status" + ''nd/skip-non-periodical-parent-headings + 'nd/peri-statuscodes ''nd/get-periodical-status nil t) + ,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\"" + "Untimestamped" + ''nd/skip-non-periodical-untimestamped))) + + ("I" + "Iterator View" + (,(nd/agenda-base-project-cmd + "-NA-REFILE+PARENT_TYPE=\"iterator\"" + "Iterator Status" + ''nd/skip-non-iterator-parent-headings + 'nd/iter-statuscodes ''nd/get-iterator-status nil t) + ,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!" + "Unscheduled or Undeaded" + ''nd/skip-non-iterator-unscheduled))) + + ("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile")) + (org-tags-match-list-sublevels nil)))) + + ("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks"))))) + + ("e" + "Critical Errors" + (,(nd/agenda-base-task-cmd task-match + "Discontinous Project" + ''nd/skip-non-discontinuous-project-tasks) + ,(nd/agenda-base-heading-cmd task-match + "Undone Closed" + ''nd/skip-non-undone-closed-todoitems) + ,(nd/agenda-base-heading-cmd (concat actionable "-" periodical) + "Done Unclosed" + ''nd/skip-non-done-unclosed-todoitems) + ,(nd/agenda-base-task-cmd (concat task-match) + "Missing Creation Timestamp" + ''nd/skip-non-ia-timestamped-tasks))) + + + ("A" + "Archivable Tasks and Projects" + ((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC") + ((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators") + (org-agenda-sorting-strategy '(category-keep)) + (org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks))) + ,(nd/agenda-base-heading-cmd (concat actionable "-" habit) + "Stale Tasks and Periodicals" + ''nd/skip-non-stale-headings) + ,(nd/agenda-base-project-cmd + (concat actionable "-" periodical "-" iterator "-" habit) + '(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects") + ''nd/skip-non-projects ''(:archivable) ''nd/get-project-status)))))) +#+END_SRC