2581 lines
92 KiB
EmacsLisp
2581 lines
92 KiB
EmacsLisp
|
(use-package spacemacs-theme
|
||
|
|
:defer t
|
||
|
|
:config
|
||
|
|
(setq spacemacs-theme-custom-colors '((lnum . "#64707c"))))
|
||
|
|
|
||
|
|
(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))))
|
||
|
|
|
||
|
|
(use-package spaceline
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
(require 'spaceline-config)
|
||
|
|
(setq powerline-default-separator 'arrow
|
||
|
|
spaceline-buffer-size-p nil)
|
||
|
|
(spaceline-spacemacs-theme))
|
||
|
|
|
||
|
|
(line-number-mode 1)
|
||
|
|
(column-number-mode 1)
|
||
|
|
|
||
|
|
(use-package delight
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(setq inhibit-startup-screen t)
|
||
|
|
|
||
|
|
(tool-bar-mode -1)
|
||
|
|
(menu-bar-mode -1)
|
||
|
|
(scroll-bar-mode -1)
|
||
|
|
|
||
|
|
(setq make-backup-files nil)
|
||
|
|
(setq auto-save-default nil)
|
||
|
|
|
||
|
|
(setq pop-up-windows nil) ; no popups (eg ediff)
|
||
|
|
|
||
|
|
(set-default 'truncate-lines t)
|
||
|
|
|
||
|
|
(setq scroll-conservatively 100)
|
||
|
|
|
||
|
|
(when (fboundp 'imagemagick-register-types)
|
||
|
|
(imagemagick-register-types))
|
||
|
|
|
||
|
|
(defalias 'yes-or-no-p 'y-or-n-p) ; eliminate yes or no prompt on killing procs
|
||
|
|
|
||
|
|
(use-package beacon
|
||
|
|
:ensure t
|
||
|
|
:delight
|
||
|
|
:init
|
||
|
|
(beacon-mode 1))
|
||
|
|
|
||
|
|
(use-package which-key
|
||
|
|
:ensure t
|
||
|
|
:delight
|
||
|
|
:init
|
||
|
|
(which-key-mode))
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(use-package helm-swoop
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(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))))))
|
||
|
|
|
||
|
|
(use-package avy
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
(setq avy-background t))
|
||
|
|
|
||
|
|
(use-package sudo-edit
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(use-package undo-tree
|
||
|
|
:ensure t
|
||
|
|
:delight
|
||
|
|
:config
|
||
|
|
(setq undo-tree-visualizer-diff t)
|
||
|
|
(global-undo-tree-mode))
|
||
|
|
|
||
|
|
(use-package fill-column-indicator
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
(setq fci-rule-use-dashes t)
|
||
|
|
:hook
|
||
|
|
(prog-mode . fci-mode))
|
||
|
|
|
||
|
|
(use-package rainbow-mode
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(use-package async
|
||
|
|
:ensure t
|
||
|
|
:delight dired-async-mode
|
||
|
|
:init
|
||
|
|
(dired-async-mode 1))
|
||
|
|
|
||
|
|
(use-package csv-mode
|
||
|
|
:ensure t
|
||
|
|
:hook (csv-mode . (lambda () (csv-align-fields nil (point-min) (point-max)))))
|
||
|
|
|
||
|
|
(use-package markdown-mode
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
;; 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))))
|
||
|
|
|
||
|
|
(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" s))
|
||
|
|
|
||
|
|
(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/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 (expand-file-name "~/.emacs.d/conf/main.org")))
|
||
|
|
|
||
|
|
(defun nd/config-visit ()
|
||
|
|
"Opens the main conf.org file (the one that really matters)."
|
||
|
|
(interactive)
|
||
|
|
(find-file "~/.emacs.d/conf/main.org"))
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(setq-default indent-tabs-mode nil
|
||
|
|
tab-width 4)
|
||
|
|
|
||
|
|
(use-package company
|
||
|
|
:ensure t
|
||
|
|
:delight " ©"
|
||
|
|
:config
|
||
|
|
(setq company-idle-delay 0
|
||
|
|
company-minimum-prefix-length 3))
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(use-package yasnippet
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(use-package yasnippet-snippets
|
||
|
|
:ensure t
|
||
|
|
:after yasnippet
|
||
|
|
:hook
|
||
|
|
((prog-mode . yas-minor-mode))
|
||
|
|
:config
|
||
|
|
(yas-reload-all))
|
||
|
|
|
||
|
|
;; (electric-pair-mode t)
|
||
|
|
|
||
|
|
(use-package flyspell-correct-helm
|
||
|
|
:ensure t
|
||
|
|
:after (helm flyspell))
|
||
|
|
|
||
|
|
;; (add-hook 'flyspell-mode-hook 'flyspell-buffer)
|
||
|
|
|
||
|
|
(add-hook 'prog-mode-hook #'prettify-symbols-mode)
|
||
|
|
(add-hook 'prog-mode-hook #'flyspell-prog-mode)
|
||
|
|
(setq flyspell-issue-message-flag nil)
|
||
|
|
|
||
|
|
(add-hook 'emacs-lisp-mode-hook 'company-mode)
|
||
|
|
|
||
|
|
(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/")))
|
||
|
|
|
||
|
|
(elpy-enable)
|
||
|
|
|
||
|
|
;; make python tabs 4 chars
|
||
|
|
(add-hook 'python-mode-hook
|
||
|
|
(lambda ()
|
||
|
|
(setq indent-tabs-mode t)
|
||
|
|
(setq tab-width 4)
|
||
|
|
(setq python-indent 4)))
|
||
|
|
|
||
|
|
(setq python-shell-interpreter "ipython"
|
||
|
|
python-shell-interpreter-args "--colors=Linux --profile=default")
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(add-hook 'haskell-mode-hook #'subword-mode)
|
||
|
|
|
||
|
|
(add-hook 'LaTeX-mode-hook #'flycheck-mode)
|
||
|
|
(add-hook 'Tex-latex-mode-hook #'flycheck-mode)
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(add-hook 'LaTeX-mode-hook (lambda () (flyspell-mode 1)))
|
||
|
|
|
||
|
|
(use-package org
|
||
|
|
:delight
|
||
|
|
;; source of indent-mode required here
|
||
|
|
(org-indent-mode nil org-indent)
|
||
|
|
(visual-line-mode)
|
||
|
|
:hook
|
||
|
|
(org-mode . visual-line-mode)
|
||
|
|
:config
|
||
|
|
(setq org-startup-indented t
|
||
|
|
org-directory "~/Org"
|
||
|
|
org-modules '(org-habit org-protocol))
|
||
|
|
|
||
|
|
(require 'org-protocol))
|
||
|
|
|
||
|
|
(setq org-special-ctrl-a/e t
|
||
|
|
org-special-ctrl-k t
|
||
|
|
org-yank-adjusted-subtrees t)
|
||
|
|
|
||
|
|
(defun nd/org-save-all-org-buffers ()
|
||
|
|
"Save org buffers without confirmation or message (unlike default)."
|
||
|
|
(save-some-buffers t (lambda () (derived-mode-p 'org-mode)))
|
||
|
|
(when (featurep 'org-id) (org-id-locations-save)))
|
||
|
|
|
||
|
|
(run-at-time "00:59" 3600 #'nd/org-save-all-org-buffers)
|
||
|
|
|
||
|
|
(setq org-log-into-drawer "LOGBOOK")
|
||
|
|
|
||
|
|
(setq org-log-done 'time
|
||
|
|
org-log-redeadline 'time
|
||
|
|
org-log-reschedule 'time)
|
||
|
|
|
||
|
|
(setq org-log-repeat 'note)
|
||
|
|
|
||
|
|
(use-package org-bullets
|
||
|
|
:ensure t
|
||
|
|
:hook
|
||
|
|
(org-mode . org-bullets-mode))
|
||
|
|
|
||
|
|
(add-hook 'org-mode-hook
|
||
|
|
(lambda ()
|
||
|
|
(let ((heading-height 1.15))
|
||
|
|
(set-face-attribute 'org-level-1 nil :weight 'bold :height heading-height)
|
||
|
|
(set-face-attribute 'org-level-2 nil :weight 'semi-bold :height heading-height)
|
||
|
|
(set-face-attribute 'org-level-3 nil :weight 'normal :height heading-height)
|
||
|
|
(set-face-attribute 'org-level-4 nil :weight 'normal :height heading-height)
|
||
|
|
(set-face-attribute 'org-level-5 nil :weight 'normal :height heading-height))))
|
||
|
|
|
||
|
|
(setq org-src-window-setup 'current-window
|
||
|
|
org-src-fontify-natively t
|
||
|
|
org-edit-src-content-indentation 0)
|
||
|
|
|
||
|
|
(add-to-list 'org-structure-template-alist
|
||
|
|
'("el" "#+BEGIN_SRC emacs-lisp\n?\n#+END_SRC"))
|
||
|
|
|
||
|
|
(setq org-insert-heading-respect-content t)
|
||
|
|
|
||
|
|
(defun nd/mark-subtree-keyword (new-keyword &optional exclude)
|
||
|
|
"Mark all tasks in a subtree with NEW-KEYWORD unless original
|
||
|
|
keyword is in the optional argument EXCLUDE."
|
||
|
|
(let ((subtree-end (save-excursion (org-end-of-subtree t))))
|
||
|
|
(if (not (listp exclude))
|
||
|
|
(error "exlude must be a list if provided"))
|
||
|
|
(save-excursion
|
||
|
|
(while (< (point) subtree-end)
|
||
|
|
(let ((keyword (nd/is-todoitem-p)))
|
||
|
|
(if (and keyword (not (member keyword exclude)))
|
||
|
|
(org-todo new-keyword)))
|
||
|
|
(outline-next-heading)))))
|
||
|
|
|
||
|
|
(defun nd/mark-subtree-done ()
|
||
|
|
"Mark all tasks in subtree as DONE unless they are already CANC."
|
||
|
|
(interactive)
|
||
|
|
(nd/mark-subtree-keyword "DONE" '("CANC")))
|
||
|
|
|
||
|
|
(defun nd/org-clone-subtree-with-time-shift (n &optional shift)
|
||
|
|
"Like `org-clone-subtree-with-time-shift' except it resets checkboxes
|
||
|
|
and reverts all todo keywords to TODO."
|
||
|
|
(interactive "nNumber of clones to produce: ")
|
||
|
|
|
||
|
|
(let ((shift (or (org-entry-get nil "TIME_SHIFT" 'selective)
|
||
|
|
(read-from-minibuffer
|
||
|
|
"Date shift per clone (e.g. +1w, empty to copy unchanged): "))))
|
||
|
|
(condition-case err
|
||
|
|
(progn
|
||
|
|
(save-excursion
|
||
|
|
;; clone once and reset
|
||
|
|
(org-clone-subtree-with-time-shift 1 shift)
|
||
|
|
(org-forward-heading-same-level 1 t)
|
||
|
|
(org-reset-checkbox-state-subtree)
|
||
|
|
(nd/mark-subtree-keyword "TODO")
|
||
|
|
(call-interactively 'nd/org-log-delete)
|
||
|
|
(org-cycle)
|
||
|
|
;; clone reset tree again if we need more than one clone
|
||
|
|
(if (> n 1)
|
||
|
|
(let ((additional-trees (- n 1)))
|
||
|
|
(org-clone-subtree-with-time-shift additional-trees shift)
|
||
|
|
(dotimes (i additional-trees)
|
||
|
|
(org-forward-heading-same-level 1 t)
|
||
|
|
(org-cycle))))))
|
||
|
|
(error (message "%s" (error-message-string err))))))
|
||
|
|
|
||
|
|
(defun nd/org-log-delete ()
|
||
|
|
"Delete logbook drawer of subtree."
|
||
|
|
(interactive)
|
||
|
|
(save-excursion
|
||
|
|
(goto-char (org-log-beginning))
|
||
|
|
(when (save-excursion
|
||
|
|
(save-match-data
|
||
|
|
(beginning-of-line 0)
|
||
|
|
(search-forward-regexp org-drawer-regexp)
|
||
|
|
(goto-char (match-beginning 1))
|
||
|
|
(looking-at "LOGBOOK")))
|
||
|
|
(org-mark-element)
|
||
|
|
(delete-region (region-beginning) (region-end))
|
||
|
|
(org-remove-empty-drawer-at (point)))))
|
||
|
|
|
||
|
|
(defun nd/org-insert-todo-heading-inactive-timestamp ()
|
||
|
|
"Insert a todo heading but also insert inactive timestamp set to now."
|
||
|
|
(interactive)
|
||
|
|
;; a bit redundant and hacky, with the advantage of being effective
|
||
|
|
(when (not (org-insert-item 'checkbox))
|
||
|
|
(call-interactively 'org-insert-todo-heading)
|
||
|
|
(insert "\n")
|
||
|
|
(funcall-interactively 'org-time-stamp-inactive '(16))
|
||
|
|
(previous-line)))
|
||
|
|
|
||
|
|
(defun nd/org-delete-subtree ()
|
||
|
|
"Delete the entire subtree under the current heading without sending to kill ring."
|
||
|
|
(interactive)
|
||
|
|
(org-back-to-heading t)
|
||
|
|
(delete-region (point) (+ 1 (save-excursion (org-end-of-subtree)))))
|
||
|
|
|
||
|
|
(defmacro nd/org-agenda-cmd-wrapper (get-head &rest body)
|
||
|
|
"Wraps commands in BODY in necessary code to allow commands to be
|
||
|
|
called from the agenda buffer. Particularly, this wrapper will
|
||
|
|
navigate to the original header, execute BODY, then update the agenda
|
||
|
|
buffer."
|
||
|
|
'(org-agenda-check-no-diary)
|
||
|
|
`(let* ((hdmarker (or (org-get-at-bol 'org-hd-marker)
|
||
|
|
(org-agenda-error)))
|
||
|
|
(buffer (marker-buffer hdmarker))
|
||
|
|
(pos (marker-position hdmarker))
|
||
|
|
(inhibit-read-only t)
|
||
|
|
newhead)
|
||
|
|
(org-with-remote-undo buffer
|
||
|
|
(with-current-buffer buffer
|
||
|
|
(widen)
|
||
|
|
(goto-char pos)
|
||
|
|
(org-show-context 'agenda)
|
||
|
|
,@body
|
||
|
|
(when ,get-head (setq newhead (org-get-heading))))
|
||
|
|
(if ,get-head
|
||
|
|
(org-agenda-change-all-lines newhead hdmarker)
|
||
|
|
(org-agenda-redo))
|
||
|
|
(beginning-of-line 1))))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-toggle-checkbox ()
|
||
|
|
"Toggle checkboxes in org agenda view using `org-toggle-checkbox'."
|
||
|
|
(interactive)
|
||
|
|
(nd/org-agenda-cmd-wrapper
|
||
|
|
t
|
||
|
|
(call-interactively #'org-toggle-checkbox)))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-clone-subtree-with-time-shift ()
|
||
|
|
"Apply `nd/org-clone-subtree-with-time-shift' to an agenda entry.
|
||
|
|
It will clone the last entry in the selected subtree."
|
||
|
|
(interactive)
|
||
|
|
(nd/org-agenda-cmd-wrapper
|
||
|
|
nil
|
||
|
|
(org-end-of-subtree)
|
||
|
|
(call-interactively #'nd/org-clone-subtree-with-time-shift)))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-delete-subtree ()
|
||
|
|
"Apply `nd/org-delete-subtree' to an agenda entry."
|
||
|
|
(interactive)
|
||
|
|
(nd/org-agenda-cmd-wrapper
|
||
|
|
nil
|
||
|
|
(call-interactively #'nd/org-delete-subtree)))
|
||
|
|
|
||
|
|
(setq org-columns-default-format
|
||
|
|
"%25ITEM %4TODO %TAGS %5Effort{:} %DELEGATE(DEL)")
|
||
|
|
|
||
|
|
(set-face-attribute 'org-column nil :background "#1e2023")
|
||
|
|
;; org-columns-summary-types
|
||
|
|
|
||
|
|
(use-package calfw
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
(setq cfw:fchar-junction ?╋
|
||
|
|
cfw:fchar-vertical-line ?┃
|
||
|
|
cfw:fchar-horizontal-line ?━
|
||
|
|
cfw:fchar-left-junction ?┣
|
||
|
|
cfw:fchar-right-junction ?┫
|
||
|
|
cfw:fchar-top-junction ?┯
|
||
|
|
cfw:fchar-top-left-corner ?┏
|
||
|
|
cfw:fchar-top-right-corner ?┓))
|
||
|
|
|
||
|
|
(use-package calfw-org
|
||
|
|
:ensure t
|
||
|
|
:after calfw
|
||
|
|
:config
|
||
|
|
(setq cfw:org-agenda-schedule-args
|
||
|
|
'(:deadline :timestamp)))
|
||
|
|
|
||
|
|
(defun nd/org-todo-position (buffer alist)
|
||
|
|
(let ((win (car (cl-delete-if-not
|
||
|
|
(lambda (window)
|
||
|
|
(with-current-buffer (window-buffer window)
|
||
|
|
(memq major-mode
|
||
|
|
'(org-mode org-agenda-mode))))
|
||
|
|
(window-list)))))
|
||
|
|
(when win
|
||
|
|
(let ((new (split-window win -4 'below)))
|
||
|
|
(set-window-buffer new buffer)
|
||
|
|
new))))
|
||
|
|
|
||
|
|
(defun nd/org-todo-window-advice (orig-fn)
|
||
|
|
"Advice to fix window placement in `org-fast-todo-selection'."
|
||
|
|
(let ((override '("\\*Org todo\\*" nd/org-todo-position)))
|
||
|
|
(add-to-list 'display-buffer-alist override)
|
||
|
|
(nd/with-advice
|
||
|
|
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
|
||
|
|
(unwind-protect (funcall orig-fn)
|
||
|
|
(setq display-buffer-alist
|
||
|
|
(delete override display-buffer-alist))))))
|
||
|
|
|
||
|
|
(advice-add #'org-fast-todo-selection :around #'nd/org-todo-window-advice)
|
||
|
|
|
||
|
|
(defun nd/org-tag-window-advice (orig-fn current inherited table &optional todo-table)
|
||
|
|
"Advice to fix window placement in `org-fast-tags-selection'."
|
||
|
|
(nd/with-advice
|
||
|
|
((#'delete-other-windows :override #'ignore)
|
||
|
|
;; pretty sure I just got lucky here...
|
||
|
|
(#'split-window-vertically :override #'(lambda (&optional size)
|
||
|
|
(split-window-below (or size -9)))))
|
||
|
|
(unwind-protect (funcall orig-fn current inherited table todo-table))))
|
||
|
|
|
||
|
|
(advice-add #'org-fast-tag-selection :around #'nd/org-tag-window-advice)
|
||
|
|
|
||
|
|
(defun nd/org-capture-position (buffer alist)
|
||
|
|
(let ((new (split-window (get-buffer-window) -14 'below)))
|
||
|
|
(set-window-buffer new buffer)
|
||
|
|
new))
|
||
|
|
|
||
|
|
(defun nd/org-capture-window-advice (orig-fn table title &optional prompt specials)
|
||
|
|
"Advice to fix window placement in `org-capture-select-template'."
|
||
|
|
(let ((override '("\\*Org Select\\*" nd/org-capture-position)))
|
||
|
|
(add-to-list 'display-buffer-alist override)
|
||
|
|
(nd/with-advice
|
||
|
|
((#'org-switch-to-buffer-other-window :override #'pop-to-buffer))
|
||
|
|
(unwind-protect (funcall orig-fn table title prompt specials)
|
||
|
|
(setq display-buffer-alist
|
||
|
|
(delete override display-buffer-alist))))))
|
||
|
|
|
||
|
|
(advice-add #'org-mks :around #'nd/org-capture-window-advice)
|
||
|
|
|
||
|
|
(setq org-html-doctype "html5")
|
||
|
|
|
||
|
|
(setq org-latex-pdf-process (list "latexmk -shell-escape -bibtex -f -pdf %f"))
|
||
|
|
|
||
|
|
;; (defvar nd/org-export-publishing-directory
|
||
|
|
;; (expand-file-name "~/Downloads/org-exports")
|
||
|
|
;; "The target directory to for all org exports.")
|
||
|
|
|
||
|
|
;; (defun nd/org-export-output-file-name (orig-fun extension &optional subtreep pub-dir)
|
||
|
|
;; "Change the target export directory for org exports."
|
||
|
|
;; (unless pub-dir
|
||
|
|
;; (setq pub-dir nd/org-export-publishing-directory)
|
||
|
|
;; (unless (file-directory-p pub-dir)
|
||
|
|
;; (make-directory pub-dir)))
|
||
|
|
;; (apply orig-fun extension subtreep pub-dir nil))
|
||
|
|
|
||
|
|
;; (advice-add 'org-export-output-file-name :around #'nd/org-export-output-file-name)
|
||
|
|
|
||
|
|
(add-to-list 'load-path "~/.emacs.d/untracked/org-gantt/")
|
||
|
|
(require 'org-gantt)
|
||
|
|
|
||
|
|
(add-to-list 'org-structure-template-alist
|
||
|
|
'("og" "#+BEGIN: org-gantt-chart\n?\n#+END"))
|
||
|
|
|
||
|
|
(setq org-todo-keywords
|
||
|
|
'((sequence
|
||
|
|
;; default undone state
|
||
|
|
"TODO(t/!)"
|
||
|
|
|
||
|
|
;; undone but available to do now (projects only)
|
||
|
|
"NEXT(n/!)" "|"
|
||
|
|
|
||
|
|
;; done and complete
|
||
|
|
"DONE(d/!)")
|
||
|
|
|
||
|
|
(sequence
|
||
|
|
;; undone and waiting on some external dependency
|
||
|
|
"WAIT(w@/!)"
|
||
|
|
|
||
|
|
;; undone but signifies tasks on which I don't wish to focus at the moment
|
||
|
|
"HOLD(h@/!)" "|"
|
||
|
|
|
||
|
|
;; done but not complete
|
||
|
|
"CANC(c@/!)")))
|
||
|
|
|
||
|
|
(setq org-todo-keyword-faces
|
||
|
|
'(("TODO" :foreground "light coral" :weight bold)
|
||
|
|
("NEXT" :foreground "khaki" :weight bold)
|
||
|
|
("DONE" :foreground "light green" :weight bold)
|
||
|
|
("WAIT" :foreground "orange" :weight bold)
|
||
|
|
("HOLD" :foreground "violet" :weight bold)
|
||
|
|
("CANC" :foreground "deep sky blue" :weight bold)))
|
||
|
|
|
||
|
|
(setq org-tag-alist
|
||
|
|
;; (@) gtd location context
|
||
|
|
'((:startgroup)
|
||
|
|
("@errand" . ?e)
|
||
|
|
("@home" . ?h)
|
||
|
|
("@work" . ?w)
|
||
|
|
("@travel" . ?r)
|
||
|
|
(:endgroup)
|
||
|
|
|
||
|
|
;; (#) gtd resource context
|
||
|
|
("#laptop" . ?l)
|
||
|
|
("#tcult" . ?t)
|
||
|
|
("#phone" . ?p)
|
||
|
|
|
||
|
|
;; (%) misc tags
|
||
|
|
;; denotes reference information
|
||
|
|
("%note" . ?n)
|
||
|
|
|
||
|
|
;; incubator
|
||
|
|
("%inc" . ?i)
|
||
|
|
|
||
|
|
;; denotes tasks that need further subdivision to turn into true project
|
||
|
|
("%subdiv" . ?s)
|
||
|
|
|
||
|
|
;; catchall to mark important headings, usually for meetings
|
||
|
|
("%flag" . ?f)
|
||
|
|
|
||
|
|
;; (_) life categories, used for gtd priority context
|
||
|
|
(:startgroup)
|
||
|
|
("_env" . ?E)
|
||
|
|
("_fin" . ?F)
|
||
|
|
("_int" . ?I)
|
||
|
|
("_met" . ?M)
|
||
|
|
("_phy" . ?H)
|
||
|
|
("_pro" . ?P)
|
||
|
|
("_rec" . ?R)
|
||
|
|
("_soc" . ?S)
|
||
|
|
(:endgroup)))
|
||
|
|
|
||
|
|
(defun nd/add-tag-face (fg-name prefix)
|
||
|
|
"Adds list of cons cells to org-tag-faces with foreground set to fg-name.
|
||
|
|
Start and end specify the positions in org-tag-alist which define the tags
|
||
|
|
to which the faces are applied"
|
||
|
|
(dolist (tag (nd/filter-list-prefix prefix (mapcar #'car org-tag-alist)))
|
||
|
|
(push `(,tag . (:foreground ,fg-name)) org-tag-faces)))
|
||
|
|
|
||
|
|
(setq org-tag-faces '())
|
||
|
|
|
||
|
|
(nd/add-tag-face "PaleGreen" "@")
|
||
|
|
(nd/add-tag-face "SkyBlue" "#")
|
||
|
|
(nd/add-tag-face "PaleGoldenrod" "%")
|
||
|
|
(nd/add-tag-face "violet" "_")
|
||
|
|
|
||
|
|
(mapc (lambda (i) (add-to-list 'org-default-properties i))
|
||
|
|
;; defines a repeater group
|
||
|
|
'("PARENT_TYPE"
|
||
|
|
;; defines the time shift for repeater groups
|
||
|
|
|
||
|
|
"TIME_SHIFT"
|
||
|
|
;; assigns another person/entity to a task (experimental)
|
||
|
|
|
||
|
|
"DELEGATE"
|
||
|
|
|
||
|
|
;; defines a goal (not currently used)
|
||
|
|
"GOAL"))
|
||
|
|
|
||
|
|
(setq org-global-properties
|
||
|
|
'(("PARENT_TYPE_ALL" . "periodical iterator")
|
||
|
|
("Effort_ALL" . "0:05 0:15 0:30 1:00 1:30 2:00 3:00 4:00 5:00 6:00"))
|
||
|
|
|
||
|
|
org-use-property-inheritance
|
||
|
|
'("PARENT_TYPE" "TIME_SHIFT"))
|
||
|
|
|
||
|
|
(defun nd/org-timestamp-future (days)
|
||
|
|
"Inserts an active org timestamp DAYS after the current time."
|
||
|
|
(format-time-string (org-time-stamp-format nil)
|
||
|
|
(time-add (current-time) (days-to-time 1))))
|
||
|
|
|
||
|
|
(let ((capfile "~/Org/capture.org"))
|
||
|
|
(setq org-capture-templates
|
||
|
|
;; regular TODO task
|
||
|
|
`(("t" "todo" entry (file ,capfile)
|
||
|
|
"* TODO %?\n%U\ndeliverable: \n")
|
||
|
|
|
||
|
|
;; for useful reference information that may be grouped with tasks
|
||
|
|
("n" "note" entry (file ,capfile)
|
||
|
|
"* %? :\\%note:\n%U\n")
|
||
|
|
|
||
|
|
;; for non-actionable events that happen at a certain time
|
||
|
|
("a" "appointment" entry (file ,capfile)
|
||
|
|
"* %?\n%U\n%^t\n")
|
||
|
|
|
||
|
|
;; like appointment but multiple days
|
||
|
|
("s" "appointment-span" entry (file ,capfile)
|
||
|
|
"* %?\n%U\n%^t--%^t\n")
|
||
|
|
|
||
|
|
;; task with a deadline
|
||
|
|
("d" "deadline" entry (file ,capfile)
|
||
|
|
"* TODO %?\nDEADLINE: %^t\ndeliverable:\n%U\n")
|
||
|
|
|
||
|
|
;; for converting mu4e emails to tasks, defaults to next-day deadline
|
||
|
|
("e" "email" entry (file ,capfile)
|
||
|
|
"* TODO Respond to %:fromname; Re: %:subject :#laptop:\nDEADLINE: %(nd/org-timestamp-future 1)\n%U\n%a\n")
|
||
|
|
|
||
|
|
;; for interruptions that produce useful reference material
|
||
|
|
("m" "meeting" entry (file ,capfile)
|
||
|
|
"* meeting with%? :\\%note:\n%U\n")
|
||
|
|
|
||
|
|
;; for capturing web pages with web browser
|
||
|
|
("p" "org-protocol" entry (file ,capfile)
|
||
|
|
"* %^{Title} :\\%note:\n%u\n#+BEGIN_QUOTE\n%i\n#+END_QUOTE"
|
||
|
|
:immediate-finish t)
|
||
|
|
|
||
|
|
;; or capturing links with web browser
|
||
|
|
("L" "org-protocol link" entry (file ,capfile)
|
||
|
|
"* %^{Title} :\\%note:\n[[%:link][%:description]]\n%U"
|
||
|
|
:immediate-finish t))))
|
||
|
|
|
||
|
|
(add-hook 'org-capture-mode-hook (lambda () (evil-append 1)))
|
||
|
|
|
||
|
|
(setq org-refile-targets '((nil :maxlevel . 9)
|
||
|
|
("~/Org/reference/idea.org" :maxlevel . 9)
|
||
|
|
(org-agenda-files :maxlevel . 9))
|
||
|
|
org-refile-use-outline-path t
|
||
|
|
org-outline-path-complete-in-steps nil
|
||
|
|
org-refile-allow-creating-parent-nodes 'confirm
|
||
|
|
org-indirect-buffer-display 'current-window)
|
||
|
|
|
||
|
|
(setq org-refile-target-verify-function
|
||
|
|
(lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords))))
|
||
|
|
|
||
|
|
;; TODO this no work, although does work if var is global
|
||
|
|
;; redfining the targets works for now
|
||
|
|
(add-hook 'org-agenda-mode-hook
|
||
|
|
(lambda ()
|
||
|
|
(when (equal (buffer-name) "*Org Agenda(A)*")
|
||
|
|
(setq-local org-refile-targets
|
||
|
|
'(("~/Org/journal/goals.org" :maxlevel . 9))))))
|
||
|
|
;; (lambda () (when (org-entry-get nil "GOAL") t))))))
|
||
|
|
;; (setq org-refile-targets '((nil :maxlevel . 9)
|
||
|
|
;; ("~/Org/reference/idea.org" :maxlevel . 9)
|
||
|
|
;; ("~/Org/journal/goals.org" :maxlevel . 9)
|
||
|
|
;; (org-agenda-files :maxlevel . 9))
|
||
|
|
|
||
|
|
(setq org-clock-history-length 23
|
||
|
|
org-clock-out-when-done t
|
||
|
|
org-clock-persist t
|
||
|
|
org-clock-report-include-clocking-task t)
|
||
|
|
|
||
|
|
(defun nd/are-conflicting-p (ts-a ts-b)
|
||
|
|
"Return t if timestamps TS-A and TS-B conflict."
|
||
|
|
(let* ((earlier-a (car ts-a))
|
||
|
|
(earlier-b (car ts-b))
|
||
|
|
(later-b (+ earlier-b (nth 1 ts-b))))
|
||
|
|
(and (>= earlier-a earlier-b) (<= earlier-a later-b))))
|
||
|
|
|
||
|
|
(defun nd/detect-conflict (ts ts-list conlist)
|
||
|
|
"Recursively determine if timestamp TS conflicts with anything in TS-LIST.
|
||
|
|
If detected, conflict pair is added to CONLIST."
|
||
|
|
(let ((next-ts (car ts-list))
|
||
|
|
(rem-ts (cdr ts-list)))
|
||
|
|
(if (nd/are-conflicting-p ts next-ts)
|
||
|
|
(progn
|
||
|
|
(setq conlist (cons (list ts next-ts) conlist))
|
||
|
|
(if rem-ts (nd/detect-conflict ts rem-ts conlist) conlist))
|
||
|
|
conlist)))
|
||
|
|
|
||
|
|
(defun nd/build-conlist (ts-list conlist)
|
||
|
|
"Recursively build a list of timestamp conflicts from TS-LIST.
|
||
|
|
|
||
|
|
TS-LIST is comprised of entries in the form (staring-ts timerange marker)
|
||
|
|
where timerange is 0 for singular timestamps and a positive number for
|
||
|
|
anything with to times or a timestamp range.
|
||
|
|
Detected conflicts are stored in CONLIST as pairs of conflicting ts
|
||
|
|
entries from the TS-LIST."
|
||
|
|
(let ((cur-ts (car ts-list))
|
||
|
|
(rem-ts (cdr ts-list)))
|
||
|
|
(if rem-ts
|
||
|
|
(nd/build-conlist rem-ts (nd/detect-conflict cur-ts rem-ts conlist))
|
||
|
|
conlist)))
|
||
|
|
|
||
|
|
(defconst nd/org-tsm-regexp
|
||
|
|
"\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\} [^]+0-9>\r\n -]+? \\)\\([0-9]\\{1,2\\}:[0-9]\\{2\\}?\\)-\\([0-9]\\{1,2\\}:[0-9]\\{2\\}\\)"
|
||
|
|
"Regular expression for timestamps with two times.")
|
||
|
|
|
||
|
|
(defun nd/get-timestamps ()
|
||
|
|
"Get the org-marker and timestamp(s) (multiple if range) or current heading."
|
||
|
|
;; TODO, what if I care about more than just TIMESTAMPs
|
||
|
|
(let* ((ts (org-entry-get nil "TIMESTAMP"))
|
||
|
|
(marker (point-marker))
|
||
|
|
(ts-range 0)
|
||
|
|
(ts-entry))
|
||
|
|
(when ts
|
||
|
|
(cond
|
||
|
|
;; match timestamps that have two times
|
||
|
|
((string-match nd/org-tsm-regexp ts)
|
||
|
|
(let* ((ts1 (concat (match-string 1 ts) (match-string 2 ts)))
|
||
|
|
(ts2 (concat (match-string 1 ts) (match-string 3 ts)))
|
||
|
|
(ft1 (org-2ft ts1))
|
||
|
|
(ft2 (org-2ft ts2)))
|
||
|
|
(setq ts-entry ft1)
|
||
|
|
(setq ts-range (- ft2 ft1))))
|
||
|
|
|
||
|
|
;; match timestamps that have a range (eq two timestamps)
|
||
|
|
((string-match org-tr-regexp ts)
|
||
|
|
(let* ((ts1 (match-string 1 ts))
|
||
|
|
(ts2 (match-string 2 ts))
|
||
|
|
(ft1 (org-2ft ts1))
|
||
|
|
(ft2 (org-2ft ts2)))
|
||
|
|
(setq ts-entry ft1)
|
||
|
|
(setq ts-range (- ft2 ft1))))
|
||
|
|
|
||
|
|
;; match timestamps with only one time
|
||
|
|
(t (setq ts-entry (org-2ft ts))))
|
||
|
|
(list ts-entry ts-range marker ts))))
|
||
|
|
|
||
|
|
(defun nd/build-conflict-list ()
|
||
|
|
"Scan all org files and make a list of all timestamps that conflict."
|
||
|
|
(let ((files (org-agenda-files))
|
||
|
|
max-reached ts-list cur-index conflicts)
|
||
|
|
;; get all timestamps from org buffers
|
||
|
|
(dolist (f files ts-list)
|
||
|
|
(with-current-buffer
|
||
|
|
(find-file-noselect f)
|
||
|
|
(goto-char (point-min))
|
||
|
|
(when (not (outline-on-heading-p)) (outline-next-heading))
|
||
|
|
(setq max-reached nil)
|
||
|
|
(while (not max-reached)
|
||
|
|
(let ((new-ts (nd/get-timestamps)))
|
||
|
|
(if new-ts (setq ts-list (cons new-ts ts-list))))
|
||
|
|
(unless (outline-next-heading) (setq max-reached t)))))
|
||
|
|
|
||
|
|
;; sort the timestamp list
|
||
|
|
;; TODO, need to make range-aware
|
||
|
|
(setq ts-list (sort ts-list (lambda (a b) (< (car a) (car b)))))
|
||
|
|
|
||
|
|
;; build a list of conflicts
|
||
|
|
(nd/build-conlist ts-list conflicts)))
|
||
|
|
|
||
|
|
(defun nd/get-conflict-header-text (conflict-marker)
|
||
|
|
"Return string with text properties representing the org header for
|
||
|
|
MARKER for use in the conflict agenda view."
|
||
|
|
(let* ((props (list
|
||
|
|
'face nil
|
||
|
|
'done-face 'org-agenda-done
|
||
|
|
'org-not-done-regexp org-not-done-regexp
|
||
|
|
'org-todo-regexp org-todo-regexp
|
||
|
|
'org-complex-heading-regexp org-complex-heading-regexp
|
||
|
|
'mouse-face 'highlight))
|
||
|
|
;; 'help-echo
|
||
|
|
;; (format "mouse-2 or RET jump to org file %s"
|
||
|
|
;; (abbreviate-file-name buffer-file-name))))
|
||
|
|
marker priority category level tags todo-state
|
||
|
|
ts-date ts-date-type ts-date-pair
|
||
|
|
txt beg end inherited-tags todo-state-end-pos)
|
||
|
|
|
||
|
|
(with-current-buffer (marker-buffer conflict-marker)
|
||
|
|
(save-excursion
|
||
|
|
(goto-char conflict-marker)
|
||
|
|
|
||
|
|
(setq marker (org-agenda-new-marker (point))
|
||
|
|
category (org-get-category)
|
||
|
|
ts-date-pair (org-agenda-entry-get-agenda-timestamp (point))
|
||
|
|
ts-date (car ts-date-pair)
|
||
|
|
ts-date-type (cdr ts-date-pair)
|
||
|
|
txt (org-get-heading t)
|
||
|
|
inherited-tags
|
||
|
|
(or (eq org-agenda-show-inherited-tags 'always)
|
||
|
|
(and (listp org-agenda-show-inherited-tags)
|
||
|
|
(memq 'todo org-agenda-show-inherited-tags))
|
||
|
|
(and (eq org-agenda-show-inherited-tags t)
|
||
|
|
(or (eq org-agenda-use-tag-inheritance t)
|
||
|
|
(memq 'todo org-agenda-use-tag-inheritance))))
|
||
|
|
tags (org-get-tags-at nil (not inherited-tags))
|
||
|
|
level (make-string (org-reduced-level (org-outline-level)) ? )
|
||
|
|
txt (org-agenda-format-item "" txt level category tags t)
|
||
|
|
priority (1+ (org-get-priority txt)))
|
||
|
|
|
||
|
|
(org-add-props txt props
|
||
|
|
'org-marker marker 'org-hd-marker marker
|
||
|
|
'priority priority
|
||
|
|
'level level
|
||
|
|
'ts-date ts-date
|
||
|
|
'type "timestamp")))))
|
||
|
|
|
||
|
|
(defun nd/org-conflicts (&optional arg)
|
||
|
|
(interactive "P")
|
||
|
|
|
||
|
|
(if org-agenda-overriding-arguments
|
||
|
|
(setq arg org-agenda-overriding-arguments))
|
||
|
|
|
||
|
|
(if (and (stringp arg) (not (string-match "\\S-" arg))) (setq arg nil))
|
||
|
|
|
||
|
|
(let* ((today (org-today))
|
||
|
|
(date (calendar-gregorian-from-absolute today))
|
||
|
|
(completion-ignore-case t)
|
||
|
|
(org-agenda-prefix-format '((agenda . " %-12:c %-5:e ")))
|
||
|
|
rtn rtnall files file pos)
|
||
|
|
|
||
|
|
(catch 'exit
|
||
|
|
(when org-agenda-sticky (setq org-agenda-buffer-name "*Org Conflicts*"))
|
||
|
|
|
||
|
|
(org-agenda-prepare)
|
||
|
|
;; (org-compile-prefix-format 'todo)
|
||
|
|
(org-compile-prefix-format 'agenda)
|
||
|
|
;; (org-set-sorting-strategy 'todo)
|
||
|
|
|
||
|
|
(setq org-agenda-redo-command '(nd/org-conflicts))
|
||
|
|
|
||
|
|
(insert "Conflicting Headings: \n")
|
||
|
|
(add-text-properties (point-min) (1- (point))
|
||
|
|
(list 'face 'org-agenda-structure
|
||
|
|
'short-heading "Conflicts"))
|
||
|
|
(org-agenda-mark-header-line (point-min))
|
||
|
|
|
||
|
|
(setq rtnall (nd/build-conflict-list))
|
||
|
|
(when rtnall
|
||
|
|
(mapc
|
||
|
|
(lambda (c)
|
||
|
|
(insert (concat "Between " (mapconcat (lambda (ts) (nth 3 ts)) c " and ") "\n"))
|
||
|
|
(insert (concat (mapconcat (lambda (ts) (nd/get-conflict-header-text (nth 2 ts))) c "\n") "\n"))
|
||
|
|
(insert "\n"))
|
||
|
|
rtnall))
|
||
|
|
|
||
|
|
;; clean up and finalize
|
||
|
|
(goto-char (point-min))
|
||
|
|
(or org-agenda-multi (org-agenda-fit-window-to-buffer))
|
||
|
|
(add-text-properties
|
||
|
|
(point-min) (point-max)
|
||
|
|
`(org-agenda-type agenda
|
||
|
|
org-last-args ,arg
|
||
|
|
org-redo-cmd ,org-agenda-redo-command
|
||
|
|
org-series-cmd ,org-cmd))
|
||
|
|
(org-agenda-finalize)
|
||
|
|
(setq buffer-read-only t))))
|
||
|
|
|
||
|
|
(setq org-agenda-files '("~/Org"
|
||
|
|
"~/Org/projects"
|
||
|
|
"~/Org/reference/peripheral.org"))
|
||
|
|
|
||
|
|
(setq org-agenda-sticky t)
|
||
|
|
|
||
|
|
(add-hook 'org-finalize-agenda-hook
|
||
|
|
(lambda () (setq org-agenda-tags-column (- 4 (window-width)))
|
||
|
|
(org-agenda-align-tags)))
|
||
|
|
|
||
|
|
(setq org-agenda-prefix-format
|
||
|
|
'((agenda . " %-12:c %-5:e %?-12t% s")
|
||
|
|
(todo . " %-12:c")
|
||
|
|
(tags . " %-12:c %-5:e ")
|
||
|
|
(search . " %-12:c")))
|
||
|
|
|
||
|
|
(setq org-agenda-dim-blocked-tasks nil
|
||
|
|
org-agenda-compact-blocks t
|
||
|
|
org-agenda-window-setup 'current-window
|
||
|
|
org-agenda-start-on-weekday 0
|
||
|
|
org-agenda-span 'day
|
||
|
|
org-agenda-current-time-string "### -- NOW -- ###")
|
||
|
|
|
||
|
|
(setq org-habit-graph-column 50)
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-non-context ()
|
||
|
|
"Filter all tasks with context tags."
|
||
|
|
(interactive)
|
||
|
|
(let* ((tags-list (mapcar #'car org-tag-alist))
|
||
|
|
(context-tags (append
|
||
|
|
(nd/filter-list-prefix "@" tags-list)
|
||
|
|
(nd/filter-list-prefix "#" tags-list))))
|
||
|
|
(setq org-agenda-tag-filter
|
||
|
|
(mapcar (lambda (tag) (concat "-" tag)) context-tags))
|
||
|
|
(org-agenda-filter-apply org-agenda-tag-filter 'tag)))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-non-peripheral ()
|
||
|
|
"Filter all tasks that don't have peripheral tags."
|
||
|
|
(interactive)
|
||
|
|
(let* ((peripheral-tags '("PERIPHERAL")))
|
||
|
|
(setq org-agenda-tag-filter
|
||
|
|
(mapcar (lambda (tag) (concat "-" tag)) peripheral-tags))
|
||
|
|
(org-agenda-filter-apply org-agenda-tag-filter 'tag)))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-non-effort ()
|
||
|
|
"Filter agenda by non-effort tasks."
|
||
|
|
(interactive)
|
||
|
|
(setq org-agenda-hasprop-filter '("-Effort"))
|
||
|
|
(org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-delegate ()
|
||
|
|
"Filter agenda by tasks with an external delegate."
|
||
|
|
(interactive)
|
||
|
|
(setq org-agenda-hasprop-filter '("+DELEGATE"))
|
||
|
|
(org-agenda-filter-apply org-agenda-hasprop-filter 'hasprop))
|
||
|
|
|
||
|
|
;; initialize new filters
|
||
|
|
(defvar org-agenda-hasprop-filter nil)
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-make-matcher-prop
|
||
|
|
(filter type &rest args)
|
||
|
|
"Return matching matcher form for FILTER and TYPE where TYPE is not
|
||
|
|
in the regular `org-agenda-filter-make-matcher' function. This is
|
||
|
|
intended to be uses as :before-until advice and will return nil if
|
||
|
|
the type is not valid (which is currently 'prop')"
|
||
|
|
(let (f f1)
|
||
|
|
;; has property
|
||
|
|
(cond
|
||
|
|
((eq type 'hasprop)
|
||
|
|
(dolist (x filter)
|
||
|
|
(push (nd/org-agenda-filter-make-matcher-hasprop-exp x) f))))
|
||
|
|
(if f (cons 'and (nreverse f)))))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-make-matcher-hasprop-exp (h)
|
||
|
|
"Returns form to test the presence or absence of properties H.
|
||
|
|
H is a string like +prop or -prop"
|
||
|
|
(let (op)
|
||
|
|
(let* ((op (string-to-char h))
|
||
|
|
(h (substring h 1))
|
||
|
|
(f `(save-excursion
|
||
|
|
(let ((m (org-get-at-bol 'org-hd-marker)))
|
||
|
|
(with-current-buffer
|
||
|
|
(marker-buffer m)
|
||
|
|
(goto-char m)
|
||
|
|
(org-entry-get nil ,h))))))
|
||
|
|
(if (eq op ?-) (list 'not f) f))))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-show-all-hasprop nil
|
||
|
|
(org-agenda-remove-filter 'hasprop))
|
||
|
|
|
||
|
|
(advice-add #'org-agenda-filter-make-matcher :before-until
|
||
|
|
#'nd/org-agenda-filter-make-matcher-prop)
|
||
|
|
|
||
|
|
(advice-add #'org-agenda-filter-remove-all :before
|
||
|
|
(lambda () (when org-agenda-hasprop-filter
|
||
|
|
(nd/org-agenda-filter-show-all-hasprop))))
|
||
|
|
|
||
|
|
(setq org-agenda-bulk-custom-functions
|
||
|
|
'((?D nd/org-agenda-delete-subtree)))
|
||
|
|
|
||
|
|
(setq holiday-bahai-holidays nil
|
||
|
|
holiday-hebrew-holidays nil
|
||
|
|
holiday-oriental-holidays nil
|
||
|
|
holiday-islamic-holidays nil)
|
||
|
|
|
||
|
|
(setq calendar-holidays (append holiday-general-holidays
|
||
|
|
holiday-christian-holidays))
|
||
|
|
|
||
|
|
(defconst nd/iter-future-time (* 7 24 60 60)
|
||
|
|
"Iterators must have at least one task greater into the future to be active.")
|
||
|
|
|
||
|
|
(defconst nd/iter-statuscodes '(:uninit :empty :active)
|
||
|
|
"Iterators can have these statuscodes.")
|
||
|
|
|
||
|
|
(defconst nd/peri-future-time nd/iter-future-time
|
||
|
|
"Periodicals must have at least one heading greater into the future to be fresh.")
|
||
|
|
|
||
|
|
(defconst nd/peri-statuscodes '(:uninit :stale :fresh))
|
||
|
|
|
||
|
|
(defconst nd/project-invalid-todostates
|
||
|
|
'("WAIT" "NEXT")
|
||
|
|
"Projects cannot have these todostates.")
|
||
|
|
|
||
|
|
(defvar nd/agenda-limit-project-toplevel t
|
||
|
|
"If true, filter projects by all levels or top level only.")
|
||
|
|
|
||
|
|
(defvar nd/agenda-hide-incubator-tags t
|
||
|
|
"If true, don't show incubator headings.")
|
||
|
|
|
||
|
|
(defconst nd/org-agenda-todo-sort-order
|
||
|
|
'("NEXT" "WAIT" "HOLD" "TODO")
|
||
|
|
"Defines the order in which todo keywords should be sorted.")
|
||
|
|
|
||
|
|
(defconst nd/project-skip-todostates
|
||
|
|
'("HOLD" "CANC")
|
||
|
|
"These keywords override all contents within their subtrees.
|
||
|
|
Currently used to tell skip functions when they can hop over
|
||
|
|
entire subtrees to save time and ignore tasks")
|
||
|
|
|
||
|
|
(defun nd/get-date-property (timestamp-property)
|
||
|
|
"Get TIMESTAMP-PROPERTY on current heading and convert to a number.
|
||
|
|
If it does not have a date, it will return nil."
|
||
|
|
(let ((ts (org-entry-get nil timestamp-property)))
|
||
|
|
(when ts (org-2ft ts))))
|
||
|
|
|
||
|
|
(defun nd/heading-compare-timestamp (timestamp-fun
|
||
|
|
&optional ref-time future)
|
||
|
|
"Returns the timestamp (from TIMESTAMP-FUM on the current heading)
|
||
|
|
if timestamp is futher back in time compared to a REF-TIME (default to
|
||
|
|
0 which is now, where negative is past and positive is future). If the
|
||
|
|
FUTURE flag is t, returns timestamp if it is in the future compared
|
||
|
|
to REF-TIME. Returns nil if no timestamp is found."
|
||
|
|
(let* ((timestamp (funcall timestamp-fun))
|
||
|
|
(ref-time (or ref-time 0)))
|
||
|
|
(if (and timestamp
|
||
|
|
(if future
|
||
|
|
(> (- timestamp (float-time)) ref-time)
|
||
|
|
(<= (- timestamp (float-time)) ref-time)))
|
||
|
|
timestamp)))
|
||
|
|
|
||
|
|
(defun nd/is-ia-timestamped-heading-p ()
|
||
|
|
"Get active timestamp of current heading."
|
||
|
|
(nd/get-date-property "TIMESTAMP_IA"))
|
||
|
|
|
||
|
|
(defun nd/is-timestamped-heading-p ()
|
||
|
|
"Get active timestamp of current heading."
|
||
|
|
(nd/get-date-property "TIMESTAMP"))
|
||
|
|
|
||
|
|
(defun nd/is-scheduled-heading-p ()
|
||
|
|
"Get scheduled timestamp of current heading."
|
||
|
|
(nd/get-date-property "SCHEDULED"))
|
||
|
|
|
||
|
|
(defun nd/is-deadlined-heading-p ()
|
||
|
|
"Get deadline timestamp of current heading."
|
||
|
|
(nd/get-date-property "DEADLINE"))
|
||
|
|
|
||
|
|
(defun nd/is-closed-heading-p ()
|
||
|
|
"Get closed timestamp of current heading."
|
||
|
|
(nd/get-date-property "CLOSED"))
|
||
|
|
|
||
|
|
(defun nd/is-stale-heading-p (&optional ts-prop)
|
||
|
|
"Return timestamp for TS-PROP (TIMESTAMP by default) if current heading is stale."
|
||
|
|
(nd/heading-compare-timestamp
|
||
|
|
(lambda () (let ((ts (org-entry-get nil (or ts-prop "TIMESTAMP"))))
|
||
|
|
(when (and ts (not (find ?+ ts))) (org-2ft ts))))))
|
||
|
|
|
||
|
|
(defun nd/is-fresh-heading-p ()
|
||
|
|
"Return timestamp if current heading is fresh."
|
||
|
|
(nd/heading-compare-timestamp 'nd/is-timestamped-heading-p nil t))
|
||
|
|
|
||
|
|
(defvar nd/archive-delay-days 30
|
||
|
|
"The number of days to wait before tasks show up in the archive view.")
|
||
|
|
|
||
|
|
(defun nd/is-archivable-heading-p ()
|
||
|
|
"Return timestamp if current heading is archivable."
|
||
|
|
(nd/heading-compare-timestamp
|
||
|
|
'nd/is-closed-heading-p
|
||
|
|
(- (* 60 60 24 nd/archive-delay-days))))
|
||
|
|
|
||
|
|
(defun nd/is-todoitem-p ()
|
||
|
|
"Return todo keyword if heading has one."
|
||
|
|
(let ((keyword (nth 2 (org-heading-components))))
|
||
|
|
(if (member keyword org-todo-keywords-1)
|
||
|
|
keyword)))
|
||
|
|
|
||
|
|
(defun nd/is-project-p ()
|
||
|
|
"Return todo keyword if heading has todoitem children."
|
||
|
|
(and (nd/heading-has-children 'nd/is-todoitem-p) (nd/is-todoitem-p)))
|
||
|
|
|
||
|
|
(defun nd/is-task-p ()
|
||
|
|
"Return todo keyword if heading has todoitem children."
|
||
|
|
(and (not (nd/heading-has-children 'nd/is-todoitem-p)) (nd/is-todoitem-p)))
|
||
|
|
|
||
|
|
(defun nd/is-project-task-p ()
|
||
|
|
"Return todo keyword if heading has todoitem parents."
|
||
|
|
(and (nd/heading-has-parent 'nd/is-todoitem-p) (nd/is-task-p)))
|
||
|
|
|
||
|
|
(defun nd/is-atomic-task-p ()
|
||
|
|
"Return todo keyword if heading has no todoitem parents or children."
|
||
|
|
(and (not (nd/heading-has-parent 'nd/is-todoitem-p)) (nd/is-task-p)))
|
||
|
|
|
||
|
|
(defun nd/is-periodical-heading-p ()
|
||
|
|
"Return t if heading is a periodical."
|
||
|
|
(equal "periodical" (org-entry-get nil "PARENT_TYPE" t)))
|
||
|
|
|
||
|
|
(defun nd/is-iterator-heading-p ()
|
||
|
|
"Return t if heading is an iterator."
|
||
|
|
(equal "iterator" (org-entry-get nil "PARENT_TYPE" t)))
|
||
|
|
|
||
|
|
(defun nd/heading-has-effort-p ()
|
||
|
|
"Return t if heading has an effort."
|
||
|
|
(org-entry-get nil "Effort"))
|
||
|
|
|
||
|
|
(defun nd/heading-has-context-p ()
|
||
|
|
"Return t if heading has a context."
|
||
|
|
(let ((tags (org-get-tags-at)))
|
||
|
|
(or (> (length (nd/filter-list-prefix "#" tags)) 0)
|
||
|
|
(> (length (nd/filter-list-prefix "@" tags)) 0))))
|
||
|
|
|
||
|
|
(defun nd/heading-has-tag-p (tag)
|
||
|
|
"Return t if heading has tag TAG."
|
||
|
|
(member tag (org-get-tags-at)))
|
||
|
|
|
||
|
|
(defun nd/heading-has-children (heading-test)
|
||
|
|
"Return t if heading has a child for whom HEADING-TEST is t."
|
||
|
|
(let ((subtree-end (save-excursion (org-end-of-subtree t)))
|
||
|
|
has-children previous-point)
|
||
|
|
(save-excursion
|
||
|
|
(setq previous-point (point))
|
||
|
|
(outline-next-heading)
|
||
|
|
(while (and (not has-children)
|
||
|
|
(< previous-point (point) subtree-end))
|
||
|
|
(when (funcall heading-test)
|
||
|
|
(setq has-children t))
|
||
|
|
(setq previous-point (point))
|
||
|
|
(org-forward-heading-same-level 1 t)))
|
||
|
|
has-children))
|
||
|
|
|
||
|
|
(defun nd/heading-has-parent (heading-test)
|
||
|
|
"Return t if heading has parent for whom HEADING-TEST is t."
|
||
|
|
(save-excursion (and (org-up-heading-safe) (funcall heading-test))))
|
||
|
|
|
||
|
|
(defun nd/has-discontinuous-parent ()
|
||
|
|
"Return t if heading has a non-todoitem parent which in turn has a todoitem parent."
|
||
|
|
(let ((has-todoitem-parent)
|
||
|
|
(has-non-todoitem-parent))
|
||
|
|
(save-excursion
|
||
|
|
(while (and (org-up-heading-safe)
|
||
|
|
(not has-todoitem-parent))
|
||
|
|
(if (nd/is-todoitem-p)
|
||
|
|
(setq has-todoitem-parent t)
|
||
|
|
(setq has-non-todoitem-parent t))))
|
||
|
|
(and has-todoitem-parent has-non-todoitem-parent)))
|
||
|
|
|
||
|
|
(defmacro nd/compare-statuscodes (op sc1 sc2 sc-list)
|
||
|
|
"Compare position of statuscodes SC1 and SC2 in SC-LIST using operator OP."
|
||
|
|
`(,op (position ,sc1 ,sc-list) (position ,sc2 ,sc-list)))
|
||
|
|
|
||
|
|
(defun nd/descend-into-project (allowed-statuscodes trans-tbl get-task-status)
|
||
|
|
"Loop through (sub)project and return overall statuscode.
|
||
|
|
|
||
|
|
The returned statuscode is chosen from list ALLOWED-STATUSCODES where
|
||
|
|
later entries in the list trump earlier ones.
|
||
|
|
|
||
|
|
When a subproject is encountered, this function will obtain the
|
||
|
|
statuscode of that project and use TRANS-TBL to translate the
|
||
|
|
subproject statuscode to one in ALLOWED-STATUSCODES (if not found an
|
||
|
|
error will be raised). TRANS-TBL is given as an alist of two-member
|
||
|
|
cons cells where the first member is the subproject statuscode and the
|
||
|
|
second is the index in ALLOWED-STATUSCODES to which the subproject
|
||
|
|
statuscode will be translated.
|
||
|
|
|
||
|
|
When a task is encountered, function GET-TASK-STATUS will be applied to
|
||
|
|
obtain a statuscode-equivalent of the status of the tasks."
|
||
|
|
;; define "breaker-status" as the last of the allowed-statuscodes
|
||
|
|
;; when this is encountered the loop is broken because we are done
|
||
|
|
;; (the last entry trumps all others)
|
||
|
|
(let ((project-status (first allowed-statuscodes))
|
||
|
|
(breaker-status (car (last allowed-statuscodes)))
|
||
|
|
(previous-point))
|
||
|
|
(save-excursion
|
||
|
|
(setq previous-point (point))
|
||
|
|
(outline-next-heading)
|
||
|
|
;; loop through subproject tasks until breaker-status found
|
||
|
|
(while (and (not (eq project-status breaker-status))
|
||
|
|
(> (point) previous-point))
|
||
|
|
(let ((keyword (nd/is-todoitem-p)))
|
||
|
|
(if keyword
|
||
|
|
(let ((new-status
|
||
|
|
;; if project then descend recursively
|
||
|
|
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||
|
|
(let ((n (nd/get-project-status)))
|
||
|
|
;; if project returns an allowed status
|
||
|
|
;; then use that
|
||
|
|
(or (and (member n allowed-statuscodes) n)
|
||
|
|
;; otherwise look up the value in the
|
||
|
|
;; translation table and return error
|
||
|
|
;; if not found
|
||
|
|
(nth (or (alist-get n trans-tbl)
|
||
|
|
(error (concat "status not found: " n)))
|
||
|
|
allowed-statuscodes)))
|
||
|
|
;; if tasks then use get-task-status to obtain status
|
||
|
|
(nth (funcall get-task-status keyword)
|
||
|
|
allowed-statuscodes))))
|
||
|
|
(if (nd/compare-statuscodes > new-status project-status allowed-statuscodes)
|
||
|
|
(setq project-status new-status)))))
|
||
|
|
(setq previous-point (point))
|
||
|
|
(org-forward-heading-same-level 1 t)))
|
||
|
|
project-status))
|
||
|
|
|
||
|
|
(defun nd/get-project-status ()
|
||
|
|
"Return project heading statuscode (assumes it is indeed a project)."
|
||
|
|
(let ((keyword (nd/is-todoitem-p)))
|
||
|
|
;;
|
||
|
|
;; these first three are easy because they only require
|
||
|
|
;; testing the project headline and nothing underneath
|
||
|
|
;;
|
||
|
|
(cond
|
||
|
|
;; it does not make sense for projects to be scheduled
|
||
|
|
((nd/is-scheduled-heading-p) :scheduled-project)
|
||
|
|
|
||
|
|
;; held projects do not care what is underneath them
|
||
|
|
((equal keyword "HOLD") :held)
|
||
|
|
|
||
|
|
;; projects with invalid todostates are nonsense
|
||
|
|
((member keyword nd/project-invalid-todostates)
|
||
|
|
:invalid-todostate)
|
||
|
|
|
||
|
|
;;
|
||
|
|
;; these require descending into the project subtasks
|
||
|
|
;;
|
||
|
|
|
||
|
|
;; canceled projects can either be archivable or complete
|
||
|
|
;; any errors or undone tasks are irrelevant
|
||
|
|
((equal keyword "CANC")
|
||
|
|
(nd/descend-into-project
|
||
|
|
'(:archivable :complete)
|
||
|
|
'((:stuck . 1)
|
||
|
|
(:held . 1)
|
||
|
|
(:waiting . 1)
|
||
|
|
(:active . 1)
|
||
|
|
(:scheduled-project . 1)
|
||
|
|
(:invalid-todostate . 1)
|
||
|
|
(:undone-complete . 1)
|
||
|
|
(:done-incomplete . 1))
|
||
|
|
(lambda (k)
|
||
|
|
(if (and (member k org-done-keywords)
|
||
|
|
(nd/is-archivable-heading-p)) 0 1))))
|
||
|
|
|
||
|
|
;; done projects are like canceled projects but can also be incomplete
|
||
|
|
((equal keyword "DONE")
|
||
|
|
(nd/descend-into-project
|
||
|
|
'(:archivable :complete :done-incomplete)
|
||
|
|
'((:stuck . 2)
|
||
|
|
(:held . 2)
|
||
|
|
(:waiting . 2)
|
||
|
|
(:active . 2)
|
||
|
|
(:scheduled-project . 2)
|
||
|
|
(:invalid-todostate . 2)
|
||
|
|
(:undone-complete . 2))
|
||
|
|
(lambda (k)
|
||
|
|
(if (member k org-done-keywords)
|
||
|
|
(if (nd/is-archivable-heading-p) 0 1)
|
||
|
|
2))))
|
||
|
|
|
||
|
|
;; project with TODO states could be basically any status
|
||
|
|
((equal keyword "TODO")
|
||
|
|
(nd/descend-into-project
|
||
|
|
'(:undone-complete :stuck :held :waiting :active)
|
||
|
|
'((:complete . 0)
|
||
|
|
(:archivable . 0)
|
||
|
|
(:scheduled-project . 1)
|
||
|
|
(:invalid-todostate . 1)
|
||
|
|
(:done-incomplete . 1))
|
||
|
|
(lambda (k)
|
||
|
|
(cond ((equal k "TODO") (if (nd/is-scheduled-heading-p) 4 1))
|
||
|
|
((equal k "HOLD") 2)
|
||
|
|
((equal k "WAIT") 3)
|
||
|
|
((equal k "NEXT") 4)
|
||
|
|
(t 0)))))
|
||
|
|
|
||
|
|
(t (error (concat "invalid keyword detected: " keyword))))))
|
||
|
|
|
||
|
|
(defun nd/get-iterator-status ()
|
||
|
|
"Get the status of an iterator where allowed statuscodes are in list
|
||
|
|
`nd/get-iter-statuscodes.' where latter codes in the list trump
|
||
|
|
earlier ones."
|
||
|
|
(let ((iter-status (first nd/iter-statuscodes))
|
||
|
|
(subtree-end (save-excursion (org-end-of-subtree t))))
|
||
|
|
(save-excursion
|
||
|
|
(setq previous-point (point))
|
||
|
|
(outline-next-heading)
|
||
|
|
(while (and (not (eq iter-status :active))
|
||
|
|
(< (point) subtree-end))
|
||
|
|
(let ((keyword (nd/is-atomic-task-p))
|
||
|
|
(new-status))
|
||
|
|
(if keyword
|
||
|
|
(progn
|
||
|
|
(setq new-status (if (nd/heading-compare-timestamp
|
||
|
|
(lambda ()
|
||
|
|
(or (nd/is-scheduled-heading-p)
|
||
|
|
(nd/is-deadlined-heading-p)))
|
||
|
|
nd/iter-future-time t)
|
||
|
|
:active
|
||
|
|
:empty))
|
||
|
|
(if (nd/compare-statuscodes > new-status iter-status nd/iter-statuscodes)
|
||
|
|
(setq iter-status new-status)))))
|
||
|
|
(outline-next-heading)))
|
||
|
|
iter-status))
|
||
|
|
|
||
|
|
(defun nd/get-periodical-status ()
|
||
|
|
"Get the status of a periodical where allowed statuscodes are in list
|
||
|
|
`nd/get-peri-statuscodes.' where latter codes in the list trump
|
||
|
|
earlier ones."
|
||
|
|
(let ((peri-status :uninit)
|
||
|
|
(subtree-end (save-excursion (org-end-of-subtree t))))
|
||
|
|
(save-excursion
|
||
|
|
(setq previous-point (point))
|
||
|
|
(outline-next-heading)
|
||
|
|
(while (and (not (eq peri-status :fresh))
|
||
|
|
(< (point) subtree-end))
|
||
|
|
(if (and (nd/is-periodical-heading-p)
|
||
|
|
(not (nd/heading-has-children 'nd/is-periodical-heading-p)))
|
||
|
|
(let ((new-status
|
||
|
|
(if (nd/heading-compare-timestamp
|
||
|
|
'nd/is-timestamped-heading-p
|
||
|
|
nd/iter-future-time t)
|
||
|
|
:fresh
|
||
|
|
:stale)))
|
||
|
|
(if (nd/compare-statuscodes > new-status peri-status nd/peri-statuscodes)
|
||
|
|
(setq peri-status new-status))))
|
||
|
|
(outline-next-heading)))
|
||
|
|
peri-status))
|
||
|
|
|
||
|
|
(defun nd/skip-heading ()
|
||
|
|
"Skip forward to next heading."
|
||
|
|
(save-excursion (or (outline-next-heading) (point-max))))
|
||
|
|
|
||
|
|
(defun nd/skip-subtree ()
|
||
|
|
"Skip forward to next subtree."
|
||
|
|
(save-excursion (or (org-end-of-subtree t) (point-max))))
|
||
|
|
|
||
|
|
|
||
|
|
(defmacro nd/skip-heading-without (heading-fun test-fun)
|
||
|
|
"Skip headings accoring to certain characteristics.
|
||
|
|
|
||
|
|
HEADING-FUN is a function that tests the heading and returns the
|
||
|
|
todoitem keyword on success. TEST-FUN is a function that further tests
|
||
|
|
the identity of the heading and may or may not use the keyword output
|
||
|
|
supplied by the HEADING-FUN. This function will not skip if
|
||
|
|
HEADING-FUN and TEST-FUN return true"
|
||
|
|
`(save-restriction
|
||
|
|
(widen)
|
||
|
|
(let ((keyword (,heading-fun)))
|
||
|
|
;; (message keyword)
|
||
|
|
(if (not (and keyword ,test-fun))
|
||
|
|
(nd/skip-heading)))))
|
||
|
|
|
||
|
|
(defun nd/skip-headings-with-tags (pos-tags-list &optional neg-tags-list)
|
||
|
|
"Skip headings that have tags in POS-TAGS-LIST and not in NEG-TAGS-LIST."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(let ((heading-tags (org-get-tags-at)))
|
||
|
|
(if (and (or (not pos-tags-list)
|
||
|
|
(intersection pos-tags-list heading-tags :test 'equal))
|
||
|
|
(not (intersection neg-tags-list heading-tags :test 'equal)))
|
||
|
|
(nd/skip-heading)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-stale-headings ()
|
||
|
|
"Skip headings that do not have stale timestamps and are not part of projects."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(let ((keyword (nd/is-todoitem-p)))
|
||
|
|
(if (not
|
||
|
|
(and (nd/is-stale-heading-p)
|
||
|
|
(not (member keyword org-done-keywords))
|
||
|
|
(not (nd/heading-has-children 'nd/is-todoitem-p))
|
||
|
|
(not (nd/heading-has-parent 'nd/is-todoitem-p))))
|
||
|
|
(nd/skip-heading)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-ia-timestamped-tasks ()
|
||
|
|
"Skip tasks that do not have an inactive timestamp."
|
||
|
|
(save-excursion
|
||
|
|
(widen)
|
||
|
|
(if (not (and (nd/is-task-p)
|
||
|
|
(not (nd/is-ia-timestamped-heading-p))))
|
||
|
|
(nd/skip-heading))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-atomic-tasks ()
|
||
|
|
"Skip headings that are not atomic tasks."
|
||
|
|
(save-excursion
|
||
|
|
(widen)
|
||
|
|
(if (not (nd/is-atomic-task-p))
|
||
|
|
(nd/skip-heading))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-closed-atomic-tasks ()
|
||
|
|
"Skip headings that are not complete (but not archivable) atomic tasks."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-atomic-task-p
|
||
|
|
(and (member keyword org-done-keywords)
|
||
|
|
(not (nd/is-archivable-heading-p)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-archivable-atomic-tasks ()
|
||
|
|
"Skip headings that are not archivable atomic tasks."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-atomic-task-p
|
||
|
|
(nd/is-archivable-heading-p)))
|
||
|
|
|
||
|
|
(defun nd/skip-non-iterator-parent-headings ()
|
||
|
|
"Skip headings that are not toplevel iterator headings."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(if (not (and (nd/is-iterator-heading-p)
|
||
|
|
(not (nd/heading-has-parent 'nd/is-iterator-heading-p))))
|
||
|
|
(nd/skip-heading))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-iterator-unscheduled ()
|
||
|
|
"Skip all headings that are not unscheduled iterator children."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-atomic-task-p
|
||
|
|
(not (or (nd/is-scheduled-heading-p)
|
||
|
|
(nd/is-deadlined-heading-p)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-periodical-parent-headings ()
|
||
|
|
"Skip headings that are not toplevel periodical headings."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(if (not (and (nd/is-periodical-heading-p)
|
||
|
|
(not (nd/heading-has-parent 'nd/is-periodical-heading-p))))
|
||
|
|
(nd/skip-heading))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-periodical-untimestamped ()
|
||
|
|
"Skip all headings that are not periodical children without a timestamp."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(if (not (and (nd/is-periodical-heading-p)
|
||
|
|
(not (nd/is-timestamped-heading-p))
|
||
|
|
(not (nd/heading-has-children 'nd/is-periodical-heading-p))))
|
||
|
|
(nd/skip-heading))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-project-tasks ()
|
||
|
|
"Skip headings that are not project tasks."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(let ((keyword (nd/is-todoitem-p)))
|
||
|
|
(if keyword
|
||
|
|
(if (nd/heading-has-children 'nd/is-todoitem-p)
|
||
|
|
(if (member keyword nd/project-skip-todostates)
|
||
|
|
(nd/skip-subtree)
|
||
|
|
(nd/skip-heading))
|
||
|
|
(if (not (nd/heading-has-parent 'nd/is-todoitem-p))
|
||
|
|
(nd/skip-heading)))
|
||
|
|
(nd/skip-heading)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-discontinuous-project-tasks ()
|
||
|
|
"Skip headings that are not discontinuous within projects."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-todoitem-p
|
||
|
|
(nd/has-discontinuous-parent)))
|
||
|
|
|
||
|
|
(defun nd/skip-non-done-unclosed-todoitems ()
|
||
|
|
"Skip headings that are not completed without a closed timestamp."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-todoitem-p
|
||
|
|
(and (member keyword org-done-keywords)
|
||
|
|
(not (nd/is-closed-heading-p)))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-undone-closed-todoitems ()
|
||
|
|
"Skip headings that are not incomplete with a closed timestamp."
|
||
|
|
(nd/skip-heading-without
|
||
|
|
nd/is-todoitem-p
|
||
|
|
(and (not (member keyword org-done-keywords))
|
||
|
|
(nd/is-closed-heading-p))))
|
||
|
|
|
||
|
|
(defun nd/skip-non-projects (&optional ignore-toplevel)
|
||
|
|
"Skip headings that are not projects (toplevel-only if IGNORE-TOPLEVEL is t)."
|
||
|
|
(save-restriction
|
||
|
|
(widen)
|
||
|
|
(let ((keyword (nd/is-project-p)))
|
||
|
|
(if keyword
|
||
|
|
(if (and nd/agenda-limit-project-toplevel
|
||
|
|
(not ignore-toplevel)
|
||
|
|
(nd/heading-has-parent 'nd/is-todoitem-p))
|
||
|
|
(nd/skip-subtree))
|
||
|
|
(nd/skip-heading)))))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-filter-status (filter status-fun a-line
|
||
|
|
&optional filter-only)
|
||
|
|
"Filter for `org-agenda-before-sorting-filter-function' intended for
|
||
|
|
agenda project views (eg makes the assumption that all entries are
|
||
|
|
from projects in the original org buffer) wherein this function will
|
||
|
|
filter project headings based on their statuscodes.
|
||
|
|
|
||
|
|
It works by going to the original org buffer and determining the
|
||
|
|
project status using STATUS-FUN, after which it will check if
|
||
|
|
status is in FILTER (a list of statuscodes). If true, the flag string
|
||
|
|
in the prefix is replaced with the status, and the status is set as a
|
||
|
|
text property for further sorting.
|
||
|
|
|
||
|
|
If option FILTER-ONLY is t, function only return the unmodified a-line
|
||
|
|
or nil to act as a filter (eg does not touch text properties)."
|
||
|
|
(let* ((m (get-text-property 1 'org-marker a-line))
|
||
|
|
(s (with-current-buffer (marker-buffer m)
|
||
|
|
(goto-char m)
|
||
|
|
(funcall status-fun))))
|
||
|
|
(if (member s filter)
|
||
|
|
(if filter-only
|
||
|
|
a-line
|
||
|
|
(org-add-props (replace-regexp-in-string
|
||
|
|
"xxxx" (symbol-name s) a-line)
|
||
|
|
nil 'project-status s)))))
|
||
|
|
|
||
|
|
(defun nd/org-agenda-sort-prop (prop order a b)
|
||
|
|
"Sort a block agenda view by text property PROP given a list ORDER
|
||
|
|
of said text properties in the desired order and lines A and B as
|
||
|
|
inputs. To be used with `org-agenda-cmp-user-defined'."
|
||
|
|
(let* ((ta (get-text-property 1 prop a))
|
||
|
|
(tb (get-text-property 1 prop b))
|
||
|
|
(pa (position ta order :test (if (stringp ta) #'equal)))
|
||
|
|
(pb (position tb order :test (if (stringp tb) #'equal))))
|
||
|
|
(cond ((or (null pa) (null pb)) nil)
|
||
|
|
((< pa pb) +1)
|
||
|
|
((> pa pb) -1))))
|
||
|
|
|
||
|
|
(defun nd/agenda-base-heading-cmd (match header skip-fun)
|
||
|
|
"Make a tags agenda view that matches tags in string MATCH with
|
||
|
|
header given as string HEADER and with skip function SKIP-FUN."
|
||
|
|
`(tags
|
||
|
|
,match
|
||
|
|
((org-agenda-overriding-header ,header)
|
||
|
|
(org-agenda-skip-function ,skip-fun)
|
||
|
|
(org-agenda-sorting-strategy '(category-keep)))))
|
||
|
|
|
||
|
|
(defun nd/agenda-base-task-cmd (match header skip-fun &optional sort)
|
||
|
|
"Make a tags-todo agenda view that matches tags in string MATCH with
|
||
|
|
header given as string HEADER and with skip function SKIP-FUN. Also
|
||
|
|
takes a sorting structure SORT which is passed to
|
||
|
|
`org-agenda-sorting-strategy'"
|
||
|
|
(or sort (setq sort ''(category-keep)))
|
||
|
|
`(tags-todo
|
||
|
|
,match
|
||
|
|
((org-agenda-overriding-header ,header)
|
||
|
|
(org-agenda-skip-function ,skip-fun)
|
||
|
|
(org-agenda-todo-ignore-with-date t)
|
||
|
|
(org-agenda-sorting-strategy ,sort))))
|
||
|
|
|
||
|
|
(defun nd/agenda-base-project-cmd (match header skip-fun kw-list status-fun
|
||
|
|
&optional todo status-px)
|
||
|
|
"Make a tags-todo agenda view that matches tags in string MATCH with
|
||
|
|
header given as string HEADER and with skip function SKIP-FUN. KW-LIST
|
||
|
|
is a list of keywords to be used in filtering and sorting (the order
|
||
|
|
in the list defines the sort order). STATUS-FUN is a function used to
|
||
|
|
get the statuscode of the current line in the agenda. Optional arg
|
||
|
|
TODO determines if this is a tags-todo (t) or tags (nil) block, and
|
||
|
|
STATUS-PX as t enables the statuscode to be formatted into the prefix
|
||
|
|
string."
|
||
|
|
`(,(if 'tags-todo 'tags)
|
||
|
|
,match
|
||
|
|
((org-agenda-overriding-header ,header)
|
||
|
|
(org-agenda-skip-function ,skip-fun)
|
||
|
|
(org-agenda-before-sorting-filter-function
|
||
|
|
(lambda (l) (nd/org-agenda-filter-status ,kw-list ,status-fun l)))
|
||
|
|
(org-agenda-cmp-user-defined
|
||
|
|
(lambda (a b) (nd/org-agenda-sort-prop 'project-status ,kw-list a b)))
|
||
|
|
(org-agenda-prefix-format '((tags . ,(if status-px
|
||
|
|
" %-12:c %(format \"xxxx: \")"
|
||
|
|
" %-12:c "))))
|
||
|
|
(org-agenda-sorting-strategy '(user-defined-down category-keep)))))
|
||
|
|
|
||
|
|
(defun nd/toggle-project-toplevel-display ()
|
||
|
|
"Toggle all project headings and toplevel only headings in project blocks."
|
||
|
|
(interactive)
|
||
|
|
(setq nd/agenda-limit-project-toplevel (not nd/agenda-limit-project-toplevel))
|
||
|
|
(when (equal major-mode 'org-agenda-mode)
|
||
|
|
(org-agenda-redo))
|
||
|
|
(message "Showing %s project view in agenda"
|
||
|
|
(if nd/agenda-limit-project-toplevel "toplevel" "complete")))
|
||
|
|
|
||
|
|
(defun nd/org-tags-view-advice (orig-fn &optional todo-only match)
|
||
|
|
"Advice to include done states in `org-tags-view' for tags-todo agenda types."
|
||
|
|
(nd/with-advice
|
||
|
|
((#'org-make-tags-matcher
|
||
|
|
:around (lambda (f m)
|
||
|
|
(let ((org--matcher-tags-todo-only nil))
|
||
|
|
(funcall f m)))))
|
||
|
|
(funcall orig-fn todo-only match)))
|
||
|
|
|
||
|
|
(advice-add #'org-tags-view :around #'nd/org-tags-view-advice)
|
||
|
|
|
||
|
|
(setq org-agenda-tags-todo-honor-ignore-options t)
|
||
|
|
|
||
|
|
(setq org-agenda-cmp-user-defined
|
||
|
|
'(lambda (a b)
|
||
|
|
(let ((pa (- (length (member
|
||
|
|
(get-text-property 1 'todo-state a)
|
||
|
|
nd/org-agenda-todo-sort-order))))
|
||
|
|
(pb (- (length (member
|
||
|
|
(get-text-property 1 'todo-state b)
|
||
|
|
nd/org-agenda-todo-sort-order)))))
|
||
|
|
(cond ((or (null pa) (null pb)) nil)
|
||
|
|
((> pa pb) +1)
|
||
|
|
((< pa pb) -1)))))
|
||
|
|
|
||
|
|
(let* ((actionable "-NA-REFILE-%inc")
|
||
|
|
(periodical "PARENT_TYPE=\"periodical\"")
|
||
|
|
(iterator "PARENT_TYPE=\"iterator\"")
|
||
|
|
(habit "STYLE=\"habit\"")
|
||
|
|
(task-match (concat actionable "-" periodical "-" habit "/!"))
|
||
|
|
(act-no-rep-match (concat actionable "-" periodical "-" iterator "-" habit "/!"))
|
||
|
|
(peri-match (concat actionable "+" periodical "-" iterator "-" habit))
|
||
|
|
(iter-match (concat actionable "-" periodical "+" iterator "-" habit "/!")))
|
||
|
|
|
||
|
|
(setq
|
||
|
|
org-agenda-custom-commands
|
||
|
|
`(("a"
|
||
|
|
"Calendar View"
|
||
|
|
((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags '("%inc" "REFILE")))
|
||
|
|
(org-agenda-include-diary t)))))
|
||
|
|
|
||
|
|
("t"
|
||
|
|
"Task View"
|
||
|
|
(,(nd/agenda-base-task-cmd act-no-rep-match
|
||
|
|
"Project Tasks"
|
||
|
|
''nd/skip-non-project-tasks
|
||
|
|
''(user-defined-up category-keep))
|
||
|
|
,(nd/agenda-base-task-cmd act-no-rep-match "Atomic Tasks" ''nd/skip-non-atomic-tasks)))
|
||
|
|
|
||
|
|
("p"
|
||
|
|
"Project View"
|
||
|
|
(,(nd/agenda-base-project-cmd
|
||
|
|
act-no-rep-match
|
||
|
|
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Projects")
|
||
|
|
''nd/skip-non-projects
|
||
|
|
''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete
|
||
|
|
:stuck :waiting :held :active)
|
||
|
|
''nd/get-project-status t t)))
|
||
|
|
|
||
|
|
("i"
|
||
|
|
"Incubator View"
|
||
|
|
((agenda "" ((org-agenda-skip-function '(nd/skip-headings-with-tags nil '("%inc")))
|
||
|
|
(org-agenda-span 7)
|
||
|
|
(org-agenda-time-grid nil)
|
||
|
|
(org-agenda-entry-types '(:deadline :timestamp :scheduled))))
|
||
|
|
,(nd/agenda-base-heading-cmd "-NA-REFILE+%inc"
|
||
|
|
"Stale Incubated Timestamps"
|
||
|
|
''nd/skip-non-stale-headings)
|
||
|
|
,(nd/agenda-base-task-cmd "-NA-REFILE+%inc/!"
|
||
|
|
"Incubated Tasks"
|
||
|
|
''nd/skip-non-atomic-tasks)
|
||
|
|
,(nd/agenda-base-project-cmd
|
||
|
|
"-NA-REFILE+%inc/!"
|
||
|
|
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Incubated Projects")
|
||
|
|
''nd/skip-non-projects
|
||
|
|
''(:scheduled-project :invalid-todostate :undone-complete :done-incomplete
|
||
|
|
:stuck :waiting :held :active)
|
||
|
|
''nd/get-project-status
|
||
|
|
t t)))
|
||
|
|
|
||
|
|
("P"
|
||
|
|
"Periodical View"
|
||
|
|
(,(nd/agenda-base-project-cmd
|
||
|
|
(concat actionable "-" iterator "+" periodical "-" habit)
|
||
|
|
"Periodical Status"
|
||
|
|
''nd/skip-non-periodical-parent-headings
|
||
|
|
'nd/peri-statuscodes ''nd/get-periodical-status nil t)
|
||
|
|
,(nd/agenda-base-heading-cmd "-NA-REFILE+PARENT_TYPE=\"periodical\""
|
||
|
|
"Untimestamped"
|
||
|
|
''nd/skip-non-periodical-untimestamped)))
|
||
|
|
|
||
|
|
("I"
|
||
|
|
"Iterator View"
|
||
|
|
(,(nd/agenda-base-project-cmd
|
||
|
|
"-NA-REFILE+PARENT_TYPE=\"iterator\""
|
||
|
|
"Iterator Status"
|
||
|
|
''nd/skip-non-iterator-parent-headings
|
||
|
|
'nd/iter-statuscodes ''nd/get-iterator-status nil t)
|
||
|
|
,(nd/agenda-base-task-cmd "-NA-REFILE+PARENT_TYPE=\"iterator\"/!"
|
||
|
|
"Unscheduled or Undeaded"
|
||
|
|
''nd/skip-non-iterator-unscheduled)))
|
||
|
|
|
||
|
|
("r" "Refile" ((tags "REFILE" ((org-agenda-overriding-header "Tasks to Refile"))
|
||
|
|
(org-tags-match-list-sublevels nil))))
|
||
|
|
|
||
|
|
("f" "Flagged" ((tags "%flag" ((org-agenda-overriding-header "Flagged Tasks")))))
|
||
|
|
|
||
|
|
("e"
|
||
|
|
"Critical Errors"
|
||
|
|
(,(nd/agenda-base-task-cmd task-match
|
||
|
|
"Discontinous Project"
|
||
|
|
''nd/skip-non-discontinuous-project-tasks)
|
||
|
|
,(nd/agenda-base-heading-cmd task-match
|
||
|
|
"Undone Closed"
|
||
|
|
''nd/skip-non-undone-closed-todoitems)
|
||
|
|
,(nd/agenda-base-heading-cmd (concat actionable "-" periodical)
|
||
|
|
"Done Unclosed"
|
||
|
|
''nd/skip-non-done-unclosed-todoitems)
|
||
|
|
,(nd/agenda-base-task-cmd (concat task-match)
|
||
|
|
"Missing Creation Timestamp"
|
||
|
|
''nd/skip-non-ia-timestamped-tasks)))
|
||
|
|
|
||
|
|
|
||
|
|
("A"
|
||
|
|
"Archivable Tasks and Projects"
|
||
|
|
((tags-todo ,(concat actionable "-" periodical "-" habit "/DONE|CANC")
|
||
|
|
((org-agenda-overriding-header "Archivable Atomic Tasks and Iterators")
|
||
|
|
(org-agenda-sorting-strategy '(category-keep))
|
||
|
|
(org-agenda-skip-function 'nd/skip-non-archivable-atomic-tasks)))
|
||
|
|
,(nd/agenda-base-heading-cmd (concat actionable "-" habit)
|
||
|
|
"Stale Tasks and Periodicals"
|
||
|
|
''nd/skip-non-stale-headings)
|
||
|
|
,(nd/agenda-base-project-cmd
|
||
|
|
(concat actionable "-" periodical "-" iterator "-" habit)
|
||
|
|
'(concat (and nd/agenda-limit-project-toplevel "Toplevel ") "Archivable Projects")
|
||
|
|
''nd/skip-non-projects ''(:archivable) ''nd/get-project-status))))))
|
||
|
|
|
||
|
|
(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)))))
|
||
|
|
|
||
|
|
(use-package magit
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
:delight auto-revert-mode
|
||
|
|
(setq magit-push-always-verify nil
|
||
|
|
git-commit-summary-max-length 50))
|
||
|
|
|
||
|
|
(setq dired-no-confirm '(move copy))
|
||
|
|
|
||
|
|
(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 &"))))
|
||
|
|
|
||
|
|
(setq dired-listing-switches "-Alh")
|
||
|
|
|
||
|
|
;; 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)
|
||
|
|
|
||
|
|
(use-package dired-du
|
||
|
|
:ensure t
|
||
|
|
:config
|
||
|
|
(setq dired-du-size-format t))
|
||
|
|
|
||
|
|
(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: ")))
|
||
|
|
|
||
|
|
(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")
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
;; 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)
|
||
|
|
|
||
|
|
(setq message-yank-prefix "")
|
||
|
|
(setq message-yank-cited-prefix "")
|
||
|
|
(setq message-yank-empty-prefix "")
|
||
|
|
|
||
|
|
(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)))))
|
||
|
|
|
||
|
|
(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")
|
||
|
|
|
||
|
|
(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)))))))
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(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"))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(add-hook 'mu4e-compose-mode-hook (lambda () (flyspell-mode 1)))
|
||
|
|
|
||
|
|
(load "auctex.el" nil t t)
|
||
|
|
(require 'tex-mik)
|
||
|
|
|
||
|
|
(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")))
|
||
|
|
|
||
|
|
;; remove ugly section size
|
||
|
|
(setq font-latex-fontify-sectioning 'color)
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(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"))
|
||
|
|
|
||
|
|
(use-package ebib
|
||
|
|
:ensure t)
|
||
|
|
|
||
|
|
(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"))
|
||
|
|
|
||
|
|
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
|
||
|
|
|
||
|
|
(use-package evil
|
||
|
|
:ensure t
|
||
|
|
:init
|
||
|
|
;; this is required to make evil collection work
|
||
|
|
(setq evil-want-integration nil)
|
||
|
|
:config
|
||
|
|
(evil-mode 1))
|
||
|
|
|
||
|
|
(setq sentence-end-double-space nil)
|
||
|
|
|
||
|
|
(add-to-list 'evil-motion-state-modes 'ess-help-mode)
|
||
|
|
(add-to-list 'evil-insert-state-modes 'inferior-ess-mode)
|
||
|
|
|
||
|
|
(use-package evil-surround
|
||
|
|
:ensure t
|
||
|
|
:after evil
|
||
|
|
:config
|
||
|
|
(global-evil-surround-mode 1))
|
||
|
|
|
||
|
|
(use-package evil-commentary
|
||
|
|
:ensure t
|
||
|
|
:after evil
|
||
|
|
:delight
|
||
|
|
:config
|
||
|
|
(evil-commentary-mode))
|
||
|
|
|
||
|
|
(use-package evil-replace-with-register
|
||
|
|
:ensure t
|
||
|
|
:after evil
|
||
|
|
:config
|
||
|
|
(evil-replace-with-register-install))
|
||
|
|
|
||
|
|
(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")))
|
||
|
|
|
||
|
|
(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))
|
||
|
|
|
||
|
|
(use-package evil-magit
|
||
|
|
:ensure t
|
||
|
|
:after (evil magit))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(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)))
|
||
|
|
|
||
|
|
(use-package evil-collection
|
||
|
|
:ensure t
|
||
|
|
:after evil
|
||
|
|
:init
|
||
|
|
(setq evil-collection-mode-list
|
||
|
|
'(company dired ediff flycheck helm minibuffer mu4e term which-key))
|
||
|
|
(setq evil-collection-setup-minibuffer t)
|
||
|
|
:config
|
||
|
|
(evil-collection-init))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(evil-define-key '(normal insert) helm-map
|
||
|
|
(kbd "<tab>") 'helm-execute-persistent-action
|
||
|
|
(kbd "C-<tab>") 'helm-select-action)
|
||
|
|
|
||
|
|
(evil-define-key 'insert term-raw-map
|
||
|
|
(kbd "<escape>") 'nd/term-send-raw-escape
|
||
|
|
(kbd "C-<escape>") 'evil-normal-state)
|
||
|
|
|
||
|
|
(add-hook 'org-mode-hook
|
||
|
|
(lambda ()
|
||
|
|
;; override default TODO timestamp creation to insert the creation date
|
||
|
|
(local-set-key (kbd "M-S-<return>") 'nd/org-insert-todo-heading-inactive-timestamp)
|
||
|
|
|
||
|
|
;; 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)))
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(define-key dired-mode-map (kbd "C-x g") 'magit)
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(define-key helm-command-prefix (kbd "f") 'helm-flyspell-correct)
|
||
|
|
(define-key helm-command-prefix (kbd "F") 'helm-multi-files)
|
||
|
|
|
||
|
|
(define-key outline-minor-mode-map (kbd "<tab>") 'outline-cycle)
|
||
|
|
|
||
|
|
(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)
|
||
|
|
|
||
|
|
(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)
|