4598 lines
193 KiB
Org Mode
4598 lines
193 KiB
Org Mode
This is my personal emacs config. It is quite massive. Please use the table of contents below for easy navigation ;)
|
||
|
||
* table of contents :TOC:
|
||
- [[#overview][overview]]
|
||
- [[#features-and-use-cases][features and use cases]]
|
||
- [[#for-new-users][for new users]]
|
||
- [[#config-structure][config structure]]
|
||
- [[#library][library]]
|
||
- [[#macros][macros]]
|
||
- [[#functions][functions]]
|
||
- [[#interactive][interactive]]
|
||
- [[#user-interface][user interface]]
|
||
- [[#theme][theme]]
|
||
- [[#modeline][modeline]]
|
||
- [[#remove-interface-bars][remove interface bars]]
|
||
- [[#startup-screen][startup screen]]
|
||
- [[#windows][windows]]
|
||
- [[#navigation][navigation]]
|
||
- [[#cursor][cursor]]
|
||
- [[#misc][misc]]
|
||
- [[#low-level-config][low-level config]]
|
||
- [[#autosave][autosave]]
|
||
- [[#async][async]]
|
||
- [[#editing][editing]]
|
||
- [[#standardization][standardization]]
|
||
- [[#auto-completion][auto completion]]
|
||
- [[#undo][undo]]
|
||
- [[#parenthesis-matching][parenthesis matching]]
|
||
- [[#sudo-edit][sudo edit]]
|
||
- [[#formats-and-languages][formats and languages]]
|
||
- [[#org-mode][org-mode]]
|
||
- [[#low-level-config-1][low-level config]]
|
||
- [[#buffer-interface][buffer interface]]
|
||
- [[#extra-commands][extra commands]]
|
||
- [[#calfw][calfw]]
|
||
- [[#window-splitting][window splitting]]
|
||
- [[#exporting][exporting]]
|
||
- [[#gantt-charts][gantt charts]]
|
||
- [[#gtd-implementation][gtd implementation]]
|
||
- [[#gtd-next-generation][gtd next generation]]
|
||
- [[#tools][tools]]
|
||
- [[#printing][printing]]
|
||
- [[#magit][magit]]
|
||
- [[#dired][dired]]
|
||
- [[#mu4e][mu4e]]
|
||
- [[#shell][shell]]
|
||
- [[#ediff][ediff]]
|
||
- [[#keybindings][keybindings]]
|
||
- [[#setup][setup]]
|
||
- [[#whichkey][whichkey]]
|
||
- [[#evil][evil]]
|
||
- [[#local][local]]
|
||
- [[#global][global]]
|
||
|
||
* overview
|
||
** features and use cases
|
||
- full [[https://en.wikipedia.org/wiki/Getting_Things_Done][GTD]] implementation with =org-mode= to help me stay organized
|
||
- unified interface for common linux tools (dired, shell, git, ediff)
|
||
- fully customizable email client with =mu4e=
|
||
- optimizations for some of my favorite languages (R, Lisp, Haskell, Lua, Python)
|
||
- document preparation with latex
|
||
** for new users
|
||
Feel free to take bits and pieces for your own configuration file. Like many things in emacs, the config file is quite self documenting; however, there are some useful ramblings that decribe why I made some design choices over others. As someone who learned from countless emacs configs of other experienced users, I thought it was extremely beneficial to see the thought process behind their workflow and code, and I hope my annotations pay that forward. Finally, please don't just blindly copy this config into your =~/.emacs.d=. I don't care if you do, but you will learn more if you build from scratch.
|
||
** config structure
|
||
The "config file" is actually two files.
|
||
|
||
The "root" is =init.el= which is the file explicitly loaded by emacs. Most users have their entire config in this file but I put most of my actuall settings in another file as explained in the next paragraph. Here =init.el= has minimum functionality, including setting the repositories, configuring =use-package= (which installs all other packages and ensures they are available, useful if I move this elsewhere), and load paths for other config file.
|
||
|
||
Once loaded, the =init.el= pulls in another file called =conf.el= with the function =org-babel-load-file=. =conf.el= is actually sourced from an [[https://en.wikipedia.org/wiki/Org-mode][org]] file called =conf.org=.
|
||
|
||
Using an org file like this offers several advantages. First, org files are foldable in emacs which makes navigation easy. Second, they allow code snippets (the bit that actually go into =conf.el=) which allows for explanatory prose to be written around them, making documentation easy and clear. Third, =org-mode= has an automatic table of contents through the =toc-org= package, which makes naviagation even easier. Fourth, github itself is awesome enough to recognize org files as valid markdown and will render all the text, code snippets, headers, and table of contents in the nice html that you are reading now if on github. The result is a nearly self-documenting, self-organizing configuration that is easy to maintain and also easy to view for other users. Using the =init.el= itself would just have plain eLisp, which gets cluttered quickly. Some people break the =init.el= down into multiple files to keep everything sane, but I personally think it is easier to use one giant file that itself can be folded and abstracted to reduce the clutter.
|
||
* library
|
||
This is code that is used generally throughout the emacs config
|
||
** 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
|
||
** functions
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/filter-list-prefix (prefix str-list)
|
||
"Return a subset of STR-LIST whose first characters are PREFIX."
|
||
(seq-filter (lambda (i)
|
||
(and (stringp i)
|
||
(string-prefix-p prefix i)))
|
||
str-list))
|
||
|
||
(defun nd/move-key (keymap-from keymap-to key)
|
||
"Move KEY from KEYMAP-FROM keymap to KEYMAP-TO keymap."
|
||
(define-key keymap-to key (lookup-key keymap-from key))
|
||
(define-key keymap-from key nil))
|
||
|
||
(defun nd/get-apps-from-mime (mimetype)
|
||
"Return all applications that can open a given MIMETYPE.
|
||
The list is comprised of alists where pairs are of the form (name . command)."
|
||
(let* ((case-fold-search nil)
|
||
(mime-regex (concat "^MimeType=.*" mimetype ";.*$"))
|
||
(desktop-dirs '("/usr/share/applications"
|
||
"/usr/local/share/applications"
|
||
"~/.local/share/applications"))
|
||
(desktop-files (mapcan (lambda (d) (directory-files d t ".*\\.desktop" t)) desktop-dirs))
|
||
(app-list))
|
||
(dolist (file desktop-files app-list)
|
||
(with-temp-buffer
|
||
(insert-file-contents file)
|
||
(let* ((tb (buffer-string)))
|
||
(if (string-match mime-regex tb)
|
||
(let* ((exec (progn (string-match "^Exec=\\(.*\\)$" tb)
|
||
(match-string 1 tb)))
|
||
(name (or
|
||
(progn (string-match "^Name=\\(.*\\)$" tb)
|
||
(match-string 1 tb))
|
||
exec)))
|
||
(setq app-list (cons `(,name . ,exec) app-list)))))))))
|
||
|
||
(defun nd/get-apps-bulk-from-mime (mimetype)
|
||
"Like `nd/get-apps-from-mime' but only includes apps that can open
|
||
multiple files at once for given MIMETYPE."
|
||
(let ((case-fold-search nil))
|
||
(seq-filter (lambda (a) (string-match ".*%[FU].*" (car a))) (nd/get-apps-from-mime mimetype))))
|
||
|
||
(defun nd/execute-desktop-command (cmd file)
|
||
"Opens FILE using CMD in separate process where CMD is from a
|
||
desktop file exec directive."
|
||
(let* ((cmd-arg (replace-regexp-in-string "%[fuFU]" file cmd t t)))
|
||
(call-process-shell-command (concat cmd-arg " &"))))
|
||
|
||
(defun nd/get-mime-type (file)
|
||
"Get the mime type of FILE."
|
||
(let* ((cmd (concat "file --mime-type -b " file))
|
||
(mt (shell-command-to-string cmd)))
|
||
(replace-regexp-in-string "\n\\'" "" mt)))
|
||
|
||
(defvar nd/device-mount-dir (concat "/media/" (user-login-name)))
|
||
|
||
(defun nd/get-mounted-directories (&optional mount-path)
|
||
"Scan MOUNT-PATH (defaults to /media/$USER for devices that have
|
||
been mounted by udevil."
|
||
(seq-filter #'file-directory-p (directory-files nd/device-mount-dir t "^\\([^.]\\|\\.[^.]\\|\\.\\..\\)")))
|
||
|
||
(defun nd/device-mountable-p (devpath)
|
||
"Returns label or uuid if device at DEVPATH is has a readable
|
||
filesystem and is a usb drive."
|
||
(let ((devprops (shell-command-to-string (concat "udevadm info --query=property " devpath))))
|
||
(and (string-match-p (regexp-quote "ID_FS_TYPE") devprops)
|
||
(string-match-p (regexp-quote "ID_BUS=usb") devprops)
|
||
(progn
|
||
(or (string-match "ID_FS_LABEL=\\(.*\\)\n" devprops)
|
||
(string-match "ID_FS_UUID=\\(.*\\)\n" devprops))
|
||
(match-string 1 devprops)))))
|
||
|
||
(defun nd/get-mountable-devices ()
|
||
"Return paths of all mountable devices. (see `nd/device-mountable-p')."
|
||
(seq-filter #'car
|
||
(mapcar (lambda (d) `(,(nd/device-mountable-p d) . ,d))
|
||
(directory-files "/dev" t "sd.[0-9]+"))))
|
||
|
||
(defun nd/mount-device (dev &rest opts)
|
||
"Mount device DEV using udevil."
|
||
(call-process "udevil" nil nil nil "mount" dev))
|
||
|
||
(defun nd/get-mountpoint (dev)
|
||
"Get the filesystem mountpoint for device DEV."
|
||
(let ((mp (shell-command-to-string (concat "printf %s \"$(findmnt -n -o TARGET " dev ")\""))))
|
||
(and (not (equal "" mp)) mp)))
|
||
|
||
(defun nd/print-args (orig-fun &rest args)
|
||
"Prints ARGS of ORIG-FUN. Intended as :around advice."
|
||
(print args)
|
||
(apply orig-fun args))
|
||
|
||
(defun nd/plist-put-append (plist prop value &optional front)
|
||
"Like `plist-put' but append VALUE to current values in PLIST for PROP.
|
||
If FRONT is t, append to the front of current values instead of the back."
|
||
(let* ((cur (plist-get plist prop))
|
||
(new (if front (append value cur) (append cur value))))
|
||
(plist-put plist prop new)))
|
||
|
||
(defun nd/plist-put-list (plist prop value &optional front)
|
||
"Like `plist-put' but append (list VALUE) to current values in PLIST for PROP.
|
||
If FRONT is t, do to the front of current values instead of the back."
|
||
(let* ((cur (plist-get plist prop))
|
||
(new (if front (append (list value) cur) (append cur (list value)))))
|
||
(plist-put plist prop new)))
|
||
|
||
(defun nd/strip-string (str)
|
||
"Remove text properties and trim STR and return the result."
|
||
(when str (string-trim (substring-no-properties str))))
|
||
#+END_SRC
|
||
** interactive
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/split-and-follow-horizontally ()
|
||
"Split window horizontally and move focus."
|
||
(interactive)
|
||
(split-window-below)
|
||
(balance-windows)
|
||
(other-window 1))
|
||
|
||
(defun nd/split-and-follow-vertically ()
|
||
"Split window vertically and move focus."
|
||
(interactive)
|
||
(split-window-right)
|
||
(balance-windows)
|
||
(other-window 1))
|
||
|
||
(defun nd/switch-to-previous-buffer ()
|
||
"Switch the buffer to the last opened buffer."
|
||
(interactive)
|
||
(switch-to-buffer (other-buffer (current-buffer) 1)))
|
||
|
||
(defun nd/config-reload ()
|
||
"Reloads main configuration file at runtime."
|
||
(interactive)
|
||
(org-babel-load-file nd/conf-main))
|
||
|
||
(defun nd/config-visit ()
|
||
"Opens the main conf.org file (the one that really matters)."
|
||
(interactive)
|
||
(find-file nd/conf-main))
|
||
|
||
(defun nd/kill-current-buffer ()
|
||
"Kill the current buffer."
|
||
(interactive)
|
||
(kill-buffer (current-buffer)))
|
||
|
||
(defun nd/close-all-buffers ()
|
||
"Kill all buffers without regard for their origin."
|
||
(interactive)
|
||
(mapc 'kill-buffer (buffer-list)))
|
||
|
||
(defun nd/org-close-all-buffers ()
|
||
"Kill all org buffers."
|
||
(interactive)
|
||
(mapc 'kill-buffer (org-buffer-list)))
|
||
|
||
(defun nd/open-urxvt ()
|
||
"Launch urxvt in the current directory."
|
||
(interactive)
|
||
(let ((cwd (expand-file-name default-directory)))
|
||
(call-process "urxvt" nil 0 nil "-cd" cwd)))
|
||
#+END_SRC
|
||
* user interface
|
||
The general look and feel, as well as interactive functionality
|
||
** theme
|
||
This theme has good functionality for many different modes without being over-the-top or overly complex. It also comes with an easy way to set custom colors.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package spacemacs-theme
|
||
:ensure t
|
||
:defer t
|
||
:config
|
||
(setq spacemacs-theme-custom-colors '((lnum . "#64707c"))))
|
||
#+END_SRC
|
||
|
||
Since I run emacs in [[https://www.gnu.org/software/emacs/manual/html_node/emacs/Emacs-Server.html][client/server]] mode, the loaded theme can change depending on if the client is a terminal or server (terminals have far fewer colors). This makes the theme reset when terminal is loaded before gui or vice versa.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defvar nd/theme 'spacemacs-dark)
|
||
(defvar nd/theme-window-loaded nil)
|
||
(defvar nd/theme-terminal-loaded nil)
|
||
|
||
;; required for emacsclient/daemon setup
|
||
(if (daemonp)
|
||
(add-hook 'after-make-frame-functions
|
||
(lambda (frame)
|
||
(select-frame frame)
|
||
(if (window-system frame)
|
||
(unless nd/theme-window-loaded
|
||
(if nd/theme-terminal-loaded
|
||
(enable-theme nd/theme)
|
||
(load-theme nd/theme t))
|
||
(setq nd/theme-window-loaded t))
|
||
(unless nd/theme-terminal-loaded
|
||
(if nd/theme-window-loaded
|
||
(enable-theme nd/theme)
|
||
(load-theme nd/theme t))
|
||
(setq nd/theme-terminal-loaded t)))))
|
||
(progn
|
||
(load-theme nd/theme t)
|
||
(if (display-graphic-p)
|
||
(setq nd/theme-window-loaded t)
|
||
(setq nd/theme-terminal-loaded t))))
|
||
#+END_SRC
|
||
** modeline
|
||
This modeline goes along with the =spacemacs-theme=. It also has nice integration with =evil-mode= (see keybindings below).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package spaceline
|
||
:ensure t
|
||
:config
|
||
(require 'spaceline-config)
|
||
(setq powerline-default-separator 'arrow
|
||
spaceline-buffer-size-p nil
|
||
spaceline-buffer-encoding-abbrev-p nil)
|
||
(spaceline-spacemacs-theme))
|
||
|
||
(line-number-mode 1)
|
||
(column-number-mode 1)
|
||
#+END_SRC
|
||
*** delight
|
||
I like to keep the modeline clean and uncluttered. This package prevents certain mode names from showing in the modeline (it also has support for =use-package= through the =:delight= keyword)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package delight
|
||
:ensure t)
|
||
#+END_SRC
|
||
** remove interface bars
|
||
Emacs comes with some useless garbage by default. IMHO (in my haughty opinion), text editors should be boxes with text in them. No menu bars, scroll bars, or toolbars (and certainly no ribbons).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(tool-bar-mode -1)
|
||
(menu-bar-mode -1)
|
||
(scroll-bar-mode -1)
|
||
#+END_SRC
|
||
** startup screen
|
||
I don't need the startup screen; scratch buffer is fine. This may change in the future.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq inhibit-startup-screen t)
|
||
#+END_SRC
|
||
** windows
|
||
*** popup windows
|
||
Some modes like to make popup windows (eg ediff). This prevents that.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq pop-up-windows nil)
|
||
#+END_SRC
|
||
*** ace-window
|
||
This is an elegant window selector. It displays a number in the corner when activated, and windows may be chosen by pressing the corresponding number. Note that spacemacs fails to make the numbers look nice so the theme code is a workaround to make them smaller and prettier.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package ace-window
|
||
:ensure t
|
||
:config
|
||
(setq aw-background t)
|
||
(custom-set-faces '(aw-leading-char-face
|
||
((t (:foreground "#292b2e"
|
||
:background "#bc6ec5"
|
||
:height 1.0
|
||
:box nil))))))
|
||
#+END_SRC
|
||
** navigation
|
||
*** helm
|
||
One of the best packages for emacs. Helm is basically a search and completion engine (other exanples being =ido-mode= and =ivy-mode=) which is mainly used for finding files and selecting commands (which are obviously used often). It also integrates well with many other modes such as =evil-mode= and =org-mode=.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package helm
|
||
:ensure t
|
||
:delight
|
||
:init
|
||
(helm-mode 1)
|
||
:config
|
||
(setq helm-autoresize-max-height 0
|
||
helm-autoresize-max-height 40
|
||
helm-M-x-fuzzy-match t
|
||
helm-buffers-fuzzy-matching t
|
||
helm-recentf-fuzzy-match t
|
||
helm-semantic-fuzzy-match t
|
||
helm-imenu-fuzzy-match t
|
||
helm-scroll-amount 8)
|
||
(add-to-list 'display-buffer-alist
|
||
`(,(rx bos "*helm" (* not-newline) "*" eos)
|
||
(display-buffer-in-side-window)
|
||
(inhibit-same-window . t)
|
||
(window-height . 0.4)))
|
||
(helm-autoresize-mode 1)
|
||
(require 'helm-config))
|
||
#+END_SRC
|
||
*** helm-swoop
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package helm-swoop
|
||
:ensure t)
|
||
#+END_SRC
|
||
*** avy
|
||
Allows jumping to any character in any window with a few keystrokes. Goodbye mouse :)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package avy
|
||
:ensure t
|
||
:config
|
||
(setq avy-background t))
|
||
#+END_SRC
|
||
** cursor
|
||
This makes a nice glowy effect on the cursor when switching window focus. Very elegant way of saving time in finding where you left off.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package beacon
|
||
:ensure t
|
||
:delight
|
||
:init
|
||
(beacon-mode 1))
|
||
#+END_SRC
|
||
** misc
|
||
*** line wrap
|
||
I don't like line wrap
|
||
#+BEGIN_SRC emacs-lisp
|
||
(set-default 'truncate-lines t)
|
||
#+END_SRC
|
||
*** smooth scrolling
|
||
This makes scrolling smoother
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq scroll-conservatively 100)
|
||
#+END_SRC
|
||
*** imagemagick
|
||
#+BEGIN_SRC emacs-lisp
|
||
(when (fboundp 'imagemagick-register-types)
|
||
(imagemagick-register-types))
|
||
#+END_SRC
|
||
*** yes-no prompt
|
||
Some prompts require literal "yes" or "no" to decide action. Life is short and I would rather not waste keystrokes typing whole words. This makes all "yes/no" prompts only require "y" or "n."
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defalias 'yes-or-no-p 'y-or-n-p)
|
||
#+END_SRC
|
||
* low-level config
|
||
General configuation for behind-the-scenes behavior
|
||
** autosave
|
||
Saving files continuously is actually really annoying and clutters my disk. Turn it off.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq make-backup-files nil)
|
||
(setq auto-save-default nil)
|
||
#+END_SRC
|
||
** async
|
||
Allows certain processes to run in multithreaded manner. For things like IO this makes sense.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package async
|
||
:ensure t
|
||
:delight dired-async-mode
|
||
:init
|
||
(dired-async-mode 1))
|
||
#+END_SRC
|
||
* editing
|
||
For options that specifically affect programming or editing modes
|
||
** standardization
|
||
*** tabs and alignment
|
||
Who uses tabs in their programs? Make tabs actually equal 4 spaces. Also, alledgedly I could [[https://stackoverflow.blog/2017/06/15/developers-use-spaces-make-money-use-tabs/][make more money]] if I use spaces :)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq-default indent-tabs-mode nil
|
||
tab-width 4)
|
||
#+END_SRC
|
||
*** short column width
|
||
Alot of languages at least semi-adhere to the 80-characters-per-line rule. =fci-mode= displays a line as a guide for column width.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package fill-column-indicator
|
||
:ensure t
|
||
:config
|
||
(setq fci-rule-use-dashes t)
|
||
:hook
|
||
(prog-mode . fci-mode))
|
||
#+END_SRC
|
||
*** spell checking
|
||
I use the built-in =flyspell-mode= to handle spellchecking. Obviously I am going to use =helm= when I spellcheck something.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package flyspell-correct-helm
|
||
:ensure t
|
||
:after (helm flyspell))
|
||
#+END_SRC
|
||
|
||
This will spell-check comments in programming languages.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'prog-mode-hook #'flyspell-prog-mode)
|
||
(setq flyspell-issue-message-flag nil)
|
||
#+END_SRC
|
||
|
||
Since flyspell mode is enabled in so many buffers, use a short modeline alias.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(delight 'flyspell-mode "λ" "flyspell")
|
||
#+END_SRC
|
||
|
||
Additionally, I want to automatically highlight errors whenever =flyspell-mode= is enabled.
|
||
#+BEGIN_SRC emacs-lisp
|
||
;; (add-hook 'flyspell-mode-hook 'flyspell-buffer)
|
||
#+END_SRC
|
||
*** syntax checking
|
||
Flycheck will highlight and explain syntax errors in code and formatting.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package flycheck
|
||
:ensure t
|
||
:hook
|
||
(prog-mode . flycheck-mode)
|
||
:config
|
||
(setq flycheck-check-syntax-automatically '(save
|
||
idle-change
|
||
mode-enabled)
|
||
flycheck-idle-change-delay 2
|
||
flycheck-error-list-minimum-level 'warning
|
||
flycheck-navigation-minimum-level 'warning)
|
||
(delight 'flycheck-mode "γ" "flycheck"))
|
||
#+END_SRC
|
||
** auto completion
|
||
Company provides a dropdown of completion options. It has many backends which are configured in each language and format elsewhere.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package company
|
||
:ensure t
|
||
:delight " ©"
|
||
:config
|
||
(setq company-idle-delay 0
|
||
company-minimum-prefix-length 3))
|
||
#+END_SRC
|
||
*** yasnippet
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package yasnippet
|
||
:ensure t)
|
||
|
||
(use-package yasnippet-snippets
|
||
:ensure t
|
||
:after yasnippet
|
||
:hook
|
||
((prog-mode . yas-minor-mode))
|
||
:config
|
||
(yas-reload-all))
|
||
#+END_SRC
|
||
** undo
|
||
I find it weird that most programs do not have a tree-like tool to navigate undo information...because this is literally how most programs store this data.
|
||
=undo-tree= package adds a nice undo tree buffer to visualize history and also displays diffs to easily show what changed.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package undo-tree
|
||
:ensure t
|
||
:delight
|
||
:config
|
||
(setq undo-tree-visualizer-diff t)
|
||
(global-undo-tree-mode))
|
||
#+END_SRC
|
||
** parenthesis matching
|
||
This color-codes matching parenthesis. Enable pretty much everywhere.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package rainbow-delimiters
|
||
:ensure t
|
||
:delight
|
||
:hook
|
||
((prog-mode . rainbow-delimiters-mode)
|
||
(inferior-ess-mode . rainbow-delimiters-mode)
|
||
(ess-mode . rainbow-delimiters-mode)
|
||
(LaTeX-mode . rainbow-delimiters-mode)
|
||
(Tex-latex-mode . rainbow-delimiters-mode)))
|
||
#+END_SRC
|
||
Use pretty symbols (like lambda in lisp)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'prog-mode-hook #'prettify-symbols-mode)
|
||
#+END_SRC
|
||
** sudo edit
|
||
Allows opening a file with sudo elevation.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package sudo-edit
|
||
:ensure t)
|
||
#+END_SRC
|
||
** formats and languages
|
||
*** Elisp
|
||
Elisp can use vanilla company with no plugins
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'emacs-lisp-mode-hook 'company-mode)
|
||
#+END_SRC
|
||
*** ESS (Emacs Speaks Statistics)
|
||
For me this means R but ess also supports S-plus, SAS, Stata, and other statistical black-magic languages. Note that ESS is not part of =prog-mode= so it must be added manually to hooks.
|
||
|
||
A few caveats when using =R=
|
||
- =ess-mode= requires a running R process for =company-mode= to work
|
||
- =flycheck-mode= requries =r-lintr=
|
||
#+begin_src emacs-lisp
|
||
(defun nd/init-ess-company ()
|
||
"Set the company backends for ess modes."
|
||
(setq-local company-backends '((company-R-objects company-R-args))))
|
||
|
||
(use-package ess
|
||
:ensure t
|
||
:init
|
||
(load "ess-site")
|
||
:hook
|
||
((ess-mode . flycheck-mode)
|
||
(ess-mode . company-mode)
|
||
(ess-mode . nd/init-ess-company)
|
||
(ess-mode . prettify-symbols-mode)
|
||
(ess-mode . fci-mode)
|
||
|
||
(inferior-ess-mode . company-mode)
|
||
(inferior-ess-mode . nd/init-ess-company)
|
||
(inferior-ess-mode . prettify-symbols-mode))
|
||
:config
|
||
(setq inferior-R-args "--quiet --no-save"
|
||
ess-history-file "session.Rhistory"
|
||
ess-history-directory (substitute-in-file-name "${XDG_CONFIG_HOME}/r/")))
|
||
#+END_SRC
|
||
*** Python
|
||
#+BEGIN_SRC emacs-lisp
|
||
(elpy-enable)
|
||
|
||
;; make python tabs 4 chars
|
||
(add-hook 'python-mode-hook
|
||
(lambda ()
|
||
(setq indent-tabs-mode t)
|
||
(setq tab-width 4)
|
||
(setq python-offset 4)))
|
||
|
||
(setq python-shell-interpreter "ipython"
|
||
python-shell-interpreter-args "--colors=Linux --profile=default")
|
||
#+END_SRC
|
||
*** Haskell
|
||
**** major mode and intero
|
||
Haskell is covered just with the basic major mode and intero (provides =company= and =flycheck=) which integrates well with stack.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package haskell-mode
|
||
:ensure t
|
||
:config
|
||
(setq haskell-interactive-popup-errors nil))
|
||
|
||
(use-package intero
|
||
:ensure t
|
||
:after haskell-mode
|
||
:hook
|
||
(haskell-mode . intero-mode))
|
||
#+END_SRC
|
||
**** camelCase
|
||
The defacto style for haskell mandates camelcase, so use subword mode.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'haskell-mode-hook #'subword-mode)
|
||
(delight 'subword-mode nil "subword")
|
||
#+END_SRC
|
||
*** TeX
|
||
**** AUCTeX
|
||
This is the official TeX (and friends) emacs package. I installed this outside of emacs on my system, so just need to load it here. Even if you do install through emacs, you will still need all the TeX packages which are bundled on Arch Linux through TeX-Live.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(load "auctex.el" nil t t)
|
||
(require 'tex-mik)
|
||
#+END_SRC
|
||
**** external viewers
|
||
AUCTeX can launch external viewers to show compiled documents. I use Okular for PDFs.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq TeX-view-program-selection '(((output-dvi has-no-display-manager)
|
||
"dvi2tty")
|
||
((output-dvi style-pstricks)
|
||
"dvips and gv")
|
||
(output-dvi "xdvi")
|
||
(output-pdf "Okular")
|
||
(output-html "xdg-open")))
|
||
#+END_SRC
|
||
**** folding and outlining
|
||
I like how =org-mode= folds with the TAB key, so bring the same thing to AUCTeX here with =outline-magic=.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'LaTeX-mode-hook (lambda () (outline-minor-mode 1)))
|
||
(add-hook 'Tex-latex-mode-hook (lambda () (outline-minor-mode 1)))
|
||
|
||
(use-package outline-magic
|
||
:ensure t
|
||
:after outline)
|
||
#+END_SRC
|
||
|
||
Also, the section fonts are too big by default. Now the sizes are all kept equal with hatchet, axe, and saw :)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq font-latex-fontify-sectioning 'color)
|
||
#+END_SRC
|
||
**** auto completion
|
||
There are two backends which (kinda) complement each other. The =company-math= package should privide completion for math symbols and the =company-auctex= package should cover pretty much everything else.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/init-company-auctex ()
|
||
"Set the company backends for auctex modes."
|
||
(setq-local company-backends '((company-auctex-labels
|
||
company-auctex-bibs
|
||
company-auctex-macros
|
||
company-auctex-symbols
|
||
company-auctex-environments
|
||
;; company-latex-commands
|
||
company-math-symbols-latex
|
||
company-math-symbols-unicode))))
|
||
|
||
(use-package company-math
|
||
:ensure t
|
||
:after company
|
||
:config
|
||
(setq company-math-allow-unicode-symbols-in-faces '(font-latex-math-face)
|
||
company-math-disallow-latex-symbols-in-faces nil))
|
||
|
||
(use-package company-auctex
|
||
:ensure t
|
||
:after (company company-math)
|
||
:hook
|
||
((LaTeX-mode . company-mode)
|
||
(LaTeX-mode . nd/init-company-auctex)
|
||
(Tex-latex-mode . company-mode)
|
||
(Tex-latex-mode . nd/init-company-auctex)))
|
||
#+END_SRC
|
||
**** syntax check
|
||
Flycheck should work out of the box.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'LaTeX-mode-hook #'flycheck-mode)
|
||
(add-hook 'Tex-latex-mode-hook #'flycheck-mode)
|
||
#+END_SRC
|
||
**** spell check
|
||
Spell checking is important for prose
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'LaTeX-mode-hook (lambda () (flyspell-mode 1)))
|
||
#+END_SRC
|
||
**** line wrap
|
||
I like having my lines short and readable (also easier to git). Turn on autofill here and also make a nice vertical line at 80 chars (=visual-line-mode=).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/turn-on-auto-fill-maybe ()
|
||
"Prompts user to turn on `auto-fill-mode'."
|
||
(when (y-or-n-p "Activate Auto Fill Mode? ")
|
||
(turn-on-auto-fill)))
|
||
|
||
(add-hook 'LaTeX-mode-hook #'nd/turn-on-auto-fill-maybe)
|
||
(add-hook 'LaTeX-mode-hook #'fci-mode)
|
||
#+END_SRC
|
||
**** BibTeX
|
||
***** database management
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package ebib
|
||
:ensure t
|
||
:config
|
||
(setq ebib-autogenerate-keys t
|
||
ebib-uniquify-keys t))
|
||
#+END_SRC
|
||
***** citation search and insertion
|
||
Together, =org-ref= and =helm-bibtex= provide a nice pipeline to search a BibTex database and insert citations.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package org-ref
|
||
:ensure t
|
||
:after org
|
||
:config
|
||
(setq reftex-default-bibliography (expand-file-name "~/BibTeX/master.bib")
|
||
org-ref-bibliography-notes (expand-file-name "~/BibTeX/notes.org")
|
||
org-ref-default-bibliography (expand-file-name "~/BibTeX/master.bib")))
|
||
|
||
(use-package helm-bibtex
|
||
:ensure t
|
||
:after helm
|
||
:config
|
||
(setq bibtex-completion-bibliography (expand-file-name "~/BibTeX/master.bib")
|
||
bibtex-completion-library-path (expand-file-name "~/BibTeX/pdf")
|
||
bibtex-completion-pdf-field "File"))
|
||
#+END_SRC
|
||
*** CSS
|
||
Overlays hex color codes with matching colors in certain modes like css and html.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package rainbow-mode
|
||
:ensure t)
|
||
#+END_SRC
|
||
*** Markdown
|
||
Added support for standard markdown files. Also used in R-markdown.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package markdown-mode
|
||
:ensure t)
|
||
#+END_SRC
|
||
*** polymode
|
||
This allows multiple modes in one buffer. This may sound totally crazy...but it actually is. Despite it's hackiness, it makes alot of sense for some situations such as R markdown which requires yaml, markdown, and R code in one buffer.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package polymode
|
||
:ensure t
|
||
:after markdown-mode
|
||
:mode
|
||
(("\\.Rmd\\'" . poly-markdown+r-mode)
|
||
("\\.rmd\\'" . poly-markdown+r-mode))
|
||
:config
|
||
(require 'poly-R)
|
||
(require 'poly-markdown))
|
||
#+END_SRC
|
||
*** csv files
|
||
This adds support for csv files. Almost makes them editable like a spreadsheet. The lambda function enables alignment by default.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package csv-mode
|
||
:ensure t
|
||
:hook (csv-mode . (lambda () (csv-align-fields nil (point-min) (point-max)))))
|
||
#+END_SRC
|
||
* org-mode
|
||
** low-level config
|
||
*** modules
|
||
Org has several extensions in the form of loadable modules. =org-protocol= is used as a backend for external programs to communicate with =org-mode=. =org-habit= allows the habit todoitem which is used as a more flexible recurring task.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-modules '(org-habit org-protocol))
|
||
(require 'org)
|
||
(require 'org-agenda)
|
||
(require 'org-protocol)
|
||
(require 'org-habit)
|
||
#+END_SRC
|
||
*** directory
|
||
I keep all my org files in one place.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-directory "~/Org")
|
||
#+END_SRC
|
||
*** autosave
|
||
Save all org buffers 1 minute before the hour.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-save-all-org-buffers ()
|
||
"Save org buffers without confirmation or message (unlike default)."
|
||
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
|
||
(when (featurep 'org-id) (org-id-locations-save)))
|
||
|
||
(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers)
|
||
#+END_SRC
|
||
** buffer interface
|
||
*** line wrap
|
||
I often write long, lengthy prose in org buffers, so use =visual-line-mode= to make lines wrap in automatic and sane manner.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-mode-hook #'visual-line-mode)
|
||
(delight 'visual-line-mode nil 'simple)
|
||
#+END_SRC
|
||
*** indentation
|
||
By default all org content is squished to the left side of the buffer regardless of its level in the outline. This is annoying and I would rather have content indented based on its level just like most bulleted lists. This is what =org-indent-mode= does.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-startup-indented t)
|
||
(delight 'org-indent-mode nil "org-indent")
|
||
#+END_SRC
|
||
*** special key behavior
|
||
TODO: These don't work in evil mode (using the usual line commands).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-special-ctrl-a/e t
|
||
org-special-ctrl-k t
|
||
org-yank-adjusted-subtrees t)
|
||
#+END_SRC
|
||
*** bullets
|
||
These are just so much better to read
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package org-bullets
|
||
:ensure t
|
||
:hook
|
||
(org-mode . org-bullets-mode))
|
||
#+END_SRC
|
||
*** font height
|
||
The fonts in org headings bug me; make them smaller and less invasive.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-mode-hook
|
||
(lambda ()
|
||
(let ((heading-height 1.15))
|
||
(set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height)
|
||
(set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height)
|
||
(set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height)
|
||
(set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height)
|
||
(set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height))))
|
||
#+END_SRC
|
||
*** src blocks
|
||
Enable shortcuts for embedding code in org text bodies.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-src-window-setup 'current-window
|
||
org-src-fontify-natively t
|
||
org-edit-src-content-indentation 0)
|
||
|
||
(add-to-list 'org-structure-template-alist
|
||
'("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC"))
|
||
#+END_SRC
|
||
*** todo insertion
|
||
Make todo insertion respect contents
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-insert-heading-respect-content t)
|
||
#+END_SRC
|
||
*** table of contents
|
||
Since I use org mode as my config file, makes sense to have a table of contents so others can easily naviagate this crazy empire I have created :)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package toc-org
|
||
:ensure t
|
||
:hook
|
||
(org-mode . toc-org-mode))
|
||
#+END_SRC
|
||
*** column view
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-columns-default-format
|
||
"%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)")
|
||
|
||
(set-face-attribute 'org-column nil :background "#1e2023")
|
||
;; org-columns-summary-types
|
||
#+END_SRC
|
||
** extra commands
|
||
*** org buffer
|
||
Some useful additional commands for org buffers.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/mark-subtree-keyword (new-keyword &optional exclude)
|
||
"Mark all tasks in a subtree with NEW-KEYWORD unless original
|
||
keyword is in the optional argument EXCLUDE."
|
||
(let ((subtree-end (save-excursion (org-end-of-subtree t))))
|
||
(if (not (listp exclude))
|
||
(error "exlude must be a list if provided"))
|
||
(save-excursion
|
||
(while (< (point) subtree-end)
|
||
(let ((keyword (nd/is-todoitem-p)))
|
||
(if (and keyword (not (member keyword exclude)))
|
||
(org-todo new-keyword)))
|
||
(outline-next-heading)))))
|
||
|
||
(defun nd/mark-subtree-done ()
|
||
"Mark all tasks in subtree as DONE unless they are already CANC."
|
||
(interactive)
|
||
(nd/mark-subtree-keyword "DONE" '("CANC")))
|
||
|
||
(defun nd/org-clone-subtree-with-time-shift (n &optional shift)
|
||
"Like `org-clone-subtree-with-time-shift' except it resets checkboxes
|
||
and reverts all todo keywords to TODO."
|
||
(interactive "nNumber of clones to produce: ")
|
||
|
||
(let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective)
|
||
(read-from-minibuffer
|
||
"Date shift per clone (e.g. +1w, empty to copy unchanged): "))))
|
||
(condition-case err
|
||
(progn
|
||
(save-excursion
|
||
;; clone once and reset
|
||
(org-clone-subtree-with-time-shift 1 shift)
|
||
(org-forward-heading-same-level 1 t)
|
||
(org-reset-checkbox-state-subtree)
|
||
(nd/mark-subtree-keyword "TODO")
|
||
(call-interactively 'nd/org-log-delete)
|
||
(org-cycle)
|
||
;; clone reset tree again if we need more than one clone
|
||
(if (> n 1)
|
||
(let ((additional-trees (- n 1)))
|
||
(org-clone-subtree-with-time-shift additional-trees shift)
|
||
(dotimes (i additional-trees)
|
||
(org-forward-heading-same-level 1 t)
|
||
(org-cycle))))))
|
||
(error (message "%s" (error-message-string err))))))
|
||
|
||
(defun nd/org-log-delete ()
|
||
"Delete logbook drawer of subtree."
|
||
(interactive)
|
||
(save-excursion
|
||
(goto-char (org-log-beginning))
|
||
(when (save-excursion
|
||
(save-match-data
|
||
(beginning-of-line 0)
|
||
(search-forward-regexp org-drawer-regexp)
|
||
(goto-char (match-beginning 1))
|
||
(looking-at "LOGBOOK")))
|
||
(org-mark-element)
|
||
(delete-region (region-beginning) (region-end))
|
||
(org-remove-empty-drawer-at (point)))))
|
||
|
||
(defun nd/org-delete-subtree ()
|
||
"Delete the entire subtree under the current heading without sending to kill ring."
|
||
(interactive)
|
||
(org-back-to-heading t)
|
||
(delete-region (point) (+ 1 (save-excursion (org-end-of-subtree)))))
|
||
|
||
#+END_SRC
|
||
*** org agenda
|
||
These are executed directly from agenda views and affect their source org buffers. The trick is that all of them must somehow go back to the heading to which they allude, execute, then update the agenda view with whatever changes have been made.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body)
|
||
"Wraps commands in BODY in necessary code to allow commands to be
|
||
called from the agenda buffer. Particularly, this wrapper will
|
||
navigate to the original header, execute BODY, then update the agenda
|
||
buffer."
|
||
'(org-agenda-check-no-diary)
|
||
`(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
|
||
(org-agenda-error)))
|
||
(buffer (marker-buffer hdmarker))
|
||
(pos (marker-position hdmarker))
|
||
(inhibit-read-only t)
|
||
newhead)
|
||
(org-with-remote-undo buffer
|
||
(with-current-buffer buffer
|
||
(widen)
|
||
(goto-char pos)
|
||
(org-show-context 'agenda)
|
||
,@body
|
||
(when ,get-head (setq newhead (org-get-heading))))
|
||
(if ,get-head
|
||
(org-agenda-change-all-lines newhead hdmarker)
|
||
(org-agenda-redo))
|
||
(beginning-of-line 1))))
|
||
|
||
(defun nd/org-agenda-toggle-checkbox ()
|
||
"Toggle checkboxes in org agenda view using `org-toggle-checkbox'."
|
||
(interactive)
|
||
(nd/org-agenda-cmd-wrapper
|
||
t
|
||
(call-interactively #'org-toggle-checkbox)))
|
||
|
||
(defun nd/org-agenda-clone-subtree-with-time-shift ()
|
||
"Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry.
|
||
It will clone the last entry in the selected subtree."
|
||
(interactive)
|
||
(nd/org-agenda-cmd-wrapper
|
||
nil
|
||
(org-end-of-subtree)
|
||
(call-interactively #'nd/org-clone-subtree-with-time-shift)))
|
||
|
||
(defun nd/org-agenda-delete-subtree ()
|
||
"Apply `nd/org-delete-subtree' to an agenda entry."
|
||
(interactive)
|
||
(nd/org-agenda-cmd-wrapper
|
||
nil
|
||
(call-interactively #'nd/org-delete-subtree)))
|
||
#+END_SRC
|
||
** calfw
|
||
This is a nifty calendar...sometimes way faster than the agenda buffer for looking at long term things.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package calfw
|
||
:ensure t
|
||
:config
|
||
(setq cfw:fchar-junction ?╋
|
||
cfw:fchar-vertical-line ?┃
|
||
cfw:fchar-horizontal-line ?━
|
||
cfw:fchar-left-junction ?┣
|
||
cfw:fchar-right-junction ?┫
|
||
cfw:fchar-top-junction ?┯
|
||
cfw:fchar-top-left-corner ?┏
|
||
cfw:fchar-top-right-corner ?┓))
|
||
|
||
(use-package calfw-org
|
||
:ensure t
|
||
:after calfw
|
||
:config
|
||
(setq cfw:org-agenda-schedule-args
|
||
'(:deadline :timestamp)))
|
||
#+END_SRC
|
||
** window splitting
|
||
Org mode is great and all, but the windows never show up in the right place. The solutions here are simple, but have the downside that the window sizing must be changed when tags/capture templates/todo items are changed. This is because the buffer size is not known at window creation time and I didn't feel like making a function to predict it
|
||
*** todo selection
|
||
I only need a teeny tiny window below my current window for todo selection
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-todo-position (buffer alist)
|
||
(let ((win (car (cl-delete-if-not
|
||
(lambda (window)
|
||
(with-current-buffer (window-buffer window)
|
||
(memq major-mode
|
||
'(org-mode org-agenda-mode))))
|
||
(window-list)))))
|
||
(when win
|
||
(let ((new (split-window win -4 'below)))
|
||
(set-window-buffer new buffer)
|
||
new))))
|
||
|
||
(defun nd/org-todo-window-advice (orig-fn)
|
||
"Advice to fix window placement in `org-fast-todo-selection'."
|
||
(let ((override '("\\*Org todo\\*" nd/org-todo-position)))
|
||
(add-to-list 'display-buffer-alist override)
|
||
(nd/with-advice
|
||
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
|
||
(unwind-protect (funcall orig-fn)
|
||
(setq display-buffer-alist
|
||
(delete override display-buffer-alist))))))
|
||
|
||
(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice)
|
||
#+END_SRC
|
||
*** tag selection
|
||
By default, the tag selection window obliterates all but the current window...how disorienting :/
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table)
|
||
"Advice to fix window placement in `org-fast-tags-selection'."
|
||
(nd/with-advice
|
||
((#'delete-other-windows :override #'ignore)
|
||
;; pretty sure I just got lucky here...
|
||
(#'split-window-vertically :override #'(lambda (&optional size)
|
||
(split-window-below (or size -9)))))
|
||
(unwind-protect (funcall orig-fn current inherited table todo-table))))
|
||
|
||
(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice)
|
||
#+END_SRC
|
||
*** capture
|
||
Capture should show up in the bottom of any currently active buffer
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-capture-position (buffer alist)
|
||
(let ((new (split-window (get-buffer-window) -14 'below)))
|
||
(set-window-buffer new buffer)
|
||
new))
|
||
|
||
(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials)
|
||
"Advice to fix window placement in `org-capture-select-template'."
|
||
(let ((override '("\\*Org Select\\*" nd/org-capture-position)))
|
||
(add-to-list 'display-buffer-alist override)
|
||
(nd/with-advice
|
||
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
|
||
(unwind-protect (funcall orig-fn table title prompt specials)
|
||
(setq display-buffer-alist
|
||
(delete override display-buffer-alist))))))
|
||
|
||
(advice-add #'org-mks :around #'nd/org-capture-window-advice)
|
||
#+END_SRC
|
||
** exporting
|
||
*** latex to pdf command
|
||
Use =latexmk= instead of =pdflatex= as it is more flexible and doesn't require running the process zillion times just to make a bibliography work. Importantly, add support here for BibTeX as well as the custom output directory (see below).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-latex-pdf-process (list "latexmk -output-directory=%o -shell-escape -bibtex -f -pdf %f"))
|
||
#+END_SRC
|
||
*** custom output directory
|
||
By default org export files to the same location as the buffer. This is insanity and clutters my org directory with =.tex= and friends. Force org to export to a separate location.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defvar nd/org-export-publishing-directory
|
||
(expand-file-name "org-exports" (getenv "XDG_CACHE_HOME"))
|
||
"The target directory to for all org exports.")
|
||
|
||
(defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir)
|
||
"Change the target export directory for org exports."
|
||
(unless pub-dir
|
||
(setq pub-dir nd/org-export-publishing-directory)
|
||
(unless (file-directory-p pub-dir)
|
||
(make-directory pub-dir)))
|
||
(apply orig-fun extension subtreep pub-dir nil))
|
||
|
||
(advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name)
|
||
#+END_SRC
|
||
*** html5
|
||
The default is XHTML for some reason (which few use and makes certain barbaric word processors complain). Use the much-superior html5.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-html-doctype "html5")
|
||
#+END_SRC
|
||
** gantt charts
|
||
This is custom, non-MELPA package, so it must be loaded manually. See [[https://github.com/swillner/org-gantt/blob/master/org-gantt-manual.org][here]] for guide.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/")
|
||
(require 'org-gantt)
|
||
#+END_SRC
|
||
|
||
It is also useful to define a block template for gantt chart creation
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-to-list 'org-structure-template-alist
|
||
'("og" "#+BEGIN: org-gantt-chart\n?\n#+END"))
|
||
#+END_SRC
|
||
** gtd implementation
|
||
*** overview
|
||
This section is meant to be a big-picture overview of how GTD works in this setup. For specifics, see each section following this for further explanation and code. I should also say that most of the ideas for the code came from [[http://doc.norang.ca/org-mode.html#OrgFileStructure][Bernt Hansen's]] very detailed guide.
|
||
**** workflow
|
||
GTD as described in its [[https://en.wikipedia.org/wiki/Getting_Things_Done][original form]] is divided into five steps as explained further below. Here I attempt to explain how I implement each of these into =org-mode=.
|
||
***** collect
|
||
The whole point of GTD is to get stuff out of one's head, and this is purpose of the /collect/ step. Basically if a thought or task pops in my head or interrupts me, I record it somewhere. These thoughts can happen any time and anywhere, so it is important to keep them out of consciousness so that I can concentrate on whatever I am doing.
|
||
|
||
When =org-mode= is in front of me, I use =org-capture= (see below for =org-capture-templates=). The "things" that could be collected include anything from random ideas, things I remember to do, appointments I need to attend, etc. I also capture emails with =mu4e= (which links to =org-mode= through =org-protocol=). Everythign collected with =org-capture= gets sent to a dedicated file where I deal with it later (see /process/ step).
|
||
|
||
When =org-mode= is not in front of me, I record my thoughts in the Orgzly app on my android. It doesn't really sync so I transfer everything manually.
|
||
***** process
|
||
Collecting only records things; it doesn't make decisions. The point of the /process/ step is to decide if the task/note is worth my time and when. This involves several key questions.
|
||
|
||
The first question to ask is if the task is actionable. If yes, it gets moved to a project file or a general task file. If not, I ask it can either be moved to the "incubator" (a place for things I might do), be moved any number of reference files (for storing inportant information), or flat-out deleted if I think it is stupid or no longer relevant.
|
||
|
||
In =org-mode= these decisions are made and recorded by moving headings between files with =org-refile=. To facilitate this process I have an agenda view to filter out captured tasks. From there it is easy to refile to wherever the headers need to go.
|
||
|
||
This step happens daily along with /organize/ below.
|
||
***** organize
|
||
The /organize/ step is basically the second half of the /process/ step (I honestly think of these as a single task because that's how they are implemented in =org-mode=, but the original GTD workflow describes them seperately).
|
||
|
||
After refiling with =org-refile=, the next step is to add any remaining meta information to each task, which is later used to decide what to do and when. This information includes context, effort, delegation, and timestamps. In the case of projects this also includes choosing a NEXT tasks if one hasn't been chosen already.
|
||
|
||
Delegation (assingning something to someone else) is simple and is represented by a simple property which is filled with the initials of the person doing the work. It filter and view this with =org-columns= and =org-agenda-columns=.
|
||
|
||
When tasks don't have a specific date, GTD outlines a four-criteria model for deciding what to do: context, required time, available energy, and priority. Context describes required locations and resources for tasks, and I represent them with tags (see =org-tags-alist=). Required time is represented by the =Effort= property (see =org-default-properties= below). Available energy is subjective and not represented in =org-mode=. Priority is again represented with tags, here chosen from one of seven "life categories."
|
||
|
||
In assigning timestamps, =org-mode= offers several possibilities out of the box. Putting a plain active timestamp denotes an appointment (something at which I need to show up). A scheduled timestamp denotes a task that I want to work on starting at a certain time. A deadline denotes a task that must be finished by a certain time. I try to only use these for "hard" times as anything "soft" risks me not fulfilling to the timestamp and hence diminishing the value of timestamps in general.
|
||
|
||
I have three main agenda views for handling this. The first is a daily view that shows the tasks needed for today, including anything with a timestamp. The second has all tasks that are not timestamps (eg things that can be done at any time). The third is a project view that shows the top level headings for collections of tasks (this is where I find any projects that need a NEXT task).
|
||
|
||
The /organize/ step may seem like it requires alot of work but luckily =org-mode= allows enough automation that some of this meta information can be added in the /collect/ and /process/ phases. For instance, timestamps and tags can be added (forcibly) in =org-capture= depending on what template is used. Furthermore, the priority tag and some context tags are added when the task is refiled to its proper file or project; this happens via tag inheritance, defined at either the file level or a parent heading (for instance, a computer-related tasks may be filed under =environmental/computer= where =environment= has the =_env= tag and =computer= has the =#laptop= tag).
|
||
***** review
|
||
In order to keep the entire workflow moving smoothly, it is necessary to do a high-level /review/.
|
||
|
||
This happens weekly and involves several things.
|
||
- Scheduling important tasks and resolve conflicts. For this I use =calfw= (basically a calendar) to look at the next week and check if anything overlaps and move things around. I also "reload" repeater tasks using =nd/org-clone-subtree-with-timeshift=.
|
||
- Moving tasks to the archive as they are available. This keeps =org-mode= fast and uncluttered.
|
||
- Reviewing the incubator and moving tasks out that I actually decide to do.
|
||
- Reviewing reference material and moving it to appropriate tasks.
|
||
- Assessing projects based on their status (see below for the definition of "status"). Ideally all projects are "active," and if they are not I try to make them active by assigning NEXT.
|
||
|
||
I have specialized agenda views and commands for facilitating all of this.
|
||
***** execute
|
||
/Execute/ involves doing the predefined work laid out in the previous four steps. Generally I work through two agenda views (in order). The first being all my tasks that need to get done in the day, and the second being all tasks with no specific timestamp.
|
||
|
||
Besides physically doing the tasks here, the other special thing in =org-mode= that I use is clocking. In addition to tracking time spent, it also encourages clean breaks between tasks (eg no multitasking).
|
||
**** file hierarchy and structure
|
||
All org files are kept in one place (see =org-directory=). This is futher subdivided into directories for project (as per terms and definitions, these are any tasks that involve at least on subtask) and reference files. At the top level are files for incubated tasks, captured tasks, and catchall general tasks (which also includes small projects that don't fit anywhere else).
|
||
|
||
In order to make sorting easier and minimize work during processing, the files are further subdivided using tags at the file level and heading level that will automatically categorize tasks when they are refiled to a certain location. For example, some project may be to create a computer program, so I would set =#+FILETAGS: #laptop= because every task in this project will require a laptop. See the tags section below for more information on tags.
|
||
**** repetition
|
||
This deserves special attention because it comprises a significant percentage of tasks I do (and likely everyone does). I personally never liked the org's repeated task functionality. It is way too temporally rigid to be useful to me, and offers very little flexibility in mutating a task as it moves forward. Habits (which I use) are a partial fix for the first problem but do not aleviate the mutability problem.
|
||
|
||
My (somewhat convoluted) solution was to use =org-clone-subtree-with-time-shift=, which creates an easy way to make repeated tasks from some template, but also allows modification. The only problem with the vanilla implementation is that it lacks automation and agenda-block awareness (they all get treated as regular tasks which I don't want). This is partially fixed with my own =nd/org-clone-subtree-with-time-shift= which automaticlly resets tasks which are cloned (eg clearing checkboxes and resetting todo state). The remainding problems I fixed by defining several properties to be applied to repeated groupings under a heading (see properties).
|
||
|
||
The first property is called =PARENT_TYPE= and has two values =iterator= and =periodical=. The first applies to repeated tasks and second which applies to timestamped headings such as appointments. These are mostly useful for agenda sorting, where I have views specifically for managing repeated tasks. The second property is =TIME_SHIFT=; =nd/org-clone-subtree-with-time-shift= is aware of this value and automatically shifts cloned tasks accordingly if available.
|
||
|
||
In practice, I use this for tasks like workouts, paying bills, maintenance, grocery shopping, work meetings, GTD reviews, etc. These are all *almost* consistent but may change slightly in their timing, action items, effort, context, etc. If any of these change, it is easy enough to modify one heading without disrupting the rest.
|
||
|
||
In an org tree these look like this:
|
||
#+BEGIN_SRC org
|
||
***** clean room
|
||
:PROPERTIES:
|
||
:PARENT_TYPE: iterator
|
||
:TIME_SHIFT: +1m
|
||
:END:
|
||
****** DONE clean room [0/2]
|
||
CLOSED: [2018-11-21 Wed 22:13] SCHEDULED: <2018-10-29 Mon>
|
||
:PROPERTIES:
|
||
:Effort: 0:15
|
||
:END:
|
||
- [ ] vacuum
|
||
- [ ] throw away trash
|
||
****** TODO clean room [0/2]
|
||
SCHEDULED: <2018-11-29 Thu>
|
||
:PROPERTIES:
|
||
:Effort: 0:30
|
||
:END:
|
||
- [ ] vacuum room
|
||
- [ ] throw away trash
|
||
#+END_SRC
|
||
**** block agenda views
|
||
The heart of this implementation is an army of block agenda views (basically filters on the underlying org trees that bring whatever I need into focus). These have become tailored enough to my workflow that I don't even use the built-in views anymore (I also have not found an "easy" way to turn these off). Besides projects, these agenda views are primarily driven using skip functions.
|
||
***** projects
|
||
When it comes to the agenda view, I never liked how org-mode by default handled "projects" (see how that is defined in "terms and definitions"). It mostly falls short because of the number of todo keywords I insist on using. The solution I implemented was to used "statuscodes" (which are just keywords in lisp) to define higher-level descriptions based on the keyword content of a project. For example a "stuck" project (with statuscode =:stuck=) is a project with only =TODO= keywords. Adding a =NEXT= status turns the statuscode to =:active=. Likewise =WAIT= makes =:waiting=. This seems straightforward, except that =NEXT= trumps =WAIT=, =WAIT= trumps =HOLD=, etc. Furthermore, there are errors I wish to catch to ensure subtrees get efficiently cleaned out, such as a project heading with =DONE= that still has a =TODO= underneath.
|
||
|
||
I used to take care of this problem with lots of skip functions, but it turned out to be unmaintainable and offered poor performance (eg if I wanted a block agenda for =N= statuscodes, I needed to scan the entire org tree =N= times). A far easier way to implement this was to embed the statuscodes in text properties in each agenda line, which could then be sorted and the prefix string formatted with the status code for identification in the block agenda view. Since this only requires one block, it only requires one scan, and is very fast.
|
||
***** repeaters
|
||
Similarly to projects, repeaters (eg iterators and periodicals) are assessed via a statuscode (after all they are a group of headings and thus depending on the evaluation of todo keywoards and timestamps in aggregate). These prove much simpler than projects as essentially all I need are codes for uninitialized (there is nothing in the repeater), empty (all subheadings are in the past and therefore irrelevant), and active (there are some subtasks in the future).
|
||
**** terms and definitions
|
||
These conventions are used throughout to be precise when naming functions/variables and describing their effects
|
||
***** headings
|
||
- heading: the topmost part after the bullet in an org outline. Org-mode cannot seem to make up it's mind in calling it a header, heading, or headline, so I picked heading
|
||
- todoitem: any heading with a todo keyword
|
||
- task: a todoitem with no todoitem children
|
||
- atomic: further specifies that the task is not part of a project
|
||
- project: a todoitem with that has todoitem children or other projects
|
||
- status(code): a keyword used to describe the overall status of a project. See skip functions in the block agenda section for their implementation.
|
||
***** time
|
||
- stale: refers to timestamps that are in the past/present
|
||
- archivable: further specifies that the timestamp is older than some cutoff that defines when tasks can be archived (usually 30 days)
|
||
- fresh: refers to timestamps that are in the future
|
||
*** todo states
|
||
**** sequences
|
||
These keywords are used universally for all org files (see below on quick explanation for each, they are all quite straightforward). Note that projects have a more specific meaning for these keywords in defining project status (see the library of agenda function). Also, it looks way better in the agenda buffer when they are all the same number of chars.
|
||
|
||
In terms of logging, I like to record the time of each change upon leaving any state, and I like recording information in notes when waiting, holding, or canceling (as these usually have some external trigger or barrier that should be specified).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-todo-keywords
|
||
'((sequence
|
||
;; default undone state
|
||
"TODO(t/!)"
|
||
|
||
;; undone but available to do now (projects only)
|
||
"NEXT(n/!)" "|"
|
||
|
||
;; done and complete
|
||
"DONE(d/!)")
|
||
|
||
(sequence
|
||
;; undone and waiting on some external dependency
|
||
"WAIT(w@/!)"
|
||
|
||
;; undone but signifies tasks on which I don't wish to focus at the moment
|
||
"HOLD(h@/!)" "|"
|
||
|
||
;; done but not complete
|
||
"CANC(c@/!)")))
|
||
#+END_SRC
|
||
**** colors
|
||
Aesthetically, I like all my keywords to have bold colors.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-todo-keyword-faces
|
||
'(("TODO" :foreground "light coral" :weight bold)
|
||
("NEXT" :foreground "khaki" :weight bold)
|
||
("DONE" :foreground "light green" :weight bold)
|
||
("WAIT" :foreground "orange" :weight bold)
|
||
("HOLD" :foreground "violet" :weight bold)
|
||
("CANC" :foreground "deep sky blue" :weight bold)))
|
||
#+END_SRC
|
||
*** tags
|
||
**** alist
|
||
I use tags for agenda filtering (primarily for GTD contexts, see below). Each tag here starts with a symbol to define its group (note, only the special chars "_", "@", "#", and "%" seem to be allowed; anything else will do weird things in the hotkey prompt). Some groups are mutually exclusive. By convention, any tag not part of these groups is ALLCAPS (not very common) and set at the file level.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-tag-alist
|
||
;; (@) gtd location context
|
||
'((:startgroup)
|
||
("@errand" . ?e)
|
||
("@home" . ?h)
|
||
("@work" . ?w)
|
||
("@travel" . ?r)
|
||
(:endgroup)
|
||
|
||
;; (#) gtd resource context
|
||
("#laptop" . ?l)
|
||
("#tcult" . ?t)
|
||
("#phone" . ?p)
|
||
|
||
;; (%) misc tags
|
||
;; denotes reference information
|
||
("%note" . ?n)
|
||
|
||
;; incubator
|
||
("%inc" . ?i)
|
||
|
||
;; denotes tasks that need further subdivision to turn into true project
|
||
("%subdiv" . ?s)
|
||
|
||
;; catchall to mark important headings, usually for meetings
|
||
("%flag" . ?f)
|
||
|
||
;; (_) life categories, used for gtd priorities
|
||
(:startgroup)
|
||
("_env" . ?E) ;; environmental
|
||
("_fin" . ?F) ;; financial
|
||
("_int" . ?I) ;; intellectual
|
||
("_met" . ?M) ;; metaphysical
|
||
("_phy" . ?H) ;; physical
|
||
("_pro" . ?P) ;; professional
|
||
("_rec" . ?R) ;; recreational
|
||
("_soc" . ?S) ;; social
|
||
(:endgroup)))
|
||
#+END_SRC
|
||
**** colors
|
||
Each group also has its own color, defined by its prefix symbol.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/add-tag-face (fg-name prefix)
|
||
"Adds list of cons cells to org-tag-faces with foreground set to fg-name.
|
||
Start and end specify the positions in org-tag-alist which define the tags
|
||
to which the faces are applied"
|
||
(dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist)))
|
||
(push `(,tag . (:foreground ,fg-name)) org-tag-faces)))
|
||
|
||
(setq org-tag-faces '())
|
||
|
||
(nd/add-tag-face "PaleGreen" "@")
|
||
(nd/add-tag-face "SkyBlue" "#")
|
||
(nd/add-tag-face "PaleGoldenrod" "%")
|
||
(nd/add-tag-face "violet" "_")
|
||
#+END_SRC
|
||
*** properties
|
||
The built-in =effort= is used as the fourth and final homonymous GTD context (the other three being covered above using tags). It is further restricted with =Effort_All= to allow easier filtering in the agenda.
|
||
|
||
Also here are the properties for repeated tasks and a few others (see comments in code).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(mapc (lambda (i) (add-to-list 'org-default-properties i))
|
||
;; defines a repeater group
|
||
'("PARENT_TYPE"
|
||
;; defines the time shift for repeater groups
|
||
|
||
"TIME_SHIFT"
|
||
;; assigns another person/entity to a task (experimental)
|
||
|
||
"DELEGATE"
|
||
|
||
;; defines a goal
|
||
"GOAL"
|
||
|
||
;; date of header creation
|
||
"CREATED"))
|
||
|
||
(setq org-global-properties
|
||
'(("PARENT_TYPE_ALL" . "periodical iterator")
|
||
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00"))
|
||
|
||
org-use-property-inheritance
|
||
'("PARENT_TYPE" "TIME_SHIFT"))
|
||
#+END_SRC
|
||
*** capture
|
||
**** templates
|
||
As per Bernt's guide, capture is meant to be fast. The dispatcher is bound to =F2= (see keybindings section) which allows access in just about every mode and brings a template up in two keystrokes.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-timestamp-future (days)
|
||
"Inserts an active org timestamp DAYS after the current time."
|
||
(format-time-string (org-time-stamp-format nil)
|
||
(time-add (current-time) (days-to-time 1))))
|
||
|
||
(let ((capfile "~/Org/capture.org"))
|
||
(setq org-capture-templates
|
||
;; regular TODO task
|
||
`(("t" "todo" entry (file ,capfile)
|
||
"* TODO %?\n")
|
||
|
||
;; for useful reference information that may be grouped with tasks
|
||
("n" "note" entry (file ,capfile)
|
||
"* %? :\\%note:\n%U\n")
|
||
|
||
;; for non-actionable events that happen at a certain time
|
||
("a" "appointment" entry (file ,capfile)
|
||
"* %?\n%U\n%^t\n")
|
||
|
||
;; like appointment but multiple days
|
||
("s" "appointment-span" entry (file ,capfile)
|
||
"* %?\n%U\n%^t--%^t\n")
|
||
|
||
;; task with a deadline
|
||
("d" "deadline" entry (file ,capfile)
|
||
"* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n")
|
||
|
||
;; for converting mu4e emails to tasks, defaults to next-day deadline
|
||
("e" "email" entry (file ,capfile)
|
||
"* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%a\n")
|
||
|
||
;; for interruptions that produce useful reference material
|
||
("m" "meeting" entry (file ,capfile)
|
||
"* meeting with%? :\\%note:\n%U\n")
|
||
|
||
;; for capturing web pages with web browser
|
||
("p" "org-protocol" entry (file ,capfile)
|
||
"* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE"
|
||
:immediate-finish t)
|
||
|
||
;; or capturing links with web browser
|
||
("L" "org-protocol link" entry (file ,capfile)
|
||
"* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U"
|
||
:immediate-finish t))))
|
||
#+END_SRC
|
||
**** insert mode
|
||
To save one more keystroke (since I use evil mode), trigger insert mode upon opening capture template.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-capture-mode-hook (lambda () (evil-append 1)))
|
||
#+END_SRC
|
||
*** refile
|
||
Refile (like capture) should be fast, and I search all org file simultaneously using helm (setting =org-outline-path-complete-in-steps= to =nil= makes search happen for entire trees at once and not just the current level). Refiling is easiest to do from a block agenda view (see below) where headings can be moved in bulk.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-refile-targets '((nil :maxlevel . 9)
|
||
("~/Org/reference/idea.org" :maxlevel . 9)
|
||
(org-agenda-files :maxlevel . 9))
|
||
org-refile-use-outline-path t
|
||
org-outline-path-complete-in-steps nil
|
||
org-refile-allow-creating-parent-nodes 'confirm
|
||
org-indirect-buffer-display 'current-window)
|
||
#+END_SRC
|
||
|
||
Prevent accidental refiling under tasks with done keywords
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-refile-target-verify-function
|
||
(lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords))))
|
||
|
||
;; TODO this no work, although does work if var is global
|
||
;; redfining the targets works for now
|
||
(add-hook 'org-agenda-mode-hook
|
||
(lambda ()
|
||
(when (equal (buffer-name) "*Org Agenda(A)*")
|
||
(setq-local org-refile-targets
|
||
'(("~/Org/journal/goals.org" :maxlevel . 9))))))
|
||
;; (lambda () (when (org-entry-get nil "GOAL") t))))))
|
||
;; (setq org-refile-targets '((nil :maxlevel . 9)
|
||
;; ("~/Org/reference/idea.org" :maxlevel . 9)
|
||
;; ("~/Org/journal/goals.org" :maxlevel . 9)
|
||
;; (org-agenda-files :maxlevel . 9))
|
||
#+END_SRC
|
||
*** clocking
|
||
**** general
|
||
Clocking is still new and experimental (I'm not a ninja like Bernt yet). I mostly use clocking now as a way to make clean breaks between tasks (eg to discourage "mixing" tasks which is a slippery multitasking slope). I bound =F4= to =org-clock-goto= as an easy way to find my current/last clocked task in any mode (see keybindigs).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-clock-history-length 23
|
||
org-clock-out-when-done t
|
||
org-clock-persist t
|
||
org-clock-report-include-clocking-task t)
|
||
#+END_SRC
|
||
**** modeline
|
||
The modeline is a nice place to indicate if something is clocked in or out. Unfortunately, sometimes is is so crowded that I can't see the text for the currently clocked task. Solution, use colors.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defface nd/spaceline-highlight-clocked-face
|
||
`((t (:background "chartreuse3"
|
||
:foreground "#3E3D31"
|
||
:inherit 'mode-line)))
|
||
"Default highlight face for spaceline.")
|
||
|
||
(defun nd/spaceline-highlight-face-clocked ()
|
||
"Set the spaceline highlight color depending on if the clock is running."
|
||
(if (and (fboundp 'org-clocking-p) (org-clocking-p))
|
||
'nd/spaceline-highlight-clocked-face
|
||
'spaceline-highlight-face))
|
||
|
||
(setq spaceline-highlight-face-func 'nd/spaceline-highlight-face-clocked)
|
||
#+END_SRC
|
||
*** conflict detection
|
||
Somehow org-mode has no way to detect conflicts between tasks with timestamps (!!??). Luckily I can make my own.
|
||
**** backend
|
||
The algoithm to detect conflicts scans all org files and stores conflicts in a list of pairs of each heading with a conflicting timestamp.
|
||
|
||
Steps for this algorithm:
|
||
1. make a list of all entries with timestamps
|
||
2. sort timestamp list
|
||
3. Walk through list and compare entries immediately after (sorting ensures that entries can be skipped once one non-conflict is found). If conflicts are found push the pair to a new list (this is what is used to make the display)
|
||
|
||
This should be O(n) (best case/no conflicts) to O(n^2) (worst case/everything conflicts)
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/are-conflicting-p (ts-a ts-b)
|
||
"Return t if timestamps TS-A and TS-B conflict."
|
||
(let* ((earlier-a (car ts-a))
|
||
(earlier-b (car ts-b))
|
||
(later-b (+ earlier-b (nth 1 ts-b))))
|
||
(and (>= earlier-a earlier-b) (<= earlier-a later-b))))
|
||
|
||
(defun nd/detect-conflict (ts ts-list conlist)
|
||
"Recursively determine if timestamp TS conflicts with anything in TS-LIST.
|
||
If detected, conflict pair is added to CONLIST."
|
||
(let ((next-ts (car ts-list))
|
||
(rem-ts (cdr ts-list)))
|
||
(if (nd/are-conflicting-p ts next-ts)
|
||
(progn
|
||
(setq conlist (cons (list ts next-ts) conlist))
|
||
(if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist))
|
||
conlist)))
|
||
|
||
(defun nd/build-conlist (ts-list conlist)
|
||
"Recursively build a list of timestamp conflicts from TS-LIST.
|
||
|
||
TS-LIST is comprised of entries in the form (staring-ts timerange marker)
|
||
where timerange is 0 for singular timestamps and a positive number for
|
||
anything with to times or a timestamp range.
|
||
Detected conflicts are stored in CONLIST as pairs of conflicting ts
|
||
entries from the TS-LIST."
|
||
(let ((cur-ts (car ts-list))
|
||
(rem-ts (cdr ts-list)))
|
||
(if rem-ts
|
||
(nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist))
|
||
conlist)))
|
||
|
||
(defconst nd/org-tsm-regexp
|
||
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
|
||
"Regular expression for timestamps with two times.")
|
||
|
||
(defun nd/get-timestamps ()
|
||
"Get the org-marker and timestamp(s) (multiple if range) or current heading."
|
||
;; TODO, what if I care about more than just TIMESTAMPs
|
||
(let* ((ts (org-entry-get nil "TIMESTAMP"))
|
||
(marker (point-marker))
|
||
(ts-range 0)
|
||
(ts-entry))
|
||
(when ts
|
||
(cond
|
||
;; match timestamps that have two times
|
||
((string-match nd/org-tsm-regexp ts)
|
||
(let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts)))
|
||
(ts2 (concat (match-string 1 ts) (match-string 3 ts)))
|
||
(ft1 (org-2ft ts1))
|
||
(ft2 (org-2ft ts2)))
|
||
(setq ts-entry ft1)
|
||
(setq ts-range (- ft2 ft1))))
|
||
|
||
;; match timestamps that have a range (eq two timestamps)
|
||
((string-match org-tr-regexp ts)
|
||
(let* ((ts1 (match-string 1 ts))
|
||
(ts2 (match-string 2 ts))
|
||
(ft1 (org-2ft ts1))
|
||
(ft2 (org-2ft ts2)))
|
||
(setq ts-entry ft1)
|
||
(setq ts-range (- ft2 ft1))))
|
||
|
||
;; match timestamps with only one time
|
||
(t (setq ts-entry (org-2ft ts))))
|
||
(list ts-entry ts-range marker ts))))
|
||
|
||
(defun nd/build-conflict-list ()
|
||
"Scan all org files and make a list of all timestamps that conflict."
|
||
(let ((files (org-agenda-files))
|
||
max-reached ts-list cur-index conflicts)
|
||
;; get all timestamps from org buffers
|
||
(dolist (f files ts-list)
|
||
(with-current-buffer
|
||
(find-file-noselect f)
|
||
(goto-char (point-min))
|
||
(when (not (outline-on-heading-p)) (outline-next-heading))
|
||
(setq max-reached nil)
|
||
(while (not max-reached)
|
||
(let ((new-ts (nd/get-timestamps)))
|
||
(if new-ts (setq ts-list (cons new-ts ts-list))))
|
||
(unless (outline-next-heading) (setq max-reached t)))))
|
||
|
||
;; sort the timestamp list
|
||
;; TODO, need to make range-aware
|
||
(setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b)))))
|
||
|
||
;; build a list of conflicts
|
||
(nd/build-conlist ts-list conflicts)))
|
||
#+END_SRC
|
||
**** frontend
|
||
To display any conflicts, I could just fetch the org headings and throw them into a new buffer. But that's boring, and quite limiting. I basically want all the perks of an agenda buffer...tab-follow, the nice parent display at the bottom, time adjust hotkeys, etc. So the obvious and hacky solution is to throw together a quick-n-dirty agenda buffer which displays each conflict pair in sequentional fashion.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/get-conflict-header-text (conflict-marker)
|
||
"Return string with text properties representing the org header for
|
||
MARKER for use in the conflict agenda view."
|
||
(let* ((props (list
|
||
'face nil
|
||
'done-face 'org-agenda-done
|
||
'org-not-done-regexp org-not-done-regexp
|
||
'org-todo-regexp org-todo-regexp
|
||
'org-complex-heading-regexp org-complex-heading-regexp
|
||
'mouse-face 'highlight))
|
||
;; 'help-echo
|
||
;; (format "mouse-2 or RET jump to org file %s"
|
||
;; (abbreviate-file-name buffer-file-name))))
|
||
marker priority category level tags todo-state
|
||
ts-date ts-date-type ts-date-pair
|
||
txt beg end inherited-tags todo-state-end-pos)
|
||
|
||
(with-current-buffer (marker-buffer conflict-marker)
|
||
(save-excursion
|
||
(goto-char conflict-marker)
|
||
|
||
(setq marker (org-agenda-new-marker (point))
|
||
category (org-get-category)
|
||
ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
||
ts-date (car ts-date-pair)
|
||
ts-date-type (cdr ts-date-pair)
|
||
txt (org-get-heading t)
|
||
inherited-tags
|
||
(or (eq org-agenda-show-inherited-tags 'always)
|
||
(and (listp org-agenda-show-inherited-tags)
|
||
(memq 'todo org-agenda-show-inherited-tags))
|
||
(and (eq org-agenda-show-inherited-tags t)
|
||
(or (eq org-agenda-use-tag-inheritance t)
|
||
(memq 'todo org-agenda-use-tag-inheritance))))
|
||
tags (org-get-tags-at nil (not inherited-tags))
|
||
level (make-string (org-reduced-level (org-outline-level)) ? )
|
||
txt (org-agenda-format-item "" txt level category tags t)
|
||
priority (1+ (org-get-priority txt)))
|
||
|
||
(org-add-props txt props
|
||
'org-marker marker 'org-hd-marker marker
|
||
'priority priority
|
||
'level level
|
||
'ts-date ts-date
|
||
'type "timestamp")))))
|
||
|
||
(defun nd/org-conflicts (&optional arg)
|
||
(interactive "P")
|
||
|
||
(if org-agenda-overriding-arguments
|
||
(setq arg org-agenda-overriding-arguments))
|
||
|
||
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
|
||
|
||
(let* ((today (org-today))
|
||
(date (calendar-gregorian-from-absolute today))
|
||
(completion-ignore-case t)
|
||
(org-agenda-prefix-format '((agenda . " %-12:c %-5:e ")))
|
||
rtn rtnall files file pos)
|
||
|
||
(catch 'exit
|
||
(when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*"))
|
||
|
||
(org-agenda-prepare)
|
||
;; (org-compile-prefix-format 'todo)
|
||
(org-compile-prefix-format 'agenda)
|
||
;; (org-set-sorting-strategy 'todo)
|
||
|
||
(setq org-agenda-redo-command '(nd/org-conflicts))
|
||
|
||
(insert "Conflicting Headings: \n")
|
||
(add-text-properties (point-min) (1- (point))
|
||
(list 'face 'org-agenda-structure
|
||
'short-heading "Conflicts"))
|
||
(org-agenda-mark-header-line (point-min))
|
||
|
||
(setq rtnall (nd/build-conflict-list))
|
||
(when rtnall
|
||
(mapc
|
||
(lambda (c)
|
||
(insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n"))
|
||
(insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n"))
|
||
(insert "\n"))
|
||
rtnall))
|
||
|
||
;; clean up and finalize
|
||
(goto-char (point-min))
|
||
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
|
||
(add-text-properties
|
||
(point-min) (point-max)
|
||
`(org-agenda-type agenda
|
||
org-last-args ,arg
|
||
org-redo-cmd ,org-agenda-redo-command
|
||
org-series-cmd ,org-cmd))
|
||
(org-agenda-finalize)
|
||
(setq buffer-read-only t))))
|
||
#+END_SRC
|
||
*** agenda
|
||
**** targets
|
||
The agenda files are limited to as few as possible to keep scanning and startup reasonably fast.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-files '("~/Org"
|
||
"~/Org/projects"
|
||
"~/Org/reference/peripheral.org"))
|
||
#+END_SRC
|
||
**** appearence
|
||
***** sticky agendas
|
||
I personally like having sticky agendas by default so I can use multiple windows
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-sticky t)
|
||
#+END_SRC
|
||
***** tag alignment
|
||
The agenda does not do this by default...it's annoying
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-finalize-agenda-hook
|
||
(lambda () (setq org-agenda-tags-column (- 4 (window-width)))
|
||
(org-agenda-align-tags)))
|
||
#+END_SRC
|
||
***** prefix format
|
||
This controls what each line on the block agenda looks like. This is reformated to include effort and remove icons.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-prefix-format
|
||
'((agenda . " %-12:c %-5:e %?-12t% s")
|
||
(todo . " %-12:c")
|
||
(tags . " %-12:c %-5:e ")
|
||
(search . " %-12:c")))
|
||
#+END_SRC
|
||
***** modeline
|
||
Hide the various modules that may be present
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-agenda-trim-modeline (orig-fn &rest args)
|
||
"Advice to remove extra information from agenda modeline name."
|
||
(let ((org-agenda-include-diary nil)
|
||
(org-agenda-include-deadlines nil)
|
||
(org-agenda-use-time-grid nil)
|
||
(org-habit-show-habits nil))
|
||
(apply orig-fn args)))
|
||
|
||
(advice-add #'org-agenda-set-mode-name :around #'nd/org-agenda-trim-modeline)
|
||
#+END_SRC
|
||
***** misc
|
||
These are just some options to enable/disable some aesthetic things.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-dim-blocked-tasks nil
|
||
org-agenda-compact-blocks t
|
||
org-agenda-window-setup 'current-window
|
||
org-agenda-start-on-weekday 0
|
||
org-agenda-span 'day
|
||
org-agenda-current-time-string "### -- NOW -- ###")
|
||
#+END_SRC
|
||
|
||
Based on my screen size and usage patterns, this seems to be a good value to enable the maximum habit history to be shown without compromising aesthetics.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-habit-graph-column 50)
|
||
#+END_SRC
|
||
**** interactive filters
|
||
Rather than define infinite views for different tasks (I already have plenty of views) I use filtering to sort through the noise. Some of the built-in filters don't cut it, so I made a few of my own.
|
||
***** custom filtering functions
|
||
Some custom filters that are applied to the agenda view. Note that some of these use alternative filter types that are implemented via advising functions (see below).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-agenda-filter-non-context ()
|
||
"Filter all tasks with context tags."
|
||
(interactive)
|
||
(let* ((tags-list (mapcar #'car org-tag-alist))
|
||
(context-tags (append
|
||
(nd/filter-list-prefix "@" tags-list)
|
||
(nd/filter-list-prefix "#" tags-list))))
|
||
(setq org-agenda-tag-filter
|
||
(mapcar (lambda (tag) (concat "-" tag)) context-tags))
|
||
(org-agenda-filter-apply org-agenda-tag-filter 'tag)))
|
||
|
||
(defun nd/org-agenda-filter-non-peripheral ()
|
||
"Filter all tasks that don't have peripheral tags."
|
||
(interactive)
|
||
(let* ((peripheral-tags '("PERIPHERAL")))
|
||
(setq org-agenda-tag-filter
|
||
(mapcar (lambda (tag) (concat "-" tag)) peripheral-tags))
|
||
(org-agenda-filter-apply org-agenda-tag-filter 'tag)))
|
||
|
||
(defun nd/org-agenda-filter-non-effort ()
|
||
"Filter agenda by non-effort tasks."
|
||
(interactive)
|
||
(setq org-agenda-hasprop-filter '("-Effort"))
|
||
(org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop))
|
||
|
||
(defun nd/org-agenda-filter-delegate ()
|
||
"Filter agenda by tasks with an external delegate."
|
||
(interactive)
|
||
(setq org-agenda-hasprop-filter '("+DELEGATE"))
|
||
(org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop))
|
||
#+END_SRC
|
||
***** filter advice
|
||
In order to implement the =hasprop= filter, the functions =org-agenda-filter-make-matcher= and =org-agenda-filter-remove-all= need to be advised in order to add the functionality for the =hasprop= filter type.
|
||
|
||
As it is, this allows any filter using =hasprop= to be applied and removed using the standard =org-agenda-filter-apply= function with the =org-agenda-hasprop-filter= variable (obviously these can all be extended to different filter types). Note this does not give a shiny indicator at the bottom of spaceline like the built-in filter does...oh well.
|
||
#+BEGIN_SRC emacs-lisp
|
||
;; initialize new filters
|
||
(defvar org-agenda-hasprop-filter nil)
|
||
|
||
(defun nd/org-agenda-filter-make-matcher-prop
|
||
(filter type &rest args)
|
||
"Return matching matcher form for FILTER and TYPE where TYPE is not
|
||
in the regular `org-agenda-filter-make-matcher' function. This is
|
||
intended to be uses as :before-until advice and will return nil if
|
||
the type is not valid (which is currently 'prop')"
|
||
(let (f f1)
|
||
;; has property
|
||
(cond
|
||
((eq type 'hasprop)
|
||
(dolist (x filter)
|
||
(push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f))))
|
||
(if f (cons 'and (nreverse f)))))
|
||
|
||
(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h)
|
||
"Returns form to test the presence or absence of properties H.
|
||
H is a string like +prop or -prop"
|
||
(let (op)
|
||
(let* ((op (string-to-char h))
|
||
(h (substring h 1))
|
||
(f `(save-excursion
|
||
(let ((m (org-get-at-bol 'org-hd-marker)))
|
||
(with-current-buffer
|
||
(marker-buffer m)
|
||
(goto-char m)
|
||
(org-entry-get nil ,h))))))
|
||
(if (eq op ?-) (list 'not f) f))))
|
||
|
||
(defun nd/org-agenda-filter-show-all-hasprop nil
|
||
(org-agenda-remove-filter 'hasprop))
|
||
|
||
(advice-add #'org-agenda-filter-make-matcher :before-until
|
||
#'nd/org-agenda-filter-make-matcher-prop)
|
||
|
||
(advice-add #'org-agenda-filter-remove-all :before
|
||
(lambda () (when org-agenda-hasprop-filter
|
||
(nd/org-agenda-filter-show-all-hasprop))))
|
||
#+END_SRC
|
||
**** bulk actions
|
||
These add to the existing bulk actions in the agenda view.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-bulk-custom-functions
|
||
'((?D nd/org-agenda-delete-subtree)))
|
||
#+END_SRC
|
||
**** holidays and birthdays
|
||
If I don't include this, I actually forget about major holidays.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq holiday-bahai-holidays nil
|
||
holiday-hebrew-holidays nil
|
||
holiday-oriental-holidays nil
|
||
holiday-islamic-holidays nil)
|
||
|
||
(setq calendar-holidays (append holiday-general-holidays
|
||
holiday-christian-holidays))
|
||
#+END_SRC
|
||
**** block agenda library
|
||
These are functions and variables exclusively for agenda block manipulation within the context of =org-custom-agenda-commands=.
|
||
***** constants
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defconst nd/iter-future-time (* 7 24 60 60)
|
||
"Iterators must have at least one task greater into the future to be active.")
|
||
|
||
(defconst nd/archive-delay-days 30
|
||
"The number of days to wait before tasks are considered archivable.")
|
||
|
||
(defconst nd/inert-delay-days 90
|
||
"The number of days to wait before tasks are considered inert.")
|
||
|
||
(defconst nd/iter-statuscodes '(:uninit :empty :active)
|
||
"Iterators can have these statuscodes.")
|
||
|
||
(defconst nd/peri-future-time nd/iter-future-time
|
||
"Periodicals must have at least one heading greater into the future to be fresh.")
|
||
|
||
(defconst nd/peri-statuscodes '(:uninit :stale :fresh))
|
||
|
||
(defconst nd/project-invalid-todostates
|
||
'("WAIT" "NEXT")
|
||
"Projects cannot have these todostates.")
|
||
|
||
(defconst nd/org-agenda-todo-sort-order
|
||
'("NEXT" "WAIT" "HOLD" "TODO")
|
||
"Defines the order in which todo keywords should be sorted.")
|
||
|
||
(defconst nd/project-skip-todostates
|
||
'("HOLD" "CANC")
|
||
"These keywords override all contents within their subtrees.
|
||
Currently used to tell skip functions when they can hop over
|
||
entire subtrees to save time and ignore tasks")
|
||
#+END_SRC
|
||
***** variables
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defvar nd/agenda-limit-project-toplevel t
|
||
"If true, filter projects by all levels or top level only.")
|
||
|
||
(defvar nd/agenda-hide-incubator-tags t
|
||
"If true, don't show incubator headings.")
|
||
#+END_SRC
|
||
***** task helper functions
|
||
These are the building blocks for skip functions.
|
||
****** timestamps
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-entry-get-ia-timestamp ()
|
||
"Get the inactive timestamp of the current entry but skip those in logbooks."
|
||
(let (( (re-search-forward regexp end t)))))
|
||
|
||
(defun nd/get-date-property (timestamp-property)
|
||
"Get TIMESTAMP-PROPERTY on current heading and convert to a number.
|
||
If it does not have a date, it will return nil."
|
||
(let ((ts (org-entry-get nil timestamp-property)))
|
||
(when ts (org-2ft ts))))
|
||
|
||
(defun nd/heading-compare-timestamp (timestamp-fun
|
||
&optional ref-time future)
|
||
"Returns the timestamp (from TIMESTAMP-FUM on the current heading)
|
||
if timestamp is futher back in time compared to a REF-TIME (default to
|
||
0 which is now, where negative is past and positive is future). If the
|
||
FUTURE flag is t, returns timestamp if it is in the future compared
|
||
to REF-TIME. Returns nil if no timestamp is found."
|
||
(let* ((timestamp (funcall timestamp-fun))
|
||
(ref-time (or ref-time 0)))
|
||
(if (and timestamp
|
||
(if future
|
||
(> (- timestamp (float-time)) ref-time)
|
||
(<= (- timestamp (float-time)) ref-time)))
|
||
timestamp)))
|
||
|
||
(defun nd/is-created-heading-p ()
|
||
"Return heading's CREATED property timestamp or nil."
|
||
(nd/get-date-property "CREATED"))
|
||
|
||
(defun nd/is-ia-timestamped-heading-p ()
|
||
"Get active timestamp of current heading."
|
||
(nd/get-date-property "TIMESTAMP_IA"))
|
||
|
||
(defun nd/is-timestamped-heading-p ()
|
||
"Get active timestamp of current heading."
|
||
(nd/get-date-property "TIMESTAMP"))
|
||
|
||
(defun nd/is-scheduled-heading-p ()
|
||
"Get scheduled timestamp of current heading."
|
||
(nd/get-date-property "SCHEDULED"))
|
||
|
||
(defun nd/is-deadlined-heading-p ()
|
||
"Get deadline timestamp of current heading."
|
||
(nd/get-date-property "DEADLINE"))
|
||
|
||
(defun nd/is-closed-heading-p ()
|
||
"Get closed timestamp of current heading."
|
||
(nd/get-date-property "CLOSED"))
|
||
|
||
(defun nd/is-stale-heading-p (&optional ts-prop)
|
||
"Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale."
|
||
(nd/heading-compare-timestamp
|
||
(lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP"))))
|
||
(when (and ts (not (find ?+ ts))) (org-2ft ts))))))
|
||
|
||
(defun nd/is-fresh-heading-p ()
|
||
"Return timestamp if current heading is fresh."
|
||
(nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t))
|
||
|
||
(defun nd/is-archivable-heading-p ()
|
||
"Return timestamp if current heading is archivable."
|
||
(nd/heading-compare-timestamp
|
||
'nd/is-closed-heading-p
|
||
(- (* 60 60 24 nd/archive-delay-days))))
|
||
|
||
(defun nd/is-inert-heading-p ()
|
||
"Return timestamp if current heading is inert."
|
||
(nd/heading-compare-timestamp
|
||
'nd/is-ia-timestamped-heading-p
|
||
(- (* 60 60 24 nd/inert-delay-days))))
|
||
#+END_SRC
|
||
****** task level testing
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/is-todoitem-p ()
|
||
"Return todo keyword if heading has one."
|
||
(let ((keyword (nth 2 (org-heading-components))))
|
||
(if (member keyword org-todo-keywords-1)
|
||
keyword)))
|
||
|
||
(defun nd/is-project-p ()
|
||
"Return todo keyword if heading has todoitem children."
|
||
(and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p)))
|
||
|
||
(defun nd/is-task-p ()
|
||
"Return todo keyword if heading has no todoitem children."
|
||
(and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p)))
|
||
|
||
(defun nd/is-project-task-p ()
|
||
"Return todo keyword if heading has todoitem parents."
|
||
(and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p)))
|
||
|
||
(defun nd/is-atomic-task-p ()
|
||
"Return todo keyword if heading has no todoitem parents or children."
|
||
(and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p)))
|
||
#+END_SRC
|
||
****** property testing
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/is-periodical-heading-p ()
|
||
"Return t if heading is a periodical."
|
||
(equal "periodical" (org-entry-get nil "PARENT_TYPE" t)))
|
||
|
||
(defun nd/is-iterator-heading-p ()
|
||
"Return t if heading is an iterator."
|
||
(equal "iterator" (org-entry-get nil "PARENT_TYPE" t)))
|
||
|
||
(defun nd/heading-has-effort-p ()
|
||
"Return t if heading has an effort."
|
||
(org-entry-get nil "Effort"))
|
||
|
||
(defun nd/heading-has-context-p ()
|
||
"Return t if heading has a context."
|
||
(let ((tags (org-get-tags-at)))
|
||
(or (> (length (nd/filter-list-prefix "#" tags)) 0)
|
||
(> (length (nd/filter-list-prefix "@" tags)) 0))))
|
||
|
||
(defun nd/heading-has-tag-p (tag)
|
||
"Return t if heading has tag TAG."
|
||
(member tag (org-get-tags-at)))
|
||
#+END_SRC
|
||
****** relational testing
|
||
Returns t if heading has certain relationship to other headings
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/heading-has-children (heading-test)
|
||
"Return t if heading has a child for whom HEADING-TEST is t."
|
||
(let ((subtree-end (save-excursion (org-end-of-subtree t)))
|
||
has-children previous-point)
|
||
(save-excursion
|
||
(setq previous-point (point))
|
||
(outline-next-heading)
|
||
(while (and (not has-children)
|
||
(< previous-point (point) subtree-end))
|
||
(when (funcall heading-test)
|
||
(setq has-children t))
|
||
(setq previous-point (point))
|
||
(org-forward-heading-same-level 1 t)))
|
||
has-children))
|
||
|
||
(defun nd/heading-has-parent (heading-test)
|
||
"Return t if heading has parent for whom HEADING-TEST is t."
|
||
(save-excursion (and (org-up-heading-safe) (funcall heading-test))))
|
||
|
||
(defun nd/has-discontinuous-parent ()
|
||
"Return t if heading has a non-todoitem parent which in turn has a todoitem parent."
|
||
(let ((has-todoitem-parent)
|
||
(has-non-todoitem-parent))
|
||
(save-excursion
|
||
(while (and (org-up-heading-safe)
|
||
(not has-todoitem-parent))
|
||
(if (nd/is-todoitem-p)
|
||
(setq has-todoitem-parent t)
|
||
(setq has-non-todoitem-parent t))))
|
||
(and has-todoitem-parent has-non-todoitem-parent)))
|
||
#+END_SRC
|
||
****** project level testing
|
||
Projects are tested according to their statuscodes, which in turn are a function of the todo keywords and timestamps of their individual subtasks.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list)
|
||
"Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP."
|
||
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
|
||
|
||
(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status)
|
||
"Loop through (sub)project and return overall statuscode.
|
||
|
||
The returned statuscode is chosen from list ALLOWED-STATUSCODES where
|
||
later entries in the list trump earlier ones.
|
||
|
||
When a subproject is encountered, this function will obtain the
|
||
statuscode of that project and use TRANS-TBL to translate the
|
||
subproject statuscode to one in ALLOWED-STATUSCODES (if not found an
|
||
error will be raised). TRANS-TBL is given as an alist of two-member
|
||
cons cells where the first member is the subproject statuscode and the
|
||
second is the index in ALLOWED-STATUSCODES to which the subproject
|
||
statuscode will be translated.
|
||
|
||
When a task is encountered, function GET-TASK-STATUS will be applied to
|
||
obtain a statuscode-equivalent of the status of the tasks."
|
||
;; define "breaker-status" as the last of the allowed-statuscodes
|
||
;; when this is encountered the loop is broken because we are done
|
||
;; (the last entry trumps all others)
|
||
(let ((project-status (first allowed-statuscodes))
|
||
(breaker-status (car (last allowed-statuscodes)))
|
||
(previous-point))
|
||
(save-excursion
|
||
(setq previous-point (point))
|
||
(outline-next-heading)
|
||
;; loop through subproject tasks until breaker-status found
|
||
(while (and (not (eq project-status breaker-status))
|
||
(> (point) previous-point))
|
||
(let ((keyword (nd/is-todoitem-p)))
|
||
(if keyword
|
||
(let ((new-status
|
||
;; if project then descend recursively
|
||
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||
(let ((n (nd/get-project-status)))
|
||
;; if project returns an allowed status
|
||
;; then use that
|
||
(or (and (member n allowed-statuscodes) n)
|
||
;; otherwise look up the value in the
|
||
;; translation table and return error
|
||
;; if not found
|
||
(nth (or (alist-get n trans-tbl)
|
||
(error (concat "status not found: " n)))
|
||
allowed-statuscodes)))
|
||
;; if tasks then use get-task-status to obtain status
|
||
(nth (funcall get-task-status keyword)
|
||
allowed-statuscodes))))
|
||
(if (nd/compare-statuscodes > new-status project-status allowed-statuscodes)
|
||
(setq project-status new-status)))))
|
||
(setq previous-point (point))
|
||
(org-forward-heading-same-level 1 t)))
|
||
project-status))
|
||
|
||
(defun nd/get-project-status ()
|
||
"Return project heading statuscode (assumes it is indeed a project)."
|
||
(let ((keyword (nd/is-todoitem-p)))
|
||
;;
|
||
;; these first three are easy because they only require
|
||
;; testing the project headline and nothing underneath
|
||
;;
|
||
(cond
|
||
;; it does not make sense for projects to be scheduled
|
||
((nd/is-scheduled-heading-p) :scheduled-project)
|
||
|
||
;; held projects do not care what is underneath them
|
||
((equal keyword "HOLD") :held)
|
||
|
||
;; projects with invalid todostates are nonsense
|
||
((member keyword nd/project-invalid-todostates)
|
||
:invalid-todostate)
|
||
|
||
;;
|
||
;; these require descending into the project subtasks
|
||
;;
|
||
|
||
;; canceled projects can either be archivable or complete
|
||
;; any errors or undone tasks are irrelevant
|
||
((equal keyword "CANC")
|
||
(nd/descend-into-project
|
||
'(:archivable :complete)
|
||
'((:stuck . 1)
|
||
(:held . 1)
|
||
(:waiting . 1)
|
||
(:active . 1)
|
||
(:scheduled-project . 1)
|
||
(:invalid-todostate . 1)
|
||
(:undone-complete . 1)
|
||
(:done-incomplete . 1))
|
||
(lambda (k)
|
||
(if (and (member k org-done-keywords)
|
||
(nd/is-archivable-heading-p)) 0 1))))
|
||
|
||
;; done projects are like canceled projects but can also be incomplete
|
||
((equal keyword "DONE")
|
||
(nd/descend-into-project
|
||
'(:archivable :complete :done-incomplete)
|
||
'((:stuck . 2)
|
||
(:held . 2)
|
||
(:waiting . 2)
|
||
(:active . 2)
|
||
(:scheduled-project . 2)
|
||
(:invalid-todostate . 2)
|
||
(:undone-complete . 2))
|
||
(lambda (k)
|
||
(if (member k org-done-keywords)
|
||
(if (nd/is-archivable-heading-p) 0 1)
|
||
2))))
|
||
|
||
;; project with TODO states could be basically any status
|
||
((equal keyword "TODO")
|
||
(nd/descend-into-project
|
||
'(:undone-complete :stuck :held :waiting :active)
|
||
'((:complete . 0)
|
||
(:archivable . 0)
|
||
(:scheduled-project . 1)
|
||
(:invalid-todostate . 1)
|
||
(:done-incomplete . 1))
|
||
(lambda (k)
|
||
(cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1))
|
||
((equal k "HOLD") 2)
|
||
((equal k "WAIT") 3)
|
||
((equal k "NEXT") 4)
|
||
(t 0)))))
|
||
|
||
(t (error (concat "invalid keyword detected: " keyword))))))
|
||
#+END_SRC
|
||
****** repeater testing
|
||
Iterators and periodicals are tested similarly to projects in that they have statuscodes.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/get-iterator-status ()
|
||
"Get the status of an iterator where allowed statuscodes are in list
|
||
`nd/get-iter-statuscodes.' where latter codes in the list trump
|
||
earlier ones."
|
||
(let ((iter-status (first nd/iter-statuscodes))
|
||
(subtree-end (save-excursion (org-end-of-subtree t))))
|
||
(save-excursion
|
||
(setq previous-point (point))
|
||
(outline-next-heading)
|
||
(while (and (not (eq iter-status :active))
|
||
(< (point) subtree-end))
|
||
(let ((keyword (nd/is-atomic-task-p))
|
||
(new-status))
|
||
(if keyword
|
||
(progn
|
||
(setq new-status (if (nd/heading-compare-timestamp
|
||
(lambda ()
|
||
(or (nd/is-scheduled-heading-p)
|
||
(nd/is-deadlined-heading-p)))
|
||
nd/iter-future-time t)
|
||
:active
|
||
:empty))
|
||
(if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes)
|
||
(setq iter-status new-status)))))
|
||
(outline-next-heading)))
|
||
iter-status))
|
||
|
||
(defun nd/get-periodical-status ()
|
||
"Get the status of a periodical where allowed statuscodes are in list
|
||
`nd/get-peri-statuscodes.' where latter codes in the list trump
|
||
earlier ones."
|
||
(let ((peri-status :uninit)
|
||
(subtree-end (save-excursion (org-end-of-subtree t))))
|
||
(save-excursion
|
||
(setq previous-point (point))
|
||
(outline-next-heading)
|
||
(while (and (not (eq peri-status :fresh))
|
||
(< (point) subtree-end))
|
||
(if (and (nd/is-periodical-heading-p)
|
||
(not (nd/heading-has-children 'nd/is-periodical-heading-p)))
|
||
(let ((new-status
|
||
(if (nd/heading-compare-timestamp
|
||
'nd/is-timestamped-heading-p
|
||
nd/iter-future-time t)
|
||
:fresh
|
||
:stale)))
|
||
(if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes)
|
||
(setq peri-status new-status))))
|
||
(outline-next-heading)))
|
||
peri-status))
|
||
#+END_SRC
|
||
***** skip functions
|
||
These are the primary means used to sort through tasks and build agenda block views
|
||
****** helper skip functions and macros
|
||
Subunits for skip functions. Not meant to be used or called from the custom commands api
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-heading ()
|
||
"Skip forward to next heading."
|
||
(save-excursion (or (outline-next-heading) (point-max))))
|
||
|
||
(defun nd/skip-subtree ()
|
||
"Skip forward to next subtree."
|
||
(save-excursion (or (org-end-of-subtree t) (point-max))))
|
||
|
||
|
||
(defmacro nd/skip-heading-without (heading-fun test-fun)
|
||
"Skip headings accoring to certain characteristics.
|
||
|
||
HEADING-FUN is a function that tests the heading and returns the
|
||
todoitem keyword on success. TEST-FUN is a function that further tests
|
||
the identity of the heading and may or may not use the keyword output
|
||
supplied by the HEADING-FUN. This function will not skip if
|
||
HEADING-FUN and TEST-FUN return true"
|
||
`(save-restriction
|
||
(widen)
|
||
(let ((keyword (,heading-fun)))
|
||
;; (message keyword)
|
||
(if (not (and keyword ,test-fun))
|
||
(nd/skip-heading)))))
|
||
#+END_SRC
|
||
****** headings
|
||
Skip functions for headings which may or may not be todo-items.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list)
|
||
"Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST."
|
||
(save-restriction
|
||
(widen)
|
||
(let ((heading-tags (org-get-tags-at)))
|
||
(if (and (or (not pos-tags-list)
|
||
(intersection pos-tags-list heading-tags :test 'equal))
|
||
(not (intersection neg-tags-list heading-tags :test 'equal)))
|
||
(nd/skip-heading)))))
|
||
|
||
(defun nd/skip-non-stale-headings ()
|
||
"Skip headings that do not have stale timestamps and are not part of projects."
|
||
(save-restriction
|
||
(widen)
|
||
(let ((keyword (nd/is-todoitem-p)))
|
||
(if (not
|
||
(and (nd/is-stale-heading-p)
|
||
(not (member keyword org-done-keywords))
|
||
(not (nd/heading-has-children 'nd/is-todoitem-p))
|
||
(not (nd/heading-has-parent 'nd/is-todoitem-p))))
|
||
(nd/skip-heading)))))
|
||
#+END_SRC
|
||
****** tasks
|
||
A few functions apply to both atomic tasks and project tasks the same.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-created-tasks ()
|
||
"Skip tasks that do not have CREATED timestamp properties."
|
||
(save-excursion
|
||
(widen)
|
||
(if (not (and (nd/is-task-p)
|
||
(not (nd/is-created-heading-p))))
|
||
(nd/skip-heading))))
|
||
#+END_SRC
|
||
****** atomic tasks
|
||
By definition these have no parents, so I don't need to worry about skipping over projects. Any todo state is valid and we only sort by done/canc
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-atomic-tasks ()
|
||
"Skip headings that are not atomic tasks."
|
||
(save-excursion
|
||
(widen)
|
||
(if (not (nd/is-atomic-task-p))
|
||
(nd/skip-heading))))
|
||
|
||
(defun nd/skip-non-closed-atomic-tasks ()
|
||
"Skip headings that are not complete (but not archivable) atomic tasks."
|
||
(nd/skip-heading-without
|
||
nd/is-atomic-task-p
|
||
(and (member keyword org-done-keywords)
|
||
(not (nd/is-archivable-heading-p)))))
|
||
|
||
(defun nd/skip-non-archivable-atomic-tasks ()
|
||
"Skip headings that are not archivable atomic tasks."
|
||
(nd/skip-heading-without
|
||
nd/is-atomic-task-p
|
||
(nd/is-archivable-heading-p)))
|
||
#+END_SRC
|
||
****** repeaters
|
||
These are headings marked with PARENT_TYPE property that have timestamped headings as children. They are to be refilled when all children are stale. Note that I only care about the parent headings as the children should always show up in the agenda simply because they have timestamps. Parents can be either fresh (at least one child in the future) or stale (all children in the past).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-iterator-parent-headings ()
|
||
"Skip headings that are not toplevel iterator headings."
|
||
(save-restriction
|
||
(widen)
|
||
(if (not (and (nd/is-iterator-heading-p)
|
||
(not (nd/heading-has-parent 'nd/is-iterator-heading-p))))
|
||
(nd/skip-heading))))
|
||
|
||
(defun nd/skip-non-iterator-unscheduled ()
|
||
"Skip all headings that are not unscheduled iterator children."
|
||
(nd/skip-heading-without
|
||
nd/is-atomic-task-p
|
||
(not (or (nd/is-scheduled-heading-p)
|
||
(nd/is-deadlined-heading-p)))))
|
||
|
||
(defun nd/skip-non-periodical-parent-headings ()
|
||
"Skip headings that are not toplevel periodical headings."
|
||
(save-restriction
|
||
(widen)
|
||
(if (not (and (nd/is-periodical-heading-p)
|
||
(not (nd/heading-has-parent 'nd/is-periodical-heading-p))))
|
||
(nd/skip-heading))))
|
||
|
||
(defun nd/skip-non-periodical-untimestamped ()
|
||
"Skip all headings that are not periodical children without a timestamp."
|
||
(save-restriction
|
||
(widen)
|
||
(if (not (and (nd/is-periodical-heading-p)
|
||
(not (nd/is-timestamped-heading-p))
|
||
(not (nd/heading-has-children 'nd/is-periodical-heading-p))))
|
||
(nd/skip-heading))))
|
||
#+END_SRC
|
||
****** project tasks
|
||
Note that I don't care about the timestamp in these cases because I don't archive these; I archive their parent projects. The keywords I care about are NEXT, WAIT, and HOLD because these are definitive project tasks that require/inhibit futher action. (TODO = stuck which I take care of at the project level, and DONE/CANC = archivable which is dealt with similarly)
|
||
|
||
For performance, I need to assess if the parent project is skippable, in which case I jump to the next subtree.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-project-tasks ()
|
||
"Skip headings that are not project tasks."
|
||
(save-restriction
|
||
(widen)
|
||
(let ((keyword (nd/is-todoitem-p)))
|
||
(if keyword
|
||
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||
(if (member keyword nd/project-skip-todostates)
|
||
(nd/skip-subtree)
|
||
(nd/skip-heading))
|
||
(if (not (nd/heading-has-parent 'nd/is-todoitem-p))
|
||
(nd/skip-heading)))
|
||
(nd/skip-heading)))))
|
||
#+END_SRC
|
||
****** heading-level errors
|
||
Some headings are invalid under certain conditions; these are tested here.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-discontinuous-project-tasks ()
|
||
"Skip headings that are not discontinuous within projects."
|
||
(nd/skip-heading-without
|
||
nd/is-todoitem-p
|
||
(nd/has-discontinuous-parent)))
|
||
|
||
(defun nd/skip-non-done-unclosed-todoitems ()
|
||
"Skip headings that are not completed without a closed timestamp."
|
||
(nd/skip-heading-without
|
||
nd/is-todoitem-p
|
||
(and (member keyword org-done-keywords)
|
||
(not (nd/is-closed-heading-p)))))
|
||
|
||
(defun nd/skip-non-undone-closed-todoitems ()
|
||
"Skip headings that are not incomplete with a closed timestamp."
|
||
(nd/skip-heading-without
|
||
nd/is-todoitem-p
|
||
(and (not (member keyword org-done-keywords))
|
||
(nd/is-closed-heading-p))))
|
||
#+END_SRC
|
||
****** projects
|
||
Projects are handled quite simply. They have statuscodes for which I test, and this can all be handled by one function. Note that this is used for "normal" projects as well as repeaters.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/skip-non-projects (&optional ignore-toplevel)
|
||
"Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)."
|
||
(save-restriction
|
||
(widen)
|
||
(let ((keyword (nd/is-project-p)))
|
||
(if keyword
|
||
(if (and nd/agenda-limit-project-toplevel
|
||
(not ignore-toplevel)
|
||
(nd/heading-has-parent 'nd/is-todoitem-p))
|
||
(nd/skip-subtree))
|
||
(nd/skip-heading)))))
|
||
#+END_SRC
|
||
***** sorting and filtering
|
||
These are used to filter and sort within block agendas (note this is different from the other filtering functions above as these are non-interactive).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-agenda-filter-status (filter status-fun a-line
|
||
&optional filter-only)
|
||
"Filter for `org-agenda-before-sorting-filter-function' intended for
|
||
agenda project views (eg makes the assumption that all entries are
|
||
from projects in the original org buffer) wherein this function will
|
||
filter project headings based on their statuscodes.
|
||
|
||
It works by going to the original org buffer and determining the
|
||
project status using STATUS-FUN, after which it will check if
|
||
status is in FILTER (a list of statuscodes). If true, the flag string
|
||
in the prefix is replaced with the status, and the status is set as a
|
||
text property for further sorting.
|
||
|
||
If option FILTER-ONLY is t, function only return the unmodified a-line
|
||
or nil to act as a filter (eg does not touch text properties)."
|
||
(let* ((m (get-text-property 1 'org-marker a-line))
|
||
(s (with-current-buffer (marker-buffer m)
|
||
(goto-char m)
|
||
(funcall status-fun))))
|
||
(if (member s filter)
|
||
(if filter-only
|
||
a-line
|
||
(org-add-props (replace-regexp-in-string
|
||
"xxxx" (symbol-name s) a-line)
|
||
nil 'project-status s)))))
|
||
|
||
(defun nd/org-agenda-sort-prop (prop order a b)
|
||
"Sort a block agenda view by text property PROP given a list ORDER
|
||
of said text properties in the desired order and lines A and B as
|
||
inputs. To be used with `org-agenda-cmp-user-defined'."
|
||
(let* ((ta (get-text-property 1 prop a))
|
||
(tb (get-text-property 1 prop b))
|
||
(pa (position ta order :test (if (stringp ta) #'equal)))
|
||
(pb (position tb order :test (if (stringp tb) #'equal))))
|
||
(cond ((or (null pa) (null pb)) nil)
|
||
((< pa pb) +1)
|
||
((> pa pb) -1))))
|
||
#+END_SRC
|
||
***** block view building macros
|
||
Some useful shorthands to create block agenda views
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/agenda-base-heading-cmd (match header skip-fun)
|
||
"Make a tags agenda view that matches tags in string MATCH with
|
||
header given as string HEADER and with skip function SKIP-FUN."
|
||
`(tags
|
||
,match
|
||
((org-agenda-overriding-header ,header)
|
||
(org-agenda-skip-function ,skip-fun)
|
||
(org-agenda-sorting-strategy '(category-keep)))))
|
||
|
||
(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort)
|
||
"Make a tags-todo agenda view that matches tags in string MATCH with
|
||
header given as string HEADER and with skip function SKIP-FUN. Also
|
||
takes a sorting structure SORT which is passed to
|
||
`org-agenda-sorting-strategy'"
|
||
(or sort (setq sort ''(category-keep)))
|
||
`(tags-todo
|
||
,match
|
||
((org-agenda-overriding-header ,header)
|
||
(org-agenda-skip-function ,skip-fun)
|
||
(org-agenda-todo-ignore-with-date t)
|
||
(org-agenda-sorting-strategy ,sort))))
|
||
|
||
(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun
|
||
&optional todo status-px)
|
||
"Make a tags-todo agenda view that matches tags in string MATCH with
|
||
header given as string HEADER and with skip function SKIP-FUN. KW-LIST
|
||
is a list of keywords to be used in filtering and sorting (the order
|
||
in the list defines the sort order). STATUS-FUN is a function used to
|
||
get the statuscode of the current line in the agenda. Optional arg
|
||
TODO determines if this is a tags-todo (t) or tags (nil) block, and
|
||
STATUS-PX as t enables the statuscode to be formatted into the prefix
|
||
string."
|
||
`(,(if 'tags-todo 'tags)
|
||
,match
|
||
((org-agenda-overriding-header ,header)
|
||
(org-agenda-skip-function ,skip-fun)
|
||
(org-agenda-before-sorting-filter-function
|
||
(lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l)))
|
||
(org-agenda-cmp-user-defined
|
||
(lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b)))
|
||
(org-agenda-prefix-format '((tags . ,(if status-px
|
||
" %-12:c %(format \"xxxx: \")"
|
||
" %-12:c "))))
|
||
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))
|
||
#+END_SRC
|
||
***** interactive functions
|
||
This is basically a filter but since it is implemented through skip functions it makes more sense to include it here. It allows distinguishing between toplevel projects and projects that are subprojects of the toplevel project (I usually only care about the former).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/toggle-project-toplevel-display ()
|
||
"Toggle all project headings and toplevel only headings in project blocks."
|
||
(interactive)
|
||
(setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel))
|
||
(when (equal major-mode 'org-agenda-mode)
|
||
(org-agenda-redo))
|
||
(message "Showing %s project view in agenda"
|
||
(if nd/agenda-limit-project-toplevel "toplevel" "complete")))
|
||
#+END_SRC
|
||
***** advising
|
||
Some org functions don't do exactly what I want. Re-educate them here
|
||
****** org-tags-view done keywords
|
||
The =org-tags-view= can filter tags for only headings with TODO keywords (with type tags-todo), but this automatically excludes keywords in =org-done-keywords=. Therefore, if I want to include these in any custom agenda blocks, I need to use type tags instead and skip the unwanted TODO keywords with a skip function. This is far slower as it applies the skip function to EVERY heading.
|
||
|
||
Fix that here by nullifying =org--matcher-tags-todo-only= which controls how the matcher is created for tags and tags-todo. Now I can select done keywords using a match string like "+tag/DONE|CANC" (also much clearer in my opinion).
|
||
|
||
While this is usually more efficient, it may be counterproductive in cases where skip functions can be used to ignore huge sections of an org file (which is rarely for me; most only skip ahead to the next heading).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-tags-view-advice (orig-fn &optional todo-only match)
|
||
"Advice to include done states in `org-tags-view' for tags-todo agenda types."
|
||
(nd/with-advice
|
||
((#'org-make-tags-matcher
|
||
:around (lambda (f m)
|
||
(let ((org--matcher-tags-todo-only nil))
|
||
(funcall f m)))))
|
||
(funcall orig-fn todo-only match)))
|
||
|
||
(advice-add #'org-tags-view :around #'nd/org-tags-view-advice)
|
||
#+END_SRC
|
||
**** block agenda views
|
||
***** default sorting
|
||
This gives more flexibility in ignoring items with timestamps
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-tags-todo-honor-ignore-options t)
|
||
#+END_SRC
|
||
|
||
By default I want block agendas to sort based on the todo keyword (with NEXT being up top as these have priority).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-agenda-cmp-user-defined
|
||
'(lambda (a b)
|
||
(let ((pa (- (length (member
|
||
(get-text-property 1 'todo-state a)
|
||
nd/org-agenda-todo-sort-order))))
|
||
(pb (- (length (member
|
||
(get-text-property 1 'todo-state b)
|
||
nd/org-agenda-todo-sort-order)))))
|
||
(cond ((or (null pa) (null pb)) nil)
|
||
((> pa pb) +1)
|
||
((< pa pb) -1)))))
|
||
|
||
#+END_SRC
|
||
***** custom commands
|
||
These agenda commands are the center of the gtd workflow. Some are slower than dirt but that's ok becuase the load times are far less than the that I would waste rifling through each org file trying to find a task.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(let* ((actionable "-NA-REFILE-%inc")
|
||
(periodical "PARENT_TYPE=\"periodical\"")
|
||
(iterator "PARENT_TYPE=\"iterator\"")
|
||
(habit "STYLE=\"habit\"")
|
||
(task-match (concat actionable "-" periodical "-" habit "/!"))
|
||
(act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!"))
|
||
(peri-match (concat actionable "+" periodical "-" iterator "-" habit))
|
||
(iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!")))
|
||
|
||
(setq
|
||
org-agenda-custom-commands
|
||
`(("a"
|
||
"Calendar View"
|
||
((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE")))
|
||
(org-agenda-include-diary t)))))
|
||
|
||
("t"
|
||
"Task View"
|
||
(,(nd/agenda-base-task-cmd act-no-rep-match
|
||
"Project Tasks"
|
||
''nd/skip-non-project-tasks
|
||
''(user-defined-up category-keep))
|
||
,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)))
|
||
|
||
("p"
|
||
"Project View"
|
||
(,(nd/agenda-base-project-cmd
|
||
act-no-rep-match
|
||
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects")
|
||
''nd/skip-non-projects
|
||
''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete
|
||
:stuck :waiting :held :active)
|
||
''nd/get-project-status t t)))
|
||
|
||
("i"
|
||
"Incubator View"
|
||
((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc")))
|
||
(org-agenda-span 7)
|
||
(org-agenda-time-grid nil)
|
||
(org-agenda-entry-types '(:deadline :timestamp :scheduled))))
|
||
,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc"
|
||
"Stale Incubated Timestamps"
|
||
''nd/skip-non-stale-headings)
|
||
,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!"
|
||
"Incubated Tasks"
|
||
''nd/skip-non-atomic-tasks)
|
||
,(nd/agenda-base-project-cmd
|
||
"-NA-REFILE+%inc/!"
|
||
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects")
|
||
''nd/skip-non-projects
|
||
''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete
|
||
:stuck :waiting :held :active)
|
||
''nd/get-project-status
|
||
t t)))
|
||
|
||
("P"
|
||
"Periodical View"
|
||
(,(nd/agenda-base-project-cmd
|
||
(concat actionable "-" iterator "+" periodical "-" habit)
|
||
"Periodical Status"
|
||
''nd/skip-non-periodical-parent-headings
|
||
'nd/peri-statuscodes ''nd/get-periodical-status nil t)
|
||
,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\""
|
||
"Untimestamped"
|
||
''nd/skip-non-periodical-untimestamped)))
|
||
|
||
("I"
|
||
"Iterator View"
|
||
(,(nd/agenda-base-project-cmd
|
||
"-NA-REFILE+PARENT_TYPE=\"iterator\""
|
||
"Iterator Status"
|
||
''nd/skip-non-iterator-parent-headings
|
||
'nd/iter-statuscodes ''nd/get-iterator-status nil t)
|
||
,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!"
|
||
"Unscheduled or Undeaded"
|
||
''nd/skip-non-iterator-unscheduled)))
|
||
|
||
("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile"))
|
||
(org-tags-match-list-sublevels nil))))
|
||
|
||
("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks")))))
|
||
|
||
("e"
|
||
"Critical Errors"
|
||
(,(nd/agenda-base-task-cmd task-match
|
||
"Discontinous Project"
|
||
''nd/skip-non-discontinuous-project-tasks)
|
||
,(nd/agenda-base-heading-cmd task-match
|
||
"Undone Closed"
|
||
''nd/skip-non-undone-closed-todoitems)
|
||
,(nd/agenda-base-heading-cmd (concat actionable "-" periodical)
|
||
"Done Unclosed"
|
||
''nd/skip-non-done-unclosed-todoitems)
|
||
,(nd/agenda-base-task-cmd (concat task-match)
|
||
"Missing Creation Timestamp"
|
||
''nd/skip-non-created-tasks)))
|
||
|
||
|
||
("A"
|
||
"Archivable Tasks and Projects"
|
||
((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC")
|
||
((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators")
|
||
(org-agenda-sorting-strategy '(category-keep))
|
||
(org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks)))
|
||
,(nd/agenda-base-heading-cmd (concat actionable "-" habit)
|
||
"Stale Tasks and Periodicals"
|
||
''nd/skip-non-stale-headings)
|
||
,(nd/agenda-base-project-cmd
|
||
(concat actionable "-" periodical "-" iterator "-" habit)
|
||
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects")
|
||
''nd/skip-non-projects ''(:archivable) ''nd/get-project-status))))))
|
||
#+END_SRC
|
||
** gtd next generation
|
||
GTD is great but has many limitations...mostly due to the fact that it was originally made on paper. This is meant to extend the GTD workflow into a comprehensive tracking engine that can be used and analyze and project long-term plans and goals.
|
||
*** logging
|
||
**** drawer
|
||
I prefer all logging to go in a seperate drawer (aptly named) which allows easier navigation and parsing for data analytics.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-log-into-drawer "LOGBOOK")
|
||
#+END_SRC
|
||
**** events
|
||
Events are nice to record because it enables tracking of my behavior (eg how often I reschedule, which may indicate how well I can predict when things should happen).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-log-done 'time
|
||
org-log-redeadline 'time
|
||
org-log-reschedule 'time)
|
||
#+END_SRC
|
||
**** repeated tasks
|
||
In these cases, it is nice to know what happened during each cycle, so force notes.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq org-log-repeat 'note)
|
||
#+END_SRC
|
||
**** creation time
|
||
=org-mode= has no good way out of the box to add creation time to todo entries or headings. This is nice to have as I can use them to see which tasks are bein ignored or neglected.
|
||
|
||
And yes, there is =org-expiry=, but it does more than I need and I don't feel like installing the extra contrib libraries.
|
||
|
||
This function adds the =CREATED= property. Note that I only really care about TODO entries, as anything else is either not worth tracking or an appointment which already have timestamps.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-set-creation-time (&optional always)
|
||
"Set the creation time property of the current heading.
|
||
Applies only to todo entries unless ALWAYS is t."
|
||
(when (or always (nd/is-todoitem-p))
|
||
(let* ((ts (format-time-string (cdr org-time-stamp-formats)))
|
||
(ts-ia (concat "[" (substring ts 1 -1) "]")))
|
||
(funcall-interactively 'org-set-property "CREATED" ts-ia))))
|
||
#+END_SRC
|
||
|
||
Advise the =org-insert-todo-entry= function. Advice here is necessary as there is only a hook for =org-insert-heading= and it fires before the TODO info is added.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(advice-add 'org-insert-todo-heading :after #'nd/org-set-creation-time)
|
||
#+END_SRC
|
||
|
||
Add hook for =org-capture=.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-capture-before-finalize-hook #'nd/org-set-creation-time)
|
||
#+END_SRC
|
||
*** sqlite backend
|
||
Org mode is great and all, but in many cases, text files just won't cut it. Hardcore data analysis is one of them, so make functions to shove org files (specifically archive files) into a sqlite database
|
||
**** basic functions
|
||
These are =org-mode=-agnostic functions that pertain to sql. They are basically just simple interfaces for shell commands.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(require 'sql)
|
||
|
||
;; this needs a better home :/
|
||
(defun nd/alist-put (alist prop value &optional front)
|
||
"For given ALIST, append VALUE to the current values in prop.
|
||
Current values (that is the cdr of each key) is assumed to be a list.
|
||
If PROP does not exist, create it. Return the new alist. If FRONT is
|
||
t, add to the front of current values list instead of the back."
|
||
(let* ((cur-cell (assoc prop alist))
|
||
(cur-values (cdr cur-cell)))
|
||
(cond
|
||
(cur-values
|
||
(let ((new-cdr (if front
|
||
`(,value ,@cur-values)
|
||
`(,@cur-values ,value))))
|
||
(setcdr cur-cell new-cdr) alist))
|
||
(cur-cell
|
||
(setcdr cur-cell `(,value)) alist)
|
||
(alist
|
||
(append alist `((,prop ,value))))
|
||
(t
|
||
`((,prop ,value))))))
|
||
|
||
;; this somehow doesn't exist O.o
|
||
;; this also needs a better home :/
|
||
(defun nd/sql-plist-get-vals(plist)
|
||
"Return all the values in PLIST."
|
||
(-slice plist 1 nil 2))
|
||
|
||
;; (defun nd/sql-construct-insert-transaction (all-data)
|
||
;; "Construct transaction string to insert ALL-DATA into SQL.
|
||
;; Does not actually execute the string."
|
||
;; (let* ((scan-tbl
|
||
;; (lambda (tbl)
|
||
;; (let ((name (car tbl))
|
||
;; (data (cdr tbl)))
|
||
;; (string-join (mapcar
|
||
;; (lambda (d)
|
||
;; (nd/sql-construct-insert name d))
|
||
;; data)))))
|
||
;; (ins (mapcar (lambda (tbl) (funcall scan-tbl tbl)) all-data))
|
||
;; (ins (string-join ins)))
|
||
;; (format "begin transaction; %s commit;" ins)))
|
||
|
||
;; SQL string parsing functions
|
||
(defun nd/sql-to-plist (out &rest cols)
|
||
"Parse SQL output string OUT to an plist representing the data.
|
||
COLS are the column names as symbols used to obtain OUT."
|
||
(unless (equal out "")
|
||
(let* ((out-trim (string-trim out))
|
||
(row-data (split-string out-trim "\n"))
|
||
(cell-data (mapcar (lambda (s) (split-string s "|")) row-data)))
|
||
(mapcar (lambda (d) (cl-mapcan #'list cols d)) cell-data))))
|
||
|
||
;; sql to string functions
|
||
(defun nd/sql-escape-text (txt)
|
||
"Escape and quote TXT in order to insert into sqlite db via 'insert'.
|
||
This assumes the insertion command will be run on a shell where the
|
||
sql command string is in double quotes."
|
||
(let* ((new-txt (replace-regexp-in-string "'" "''" txt nil t))
|
||
(new-txt (replace-regexp-in-string "\"" "\\\"" new-txt nil t)))
|
||
(concat "'" new-txt "'")))
|
||
|
||
(defun nd/sql-to-string (entry)
|
||
"Convert ENTRY to a string suitable for insertion into SQLite db.
|
||
Converts numbers to strings, flanks strings with '\"', and converts
|
||
any other symbols to their symbol name."
|
||
(cond ((stringp entry) (nd/sql-escape-text entry))
|
||
((numberp entry) (number-to-string entry))
|
||
(entry (symbol-name entry))
|
||
(t "NULL")))
|
||
|
||
(defun nd/sql-kw-to-colname (kw)
|
||
"Return string representation of KW for column in sql database."
|
||
(substring (symbol-name kw) 1))
|
||
|
||
(defun nd/sql-plist-concat (plist &optional sep)
|
||
"Concatenate a PLIST to string to be used in a SQL statement.
|
||
Returns a string formatted like 'prop1 = value1 SEP prop2 = value2'
|
||
from a plist like '(:prop1 value1 :prop2 value2)."
|
||
(let* ((sep (or sep ","))
|
||
(keys (plist-get-keys plist))
|
||
(keys (mapcar #'nd/sql-kw-to-colname keys))
|
||
(vals (nd/sql-plist-get-vals plist))
|
||
(vals (mapcar #'nd/sql-to-string vals))
|
||
(str (mapcar* (lambda (k v) (format "%s=%s" k v)) keys vals)))
|
||
(string-join str sep)))
|
||
|
||
;; SQL formatting functions
|
||
(defun nd/org-sql-fmt-insert (tbl-name tbl-data)
|
||
"Format SQL insert command from TBL-NAME and TBL-DATA."
|
||
(let* ((col-names (plist-get-keys tbl-data))
|
||
(col-names (mapcar (lambda (s) (substring (symbol-name s) 1)) col-names))
|
||
(col-names (string-join col-names ","))
|
||
(col-values (nd/sql-plist-get-vals tbl-data))
|
||
(col-values (mapcar #'nd/sql-to-string col-values))
|
||
(col-values (string-join col-values ",")))
|
||
(format "insert into %s (%s) values (%s);" (symbol-name tbl-name)
|
||
col-names col-values )))
|
||
|
||
(defun nd/org-sql-fmt-update (tbl-name update)
|
||
"Format SQL update command from TBL-NAME, UPDATE, and CONDS."
|
||
(let ((upd-str (nd/sql-plist-concat (car update)))
|
||
(conds-str (nd/sql-plist-concat (cdr update) " and ")))
|
||
(format "update %s set %s where %s;" (symbol-name tbl-name)
|
||
upd-str conds-str)))
|
||
|
||
(defun nd/org-sql-fmt-delete (tbl-name conds)
|
||
"Format SQL update command from TBL-NAME and CONDS."
|
||
(let ((conds-str (nd/sql-plist-concat conds " and ")))
|
||
(format "delete from %s where %s;" (symbol-name tbl-name) conds-str)))
|
||
|
||
(defun nd/org-sql-fmt-trans (sql-str)
|
||
"Format SQL transaction from list of SQL commands as strings SQL-STR."
|
||
(when sql-str
|
||
(nd/org-sql->> sql-str
|
||
(-flatten)
|
||
(string-join)
|
||
(format "begin transaction; %s commit;"))))
|
||
|
||
(defun nd/org-sql-fmt-multi (tbl fun)
|
||
(let ((name (car tbl))
|
||
(data (cdr tbl)))
|
||
(mapcar (lambda (r) (funcall fun name r)) data)))
|
||
|
||
(defun nd/org-sql-fmt-inserts (tbl)
|
||
(nd/org-sql-fmt-multi tbl #'nd/org-sql-fmt-insert))
|
||
|
||
(defun nd/org-sql-fmt-updates (tbl)
|
||
(nd/org-sql-fmt-multi tbl #'nd/org-sql-fmt-update))
|
||
|
||
(defun nd/org-sql-fmt-deletes (tbl)
|
||
(nd/org-sql-fmt-multi tbl #'nd/org-sql-fmt-delete))
|
||
|
||
;; SQL command abstractions
|
||
(defun nd/sql-cmd (db cmd &optional show-err foreign-keys)
|
||
"Execute string CMD on database DB executing `sql-sqlite-program'.
|
||
Returns the output of CMD. SQL should not contain any quotes as if it
|
||
were entered on the shell."
|
||
(when cmd
|
||
(let* ((err (if show-err "" " 2> /dev/null"))
|
||
(pragma (if foreign-keys
|
||
"PRAGMA foreign_keys = ON;"
|
||
"PRAGMA foreign_keys = OFF;"))
|
||
;; TODO, there has to be a better way to fix this foreign key bs
|
||
(cmd (format "%s %s \"%s%s\"%s" sql-sqlite-program db pragma cmd err)))
|
||
(shell-command-to-string cmd))))
|
||
|
||
(defun nd/sql-select (db tbl-name cols &optional conds)
|
||
"Select columns from TBL-NAME in DB where COLS is the list of columns.
|
||
If COLS is nil, all columns will be returned. Columns is expected as
|
||
a list of keywords like ':col1' and :col2'. CONDS, if supplied, is
|
||
a plist of conditions to test in the select statement. (currently
|
||
joined by AND)"
|
||
(let* ((colnames
|
||
(if (not cols) "*"
|
||
(string-join
|
||
(mapcar (lambda (s) (substring (symbol-name s) 1)) cols)
|
||
",")))
|
||
(tbl-str (symbol-name tbl-name))
|
||
(cmd (if (not conds)
|
||
(format "select %s from %s;" colnames tbl-str)
|
||
(let ((conds-str (nd/sql-plist-concat conds " and ")))
|
||
(format "select %s from %s where %s;" colnames
|
||
tbl-str conds-str))))
|
||
(out (nd/sql-cmd db cmd)))
|
||
(apply #'nd/sql-to-plist out cols)))
|
||
|
||
(defun nd/sql-delete (db tbl-name conds)
|
||
"Delete records from TBL-NAME in DB where CONDS are true.
|
||
CONDS is a plist of column names and values, '(:col1 val1 :col2 val2)',
|
||
where values will be deleted if the listed columns have the listed
|
||
values (AND condition)."
|
||
(let* ((conds-str (nd/sql-plist-concat " and "))
|
||
(cmd (format "delete from %s where %s;"
|
||
(symbol-name tbl-name) conds-str)))
|
||
(nd/sql-cmd db cmd)))
|
||
|
||
(defun nd/sql-update (db tbl-name update conds)
|
||
"Update records in TBL-NAME in DB with UPDATE where CONDS are true.
|
||
VALUES is a plist containing the columns and new values as
|
||
'(col1: newval1 col2: newval2) and CONDS is a similar plist
|
||
where columns in UPDATE will be updated if values matching those in
|
||
CONDS are found (AND condition)."
|
||
(let* ((upd-str (nd/sql-plist-concat update))
|
||
(conds-str (nd/sql-plist-to-condition conds " and "))
|
||
(cmd (format "update %s set %s where %s;"
|
||
(symbol-name tbl-name) upd-str conds-str)))
|
||
(nd/sql-cmd db cmd)))
|
||
|
||
(defun nd/sql-insert (db tbl-name tbl-data)
|
||
"Insert list TBL-DATA into TBL-NAME in sqlite database DB."
|
||
(nd/sql-cmd db (nd/sql-construct-insertion tbl-name tbl-data)))
|
||
|
||
(defun nd/sql-insert-multi (db all-data)
|
||
"Insert ALL-DATA into sqlite DB."
|
||
(nd/sql-cmd db (nd/sql-construct-insert-transaction all-data)))
|
||
#+END_SRC
|
||
**** org parsing function
|
||
Basic functions to parse org strings
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-effort-to-int (effort-str &optional to-string throw-err)
|
||
"Convert EFFORT-STR into an integer from HH:MM format.
|
||
If it is already an integer, nothing is changed. If TO-STRING is t,
|
||
convert the final number to a string of the number. If THROW-ERR is t,
|
||
throw an error if the string is not recognized."
|
||
(when effort-str
|
||
(let ((effort-str (string-trim effort-str)))
|
||
(save-match-data
|
||
(cond
|
||
((string-match "^\\([0-9]+\\):\\([0-6][0-9]\\)$" effort-str)
|
||
(let* ((hours (string-to-number (match-string 1 effort-str)))
|
||
(minutes (string-to-number (match-string 2 effort-str)))
|
||
(sum (+ (* 60 hours) minutes)))
|
||
(if to-string (number-to-string sum) sum)))
|
||
((string-match-p "^[0-9]+$" effort-str)
|
||
(if to-string effort-str (string-to-number effort-str)))
|
||
(t (when throw-err
|
||
(error (concat "Unknown effort format: '" effort-str "'")))))))))
|
||
|
||
(defun nd/org-ts-format-to-iso (ts)
|
||
"Return org timestamp TS to as string in ISO 8601 format.
|
||
If TS is nil or TS cannot be understood, nil will be returned."
|
||
(when ts
|
||
;; org-parse-time-string (used in org-2ft) does not save match data
|
||
(let ((ft (save-match-data (org-2ft ts))))
|
||
;; assume that nobody is going to need jan 1 1970
|
||
(when (> ft 0)
|
||
(format-time-string "%Y-%m-%dT%H:%M:00" ft)))))
|
||
#+END_SRC
|
||
**** org sql schemas
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defconst nd/org-sql-schemas
|
||
'("CREATE TABLE files (
|
||
file_path TEXT PRIMARY KEY ASC,
|
||
md5 TEXT NOT NULL,
|
||
size INTEGER NOT NULL,
|
||
time_modified DATE,
|
||
time_created DATE,
|
||
time_accessed DATE);"
|
||
|
||
"CREATE TABLE headlines (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
tree_path TEXT,
|
||
headline_text TEXT NOT NULL,
|
||
time_created DATE,
|
||
time_closed DATE,
|
||
time_scheduled DATE,
|
||
time_deadlined DATE,
|
||
keyword TEXT,
|
||
effort INTEGER,
|
||
priority INTEGER,
|
||
content TEXT,
|
||
PRIMARY KEY (file_path ASC, headline_offset ASC),
|
||
FOREIGN KEY (file_path) REFERENCES files (file_path)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE);"
|
||
|
||
"CREATE TABLE tags (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
tag TEXT,
|
||
inherited BOOLEAN,
|
||
FOREIGN KEY (file_path, headline_offset)
|
||
REFERENCES headlines (file_path, headline_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path, headline_offset, tag, inherited));"
|
||
|
||
"CREATE TABLE properties (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
property_offset INTEGER,
|
||
key_text TEXT NOT NULL,
|
||
val_text TEXT NOT NULL,
|
||
inherited BOOLEAN,
|
||
FOREIGN KEY (file_path, headline_offset)
|
||
REFERENCES headlines (file_path, headline_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, property_offset ASC));"
|
||
|
||
"CREATE TABLE clocking (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
clock_offset INTEGER,
|
||
time_start DATE,
|
||
time_end DATE,
|
||
clock_note TEXT,
|
||
FOREIGN KEY (file_path, headline_offset)
|
||
REFERENCES headlines (file_path, headline_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, clock_offset ASC));"
|
||
|
||
"CREATE TABLE logbook (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
entry_offset INTEGER,
|
||
time_logged DATE,
|
||
header TEXT,
|
||
note TEXT,
|
||
FOREIGN KEY (file_path, headline_offset)
|
||
REFERENCES headlines (file_path, headline_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, entry_offset ASC));"
|
||
|
||
"CREATE TABLE state_changes (
|
||
file_path TEXT,
|
||
entry_offset INTEGER,
|
||
state_old TEXT NOT NULL,
|
||
state_new TEXT NOT NULL,
|
||
FOREIGN KEY (file_path, entry_offset)
|
||
REFERENCES logbook (file_path, entry_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, entry_offset ASC));"
|
||
|
||
"CREATE TABLE planning_changes (
|
||
file_path TEXT,
|
||
entry_offset INTEGER,
|
||
time_old DATE NOT NULL,
|
||
time_new DATE,
|
||
planning_type TEXT CHECK (planning_type = \\\"d\\\" or (planning_type = \\\"s\\\")),
|
||
FOREIGN KEY (file_path, entry_offset)
|
||
REFERENCES logbook (file_path, entry_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, entry_offset ASC));"
|
||
|
||
"CREATE TABLE links (
|
||
file_path TEXT,
|
||
headline_offset INTEGER,
|
||
link_offset INTEGER,
|
||
link_path TEXT,
|
||
link_text TEXT,
|
||
link_type TEXT,
|
||
FOREIGN KEY (file_path, headline_offset)
|
||
REFERENCES headlines (file_path, headline_offset)
|
||
ON UPDATE CASCADE
|
||
ON DELETE CASCADE,
|
||
PRIMARY KEY (file_path ASC, link_offset ASC));")
|
||
"Table schemas for the org database.")
|
||
#+END_SRC
|
||
**** org element functions
|
||
These are functions that operate on org-element objects to parse for insertion into the db.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-element-timestamp-raw (prop obj &optional iso)
|
||
"Return the raw-value of the timestamp PROP in OBJ if exists.
|
||
If ISO is t, return the timestamp in ISO 8601 format."
|
||
(when obj
|
||
(let ((ts (org-element-property prop obj)))
|
||
(when ts
|
||
(let ((raw-ts (org-element-property :raw-value ts)))
|
||
(if iso (nd/org-ts-format-to-iso raw-ts) raw-ts))))))
|
||
|
||
;; TODO this is entirely redundant and can be replaced with assoc
|
||
;; (defun nd/org-element-find-type (type obj)
|
||
;; "Find and return the first instance of TYPE in OBJ.
|
||
;; TYPE is an org element type symbol and OBJ is a list of elements/objects."
|
||
;; (when obj
|
||
;; (let ((obj-cur (car obj))
|
||
;; (obj-rem (cdr obj)))
|
||
;; (if (eq type (org-element-type obj-cur))
|
||
;; obj-cur
|
||
;; (nd/org-element-find-type type obj-rem)))))
|
||
|
||
(defun nd/org-element-get-parent-type (type obj)
|
||
"Return parent element of type TYPE for OBJ or nil if not found."
|
||
(when obj
|
||
(let ((parent (org-element-property :parent obj)))
|
||
(if (eq type (org-element-type parent))
|
||
parent
|
||
(nd/org-element-get-parent-type type parent)))))
|
||
|
||
(defun nd/org-element-split-by-type (type contents &optional right)
|
||
"Split org-element sequence of objects CONTENTS by first instance of TYPE.
|
||
If RIGHT is t, get the right half instead of the left."
|
||
(let ((scan
|
||
(lambda (c &optional acc)
|
||
(if c
|
||
(let ((cur (car c))
|
||
(rem (cdr c)))
|
||
(if (equal type (org-element-type cur))
|
||
(if right rem acc)
|
||
(funcall scan rem (append acc (list cur)))))
|
||
(unless right acc)))))
|
||
(funcall scan contents)))
|
||
|
||
(defun nd/org-element-get-parent-headline (obj)
|
||
"Get the parent headline element (if any) of org-element OBJ."
|
||
(when obj
|
||
(let ((parent (org-element-property :parent obj)))
|
||
(if (eq 'headline (org-element-type parent))
|
||
parent
|
||
(nd/org-element-get-parent-headline parent)))))
|
||
|
||
(defun nd/org-element-get-parent-tree (obj &optional acc)
|
||
"Construct parent tree path for object OBJ and concatenate to ACC.
|
||
Returns '/' delimited path of headlines or nil if obj is in a toplevel
|
||
headline."
|
||
(let ((parent-hl (nd/org-element-get-parent-headline obj)))
|
||
(if parent-hl
|
||
(let* ((txt (org-element-property :raw-value parent-hl))
|
||
(new-acc (concat "/" txt acc)))
|
||
(nd/org-element-get-parent-tree parent-hl new-acc))
|
||
acc)))
|
||
|
||
(defun nd/org-element-get-parent-tags (obj &optional acc)
|
||
"Get all tags from parent headlines of OBJ and concat to ACC.
|
||
ACC is treated as a set; therefore no duplicates are retained."
|
||
(let ((parent-hl (nd/org-element-get-parent-headline obj)))
|
||
(if parent-hl
|
||
(let* ((tags (org-element-property :tags parent-hl))
|
||
(i-tags (org-element-property :ARCHIVE_ITAGS parent-hl))
|
||
(i-tags (when i-tags (split-string i-tags)))
|
||
(all-tags (delete-dups (append acc tags i-tags))))
|
||
(nd/org-element-get-parent-tags parent-hl all-tags))
|
||
acc)))
|
||
|
||
(defun nd/org-element-property-inherited (prop obj)
|
||
"Return the PROP value of the current org element or object OBJ.
|
||
If it is not available in the current obj, recursively go up to
|
||
parent until found or return nil if unfruitful."
|
||
(when obj
|
||
(let ((prop-val (org-element-property prop obj)))
|
||
(or
|
||
prop-val
|
||
(let ((parent (org-element-property :parent obj)))
|
||
(nd/org-element-property-inherited prop parent))))))
|
||
|
||
#+END_SRC
|
||
**** org sql constants and variables
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defconst nd/org-sqlite-db-path
|
||
(expand-file-name "archive.db" org-directory)
|
||
"Path for the sqlite database that holds archive data.")
|
||
|
||
(defconst nd/org-sql-ignored-properties
|
||
'("ARCHIVE_ITAGS" "Effort" "CREATED")
|
||
"Property keys to be ignored when inserting in properties table.
|
||
It is assumed these are used elsewhere and thus it would be redundant
|
||
to store them.")
|
||
|
||
(defvar nd/org-sql-use-tag-inheritance t
|
||
"Use tag inheritance when constructing sql databases for org.
|
||
See `org-use-tag-inheritance'.")
|
||
#+END_SRC
|
||
**** org logbook parsing functions
|
||
The logbook takes some extra work to parse as there is little/no information to distinguish the "type" of any given log entry (outside of clocking). Therefore, need to go down to the string level and match using regular expressions.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-logbook-match-header (header-text)
|
||
"Attempts to match HEADER-TEXT with `nd/org-log-note-headings-regexp'.
|
||
If match successful, returns list whose car is the match type
|
||
and cdr is the match data."
|
||
(let* ((scan
|
||
(lambda (str note-regex-alist)
|
||
(when note-regex-alist
|
||
(let* ((cur (car note-regex-alist))
|
||
(rem (cdr note-regex-alist))
|
||
(type (car cur))
|
||
(re (cdr cur)))
|
||
(if (string-match re str)
|
||
type
|
||
(funcall scan str rem))))))
|
||
(type (funcall scan header-text nd/org-log-note-headings-regexp)))
|
||
(when type (cons type (match-data)))))
|
||
|
||
;; this function doesn't exist in vanilla org mode >:(
|
||
(defun nd/org-todo-keywords-stripped ()
|
||
"Return `org-todo-keywords' as string list w/o selectors.
|
||
Will likely match the value of `org-todo-keywords-1' in many cases,
|
||
but this has the advantage of being always available and comprehensive."
|
||
(nd/org-sql->>
|
||
org-todo-keywords
|
||
(copy-tree)
|
||
(mapcan #'cdr)
|
||
(remove "|")
|
||
(mapcar (lambda (s) (replace-regexp-in-string "(.*)" "" s)))))
|
||
|
||
(defun nd/org-log-note-headings-matcher ()
|
||
"Convert `org-log-note-headings' to a regex matcher.
|
||
See `org-log-note-headings' for escape sequences that are matched
|
||
and replaces by regexps that match what would be inserted in place
|
||
of the escapes."
|
||
;; no pipes :( so sad for mario bros
|
||
(let* ((escapes '("%u" "%U" "%t" "%T" "%d" "%D" "%s" "%S"))
|
||
(todo-list (nd/org-todo-keywords-stripped))
|
||
(todo-regexp (mapconcat #'regexp-quote todo-list "\\|"))
|
||
(ts-or-todo-regexp (format "\"\\(%s\\|%s\\)\""
|
||
org-ts-regexp-inactive
|
||
todo-regexp))
|
||
(org-ts-regexp-cap (format "\\(%s\\)" org-ts-regexp))
|
||
(org-ts-regexp-inactive-cap (format "\\(%s\\)" org-ts-regexp-inactive))
|
||
(re-no-pad-alist (mapcar* #'cons escapes escapes))
|
||
(re-match-alist
|
||
(nd/org-sql->>
|
||
(list ".*"
|
||
".*"
|
||
org-ts-regexp-inactive-cap
|
||
org-ts-regexp-cap
|
||
org-ts-regexp-inactive-cap
|
||
org-ts-regexp-cap
|
||
ts-or-todo-regexp
|
||
ts-or-todo-regexp)
|
||
(mapcar (lambda (s) (concat "[[:space:]]*" s "[[:space:]]*")))
|
||
(mapcar* #'cons escapes)))
|
||
(apply2note
|
||
(lambda (n f)
|
||
(let ((note-type (car n))
|
||
(note-str (cdr n)))
|
||
(cons note-type (funcall f note-str)))))
|
||
(replace-esc
|
||
(lambda (n re)
|
||
(funcall apply2note
|
||
n
|
||
(lambda (s) (org-replace-escapes s re)))))
|
||
(shrink-space
|
||
(lambda (n)
|
||
(funcall apply2note
|
||
n
|
||
(lambda (s) (replace-regexp-in-string "\s+" " " s))))))
|
||
(nd/org-sql->>
|
||
org-log-note-headings
|
||
;; remove padding information by replacing all escape sequences
|
||
;; with their non-padded version and then removing extra spaces
|
||
(mapcar (lambda (n) (funcall replace-esc n re-no-pad-alist)))
|
||
(mapcar (lambda (n) (funcall shrink-space n)))
|
||
;; replace all escape sequences with regexps that match
|
||
;; the data to be inserted via the escape sequences
|
||
(mapcar (lambda (n) (funcall replace-esc n re-match-alist)))
|
||
;; filter out anything that is blank (eg default clock-in)
|
||
(seq-filter (lambda (s) (not (equal (cdr s) "")))))))
|
||
|
||
(defconst nd/org-log-note-headings-regexp
|
||
(nd/org-log-note-headings-matcher)
|
||
"Like `org-log-note-headings' but has regexp's instead of
|
||
escape sequences.")
|
||
#+END_SRC
|
||
**** org sql partioning functions
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/org-sql-partion-headling-section (contents &optional acc)
|
||
"Partition list of org-elements CONTENTS into accumulator ACC.
|
||
When finished return ACC. ACC will hold an alist structured as described
|
||
in `nd/org-element-partition-headline', except this function does not
|
||
deal with the subheadings or headline-properties."
|
||
(if (not contents)
|
||
acc
|
||
(let* ((cur (car contents))
|
||
(rem (cdr contents))
|
||
(type (org-element-type cur))
|
||
(acc*
|
||
(cond
|
||
((eq type 'planning)
|
||
(nd/alist-put acc :planning cur))
|
||
((eq type 'property-drawer)
|
||
;; TODO maybe filter for non-node-props here???
|
||
(let ((node-props (org-element-contents cur)))
|
||
(nd/alist-put acc :node-props node-props)))
|
||
((eq type 'drawer)
|
||
(let ((name (org-element-property :drawer-name cur)))
|
||
(if (equal name org-log-into-drawer)
|
||
(let ((lb-contents (org-element-contents cur)))
|
||
(nd/alist-put acc :logbook lb-contents))
|
||
(nd/alist-put acc :hl-contents cur))))
|
||
(t (nd/alist-put acc :hi-contents cur)))))
|
||
(nd/org-sql-partion-headling-section rem acc*))))
|
||
|
||
(defun nd/org-sql-partition-headline (headline fp)
|
||
"For org-element HEADLINE and file path FP, return an alist.
|
||
The alist will be structured as such:
|
||
|
||
:filepath - path to the file in which the headline resides
|
||
:headline - original headline element
|
||
:section - the section contents of the headline if found
|
||
:subheadlines - list of subheadlines if any
|
||
|
||
The planning entry will have the list of data associated with the
|
||
:planning property, and likewise with property-drawer. logbook-drawer
|
||
will be a drawer that is explicitly named `org-log-into-drawer' or
|
||
nil if not set. other-contents includes all other elements including
|
||
other drawers, list, paragraph elements, etc. If any of these groups
|
||
are missing, nil will be returned."
|
||
(unless headline (error "No headline given"))
|
||
(unless fp (error "No file path given"))
|
||
(let* ((hl-contents (org-element-contents headline))
|
||
(section (assoc 'section hl-contents))
|
||
(section (org-element-contents section))
|
||
(subheadlines (if section (cdr hl-contents) hl-contents)))
|
||
`((:headline . ,headline)
|
||
(:filepath . ,fp)
|
||
(:section . ,section)
|
||
(:subheadlines . ,subheadlines))))
|
||
;; (when section
|
||
;; (let ((sec-contents (org-element-contents section)))
|
||
;; (nd/org-sql-partion-headling-section sec-contents hl-part)))))
|
||
|
||
(defun nd/org-sql-partition-item (item hl-part)
|
||
"Parse an org-element ITEM which is assumed to be part of a logbook.
|
||
Returns a alist with the following structure:
|
||
|
||
:hl-part - the partitioned headline HL-PART surrounding the item,
|
||
which is an object as described in `nd/org-sql-partition-headline'
|
||
:item - the original item element
|
||
:header-text - the first line of the note which is standardized using
|
||
`org-log-note-headings'
|
||
:note-text - the remainder of the note text as a trimmed string with
|
||
no text properties (will be nil if item has no line-break element)
|
||
:type - the type of the item's header text (may be nil if unknown)
|
||
:match-data - match data associated with finding the type as done
|
||
using `nd/org-log-note-headings-regexp' (may be nil if undetermined).
|
||
|
||
Anatomy of a logbook item (non-clocking):
|
||
- header-text with linebreak //
|
||
note-text ... more text
|
||
- another header-text linebreak
|
||
|
||
The header text is solely used for determining :type and :match-data."
|
||
(let* ((paragraph (assoc 'paragraph item))
|
||
(contents (org-element-contents paragraph))
|
||
;; split entry into right / left components via linebreak
|
||
(left (nd/org-element-split-by-type 'line-break contents))
|
||
(right (nd/org-element-split-by-type 'line-break contents t))
|
||
(header-text (string-trim (substring-no-properties
|
||
(org-element-interpret-data left))))
|
||
(note-text (string-trim (substring-no-properties
|
||
(org-element-interpret-data right))))
|
||
(header-match (nd/org-logbook-match-header header-text)))
|
||
`((:item . ,item)
|
||
(:hl-part . ,hl-part)
|
||
(:header-text . ,header-text)
|
||
(:note-text . ,note-text)
|
||
(:type . ,(car header-match))
|
||
(:match-data . ,(cdr header-match)))))
|
||
#+END_SRC
|
||
**** org sql db function
|
||
These are the main functions to populate the db.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defmacro nd/org-sql-> (&rest body)
|
||
(let ((result (pop body)))
|
||
(dolist (form body result)
|
||
(setq result (append (list (car form) result) (cdr form))))))
|
||
|
||
(defmacro nd/org-sql->> (&rest body)
|
||
(let ((result (pop body)))
|
||
(dolist (form body result)
|
||
(setq result (append form (list result))))))
|
||
|
||
(defun nd/org-sql-extract (acc fun objs &rest args)
|
||
"Iterate through OBJS and add them to accumulator ACC using FUN.
|
||
FUN is a function that takes a single object from OBJS, the accumulator,
|
||
and ARGS. FUN adds OBJ to ACC and returns a new ACC."
|
||
(while objs
|
||
(setq acc (apply fun acc (car objs) args)
|
||
objs (cdr objs)))
|
||
acc)
|
||
|
||
(defun nd/org-sql-extract-lb-header (acc item-part)
|
||
"Add specific data from logbook entry ITEM-PART to accumulator ACC.
|
||
ITEM-PART is a partitions logbook item as described in
|
||
`nd/org-sql-partition-item'. Note headings are parsed according to
|
||
how they match those generated by `org-log-note-headings', and
|
||
nothing is added if a match is not found."
|
||
(let* ((hl-part (alist-get :hl-part item-part))
|
||
(hl (alist-get :headline hl-part))
|
||
(fp (alist-get :filepath hl-part))
|
||
(item (alist-get :item item-part))
|
||
(item-offset (org-element-property :begin item))
|
||
(type (alist-get :type item-part))
|
||
(md (alist-get :match-data item-part))
|
||
(header-text (alist-get :header-text item-part)))
|
||
;; TODO, make these adapt to the value of org-log-note-headings??
|
||
(set-match-data md)
|
||
(cond
|
||
((eq type 'state)
|
||
(let* ((state-old (match-string 3 header-text))
|
||
(state-new (match-string 1 header-text))
|
||
(state-data (list :file_path fp
|
||
:entry_offset item-offset
|
||
:state_old state-old
|
||
:state_new state-new)))
|
||
(nd/alist-put acc 'state_changes state-data)))
|
||
((memq type '(reschedule delschedule redeadline deldeadline))
|
||
(let* ((time-old (nd/org-ts-format-to-iso
|
||
(match-string 1 header-text)))
|
||
(planning-kw (if (memq type '(reschedule delschedule))
|
||
:scheduled
|
||
:deadline))
|
||
(time-new (nd/org-element-timestamp-raw planning-kw hl t))
|
||
(planning-type (if (eq :scheduled planning-kw) "s" "d"))
|
||
(planning-data (list :file_path fp
|
||
:entry_offset item-offset
|
||
:time_old time-old
|
||
:time_new time-new
|
||
:planning_type planning-type)))
|
||
(nd/alist-put acc 'planning_changes planning-data)))
|
||
;; no action required for these
|
||
((memq type '(done refile note)) acc)
|
||
;; header type not determined, therefore do nothing
|
||
(t acc))))
|
||
|
||
(defun nd/org-element-note-get-time-logged (item-part)
|
||
"Return time-logged of ITEM-PART or nil if it cannot be determined.
|
||
ITEM-PART is a partitioned logbook item as described in
|
||
`nd/org-sql-partition-item'."
|
||
(let* ((type (alist-get :type item-part))
|
||
(time-index
|
||
(cond
|
||
((memq type '(done note refile)) 1)
|
||
((memq type '(reschedule delschedule redeadline deldeadline)) 3)
|
||
((eq type 'state) 5)))
|
||
(header-text (alist-get :header-text item-part)))
|
||
(when time-index
|
||
(set-match-data (alist-get :match-data item-part))
|
||
(nd/org-ts-format-to-iso (match-string time-index header-text)))))
|
||
|
||
(defun nd/org-sql-extract-lb-entry (acc item-part)
|
||
"Add data from logbook entry ITEM-PART to accumulator ACC.
|
||
ITEM-PART is a partitioned logbook item as described in
|
||
`nd/org-sql-partition-item'."
|
||
(let* ((hl-part (alist-get :hl-part item-part))
|
||
(fp (alist-get :filepath hl-part))
|
||
(hl (alist-get :headline hl-part))
|
||
(item (alist-get :item item-part))
|
||
(hl-offset (org-element-property :begin hl))
|
||
(item-offset (org-element-property :begin item))
|
||
(time-logged (nd/org-element-note-get-time-logged item-part))
|
||
(hdr-text (alist-get :header-text item-part))
|
||
(note-text (alist-get :note-text item-part))
|
||
(logbook-data (list :file_path fp
|
||
:headline_offset hl-offset
|
||
:entry_offset item-offset
|
||
:time_logged time-logged
|
||
:header hdr-text
|
||
:note note-text)))
|
||
(nd/org-sql->
|
||
acc
|
||
(nd/alist-put 'logbook logbook-data)
|
||
(nd/org-sql-extract-lb-header item-part))))
|
||
|
||
(defun nd/org-logbook-parse-timestamp-range (ts)
|
||
"Return start and end of timestamp TS depending on if it is a range.
|
||
Return value will be a list of two elements if range and one if not."
|
||
(when ts
|
||
(let ((split
|
||
(lambda (ts &optional end)
|
||
(nd/org-ts-format-to-iso
|
||
(org-element-property
|
||
:raw-value
|
||
(org-timestamp-split-range ts end))))))
|
||
(if (eq (org-element-property :type ts) 'inactive-range)
|
||
(let ((start (funcall split ts))
|
||
(end (funcall split ts t)))
|
||
(cons start end))
|
||
`(,(funcall split ts))))))
|
||
|
||
(defun nd/org-sql-extract-lb-clock (acc clock hl-part &optional item)
|
||
"Add data from logbook CLOCK to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||
and represents the headline surrounding the clock.
|
||
If ITEM is provided, check that this is a valid note that can be
|
||
added to the clock, else add it as a normal logbook entry."
|
||
(let* ((hl (alist-get :headline hl-part))
|
||
(fp (alist-get :filepath hl-part))
|
||
(hl-offset (org-element-property :begin hl))
|
||
(cl-offset (org-element-property :begin clock))
|
||
(ts-obj (org-element-property :value clock))
|
||
(ts-range (nd/org-logbook-parse-timestamp-range ts-obj))
|
||
(start (car ts-range))
|
||
(end (cdr ts-range))
|
||
(clock-data (list :file_path fp
|
||
:headline_offset hl-offset
|
||
:clock_offset cl-offset
|
||
:time_start start
|
||
:time_end end)))
|
||
(if (not item)
|
||
(nd/alist-put acc 'clocking clock-data)
|
||
(let* ((item-part (nd/org-sql-partition-item item hl-part))
|
||
(item-type (alist-get :type item-part)))
|
||
(if item-type
|
||
;; if we know the type, add the clock and note
|
||
;; separately
|
||
(nd/org-sql->
|
||
acc
|
||
(nd/alist-put 'clocking clock-data)
|
||
(nd/org-sql-extract-lb-entry item-part))
|
||
;; else add it with the clocking table
|
||
(let* ((hdr-text (alist-get :header-text item-part))
|
||
(clock-data* `(,@clock-data :clock_note ,hdr-text)))
|
||
(nd/alist-put acc 'clocking clock-data*)))))))
|
||
|
||
(defun nd/org-sql-extract-lb-items (acc items hl-part)
|
||
"Add data from logbook ITEMS to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||
and represents the headline surrounding the items."
|
||
(let ((from
|
||
(lambda (acc item hl-part)
|
||
(let ((item-part (nd/org-sql-partition-item item hl-part)))
|
||
(nd/org-sql-extract-lb-entry acc item-part)))))
|
||
(nd/org-sql-extract acc from items hl-part)))
|
||
|
||
(defun nd/org-sql-extract-lb-one (acc entry hl-part)
|
||
"Add data from logbook ENTRY to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||
and represents the headline surrounding the entry."
|
||
(let ((type (org-element-type entry)))
|
||
(cond
|
||
((eq type 'clock)
|
||
(nd/org-sql-extract-lb-clock acc entry hl-part))
|
||
((eq type 'plain-list)
|
||
(let ((items (org-element-contents entry)))
|
||
(nd/org-sql-extract-lb-items acc items hl-part)))
|
||
;; TODO add an "UNKNOWN" logbook parser
|
||
(t acc))))
|
||
|
||
(defun nd/org-sql-extract-lb-two (acc entry1 entry2 hl-part)
|
||
"Add data from logbook ENTRY1 and ENTRY2 to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'
|
||
and represents the headline surrounding the entries. This assumes the
|
||
entries are org-element types clock and plain-list respectively, and
|
||
will check if the first item in ENTRY2 is part of the clock."
|
||
(let* ((items (org-element-contents entry2))
|
||
(first-item (car items))
|
||
(rem-items (cdr items)))
|
||
(nd/org-sql->
|
||
acc
|
||
(nd/org-sql-extract-lb-clock entry1 hl-part first-item)
|
||
(nd/org-sql-extract-lb-items rem-items hl-part))))
|
||
|
||
(defun nd/org-sql-find-logbook (contents)
|
||
"Find the logbook drawer given CONTENTS from section of org headline.
|
||
Returns a list of the contents in the logbook. Note this assumes
|
||
the `org-log-into-drawer' is set and that there is one drawer per
|
||
headline matching this value. Additional logbook drawers will be
|
||
ignored."
|
||
(org-element-contents
|
||
(rassoc-if
|
||
(lambda (e)
|
||
(equal org-log-into-drawer (plist-get (car e) :drawer-name)))
|
||
contents)))
|
||
|
||
(defun nd/org-sql-extract-lb (acc hl-part)
|
||
"Add logbook data from HL-PART and add to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||
(let* ((sec (alist-get :section hl-part))
|
||
(lb-contents (nd/org-sql-find-logbook sec)))
|
||
(while lb-contents
|
||
;; Need two of the next entries here because clocks may
|
||
;; have notes associated with them, but the only
|
||
;; distinguishing characteristic they have is that they
|
||
;; don't match anything in org-log-note-headings. If we
|
||
;; end up processing two entries at once, skip over two
|
||
;; instead of one on the next iteration.
|
||
(let* ((cur1 (car lb-contents))
|
||
(cur2 (cadr lb-contents))
|
||
(type1 (org-element-type cur1))
|
||
(type2 (org-element-type cur2))
|
||
(try-clock-note (and (eq 'clock type1)
|
||
(eq type2 'plain-list))))
|
||
(if try-clock-note
|
||
(setq acc (nd/org-sql-extract-lb-two acc cur1 cur2 hl-part)
|
||
lb-contents (cddr lb-contents))
|
||
(setq acc (nd/org-sql-extract-lb-one acc cur1 hl-part)
|
||
lb-contents (cdr lb-contents)))))
|
||
acc))
|
||
|
||
(defun nd/org-sql-parse-ts-maybe (txt)
|
||
"If TXT is a timestamp, return it in ISO 8601 format.
|
||
Otherwise return it unchanged."
|
||
;; assume the iso parser to return nil on failure
|
||
(nd/org-sql-> txt (nd/org-ts-format-to-iso) (or txt)))
|
||
|
||
(defun nd/org-sql-extract-properties (acc hl-part)
|
||
"Add properties data from HL-PART and add to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||
(let* ((sec (alist-get :section hl-part))
|
||
(prop-drawer (assoc 'property-drawer sec))
|
||
(node-props (org-element-contents prop-drawer))
|
||
(from
|
||
(lambda (acc np hl-part)
|
||
(let ((key (org-element-property :key np)))
|
||
(if (member key nd/org-sql-ignored-properties)
|
||
acc
|
||
(let* ((hl (alist-get :headline hl-part))
|
||
(fp (alist-get :filepath hl-part))
|
||
(hl-offset (org-element-property :begin hl))
|
||
(np-offset (org-element-property :begin np))
|
||
(val (org-element-property :value np))
|
||
(val (nd/org-sql-parse-ts-maybe val))
|
||
(prop-data (list :file_path fp
|
||
:headline_offset hl-offset
|
||
:property_offset np-offset
|
||
:key_text key
|
||
:val_text val
|
||
;; TODO add inherited flag
|
||
:inherited nil)))
|
||
(nd/alist-put acc 'properties prop-data)))))))
|
||
(nd/org-sql-extract acc from node-props hl-part)))
|
||
|
||
(defun nd/org-sql-extract-tags (acc hl-part)
|
||
"Extract tags data from HL-PART and add to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||
(let* ((hl (alist-get :headline hl-part))
|
||
;; first retrieve tags and strip text props and whitespace
|
||
(tags (nd/org-sql->> hl
|
||
(org-element-property :tags)
|
||
(mapcar #'nd/strip-string)))
|
||
;; then retrieve i-tags, optionally going up to parents
|
||
(i-tags (org-element-property :ARCHIVE_ITAGS hl))
|
||
(i-tags (when i-tags (split-string i-tags)))
|
||
(i-tags (if nd/org-sql-use-tag-inheritance
|
||
(nd/org-element-get-parent-tags hl i-tags)
|
||
i-tags))
|
||
(from
|
||
(lambda (acc tag hl-part &optional inherited)
|
||
(let* ((hl (alist-get :headline hl-part))
|
||
(fp (alist-get :filepath hl-part))
|
||
(offset (org-element-property :begin hl))
|
||
(i (if inherited 1 0))
|
||
(tags-data (list :file_path fp
|
||
:headline_offset offset
|
||
:tag tag
|
||
:inherited i)))
|
||
(nd/alist-put acc 'tags tags-data)))))
|
||
(nd/org-sql->
|
||
acc
|
||
(nd/org-sql-extract from tags hl-part)
|
||
(nd/org-sql-extract from i-tags hl-part t))))
|
||
|
||
|
||
(defun nd/org-sql-extract-links (acc hl-part)
|
||
"Add link data from headline HL-PART to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||
(let* ((sec (alist-get :section hl-part))
|
||
(links (org-element-map sec 'link #'identity))
|
||
(from
|
||
(lambda (acc ln hl-part)
|
||
(let* ((fp (alist-get :filepath hl-part))
|
||
(hl (alist-get :headline hl-part))
|
||
(hl-offset (org-element-property :begin hl))
|
||
(ln-offset (org-element-property :begin ln))
|
||
(ln-path (org-element-property :path ln))
|
||
(ln-text (org-element-contents ln))
|
||
(ln-text (mapcar #'nd/strip-string ln-text))
|
||
(ln-text (string-join ln-text))
|
||
(ln-type (org-element-property :type ln))
|
||
(ln-data (list :file_path fp
|
||
:headline_offset hl-offset
|
||
:link_offset ln-offset
|
||
:link_path ln-path
|
||
:link_text ln-text
|
||
:link_type ln-type)))
|
||
(nd/alist-put acc 'links ln-data)))))
|
||
(nd/org-sql-extract acc from links hl-part)))
|
||
|
||
(defun nd/org-sql-extract-hl-meta (acc hl-part)
|
||
"Add general data from headline HL-PART to accumulator ACC.
|
||
HL-PART is an object as returned by `nd/org-sql-partition-headline'."
|
||
(let* ((fp (alist-get :filepath hl-part))
|
||
(hl (alist-get :headline hl-part))
|
||
(offset (org-element-property :begin hl))
|
||
(rxv-tp (nd/org-element-get-parent-tree hl))
|
||
(hl-txt (org-element-property :raw-value hl))
|
||
(t-created (org-element-property :CREATED hl))
|
||
(t-created (nd/org-ts-format-to-iso t-created))
|
||
(t-closed (nd/org-element-timestamp-raw :closed hl t))
|
||
(t-scheduled (nd/org-element-timestamp-raw :scheduled hl t))
|
||
(t-deadline (nd/org-element-timestamp-raw :deadline hl t))
|
||
(kw (nd/strip-string (org-element-property :todo-keyword hl)))
|
||
(effort (org-element-property :EFFORT hl))
|
||
(effort (nd/org-effort-to-int effort t))
|
||
(priority (org-element-property :priority hl))
|
||
;; TODO, add contents somehow
|
||
;; (hl-contents (plist-get hl-part :hl-contents))
|
||
;; (hl-contents-text (org-element-interpret-data hl-contents))
|
||
;; (hl-contents-text (when hl-contents-text
|
||
;; (string-trim
|
||
;; (substring-no-properties hl-contents-text))))
|
||
(hl-data (list :file_path fp
|
||
:headline_offset offset
|
||
:tree_path rxv-tp
|
||
:headline_text hl-txt
|
||
:time_created t-created
|
||
:time_closed t-closed
|
||
:time_scheduled t-scheduled
|
||
:time_deadlined t-deadline
|
||
:keyword kw
|
||
:effort effort
|
||
:priority priority
|
||
:content nil)))
|
||
(nd/alist-put acc 'headlines hl-data)))
|
||
|
||
(defun nd/org-sql-extract-hl (acc headlines fp)
|
||
"Extract data from HEADLINES and add to accumulator ACC.
|
||
FP is the path to the file containing the headlines."
|
||
(let ((from
|
||
(lambda (acc hl fp)
|
||
(let* ((hl-part (nd/org-sql-partition-headline hl fp))
|
||
(hl-sub (alist-get :subheadlines hl-part)))
|
||
(nd/org-sql-> acc
|
||
(nd/org-sql-extract-hl-meta hl-part)
|
||
(nd/org-sql-extract-links hl-part)
|
||
(nd/org-sql-extract-tags hl-part)
|
||
(nd/org-sql-extract-properties hl-part)
|
||
(nd/org-sql-extract-lb hl-part)
|
||
(nd/org-sql-extract-hl hl-sub fp))))))
|
||
(nd/org-sql-extract acc from headlines fp)))
|
||
|
||
(defun nd/org-sql-extract-file (cell acc)
|
||
"Extract the file in the car of CELL for a sql insertion.
|
||
The results are accumulated in ACC which is returned on exit."
|
||
(let* ((fp (car cell))
|
||
(md5sum (cdr cell))
|
||
(buf (find-file-noselect fp t))
|
||
(tree (with-current-buffer buf
|
||
(org-element-parse-buffer)))
|
||
(attr (file-attributes fp))
|
||
(fsize (file-attribute-size attr))
|
||
(contents (org-element-contents tree))
|
||
(headlines (if (assoc 'section contents)
|
||
(cdr contents)
|
||
contents))
|
||
(file-data (list :file_path fp
|
||
:md5 md5sum
|
||
:size fsize)))
|
||
(nd/org-sql->
|
||
acc
|
||
(nd/alist-put 'files file-data)
|
||
(nd/org-sql-extract-hl headlines fp))))
|
||
|
||
(defun nd/org-sql-mk-insert (cell acc)
|
||
(nd/org-sql->> (plist-get acc 'insert)
|
||
(nd/org-sql-extract-file cell)
|
||
(plist-put acc 'insert)))
|
||
|
||
(defun nd/org-sql-mk-update (cell acc)
|
||
(let ((updt-acc (plist-get acc 'update)))
|
||
(nd/org-sql->> `((:file_path ,(car cell)) . (:md5 ,(cdr cell)))
|
||
(nd/alist-put updt-acc 'files)
|
||
(plist-put acc 'update))))
|
||
|
||
(defun nd/org-sql-mk-delete (cell acc)
|
||
(let ((dlt-acc (plist-get acc 'delete)))
|
||
(nd/org-sql->> `(:file_path ,(car cell))
|
||
(nd/alist-put dlt-acc 'files)
|
||
(plist-put acc 'delete))))
|
||
|
||
(defun nd/org-sql-get-updates (cell fp-qry acc)
|
||
"Returns cell where the car is accumulator ACC and cdr is current fp-qry."
|
||
;; if perfect match, do nothing
|
||
(if (find cell fp-qry :test #'equal)
|
||
(cons acc (remove cell fp-qry))
|
||
(let* ((match-cells
|
||
(lambda (a b fun)
|
||
(let ((car-a (car a))
|
||
(cdr-a (cdr a))
|
||
(car-b (car b))
|
||
(cdr-b (cdr b)))
|
||
(funcall fun car-a car-b cdr-a cdr-b))))
|
||
(match-fp
|
||
(lambda (fp-a fp-b md5-a md5-b)
|
||
(and (equal fp-a fp-b) (not (equal md5-a md5-b)))))
|
||
(match-md5
|
||
(lambda (fp-a fp-b md5-a md5-b)
|
||
(and (not (equal fp-a fp-b)) (equal md5-a md5-b))))
|
||
(match-fp*
|
||
(lambda (b)
|
||
(funcall match-cells cell b match-fp)))
|
||
(match-md5*
|
||
(lambda (b)
|
||
(funcall match-cells cell b match-md5)))
|
||
(found-fp (find-if (lambda (q) (funcall match-fp* q)) fp-qry)))
|
||
(cond
|
||
;; delete qry in db and insert cell
|
||
(found-fp
|
||
(cons (nd/org-sql-mk-insert cell (nd/org-sql-mk-delete found-fp acc))
|
||
(remove found-fp fp-qry)))
|
||
;; update fp in db
|
||
((find-if (lambda (q) (funcall match-md5* q)) fp-qry)
|
||
(cons (nd/org-sql-mk-update cell acc)
|
||
(remove-if (lambda (q) (funcall match-md5* q)) fp-qry)))
|
||
;; insert cell
|
||
(t
|
||
(cons (nd/org-sql-mk-insert cell acc) fp-qry))))))
|
||
|
||
(defun nd/org-sql-compare-files (fp-dsk fp-qry)
|
||
(let (acc)
|
||
(while fp-dsk
|
||
(let* ((cur (car fp-dsk))
|
||
(rem (cdr fp-dsk))
|
||
(found (nd/org-sql-get-updates cur fp-qry acc)))
|
||
(setq fp-dsk rem
|
||
acc (car found)
|
||
fp-qry (cdr found))))
|
||
(if fp-qry (nd/org-sql-mk-delete fp-qry acc)) acc))
|
||
|
||
(defun nd/org-sql-files-from-disk ()
|
||
"Return alist of metadata for filepaths PATHS."
|
||
(let ((paths (mapcar (lambda (p) (expand-file-name p org-directory)) nd/org-sql-files))
|
||
(cons-md5
|
||
(lambda (fp)
|
||
(let* ((fp-buf (find-file-noselect fp t)))
|
||
(cons fp (md5 fp-buf))))))
|
||
(mapcar (lambda (p) (funcall cons-md5 p)) paths)))
|
||
|
||
(defun nd/org-sql-files-from-db ()
|
||
"Get all files and their metadata from the database.
|
||
Returns an alist where the each car is file_path and each cdr is
|
||
the plist of metadata."
|
||
;; TODO should probably make the table recreate itself if it is
|
||
;; corrupted or missing
|
||
(when (file-exists-p nd/org-sqlite-db-path)
|
||
(nd/org-sql->> '(:file_path :md5)
|
||
(nd/sql-select nd/org-sqlite-db-path 'files)
|
||
(mapcar #'nd/sql-plist-get-vals)
|
||
(mapcar (lambda (q) (cons (car q) (car (cdr q))))))))
|
||
|
||
(defun nd/org-sql-get-transactions ()
|
||
(let ((fp-dsk (nd/org-sql-files-from-disk))
|
||
(map-trns
|
||
(lambda (op fun trans)
|
||
(nd/org-sql->>
|
||
(plist-get trans op)
|
||
(mapcar (lambda (s) (funcall fun s)))
|
||
(nd/org-sql-fmt-trans)
|
||
(plist-put trans op)))))
|
||
(nd/org-sql->>
|
||
(nd/org-sql-files-from-db)
|
||
(nd/org-sql-compare-files fp-dsk)
|
||
(funcall map-trns 'insert #'nd/org-sql-fmt-inserts)
|
||
(funcall map-trns 'update #'nd/org-sql-fmt-updates)
|
||
(funcall map-trns 'delete #'nd/org-sql-fmt-deletes))))
|
||
|
||
(defvar nd/org-sql-files '("test1.org_archive" "test2.org_archive")
|
||
"A list of org files to put into sql database.")
|
||
|
||
(defun nd/org-init-db ()
|
||
"Make a sqlite database for org files if it does not exist already."
|
||
(unless (file-exists-p nd/org-sqlite-db-path)
|
||
(process-file-shell-command (concat "touch " nd/org-sqlite-db-path))
|
||
(mapcar (lambda (s) (nd/sql-cmd nd/org-sqlite-db-path s)) nd/org-sql-schemas)))
|
||
|
||
(defun nd/org-archive-to-db (&optional show-err)
|
||
"Transfer archive files to sqlite database."
|
||
(let* ((trans (nd/org-sql-get-transactions))
|
||
(trans-dlt (plist-get trans 'delete))
|
||
(trans-upd (plist-get trans 'update))
|
||
(trans-ins (plist-get trans 'insert)))
|
||
;; note, the order of sql commands matters in transactions,
|
||
;; so, we need to do deletes, update, then inserts in that order
|
||
;; `(,(nd/sql-cmd nd/org-sqlite-db-path trans-dlt show-err))))
|
||
`(,(nd/sql-cmd nd/org-sqlite-db-path trans-dlt show-err t)
|
||
,(nd/sql-cmd nd/org-sqlite-db-path trans-upd show-err t)
|
||
,(nd/sql-cmd nd/org-sqlite-db-path trans-ins show-err nil))))
|
||
#+END_SRC
|
||
* tools
|
||
** printing
|
||
For some reason there is no default way to get a "print prompt." Instead one needs to either install some third-party helper or make a function like this.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/helm-set-printer-name ()
|
||
"Set the printer name using helm-completion to select printer."
|
||
(interactive)
|
||
(let ((pl (or helm-ff-printer-list (helm-ff-find-printers))))
|
||
(if pl (setq printer-name (helm-comp-read "Printer: " pl)))))
|
||
#+END_SRC
|
||
** magit
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package magit
|
||
:ensure t
|
||
:config
|
||
:delight auto-revert-mode
|
||
(setq magit-push-always-verify nil
|
||
git-commit-summary-max-length 50))
|
||
#+END_SRC
|
||
** dired
|
||
*** no confirm
|
||
Keeping confirmation enabled does weird stuff with helm. Not ideal at the moment but we shall see if I find something better.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq dired-no-confirm '(move copy))
|
||
#+END_SRC
|
||
*** compression
|
||
Only supports tar.gz, tar.bz2, tar.xz, and .zip by default. Add support for more fun algos such as lzo and zpaq
|
||
#+BEGIN_SRC emacs-lisp
|
||
(if (file-exists-p "/usr/bin/7z")
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.7z\\'" . "7z a %o %i")))
|
||
|
||
(if (file-exists-p "/usr/bin/lrzip")
|
||
(progn
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.lrz\\'" . "lrzip -L 9 -o %o %i &"))
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.lzo\\'" . "lrzip -l -L 9 -o %o %i &"))
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.zpaq\\'" . "lrzip -z -L 9 -o %o %i &"))))
|
||
|
||
;; NOTE: this must be after the shorter lrz algos otherwise it will
|
||
;; always default to .lrz and not .tar.lrz
|
||
(if (file-exists-p "/usr/bin/lrztar")
|
||
(progn
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.tar\\.lrz\\'" . "lrztar -L 9 -o %o %i &"))
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.tar\\.lzo\\'" . "lrztar -l -L 9 -o %o %i &"))
|
||
(add-to-list 'dired-compress-files-alist
|
||
'("\\.tar\\.zpaq\\'" . "lrztar -z -L 9 -o %o %i &"))))
|
||
#+END_SRC
|
||
*** formatting for humans
|
||
make sizes human readable
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq dired-listing-switches "-Alh")
|
||
#+END_SRC
|
||
*** mu4e attachments
|
||
By default the included gnus-dired package does not understan mu4e, so override the existing =gnus-dired-mail-buffers= function to fix. This allows going to a dired buffer, marking files, and attaching them interactively to mu4e draft buffers.
|
||
#+BEGIN_SRC emacs-lisp
|
||
;; from here:
|
||
;; https://www.djcbsoftware.nl/code/mu/mu4e/Dired.html#Dired
|
||
(require 'gnus-dired)
|
||
|
||
(eval-after-load 'gnus-dired
|
||
'(defun gnus-dired-mail-buffers ()
|
||
"Return a list of active mu4e message buffers."
|
||
(let (buffers)
|
||
(save-current-buffer
|
||
(dolist (buffer (buffer-list t))
|
||
(set-buffer buffer)
|
||
(when (and (derived-mode-p 'message-mode)
|
||
(null message-sent-message-via))
|
||
(push (buffer-name buffer) buffers))))
|
||
(nreverse buffers))))
|
||
|
||
(setq gnus-dired-mail-mode 'mu4e-user-agent)
|
||
(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
|
||
#+END_SRC
|
||
*** directory sized
|
||
By default dired uses =ls -whatever= to get its output. This does not have recursive directory contents by default. This nitfy package solves this. This is not on default because navigation is much slower and the du output adds very little in many situations (toggle when needed).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package dired-du
|
||
:ensure t
|
||
:config
|
||
(setq dired-du-size-format t))
|
||
#+END_SRC
|
||
*** mounted devices
|
||
If dired is to replace all other file managers it must handle devices. This function assumes all my devices are mounted on =/media/$USER= and that udevil is installed. It provides mount and mount/follow ops for all usb removable media and follow/unmount for all mounted devices (note the latter includes things that are not mounted here such as samba drives, which I normally hotkey to my window manager). This /almost/ replicates the functionality of gvfs that I actually use without the bloat; the only missing piece is MPT for android (which will come later).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/helm-devices ()
|
||
"Mount, unmount, and navigate to removable media using helm."
|
||
(interactive)
|
||
(let* ((mounted (mapcar
|
||
(lambda (d)
|
||
`(,(file-name-base d) . ,d))
|
||
(nd/get-mounted-directories)))
|
||
(mountable (seq-filter
|
||
(lambda (d) (not (member (car d) (mapcar #'car mounted))))
|
||
(nd/get-mountable-devices))))
|
||
(helm
|
||
:sources
|
||
(list
|
||
(helm-build-sync-source "Mounted Devices"
|
||
:candidates mounted
|
||
:action
|
||
'(("Open" . (lambda (s) (find-file s)))
|
||
("Unmount" . (lambda (s) (start-process "unmount" nil "udevil" "unmount" s)))))
|
||
(helm-build-sync-source "Mountable Devices"
|
||
:candidates mountable
|
||
:action
|
||
'(("Mount and Follow" . (lambda (s)
|
||
(nd/mount-device s)
|
||
(find-file (nd/get-mountpoint s))))
|
||
("Mount" . (lambda (s) (nd/mount-device s))))))
|
||
:buffer "*helm device buffer*"
|
||
:prompt "Device: ")))
|
||
#+END_SRC
|
||
** mu4e
|
||
*** basic
|
||
#+BEGIN_SRC emacs-lisp
|
||
(require 'mu4e)
|
||
|
||
(setq mail-user-agent 'mu4e-user-agent
|
||
mu4e-maildir "/mnt/data/Mail"
|
||
|
||
mu4e-attachment-dir "~/Downloads"
|
||
|
||
mu4e-view-show-images t
|
||
mu4e-headers-show-target nil
|
||
|
||
mu4e-view-show-addresses t
|
||
|
||
message-kill-buffer-on-exit t
|
||
|
||
mu4e-change-filenames-when-moving t
|
||
|
||
mu4e-confirm-quit nil
|
||
|
||
mu4e-view-prefer-html t
|
||
|
||
mu4e-compose-dont-reply-to-self t
|
||
|
||
mu4e-get-mail-command "systemctl --user start mbsync"
|
||
|
||
user-full-name "Dwarshuis, Nathan J")
|
||
#+END_SRC
|
||
*** headers view
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq mu4e-headers-fields '((:human-date . 11)
|
||
(:flags . 5)
|
||
(:from . 22)
|
||
(:thread-subject))
|
||
mu4e-headers-date-format "%F"
|
||
mu4e-headers-time-format "%R"
|
||
mu4e-use-fancy-chars nil)
|
||
#+END_SRC
|
||
*** citing
|
||
The citation line should enable history folding in outlook. This is enabled by using 32 underscores followed by the addressing info of the previous message(s).
|
||
#+BEGIN_SRC emacs-lisp
|
||
;; necessary for the header macros below
|
||
(require 'nnheader)
|
||
|
||
(defun nd/message-insert-citation-header ()
|
||
"Insert the header of the reply message."
|
||
(let* ((h message-reply-headers)
|
||
(sep "________________________________")
|
||
(from (concat "From: " (mail-header-from h)))
|
||
(date (concat "Sent: " (mail-header-date h)))
|
||
(to (concat "To: " user-full-name))
|
||
(subj (concat "Subject: " (message-strip-subject-re (mail-header-subject h)))))
|
||
(insert (string-join `("" ,sep ,from ,date ,to ,subj "") "\n"))))
|
||
|
||
(setq message-citation-line-function 'nd/message-insert-citation-header)
|
||
#+END_SRC
|
||
|
||
The default "> " things are annoying when citing old messages.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq message-yank-prefix "")
|
||
(setq message-yank-cited-prefix "")
|
||
(setq message-yank-empty-prefix "")
|
||
#+END_SRC
|
||
|
||
By default the citation is destroyed (as in totally textified) if it is HTML. I want the links to be preserved, so use html2text and set arguments accordingly. Note that =--body-width=0= is necessary to prevent line breaks from being inserted in the middle of links.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq
|
||
mu4e-compose-pre-hook
|
||
(lambda ()
|
||
(let* ((msg mu4e-compose-parent-message)
|
||
(html (and msg (plist-get msg :body-html)))
|
||
;; oops, mu4e screwed up
|
||
(mu4e-html2text-command
|
||
(if (file-exists-p "/usr/bin/html2text")
|
||
"html2text --ignore-emphasis --images-to-alt --body-width=0"
|
||
'mu4e-shr2text)))
|
||
(when (and html mu4e-view-prefer-html (member compose-type '(reply forward)))
|
||
;; hackity hack, since the normal mu4e-message-body-text function
|
||
;; does not render the desired html, do it here and force the
|
||
;; aforementioned function to only look at text by removing
|
||
;; the html
|
||
(plist-put msg :body-txt (mu4e~html2text-shell msg mu4e-html2text-command))
|
||
(plist-put msg :body-html nil)))))
|
||
#+END_SRC
|
||
*** smtp
|
||
#+BEGIN_SRC emacs-lisp
|
||
(require 'smtpmail)
|
||
;; (require 'smtpmail-async)
|
||
;; (require 'secrets)
|
||
;; (setq secrets-enabled t)
|
||
(setq send-mail-function 'smtpmail-send-it
|
||
message-send-mail-function 'smtpmail-send-it)
|
||
(add-to-list 'auth-sources (expand-file-name "~/.emacs.d/.authinfo_mu4e.gpg"))
|
||
;; (add-to-list 'auth-sources "secrets:default")
|
||
#+END_SRC
|
||
*** contexts
|
||
I have current have three contexts, personal and two work accounts. The first is a gmail account and the second/third are office365 accounts.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq mu4e-context-policy 'pick-first
|
||
mu4e-compose-context-policy 'ask-if-none
|
||
mu4e-user-mail-address-list '("natedwarshuis@gmail.com" "ndwarshuis3@gatech.edu" "ndwarsh@emory.edu")
|
||
|
||
mu4e-contexts
|
||
`( ,(make-mu4e-context
|
||
:name "personal"
|
||
:match-func
|
||
(lambda (msg)
|
||
(when msg
|
||
(let ((pfx (mu4e-message-field msg :maildir)))
|
||
(string-prefix-p "/gmail" pfx))))
|
||
:vars '((mu4e-trash-folder . "/gmail/trash")
|
||
(mu4e-drafts-folder . "/gmail/drafts")
|
||
(mu4e-sent-folder . "/gmail/sent")
|
||
(mu4e-refile-folder . "/gmail/archive")
|
||
(mu4e-sent-messages-behavior . delete)
|
||
(smtpmail-stream-type . starttls)
|
||
(smtpmail-smtp-server . "smtp.gmail.com")
|
||
(smtpmail-smtp-service . 587)
|
||
(smtpmail-smtp-user . "natedwarshuis@gmail.com")
|
||
(user-mail-address . "natedwarshuis@gmail.com")
|
||
(mu4e-maildir-shortcuts .
|
||
(("/gmail/inbox" . ?i)
|
||
("/gmail/sent" . ?s)
|
||
("/gmail/trash" . ?t)
|
||
("/gmail/drafts" . ?d)
|
||
("/gmail/archive" . ?a)))))
|
||
,(make-mu4e-context
|
||
:name "gatech"
|
||
:match-func
|
||
(lambda (msg)
|
||
(when msg
|
||
(let ((pfx (mu4e-message-field msg :maildir)))
|
||
(string-prefix-p "/gatech" pfx))))
|
||
:vars '((mu4e-trash-folder . "/gatech/trash")
|
||
(mu4e-drafts-folder . "/gatech/drafts")
|
||
(mu4e-sent-folder . "/gatech/sent")
|
||
(mu4e-refile-folder . "/gatech/archive")
|
||
(mu4e-sent-messages-behavior . sent)
|
||
(smtpmail-stream-type . starttls)
|
||
(smtpmail-smtp-server . "smtp.office365.com")
|
||
(smtpmail-smtp-service . 587)
|
||
(smtpmail-smtp-user . "ndwarshuis3@gatech.edu")
|
||
(user-mail-address . "ndwarshuis3@gatech.edu")
|
||
(mu4e-maildir-shortcuts .
|
||
(("/gatech/inbox" . ?i)
|
||
("/gatech/sent" . ?s)
|
||
("/gatech/trash" . ?t)
|
||
("/gatech/drafts" . ?d)
|
||
("/gatech/archive" . ?a)))))
|
||
,(make-mu4e-context
|
||
:name "emory"
|
||
:match-func
|
||
(lambda (msg)
|
||
(when msg
|
||
(let ((pfx (mu4e-message-field msg :maildir)))
|
||
(string-prefix-p "/emory" pfx))))
|
||
:vars '((mu4e-trash-folder . "/emory/trash")
|
||
(mu4e-drafts-folder . "/emory/drafts")
|
||
(mu4e-sent-folder . "/emory/sent")
|
||
(mu4e-refile-folder . "/emory/archive")
|
||
(mu4e-sent-messages-behavior . sent)
|
||
(smtpmail-stream-type . starttls)
|
||
(smtpmail-smtp-server . "smtp.office365.com")
|
||
(smtpmail-smtp-service . 587)
|
||
(smtpmail-smtp-user . "ndwarsh@emory.edu")
|
||
(user-mail-address . "ndwarsh@emory.edu")
|
||
(mu4e-maildir-shortcuts .
|
||
(("/emory/inbox" . ?i)
|
||
("/emory/sent" . ?s)
|
||
("/emory/trash" . ?t)
|
||
("/emory/drafts" . ?d)
|
||
("/emory/archive" . ?a)))))))
|
||
#+END_SRC
|
||
*** org-mu4e
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package org-mu4e
|
||
:after (org mu4e)
|
||
:config
|
||
(setq
|
||
;; for using mu4e in org-capture templates
|
||
org-mu4e-link-query-in-headers-mode nil
|
||
;; for composing rich-text emails using org mode
|
||
org-mu4e-convert-to-html t))
|
||
#+END_SRC
|
||
*** signature
|
||
Signatures take lots of space and make short messages look needlessly clunky, so keep off by default.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq mu4e-compose-signature-auto-include nil
|
||
|
||
mu4e-compose-signature
|
||
(string-join
|
||
'("Nathan Dwarshuis"
|
||
""
|
||
"PhD Student - Biomedical Engineering - Krish Roy Lab"
|
||
"Georgia Institute of Technology and Emory University"
|
||
"ndwarshuis3@gatech.edu")
|
||
"\n"))
|
||
#+END_SRC
|
||
*** visual-line-mode
|
||
By default mu4e adds breaks after 80-ish chars using auto-fill-mode which makes messages look weird when opened. =Visual-line-mode= avoids this problem.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'mu4e-compose-mode-hook 'turn-off-auto-fill)
|
||
(add-hook 'mu4e-compose-mode-hook 'visual-line-mode)
|
||
(add-hook 'mu4e-view-mode-hook 'turn-off-auto-fill)
|
||
(add-hook 'mu4e-view-mode-hook 'visual-line-mode)
|
||
#+END_SRC
|
||
*** flyspell
|
||
Spell checking is generally a good idea when writing to pointy-haired bosses.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'mu4e-compose-mode-hook (lambda () (flyspell-mode 1)))
|
||
#+END_SRC
|
||
** shell
|
||
#+begin_src emacs-lisp
|
||
(defadvice ansi-term (before force-bash)
|
||
(interactive (list "/bin/zsh")))
|
||
(ad-activate 'ansi-term)
|
||
|
||
(defun nd/term-send-raw-escape ()
|
||
"Send a raw escape character to the running terminal."
|
||
(interactive)
|
||
(term-send-raw-string "\e"))
|
||
#+END_SRC
|
||
** ediff
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
|
||
#+END_SRC
|
||
* keybindings
|
||
For the sake of my sanity, all bindings go here. Note this means I don't use =:bind= in use-package forms.
|
||
** setup
|
||
Most of my modifiers are reloacted using xkb and xcape. Below is a summary where each item is in the form <original key> -> <new key action> (<key release action if used>)
|
||
- tab -> l_super (tab)
|
||
- backslash -> r_super (backslash)
|
||
- caps -> l_ctrl (escape)
|
||
- return -> r_ctrl (return)
|
||
- l_ctrl -> l_hyper
|
||
- l_super -> iso_l3_shift (xf86search)
|
||
- space -> r_alt (space)
|
||
- r_alt -> r_hyper
|
||
- r_ctrl -> caps
|
||
** whichkey
|
||
Everyone forgets keybindings. When typing a key chord, this will display a window with all possible completions and their commands.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package which-key
|
||
:ensure t
|
||
:delight
|
||
:init
|
||
(which-key-mode))
|
||
#+END_SRC
|
||
** evil
|
||
I like being evil. All package and custom bindings go here.
|
||
*** base
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil
|
||
:ensure t
|
||
:init
|
||
;; this is required to make evil collection work
|
||
(setq evil-want-integration nil)
|
||
:config
|
||
(evil-mode 1))
|
||
#+END_SRC
|
||
*** motion
|
||
By default, emacs counts a sentence as having at least 2 spaces after punctuation. Make this behave more like vim.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(setq sentence-end-double-space nil)
|
||
#+END_SRC
|
||
*** evil state defaults
|
||
Some modes use primitive emacs bindings by default. Educate them.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-to-list 'evil-motion-state-modes 'ess-help-mode)
|
||
(add-to-list 'evil-insert-state-modes 'inferior-ess-mode)
|
||
#+END_SRC
|
||
*** enhancements
|
||
delightfully ripped off from vim plugins
|
||
**** surround
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-surround
|
||
:ensure t
|
||
:after evil
|
||
:config
|
||
(global-evil-surround-mode 1))
|
||
#+END_SRC
|
||
**** commentary
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-commentary
|
||
:ensure t
|
||
:after evil
|
||
:delight
|
||
:config
|
||
(evil-commentary-mode))
|
||
#+END_SRC
|
||
**** replace with register
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-replace-with-register
|
||
:ensure t
|
||
:after evil
|
||
:config
|
||
(evil-replace-with-register-install))
|
||
#+END_SRC
|
||
*** unbind emacs keys
|
||
Some of these commands just get in the way of being evil (which really means that I keep pressing them on accident). Rather than nullifying them completely, tuck them away in the emacs state map in case I actually want them.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(mapc (lambda (k) (nd/move-key global-map evil-emacs-state-map (eval k)))
|
||
'((kbd "C-s")
|
||
(kbd "C-p")
|
||
(kbd "C-n")
|
||
(kbd "C-f")
|
||
(kbd "C-b")
|
||
(kbd "C-a")
|
||
(kbd "C-e")
|
||
(kbd "C-<SPC>")
|
||
|
||
(kbd "C-x C-;")
|
||
(kbd "C-x C-l")
|
||
(kbd "C-x C-u")
|
||
(kbd "C-x C-z")
|
||
(kbd "C-x C-c")
|
||
|
||
(kbd "M-c")
|
||
(kbd "M-d")
|
||
(kbd "M-e")
|
||
(kbd "M-r")
|
||
(kbd "M-f")
|
||
(kbd "M-h")
|
||
(kbd "M-j")
|
||
(kbd "C-M-j")
|
||
(kbd "M-k")
|
||
(kbd "M-l")
|
||
(kbd "M-m")
|
||
(kbd "M-q")
|
||
(kbd "M-w")
|
||
(kbd "M-t")
|
||
(kbd "M-u")
|
||
(kbd "M-i")
|
||
(kbd "M-z")
|
||
(kbd "M-v")
|
||
(kbd "M-/")
|
||
(kbd "M-;")
|
||
(kbd "M-DEL")))
|
||
#+END_SRC
|
||
*** evil-org
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-org
|
||
:ensure t
|
||
:after (evil org)
|
||
:delight
|
||
:config
|
||
(add-hook 'org-mode-hook 'evil-org-mode)
|
||
(add-hook 'evil-org-mode-hook 'evil-org-set-key-theme)
|
||
|
||
(require 'evil-org-agenda)
|
||
(evil-org-agenda-set-keys)
|
||
;; some of the defaults bug me...
|
||
(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
|
||
"sC" 'nd/org-agenda-filter-non-context
|
||
"sE" 'nd/org-agenda-filter-non-effort
|
||
"sD" 'nd/org-agenda-filter-delegate
|
||
"sP" 'nd/org-agenda-filter-non-peripheral
|
||
"e" 'org-agenda-set-effort
|
||
"ce" nil))
|
||
#+END_SRC
|
||
*** evil-magit
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-magit
|
||
:ensure t
|
||
:after (evil magit))
|
||
#+END_SRC
|
||
*** visual line mode
|
||
This is somewhat strange because all I really care about is moving between lines and to the beginning and end as normal. However, I like the idea of thinking of paragraphs as one line (eg df. deletes a sentence even if on multiple lines). Opinion subject to change.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(evil-define-key '(normal visual) 'visual-line-mode
|
||
"j" 'evil-next-visual-line
|
||
"k" 'evil-previous-visual-line
|
||
"0" 'beginning-of-visual-line
|
||
"$" 'end-of-visual-line)
|
||
#+END_SRC
|
||
*** comint
|
||
Comint-based inferior modes often are not evil (eg =intero= and =ESS=). Configure this similarly to term (see below) where C-j/k navigate cmd history and insert mode goes to cmd input line.
|
||
**** interactive functions
|
||
Some common interactive functions for comint-based modes
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/comint-char-mode-evil-insert ()
|
||
"If not at the last line, go to the end of the buffer and enter insert mode. Else just enter insert mode."
|
||
(interactive)
|
||
(if (/= (line-number-at-pos (point)) (line-number-at-pos (point-max)))
|
||
(goto-char (point-max))))
|
||
|
||
(defun nd/comint-send-input-evil-insert (&optional send-input-cmd)
|
||
"Go into insert mode after calling SEND-INPUT-CMD which is usually
|
||
the function that send the command to the interactive process in the
|
||
REPL. If no SEND-INPUT-CMD then `comint-send-input' is used."
|
||
(interactive)
|
||
(if send-input-cmd (funcall send-input-cmd) (comint-send-input))
|
||
(evil-insert 1))
|
||
|
||
(evil-define-key '(normal insert) comint-mode-map
|
||
(kbd "C-k") 'comint-previous-input
|
||
(kbd "C-j") 'comint-next-input)
|
||
#+END_SRC
|
||
**** ess
|
||
#+BEGIN_SRC emacs-lisp
|
||
(evil-define-key 'normal inferior-ess-mode-map
|
||
(kbd "RET") (lambda () nd/comint-send-input-evil-insert
|
||
'inferior-ess-send-input))
|
||
|
||
(add-hook 'inferior-ess-mode-hook
|
||
(lambda ()
|
||
(add-hook 'evil-insert-state-entry-hook
|
||
'nd/comint-char-mode-evil-insert nil t)))
|
||
#+END_SRC
|
||
**** intero
|
||
#+BEGIN_SRC emacs-lisp
|
||
(evil-define-key 'normal intero-repl-mode-map
|
||
(kbd "RET") 'nd/comint-send-input-evil-insert)
|
||
|
||
(add-hook 'intero-repl-mode-hook
|
||
(lambda ()
|
||
(add-hook 'evil-insert-state-entry-hook
|
||
'nd/comint-char-mode-evil-insert nil t)))
|
||
#+END_SRC
|
||
*** collection
|
||
Most packages that don't have an evil version are in this one. I don't like surprises so I set =evil-collection-modes-list= with the modes I actually want. Some of these are further configured below.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(use-package evil-collection
|
||
:ensure t
|
||
:after evil
|
||
:init
|
||
(setq evil-collection-mode-list
|
||
'(company dired ediff flycheck helm minibuffer mu4e
|
||
package-menu term which-key))
|
||
(setq evil-collection-setup-minibuffer t)
|
||
:config
|
||
(evil-collection-init))
|
||
#+END_SRC
|
||
**** dired
|
||
Dired makes new buffers by default. Use =find-alternate-file= to avoid this.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(defun nd/dired-move-to-parent-directory ()
|
||
"Move buffer to parent directory (like 'cd ..')."
|
||
(interactive)
|
||
(find-alternate-file ".."))
|
||
|
||
(defun nd/dired-xdg-open ()
|
||
"Open all non-text files in external app using xdg-open.
|
||
Only regular files are considered."
|
||
(interactive)
|
||
(let* ((file-list (seq-filter #'file-regular-p (dired-get-marked-files)))
|
||
(do-it (if (<= (length file-list) 5)
|
||
t
|
||
(y-or-n-p "Open more then 5 files? "))))
|
||
(when do-it
|
||
(mapc
|
||
(lambda (f) (let ((process-connection-type nil))
|
||
(start-process "" nil "xdg-open" f)))
|
||
file-list))))
|
||
|
||
(defun nd/dired-open-with ()
|
||
"Open marked non-text files in external app via open-with dialog
|
||
according to mime types as listed in all available desktop files."
|
||
(interactive)
|
||
(let* ((mf (seq-filter #'file-regular-p (dired-get-marked-files)))
|
||
(qmf (mapcar #'shell-quote-argument mf))
|
||
(file-mime-list (mapcar (lambda (f) (list f (nd/get-mime-type f))) qmf)))
|
||
|
||
(if (= (length file-mime-list) 0)
|
||
(message "No files selected")
|
||
|
||
(let* ((first-pair (car file-mime-list))
|
||
(last-pairs (cdr file-mime-list))
|
||
mime-alist file-list)
|
||
(setq file-list (nth 0 first-pair)
|
||
mime-alist (nd/get-apps-from-mime (nth 1 first-pair)))
|
||
;; if multiple files selected, add to the selection list
|
||
(if last-pairs
|
||
(progn
|
||
(setq file-list (string-join (mapcar #'car file-mime-list) " "))
|
||
(dolist (mime (mapcar (lambda (f) (nth 1 f)) last-pairs))
|
||
(setq mime-alist (intersection mime-alist
|
||
(nd/get-apps-from-mime mime)
|
||
:test #'equal)))))
|
||
(if (= (length mime-alist) 0)
|
||
(let* ((ml (delete-dups (mapcan #'cdr file-mime-list)))
|
||
(mls (string-join ml ", ")))
|
||
(if (= (length ml) 1)
|
||
(message (concat "No apps found for mime type: " mls))
|
||
(message (concat "No common apps found for mime types: " mls))))
|
||
(helm
|
||
:sources (helm-build-sync-source "Apps"
|
||
:candidates mime-alist
|
||
:action '(("Open" . (lambda (f) (nd/execute-desktop-command f file-list)))))
|
||
:buffer "*helm open with*"))))))
|
||
|
||
(defun nd/dired-sort-by ()
|
||
"Sort current dired buffer by a list of choices presented in helm menu.
|
||
Note this assumes there are no sorting switches on `dired-ls'"
|
||
(interactive)
|
||
(let ((sort-alist '(("Name" . "")
|
||
("Date" . "-t")
|
||
("Size" . "-S")
|
||
("Extension" . "-X")
|
||
("Dirs First" . "--group-directories-first"))))
|
||
(helm
|
||
:sources
|
||
(helm-build-sync-source "Switches"
|
||
:candidates sort-alist
|
||
:action
|
||
'(("Sort" . (lambda (s) (dired-sort-other (concat dired-listing-switches " " s))))))
|
||
:buffer "*helm sort buffer*")))
|
||
|
||
(put 'dired-find-alternate-file 'disabled nil)
|
||
|
||
(evil-define-key 'normal dired-mode-map
|
||
"a" 'dired-find-file
|
||
"za" 'gnus-dired-attach
|
||
"gs" 'nd/dired-sort-by
|
||
"^" 'nd/dired-move-to-parent-directory
|
||
"q" 'nd/kill-current-buffer
|
||
(kbd "<return>") 'dired-find-alternate-file
|
||
(kbd "C-<return>") 'nd/dired-xdg-open
|
||
(kbd "M-<return>") 'nd/dired-open-with)
|
||
#+END_SRC
|
||
**** helm
|
||
I like tab completion...regardless of what the helm zealots say. This is actually easier and faster because I can just scroll through the source list with j/k and mash TAB when I find the right directory.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(evil-define-key '(normal insert) helm-map
|
||
(kbd "<tab>") 'helm-execute-persistent-action
|
||
(kbd "C-<tab>") 'helm-select-action)
|
||
#+END_SRC
|
||
**** term
|
||
Since I use vi mode in my terminal emulator, need to preserve the escape key's raw behavior
|
||
#+BEGIN_SRC emacs-lisp
|
||
(evil-define-key 'insert term-raw-map
|
||
(kbd "<escape>") 'nd/term-send-raw-escape
|
||
(kbd "C-<escape>") 'evil-normal-state)
|
||
#+END_SRC
|
||
** local
|
||
These are for mode-specific bindings that can/should be outside of the evil maps above (there are not many, and these may be merged with their evil bretheren in the future).
|
||
*** org-mode
|
||
#+BEGIN_SRC emacs-lisp
|
||
(add-hook 'org-mode-hook
|
||
(lambda ()
|
||
;; use the hyper keys/vim arrows with the shifters instead of shift/arrows
|
||
(local-set-key (kbd "H-k") 'org-shiftup)
|
||
(local-set-key (kbd "H-l") 'org-shiftright)
|
||
(local-set-key (kbd "H-j") 'org-shiftdown)
|
||
(local-set-key (kbd "H-h") 'org-shiftleft)
|
||
|
||
;; this is just a useful function I made (actually I think I stole)
|
||
(local-set-key (kbd "C-c C-x x") 'nd/mark-subtree-done)
|
||
|
||
;; override default org subtree cloning with something that clones and resets
|
||
(local-set-key (kbd "C-c C-x c") 'nd/org-clone-subtree-with-time-shift)))
|
||
|
||
(add-hook 'org-agenda-mode-hook
|
||
(lambda ()
|
||
(local-set-key (kbd "C-c C-c") 'org-agenda-set-tags)
|
||
(local-set-key (kbd "C-c C-x c") 'nd/org-agenda-clone-subtree-with-time-shift)
|
||
(local-set-key (kbd "C-c C-x C-b") 'nd/org-agenda-toggle-checkbox)))
|
||
#+END_SRC
|
||
*** mu4e
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key mu4e-headers-mode-map (kbd "C-c C-l") 'org-store-link)
|
||
(define-key mu4e-view-mode-map (kbd "C-c C-l") 'org-store-link)
|
||
#+END_SRC
|
||
*** dired
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key dired-mode-map (kbd "C-x g") 'magit)
|
||
#+END_SRC
|
||
*** helm-prefix
|
||
Some of these are useful enough that I make give them a direct binding without requiring a prefix. For now this is fine.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key helm-command-prefix (kbd "b") 'helm-bibtex)
|
||
(define-key helm-command-prefix (kbd "S") 'helm-swoop)
|
||
(define-key helm-command-prefix (kbd "<f8>") 'helm-resume)
|
||
#+END_SRC
|
||
|
||
Give =f= to =nd/helm-flyspell-correct= instead of =helm-multi-files= and give the latter =F= (used much less).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key helm-command-prefix (kbd "f") 'helm-flyspell-correct)
|
||
(define-key helm-command-prefix (kbd "F") 'helm-multi-files)
|
||
#+END_SRC
|
||
*** outline-magic
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key outline-minor-mode-map (kbd "<tab>") 'outline-cycle)
|
||
#+END_SRC
|
||
*** ess
|
||
They removed the underscore-inserts-arrow feature. Bring it back.
|
||
#+BEGIN_SRC emacs-lisp
|
||
(define-key ess-r-mode-map "_" #'ess-insert-assign)
|
||
(define-key inferior-ess-r-mode-map "_" #'ess-insert-assign)
|
||
#+END_SRC
|
||
** global
|
||
*** function
|
||
The function keys are nice because they are almost (not always) free in every mode. Therefore I use these for functions that I need to access anywhere, but not necessary extremely often (because they are out of the way and harder to reach).
|
||
#+BEGIN_SRC emacs-lisp
|
||
(global-set-key (kbd "<f1>") 'org-agenda)
|
||
(global-set-key (kbd "<f2>") 'org-capture)
|
||
(global-set-key (kbd "<f3>") 'cfw:open-org-calendar)
|
||
(global-set-key (kbd "<f4>") 'org-clock-goto)
|
||
(global-set-key (kbd "<f5>") 'ansi-term)
|
||
(global-set-key (kbd "<f8>") 'helm-command-prefix)
|
||
(global-set-key (kbd "C-<f5>") 'nd/open-urxvt)
|
||
(global-set-key (kbd "<f12>") 'mu4e)
|
||
(global-set-key (kbd "C-<f12>") 'global-hl-line-mode)
|
||
(global-set-key (kbd "S-<f12>") 'display-line-numbers-mode)
|
||
#+END_SRC
|
||
*** control/meta
|
||
#+BEGIN_SRC emacs-lisp
|
||
(global-set-key (kbd "C-<SPC>") 'company-complete)
|
||
|
||
(global-set-key (kbd "C-c e") 'nd/config-visit)
|
||
(global-set-key (kbd "C-c r") 'nd/config-reload)
|
||
(global-set-key (kbd "C-c s") 'sudo-edit)
|
||
|
||
(global-set-key (kbd "C-x 2") 'nd/split-and-follow-horizontally)
|
||
(global-set-key (kbd "C-x 3") 'nd/split-and-follow-vertically)
|
||
(global-unset-key (kbd "C-x c"))
|
||
(global-set-key (kbd "C-x k") 'nd/kill-current-buffer)
|
||
(global-set-key (kbd "C-x C-d") 'helm-bookmarks)
|
||
(global-set-key (kbd "C-x C-c C-d") 'nd/helm-devices)
|
||
(global-set-key (kbd "C-x C-f") 'helm-find-files)
|
||
(global-set-key (kbd "C-x C-b") 'helm-buffers-list)
|
||
|
||
(global-set-key (kbd "C-M-S-k") 'nd/close-all-buffers)
|
||
(global-set-key (kbd "C-M-S-o") 'nd/org-close-all-buffers)
|
||
(global-set-key (kbd "C-M-S-a") 'org-agenda-kill-all-agenda-buffers)
|
||
|
||
(global-set-key (kbd "M-b") 'nd/switch-to-previous-buffer)
|
||
(global-set-key (kbd "M-o") 'ace-window)
|
||
(global-set-key (kbd "M-s") 'avy-goto-char)
|
||
(global-set-key (kbd "M-x") 'helm-M-x)
|
||
#+END_SRC
|