From e4414d00317adc18979c25aa2e6ed06c7fadbaf4 Mon Sep 17 00:00:00 2001 From: ndwarshuis Date: Tue, 11 Dec 2018 19:33:59 -0500 Subject: [PATCH] moved conf files to seperate dir --- .gitignore | 4 +- conf/main.el | 2580 +++++++++++++++++++++++++++++++++++++ conf.org => conf/main.org | 19 +- init.el | 5 +- 4 files changed, 2601 insertions(+), 7 deletions(-) create mode 100644 conf/main.el rename conf.org => conf/main.org (99%) diff --git a/.gitignore b/.gitignore index 6a6dadd..4574b12 100644 --- a/.gitignore +++ b/.gitignore @@ -1,6 +1,6 @@ /* !.gitignore -!conf.org +!conf +!conf/* !README.org -conf.el !init.el diff --git a/conf/main.el b/conf/main.el new file mode 100644 index 0000000..edc5617 --- /dev/null +++ b/conf/main.el @@ -0,0 +1,2580 @@ +(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-") + + (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 b/conf/main.org similarity index 99% rename from conf.org rename to conf/main.org index 5bdadaf..1cd4788 100644 --- a/conf.org +++ b/conf/main.org @@ -363,14 +363,14 @@ filesystem and is a usb drive." (switch-to-buffer (other-buffer (current-buffer) 1))) (defun nd/config-reload () - "Reloads ~/.emacs.d/conf.org at runtime." + "Reloads main configuration file at runtime." (interactive) - (org-babel-load-file (expand-file-name "~/.emacs.d/conf.org"))) + (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.org")) + (find-file "~/.emacs.d/conf/main.org")) (defun nd/kill-current-buffer () "Kill the current buffer." @@ -1211,6 +1211,19 @@ Prevent accidental refiling under tasks with done keywords #+BEGIN_SRC emacs-lisp (setq org-refile-target-verify-function (lambda () (not (member (nth 2 (org-heading-components)) org-done-keywords)))) + +;; TODO this no work, although does work if var is global +;; redfining the targets works for now +(add-hook 'org-agenda-mode-hook + (lambda () + (when (equal (buffer-name) "*Org Agenda(A)*") + (setq-local org-refile-targets + '(("~/Org/journal/goals.org" :maxlevel . 9)))))) +;; (lambda () (when (org-entry-get nil "GOAL") t)))))) +;; (setq org-refile-targets '((nil :maxlevel . 9) +;; ("~/Org/reference/idea.org" :maxlevel . 9) +;; ("~/Org/journal/goals.org" :maxlevel . 9) +;; (org-agenda-files :maxlevel . 9)) #+END_SRC *** clocking Clocking is still new and experimental (I'm not a ninja like Bernt yet). I mostly use clocking now as a way to make clean breaks between tasks (eg to discourage "mixing" tasks which is a slippery multitasking slope). I bound =F4= to =org-clock-goto= as an easy way to find my current/last clocked task in any mode (see keybindigs). diff --git a/init.el b/init.el index a10166f..358df7b 100644 --- a/init.el +++ b/init.el @@ -7,7 +7,7 @@ (package-refresh-contents) (package-install 'use-package)) -(org-babel-load-file (expand-file-name "~/.emacs.d/conf.org")) +(org-babel-load-file (expand-file-name "~/.emacs.d/conf/main.org")) ;; (custom-set-variables ;; ;; custom-set-variables was added by Custom. @@ -21,10 +21,11 @@ ;; If there is more than one, they won't work right. '(package-selected-packages (quote - (company-math company-auctex dired-du helm-swoop org-ref helm-bibtex evil-replace-with-register evil-commentary flyspell-correct-helm helm-flyspell evil-surround markdown-mode polymode csv-mode company-ghc calf-org evil-magit magit yasnippet-snippets flycheck rainbow-delimiters-mode helm evil-collection haskell-mode fill-column-indicator gtklp delight browse-kill-ring evil-org-agenda evil-org evil calfw calfw-org yaml-mode which-key use-package systemd sudo-edit spaceline rainbow-mode rainbow-delimiters pkgbuild-mode pdf-tools org-bullets lua-mode ess elpy diff-hl beacon ace-window)))) + (intero ebib company-math company-auctex dired-du helm-swoop org-ref helm-bibtex evil-replace-with-register evil-commentary flyspell-correct-helm helm-flyspell evil-surround markdown-mode polymode csv-mode calf-org evil-magit magit yasnippet-snippets flycheck rainbow-delimiters-mode helm evil-collection haskell-mode fill-column-indicator gtklp delight browse-kill-ring evil-org-agenda evil-org evil calfw calfw-org yaml-mode which-key use-package systemd sudo-edit spaceline rainbow-mode rainbow-delimiters pkgbuild-mode pdf-tools org-bullets lua-mode ess elpy diff-hl beacon ace-window)))) (custom-set-faces ;; custom-set-faces was added by Custom. ;; If you edit it by hand, you could mess it up, so be careful. ;; Your init file should contain only one such instance. ;; If there is more than one, they won't work right. '(aw-leading-char-face ((t (:foreground "#292b2e" :background "#bc6ec5" :height 1.0 :box nil))))) +(put 'upcase-region 'disabled nil)