2018-03-21 21:59:12 -04:00
work in progress
2018-03-21 21:44:31 -04:00
* ui
** remove garbage
*** startup screen
#+BEGIN_SRC emacs-lisp
(setq inhibit-startup-screen t)
#+END_SRC
*** useless mouse widgets
#+BEGIN_SRC emacs-lisp
(tool-bar-mode -1)
(menu-bar-mode -1)
(scroll-bar-mode -1)
#+END_SRC
*** line wrap
#+BEGIN_SRC emacs-lisp
(set-default 'truncate-lines t)
#+END_SRC
*** autosave/backup files
#+BEGIN_SRC emacs-lisp
(setq make-backup-files nil)
(setq auto-save-default nil)
#+END_SRC
*** popup windows
#+BEGIN_SRC emacs-lisp
(setq pop-up-windows nil) ; no popups (eg ediff)
#+END_SRC
** pretty stuff
*** enable line/column numbering
#+BEGIN_SRC emacs-lisp
;; (global-linum-mode t)
(line-number-mode 1)
(column-number-mode 1)
#+END_SRC
*** tab width
#+BEGIN_SRC emacs-lisp
(setq-default tab-width 4)
#+END_SRC
*** smooth scrolling
#+BEGIN_SRC emacs-lisp
(setq scroll-conservatively 100)
#+END_SRC
*** pretty symbols
#+BEGIN_SRC emacs-lisp
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
#+END_SRC
** yes-no prompt enhancement
#+BEGIN_SRC emacs-lisp
(defalias 'yes-or-no-p 'y-or-n-p) ; eliminate yes or no prompt on killing procs
#+END_SRC
2018-07-03 22:27:12 -04:00
** theme customizations
#+BEGIN_SRC emacs-lisp
;; for spacemacs theme
(setq spacemacs-theme-custom-colors '((lnum . "#64707c")))
#+END_SRC
2018-03-21 21:44:31 -04:00
** theme color selection
need this to:
a) apply the gui theme if gui is loaded as client and
b) ensure that the reloaded theme is only applied to the current frame
NOTE: this only works if we start term after gui, and term has light bg. not big deal for now since I hardly ever use term as client
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
* modeline
#+BEGIN_SRC emacs-lisp
(use-package spaceline
:ensure t
:config
(require 'spaceline-config)
(setq powerline-default-separator (quote arrow))
(spaceline-spacemacs-theme)
(setq spaceline-buffer-size-p nil))
#+END_SRC
** dashboard
#+BEGIN_SRC emacs-lisp
2018-05-15 22:55:11 -04:00
;; (use-package dashboard
;; :ensure t
;; :config
;; (dashboard-setup-startup-hook)
;; (setq dashboard-banner-logo-title "Emacs"))
2018-05-13 20:15:00 -04:00
;; (setq dashboard-items '((recents . 10))))
2018-03-21 21:44:31 -04:00
#+END_SRC
* keybindings
2018-04-08 01:10:01 -04:00
** overrides
2018-03-21 21:44:31 -04:00
#+BEGIN_SRC emacs-lisp
2018-04-08 01:10:01 -04:00
(global-set-key (kbd "C-h a") 'apropos)
#+END_SRC
** modeless bindings
These are commands that should work in any mode. Make the assumption that function keys are pretty much free in any major/minor mode
#+BEGIN_SRC emacs-lisp
(global-set-key (kbd "<f1 >") 'org-agenda)
(global-set-key (kbd "<f2 >") 'org-capture)
2018-07-03 19:48:50 -04:00
(global-set-key (kbd "<f12 >") 'global-hl-line-mode)
(global-set-key (kbd "S-<f12 >") 'display-line-numbers-mode)
2018-03-21 21:44:31 -04:00
#+END_SRC
* printing
**
* packages
** delight
#+BEGIN_SRC emacs-lisp
(use-package delight
:ensure t)
#+END_SRC
** beacon
#+BEGIN_SRC emacs-lisp
(use-package beacon
:ensure t
:delight
:init
(beacon-mode 1))
#+END_SRC
** whichkey
#+BEGIN_SRC emacs-lisp
(use-package which-key
:ensure t
:delight
:init
(which-key-mode))
#+END_SRC
** ido
#+BEGIN_SRC emacs-lisp
(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"))
#+END_SRC
** smex
#+BEGIN_SRC emacs-lisp
(use-package smex
:ensure t
:init
(smex-initialize)
:bind
("M-x" . 'smex)
("M-X" . 'smex-major-mode-commands))
#+END_SRC
** rainbow-delimiters
#+BEGIN_SRC emacs-lisp
(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
#+END_SRC
** ace-window
#+BEGIN_SRC emacs-lisp
2018-07-03 22:27:12 -04:00
(use-package ace-window
:ensure t
:bind ("M-o" . ace-window)
:config
(setq aw-background t)
(set-face-attribute 'aw-leading-char-face nil :foreground "#292b2e"
:background "#bc6ec5":height 1.0 :box nil))
2018-03-21 21:44:31 -04:00
#+END_SRC
** avy
#+BEGIN_SRC emacs-lisp
(use-package avy
:ensure t
:bind ("M-s" . avy-goto-char)
:config (setq avy-background t))
#+END_SRC
** sudo edit
#+BEGIN_SRC emacs-lisp
(use-package sudo-edit
:ensure t
:bind ("C-c s" . sudo-edit))
#+END_SRC
** typit
#+BEGIN_SRC emacs-lisp
(use-package typit
:init
:ensure t)
#+END_SRC
** calfw
#+BEGIN_SRC emacs-lisp
(use-package calfw
:init
:ensure t)
#+END_SRC
** evil
*** packages
#+BEGIN_SRC emacs-lisp
(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)))
#+END_SRC
*** keybindings
vim is all about escape, not...ctrl+g???
+BEGIN_SRC emacs-lisp
(define-key evil-normal-state-map [escape] 'keyboard-quit)
(define-key evil-visual-state-map [escape] 'keyboard-quit)
;; since ctrl+g and evil make no sense
(defun nd/minibuffer-keyboard-quit ()
"Abort recursive edit.
In Delete Selection mode, if the mark is active, just deactivate it;
then it takes a second \\[keyboard-quit] to abort the minibuffer."
(interactive)
(if (and delete-selection-mode transient-mark-mode mark-active)
(setq deactivate-mark t)
(when (get-buffer "*Completions* ") (delete-windows-on "*Completions* "))
(abort-recursive-edit)))
(define-key minibuffer-local-ns-map [escape] 'minibuffer-keyboard-quit)
(define-key minibuffer-local-completion-map [escape] 'minibuffer-keyboard-quit)
(define-key minibuffer-local-must-match-map [escape] 'minibuffer-keyboard-quit)
(define-key minibuffer-local-isearch-map [escape] 'minibuffer-keyboard-quit)
#+END_SRC
** undo tree
#+BEGIN_SRC emacs-lisp
(use-package undo-tree
:ensure t
:delight
:config
(global-undo-tree-mode)
(setq undo-tree-visualizer-diff t))
#+END_SRC
2018-06-09 18:31:40 -04:00
** fill-column-indicator
#+BEGIN_SRC emacs-lisp
(use-package fill-column-indicator
:ensure t
:init
:config
(setq fci-rule-use-dashes t)
(add-hook 'prog-mode-hook #'fci-mode))
#+END_SRC
2018-07-03 19:48:50 -04:00
** rainbow
#+BEGIN_SRC emacs-lisp
(use-package rainbow-mode
:ensure t)
#+END_SRC
2018-05-19 14:45:43 -04:00
* library
A place for duct tape code that I developed (or lovingly stole from others)
** macros
#+BEGIN_SRC emacs-lisp
;; 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))))
#+END_SRC
2018-05-19 15:09:15 -04:00
** functions
#+BEGIN_SRC emacs-lisp
(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))
#+END_SRC
2018-03-21 21:44:31 -04:00
* custom functions
** follow window splitting
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
** config edit and reload
*** edit
#+BEGIN_SRC emacs-lisp
(defun config-visit ()
(interactive)
(find-file "~/.emacs.d/conf.org"))
(global-set-key (kbd "C-c e") 'config-visit)
#+END_SRC
*** reload
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
** custom keybindings
*** delete whole line
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
*** delete word forward
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
*** delete word backward
#+BEGIN_SRC emacs-lisp
(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))))
#+END_SRC
*** duplicate line
#+BEGIN_SRC emacs-lisp
(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))))))
#+END_SRC
(goto-char (+ origin (* (length region) arg) arg)))))
* ess
#+begin_src emacs-lisp
(setq inferior-R-args "--quiet --no-save")
(load "ess-site")
(setq ess-history-file "session.Rhistory")
(setq ess-history-directory
(substitute-in-file-name "${XDG_CONFIG_HOME}/r/ "))
#+END_SRC
* languages
** python
#+BEGIN_SRC
(elpy-enable)
;; make python tabs 4 chars
(add-hook 'python-mode-hook
(lambda ()
(setq indent-tabs-mode t)
(setq tab-width 4)
(setq python-indent 4)))
#+END_SRC
2018-07-03 19:48:50 -04:00
** haskell
#+BEGIN_SRC emacs-lisp
(use-package haskell-mode
:ensure t
:config
;; enable dynamic linking by default
(setq haskell-compile-command "ghc -dynamic -Wall -ferror-spans -fforce-recomp -c %s")
(setq haskell-interactive-popup-errors nil))
#+END_SRC
2018-03-21 21:44:31 -04:00
* org-mode
** basic
#+BEGIN_SRC emacs-lisp
2018-05-19 15:09:15 -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-07-01 21:16:50 -04:00
(setq org-modules '(org-habit))
2018-03-21 21:44:31 -04:00
#+END_SRC
2018-06-05 09:11:35 -04:00
** logging
#+BEGIN_SRC emacs-lisp
(setq org-log-into-drawer "LOGBOOK")
(setq org-log-done t)
#+END_SRC
2018-05-04 20:36:22 -04:00
** ui
*** bullets
#+BEGIN_SRC emacs-lisp
(use-package org-bullets
:ensure t
:config
(add-hook 'org-mode-hook (lambda () (org-bullets-mode))))
#+END_SRC
*** font height
2018-05-19 14:45:43 -04:00
The fonts in org headings bug me, make them smaller and less invasive
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
2018-05-19 14:45:43 -04:00
*** window splitting
Org mode is great and all, but the windows never show up in the right place
2018-05-19 17:39:36 -04:00
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
2018-05-19 14:45:43 -04:00
**** todo selection
I only need a teeny tiny window below my current window for todo selection
#+BEGIN_SRC emacs-lisp
2018-05-19 15:09:15 -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))))
2018-05-19 14:45:43 -04:00
2018-05-19 15:09:15 -04:00
(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))))))
2018-05-19 14:45:43 -04:00
2018-05-19 15:09:15 -04:00
(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice)
2018-05-19 14:45:43 -04:00
#+END_SRC
**** tag selection
By default, the tag selection window obliterates all but the current window...how disorienting :/
#+BEGIN_SRC emacs-lisp
2018-05-19 15:09:15 -04:00
(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))))
2018-05-19 14:45:43 -04:00
2018-05-19 15:09:15 -04:00
(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice)
2018-03-21 21:44:31 -04:00
#+END_SRC
2018-05-19 17:39:36 -04:00
**** 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
2018-05-19 14:59:58 -04:00
** src
*** basic
2018-03-21 21:44:31 -04:00
#+BEGIN_SRC emacs-lisp
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)
#+END_SRC
*** snippets
#+BEGIN_SRC emacs-lisp
(add-to-list 'org-structure-template-alist
'("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC"))
2018-03-21 21:44:31 -04:00
#+END_SRC
** keyboard shortcuts
*** navigation
#+BEGIN_SRC emacs-lisp
2018-05-19 14:59:58 -04:00
(setq org-special-ctrl-a/e t)
(setq org-special-ctrl-k t)
(setq org-yank-adjusted-subtrees t)
2018-03-21 21:44:31 -04:00
#+END_SRC
2018-05-04 20:36:22 -04:00
*** custom
#+BEGIN_SRC emacs-lisp
(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-04 20:36:22 -04:00
#+END_SRC
2018-05-13 20:15:00 -04:00
*** agenda
#+BEGIN_SRC emacs-lisp
(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
#+END_SRC
2018-03-21 21:44:31 -04:00
** todo states
*** sequences
#+BEGIN_SRC emacs-lisp
2018-05-19 15:09:15 -04:00
(setq org-todo-keywords
'((sequence "TODO(t)" "NEXT(n)" "|" "DONE(d)")
(sequence "WAIT(w@/!)" "HOLD(h@/ !)" "|" "CANC(c@/!)")))
2018-03-21 21:44:31 -04:00
#+END_SRC
*** colors
#+BEGIN_SRC emacs-lisp
(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
#+END_SRC
2018-04-24 23:37:37 -04:00
** tags
2018-05-04 20:36:22 -04:00
I use tags for agenda filtering. Very fast and simple.
Each tag here starts with a symbol to define its group. Some groups are mutually exclusive, and each group has a different color.
Any tag that is not part of these groups (eg some filetags in the few cases I use those) is easy to distinguish as it has the default tag color and is all caps.
There are several types of tags I use:
- location: a GTD contexts; these start with "@"
- tools: also a GTD contexts; these start with "#"
2018-05-15 22:55:11 -04:00
- attribute: useful flags for filtering; these start with "%"
2018-05-04 20:36:22 -04:00
- life areas: key areas of life which define priorities and goals; these start with "_"
2018-04-24 23:37:37 -04:00
#+BEGIN_SRC emacs-lisp
2018-05-19 15:09:15 -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.
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-04 20:36:22 -04:00
2018-05-19 15:09:15 -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)
2018-06-05 09:11:35 -04:00
("@travel" . ?r)
2018-05-19 15:09:15 -04:00
(:endgroup)
2018-06-05 09:11:35 -04:00
("#laptop" . ?l)
("#tcult" . ?t)
("#phone" . ?p)
2018-05-19 15:09:15 -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)))
2018-05-15 22:55:11 -04:00
2018-05-19 15:09:15 -04:00
(setq org-tag-faces '())
2018-05-15 22:55:11 -04:00
2018-05-19 15:09:15 -04:00
(nd/add-tag-face "PaleGreen" "@")
(nd/add-tag-face "SkyBlue" "#")
(nd/add-tag-face "PaleGoldenrod" "%")
(nd/add-tag-face "violet" "_")
2018-05-13 20:15:00 -04:00
2018-04-24 23:37:37 -04:00
#+END_SRC
** properties
#+BEGIN_SRC emacs-lisp
2018-05-19 15:36:04 -04:00
(add-to-list 'org-default-properties "PARENT_TYPE")
(add-to-list 'org-default-properties "OWNER")
(add-to-list 'org-default-properties "GOAL")
(add-to-list 'org-default-properties "TIME_SHIFT")
2018-05-04 20:36:22 -04:00
2018-05-19 15:36:04 -04:00
(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")))
;; TODO this may not be needed
(setq org-use-property-inheritance '("PARENT_TYPE" "TIME_SHIFT"))
2018-03-21 21:44:31 -04:00
#+END_SRC
2018-05-13 20:15:00 -04:00
** capture
2018-03-21 21:44:31 -04:00
#+BEGIN_SRC emacs-lisp
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
#+END_SRC
** refile
*** targets
#+BEGIN_SRC emacs-lisp
(setq org-refile-targets (quote ((nil :maxlevel . 9)
("~/Org/reference/idea.org" :maxlevel . 9)
(org-agenda-files :maxlevel . 9))))
#+END_SRC
*** completion
#+BEGIN_SRC emacs-lisp
2018-06-04 17:58:43 -04:00
(setq org-refile-use-outline-path t)
(setq org-outline-path-complete-in-steps t)
;; (setq org-completion-use-ido t)
2018-03-21 21:44:31 -04:00
#+END_SRC
*** node creation
#+BEGIN_SRC emacs-lisp
2018-04-08 01:10:01 -04:00
(setq org-refile-allow-creating-parent-nodes 'confirm)
2018-03-21 21:44:31 -04:00
#+END_SRC
*** use current window
#+BEGIN_SRC emacs-lisp
(setq org-indirect-buffer-display 'current-window)
#+END_SRC
*** exclude done states
#+BEGIN_SRC emacs-lisp
(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)
#+END_SRC
2018-07-01 21:16:50 -04:00
** habits
#+BEGIN_SRC emacs-lisp
2018-07-03 19:51:32 -04:00
(setq org-habit-graph-column 50)
2018-07-03 19:48:50 -04:00
#+END_SRC
** clocking
#+BEGIN_SRC emacs-lisp
2018-07-01 21:16:50 -04:00
#+END_SRC
2018-03-21 21:44:31 -04:00
** agenda
*** basic config
#+BEGIN_SRC emacs-lisp
2018-04-27 23:03:56 -04:00
(setq org-agenda-files '("~/Org"
2018-05-04 20:36:22 -04:00
"~/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
#+END_SRC
2018-06-21 22:35:03 -04:00
*** holidays and birthdays
#+BEGIN_SRC emacs-lisp
(setq holiday-bahai-holidays nil)
(setq holiday-hebrew-holidays nil)
(setq holiday-islamic-holidays nil)
#+END_SRC
2018-04-02 00:40:42 -04:00
*** task helper functions
These are the building blocks for skip functions.
2018-05-04 20:36:22 -04:00
**** timestamps
Each of these returns the timestamp if found.
2018-03-21 21:44:31 -04:00
#+BEGIN_SRC emacs-lisp
2018-06-21 22:35:03 -04:00
(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)))))
(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"))
(defun nd/is-closed-heading-p ()
(nd/get-date-property "CLOSED"))
(defun nd/is-stale-heading-p ()
(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))))
2018-05-04 20:36:22 -04:00
#+END_SRC
**** task level testing
2018-05-04 21:22:55 -04:00
Each of these returns the keyword if true
Doubles as a way to further test the todostate in downstream functions
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
(defun nd/is-todoitem-p ()
(let ((keyword (nth 2 (org-heading-components))))
(if (member keyword org-todo-keywords-1)
2018-03-24 18:13:54 -04:00
keyword)))
2018-05-04 20:36:22 -04:00
(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)))
2018-05-04 20:36:22 -04:00
(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-04 20:36:22 -04:00
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)))
2018-05-04 20:36:22 -04:00
(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 21:22:55 -04:00
#+END_SRC
**** property testing
Returns t is heading matches a certian set of properties
#+BEGIN_SRC emacs-lisp
(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 21:22:55 -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-04 20:36:22 -04:00
#+END_SRC
**** relational testing
2018-05-04 21:22:55 -04:00
Returns t if heading has certain relationship to other headings
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
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"
2018-05-04 22:18:04 -04:00
(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)))
2018-05-04 20:36:22 -04:00
#+END_SRC
**** project level testing
#+BEGIN_SRC emacs-lisp
2018-06-03 21:09:16 -04:00
(defconst nd/project-invalid-todostates
'("WAIT" "NEXT")
"projects cannot have these todostates")
2018-06-24 17:47:07 -04:00
2018-06-26 20:23:45 -04:00
(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list)
2018-06-18 22:19:07 -04:00
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
2018-06-24 17:47:07 -04:00
2018-06-26 20:23:45 -04:00
(defun nd/decend-into-project (allowed-statuscodes trans-tbl get-task-status)
2018-06-18 22:19:07 -04:00
(let ((project-status (first allowed-statuscodes))
(breaker-status (car (last allowed-statuscodes)))
(previous-point))
2018-06-24 17:47:07 -04:00
;; (message "hi")
2018-06-18 22:19:07 -04:00
(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))))
2018-06-24 17:47:07 -04:00
;; (message (format "%s" (concat "new status: " (symbol-name new-status))))
;; (message (format "%s" (concat "project status: " (symbol-name project-status))))
;; (message (format "%s" keyword))
2018-06-26 20:23:45 -04:00
(if (nd/compare-statuscodes > new-status project-status allowed-statuscodes)
2018-06-18 22:19:07 -04:00
(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")
2018-06-26 20:23:45 -04:00
(nd/decend-into-project
2018-06-18 22:19:07 -04:00
'(: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")
2018-06-26 20:23:45 -04:00
(nd/decend-into-project
2018-06-18 22:19:07 -04:00
'(: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")
2018-06-26 20:23:45 -04:00
(nd/decend-into-project
2018-06-18 22:19:07 -04:00
'(:undone-complete :stuck :held :waiting :active)
'((:complete . 0)
(:archivable . 0)
(:scheduled-project . 1)
(:invalid-todostate . 1)
(:done-incomplete . 1))
(lambda (k)
2018-06-26 20:23:45 -04:00
(cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1))
2018-06-18 22:19:07 -04:00
((equal k "HOLD") 2)
((equal k "WAIT") 3)
((equal k "NEXT") 4)
(t 0)))))
(t (error (concat "invalid keyword detected: " keyword))))))
2018-04-24 23:37:37 -04:00
#+END_SRC
2018-06-23 20:28:26 -04:00
**** iterator testing
#+BEGIN_SRC emacs-lisp
(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)
2018-06-24 12:36:12 -04:00
(subtree-end (save-excursion (org-end-of-subtree t))))
2018-06-23 20:28:26 -04:00
(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))
2018-06-26 20:23:45 -04:00
(if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes)
2018-06-23 20:28:26 -04:00
(setq iter-status new-status)))))
(outline-next-heading)))
iter-status))
#+END_SRC
2018-06-26 22:59:47 -04:00
**** periodical testing
#+BEGIN_SRC emacs-lisp
(defconst nd/peri-future-time nd/iter-future-time)
(defconst nd/peri-statuscodes '(:uninit :stale :fresh))
(defun nd/get-periodical-status ()
(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
2018-04-24 23:37:37 -04:00
*** skip functions
These are the primary means we use to sort through tasks. Note that we could do this with
tags in the custom commands section but I find this easier to maintain and possibly faster.
2018-05-13 20:15:00 -04:00
**** helper skip functions and macros
Subunits for skip functions. Not meant to be used or called from the custom commands api
2018-04-24 23:37:37 -04:00
#+BEGIN_SRC emacs-lisp
2018-05-04 21:22:55 -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
2018-05-04 20:36:22 -04:00
'("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 21:22:55 -04:00
(nd/skip-heading)))))
2018-05-13 20:15:00 -04:00
#+END_SRC
2018-05-15 22:55:11 -04:00
**** headings
Skip functions for headings which may or may
not be todo-items
2018-05-04 20:36:22 -04:00
2018-05-15 22:55:11 -04:00
Note in the case of stale headings that
2018-05-13 20:15:00 -04:00
I only care about those that are not part
of projects (projects will get taken care
of when the entire project is finished)
and those that are not DONE/CANC (as
those appear in the regular archive
section)
#+BEGIN_SRC emacs-lisp
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)))))
2018-05-04 20:36:22 -04:00
(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))))
2018-05-04 21:22:55 -04:00
(nd/skip-heading)))))
2018-04-24 23:37:37 -04:00
2018-05-13 20:15:00 -04:00
#+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
;; 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)
2018-05-04 20:36:22 -04:00
(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)
2018-05-04 20:36:22 -04:00
(nd/is-archivable-heading-p))))
2018-05-13 20:15:00 -04:00
#+END_SRC
**** periodicals
These are headers marked with PARENT_TYPE=periodical
property that have timestamped headers as children
which in turn may or may not have todo keywords.
They are to be refilled when all children are stale
Note that I only care about the parent headers
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
2018-06-26 22:59:47 -04:00
(defun nd/skip-non-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/skip-heading))))
2018-05-13 20:15:00 -04:00
2018-06-26 22:59:47 -04:00
(defun nd/skip-non-periodical-untimestamped ()
(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))))
2018-05-13 20:15:00 -04:00
#+END_SRC
2018-06-24 12:36:12 -04:00
**** iterators
iterators are like projects but have additional status codes based on
when the iterator will run out
#+BEGIN_SRC emacs-lisp
(defun nd/skip-non-iterator-parent-headers ()
(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 ()
(nd/skip-heading-with
nd/is-atomic-task-p
(not (or (nd/is-scheduled-heading-p)
(nd/is-deadlined-heading-p)))))
#+END_SRC
2018-05-13 20:15:00 -04:00
**** project tasks
Since these are part of projects I need to assess
if the parent project is skippable, in which case
I jump to the next subtree
Note that I only care about the keyword 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)
#+BEGIN_SRC emacs-lisp
2018-06-05 09:11:35 -04:00
(defun nd/skip-non-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))
2018-06-26 23:02:21 -04:00
(if (not (nd/heading-has-parent 'nd/is-todoitem-p))
2018-06-05 09:11:35 -04:00
(nd/skip-heading)))
(nd/skip-heading)))))
2018-05-13 20:15:00 -04:00
#+END_SRC
**** header-level errors
Some headers are invalid under certain conditions
which I test here
#+BEGIN_SRC emacs-lisp
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-06-24 12:36:12 -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))))
#+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 iterators
#+BEGIN_SRC emacs-lisp
2018-06-27 21:12:46 -04:00
(defun nd/skip-non-projects (&optional ignore-toplevel)
2018-06-18 22:19:07 -04:00
(save-restriction
(widen)
(let ((keyword (nd/is-project-p)))
(if keyword
(if (and nd/agenda-limit-project-toplevel
2018-06-27 21:12:46 -04:00
(not ignore-toplevel)
2018-06-18 22:19:07 -04:00
(nd/heading-has-parent 'nd/is-todoitem-p))
(nd/skip-subtree))
(nd/skip-heading)))))
2018-04-24 23:37:37 -04:00
#+END_SRC
*** interactive view functions
#+BEGIN_SRC emacs-lisp
2018-06-05 09:11:35 -04:00
(defvar nd/agenda-limit-project-toplevel t
"used to filter projects by all levels or top-level only")
2018-04-24 23:37:37 -04:00
2018-06-05 09:11:35 -04:00
(defvar nd/agenda-hide-incubator-tags t
"used to filter incubator headings")
2018-05-13 20:15:00 -04:00
2018-06-05 09:11:35 -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)
(org-agenda-redo))
(message "Showing %s project view in agenda"
(if nd/agenda-limit-project-toplevel "toplevel" "complete")))
2018-05-13 20:15:00 -04:00
2018-06-05 09:11:35 -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
2018-06-05 09:11:35 -04:00
(defun nd/org-agenda-filter-non-context ()
2018-05-16 23:04:34 -04:00
"A quick and dirty agenda filter that removes all
2018-06-05 09:11:35 -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)))
2018-05-04 20:36:22 -04:00
#+END_SRC
2018-06-05 09:11:35 -04:00
*** agenda aesthetics
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
2018-06-03 21:09:16 -04:00
(setq org-agenda-tags-todo-honor-ignore-options t)
(setq org-agenda-prefix-format
'((agenda . " %-12:c %-5:e %?-12t% s")
(timeline . " % s")
(todo . " %-12:c")
(tags . " %-12:c %-5:e ")
(search . " %-12:c")))
(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-05 09:11:35 -04:00
#+END_SRC
*** custom commands
#+BEGIN_SRC emacs-lisp
2018-06-24 12:36:12 -04:00
(defun nd/org-agenda-filter-status (filter status-fun a-line)
2018-06-24 17:47:07 -04:00
"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"
2018-06-18 22:19:07 -04:00
(let* ((m (get-text-property 1 'org-marker a-line))
(s (with-current-buffer (marker-buffer m)
(goto-char m)
2018-06-24 12:36:12 -04:00
(funcall status-fun))))
2018-06-18 22:19:07 -04:00
(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))))
2018-06-05 09:11:35 -04:00
(defun nd/agenda-base-header-cmd (match header skip-fun)
2018-06-03 21:09:16 -04:00
`(tags
,match
((org-agenda-overriding-header ,header)
(org-agenda-skip-function ,skip-fun)
(org-agenda-sorting-strategy '(category-keep)))))
2018-06-05 09:11:35 -04:00
(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort)
2018-06-03 21:09:16 -04:00
(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))))
2018-06-05 09:11:35 -04:00
(let* ((actionable "-NA-REFILE-%inc")
(periodical "PARENT_TYPE=\"periodical\"")
(iterator "PARENT_TYPE=\"iterator\"")
2018-07-01 21:16:50 -04:00
(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 "/!")))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
(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)))
2018-06-05 09:11:35 -04:00
,(nd/agenda-base-task-cmd act-no-rep-match
2018-06-03 21:09:16 -04:00
"Project Tasks"
''nd/skip-non-project-tasks
''(user-defined-up category-keep))
2018-06-05 09:11:35 -04:00
,(nd/agenda-base-task-cmd act-no-rep-match
2018-06-03 21:09:16 -04:00
"Atomic Tasks"
''nd/skip-non-atomic-tasks)))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("p"
"Project View"
2018-06-24 17:47: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
2018-06-26 20:23:45 -04:00
(lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
2018-06-24 17:47:07 -04:00
(org-agenda-cmp-user-defined
2018-06-26 20:23:45 -04:00
(lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
a b)))
2018-06-24 17:47:07 -04:00
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("P"
"Periodical View"
2018-06-26 22:59:47 -04:00
((tags
2018-07-01 21:16:50 -04:00
(concat actionable "-" iterator "+" periodical "-" habit)
2018-06-26 22:59:47 -04:00
((org-agenda-overriding-header "Periodical Status")
(org-agenda-skip-function '(nd/skip-non-periodical-parent-headers))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status
nd/peri-statuscodes 'nd/get-periodical-status l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop
'project-status nd/peri-statuscodes a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))
,(nd/agenda-base-header-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\""
"Untimestamped"
''nd/skip-non-periodical-untimestamped)))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("i"
"Iterator View"
2018-06-24 12:36:12 -04:00
((tags
"-NA-REFILE+PARENT_TYPE=\"iterator\""
((org-agenda-overriding-header "Iterator Status")
(org-agenda-skip-function '(nd/skip-non-iterator-parent-headers))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status nd/iter-statuscodes 'nd/get-iterator-status l)))
(org-agenda-cmp-user-defined
(lambda (a b) (nd/org-agenda-sort-prop 'project-status nd/iter-statuscodes a b)))
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))
,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/ !"
"Unscheduled or Undeaded"
''nd/skip-non-iterator-unscheduled)))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("I"
"Incubator View"
((agenda "" ((org-agenda-span 7)
(org-agenda-time-grid nil)
(org-agenda-entry-types '(:deadline :timestamp))))
2018-06-05 09:11:35 -04:00
,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/ !"
"Incubated Tasks"
''nd/skip-non-atomic-tasks)
2018-06-24 17:47:07 -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
2018-06-26 20:23:45 -04:00
(lambda (l) (nd/org-agenda-filter-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:held :active)
'nd/get-project-status l)))
2018-06-24 17:47:07 -04:00
(org-agenda-cmp-user-defined
2018-06-26 20:23:45 -04:00
(lambda (a b) (nd/org-agenda-sort-prop
'project-status
'(:scheduled-project :invalid-todostate :undone-complete
:done-incomplete :stuck :waiting
:active :held)
a b)))
2018-06-24 17:47:07 -04:00
(org-agenda-prefix-format '((tags . " %-12:c %(format \"xxxx: \")")))
(org-agenda-sorting-strategy '(user-defined-down category-keep))))))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("r"
2018-06-24 17:47:07 -04:00
"Refile and Critical Errors"
2018-06-03 21:09:16 -04:00
((tags "REFILE"
((org-agenda-overriding-header "Tasks to Refile"))
(org-tags-match-list-sublevels nil))
2018-06-05 09:11:35 -04:00
,(nd/agenda-base-task-cmd task-match
"Discontinous Project"
2018-06-26 20:23:45 -04:00
''nd/skip-non-discontinuous-project-tasks)
,(nd/agenda-base-header-cmd task-match
2018-06-05 09:11:35 -04:00
"Undone Closed"
''nd/skip-non-undone-closed-todoitems)
,(nd/agenda-base-header-cmd (concat actionable "-" periodical)
"Done Unclosed"
2018-06-26 20:23:45 -04:00
''nd/skip-non-done-unclosed-todoitems)))
2018-06-05 09:11:35 -04:00
2018-06-03 21:09:16 -04:00
("A"
"Archivable Tasks and Projects"
2018-07-01 21:16:50 -04:00
(,(nd/agenda-base-header-cmd (concat actionable "-" periodical "-" habit)
2018-06-26 22:59:47 -04:00
"Archivable Atomic Tasks and Iterators"
2018-06-05 09:11:35 -04:00
''nd/skip-non-archivable-atomic-tasks)
2018-07-01 21:16:50 -04:00
,(nd/agenda-base-header-cmd (concat actionable "-" habit)
2018-06-26 22:59:47 -04:00
"Stale Tasks and Periodicals"
2018-06-05 09:11:35 -04:00
''nd/skip-non-stale-headings)
2018-06-24 17:47:07 -04:00
(tags-todo
2018-07-01 21:16:50 -04:00
,(concat actionable "-" periodical "-" iterator "-" habit)
2018-06-24 17:47:07 -04:00
((org-agenda-overriding-header
2018-06-27 21:12:46 -04:00
(concat (and nd/agenda-limit-project-toplevel "Toplevel ")
2018-06-24 17:47:07 -04:00
"Archivable Projects"))
(org-agenda-skip-function '(nd/skip-non-projects))
(org-agenda-before-sorting-filter-function
(lambda (l) (nd/org-agenda-filter-status '(:archivable) 'nd/get-project-status 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-19 01:22:11 -04:00
#+END_SRC
2018-04-08 21:54:20 -04:00
*** views
**** calendar display
2018-04-02 00:40:42 -04:00
#+BEGIN_SRC emacs-lisp
2018-06-03 21:09:16 -04:00
(setq org-agenda-start-on-weekday 0)
(setq org-agenda-span 'day)
(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
#+End_src
**** right align tags
the agenda does not do this by default...it's annoying
2018-04-02 00:40:42 -04:00
#+BEGIN_SRC emacs-lisp
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))
#+END_SRC
*** auto exclusion
#+BEGIN_SRC emacs-lisp
(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
#+END_SRC
2018-05-19 14:59:58 -04:00
** column view
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
(setq org-columns-default-format
2018-05-13 20:15:00 -04:00
"%25ITEM %4TODO %TAGS %5Effort{:} %OWNER(OWN)")
2018-05-04 20:36:22 -04:00
(set-face-attribute 'org-column nil :background "#1e2023")
;; org-columns-summary-types
#+END_SRC
2018-05-19 17:39:36 -04:00
** interactive commands
2018-05-04 20:36:22 -04:00
#+BEGIN_SRC emacs-lisp
2018-05-19 15:36:04 -04:00
(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")))
(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
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")
2018-06-05 09:11:35 -04:00
(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))))))
2018-05-19 15:36:04 -04:00
(error (message "%s" (error-message-string err))))))
2018-06-05 09:11:35 -04:00
(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-05-04 20:36:22 -04:00
#+END_SRC
2018-03-21 21:44:31 -04:00
** caldav
+BEGIN_SRC emacs-lisp
(use-package org-caldav
:ensure t
:config (org-caldav-url "https://portnoy4prez.yavin4.ch/nextcloud/remote.php/dav/calendars/petrucci4prez/concerts/ "
org-cladav-calendar-id "testorg"
org-caldav-inbox "~/Org/reference/testcal.org"))
#+END_SRC
** calfw
#+BEGIN_SRC emacs-lisp
(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 ?┓))
#+END_SRC
* shell
#+begin_src emacs-lisp
(defvar nd-term-shell "/bin/bash")
(defadvice ansi-term (before force-bash)
(interactive (list nd-term-shell)))
(ad-activate 'ansi-term)
#+END_SRC
* ediff
#+BEGIN_SRC emacs-lisp
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
#+END_SRC
