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