emacs-config/conf.el

1452 lines
50 KiB
EmacsLisp
Raw Normal View History

2018-03-21 21:44:31 -04:00
(setq inhibit-startup-screen t)
(tool-bar-mode -1)
(menu-bar-mode -1)
(scroll-bar-mode -1)
(set-default 'truncate-lines t)
(setq make-backup-files nil)
(setq auto-save-default nil)
(setq pop-up-windows nil) ; no popups (eg ediff)
;; (global-linum-mode t)
(line-number-mode 1)
(column-number-mode 1)
(setq-default tab-width 4)
(setq scroll-conservatively 100)
2018-05-16 23:04:34 -04:00
(add-hook 'ess-mode-hook #'prettify-symbols-mode)
(add-hook 'inferior-ess-mode-hook #'prettify-symbols-mode)
(add-hook 'prog-mode-hook #'prettify-symbols-mode)
2018-03-21 21:44:31 -04:00
(when window-system (global-hl-line-mode t))
(defalias 'yes-or-no-p 'y-or-n-p) ; eliminate yes or no prompt on killing procs
(defvar my:theme 'spacemacs-dark)
(defvar my:theme-window-loaded nil)
(defvar my:theme-terminal-loaded nil)
(if (daemonp)
(add-hook 'after-make-frame-functions(lambda (frame)
(select-frame frame)
(if (window-system frame)
(unless my:theme-window-loaded
(if my:theme-terminal-loaded
(enable-theme my:theme)
(load-theme my:theme t))
(setq my:theme-window-loaded t))
(unless my:theme-terminal-loaded
(if my:theme-window-loaded
(enable-theme my:theme)
(load-theme my:theme t))
(setq my:theme-terminal-loaded t)))))
(progn
(load-theme my:theme t)
(if (display-graphic-p)
(setq my:theme-window-loaded t)
(setq my:theme-terminal-loaded t))))
(use-package spaceline
:ensure t
:config
(require 'spaceline-config)
(setq powerline-default-separator (quote arrow))
(spaceline-spacemacs-theme)
(setq spaceline-buffer-size-p nil))
2018-05-15 22:55:11 -04:00
;; (use-package dashboard
;; :ensure t
;; :config
;; (dashboard-setup-startup-hook)
;; (setq dashboard-banner-logo-title "Emacs"))
;; (setq dashboard-items '((recents . 10))))
2018-03-21 21:44:31 -04:00
(global-set-key (kbd "C-h a") 'apropos)
2018-04-08 01:10:01 -04:00
(global-set-key (kbd "<f1>") 'org-agenda)
(global-set-key (kbd "<f2>") 'org-capture)
2018-03-21 21:44:31 -04:00
(use-package delight
:ensure t)
(use-package beacon
:ensure t
:delight
:init
(beacon-mode 1))
(use-package which-key
:ensure t
:delight
:init
(which-key-mode))
(use-package ido
:ensure t
:bind
("C-x C-b" . 'ido-switch-buffer)
("C-x b" . 'ibuffer)
:config
(ido-mode 1)
(setq ido-everywhere t)
(setq ido-enable-flex-matching t)
(setq ido-max-directory-size 100000)
(setq ido-default-file-method 'selected-window)
(setq ido-default-buffer-method 'selected-window)
(use-package ido-vertical-mode
:ensure t
:init
(ido-vertical-mode 1)
(setq ido-vertical-define-keys 'C-n-and-C-p-only)))
;; (setq ido-file-extensions-order '(".org" ".txt" ".py" ".emacs" ".xml" ".el" ".ini" ".cfg" ".cnf"))
(use-package smex
:ensure t
:init
(smex-initialize)
:bind
("M-x" . 'smex)
("M-X" . 'smex-major-mode-commands))
(use-package rainbow-delimiters
:ensure t
:delight
:init
2018-05-13 20:15:00 -04:00
(add-hook 'prog-mode-hook #'rainbow-delimiters-mode)
2018-05-16 23:04:34 -04:00
(add-hook 'inferior-ess-mode-hook #'rainbow-delimiters-mode)
2018-05-13 20:15:00 -04:00
(add-hook 'ess-mode-hook #'rainbow-delimiters-mode))
2018-03-21 21:44:31 -04:00
(use-package ace-window
:ensure t
:bind ("M-o" . ace-window)
:config (setq aw-background nil))
(use-package avy
:ensure t
:bind ("M-s" . avy-goto-char)
:config (setq avy-background t))
(use-package sudo-edit
:ensure t
:bind ("C-c s" . sudo-edit))
(use-package typit
:init
:ensure t)
(use-package calfw
:init
:ensure t)
(use-package evil
:ensure t
:config
(evil-mode 1)
(use-package evil-org
:ensure t
:after org
:delight
:config
(add-hook 'org-mode-hook 'evil-org-mode)
(add-hook 'evil-org-mode-hook
(lambda ()
(evil-org-set-key-theme)))
(require 'evil-org-agenda)
(evil-org-agenda-set-keys)))
(use-package undo-tree
:ensure t
:delight
:config
(global-undo-tree-mode)
(setq undo-tree-visualizer-diff t))
2018-06-09 18:31:40 -04:00
(use-package fill-column-indicator
:ensure t
:init
:config
(setq fci-rule-use-dashes t)
(add-hook 'prog-mode-hook #'fci-mode))
2018-05-19 14:45:43 -04:00
;; lovingly stolen from aaron harris
(defmacro nd/with-advice (adlist &rest body)
"Execute BODY with temporary advice in ADLIST.
Each element of ADLIST should be a list of the form
(SYMBOL WHERE FUNCTION [PROPS])
suitable for passing to `advice-add'. The BODY is wrapped in an
`unwind-protect' form, so the advice will be removed even in the
event of an error or nonlocal exit."
(declare (debug ((&rest (&rest form)) body))
(indent 1))
`(progn
,@(mapcar (lambda (adform)
(cons 'advice-add adform))
adlist)
(unwind-protect (progn ,@body)
,@(mapcar (lambda (adform)
`(advice-remove ,(car adform) ,(nth 2 adform)))
adlist))))
2018-05-19 15:36:04 -04:00
(defun nd/filter-list-prefix (prefix str-list)
"Return a subset of tags-list whose first character matches prefix.'
tags-list defaults to org-tag-alist if not given"
(seq-filter (lambda (i)
(and (stringp i)
(string-prefix-p prefix i)))
str-list))
2018-03-21 21:44:31 -04:00
(defun split-and-follow-horizontally ()
(interactive)
(split-window-below)
(balance-windows)
(other-window 1))
(global-set-key (kbd "C-x 2") 'split-and-follow-horizontally)
(defun split-and-follow-vertically ()
(interactive)
(split-window-right)
(balance-windows)
(other-window 1))
(global-set-key (kbd "C-x 3") 'split-and-follow-vertically)
(defun config-visit ()
(interactive)
(find-file "~/.emacs.d/conf.org"))
(global-set-key (kbd "C-c e") 'config-visit)
(defun config-reload ()
"Reloads ~/.emacs.d/conf.org at runtime"
(interactive)
(org-babel-load-file (expand-file-name "~/.emacs.d/conf.org")))
(global-set-key (kbd "C-c r") 'config-reload)
(global-set-key (kbd "C-S-w") 'fc/delete-whole-line)
(defun fc/delete-whole-line ()
"Delete the whole line without flooding the kill ring"
(interactive)
(delete-region (progn (forward-line 0) (point))
(progn (forward-line 1) (point))))
(global-set-key (kbd "M-d") 'fc/delete-word-forward)
(defun fc/delete-word-forward (arg)
"Delete word forward without flooding the kill ring"
(interactive "p")
(delete-region (point) (progn (forward-word arg) (point))))
(global-set-key (kbd "<M-backspace>") 'fc/delete-word-backward)
(defun fc/delete-word-backward (arg)
"Delete word backward without flooding the kill ring"
(interactive "p")
(delete-region (point) (progn (backward-word arg) (point))))
(global-set-key (kbd "C-c C-d") 'fc/duplicate-current-line-or-region)
(defun fc/duplicate-current-line-or-region (arg)
"Duplicates the current line or region ARG times."
(interactive "p")
(let (beg end (origin (point)))
(if (and mark-active (> (point) (mark)))
(exchange-point-and-mark))
(setq beg (line-beginning-position))
(if mark-active
(exchange-point-and-mark))
(setq end (line-end-position))
(let ((region (buffer-substring-no-properties beg end)))
(dotimes (i arg)
(goto-char end)
(newline)
(insert region)
(setq end (point))))))
(setq inferior-R-args "--quiet --no-save")
(load "ess-site")
(setq ess-history-file "session.Rhistory")
(setq ess-history-directory
2018-06-03 21:09:16 -04:00
(substitute-in-file-name "${XDG_CONFIG_HOME}/r/"))
2018-03-21 21:44:31 -04:00
(setq org-startup-indented t)
(delight 'org-indent-mode)
(setq org-directory "~/Org")
2018-06-03 21:09:16 -04:00
(run-at-time "00:59" 3600 'org-save-all-org-buffers)
2018-03-21 21:44:31 -04:00
(setq org-log-into-drawer "LOGBOOK")
(setq org-log-done t)
(use-package org-bullets
:ensure t
:config
(add-hook 'org-mode-hook (lambda () (org-bullets-mode))))
(defun nd/org-ui-heading-same-font-height ()
(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)))
(add-hook 'org-mode-hook 'nd/org-ui-heading-same-font-height)
2018-05-19 14:45:43 -04:00
(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)
2018-05-19 17:39:36 -04:00
(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)
2018-05-19 14:59:58 -04:00
(setq org-src-window-setup 'current-window)
(setq org-src-fontify-natively t)
(setq org-edit-src-content-indentation 0)
2018-03-21 21:44:31 -04:00
(add-to-list 'org-structure-template-alist
'("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC"))
(setq org-special-ctrl-a/e t)
(setq org-special-ctrl-k t)
(setq org-yank-adjusted-subtrees t)
(add-hook 'org-mode-hook
(lambda ()
(local-set-key (kbd "C-c C-x x") 'nd/mark-subtree-done)
2018-05-19 15:36:04 -04:00
(local-set-key (kbd "C-c C-x c") 'nd/org-clone-subtree-with-time-shift)))
2018-05-13 20:15:00 -04:00
(evil-define-key 'motion org-agenda-mode-map
"t" 'nd/toggle-project-toplevel-display
"D" 'org-agenda-day-view
"W" 'org-agenda-week-view
"M" 'org-agenda-month-view
"Y" 'org-agenda-year-view
"ct" nil
2018-05-16 23:04:34 -04:00
"sC" 'nd/org-agenda-filter-non-context
2018-05-13 20:15:00 -04:00
"e" 'org-agenda-set-effort
"ce" nil)
(add-hook 'org-agenda-mode-hook
(lambda ()
2018-05-15 22:55:11 -04:00
(local-set-key (kbd "C-c C-c") 'org-agenda-set-tags)))
2018-05-13 20:15:00 -04:00
2018-03-21 21:44:31 -04:00
(setq org-todo-keywords
2018-04-08 01:10:01 -04:00
'((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)")
(sequence "WAIT(w@/!)" "HOLD(h@/!)" "|" "CANC(c@/!)")))
2018-03-21 21:44:31 -04:00
(setq org-todo-keyword-faces
2018-05-19 15:09:15 -04:00
'(("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)))
2018-03-21 21:44:31 -04:00
2018-05-13 20:15:00 -04:00
(defun nd/add-tag-face (fg-name prefix)
"Adds list of cons cells to org-tag-faces with foreground set to fg-name.
2018-05-15 22:55:11 -04:00
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)))
2018-05-15 22:55:11 -04:00
;; for some reason, most special chars don't really
;; work in org-tag-alist, only #, @, %, and _
(setq org-tag-alist
'((:startgroup)
("@errand" . ?e)
("@home" . ?h)
("@work" . ?w)
("@travel" . ?r)
2018-05-15 22:55:11 -04:00
(:endgroup)
("#laptop" . ?l)
("#tcult" . ?t)
("#phone" . ?p)
2018-05-15 22:55:11 -04:00
("%note" . ?n)
("%inc" . ?i)
("%subdiv" . ?s)
(:startgroup)
("_env" . ?E)
("_fin" . ?F)
("_int" . ?I)
("_met" . ?M)
("_phy" . ?H)
("_pro" . ?P)
("_rec" . ?R)
("_soc" . ?S)
(:endgroup)))
(setq org-tag-faces '())
(nd/add-tag-face "PaleGreen" "@")
(nd/add-tag-face "SkyBlue" "#")
(nd/add-tag-face "PaleGoldenrod" "%")
(nd/add-tag-face "violet" "_")
(add-to-list 'org-default-properties "PARENT_TYPE")
(add-to-list 'org-default-properties "OWNER")
2018-05-19 14:45:43 -04:00
(add-to-list 'org-default-properties "GOAL")
2018-05-19 15:36:04 -04:00
(add-to-list 'org-default-properties "TIME_SHIFT")
(setq org-global-properties
'(("PARENT_TYPE_ALL" . "periodical iterator")
2018-05-13 20:15:00 -04:00
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00")))
2018-04-24 23:37:37 -04:00
;; TODO this may not be needed
2018-05-19 15:36:04 -04:00
(setq org-use-property-inheritance '("PARENT_TYPE" "TIME_SHIFT"))
2018-04-08 01:10:01 -04:00
2018-05-19 15:03:12 -04:00
(let ((capfile "~/Org/capture.org"))
(setq org-capture-templates
2018-05-19 15:40:04 -04:00
`(("t" "todo" entry (file ,capfile) "* TODO %?\ndeliverable: \n%U\n")
("n" "note" entry (file ,capfile) "* %? :\\%note:\n%U\n" )
("a" "appointment" entry (file ,capfile) "* %?\n%U\n%^t\n" )
("m" "multi-day" entry (file ,capfile) "* TODO %?\n%U\n%^t--%^t\n" )
("d" "deadline" entry (file ,capfile) "* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n" ))))
2018-03-21 21:44:31 -04:00
(setq org-refile-targets (quote ((nil :maxlevel . 9)
("~/Org/reference/idea.org" :maxlevel . 9)
(org-agenda-files :maxlevel . 9))))
(setq org-refile-use-outline-path t)
2018-06-04 17:58:43 -04:00
(setq org-outline-path-complete-in-steps t)
;; (setq org-completion-use-ido t)
2018-03-21 21:44:31 -04:00
2018-04-08 01:10:01 -04:00
(setq org-refile-allow-creating-parent-nodes 'confirm)
2018-03-21 21:44:31 -04:00
(setq org-indirect-buffer-display 'current-window)
(defun nd/verify-refile-target ()
"Exclude todo keywords with a done state from refile targets"
(not (member (nth 2 (org-heading-components)) org-done-keywords)))
(setq org-refile-target-verify-function 'nd/verify-refile-target)
2018-04-27 23:03:56 -04:00
(setq org-agenda-files '("~/Org"
"~/Org/projects"
2018-04-27 23:03:56 -04:00
"~/Org/reference"))
;; (setq org-agenda-files '("~/Org/reference/agendatest.org"))
2018-03-21 21:44:31 -04:00
(setq org-agenda-dim-blocked-tasks nil)
(setq org-agenda-compact-blocks t)
2018-06-09 18:31:40 -04:00
(setq org-agenda-window-setup 'current-window)
2018-03-21 21:44:31 -04:00
2018-06-21 22:35:03 -04:00
(setq holiday-bahai-holidays nil)
(setq holiday-hebrew-holidays nil)
(setq holiday-islamic-holidays nil)
(defun nd/get-date-property (date-property)
"Helper function to get the date property and convert to a number.
If it does not have a date, it will return nil."
(let ((timestamp (org-entry-get nil date-property)))
(if timestamp (float-time (date-to-time timestamp)))))
2018-03-22 00:32:17 -04:00
2018-06-21 22:35:03 -04:00
(defun nd/heading-compare-timestamp (timestamp-fun
&optional ref-time future)
"helper function that returns the timestamp (returned by
timestamp-fun on the current header) if timestamp is futher back in
time compared to a ref-time (default to 0 which is now, where negative
is past an positive is future). If the future flag is set, 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-timestamped-heading-p ()
(nd/get-date-property "TIMESTAMP"))
(defun nd/is-scheduled-heading-p ()
(nd/get-date-property "SCHEDULED"))
(defun nd/is-deadlined-heading-p ()
(nd/get-date-property "DEADLINE"))
2018-04-24 23:37:37 -04:00
(defun nd/is-closed-heading-p ()
(nd/get-date-property "CLOSED"))
(defun nd/is-stale-heading-p ()
2018-06-21 22:35:03 -04:00
(nd/heading-compare-timestamp
(lambda () (let ((ts (org-entry-get nil "TIMESTAMP")))
(if (and ts (not (find ?+ ts)))
(float-time (date-to-time ts)))))))
(defun nd/is-fresh-heading-p ()
(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 ()
(nd/heading-compare-timestamp
'nd/is-closed-heading-p
(- (* 60 60 24 nd/archive-delay-days))))
(defun nd/is-todoitem-p ()
(let ((keyword (nth 2 (org-heading-components))))
(if (member keyword org-todo-keywords-1)
keyword)))
(defun nd/is-project-p ()
2018-05-04 22:13:10 -04:00
(and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p)))
(defun nd/is-task-p ()
2018-05-04 22:13:10 -04:00
(and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p)))
2018-05-13 20:15:00 -04:00
(defun nd/is-project-task-p ()
(and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p)))
(defun nd/is-atomic-task-p ()
2018-05-04 22:13:10 -04:00
(and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p)))
2018-05-04 22:13:10 -04:00
(defun nd/is-periodical-heading-p ()
(equal "periodical" (org-entry-get nil "PARENT_TYPE" t)))
2018-03-22 00:32:17 -04:00
2018-05-04 22:13:10 -04:00
(defun nd/is-iterator-heading-p ()
(equal "iterator" (org-entry-get nil "PARENT_TYPE" t)))
2018-05-13 20:15:00 -04:00
(defun nd/heading-has-effort-p ()
(org-entry-get nil "Effort"))
(defun nd/heading-has-context-p ()
(let ((tags (org-get-tags-at)))
2018-05-15 22:55:11 -04:00
(or (> (length (nd/filter-list-prefix "#" tags)) 0)
(> (length (nd/filter-list-prefix "@" tags)) 0))))
(defun nd/heading-has-tag-p (tag)
(member tag (org-get-tags-at)))
2018-05-13 20:15:00 -04:00
2018-05-04 22:13:10 -04:00
(defun nd/heading-has-children (heading-test)
"returns t if heading has subheadings that return t when assessed with
heading-test function"
(let ((subtree-end (save-excursion (org-end-of-subtree t)))
has-children previous-point)
2018-04-02 00:40:42 -04:00
(save-excursion
2018-05-04 22:13:10 -04:00
(setq previous-point (point))
2018-04-02 00:40:42 -04:00
(outline-next-heading)
(while (and (not has-children)
2018-05-04 22:13:10 -04:00
(< previous-point (point) subtree-end))
(when (funcall heading-test)
2018-04-02 00:40:42 -04:00
(setq has-children t))
2018-05-04 22:13:10 -04:00
(setq previous-point (point))
(org-forward-heading-same-level 1 t)))
2018-04-02 00:40:42 -04:00
has-children))
2018-05-04 22:13:10 -04:00
(defun nd/heading-has-parent (heading-test)
"returns parent keyword if heading is in the immediate subtree of a heading
that evaluated to t with heading-test function"
(save-excursion (and (org-up-heading-safe) (funcall heading-test))))
2018-04-02 00:40:42 -04:00
2018-04-27 23:03:56 -04:00
(defun nd/has-discontinuous-parent ()
"returns t if heading has a parent which is not a
todoitem which in turn has a parent which is a todoitem"
2018-04-08 21:54:20 -04:00
(let ((has-todoitem-parent)
(has-non-todoitem-parent))
(save-excursion
(while (and (org-up-heading-safe)
2018-04-13 01:46:47 -04:00
(not has-todoitem-parent))
2018-04-08 21:54:20 -04:00
(if (nd/is-todoitem-p)
(setq has-todoitem-parent t)
(setq has-non-todoitem-parent t))))
(and has-todoitem-parent has-non-todoitem-parent)))
(defconst nd/project-invalid-todostates
'("WAIT" "NEXT")
2018-04-08 21:54:20 -04:00
"projects cannot have these todostates")
2018-04-27 07:52:05 -04:00
(defconst nd/project-statuscodes
'(:archivable
:complete
:stuck
:held
:waiting
:active
:done-incomplete
:undone-complete
:invalid-todostate
2018-04-27 09:58:08 -04:00
:scheduled-project)
2018-04-27 07:52:05 -04:00
"list of statuscodes to be used in assessing projects
Note they are listed in order of priority (eg items further
down the list override higher items")
2018-06-18 22:19:07 -04:00
(defconst nd/complete-statuscodes
'(:archivable
:complete))
(defconst nd/todo-statuscodes
'(:stuck
:held
:waiting
:active))
(defconst nd/error-statuscodes
'(:done-incomplete
:undone-complete
:invalid-todostate
:scheduled-project))
(defmacro nd/compare-statuscodes0 (op sc1 sc2 sc-list)
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
2018-04-27 07:52:05 -04:00
(defmacro nd/compare-statuscodes (operator statuscode-1 statuscode-2)
"syntactic suger to compare statuscodes by position"
`(,operator (position ,statuscode-1 nd/project-statuscodes)
(position ,statuscode-2 nd/project-statuscodes)))
(defun nd/status< (statuscode-1 statuscode-2)
"returns t is statuscode-1 is lesser priority than statuscode-2"
(nd/compare-statuscodes < statuscode-1 statuscode-2))
(defun nd/status> (statuscode-1 statuscode-2)
"returns t is statuscode-1 is greater priority than statuscode-2"
(nd/compare-statuscodes > statuscode-1 statuscode-2))
(defun nd/status= (statuscode-1 statuscode-2)
"returns t is statuscode-1 is equal priority than statuscode-2"
(nd/compare-statuscodes = statuscode-1 statuscode-2))
2018-03-30 20:54:25 -04:00
(defun nd/descend-into-project ()
2018-04-27 07:52:05 -04:00
"returns statuscode of project and recursively descends into subprojects"
(let ((project-state :archivable)
(previous-point))
(save-excursion
(setq previous-point (point))
(outline-next-heading)
2018-04-27 07:52:05 -04:00
;; loop breaks if active or higher priority
;; note that all invalid statuscodes are higher
;; thus this function will only return the first
;; encountered error
(while (and (nd/status< project-state :active)
(> (point) previous-point))
2018-04-13 01:46:47 -04:00
(let ((keyword (nd/is-todoitem-p)))
2018-03-30 20:54:25 -04:00
(if keyword
(let ((cur-state
2018-05-04 22:13:10 -04:00
(if (nd/heading-has-children 'nd/is-todoitem-p)
2018-04-27 07:52:05 -04:00
(cond ((member keyword nd/project-invalid-todostates) :invalid-todostate)
((nd/is-scheduled-heading-p) :scheduled-project)
((equal keyword "CANC") (if (nd/is-archivable-heading-p)
2018-04-27 07:52:05 -04:00
:archivable
:complete))
((equal keyword "HOLD") :held)
2018-04-08 21:54:20 -04:00
(t (let ((child-statuscode (nd/descend-into-project)))
2018-04-27 07:52:05 -04:00
(cond ((equal keyword "TODO")
(if (nd/status> child-statuscode :complete)
child-statuscode
:undone-complete))
2018-04-24 23:37:37 -04:00
(t (case child-statuscode
2018-04-27 07:52:05 -04:00
(:complete :complete)
(:archivable (if (nd/is-archivable-heading-p)
:archivable
:complete))
(t (if (nd/status= child-statuscode :complete)
2018-04-27 07:52:05 -04:00
:complete
:done-incomplete))))))))
2018-04-27 07:52:05 -04:00
(cond ((equal keyword "HOLD") :held)
((equal keyword "WAIT") :waiting)
2018-04-27 07:52:05 -04:00
((equal keyword "NEXT") :active)
((and (equal keyword "TODO") (nd/is-scheduled-heading-p)) :active)
((equal keyword "TODO") :stuck)
((nd/is-archivable-heading-p) :archivable)
(t :complete)))))
(if (nd/status> cur-state project-state)
2018-03-30 20:54:25 -04:00
(setq project-state cur-state)))))
(setq previous-point (point))
(org-forward-heading-same-level 1 t)))
2018-03-30 20:54:25 -04:00
project-state))
2018-06-18 22:19:07 -04:00
(defun nd/decend-into-project0 (allowed-statuscodes trans-tbl get-task-status)
(let ((project-status (first allowed-statuscodes))
(breaker-status (car (last allowed-statuscodes)))
(previous-point))
;; (message "hi")
(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 not project then use user-defined function
;; to obtain status of task
(nth (funcall get-task-status keyword)
allowed-statuscodes))))
;; (message (format "%s" (concat "new status: " (symbol-name new-status))))
;; (message (format "%s" (concat "project status: " (symbol-name project-status))))
;; (message (format "%s" keyword))
(if (nd/compare-statuscodes0 > 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 ()
(let ((keyword (nd/is-todoitem-p)))
;; these first three are easy because they only require
;; testing the project headline and nothing underneath
(cond
((nd/is-scheduled-heading-p) :scheduled-project)
((equal keyword "HOLD") :held)
((member keyword nd/project-invalid-todostates)
:invalid-todostate)
;; these require descending into the project subtasks
((equal keyword "CANC")
(nd/decend-into-project0
'(: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))))
((equal keyword "DONE")
(nd/decend-into-project0
'(: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))))
((equal keyword "TODO")
(nd/decend-into-project0
'(: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") 1)
((equal k "HOLD") 2)
((equal k "WAIT") 3)
((equal k "NEXT") 4)
((and (equal k "TODO") (nd/is-scheduled-heading-p)) 4)
(t 0)))))
(t (error (concat "invalid keyword detected: " keyword))))))
2018-04-27 23:03:56 -04:00
(defmacro nd/is-project-keyword-status-p (test-keyword operator statuscode)
2018-04-27 09:58:08 -04:00
"tests if a project has toplevel heading of top-keyword and
child status equal to status code and returns keyword if
both are true"
2018-04-27 23:03:56 -04:00
`(and
(equal ,keyword ,test-keyword)
(nd/compare-statuscodes ,operator (nd/descend-into-project) ,statuscode)))
2018-04-27 09:58:08 -04:00
2018-03-31 01:43:17 -04:00
(defun nd/is-project-status-p (statuscode)
2018-04-27 23:03:56 -04:00
"Returns t if project matches statuscode given.
Note that this assumes the headline being tested is a valid project"
(case statuscode
;; projects closed more than 30 days ago
;; note CANC overrides all subtasks/projects
2018-04-27 23:03:56 -04:00
(:archivable
(if (nd/is-archivable-heading-p)
(or (equal keyword "CANC")
2018-04-27 23:03:56 -04:00
(nd/is-project-keyword-status-p "DONE" = :archivable))))
;; projects closed less than 30 days ago
;; note CANC overrides all subtasks/projects
2018-04-27 23:03:56 -04:00
(:complete
(if (not (nd/is-archivable-heading-p))
(or (equal keyword "CANC")
2018-04-27 23:03:56 -04:00
(nd/is-project-keyword-status-p "DONE" = :complete))))
;; projects with no waiting, held, or active components
(:stuck
(nd/is-project-keyword-status-p "TODO" = :stuck))
;; held projects
;; note toplevel HOLD overrides all subtasks/projects
(:held
(or (equal keyword "HOLD")
(nd/is-project-keyword-status-p "TODO" = :held)))
;; projects with at least one waiting component
(:waiting
(nd/is-project-keyword-status-p "TODO" = :waiting))
;; projects with at least one active component
(:active
(nd/is-project-keyword-status-p "TODO" = :active))
;; projects marked DONE but still have undone subtasks
(:done-incomplete
(nd/is-project-keyword-status-p "DONE" > :complete))
;; projects marked TODO but all subtasks are done
(:undone-complete
(nd/is-project-keyword-status-p "TODO" < :stuck))
;; projects with invalid todo keywords
(:invalid-todostate
(member keyword nd/project-invalid-todostates))
;; projects with scheduled heading (only subtasks should be scheduled)
(:scheduled-project
(nd/is-scheduled-heading-p))
;; error if not known
(t (if (not (member statuscode nd/project-statuscodes))
(error "unknown statuscode")))))
2018-06-23 20:28:26 -04:00
(defconst nd/iter-future-time (* 7 24 60 60))
(defconst nd/iter-statuscodes '(:uninit :empty :active))
(defun nd/get-iterator-status ()
(let ((iter-status :uninit)
(subtree-end (save-excursion (org-end-of-subtree))))
(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-statuscodes0 > new-status iter-status nd/iter-statuscodes)
(setq iter-status new-status)))))
(outline-next-heading)))
iter-status))
2018-05-04 22:13:10 -04:00
(defun nd/skip-heading ()
2018-04-27 23:03:56 -04:00
(save-excursion (or (outline-next-heading) (point-max))))
(defun nd/skip-subtree ()
(save-excursion (or (org-end-of-subtree t) (point-max))))
(defconst nd/project-skip-todostates
'("HOLD" "CANC")
2018-04-27 23:03:56 -04:00
"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")
(defmacro nd/skip-heading-with (heading-fun test-fun)
"Skips 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))
2018-05-04 22:13:10 -04:00
(nd/skip-heading)))))
2018-05-15 22:55:11 -04:00
(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list)
"Skips headings that have tags in pos-tags-list and also skips
tags that do not have tags in neg-tags-list"
(save-restriction
(widen)
(let ((header-tags (org-get-tags-at)))
(if (and (or (not pos-tags-list)
(intersection pos-tags-list header-tags :test 'equal))
(not (intersection neg-tags-list header-tags :test 'equal)))
(nd/skip-heading)))))
(defun nd/skip-non-stale-headings ()
(save-restriction
(widen)
(let ((keyword (nd/is-todoitem-p)))
(if (not
(and (nd/is-stale-heading-p)
(not (member keyword org-done-keywords))
2018-05-04 22:13:10 -04:00
(not (nd/heading-has-children 'nd/is-todoitem-p))
(not (nd/heading-has-parent 'nd/is-todoitem-p))))
(nd/skip-heading)))))
2018-05-13 20:15:00 -04:00
;; NOTE: this assumes that tags-todo will
;; filter out all done state tasks
(defun nd/skip-non-atomic-tasks ()
(save-excursion
(widen)
(if (not (nd/is-atomic-task-p))
(nd/skip-heading))))
2018-04-27 23:03:56 -04:00
(defun nd/skip-non-closed-atomic-tasks ()
(nd/skip-heading-with
nd/is-atomic-task-p
(and (member keyword org-done-keywords)
(not (nd/is-archivable-heading-p)))))
2018-04-24 23:37:37 -04:00
2018-04-27 23:03:56 -04:00
(defun nd/skip-non-archivable-atomic-tasks ()
(nd/skip-heading-with
nd/is-atomic-task-p
(and (member keyword org-done-keywords)
(nd/is-archivable-heading-p))))
2018-04-27 23:03:56 -04:00
(defun nd/skip-non-fresh-periodical-parent-headers ()
(save-restriction
(widen)
2018-05-13 20:15:00 -04:00
(if (not (and (nd/is-periodical-heading-p)
(not (nd/heading-has-parent 'nd/is-periodical-heading-p))
(nd/heading-has-children 'nd/is-fresh-heading-p)))
(nd/skip-heading))))
(defun nd/skip-non-stale-periodical-parent-headers ()
(save-restriction
(widen)
(if (not (and (nd/is-periodical-heading-p)
(not (nd/heading-has-parent 'nd/is-periodical-heading-p))
(nd/heading-has-children 'nd/is-stale-heading-p)
(not (nd/heading-has-children 'nd/is-fresh-heading-p))))
(nd/skip-heading))))
(defun nd/skip-non-empty-periodical-parent-headers ()
(save-restriction
(widen)
(if (not (and (nd/is-periodical-heading-p)
(not (nd/heading-has-parent 'nd/is-periodical-heading-p))
(not (nd/heading-has-children 'nd/is-timestamped-heading-p))))
(nd/skip-heading))))
2018-05-19 14:45:43 -04:00
(defun nd/skip-non-project-tasks ()
2018-04-24 23:37:37 -04:00
(save-restriction
(widen)
2018-04-27 23:03:56 -04:00
(let ((keyword (nd/is-todoitem-p)))
(if keyword
2018-05-04 22:13:10 -04:00
(if (nd/heading-has-children 'nd/is-todoitem-p)
2018-04-27 23:03:56 -04:00
(if (member keyword nd/project-skip-todostates)
(nd/skip-subtree)
2018-05-04 22:13:10 -04:00
(nd/skip-heading))
(if (not (and (nd/heading-has-parent 'nd/is-todoitem-p)
(not (nd/is-timestamped-heading-p))
(not (nd/is-scheduled-heading-p))
(not (nd/is-deadlined-heading-p))
2018-05-19 14:45:43 -04:00
;; (equal keyword skip-keyword)
))
2018-05-04 22:13:10 -04:00
(nd/skip-heading)))
(nd/skip-heading)))))
2018-05-13 20:15:00 -04:00
2018-04-24 23:37:37 -04:00
(defun nd/skip-non-discontinuous-project-tasks ()
2018-04-27 23:03:56 -04:00
(nd/skip-heading-with
nd/is-todoitem-p
(nd/has-discontinuous-parent)))
(defun nd/skip-non-done-unclosed-todoitems ()
(nd/skip-heading-with
nd/is-todoitem-p
(and (member keyword org-done-keywords)
(not (nd/is-closed-heading-p)))))
2018-04-24 23:37:37 -04:00
(defun nd/skip-non-undone-closed-todoitems ()
2018-04-27 23:03:56 -04:00
(nd/skip-heading-with
nd/is-todoitem-p
(and (not (member keyword org-done-keywords))
(nd/is-closed-heading-p))))
2018-05-04 22:13:10 -04:00
(defun nd/skip-non-iterator-atomic-tasks ()
2018-04-27 23:03:56 -04:00
(nd/skip-heading-with
nd/is-atomic-task-p
2018-05-04 22:13:10 -04:00
(nd/is-iterator-heading-p)))
2018-04-24 23:37:37 -04:00
2018-05-13 20:15:00 -04:00
(defun nd/skip-atomic-tasks-with-context ()
(nd/skip-heading-with
nd/is-atomic-task-p
(not (nd/heading-has-context-p))))
(defun nd/skip-project-tasks-with-context ()
(nd/skip-heading-with
nd/is-project-task-p
(not (nd/heading-has-context-p))))
(defun nd/skip-projects-with-context ()
(nd/skip-heading-with
nd/is-project-p
(not (nd/heading-has-context-p))))
(defun nd/skip-tasks-with-effort ()
(nd/skip-heading-with
nd/is-task-p
(not (nd/heading-has-effort-p))))
2018-04-24 23:37:37 -04:00
(defun nd/skip-projects-without-statuscode (statuscode)
(save-restriction
(widen)
2018-04-27 23:03:56 -04:00
(let ((keyword (nd/is-project-p)))
(if keyword
(if (and nd/agenda-limit-project-toplevel
2018-05-04 22:13:10 -04:00
(nd/heading-has-parent 'nd/is-todoitem-p))
(nd/skip-subtree)
(if (not (nd/is-project-status-p statuscode))
2018-05-04 22:13:10 -04:00
(nd/skip-heading)))
(nd/skip-heading)))))
2018-04-24 23:37:37 -04:00
2018-06-18 22:19:07 -04:00
(defun nd/skip-non-projects ()
(save-restriction
(widen)
(let ((keyword (nd/is-project-p)))
(if keyword
(if (and nd/agenda-limit-project-toplevel
(nd/heading-has-parent 'nd/is-todoitem-p))
(nd/skip-subtree))
(nd/skip-heading)))))
2018-06-04 17:58:43 -04:00
2018-04-24 23:37:37 -04:00
(defvar nd/agenda-limit-project-toplevel t
"used to filter projects by all levels or top-level only")
2018-05-13 20:15:00 -04:00
(defvar nd/agenda-hide-incubator-tags t
"used to filter incubator headings")
2018-04-24 23:37:37 -04:00
(defun nd/toggle-project-toplevel-display ()
(interactive)
(setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel))
(when (equal major-mode 'org-agenda-mode)
2018-04-24 23:37:37 -04:00
(org-agenda-redo))
(message "Showing %s project view in agenda"
(if nd/agenda-limit-project-toplevel "toplevel" "complete")))
2018-04-24 23:37:37 -04:00
2018-05-13 20:15:00 -04:00
(defun nd/toggle-agenda-var (var msg)
(interactive)
(set var (not (eval var)))
(when (equal major-mode 'org-agenda-mode)
(org-agenda-redo))
(message msg))
2018-05-16 23:04:34 -04:00
(defun nd/org-agenda-filter-non-context ()
"A quick and dirty agenda filter that removes all
2018-05-16 23:04:34 -04:00
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)))
(setq org-agenda-tags-todo-honor-ignore-options t)
(setq org-agenda-prefix-format
2018-06-03 21:09:16 -04:00
'((agenda . " %-12:c %-5:e %?-12t% s")
2018-05-13 20:15:00 -04:00
(timeline . " % s")
(todo . " %-12:c")
2018-06-03 21:09:16 -04:00
(tags . " %-12:c %-5:e ")
2018-05-13 20:15:00 -04:00
(search . " %-12:c")))
2018-05-19 14:45:43 -04:00
(defconst nd/org-agenda-todo-sort-order '("NEXT" "WAIT" "HOLD" "TODO"))
(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)))))
2018-06-18 22:19:07 -04:00
(defun nd/org-agenda-filter-projects (filter a-line)
"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)
Will go to the original org buffer and determine the project status
after which it will check if status is in filter. 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"
(let* ((m (get-text-property 1 'org-marker a-line))
(s (with-current-buffer (marker-buffer m)
(goto-char m)
(nd/get-project-status))))
(if (member s filter)
(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)
(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-header-cmd (match header skip-fun)
2018-04-27 23:03:56 -04:00
`(tags
,match
2018-05-13 20:15:00 -04:00
((org-agenda-overriding-header ,header)
2018-04-24 23:37:37 -04:00
(org-agenda-skip-function ,skip-fun)
(org-agenda-sorting-strategy '(category-keep)))))
(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort)
2018-05-19 14:45:43 -04:00
(or sort (setq sort ''(category-keep)))
2018-05-13 20:15:00 -04:00
`(tags-todo
,match
((org-agenda-overriding-header ,header)
(org-agenda-skip-function ,skip-fun)
(org-agenda-todo-ignore-with-date t)
2018-05-19 14:45:43 -04:00
(org-agenda-sorting-strategy ,sort))))
2018-05-13 20:15:00 -04:00
(defun nd/agenda-base-proj-cmd (match header statuscode)
`(tags-todo
2018-04-24 23:37:37 -04:00
,match
((org-agenda-overriding-header
2018-05-13 20:15:00 -04:00
(concat (and nd/agenda-limit-project-toplevel "Toplevel ") ,header))
2018-04-27 23:03:56 -04:00
(org-agenda-skip-function '(nd/skip-projects-without-statuscode ,statuscode))
2018-06-18 22:19:07 -04:00
;;(org-agenda-before-sorting-filter-function 'nd/sorting-filter-demo)
;; (nd/apply-statuscodes t)
2018-06-21 22:35:03 -04:00
;; (org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
2018-04-24 23:37:37 -04:00
(org-agenda-sorting-strategy '(category-keep)))))
(let* ((actionable "-NA-REFILE-%inc")
(periodical "PARENT_TYPE=\"periodical\"")
(iterator "PARENT_TYPE=\"iterator\"")
(task-match (concat actionable "-" periodical "/!"))
(act-no-rep-match (concat actionable "-" periodical "-" iterator "/!"))
(peri-match (concat actionable "+" periodical "-" iterator "/!"))
(iter-match (concat actionable "-" periodical "+" iterator "/!")))
(setq org-agenda-custom-commands
`(("t"
"Task View"
2018-06-21 22:35:03 -04:00
((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc")))
(org-agenda-include-diary t)))
,(nd/agenda-base-task-cmd act-no-rep-match
2018-05-19 14:45:43 -04:00
"Project Tasks"
''nd/skip-non-project-tasks
''(user-defined-up category-keep))
,(nd/agenda-base-task-cmd act-no-rep-match
2018-05-19 14:45:43 -04:00
"Atomic Tasks"
''nd/skip-non-atomic-tasks)))
("p"
"Project View"
2018-06-18 22:19:07 -04:00
((tags-todo
,act-no-rep-match
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Projects"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-projects '(:stuck :waiting :held :active) l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
;; ("p"
;; "Project View"
;; (,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Stuck Projects"
;; :stuck)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Waiting Projects"
;; :waiting)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Active Projects"
;; :active)
;; ,(nd/agenda-base-proj-cmd act-no-rep-match
;; "Held Projects"
;; :held)))
2018-05-13 20:15:00 -04:00
("P"
"Periodical View"
(,(nd/agenda-base-header-cmd peri-match
"Empty Periodicals"
''nd/skip-non-empty-periodical-parent-headers)
,(nd/agenda-base-header-cmd peri-match
"Stale Periodicals"
''nd/skip-non-stale-periodical-parent-headers)
,(nd/agenda-base-header-cmd peri-match
"Fresh Periodicals"
''nd/skip-non-fresh-periodical-parent-headers)))
2018-05-13 20:15:00 -04:00
("i"
"Iterator View"
(,(nd/agenda-base-proj-cmd iter-match
"Stuck Iterators (require NEXT or schedule)"
:stuck)
,(nd/agenda-base-proj-cmd iter-match
"Empty Iterators (require new tasks)"
:undone-complete)
,(nd/agenda-base-task-cmd iter-match
"Uninitialized Iterators (no tasks added)"
''nd/skip-non-iterator-atomic-tasks)
,(nd/agenda-base-proj-cmd iter-match
"Active Iterators"
:active)
,(nd/agenda-base-proj-cmd iter-match
"Waiting Iterators"
:waiting)
,(nd/agenda-base-proj-cmd iter-match
"Held Iterators"
:held)))
2018-05-15 22:55:11 -04:00
("I"
"Incubator View"
((agenda "" ((org-agenda-span 7)
(org-agenda-time-grid nil)
(org-agenda-entry-types '(:deadline :timestamp))))
,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!"
"Incubated Tasks"
''nd/skip-non-atomic-tasks)
2018-06-23 20:28:26 -04:00
(tags-todo
"-NA-REFILE+%inc/!"
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Incubated Projects"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-projects '(:stuck :waiting :held :active) l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:stuck :waiting :active :held) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
("r"
"Refile and Critical Errors"
((tags "REFILE"
((org-agenda-overriding-header "Tasks to Refile"))
(org-tags-match-list-sublevels nil))
,(nd/agenda-base-task-cmd task-match
"Discontinous Project"
2018-06-23 20:28:26 -04:00
''nd/skip-non-discontinuous-project-tasks)))
("e"
"Non-critical Errors"
(,(nd/agenda-base-header-cmd task-match
"Undone Closed"
''nd/skip-non-undone-closed-todoitems)
,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Done Unclosed"
''nd/skip-non-done-unclosed-todoitems)
2018-06-23 20:28:26 -04:00
(tags-todo
,act-no-rep-match
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Project Errors"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-projects '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:scheduled-project :invalid-todostate :undone-complete :done-incomplete) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
("A"
"Archivable Tasks and Projects"
(,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Archivable Atomic Tasks"
''nd/skip-non-archivable-atomic-tasks)
,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Stale Tasks"
''nd/skip-non-stale-headings)
,(nd/agenda-base-proj-cmd (concat actionable "-" periodical "+" iterator)
"Archivable Iterators"
:archivable)
2018-06-23 20:28:26 -04:00
(tags-todo
,(concat actionable "-" periodical "-" iterator)
((org-agenda-overriding-header
(concat (and
nd/agenda-limit-project-toplevel "Toplevel ")
"Archivable Projects"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-projects '(:archivable) l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status '(:archivable) a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))))))
2018-04-02 00:40:42 -04:00
2018-05-15 22:55:11 -04:00
(setq org-agenda-start-on-weekday 0)
2018-04-08 21:54:20 -04:00
(setq org-agenda-span 'day)
2018-06-03 21:09:16 -04:00
(setq org-agenda-current-time-string "### -- NOW -- ###")
(setq org-agenda-time-grid '((daily today remove-match)
(0800 1000 1200 1200 1400 1600)
"......" "-----------------"))
2018-04-08 21:54:20 -04:00
(add-hook 'org-finalize-agenda-hook 'place-agenda-tags)
(defun place-agenda-tags ()
"Put the agenda tags by the right border of the agenda window."
(setq org-agenda-tags-column (- 4 (window-width)))
(org-agenda-align-tags))
2018-04-08 21:54:20 -04:00
(defun nd/org-auto-exclude-function (tag)
"Automatic task exclusion in the agenda with / RET"
(and (cond
((string= tag "hold")
t))
(concat "-" tag)))
2018-04-02 00:40:42 -04:00
2018-04-08 21:54:20 -04:00
(setq org-agenda-auto-exclude-function 'nd/org-auto-exclude-function)
2018-03-21 21:44:31 -04:00
(setq org-columns-default-format
2018-05-13 20:15:00 -04:00
"%25ITEM %4TODO %TAGS %5Effort{:} %OWNER(OWN)")
(set-face-attribute 'org-column nil :background "#1e2023")
;; org-columns-summary-types
(defun nd/mark-subtree-keyword (new-keyword &optional exclude)
"marks all tasks in a subtree with 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 ()
"marks all tasks in subtree as DONE unless they are already canc"
(interactive)
(nd/mark-subtree-keyword "DONE" '("CANC")))
2018-05-19 15:36:04 -04:00
(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: ")
2018-05-19 15:36:04 -04:00
(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
2018-06-04 17:58:43 -04:00
;; 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)
2018-06-04 17:58:43 -04:00
(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)))))
2018-03-21 21:44:31 -04:00
(use-package calfw-org
:init
: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 ?┓))
(defvar nd-term-shell "/bin/bash")
(defadvice ansi-term (before force-bash)
(interactive (list nd-term-shell)))
(ad-activate 'ansi-term)
(setq ediff-window-setup-function 'ediff-setup-windows-plain)