Skip to content

Instantly share code, notes, and snippets.

@holtzermann17
Last active November 29, 2022 16:05
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save holtzermann17/1c5b333a905b312f21da66db246159a6 to your computer and use it in GitHub Desktop.
Save holtzermann17/1c5b333a905b312f21da66db246159a6 to your computer and use it in GitHub Desktop.
Joe's Emacs Config
;;; .emacs --- -*- lexical-binding: t; -*-
;;; Commentary:
;; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;;
;; ___ ___ ___ ___ ___ ___ ___
;; / /\ /__/\ / /\ /__/\ / /\ / /\ / /\
;; / /:/ \ \:\ / /:/_ | |::\ / /::\ / /:/ / /:/_
;; / /:/ \__\:\ / /:/ /\ | |:|:\ / /:/\:\ / /:/ / /:/ /\
;; / /:/ ___ ___ / /::\ / /:/ /:/_ __|__|:|\:\ / /:/~/::\ / /:/ ___ / /:/ /::\
;; /__/:/ / /\ /__/\ /:/\:\ /__/:/ /:/ /\ /__/::::| \:\ /__/:/ /:/\:\ /__/:/ / /\ /__/:/ /:/\:\
;; \ \:\ / /:/ \ \:\/:/__\/ \ \:\/:/ /:/ \ \:\~~\__\/ \ \:\/:/__\/ \ \:\ / /:/ \ \:\/:/~/:/
;; \ \:\ /:/ \ \::/ \ \::/ /:/ \ \:\ \ \::/ \ \:\ /:/ \ \0.1 /:/
;; \ \:\/:/ \ \:\ \ \:\/:/ \ \:\ \ \:\ \ \:\/:/ \__\/ /:/
;; \ \::/ \ \:\ \ \::/ \ \:\ \ \:\ \ \::/ /__/:/
;; \__\/ \__\/ \__\/ \__\/ \__\/ \__\/ \__\/
;;
;; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;;
;; Chemacs - Emacs Profile Switcher v0.1
;;
;; INSTALLATION
;;
;; Install this file as ~/.emacs . Next time you start Emacs it will create a
;; ~/.emacs-profiles.el , with a single "default" profile
;;
;; (("default" . ((user-emacs-directory . "~/.emacs.d"))))
;;
;; Now you can start Emacs with `--with-profile' to pick a specific profile. A
;; more elaborate example:
;;
;; (("default" . ((user-emacs-directory . "~/emacs-profiles/plexus")))
;; ("spacemacs" . ((user-emacs-directory . "~/github/spacemacs")
;; (server-name . "spacemacs")
;; (custom-file . "~/.spacemacs.d/custom.el")
;; (env . (("SPACEMACSDIR" . "~/.spacemacs.d"))))))
;;
;; If you want to change the default profile used (so that, for example, a
;; GUI version of Emacs uses the profile you want), you can also put the name
;; of that profile in a ~/.emacs-profile file
;; ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;; this must be here to keep the package system happy, normally you do
;; `package-initialize' for real in your own init.el
;; (package-initialize)
;;; Code:
(defvar chemacs-profiles-path "~/.emacs-profiles.el")
(defvar chemacs-default-profile-path "~/.emacs-profile")
(when (not (file-exists-p chemacs-profiles-path))
(with-temp-file chemacs-profiles-path
(insert "((\"default\" . ((user-emacs-directory . \"~/.emacs.d\"))))")))
(defvar chemacs-emacs-profiles
(with-temp-buffer
(insert-file-contents chemacs-profiles-path)
(goto-char (point-min))
(read (current-buffer))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chemacs-detect-default-profile ()
(if (file-exists-p chemacs-default-profile-path)
(with-temp-buffer
(insert-file-contents chemacs-default-profile-path)
(goto-char (point-min))
;; (buffer-string))
(symbol-name (read (current-buffer)) ))
"default"))
(defun chemacs-load-straight ()
(defvar bootstrap-version)
(let ((bootstrap-file (expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory))
(bootstrap-version 5))
(unless (file-exists-p bootstrap-file)
(with-current-buffer
(url-retrieve-synchronously
"https://raw.githubusercontent.com/raxod502/straight.el/develop/install.el"
'silent 'inhibit-cookies)
(goto-char (point-max))
(eval-print-last-sexp)))
(load bootstrap-file nil 'nomessage)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun chemacs-get-emacs-profile (profile)
(cdr (assoc profile chemacs-emacs-profiles)))
(defun chemacs-emacs-profile-key (key &optional default)
(alist-get key (chemacs-get-emacs-profile chemacs-current-emacs-profile)
default))
(defun chemacs-load-profile (profile)
(when (not (chemacs-get-emacs-profile profile))
(error "No profile `%s' in %s" profile chemacs-profiles-path))
(setq chemacs-current-emacs-profile profile)
(let* ((emacs-directory (file-name-as-directory
(chemacs-emacs-profile-key 'user-emacs-directory)))
(init-file (expand-file-name "init.el" emacs-directory))
(custom-file- (chemacs-emacs-profile-key 'custom-file init-file))
(server-name- (chemacs-emacs-profile-key 'server-name)))
(setq user-emacs-directory emacs-directory)
;; Allow multiple profiles to each run their server
;; use `emacsclient -s profile_name' to connect
(when server-name-
(setq server-name server-name-))
;; Set environment variables, these are visible to init-file with getenv
(mapcar (lambda (env)
(setenv (car env) (cdr env)))
(chemacs-emacs-profile-key 'env))
(when (chemacs-emacs-profile-key 'straight-p)
(chemacs-load-straight))
;; Start the actual initialization
(load init-file)
;; Prevent customize from changing ~/.emacs (this file), but if init.el has
;; set a value for custom-file then don't touch it.
(when (not custom-file)
(setq custom-file custom-file-)
(unless (equal custom-file init-file)
(load custom-file)))))
(defun chemacs-check-command-line-args (args)
(if args
;; Handle either `--with-profile profilename' or
;; `--with-profile=profilename'
(let ((s (split-string (car args) "=")))
(cond ((equal (car args) "--with-profile")
;; This is just a no-op so Emacs knows --with-profile
;; is a valid option. If we wait for
;; command-switch-alist to be processed then
;; after-init-hook has already run.
(add-to-list 'command-switch-alist
'("--with-profile" .
(lambda (_) (pop command-line-args-left))))
;; Load the profile
(chemacs-load-profile (cadr args)))
;; Similar handling for `--with-profile=profilename'
((equal (car s) "--with-profile")
(add-to-list 'command-switch-alist `(,(car args) . (lambda (_))))
(chemacs-load-profile (mapconcat 'identity (cdr s) "=")))
(t (chemacs-check-command-line-args (cdr args)))))
;; If no profile given, load the "default" profile
(chemacs-load-profile (chemacs-detect-default-profile))))
;; Check for a --with-profile flag and honor it; otherwise load the
;; default profile.
(chemacs-check-command-line-args command-line-args)
(provide '.emacs)
;;; .emacs ends here
(put 'dired-find-alternate-file 'disabled nil)
(("default" . ((user-emacs-directory . "~/.emacs.d")))
("nw" . ((user-emacs-directory . "~/.emacs-nw.d")))
("doom" . ((user-emacs-directory . "~/doom-emacs"))))
;; ~/.emacs
;;; This is not the source code you’re looking for
(require 'org)
(setq org-use-property-inheritance t)
(defun frondeus/reload-init-org ()
"It reloads Emacs init config."
(interactive)
(load (concat user-emacs-directory "settings")))
(defvar frondeus/tangle-tag-sys-list '(("osx" . "darwin")
("cyngwin" . "cyngwin")
("linux" . "gnu/linux"))
"List of org mode tags and system-types.")
;; Highly based on http://www.holgerschurig.de/en/emacs-init-tangle/
(defun frondeus/tangle-init-org ()
"It tangles Emacs init config from settings.org to settings.el and then compiles to settings.elc."
(interactive)
(require 'org)
(message "*** Tangle init org")
(let* (
(body-list ())
(input-file (concat user-emacs-directory "settings.org"))
(output-file (concat user-emacs-directory "settings.el"))
(org-babel-default-header-args
(org-babel-merge-params org-babel-default-header-args
(list (cons :tangle output-file)))))
(message "Writing %s ..." output-file)
(save-restriction
(save-excursion
(org-babel-map-src-blocks input-file
(let* ((info (org-babel-get-src-block-info 'light))
(tfile (cdr (assq :tangle (nth 2 info))))
(tags)
(wrong-system nil))
(save-excursion
(catch 'exit
(setq tags (org-get-local-tags))))
(dolist (tag-sys frondeus/tangle-tag-sys-list)
(let* ((tag (car tag-sys)) (sys (cdr tag-sys)))
(unless (null (member tag tags))
(setq wrong-system t))
(when (string= sys system-type) (setq wrong-system nil))))
(when (and (not(string= "no" tfile))
(null wrong-system)
(null (member "notangle" tags))
(string= "emacs-lisp" lang))
(add-to-list 'body-list body)))))
(with-temp-file output-file
(insert (apply 'concat (reverse body-list))))
(message "Wrote %s ..." output-file))
(byte-compile-file output-file)))
(defun frondeus/reload-and-tangle-init-org()
"It reloads and tangles Emacs init config."
(when (string= buffer-file-name (file-truename (concat user-emacs-directory "settings.org")))
(frondeus/tangle-init-org)
(frondeus/reload-init-org)))
(add-hook 'after-save-hook 'frondeus/reload-and-tangle-init-org)
(frondeus/reload-init-org)
;;; Custom
(custom-set-variables
;; custom-set-variables 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.
'(ansi-color-names-vector
["black" "red3" "forest green" "yellow3" "light sky blue" "magenta3" "cyan3" "gray90"])
'(bmkp-auto-light-when-set 'all-in-buffer)
'(bmkp-last-as-first-bookmark-file "~/.emacs.d/bookmarks")
'(custom-safe-themes
'("8968241852eca6dc5ae9cf3b71a57558d1ec90f911eebaa7cb545362a6acbb36" "8b8fd1c936a20b5ca6afe22e081798ffb5e7498021515accadc20aab3517d402" "7661b762556018a44a29477b84757994d8386d6edee909409fabe0631952dad9" "4eb6fa2ee436e943b168a0cd8eab11afc0752aebb5d974bba2b2ddc8910fca8f" "aba75724c5d4d0ec0de949694bce5ce6416c132bb031d4e7ac1c4f2dbdd3d580" "94a94c957cf4a3f8db5f12a7b7e8f3e68f686d76ae8ed6b82bd09f6e6430a32c" "b89a4f5916c29a235d0600ad5a0849b1c50fab16c2c518e1d98f0412367e7f97" "fa11ec1dbeb7c54ab1a7e2798a9a0afa1fc45a7b90100774d7b47d521be6bfcf" "13a8eaddb003fd0d561096e11e1a91b029d3c9d64554f8e897b2513dbf14b277" "285d1bf306091644fb49993341e0ad8bafe57130d9981b680c1dbd974475c5c7" "830877f4aab227556548dc0a28bf395d0abe0e3a0ab95455731c9ea5ab5fe4e1" "2b9dc43b786e36f68a9fd4b36dd050509a0e32fe3b0a803310661edb7402b8b6" "585942bb24cab2d4b2f74977ac3ba6ddbd888e3776b9d2f993c5704aa8bb4739" "8e797edd9fa9afec181efbfeeebf96aeafbd11b69c4c85fa229bb5b9f7f7e66c" "8f97d5ec8a774485296e366fdde6ff5589cf9e319a584b845b6f7fa788c9fa9a" "a22f40b63f9bc0a69ebc8ba4fbc6b452a4e3f84b80590ba0a92b4ff599e53ad0" "1436d643b98844555d56c59c74004eb158dc85fc55d2e7205f8d9b8c860e177f" default))
'(debug-on-error nil)
'(disable-mouse-global-mode t nil (disable-mouse))
'(disable-mouse-mode-global-lighter " ✘🐁")
'(disable-mouse-mode-lighter " 🐁")
'(electric-quote-mode t)
'(elfeed-feeds
'("https://hypothes.is/stream.atom?user=paulallison" "https://hypothes.is/stream.atom?wildcard_uri=https://hyperreal.enterprises/*"))
'(emacsql-sqlite3-executable "/home/joe/bin/sqlite3")
'(ess-R-font-lock-keywords
'((ess-R-fl-keyword:keywords . t)
(ess-R-fl-keyword:constants . t)
(ess-R-fl-keyword:modifiers . t)
(ess-R-fl-keyword:fun-defs . t)
(ess-R-fl-keyword:assign-ops . t)
(ess-R-fl-keyword:assign-vars . t)
(ess-R-fl-keyword:%op% . t)
(ess-fl-keyword:fun-calls . t)
(ess-fl-keyword:numbers . t)
(ess-fl-keyword:operators . t)
(ess-fl-keyword:delimiters . t)
(ess-fl-keyword:= . t)
(ess-R-fl-keyword:F&T . t)))
'(evil-undo-system 'undo-redo)
'(frame-background-mode 'light)
'(global-command-log-mode t)
'(global-linum-mode nil)
'(gnus-select-method
'(nndiscourse "forum.openglobalmind.com"
(nndiscourse-scheme "https")))
'(helm-completion-style 'emacs)
'(line-number-mode nil)
'(lsp-clojure-custom-server-command '("clojure-lsp-server-clj-kondo") t nil "Customized with use-package lsp-mode")
'(mail-host-address "Proteus")
'(org-export-with-sub-superscripts nil)
'(org-habit-completed-glyph 8224)
'(org-habit-graph-column 80)
'(org-habit-show-all-today t)
'(org-habit-show-done-always-green t)
'(org-habit-today-glyph 94)
'(org-latex-compiler "xelatex")
'(org-latex-default-packages-alist
'(("AUTO" "inputenc" t
("pdflatex"))
("T1" "fontenc" t
("pdflatex"))
("" "graphicx" t nil)
("" "grffile" t nil)
("" "longtable" nil nil)
("" "wrapfig" nil nil)
("" "rotating" nil nil)
("normalem" "ulem" t nil)
("" "amsmath" t nil)
("" "textcomp" t nil)
("" "amssymb" t nil)
("" "capt-of" nil nil)
("" "hyperref" t nil)))
'(org-latex-footnote-separator "\\textsuperscript{,}")
'(org-roam-server-mode t)
'(package-selected-packages
'(lsp-grammarly grammarly org-roam scholar-import swift-mode latex-extra evil-goggles tommyh-theme yasnippet helm-lsp lsp-ui company-go lsp-treemacs org-roam-server emacsql-mysql emacsql-sqlite-module lsp-mode leuven-theme cyberpunk-2019-theme cyberpunk-theme php-mode org-wc helm-bibtex ox-reveal geiser-racket geiser hideshow-org mediawiki org-contrib gscholar-bibtex ebib caps-lock flycheck-clj-kondo rust-mode bookmark+ quelpa-use-package quelpa feebleline mini-modeline outline-magic memory-usage i3wm interaction-log gh zotxt ts-comint tide ob-typescript org-journal disable-mouse ripgrep ag citeproc-org helm-org hercules org-super-agenda lispy which-key speed-type ess-view-data ess font-lock-studio hide-mode-line exwm nz-holidays brazilian-holidays csv-mode org-randomnote overseer slime github-issues helm-mu toc-org helm-rg interleave nov vterm-toggle vterm modus-vivendi-theme modus-operandi-theme org-fragtog maxima auctex cdlatex smart-cursor-color beacon zpresent nndiscourse rbenv json-rpc anaphora poly-org command-log-mode docker-tramp emojify org-ref org-noter org-bullets magit eros writeroom-mode org-tree-slide helm-ag-r bash-completion ac-cider ac-capf elcord ox-hugo pdf-tools org-scrum god-mode ghost-blog dash with-editor transient rainbow-mode popup parseedn parsebib log4e helm-core dash-functional company clomacs clojure-mode bibtex-completion alert auto-package-update ink-mode racket-mode ttl-mode julia-repl julia-mode org-caldav oauth2 elfeed company-org-roam smooth-scrolling olivetti fountain-mode haml-mode epresent highlight-parentheses rainbow-delimiters bug-hunter gruvbox-theme queue ejc-sql helm-cider inf-clojure hlinum emacsql emacsql-psql helm-ag floobits org-preview-html xterm-color pcomplete-extension pcmpl-args use-package git-commit markdown-mode yaml-mode helm-projectile projectile org-alert org-gnome yafolding dockerfile-mode helm clojure-mode-extra-font-locking cider))
'(pdf-view-display-size 'fit-width)
'(safe-local-variable-values
'((org-tree-slide-skip-outline-level . 4)
(TeX-engine . xelatex)
(magit-todos-exclude-globs "*.org")
(eval setq org-latex-default-packages-alist
(cons
'("mathletters" "ucs" nil)
org-latex-default-packages-alist))
(org-latex-inputenc-alist
("utf8" . "utf8x"))
(cider-cljs-repl-types
(om "(do (figwheel/cljs-repl \"shopping\"))"))
(cider-cljs-repl-types
(edge "(do (require 'dev-extras) ((resolve 'dev-extras/cljs-repl)))"))
(cider-repl-init-code "(dev)")
(cider-ns-refresh-after-fn . "dev-extras/resume")
(cider-ns-refresh-before-fn . "dev-extras/suspend")
(cider-ns-refresh-after-fn . "integrant.repl/resume")
(cider-ns-refresh-before-fn . "integrant.repl/suspend")))
'(sow-mode t)
'(warning-suppress-log-types '((:warning) (comp) (emacs)))
'(warning-suppress-types '((comp) (emacs)))
'(xterm-color-debug t)
'(xterm-color-names
["#192033" "#A93F43" "#59963A" "#BE8A2D" "#4068A3" "#7F60A6" "#4E9B9B" "#7E8A90"])
'(xterm-color-names-bright
["#fb4934" "#b8bb26" "#fabd2f" "#83a598" "#d3869b" "#8ec07c" "#fe8019" "#a89984"]))
(put 'upcase-region 'disabled nil)
(put 'narrow-to-region 'disabled nil)
(put 'list-timers 'disabled nil)
(put 'downcase-region 'disabled nil)
(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.
'(bmkp-light-autonamed ((t (:background "dark blue"))))
'(bmkp-light-non-autonamed ((t (:background "midnight blue"))))
'(bmkp-local-file-without-region ((t (:foreground "lawn green"))))
'(bold ((t (:foreground "white" :weight bold))))
'(bookmark-face ((t (:background "dark blue" :foreground "White"))))
'(cider-debug-code-overlay-face ((t (:underline t))))
'(cider-result-overlay-face ((t (:box (:line-width (1 . -1) :color "yellow")))))
'(company-tooltip ((t (:foreground "black"))))
'(cursor ((t (:background "#21BDFF" :foreground "#dc8cc3" :box (:line-width (2 . 2) :color "#21BDFF" :style released-button)))))
'(custom-group-tag ((t (:inherit variable-pitch :foreground "deep sky blue" :weight bold :height 1.2))))
'(custom-variable-tag ((t (:foreground "deep sky blue" :weight bold))))
'(diff-added ((t (:inherit diff-changed :extend t :background "gray5"))))
'(diff-header ((t (:extend t :background "grey06"))))
'(diff-refine-added ((t (:inherit diff-refine-changed :background "dark green"))))
'(diff-refine-changed ((t (:background "dark green"))))
'(diff-removed ((t (:inherit diff-changed :extend t :background "dark red"))))
'(elfeed-search-title-face ((t nil)))
'(eros-result-overlay-face ((t (:box (:line-width (1 . -1) :color "yellow")))))
'(ess-assignment-face ((t (:foreground "yellow1" :weight bold))))
'(ess-paren-face ((t (:foreground "dodger blue"))))
'(font-lock-comment-delimiter-face ((t (:foreground "gainsboro" :slant oblique))))
'(font-lock-comment-face ((t (:foreground "dim gray" :slant italic))))
'(font-lock-doc-face ((t (:foreground "dark turquoise" :slant italic))))
'(fringe ((t (:background "#101010" :foreground "gray50"))))
'(helm-mu-contacts-name-face ((t (:foreground "dark violet"))))
'(isearch-fail ((t (:background "RosyBrown1" :foreground "royal blue"))))
'(link ((t (:foreground "yellow" :underline t :slant italic :weight bold :foundry "DAMA" :family "Ubuntu"))))
'(lsp-ui-doc-background ((t (:background "black"))))
'(lsp-ui-peek-highlight ((t (:background "dark green" :box (:line-width (1 . -1) :color "red")))))
'(lsp-ui-peek-list ((t nil)))
'(lsp-ui-peek-peek ((t nil)))
'(magit-section-highlight ((t (:inherit nil :extend nil :background "grey50"))))
'(mini-modeline-mode-line ((t (:background "#55ced1" :box (:line-width (2 . 2) :color "grey75" :style released-button) :height 0.8))))
'(minibuffer-prompt ((t (:height 1.0 :background "#2f2f2f" :foreground "#cc9393" :weight bold :foundry "DAMA" :family "Ubuntu Condensed"))))
'(mode-line ((t (:background "#303030" :box (:line-width (2 . 2) :color "#101010") :height 1.0 :width normal :foundry "DAMA" :family "Ubuntu Condensed"))))
'(om/highlighter ((t (:background "dim gray" :underline "#aecf90"))))
'(org-agenda-structure ((t (:foreground "turquoise"))))
'(org-block ((t (:background "black"))))
'(org-block-begin-line ((t (:inherit default :extend t :background "SkyBlue4" :underline "#A7A6AA" :slant italic :height 0.5 :foundry "DAMA" :family "Ubuntu Mono"))))
'(org-block-end-line ((t (:inherit org-block-begin-line :extend t :overline "#A7A6AA"))))
'(org-column ((t (:strike-through nil :underline nil :slant normal :weight normal))))
'(org-column-title ((t (:background "dark blue" :underline t :weight bold))))
'(org-document-info ((t (:foreground "DarkGoldenrod1"))))
'(org-document-title ((t (:inherit default :foreground "#dcdccc" :underline nil :slant normal :weight bold :height 1.5 :width normal :foundry "DAMA" :family "Ubuntu Thin"))))
'(org-drawer ((t (:foreground "green"))))
'(org-habit-alert-face ((t (:background "orange red"))))
'(org-habit-alert-future-face ((t (:background "dark orange"))))
'(org-habit-clear-future-face ((t nil)))
'(org-habit-overdue-future-face ((t (:background "light gray"))))
'(org-habit-ready-face ((t (:background "dark green"))))
'(org-level-1 ((t (:extend nil :foreground "dark turquoise"))))
'(org-level-2 ((t (:extend nil :foreground "#D2042D"))))
'(org-level-3 ((t (:extend nil :foreground "#fc5a8d"))))
'(org-level-4 ((t (:extend nil :foreground "dark orange"))))
'(org-level-5 ((t (:extend nil :foreground "#C7372F"))))
'(org-level-6 ((t (:extend nil :foreground "medium spring green"))))
'(org-level-7 ((t (:extend nil :foreground "white"))))
'(org-level-8 ((t (:extend nil :foreground "yellow"))))
'(org-level-9 ((t (:extend nil :foreground "light gray"))))
'(org-link-internal ((t (:foreground "white smoke" :underline t :foundry "DAMA" :family "Ubuntu Condensed"))))
'(org-meta-line ((t (:inherit font-lock-comment-face :foreground "aquamarine" :slant italic :height 0.8 :foundry "DAMA" :family "Ubuntu Mono"))))
'(org-priority ((t nil)))
'(org-quote ((t (:foreground "dim gray" :slant italic :height 1.1))))
'(org-special-keyword ((t (:inherit font-lock-function-name-face))))
'(org-table ((t (:background "SlateBlue4" :foreground "chartreuse"))))
'(org-tree-slide-header-overlay-face ((t (:background "#0d0e14" :foreground "#dcdccc" :inverse-video nil :weight bold))))
'(popup-face ((t (:inherit default :background "gray26" :foreground "white smoke"))))
'(popup-scroll-bar-background-face ((t nil)))
'(shadow ((t (:foreground "green yellow"))))
'(shr-link ((t (:inherit link))))
'(variable-pitch ((t (:foundry "DAMA" :family "Ubuntu Thin"))))
'(visible-mark-active ((t (:underline (:color "YellowGreen" :style wave)))))
'(visible-mark-face1 ((t (:underline (:color "green" :style wave)))))
'(visible-mark-face2 ((t (:underline (:color foreground-color :style wave)))))
'(visible-mark-forward-face1 ((t (:underline (:color foreground-color :style wave)))))
'(whitespace-line ((t (:background "gray20"))))
'(whitespace-tab ((t (:background "beige" :foreground "red"))))
'(widget-field ((t (:extend t :background "thistle3" :foreground "gray9"))))
'(widget-single-line-field ((t nil))))

Joe’s Emacs Configuration

#

Load locations, debugging

(setq stack-trace-on-error t)
(add-to-list 'load-path "~/.emacs.d/lisp/")
(add-to-list 'load-path "~/org-mode/org/contrib/lisp/")
(add-to-list 'load-path "~/org-mode/repos/org/lisp/")
(add-to-list 'custom-theme-load-path "~/.emacs.d/lisp/")

Hello Emacs

;;; Hello Emacs
(message "Start load")
(setq debug-on-error t)
(setq eval-expression-print-level 100
      eval-expression-print-length 100)

(when (>= emacs-major-version 24)
  (require 'package)
  (add-to-list 'package-archives '("melpa" .  "https://melpa.org/packages/") t)
  (package-initialize)
  )

;; Find this file (suggested by Alex)
(defun find-user-file ()
  (interactive)
  (find-file "/home/joe/.emacs.d/settings.org"))

(global-set-key (kbd "C-c f") #'find-user-file)

Straight

(defvar bootstrap-version)
(let ((bootstrap-file
       (expand-file-name "straight/repos/straight.el/bootstrap.el" user-emacs-directory))
      (bootstrap-version 6))
  (unless (file-exists-p bootstrap-file)
    (with-current-buffer
        (url-retrieve-synchronously
         "https://raw.githubusercontent.com/radian-software/straight.el/develop/install.el"
         'silent 'inhibit-cookies)
      (goto-char (point-max))
      (eval-print-last-sexp)))
  (load bootstrap-file nil 'nomessage))

(straight-use-package 'use-package)

Yasnippet

(require 'yasnippet)
(yas-global-mode 1)

Quelpa packages: bookmark+

(require 'quelpa)
(require 'quelpa-use-package)
(use-package bookmark+
                 :quelpa (bookmark+ :fetcher wiki
                                    :files
                                    ("bookmark+.el"
                                     "bookmark+-mac.el"
                                     "bookmark+-bmu.el"
                                     "bookmark+-1.el"
                                     "bookmark+-key.el"
                                     "bookmark+-lit.el"
                                     "bookmark+-doc.el"
                                     "bookmark+-chg.el"))
                 :defer 2)
(require 'bookmark+)
(require 'bookmark+-lit)

Server

(server-start)

Desktop

This is super fun for watching your life flash between your eyes when you reload Emacs, but it does seem slighty impractical to do so. Turning off for now.

; (desktop-save-mode 1)

Environment variables

;;; Environment variables
(setenv "PATH" "/home/joe/graalvm/bin/:/usr/local/texlive/2019/bin/x86_64-linux:/home/joe/bin:/usr/local/sbin:/usr/local/bin:/usr/sbin:/usr/bin:/sbin:/bin:/usr/games:/usr/local/games")

(setenv "PATH-TO-EXP2EXP" "~/exp2exp.github.io/src/")

Tweak built in Emacs settings

; copy files between directories in a sensible way
(setq dired-dwim-target t)

; turn on word-wrap along with visual-line-mode when in textual modes
(add-hook 'visual-line-mode-hook
          (lambda () (when (member major-mode '(text-mode
                                                org-mode))
                       (setq-local word-wrap t))))

Convenience: timestamps

(defun now ()
  "Insert string for the current time formatted like '2:34 PM'."
  (interactive)
  (insert (format-time-string "%D %-I:%M %p")))
;; 04/29/21 3:08 pm

(defun today ()
  "Insert string for today's date nicely formatted in American style,
e.g. Sunday, September 17, 2000."
  (interactive)
  (insert (format-time-string "<%Y-%m-%d %a %e>")))
;; Thu, April 29, 2021
;; Thursday, April 29, 2021
;; <2021-04-29 Thu, April 29>

(defun date-string ()
  (interactive)
  (format-time-string  "<%Y-%m-%d %a %-H:%M>" nil t))

(defun date ()
  (interactive)
  (insert (date-string)))

(defun date-string ()
  (interactive)
  (format-time-string  "<%Y-%m-%d %a %-H:%M>" nil t))

(defun now-string ()
  (interactive)
  (format-time-string  "%Y-%m-%d %-H:%M|Z" nil t))

Visual config

;;; Visual config
(global-font-lock-mode 1)
(transient-mark-mode t)
(setq-default indent-tabs-mode nil)

(tool-bar-mode -1)
(menu-bar-mode -1)
(scroll-bar-mode -1)
(horizontal-scroll-bar-mode -1)
(blink-cursor-mode -1)
;(setq cursor-type '(hbar . 1))
(show-paren-mode 1)
(when window-system
  (normal-erase-is-backspace-mode 1))

; (normal-erase-is-backspace-mode 0)

(setq visible-bell t)
(setq blink-matching-paren t)
(setq select-enable-clipboard t)
(setq select-enable-primary t)
(setq select-active-regions 'only)
(mouse-wheel-mode -1)

(fringe-mode '(30 . 14))
(setq visual-line-fringe-indicators '(left-curly-arrow nil))

(define-fringe-bitmap 'right-curly-arrow
  [#b00000000
   #b00000000
   #b00000000
   #b00000000
   #b01110000
   #b00010000
   #b00010000
   #b00000000])
(define-fringe-bitmap 'left-curly-arrow
  [#b00001100
   #b00001100
   #b00000000
   #b00001100
   #b00001100
   #b00000000
   #b00001100
   #b00001100])
; (setq visual-line-fringe-indicators '(nil nil))

;; feebleline looks better than mini-modeline
(use-package    feebleline
  :ensure       t
  :config       (setq feebleline-msg-functions
                      '((now-string :post " ")
                        ;(feebleline-line-number         :post "" :fmt "%5s")
                        ;(feebleline-column-number       :pre ":" :fmt "%-2s")
                        (feebleline-file-directory      :face feebleline-dir-face :post "")
                        (feebleline-file-or-buffer-name :face font-lock-keyword-face :post "")
                        (feebleline-file-modified-star  :face font-lock-warning-face :post "")
;; The following line is problematic, I think!
;                        (feebleline-git-branch          :face feebleline-git-face :pre " : ")
                        (feebleline-project-name        :align right)))
                (feebleline-mode +1))

;; (setq-default mode-line-format '("%e"
;;                                  mode-line-front-space
;;                                  mode-line-mule-info
;;                                  mode-line-client
;;                                  mode-line-modified
;;                                  mode-line-remote
;;                                  mode-line-frame-identification
;;                                  mode-line-buffer-identification
;;                                  "   "
;;                                  mode-line-position
;;                                  (:eval (concat "   ⚑ "
;;                                                 (propertize (number-to-string (point))
;;                                                             'face '(:foreground "red" :weight bold)))) 
;;                                  (vc-mode vc-mode) "  "
;;                                  mode-line-modes
;;                                  mode-line-misc-info
;;                                  mode-line-end-spaces))

(display-time-mode 1)

(defgroup joe-custom nil
  "Settings for Joe’s elisp."
  :tag "Joe Custom"
  :group 'customize)

(defface egoge-display-time '((((type x w32 mac))
                               ;; #060525 is the background colour of my default face.
                               (:foreground "DarkTurquoise" :inherit bold))
                              (((type tty))
                               (:foreground "blue")))
  "Face used to display the time in the mode line."
  :group 'joe-custom)

 ;; This causes the current time in the mode line to be displayed in
 ;; `egoge-display-time-face' to make it stand out visually
 (setq-default display-time-string-forms
               '((propertize (concat "  " 24-hours ":" minutes " ")
                             'face 'egoge-display-time)))

(add-hook 'post-command-hook #'force-mode-line-update nil)
force-mode-line-updateglobal-font-lock-mode-check-buffersglobal-eldoc-mode-check-buffers

Epub

(defun nov-render-buffer ()
  (shr-render-buffer (current-buffer)))

(setq nov-render-html-function #'nov-render-buffer)

Fonts

;;; Fonts
(add-to-list 'default-frame-alist '(font . "Ubuntu Mono-18"))
(set-face-attribute 'default nil :font "Ubuntu Mono" :height 180)
(set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 180 :slant 'italic)
(set-frame-font "Ubuntu Mono" nil t)

(defun actual-god ()
(interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 600)
  (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 600 :slant 'italic))

(defun insane ()
(interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 300)
  (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 300 :slant 'italic))

(defun bigger ()
  (interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 250)
  (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 250 :slant 'italic))

(defun big ()
  (interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 220)
  (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 220 :slant 'italic))

(defun medium ()
  (interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 180)
    (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 180 :slant 'italic))

(defun small ()
  (interactive)
  (set-face-attribute 'default nil :font "Ubuntu Mono:antialias=1" :height 120)
  (set-face-attribute 'fixed-pitch nil :font "Ubuntu Mono:antialias=1" :height 120 :slant 'italic))

Printing

(setq ps-print-header nil
      ps-print-footer nil
      ps-header-lines 0
      ps-show-n-of-n nil
      ps-font-family 'Helvetica
      ps-font-size '(12 . 12)
      ps-paper-type 'letter)

(setq ps-multibyte-buffer 'bdf-font)
(setq bdf-directory-list '("/usr/share/emacs/fonts/bdf/"))

(require 'ps-print)

(defun harden-newlines ()
  (interactive)
  "Make all the newlines in the buffer hard."
  (save-excursion
    (goto-char (point-min))
    (while (search-forward "\n" nil t)
      (backward-char)
      (put-text-property (point) (1+ (point)) 'hard t)
      (forward-char))))

(defun spool-buffer-given-name (name)
  (ps-spool-buffer))

(defun print-to-pdf (pdf-file-name)
  "Print the current file to the given file."
  (interactive (list (read-file-name "Write PDF file: " "~/" nil ".pdf")))
  (when (or (not (file-exists-p pdf-file-name))
            (yes-or-no-p (format "%s  File already exists.  Do you want to overwrite it?" pdf-file-name)))
    (let (
        (ps-file-name (concat (file-name-sans-extension pdf-file-name) ".ps"))
        (wbuf (generate-new-buffer "*Wrapped*"))
        (sbuf (current-buffer)))
    (jit-lock-fontify-now)
    (save-current-buffer
    (set-buffer wbuf)
    (insert-buffer sbuf)
    (setq fill-column 63)
;    (require 'longlines)
;    (longlines-mode t)
    (harden-newlines)
    (message (buffer-name sbuf))
    (spool-buffer-given-name (buffer-name sbuf))
    (kill-buffer wbuf)
    (switch-to-buffer "*PostScript*")
    (write-file ps-file-name)
    (kill-buffer (current-buffer)))
    (call-process "/usr/bin/ps2pdf" nil nil nil ps-file-name pdf-file-name)
    (delete-file ps-file-name)
    (message "PDF saved to %s" pdf-file-name))))

Theme

(when (require 'dream-theme nil 'noerror)
  (load-theme 'dream t nil))

An alternative for projectors:

(require 'cyberpunk-theme nil 'noerror)

Manage the buffer’s title

;;; Manage the buffer’s title

(defun buffer-title ()
  (if buffer-file-name
      (replace-regexp-in-string
       "\\\\" "/"
       (replace-regexp-in-string
        (regexp-quote (getenv "HOME")) "~"
        (convert-standard-filename buffer-file-name)))
    (buffer-name)))

;; (buffer-title)

(setq frame-title-format
  '(:eval
    (buffer-title)))

(defun copy-buffer-title-as-kill ()
  (interactive)
  (kill-new (buffer-title)))

(defun copy-buffer-file-name-as-kill ()
  (interactive)
  (kill-new (buffer-file-name)))

(defun copy-buffer-title-to-url-as-kill ()
  (interactive)
  (kill-new 
   (replace-regexp-in-string (regexp-quote (concat (getenv "HOME") "/system-test/exchange/"))
                             "https://github.com/openmarkets/exchange/blob/master/"
                             (convert-standard-filename buffer-file-name))))

(defun copy-buffer-title-as-kill-short ()
  (interactive)
  (kill-new (replace-regexp-in-string "~/system-test/exchange/src/cljs?/com/openmarkets/exchange"
                                      "..."
                                      (buffer-title))))

(define-prefix-command 'copy-buffer-title-keymap)
(global-set-key (kbd "C-c b") 'copy-buffer-title-keymap)
(global-set-key (kbd "<f9>") 'kinesis)
(define-key copy-buffer-title-keymap (kbd "s") 'copy-buffer-title-as-kill-short)
(define-key copy-buffer-title-keymap (kbd "u") 'copy-buffer-title-to-url-as-kill)
(define-key copy-buffer-title-keymap (kbd "k") 'copy-buffer-title-as-kill)
(define-key copy-buffer-title-keymap (kbd "n") 'copy-buffer-file-name-as-kill)

Eww

;;; Eww
(setq shr-color-visible-luminance-min 80)
(setq shr-use-fonts nil)
  
(setq browse-url-browser-function 'eww-browse-url)
(setq browse-url-browser-function 'browse-url-firefox)

(defun oht-eww-bookmark-make-record ()
  "Make a bookmark record for the current eww buffer"
  `(,(plist-get eww-data :title)
    ((location . ,(eww-current-url))
     (handler . oht-eww-bookmark-handler)
     (defaults . ("This is" "something else" "*eww*")))))

; Second, the handler function for jumping to the URL:
(defun oht-eww-bookmark-handler (record)
  "Jump to a bookmark's url with bookmarked location."
  (eww (bookmark-prop-get record 'location)))

(defun oht-eww-set-bookmark-handler ()
  "Assigns `bookmark-make-record-function' to a custom function"
  (set (make-local-variable 'bookmark-make-record-function)
       #'oht-eww-bookmark-make-record))
(add-hook 'eww-mode-hook 'oht-eww-set-bookmark-handler)
oht-eww-set-bookmark-handlerorg-eww-extend-eww-keymap

Command log mode

Adding this early on because it’s useful to be able to show people what keys I’m pressing, either to debug live, or to teach/demo.

(require 'command-log-mode)
(define-key global-map (kbd "C-c '")
  (lambda () (interactive) (if command-log-mode
                               (command-log-mode -1)
                             (command-log-mode +1)
                             (clm/open-command-log-buffer))))
lambdanil(interactive)(if command-log-mode (command-log-mode -1) (command-log-mode 1) (clm/open-command-log-buffer))

Evil

I don’t really know how to use Evil; see the section on Hercules for an initial attempt to build a heads-up display.

;;; Evil
; (require 'evil)

Margins

(require 'window-margin)
(setq window-margin-width 120)

Holidays

;; Holidays

(require 'calendar)
(require 'holidays)
;(require 'nz-holidays)
(setq holiday-general-holidays nil)
(setq holiday-local-holidays nil)
(setq holiday-christian-holidays nil)
(setq holiday-hebrew-holidays nil)
(setq holiday-islamic-holidays nil)
(setq holiday-bahai-holidays nil)
(setq holiday-oriental-holidays nil)
(setq holiday-solar-holidays nil)
(defalias 'holiday-bahai-ridvan #'ignore)

Visible Mark

I’m new to this mode but it seems to make sense to use it, especially in combination with ‘helm-all-mark-rings’. Remembering the keys for popping around from mark to mark is a bit tricky: C-u C-SPC to pop, and C-h SPC for the Helm version. It’s entirely possible that it will become too annoying to use and I’ll just have to give up on it.

C-h TAB added as well, to move in the opposite direction. This seems like a bit of a muddle. Another annoyance is that this doesn’t quite work globally. In Org Mode there’s C-c & which will pop back quasi-globally — but only for the org mark ring.

Probably the Helm version is the most sensible thing to use. But, the visible marks can perhaps help give some guidance? In a way it seems reminiscent of our concerns with CRDT, and being able to go to where someone else is editing there. Perhaps something like occur would help in combination?

Update: Ultimately I’m getting a bit fed up with this mode.

(require 'visible-mark)
(global-visible-mark-mode 1)
(setq visible-mark-max 5)
(setq visible-mark-forward-max 5)
(setq visible-mark-faces `(visible-mark-face1 visible-mark-face2))
(setq visible-mark-forward-faces `(visible-mark-forward-face1))

(defun unpop-to-mark-command ()
    "Unpop off mark ring. Does nothing if mark ring is empty."
    (interactive)
    (when mark-ring
      (let ((pos (marker-position (car (last mark-ring)))))
        (if (not (= (point) pos))
            (goto-char pos)
          (setq mark-ring (cons (copy-marker (mark-marker)) mark-ring))
          (set-marker (mark-marker) pos)
          (setq mark-ring (nbutlast mark-ring))
          (goto-char (marker-position (car (last mark-ring))))))))
(global-set-key (kbd "C-h TAB") 'unpop-to-mark-command)

ESS

(require 'ess)

;; For whatever reason, this doesn’t work
(defvar ess-R-fl-keyword:assign-vars
  (cons "\\(\\(?2:\\s\"\\).+\\2\\|[a-ZA-Z_]+\\)\\s-*\\(<-\\)"
        '(1 font-lock-variable-name-face)))

(add-to-list 'ess-R-font-lock-keywords '(ess-R-fl-keyword:assign-vars . t) t)

(setq ess-fl-keyword:operators
      (cons "\\(\\*\\|[-=+></]\\)+" 'ess-operator-face))

(advice-add 'ess-elisp-trace-mode :override (lambda (x)))

Basic load for org mode and friends

(defun illiterate ()
  (interactive)
  (let ((coding-system-for-read 'utf-8))
    (if (eq major-mode 'fundamental-mode)
        (revert-buffer nil t)
      (let ((pt (1+ (length
                     (encode-coding-string
                      (buffer-substring-no-properties (point-min) (point))
                      'utf-8))))
            (file-name (buffer-file-name)))
        (kill-buffer (current-buffer))
        (find-file-literally file-name)
        (goto-char pt)))))

;;(load "~/org-mode/lisp/org-macs.elc")
;;(load "~/org-mode/lisp/org-macro.elc")
;;(load "~/org-mode/lisp/org.elc")
;; You need to reload Org or to restart Emacs after setting this.
(setcar (nthcdr 2 org-emphasis-regexp-components) " \t\r\n,\"")
(setf (nth 4 org-emphasis-regexp-components) 10)
;;(load "~/org-mode/lisp/org.elc")

;;(load "~/org-mode/lisp/ob-shell.elc")
;;(load "~/org-mode/lisp/ob-clojure.elc")
;;(load "~/org-mode/lisp/ob-maxima.elc")
(setq org-babel-clojure-backend 'cider)



(setq exec-path (append '("/usr/local/texlive/2021/bin/x86_64-linux") exec-path))
(setq org-preview-latex-default-process 'dvisvgm)
(plist-put org-format-latex-options :scale 2.5)
(add-hook 'org-mode-hook 'org-fragtog-mode)

; org-preview-latex-image-directory
;; Set to nil here, b/c its very annoying when viewing the agenda!
(setq org-startup-with-latex-preview nil)

(defun turn-on-fragments ()
  (interactive)
  (org-preview-latex-fragment '(16)))

;; This takes too long!
(setq calendar-mark-diary-entries-flag nil)
(setq org-agenda-include-diary t)

;; This seems like a good idea
(setq org-startup-with-inline-images t)

(setq org-cycle-global-at-bob t)
(setq org-adapt-indentation nil)

Calendar

Show the week number.

(copy-face font-lock-constant-face 'calendar-iso-week-face)
(set-face-attribute 'calendar-iso-week-face nil
                    :height 0.7)
(setq calendar-intermonth-text
      '(propertize
        (format "%2d"
                (car
                 (calendar-iso-from-absolute
                  (calendar-absolute-from-gregorian (list month day year)))))
        'font-lock-face 'calendar-iso-week-face))

Org mode: priorities

See also Org mode archiving and refiling below.

(setq org-default-priority 9)
(setq org-lowest-priority 9)
(setq org-highest-priority 1)
; (setq org-agenda-fontify-priorities 'cookies)

Org babel languages

(setq org-babel-load-languages
 '((emacs-lisp .t)
   (scheme . t)
   (python . t)
   (R . t)
   (clojure . t)
   (lilypond . t)
;   (jupyter . t)
   (calc . t)
   ))
 
(org-babel-do-load-languages 'org-babel-load-languages org-babel-load-languages)

Org Mode: LaTeX compat

(require 'ox-latex)
;;(setq org-latex-inputenc-alist '(("utf8" . "utf8")))
(setq org-latex-inputenc-alist nil)
(setq org-latex-prefer-user-labels t)

(setq font-latex-fontify-script nil)
(setq font-latex-fontify-sectioning 'color)

;; This gets it to use xelatex...
(setq org-latex-pdf-process
      (list
       "latexmk -outdir=. -pdflatex='/usr/local/texlive/2021/bin/x86_64-linux/xelatex -8bit -shell-escape -interaction nonstopmode' -pdf -f  %f"))

(setq org-export-with-smart-quotes t)

(add-to-list 'org-file-apps '(directory . emacs))

(setq org-confirm-babel-evaluate nil)
(setq org-export-use-babel nil)

(defun my-latex-filter-removeOrgAutoLabels (text backend info)
  "Org-mode automatically generates labels for headings despite explicit use of `#+LABEL`. This filter forcibly removes all automatically generated org-labels in headings."
  (when (org-export-derived-backend-p backend 'latex)
  (replace-regexp-in-string "\\\\label{sec:org[a-f0-9]+}\n" "" text)))

 (add-to-list 'org-export-filter-headline-functions
              'my-latex-filter-removeOrgAutoLabels)

Org Mode: Tempo

(require 'org-tempo)
(setq org-structure-template-alist
      '(("a" . "export ascii")
       ("c" . "center")
       ("C" . "comment")
       ("e" . "src emacs-lisp")
       ("r" . "src scheme :session :results output org :wrap example")
       ("E" . "export")
       ("h" . "export html")
       ("l" . "export latex")
       ("q" . "quote")
       ("Q" . "src sql")
       ("s" . "src")
       ("R" . "src R :session :results output org")
       ("v" . "verse")))

Org mode: Task Juggler integration

(setq org-taskjuggler-default-project-duration 2800)

(setq org-taskjuggler-default-reports
  '("textreport report \"Plan\" {
  formats html
  header '== %title =='

  center -8<-
    [#Plan Plan] | [#Resource_Allocation Resource Allocation]
    ----
    === Plan ===
    <[report id=\"plan\"]>
    ----
    === Resource Allocation ===
    <[report id=\"resourceGraph\"]>
  ->8-
}

# A traditional Gantt chart with a project overview.
taskreport plan \"\" {
  headline \"Project Plan\"
  columns bsi, name, effort, chart {scale month width 1500}
  loadunit shortauto
  hideresource 1
  sorttasks tree
}

# A graph showing resource allocation. It identifies whether each
# resource is under- or over-allocated for.
resourcereport resourceGraph \"\" {
  headline \"Resource Allocation Graph\"
  columns no, name, effort, weekly
  loadunit shortauto
  hidetask ~(isleaf() & isleaf_())
  sorttasks plan.start.up
}"))

Org Mode: Org Agenda

(define-key global-map "\C-ca" 'org-agenda)

;; Is this being loaded properly
(setq org-agenda-prefix-format '(
  (agenda  . " %i %-12:c%?-12t% s") ;; file name + org-agenda-entry-type
  ;; (agenda  . "  • ")
  (timeline  . "  % s")
  ;; (todo  . " %i %-12:c")
  (todo  . "")
  (tags  . " %i %-12:c")
  (search . " %i %-12:c")))

(setq org-agenda-use-time-grid nil)
(setq org-agenda-include-deadlines t)
;; 0 to start on Sunday or 1 to start on Monday, nil to start "today"
(setq org-agenda-start-on-weekday 1)

;; This works
(defun place-agenda-tags ()
  "Put the agenda tags by the right border of the agenda window."
  (let ((org-agenda-tags-column (- 4 (window-width))))
    (org-agenda-align-tags)))
(add-hook 'org-agenda-finalize-hook 'place-agenda-tags)

;; Intention markers in agenda
(defun color-org-item (tag backcolor forecolor)
  ""
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward tag nil t)
    (add-text-properties (match-beginning 0) (match-end 0) `(face (:background ,backcolor :foreground ,forecolor)))
    (cond ((string= tag "\\[#1\\]")
           (compose-region (match-beginning 0) (match-end 0) "💠"))
          ((string= tag "\\[#2\\]")
           (compose-region (match-beginning 0) (match-end 0) "🌴"))
          ((string= tag "\\[#3\\]")
           (compose-region (match-beginning 0) (match-end 0) "🛠"))
          ((string= tag "\\[#4\\]")
           (compose-region (match-beginning 0) (match-end 0) ""))
          ((string= tag "\\[#5\\]")
           (compose-region (match-beginning 0) (match-end 0) "🌓"))
          ((string= tag "\\[#6\\]")
           (compose-region (match-beginning 0) (match-end 0) ""))
          ((string= tag "\\[#7\\]")
           (compose-region (match-beginning 0) (match-end 0) ""))
          ((string= tag "\\[#8\\]")
           (compose-region (match-beginning 0) (match-end 0) "🔴"))
          ((string= tag "\\[#9\\]")
           (compose-region (match-beginning 0) (match-end 0) "🎲")))))

(defun color-org-item-ink (tag backcolor forecolor)
  ""
  (interactive)
  (goto-char (point-min))
  (while (re-search-forward tag nil t)
    (add-text-properties (match-beginning 0) (match-end 0) `(face (:background ,backcolor :foreground ,forecolor)))))

(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#1\\]" "#0d0e14" "DeepSkyBlue1"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#2\\]" "#0d0e14" "green"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#3\\]" "#0d0e14" "red"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#4\\]" "#0d0e14" "DeepSkyBlue1"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#5\\]" "#0d0e14" "DeepSkyBlue1"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#6\\]" "#0d0e14" "dark violet"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#7\\]" "#0d0e14" "lavender"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#8\\]" "#0d0e14" "yellow"))))
(add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item "\\[#9\\]" "#0d0e14" "azure"))))
;;; (add-hook 'org-agenda-finalize-hook (lambda () (save-excursion (color-org-item-ink "\\[#[23456789]\\]" "#0d0e14" "DeepSkyBlue1"))))

;; Hm... it occurs to me, maybe it would be helpful to have a variable
;; that we could toggle to include BACK and PATT items in any of the
;; views that might exist.

;; Most of these line up except some that will stand out
(setq org-todo-keywords
      '((sequence "BACK(b)" "PATT(p)" "TODO(t)" "WIP(s)" "BLOC(x)" "DECK(n)" "DEFE(d)" "BURN(z)" "FROZ(f)" "|" "DONE(y)" "ARCH(a)" "SAVE(v)" "WONT(w)")))

(setq org-todo-keyword-faces
 '(("BACK" . "white")
   ("PATT" . "dim gray")
   ("TODO" . "red")
   ("WIP" . "magenta")
   ("BLOC" . "teal") 
   ("BURN" . "dodger blue") 
   ("FROZ" . "blue") 
   ("DECK" . "yellow") 
   ("DONE" . "green")
   ("ARCH" . "green")
   ("SAVE" . "dark green")
   ("DEFE" . "gray")
   ("WONT" . "dim gray"))
 )

(setq org-log-done 'time)

;; Everything in this directory (non-recursive) will be displayed
(setq org-agenda-files '("~/git-repos/brookes/policies.org"))
      ;("~/Anticipation2022/Resume-Goals.org" "~/exp2exp.github.io/src/" "~/Peeragogy.github.io/src/" "~/journal/")

(setq org-agenda-log-mode-items '(closed clock state))

;; Here’s what makes Emacs funny — advice to override contents of Org
;; Agenda buffer when pressing E, and turn the quoted text dark green

(load "~/org-mode/lisp/org-agenda.el")
(defun org-green-entries (arg &optional x)
  (with-temp-buffer (insert arg)
                    (add-text-properties (point-min)
                                         (point-max)
                                         '(face ((background-color . "darkgreen"))))
                    (buffer-string)))

(defun advise-org-no-properties (r)
  (advice-add 'org-no-properties :override 'org-green-entries))

(defun unadvise-org-no-properties (r)
  (advice-remove 'org-no-properties 'org-green-entries))

(advice-add 'org-agenda-entry-text-mode :before 'advise-org-no-properties)
(advice-add 'org-agenda-entry-text-mode :after 'unadvise-org-no-properties)

(setq org-agenda-sorting-strategy '((todo todo-state-up category-down priority-down tag-up)))

(setq org-agenda-prefix-format '((agenda   . " %i %-10:c%?-12t% s") ; " %i %-12:c"
                                 (timeline . "  % s")
                                 (todo     . " %i %-12:c")
                                 (tags     . " %i %-12:c")
                                 (search   . " %i %-12:c")))

(setq org-agenda-todo-keyword-format "%-1s")
(setq org-agenda-hide-tags-regexp "write")

;; I'm using this for some upcoming tasks as well as to keep track of completed tasks.
(setq org-agenda-diary-file "~/org-files/work.org")

(global-set-key (kbd "C-c s") 'org-store-link)
(global-set-key (kbd "C-c l") 'org-insert-link)
(global-set-key (kbd "C-c a") 'org-agenda)
(global-set-key (kbd "C-c c") 'org-capture)

Sophisticated blocks

(defun my-latex-export-example-blocks (text backend info)
  "Export example blocks as `results' env."
  (when (org-export-derived-backend-p backend 'latex)
    (with-temp-buffer
      (insert text)
      ;; replace verbatim env by listings
      (goto-char (point-min))
      (while (re-search-forward "\\\\\\(begin\\|end\\){verbatim}" nil t)
        (replace-match "\\\\\\1{results}"))
      (buffer-substring-no-properties (point-min) (point-max)))))

(add-to-list 'org-export-filter-example-block-functions
             'my-latex-export-example-blocks)

Org mode archiving and refiling

This works for archiving things into a datetree.

The function org-agenda-priority ends up calling org-priority with the same argument style as before. Note that the flag =’remove= isn’t documented as an option, but it exists in the code!

It would be nice to take some further action here, like setting a property “deferred”

(setq org-archive-location "~/org-files/datetree.org::datetree/")

(setq org-priority-enable-commands t)

(setq org-agenda-bulk-custom-functions '((?D (lambda () (interactive) (let ((org-agenda-title nil))
                                                                        (org-agenda-todo "DEFE")
                                                                        ;; this will give an error if there isn’t a priority cookie set!
                                                                        (org-agenda-priority 'remove))))
                                         ;; According to the docs for ‘org-agenda-bulk-custom-functions’,
                                         ;; we need *two* functions to pull off what’s wanted here.
                                         (?P (lambda (ch) (interactive) (let ((org-agenda-title nil))
                                                                          (org-agenda-priority ch)))
                                             (lambda () (interactive)
                                               ;; we need to produce a list (!) of arguments, which is a bit confusing
                                               ;; Basically, the function above is a destructuring of that list.
                                               ;; In this case, there is only one argument anyway!
                                               (list
                                                (string-to-number (read-string (format "Priority %s-%s, SPC to remove: "
                                                                                       (int-to-string org-priority-highest)
                                                                                       (int-to-string org-priority-lowest)))))))))

Org mode extras

(setq org-fontify-quote-and-verse-blocks t)
  
(defun org-fold-and-move ()
  (interactive)
  (outline-hide-subtree)
  (org-next-visible-heading 1)
  (outline-show-subtree))

(define-key org-mode-map (kbd "C-H-n") 'org-fold-and-move)

(defun org-fold-and-move-back ()
  (interactive)
  (outline-hide-subtree)
  (org-previous-visible-heading 1)
  (outline-show-subtree))

(define-key org-mode-map (kbd "C-H-p") 'org-fold-and-move-back)

(require 'ox-extra)
(ox-extras-activate '(ignore-headlines))

(require 'toc-org)

(add-hook 'org-create-file-search-functions
      #'(lambda ()
         (when (member major-mode '(text-mode latex-mode))
           (number-to-string (line-number-at-pos)))))

(add-hook 'org-execute-file-search-functions
          #'(lambda (search-string)
              (when (member major-mode '(text-mode latex-mode))
                (goto-char (point-min))
                (forward-line (string-to-number search-string)))))

Org Tree Slide

;;; Org Tree Slide

(require 'org-tree-slide)

;; Weird but needed to get images to respond
(setq org-image-actual-width '(3))

(setq org-tree-slide-slide-in-effect nil)
(setq org-tree-slide-skip-outline-level 3)

(defvar-local org-show-comments-state t)

(defun engage-org-cloaking ()
  (interactive)
  (let ((cloak (face-attribute 'default :background)))
    (set-face-attribute 'org-meta-line (selected-frame) :foreground cloak)
    (set-face-attribute 'org-block-begin-line (selected-frame) :foreground cloak)
    (set-face-attribute 'org-block-end-line (selected-frame) :foreground cloak))
  (setq org-show-comments-state nil)
  (setq mode-line-format nil)
  (org-display-inline-images t t))

(defun disengage-org-cloaking ()
  (interactive)
  (let ((uncloak (face-attribute 'default :foreground)))
    (set-face-attribute 'org-meta-line (selected-frame) :foreground uncloak)
    (set-face-attribute 'org-block-begin-line (selected-frame) :foreground uncloak)
    (set-face-attribute 'org-block-end-line (selected-frame) :foreground uncloak))
  (setq org-show-comments-state t)
  (setq mode-line-format t)
  (org-display-inline-images nil t))

(defun toggle-org-cloaking ()
  (interactive)
  (cond
   (org-show-comments-state (engage-org-cloaking))
   (t (disengage-org-cloaking))))

(add-hook 'org-tree-slide-mode-hook  'toggle-org-cloaking)

(define-key org-tree-slide-mode-map (kbd "M-p") 'org-tree-slide-move-previous-tree)
(define-key org-tree-slide-mode-map (kbd "M-n") 'org-tree-slide-move-next-tree)

(define-key org-tree-slide-mode-map (kbd "<kp-left>") 'org-tree-slide-move-previous-tree)
(define-key org-tree-slide-mode-map (kbd "<kp-right>") 'org-tree-slide-move-next-tree)

(defun org-next-visible-heading-to-top ()
  (interactive)
  (org-next-visible-heading 1)
  (recenter-top-bottom 1)
  (outline-show-subtree))

(define-key org-tree-slide-mode-map (kbd "M-z") 'org-next-visible-heading-to-top)

Org mode: org-journal

(use-package org-journal)
(setq org-journal-dir "~/journal/"
      org-journal-file-format "%Y%m%d.org"
      org-journal-date-format "%e %B %Y (%A)"
      org-journal-date-prefix "#+TITLE: "
      org-journal-time-prefix "* "
      org-journal-time-format "")

(defun get-journal-file-yesterday ()
  "Gets filename for yesterday's journal entry."
  (let* ((yesterday (time-subtract (current-time) (days-to-time 1)))
         (daily-name (format-time-string "%Y%m%d" yesterday)))
    (expand-file-name (concat org-journal-dir daily-name ".org"))))

(defun journal-file-yesterday ()
  "Creates and load a file based on yesterday's date."
  (interactive)
  (find-file (get-journal-file-yesterday)))

(global-set-key (kbd "C-c j") #'org-journal-open-current-journal-file)
(global-set-key (kbd "C-c y") #'journal-file-yesterday)

(defun org-journal-find-location ()
  ;; Open today's journal, but specify a non-nil prefix argument in order to
  ;; inhibit inserting the heading; org-capture will insert the heading.
  (org-journal-new-entry t)
  (unless (eq org-journal-file-type 'daily)
    (org-narrow-to-subtree))
  (goto-char (point-max)))

(defvar org-journal--date-location-scheduled-time nil)

(defun org-journal-date-location (&optional scheduled-time)
  (let ((scheduled-time (or scheduled-time (org-read-date nil nil nil "Date:"))))
    (setq org-journal--date-location-scheduled-time scheduled-time)
    (org-journal-new-entry t (org-time-string-to-time scheduled-time))
    (unless (eq org-journal-file-type 'daily)
      (org-narrow-to-subtree))
    (goto-char (point-max))))

(setq org-capture-templates '(("j" "Journal entry" plain (function org-journal-find-location)
                               "** %(format-time-string org-journal-time-format)%^{Title}\n%i%?"
                               :jump-to-captured t :immediate-finish t)
                              ("f" "Journal entry" plain (function org-journal-date-location)
                               "** TODO %?\n <%(princ org-journal--date-location-scheduled-time)>\n"
                               :jump-to-captured t)))

(unbind-key (kbd "C-c C-s") org-journal-mode-map)
(define-key org-journal-mode-map (kbd "<end>") #'org-journal-search)

; (setq org-journal-enable-agenda-integration t)

(defun org-journal-new-entry-from-agenda (prefix)
  "Add journal entry for the date at point in the agenda."
  (interactive "P")
  (org-agenda-check-type t 'agenda)
  (let* ((day (or (get-text-property (min (1- (point-max)) (point)) 'day)
                  (user-error "Don't know which date to open in calendar")))
         (time (org-time-string-to-time (format-time-string "%Y-%m-%d" (org-time-from-absolute day)))))
    (org-journal-new-scheduled-entry prefix time)))

Org bullets

;; Markers from https://zzamboni.org/post/beautifying-org-mode-in-emacs/

(use-package org-bullets
  :config
  (add-hook 'org-mode-hook (lambda () (org-bullets-mode 1))))

(setq org-bullets-bullet-list
      '(;;; Large
        "👻"
        "🍒"
        "🍓"
        "🍊"
        "🍎"
        "🍈"
        "🚀"
        "🔔"
        "🗝️"
        "𝗔"
        "𝗕"
        "𝗖"
        "𝗗"
        ))
;(use-package emojify
;  :hook (after-init . global-emojify-mode))

;; It is a bit annoying to have to do this; apparently the additions
;; to org-journal-mode do not “just work” out of the box, even though
;; it is a derived mode.
(dolist (a '(org-mode org-journal-mode))
  (font-lock-add-keywords a
                          '(("^ *\\([-]\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([2]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([3]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([4]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([5]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([6]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([7]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([8]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([9]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][0]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][1]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][2]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][3]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][4]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][5]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][6]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][7]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][8]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([1][9]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ("^ *\\([2][0]\\.\\) "
                             (0 (prog1 () (compose-region (match-beginning 1) (match-end 1) ""))))
                            ;; Intention markers — for Habits (1), Yearly (2), Quarterly (3), Monthly (4), Weekly (5), Daily (6);
                            ;;                   — 5 Years (7), Life (8), and Done (9)
                            ("\\(\\[#1\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "💠")
                                       )))
                            ("\\(\\[#2\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "🌴")
                                       )))
                            ("\\(\\[#3\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "🛠")
                                       )))
                            ("\\(\\[#4\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "")
                                       )))
                            ("\\(\\[#5\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "🌓")
                                       )))
                            ("\\(\\[#6\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "")
                                       )))
                            ("\\(\\[#7\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "")
                                       )))
                            ("\\(\\[#8\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "🔴")
                                       )))
                            ("\\(\\[#9\\]\\)"
                             (0 (prog1 () 
                                       (compose-region (match-beginning 1) (match-end 1) "🎲")
                                       )))
                            )))


;; ⓿ ❶ ❷ ❸ ❹ ❺ ❻ ❼ ❽ ❾ ❿ ⓫ ⓬ ⓭ ⓮ ⓯ ⓰ ⓱ ⓲ ⓳ ⓴
;; ㉑ ㉒ ㉓ ㉔ ㉕ ㉖ ㉗ ㉘ ㉙ ㉚ ㉛ ㉜ ㉝ ㉞ ㉟ ㊱ ㊲ ㊳ ㊴ ㊵ ㊶ ㊷ ㊸ ㊹ ㊺ ㊻ ㊼ ㊽ ㊾ ㊿

Further configuration of Org Mode

(setq org-cycle-separator-lines 2)

(require 'color)
(set-face-attribute 'org-block nil :background
                    (color-darken-name
                     (face-attribute 'default :background) 3))

(setq org-src-block-faces '(("R" (:foreground "dark violet"))
                            ("python" (:foreground "dark violet"))
                            ("org" (:foreground "Green"))
                            ("example" (:foreground "Green"))))

(setq org-src-fontify-natively t)

;; orig
;;(setq org-priority-regexp ".*?\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)"
;; modified
;;(setq org-priority-regexp "^\\*+.*\\(\\[#\\([A-Z0-9]+\\)\\] ?\\)")

(setq org-link-frame-setup '((vm . vm-visit-folder-other-frame)
                             (vm-imap . vm-visit-imap-folder-other-frame)
                             (gnus . org-gnus-no-new-news)
                             (file . find-file-other-frame)
                             (wl . wl-other-frame)))

(require 'cl-lib)

(defun my-org-open-at-point (&optional arg)
  (interactive "P")
  (if (not arg)
      (let ((org-link-frame-setup (cl-acons 'file 'find-file org-link-frame-setup)))
        (org-open-at-point))
    (let ((browse-url-browser-function 'eww-browse-url))
      (org-open-at-point))))

;; Make colorful extension for numbered and bullet lists.
(add-hook 'org-mode-hook
          #'(lambda ()
              (font-lock-add-keywords nil
                                      ;; possible white space followed by - or N. and then white space
                                      '(("^\\s-*?\\(-\\{1\\}\\|[0-9]+\\.\\)\\s-" 1
                                         font-lock-warning-face t)))
              (font-lock-add-keywords nil
                                      '(("^\\(-\\{5,\\}\\)" 1
                                         font-lock-type-face t)))))

(defun my-org-return (&optional arg indent)
  (interactive "*p")
  (dotimes (number arg) (org-return indent)))
(define-key org-mode-map (kbd "<return>") 'my-org-return)

;; This is great but I notice sometimes that it interferes with embedded
;; code blocks
(setq org-hide-emphasis-markers t)

Habits

(require 'org-habit)
(add-to-list 'org-modules 'org-habit t)
(setq org-agenda-scheduled-leaders '("" ""))
(setq org-treat-insert-todo-heading-as-state-change t)

(setq org-log-into-drawer t)

Manipulate source blocks

The first function here did some havoc.

;; (defun my/org-in-src-block-p (&optional inside)
;;   "Whether point is in a code source block.
;; When INSIDE is non-nil, don't consider we are within a source
;; block when point is at #+BEGIN_SRC or #+END_SRC."
;;   (let ((case-fold-search t))
;;     (or (and (eq (car (org-element-at-point)) 'src-block))
;;         (and (not inside)
;;              (save-match-data
;;                (save-excursion
;;                  (beginning-of-line)
;;                  (looking-at ".*#\\+\\(begin\\|end\\)_src")))))))
;; (advice-add 'org-in-src-block-p :override #'my/org-in-src-block-p)

(defun my/advice-org-ctrl-c-ctrl-c (&rest args)
  "Run `org-babel-execute-src-block-maybe' if point is in an org source block."
  (let ((do-not-run-orig-fn (org-in-src-block-p)))
    (when do-not-run-orig-fn
      (call-interactively #'org-babel-execute-src-block-maybe))
    do-not-run-orig-fn))
(advice-add 'org-ctrl-c-ctrl-c :before-until #'my/advice-org-ctrl-c-ctrl-c)

Org Roam

;; Should switch to v2 now
(require 'org-roam)

(setq org-roam-directory "/home/joe/git-repos/exp2exp.github.io/src/")
;; For now
(setq org-roam-db-location "/home/joe/git-repos/exp2exp.github.io/src/org-roam.db")

(org-roam-db-autosync-mode)

(defun display-current-backlinks ()
  (interactive)
  (let ((ready (org-roam-node-at-point)))
    (when ready (org-roam-buffer ready))))

(defun display-current-backlinks-2 (&rest _args)
  (interactive)
  (let ((ready (org-roam-node-at-point)))
    (when ready (org-roam-buffer ready))))

(define-prefix-command 'org-roam-user-keymap)
(global-set-key (kbd "C-c n") 'org-roam-user-keymap)

;; Maybe this should be set up to toggle the buffer out of the way if it’s rerun
(define-key org-roam-user-keymap (kbd "l") #'display-current-backlinks)
(define-key org-roam-user-keymap (kbd "f") #'org-roam-node-find)
(define-key org-roam-user-keymap (kbd "a") #'org-roam-db-sync)
(define-key org-mode-map (kbd "C-c n i") #'org-roam-node-insert)

(define-key org-mode-map (kbd "C-c n b") #'org-mark-ring-goto)
(define-key org-roam-mode-map (kbd "C-c n b") #'org-mark-ring-goto)
(define-key org-roam-user-keymap (kbd "g") #'org-mark-ring-goto)

;; Keep the backlinks buffer in sight.

;; The function should be set up so that it only takes action when
;; we’re actually in an org-roam buffer! — done
(add-hook 'org-follow-link-hook #'display-current-backlinks)

(advice-add #'org-mark-ring-goto :after #'display-current-backlinks)
(advice-add #'org-roam-node-open :after #'display-current-backlinks-2) 

(setq org-link-frame-setup '((vm . vm-visit-folder-other-frame)
                             (vm-imap . vm-visit-imap-folder-other-frame)
                             (gnus . org-gnus-no-new-news)
                             (file . find-file)
                             (wl . wl-other-frame)))

Org Roam UI

(require 'org-roam-ui)
(setq org-roam-ui-sync-theme t
      org-roam-ui-follow t
      org-roam-ui-update-on-save t
      org-roam-ui-open-on-start t)

Org Ref

(setq bibtex-completion-bibliography '(;"/home/joe/hci-ethics-readings.bib"
                                       ; "/home/joe/MyLibrary.bib"
                                       "/home/joe/Melanie/Repo/melanie.bib"
                                       ))

(require 'helm-bibtex)
(add-to-list 'load-path "~/org-ref/")
(require 'org-ref)

(setq reftex-default-bibliography bibtex-completion-bibliography)

;; but this cautions that we still need to include the bibliography when exporting to LaTeX
(setq org-ref-default-bibliography bibtex-completion-bibliography
      org-ref-bibliography-notes "~/org-files/notes.org"
      org-ref-pdf-directory "~/pdfs/")

Pandoc compatibility

Actually, we don’t need any of this — the system works of of the box with the correct magic invocations.

;; (defun helm-bibtex-format-pandoc-citation (keys)
;;   (concat "[" (mapconcat (lambda (key) (concat "@" key)) keys "; ") "]"))
;; (setf (cdr (assoc 'org-mode helm-bibtex-format-citation-functions))
;;   'helm-bibtex-format-pandoc-citation)

;; (load "~/ox-pandoc/ox-pandoc.el")
;; (require 'ox-pandoc)
;; (setq helm-bibtex-format-citation-functions
;;       '((org-mode . (lambda (x) (insert (concat
;;                                          "\\cite{"
;;                                          (mapconcat 'identity x ",")
;;                                          "}")) ""))))

;; (defun ox-export-to-docx-and-open ()
;;  "Export the current org file as a docx via markdown."
;;  (interactive)
;;  (let* ((bibfile (expand-file-name (car (org-ref-find-bibliography))))
;;         ;; this is probably a full path
;;         (current-file (buffer-file-name))
;;         (basename (file-name-sans-extension current-file))
;;         (docx-file (concat basename ".docx")))
;;    (save-buffer)
;;    (when (file-exists-p docx-file) (delete-file docx-file))
;;    (shell-command (format
;;                    "pandoc -s -S --bibliography=%s %s -o %s"
;;                    bibfile current-file docx-file))
;;    (org-open-file docx-file '(16))))

Org mode: face for internal links

(defface org-link-internal
  '((((class color) (background light))
     (:foreground "turquoise1" :underline t))
    (((class color) (background dark))
     (:foreground "turquoise1" :underline t))
    (t (:underline t)))
  "Face for internal links."
  :group 'org-faces)

(org-link-set-parameters "file"
               :face 'org-link-internal)

Org mode: LaTeX classes

(add-to-list 'org-latex-default-packages-alist "\\PassOptionsToPackage{hyperref}{breaklinks=true,pageanchor}")
  
(setq org-latex-classes '(("article" "\\documentclass{article}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
                             ("\\paragraph{%s}" . "\\paragraph*{%s}")
                             ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
                            ("beamer" "\\documentclass[9pt,presentation]{beamer}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\subsubsection*{%s}")
                             ("\\paragraph{%s}" . "\\paragraph*{%s}")
                             ("\\subparagraph{%s}" . "\\subparagraph*{%s}"))
                            ("report" "\\documentclass[11pt]{report}"
                             ("\\chapter{%s}" . "\\chapter*{%s}")
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
                            ("reportalt" "\\documentclass[11pt]{report}"
                             ("\\level{0}{%s}" . "\\chapter*{%s}")
                             ("\\level{1}{%s}" . "\\section*{%s}")
                             ("\\level{2}{%s}" . "\\subsection*{%s}")
                             ("\\level{3}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{4}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{5}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{6}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{7}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{8}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{9}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{10}{%s}" . "\\subsubsection*{%s}")
                             ("\\level{11}{%s}" . "\\subsubsection*{%s}"))
                            ("book" "\\documentclass[11pt]{book}"
                             ("\\part{%s}" . "\\part*{%s}")
                             ("\\chapter{%s}" . "\\chapter*{%s}")
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\subsubsection*{%s}"))
                            ("acmlarge" "\\documentclass[11pt]{acmlarge}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))
                            ("acmart" "\\documentclass{acmart}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))
                            ("ceurart" "\\documentclass{ceurart}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))
                            ("scrartcl" "\\documentclass{scrartcl}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))
                            ("easychair" "\\documentclass{easychair}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))
                            ("memoir" "\\documentclass{memoir}"
                             ("\\section{%s}" . "\\section*{%s}")
                             ("\\subsection{%s}" . "\\subsection*{%s}")
                             ("\\subsubsection{%s}" . "\\paragraph{%s}")
                             ("\\paragraph{%s}" . "\\subparagraph{%s}"))))

Org mode: LaTeX fragments

;; For formatting drawers in blue...
(setq org-latex-format-drawer-function      
(lambda (name contents) (concat "\\begingroup\\color{blue}{" contents "\\endgroup")))
;; This is only for fragments, so I don’t think we need biblatex here!
;; Indeed, it seems the above was used as well?
(setq org-format-latex-header
   "\\documentclass{article}
\\usepackage[usenames]{color}
\\pagestyle{empty}             % do not remove
% The settings below are copied from fullpage.sty
%%%%% START SILLY COMMANDS TO TURN OFF BEAMER STUFF, THIS IS BOUND TO BE A BAD IDEA IN GENERAL
\\newcommand{\\fakezero}[1]{}
\\newcommand{\\fakeadd}[2]{}
\\newcommand{\\fakeminus}[1][1]{}
\\newcommand{\\fakeplusminus}[2][c]{}
\\newcommand{\\faketriadminus}[3][c]{}
\\newcommand{\\fakequadminus}[4][c]{}
\\newcommand{\\fakequintminus}[5][c]{}
\\usepackage{xparse}
\\NewDocumentCommand{\\fakesetminus}{mo}{\\unskip}
\\NewDocumentCommand{\\fakeunminus}{mm}{\\unskip}
\\let\\addtobeamertemplate\\fakeadd
%%%%% END OF SILLY COMMANDS TO TURN OFF BEAMER STUFF, THIS IS BOUND TO BE A BAD IDEA IN GENERAL
\\setlength{\\textwidth}{\\paperwidth}
\\addtolength{\\textwidth}{-3cm}
\\setlength{\\oddsidemargin}{1.5cm}
\\addtolength{\\oddsidemargin}{-2.54cm}
\\setlength{\\evensidemargin}{\\oddsidemargin}
\\setlength{\\textheight}{\\paperheight}
\\addtolength{\\textheight}{-\\headheight}
\\addtolength{\\textheight}{-\\headsep}
\\addtolength{\\textheight}{-\\footskip}
\\addtolength{\\textheight}{-3cm}
\\setlength{\\topmargin}{1.5cm}
\\addtolength{\\topmargin}{-2.54cm}
\\usepackage{libertinust1math}
%% This gives some error in Emacs, I’m not sure why: not all the characters display
%%\\usepackage{concmath}
%%\\usepackage[2cell,all]{xy}
%%%%% APPLYING SILLY COMMANDS TO TURN OFF BEAMER STUFF, THIS IS BOUND TO BE A BAD IDEA IN GENERAL
\\renewcommand{\\usepackage}{\\fakeplusminus}
\\let\\setmainfont\\fakeplusminus
\\let\\setmathfont\\fakeplusminus
\\let\\hypersetup\\fakeplusminus
\\let\\newfontfamily\\fakeadd
\\let\\input\\fakeplusminus
\\let\\setbeamertemplate\\fakeunminus
\\let\\setbeamercolor\\fakeunminus
\\let\\DeclareInstance\\fakequintminus
\\let\\setenotez\\fakeplusminus
\\makeatletter
\\let\\beamer@usesphere\\fakesetminus
\\makeatother
\\definecolor{arsenic}{rgb}{0, 0, 0}
")

Omitting:

[PACKAGES] [DEFAULT-PACKAGES]

Org mode: Bindings

;;; Org mode bindings
;; I might regret the lack of easy access to org-edit-special
;; ... but I’m currently using this binding globally
(unbind-key (kbd "C-c '") org-mode-map)

(define-key org-mode-map (kbd "C-<tab>") nil)

(define-key org-mode-map (kbd "<f12>") 'org-open-at-point)
(define-key org-mode-map (kbd "<insert>") 'my-org-open-at-point)

(define-key org-mode-map (kbd "<kp-right>") 'org-next-link)
(define-key org-mode-map (kbd "<kp-left>") 'org-previous-link)
(define-key org-mode-map (kbd "<kp-begin>") 'org-open-at-point)

(define-key org-mode-map (kbd "s-n") 'org-next-link)
(define-key org-mode-map (kbd "s-p") 'org-previous-link)

Org Reveal

(require 'ox-reveal)
(setq org-reveal-root "file:///home/joe/reveal.js")

Whitespace mode

(setq whitespace-style (quote (face trailing tab-mark lines-tail)))
(setq whitespace-line-column 500)

(add-hook 'find-file-hook 'whitespace-mode)

; transform literal tabs into a right-pointing index finger
(setq
 whitespace-display-mappings ;http://ergoemacs.org/emacs/whitespace-mode.html
 '((tab-mark 9 [9758 9] [92 9])
   ;others substitutions...
   ))

Mu4e

(add-to-list 'load-path "~/mu/mu4e/")
(require 'mu4e)
(setq mu4e-get-mail-command "mbsync -a")

(setq mail-user-agent 'mu4e-user-agent)
(setq mu4e-maildir "/home/joe/.mail/main")
(setq mu4e-sent-folder "/Sent")
(setq mu4e-trash-folder "/Trash")
(setq mu4e-drafts-folder "/Drafts")

;; Turn off completion of addresses
(setq mu4e-compose-complete-addresses t)

(setq send-mail-function 'smtpmail-send-it)

(setq user-mail-address "joseph.corneli@hyperreal.enterprises")
(setq mu4e-user-mail-address-list '("joseph.corneli@hyperreal.enterprises"))

(setq hyperreal-signature
"Dr Joseph A. Corneli (https://github.com/holtzermann17)

HYPERREAL ENTERPRISES LTD is a private company limited by shares, incorporated
25th, June 2019 as Company Number 634284 on the Register of Companies for
Scotland (https://beta.companieshouse.gov.uk/company/SC634284).")

(setq brookes-signature
      "Dr Joseph A. Corneli, Research Fellow in Ethical AI (https://ethical-ai.ac.uk/)")

;; This is a lovely long definition that represents various "contexts".
;; I like it because the idea of defining contexts to switch between is
;; itself very nice!  However, the definition itself has lots of repeated
;; terms and I wonder if I shouldn’t take the opportunity to re-think it in
;; terms of a macro with some higher-level abstractions? 22 October 2020, 13:08
(setq mu4e-contexts
      `( ,(make-mu4e-context
           :name "main"
           :match-func (lambda (_) (string-equal "main" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/main")
                   (mu4e-mu-home . "~/.mu-main")
                   (mu4e-get-mail-command . "mbsync main")
                   (user-mail-address . "joseph.corneli@hyperreal.enterprises")
                   (smtpmail-smtp-user . "joseph.corneli@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))
         ,(make-mu4e-context
           :name "contact"
           :match-func (lambda (_) (string-equal "contact" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/contact")
                   (mu4e-mu-home . "~/.mu-contact")
                   (mu4e-get-mail-command . "mbsync contact")
                   (user-mail-address . "contact@hyperreal.enterprises")
                   (smtpmail-smtp-user . "contact@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))
         ,(make-mu4e-context
           :name "Orgmode"
           :match-func (lambda (_) (string-equal "orgmode" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/orgmode")
                   (mu4e-mu-home . "~/.mu-orgmode")
                   (mu4e-get-mail-command . "mbsync orgmode")
                   (user-mail-address . "joseph.corneli.orgmode@hyperreal.enterprises")
                   (smtpmail-smtp-user . "joseph.corneli.orgmode@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))
         ,(make-mu4e-context
           :name "Github"
           :match-func (lambda (_) (string-equal "github" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/github")
                   (mu4e-mu-home . "~/.mu-github")
                   (mu4e-get-mail-command . "mbsync github")
                   (user-mail-address . "joseph.corneli.github@hyperreal.enterprises")
                   (smtpmail-smtp-user . "joseph.corneli.github@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))
         ,(make-mu4e-context
           :name "Mu"
           :match-func (lambda (_) (string-equal "mu" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/mu")
                   (mu4e-mu-home . "~/.mu-mu")
                   (mu4e-get-mail-command . "mbsync mu")
                   (user-mail-address . "joseph.corneli.mu@hyperreal.enterprises")
                   (smtpmail-smtp-user . "joseph.corneli.mu@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))
         ,(make-mu4e-context
           :name "Emacs"
           :match-func (lambda (_) (string-equal "em" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/em")
                   (mu4e-mu-home . "~/.mu-em")
                   (mu4e-get-mail-command . "mbsync em")
                   (user-mail-address . "joseph.corneli.em@hyperreal.enterprises")
                   (smtpmail-smtp-user . "joseph.corneli.em@hyperreal.enterprises")
                   (smtpmail-smtp-server . "box.hyperreal.enterprises")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "hyperreal.enterprises")
                   (mu4e-compose-signature . ,hyperreal-signature)
                   ))

         ,(make-mu4e-context
           :name "gmail"
           :match-func (lambda (_) (string-equal "gmail" (mu4e-context-name mu4e~context-current)))
           :enter-func '()
           :leave-func (lambda () (mu4e-clear-caches) (setq mu4e-maildir-list nil))
           :vars `((mu4e-maildir . "~/.mail/gmail")
                   (mu4e-mu-home . "~/.mu-gmail")
                   (mu4e-get-mail-command . "mbsync gmail")
                   (user-mail-address . "p0091091@brookes.ac.uk")
                   (smtpmail-smtp-user . "p0091091@brookes.ac.uk")
                   (smtpmail-smtp-server . "smtp.gmail.com")
                   (smtpmail-smtp-service . 587)
                   (smtpmail-local-domain . "brookes.ac.uk")
                   (mu4e-compose-signature . ,brookes-signature)
                   ))))

(defun zap-mu ()
  (interactive)
  (shell-command "pkill -2 -u $UID mu; sleep 1"))

(defun reindex-mu ()
  (interactive)
  (shell-command "mu index --muhome=~/.mu-main --maildir=~/.mail/main"))

(setq mu4e-compose-context-policy nil)
(setq mu4e-context-policy nil)
(defun mu4e-reboot-on-switch ()
  "Objective: sequence switch context, quit, restart.
This doesn't always work."
  (interactive)
  (mu4e-context-switch)
  ;; (message "Current context: %s" (mu4e-context-current))
  (mu4e~stop)
  (mu4e)
  (zap-mu))

(define-key mu4e-main-mode-map (kbd ";") 'mu4e-reboot-on-switch)

;; Begin in main context at startup
(mu4e-context-switch nil "main")

Web stuff

(require 'request)
(add-to-list 'load-path "~/.emacs.d/lisp/hypothesis/")
(require 'hypothesis)
(setq hypothesis-username "holtzermann17")
(setq hypothesis-token "6879-Kbek19hiNLSDbeW0KzXUhsnwy7T4et_R82Hz8kv27F8")

Geiser

(require 'geiser)
(require 'geiser-racket)
(add-hook 'scheme-mode-hook 'geiser-mode)
(setq geiser-default-implementation 'racket)

Cider

  ;; Haven’t gotten LSP working yet
  ;; https://www.youtube.com/watch?v=grL3DQyvneI
  ;; https://github.com/practicalli/spacemacs.d/blob/live/init.el also pretty cool

  ;; ensure the lsp-mode package is installed
(use-package lsp-mode)
(use-package lsp-ui)
(use-package lsp-treemacs)
(use-package helm-lsp)

(add-hook 'clojure-mode-hook 'lsp)
(add-hook 'clojurescript-mode-hook 'lsp)
(add-hook 'clojurec-mode-hook 'lsp)

(setq gc-cons-threshold (* 100 1024 1024)
      read-process-output-max (* 1024 1024)
      treemacs-space-between-root-nodes nil
      lsp-headerline-breadcrumb-enable t
      company-idle-delay 0.2
      company-minimum-prefix-length 1
      ;; lsp-lens-enable t
      lsp-file-watch-threshold 10000
      lsp-signature-auto-activate nil
      lsp-clojure-custom-server-command '("/usr/local/bin/clojure-lsp")
      ;; I use clj-kondo from master
      lsp-diagnostics-provider :auto ; :none
      lsp-enable-indentation nil ;; uncomment to use cider indentation instead of lsp
      ;; lsp-enable-completion-at-point nil ;; uncomment to use cider completion instead of lsp
)

;;; This turns on lots of nice features
  
(setq
          ;; Formatting and indentation - use Cider instead
          lsp-enable-on-type-formatting t
          ;; Set to nil to use CIDER features instead of LSP UI
          lsp-enable-indentation t
          lsp-enable-snippet t  ;; to test again

          ;; symbol highlighting - `lsp-toggle-symbol-highlight` toggles highlighting
          ;; subtle highlighting for doom-gruvbox-light theme defined in dotspacemacs/user-config
          lsp-enable-symbol-highlighting t

          ;; Show lint error indicator in the mode line
          lsp-modeline-diagnostics-enable t
          ;; lsp-modeline-diagnostics-scope :workspace

          ;; popup documentation boxes
          ;; lsp-ui-doc-enable nil          ;; disable all doc popups
          lsp-ui-doc-show-with-cursor nil   ;; doc popup for cursor
          ;; lsp-ui-doc-show-with-mouse t   ;; doc popup for mouse
          ;; lsp-ui-doc-delay 2             ;; delay in seconds for popup to display
          lsp-ui-doc-include-signature t    ;; include function signature
          ;; lsp-ui-doc-position 'at-point  ;; positioning of doc popup: top bottom at-point
          lsp-ui-doc-alignment 'window      ;; relative location of doc popup: frame window

          lsp-ui-peek-enable t
          
          ;; code actions and diagnostics text as right-hand side of buffer
          lsp-ui-sideline-enable nil
          lsp-ui-sideline-show-code-actions nil
          ;; lsp-ui-sideline-delay 500

          ;; lsp-ui-sideline-show-diagnostics nil

          ;; reference count for functions (assume there maybe other lenses in future)
          lsp-lens-enable t

          ;; Efficient use of space in treemacs-lsp display
          treemacs-space-between-root-nodes nil

          ;; Optimization for large files
          lsp-file-watch-threshold 10000
          lsp-log-io nil)

;; ;; (use-package flycheck-clj-kondo
;; ;;   :ensure t)

;;; Is this needed?
  
;; (defun nomis/lsp-eldoc ()
;;   (unless (ignore-errors (cider-repls))
;;     (lsp-hover)))

;; (setq lsp-eldoc-hook '(nomis/lsp-eldoc))

;; then install the checker as soon as `clojure-mode' is loaded
(use-package clojure-mode
  :ensure t
  ;; :config
  ;; (require 'flycheck-clj-kondo)
  )

; (add-hook 'clojure-mode-hook 'flycheck-mode)

(require 'cider)


;; (setq nrepl-use-ssh-fallback-for-remote-hosts t)

;; (setq cider-known-endpoints
;;       '(("Auth"     "localhost" "6888")
;;         ("Exchange" "localhost" "5888")))

;; ;;; This gets us a cljs.user> repl.
;; (setq cider-default-cljs-repl 'oma)
;; (add-to-list 'cider-cljs-repl-types '(oma "(do (figwheel/cljs-repl \"admin\"))"))
;; (add-to-list 'cider-cljs-repl-types '(oms "(do (figwheel/cljs-repl \"shopping\"))"))

;; (setq nrepl-sync-request-timeout 20)

;(require 'turn-off-messaging)

(defun cider-recenter (&rest args)
  (interactive)
  (other-frame 1)
  (goto-char (point-max))
  (recenter -2)
  (other-frame -1))

(define-key cider-mode-map (kbd "s-e")
  #'(lambda () (interactive)
     (advice-add 'make-progress-reporter :override (lambda (&rest args)))
     (save-window-excursion (cider-insert-last-sexp-in-repl 1))
     (cider-recenter)
     (advice-remove 'make-progress-reporter (lambda (&rest args)))))

Rainbow delimiters

(require 'highlight-parentheses)
(add-hook 'emacs-lisp-mode-hook 'highlight-parentheses-mode)
(add-hook 'clojure-mode-hook 'highlight-parentheses-mode)
;; setting this to (t) turns off colors
(setq highlight-parentheses-colors '("green"))
(set-face-attribute 'hl-paren-face nil :inherit 'escape-glyph :weight 'ultra-bold :height 1.0)
(require 'paren)
(require 'rainbow-delimiters)
(add-hook 'emacs-lisp-mode-hook 'rainbow-delimiters-mode)
(add-hook 'clojure-mode-hook 'rainbow-delimiters-mode)
;; Here’s a nice opportunity for a little bit of design:
;; The color sequence corresponds to the colors I use for my first two Org Mode headings
(set-face-foreground 'rainbow-delimiters-depth-1-face "dodger blue")
(set-face-foreground 'rainbow-delimiters-depth-2-face "hot pink")
(set-face-foreground 'rainbow-delimiters-depth-3-face "dodger blue")
(set-face-foreground 'rainbow-delimiters-depth-4-face "hot pink")
(set-face-foreground 'rainbow-delimiters-depth-5-face "dodger blue")
(set-face-foreground 'rainbow-delimiters-depth-6-face "hot pink")
(set-face-foreground 'rainbow-delimiters-depth-7-face "dodger blue")
(set-face-foreground 'rainbow-delimiters-depth-8-face "hot pink")
(set-face-foreground 'rainbow-delimiters-depth-9-face "dodger blue")

Shell

(autoload 'ansi-color-for-comint-mode-on "ansi-color" nil t)
(add-hook 'shell-mode-hook 'ansi-color-for-comint-mode-on)

Tramp

(defun admin-tramp ()
  (interactive)
  (find-file "/scp:admin@54.91.30.218:/home/admin/"))

(defun new-server-tramp ()
  (interactive)
  (find-file "/scp:joe@198.74.56.39:/home/joe/"))

(defun hel-tramp ()
  (interactive)
  (find-file "/scp:root@85.159.211.210:/root/"))

(defun metameso-tramp ()
  (interactive)
  (find-file "/scp:root@178.79.174.58:/root/"))

(defun joe-tramp ()
  (interactive)
  (find-file "/scp:joe@178.79.174.58:/"))

Helm

(require 'helm-config)
(helm-mode 1)
(global-set-key (kbd "M-x") 'helm-M-x)
(global-set-key (kbd "\C-x \C-f") 'helm-find-files)
(global-set-key (kbd "C-h SPC") 'helm-all-mark-rings)

(setq helm-completion-style 'emacs)

;;; This is a nice option for making helm show up in a pop-up
;;; But I’m not totally sure I’m ready for that yet!

;; (setq helm-display-function 'helm-display-buffer-in-own-frame
;;       helm-display-buffer-reuse-frame t
;;       helm-use-undecorated-frame-option t)

(setq helm-display-header-line nil)
(set-face-attribute 'helm-source-header nil :height 0.1)
(set-face-attribute 'helm-source-header nil :foreground "gray10")
(helm-autoresize-mode 1)
(setq helm-autoresize-max-height 30)
(setq helm-autoresize-min-height 30)

(require 'helm-fd)
(setq helm-fd-executable "fdfind")

(require 'helm-ag)
(setq helm-ag-insert-at-point 'symbol)  ;; Standard search is with (kbd "s s"), populated by whatever is at point

(require 'helm-cider)
(helm-cider-mode 1)
(define-key cider-repl-mode-map (kbd "C-c C-r") #'helm-cider-repl-history)

;; https://github.com/emacs-helm/helm-org

;; helm-org-agenda-files-headings Allows searching in headings of all your org files.
;; helm-org-in-buffer-headings Allows searching in headings of current org buffer.
;; helm-org-parent-headings Find the parents heading of current heading.
;; helm-org-capture-templates Completion on org capture templates.

(require 'helm-org)
(define-prefix-command 'helm-org-map)
(global-set-key (kbd "C-c H") 'helm-org-map)
(define-key helm-org-map (kbd "a") 'helm-org-agenda-files-headings)
;; Note, this does not work inside source 
(define-key helm-org-map (kbd "b") 'helm-org-in-buffer-headings)

Projectile

(projectile-mode +1)
;(define-key projectile-mode-map (kbd "s-p") 'projectile-command-map)
(define-key projectile-mode-map (kbd "C-c p") 'projectile-command-map)

(defvar projectile-main-project "~/exp2exp.github.io/")

(defun use-main-project (&rest args)
  "Use `projectile-main-project' if no project is defined."
  (when projectile-main-project
    projectile-main-project))

(advice-add #'projectile-project-root :after-until #'use-main-project)

(defun projectile-grep-without-js (&optional regexp arg)
  (interactive "i\nP")
  (ignore-errors
    (let ((grep-find-ignored-files (append '("*.js" "*.json" "*.map"
                                             "*.css" "*.log" "*.txt"
                                             "*.jar" "*.png" "*.zip"
                                             "*.cpp" "*.h" "*.hpp"
                                             "*.py" "*.md" "*.m4"
                                             "*.gyp" "*.gyp.fontified" "*.gypi"
                                             "*.pdf" "*.jpg" "*.yml")
                                           grep-find-ignored-files))
          (grep-find-ignored-directories (append '("resources" "target") grep-find-ignored-directories)))
      (projectile-grep regexp arg))))

(define-key projectile-command-map (kbd "s j") #'projectile-grep-without-js)

Helm Projectile

;;; Helm Projectile

(require 'helm-projectile)
(helm-projectile-on)

;; search for something 'new'
(define-key projectile-command-map (kbd "s n") (lambda ()
                                                 (interactive)
                                                 (let ((helm-ag-insert-at-point nil))
                                                   (helm-projectile-ag))))

(defun namespace-to-file ()
  "Retrieve a file based on a Java-style namespace.
E.g., com.openmarkets.exchange.lib.data.graph produces
com/openmarkets/exchange/lib/data/graphs.clj."
  (interactive)
  (with-temp-buffer
   (insert thing)
   (message thing)
   (goto-char (point-min))
   (replace-string "." "/")
   (goto-char (point-min))
   (replace-string "-" "_")
   (buffer-substring-no-properties (point-min) (point-max))))

(defun helm-read-pattern-filter-args (args)
  (setcar (nthcdr 1 args) (namespace-to-file))
  args)

(define-key projectile-command-map (kbd "n")
  (lambda ()
    "Use `namespace-to-file' to jump to the file corresponding to namespace at point."
    (interactive)
    (let ((thing (thing-at-point 'symbol))
          (helm--maybe-use-default-as-input nil))
      (advice-add 'helm-read-pattern-maybe :filter-args #'helm-read-pattern-filter-args)
      (helm-projectile-find-file)
      (advice-remove 'helm-read-pattern-maybe #'helm-read-pattern-filter-args))))

(defun fix-projectile ()
  "Projectile might get confused due to the hacks above.
This fixes it."
  (interactive)
  (advice-remove 'helm-read-pattern-maybe #'helm-read-pattern-filter-args))

Multi-occur in matching buffers

(defun get-up ()
  (interactive)
  (multi-occur-in-matching-buffers "clj" "JAC"))

(defun multi-occur-get-regexp (regexp)
  (interactive "MRegexp: ")
  regexp)

(defun multi-occur-in-matching-buffers-filter-args (args)
  (list "clj" (call-interactively #'multi-occur-get-regexp)))

(defun multi-occur-clj ()
  "This wraps multi-occur-in-matching-buffers to search on clj(s) buffers only.
Cheap hack using advice because Emacs doesn't have an easy way to
curry interactive function calls."
  (interactive)
  ;; Supply arguments in another way
  (advice-add 'multi-occur-in-matching-buffers :filter-args #'multi-occur-in-matching-buffers-filter-args)
  ;; Compiler will complain about this but that’s OK
  (multi-occur-in-matching-buffers)
  (advice-remove 'multi-occur-in-matching-buffers #'multi-occur-in-matching-buffers-filter-args))

(global-set-key (kbd "s-o") #'multi-occur-clj)

Real-time editing

(load "crdt.el")

Silent writing

(require 'cl-lib)

(fset 'original-write-region (symbol-function 'write-region))
(defun silent-write-region (start end filename &optional append
                                  visit lockname mustbenew)
  "Suppress the \"Wrote file\" message in `write-region'."
  (original-write-region start end filename append 'nomsg lockname mustbenew))

;; (cl-letf (((symbol-function 'write-region) #'silent-write-region))
;;   (save-buffer (current-buffer))
;;   ;; take care of mtime changes
;;   (set-visited-file-modtime)
;;   (set-buffer-modified-p nil))

Recent Files

(recentf-mode 1)
(setq recentf-max-menu-items 250)
(setq recentf-max-saved-items 250)
(global-set-key "\C-x\ \C-r" 'helm-recentf)
(run-at-time nil (* 5 60) (lambda () (cl-letf (((symbol-function 'write-region) #'silent-write-region)) (recentf-save-list))))

Elfeed

(require 'elfeed)
(global-set-key (kbd "C-x w") 'elfeed)
;; Somewhere in your .emacs file
(setq elfeed-feeds
      '("https://sehkelly.tumblr.com/rss"
        "https://exp2exp.github.io/feed.xml"
        "https://hypothes.is/stream.atom?wildcard_uri=https://hyperreal.enterprises/*"
        "https://repo.or.cz/arxana.git/rss/refs/heads/mob"))

Autocompletion

(require 'ac-capf)
(require 'ac-cider)
(require 'bash-completion)
;(require 'bibtex-completion)

Github issues

;; (require 'github-issues)

PDF Tools

(use-package pdf-tools
 :pin manual ;; manually update
 :config
 ;; initialise
 (pdf-tools-install)
 ;; open pdfs scaled to fit page
 (setq-default pdf-view-display-size 'fit-page)
 ;; automatically annotate highlights
 (setq pdf-annot-activate-created-annotations t)
 ;; use normal isearch
 (define-key pdf-view-mode-map (kbd "C-s") 'isearch-forward)
 ;; turn off cua so copy works
 (add-hook 'pdf-view-mode-hook (lambda () (cua-mode 0)))
 ;; more fine-grained zooming
 (setq pdf-view-resize-factor 1.1)
 ;; keyboard shortcuts
 (define-key pdf-view-mode-map (kbd "h") 'pdf-annot-add-highlight-markup-annotation)
 (define-key pdf-view-mode-map (kbd "t") 'pdf-annot-add-text-annotation)
 (define-key pdf-view-mode-map (kbd "D") 'pdf-annot-delete))

(setq pdf-annot-list-format '((page . 3) (label . 24) (date . 24) (contents . 124)))

Hercules

;;; Hercules
(require 'hercules)
(setq which-key-popup-type 'minibuffer)

(defun help-evil-normal ()
  (interactive))
(global-set-key (kbd "<f2> n") 'help-evil-normal)

(hercules-def
 :toggle-funs #'help-evil-normal
 :keymap 'evil-normal-state-map
 :transient nil)

(defun help-evil-motion ()
  (interactive))
(global-set-key (kbd "<f2> m") 'help-evil-motion)

(hercules-def
 :toggle-funs #'help-evil-motion
 :keymap 'evil-motion-state-map
 :transient nil)

(defun help-evil-insert ()
  (interactive))
(global-set-key (kbd "<f2> i") 'help-evil-insert)

(hercules-def
 :toggle-funs #'help-scrum
 :keymap 'scrum-board-map
 :transient nil)

(defun help-scrum ()
  (interactive))
(global-set-key (kbd "<f2> s") 'help-scrum)

Global bindings

;;; Bindings
(global-set-key (kbd "H-m") (lambda () (interactive) (push-mark)))
(global-set-key (kbd "H-p") (lambda () (interactive) (pop-to-mark-command)))

(global-set-key (kbd "H-o") (lambda () (interactive) (multi-occur-in-matching-buffers "clj" )))

(global-set-key (kbd "C-<tab>") 'next-multiframe-window)

(global-set-key (kbd "C-z") (lambda () (interactive) (shell (get-buffer "*shell*"))))

(global-set-key (kbd "C-;") (lambda () (interactive) (cider-switch-to-repl-buffer)))

(global-set-key (kbd "C-<right>") 'forward-sexp)                                       ;; Go forward
(global-set-key (kbd "C-<left>") 'backward-sexp)                                       ;; Go backward

(defun go-up-and-right ()
  (interactive)
  (unwind-protect
      (condition-case top
          (up-list nil t)
        ('error (message "Can't go up from here")))))  ;; Go up and right

(global-set-key (kbd "C-<up>") #'go-up-and-right) 
(global-set-key (kbd "<next>")
                (lambda ()
                  (interactive)
                  (go-up-and-right)
                  (electric-newline-and-maybe-indent)
                  (indent-for-tab-command)))

(global-set-key (kbd "C-{") (lambda () (interactive)
                              (unwind-protect
                                  (condition-case top
                                      (progn (up-list nil t)
                                             (backward-sexp))
                                    ('error (message "Can't go up from here")))))) ;; Go up and left...

(global-set-key (kbd "H-<up>") (lambda () (interactive)
                                 (unwind-protect
                                     (condition-case top
                                         (up-list nil t)
                                       ('error (message "Can't go up from here"))))
                                 (backward-char)))                                     ;; Go *almost* up and right: end of this sexp

(global-set-key (kbd "H-{") (lambda () (interactive)
                              (unwind-protect
                                  (condition-case top
                                      (progn (up-list nil t)
                                             (backward-sexp)
                                             (forward-char 1))
                                    ('error (message "Can't go up from here")))))) ;; Go *almost* up and left: beginning of this sexp

(global-set-key (kbd "C-}") (lambda () (interactive) (up-list nil t) (kill-sexp -1)))   ;; Kill current sexp

(global-set-key (kbd "H-}") (lambda () (interactive)
                              (up-list nil t)
                              (save-excursion
                                (let ((end (point))
                                      (beg (progn (backward-sexp 1)
                                                  (point))))
                                  (delete-region beg end)))))                           ;; Delete current sexp

(global-set-key (kbd "<end>") (lambda () (interactive) (insert "()") (backward-char 1)))

(global-set-key (kbd "§") (lambda () (interactive)
                            (unwind-protect
                                (condition-case top
                                    (up-list nil t)
                                  ('error (message "Can't go up from here"))))))      ;; Go up and right (alt binding)
;; Should add a corresponding one for up-and-left

(defun indent-properly ()
  (interactive)
  (unwind-protect
      (condition-case top
          (let ((start (progn (beginning-of-defun) (point)))
                (end (progn (forward-sexp 1) (point))))
            (indent-region start end nil))
        ('error (message "Mismatched parens")))))

(global-set-key (kbd "S-<next>") #'indent-properly)      ;; Complete: go to top, also check that parens are balanced

(defun delete-something-here ()
  (interactive)
  (if (get-char-property (point) 'composition)
      (delete-region (point) (1+ (point)))
    (delete-forward-char 1)))
  
(global-set-key [delete] 'delete-something-here)

(global-set-key (kbd "<M-delete>") 'kill-word)
(global-set-key (kbd "<M-backspace>") (lambda () (interactive) (kill-word -1)))
(global-set-key (kbd "<C-delete>") 'kill-sexp)
(global-set-key (kbd "<C-backspace>") (lambda () (interactive) (kill-sexp -1)))

;; Fix some broken keys on my keyboard
(define-key global-map (kbd "M-M") (lambda () (interactive) (insert "m")))
(define-key global-map (kbd "M-m") (lambda () (interactive) (insert "M")))

Keyboard

(defun kinesis ()
  (interactive)
  (shell-command "xkbcomp /home/joe/kinesis.xkb $DISPLAY > /dev/null 2>&1"))

(defun mbp ()
  (interactive)
  (shell-command "xkbcomp /home/joe/mbp.xkb $DISPLAY > /dev/null 2>&1"))

Mouse

(defun disable-tap-to-click ()
 (interactive)
 (shell-command "gsettings set org.gnome.desktop.peripherals.touchpad tap-to-click false")
 )

Clean up after load

(defun switch-to-new-frame-at-start ()
  ; (switch-to-buffer-other-frame "*GNU Emacs*")
  ; (sleep-for 1)
  (kinesis)
  ; (delete-other-frames)
)
(add-hook 'after-init-hook #'switch-to-new-frame-at-start)

Demo SVG export

(setq org-preview-latex-process-alist
      '((dvipng :programs
                ("latex" "dvipng")
                :description "dvi > png" :message "you need to install the programs: latex and dvipng." :image-input-type "dvi" :image-output-type "png" :image-size-adjust
                (1.0 . 1.0)
                :latex-compiler
                ("latex -interaction nonstopmode -output-directory %o %f")
                :image-converter
                ("dvipng -D %D -T tight -o %O %f"))
        (dvisvgm :programs
                 ("latex" "/usr/local/texlive/2021/bin/x86_64-linux/dvisvgm")
                 :description "dvi > svg"
                 :message "you need to install the programs: latex and dvisvgm."
                 :image-input-type "dvi" :image-output-type "svg"
                 :image-size-adjust (1.7 . .1)
                 :latex-compiler
                 ("latex -interaction nonstopmode -output-directory %o %f")
                 :image-converter
                 ("/usr/local/texlive/2021/bin/x86_64-linux/dvisvgm %f -n -e -c %S -o %O"))
        (imagemagick :programs
                     ("latex" "convert")
                     :description "pdf > png" :message "you need to install the programs: latex and imagemagick." :image-input-type "pdf" :image-output-type "png" :image-size-adjust
                     (1.0 . 1.0)
                     :latex-compiler
                     ("pdflatex -interaction nonstopmode -output-directory %o %f")
                     :image-converter
                     ("convert -density %D -trim -antialias %f -quality 100 %O"))))

(with-eval-after-load 'ox-html
  (setq org-html-head
        (replace-regexp-in-string
         ".org-svg { width: 90%; }"
         ".org-svg { width: auto; }"
         org-html-style-default)))

Fix pdfview and org-noter

(require 'scroll-other-window)
(add-hook 'org-noter-notes-mode-hook #'sow-mode)
(setq org-noter--inhibit-location-change-handler t)

Hello Peeragogy

(require 'dash)
(require 's)

(defun insert-par-template ()
  (interactive)
  (let ((pos (point)))
    (-> (s-join "\n\n"
                '("**1. Review the intention: what do we expect to learn or make together?**"
                  "**2. Establish what is happening: what and how are we learning?**"
                  "**3. What are some different perspectives on what’s happening?**"
                  "**4. What did we learn or change?**"
                  "**5. What else should we change going forward?**"))
        (insert))
    (goto-char pos)))

Convenience

(defun uniquify-all-lines-region (start end)
  "Find duplicate lines in region START to END keeping first occurrence."
  (interactive "*r")
  (save-excursion
    (let ((end (copy-marker end)))
      (while
          (progn
            (goto-char start)
            (re-search-forward "^\\(.*\\)\n\\(\\(.*\n\\)*\\)\\1\n" end t))
        (replace-match "\\1\n\\2")))))

(defun uniquify-all-lines-buffer ()
  "Delete duplicate lines in buffer and keep first occurrence."
  (interactive "*")
  (uniquify-all-lines-region (point-min) (point-max)))

Lilypond

;; lilypond
(require 'lilypond-mode)
(setq LilyPond-lilypond-command "lilypond -I ~/lib/lilypond -I~/lib/openlilylib/snippets")

(autoload 'LilyPond-mode "lilypond-mode")
(setq auto-mode-alist
      (cons '("\\.ly$" . LilyPond-mode) auto-mode-alist))

(add-hook 'LilyPond-mode-hook (lambda () (turn-on-font-lock)))

(require 'ob-lilypond)

Hello User

;;;End load
(message "End load")
;; scroll-other-window.el --- Variable commands for scrolling the other window.
;; Copyright (C) 2016 Andreas Politz
;; Author: Andreas Politz <politza@fh-trier.de>
;; Keywords: extensions, frames
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;;; Code:
(defvar-local sow-scroll-up-command nil)
(defvar-local sow-scroll-down-command nil)
(defvar sow-mode-map
(let ((km (make-sparse-keymap)))
(define-key km [remap scroll-other-window] 'sow-scroll-other-window)
(define-key km [remap scroll-other-window-down] 'sow-scroll-other-window-down)
km)
"Keymap used for `sow-mode'")
(define-minor-mode sow-mode
"FIXME: Not documented."
nil nil nil
:global t)
(defun sow-scroll-other-window (&optional arg)
(interactive "P")
(sow--scroll-other-window-1 arg))
(defun sow-scroll-other-window-down (&optional arg)
(interactive "P")
(sow--scroll-other-window-1 arg t))
(defun sow--scroll-other-window-1 (n &optional down-p)
(let* ((win (other-window-for-scrolling))
(cmd (with-current-buffer (window-buffer win)
(if down-p
(or sow-scroll-down-command #'scroll-up-command)
(or sow-scroll-up-command #'scroll-down-command)))))
(with-current-buffer (window-buffer win)
(save-excursion
(goto-char (window-point win))
(with-selected-window win
(funcall cmd n))
(set-window-point win (point))))))
(add-hook 'Info-mode-hook
(lambda nil
(setq sow-scroll-up-command
(lambda (_) (Info-scroll-up))
sow-scroll-down-command
(lambda (_) (Info-scroll-down)))))
(add-hook 'doc-view-mode-hook
(lambda nil
(setq sow-scroll-up-command
'doc-view-scroll-up-or-next-page
sow-scroll-down-command
'doc-view-scroll-down-or-previous-page)))
(add-hook 'pdf-view-mode-hook
(lambda nil
(setq sow-scroll-up-command
'pdf-view-scroll-up-or-next-page
sow-scroll-down-command
'pdf-view-scroll-down-or-previous-page)))
(provide 'scroll-other-window)
;;; scroll-other-window.el ends here
;;; window-margin.el --- automatic margins for visual-line-mode wrapping
;; Copyright (C) 2012 by Aaron Culich
;; Maintainer: Aaron Culich <aculich@gmail.com>
;; Version: 0.1
;; Keywords: margins, text, visual-line, word wrap
;; URL: http://github.com/aculich/window-margin.el
;; Description: automatic margins for visual-line-mode wrapping
;; This file is not part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This minor mode will automatically resize windows to the width of
;; the fill-column, or optionally to some fixed size set with the
;; window-margin-width variable.
;;
;; To enable it with text-mode use:
;;
;; (add-hook 'text-mode-hook 'turn-on-window-margin-mode)
;;
;; This minor mode was inspired by reading an entry on StackOverflow
;;
;; http://stackoverflow.com/q/14009223/462302
;;
;; when I discovered that (the quirky, but useful) longlines-mode was
;; being discontinued. I can't claim that this mode will be any less
;; quirky (probably moreso at this early 0.1 release), but it makes
;; use of margins and visual-line mode which is better way to
;; accomplish the effect than implemented by longlines-mode
;;; Code:
(defgroup window-margin nil
"Restrict visual width of window using margins for `visual-line-mode'."
:group 'visual-line
:version "24.2.0")
(defvar window-margin-width nil
"Restrict visual width of window using margins for `visual-line-mode'.
If non-nil use value of `fill-column'; if an integer, that number of
columns; if a positive floating-point number, that percentage of the
frame width; if a negative floating-point number, that number negated
and multiplied by `fill-column' (useful for variable-pitch fonts).")
(make-local-variable 'window-margin-width)
(setq-default window-margin-width nil)
(defcustom window-margin-mode-line-string " Margin"
"String displayed on the modeline when window-margin is active.
Set this to nil if you don't want a modeline indicator."
:group 'window-margin
:type '(choice string (const :tag "None" nil)))
;;;###autoload
(define-minor-mode window-margin-mode
"Restrict visual width of window using margins for `visual-line-mode'.
With a prefix argument ARG, enable Window Margin mode if ARG is
positive, and disable it otherwise. If called from Lisp, enable
the mode if ARG is omitted or nil.
When Window Margin mode is enabled, the visual width of windows
will be restricted using margins in `visual-line-mode' (which
will also be turned on for the selected buffer).
"
:lighter window-margin-mode-line-string
:group 'window-margin
(if window-margin-mode
(progn
(unless window-margin-width
(setq window-margin-width t))
(add-hook 'window-configuration-change-hook 'window-margin-update t t)
(turn-on-visual-line-mode)
(window-margin-update))
(progn
(setq window-margin-width nil)
(remove-hook 'window-configuration-change-hook 'window-margin-update t)
(set-window-margins (get-buffer-window) nil nil))))
;;;###autoload
(defun turn-on-window-margin-mode ()
(window-margin-mode 1))
(custom-add-option 'text-mode-hook 'turn-on-window-margin-mode)
;;;###autoload
(defun turn-off-window-margin-mode ()
(window-margin-mode -1))
(defun window-margin-update ()
(let* ((window-configuration-change-hook
(remove 'window-margin-update window-configuration-change-hook))
(window (selected-window))
(buffer-width
(cond ((integerp window-margin-width)
window-margin-width)
((floatp window-margin-width)
(if (< 0 window-margin-width) window-margin-width
(floor (* (or fill-column 80) (- window-margin-width)))))
((and window-margin-width)
(or fill-column nil))
(t 80))))
(unless (active-minibuffer-window)
(set-window-margins window nil nil)
(if (window-at-side-p window 'right)
(let ((rm (+ (- (window-total-width) buffer-width)
(- (window-body-width) (window-total-width) 1))))
(when (> rm 0)
(set-window-margins window nil rm)))
(let ((window-delta (+ (- buffer-width (window-total-width))
(- (window-total-width) (window-body-width))
1)))
(window-resize window window-delta t))))))
(defadvice set-fill-column (after window-margin-update activate)
(window-margin-update))
(provide 'window-margin)
;;; window-margin.el ends here
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment