(let ((data '(("Color" "Name" "Symbol" "Hex Code") ("Adwaita Dark Background (Original)" "" "" "#29353b") ("Adwaita Dark Background (Darker)" "" "" "#19252b") ("Adwaita Dark Background (Darkest)" "" "color-background" "#09151b") ("White Foreground" "" "color-foreground" "#bbc2cf") ("White Foreground Accent" "" "" "#798188") ("Yellow Cursor" "" "color-cursor" "#eeee22") ("Bright Yellow Highlight" "" "color-paren" "#ffff33") ("White Mouse" "" "color-mouse" "#ffffff") ("Outline Level 1" "goldenrod" "color-1" "#daa520") ("Outline Level 2" "light goldenrod" "color-2" "#eedd82") ("Outline Level 3" "yellow green" "color-3" "#9acd32") ("Outline Level 4" "light salmon" "color-4" "#ffa07a") ("Outline Level 5" "tan" "color-5" "#d2b48c") ("Outline Level 6" "light green" "color-6" "#90ee90") ("Outline Level 7" "coral" "color-7" "#ff7f50") ("Outline Level 8" "wheat" "color-8" "#f5deb3"))))
(mapc (lambda (x)
(let ((color (caddr x))
(value (cadddr x)))
(when (> (length color) 0)
(set (intern color) value))))
(cdr data))
)
(defun message--with-timestamp (format-string &rest args)
"Add timestamps to `*Messages*' buffer."
(when (and (> (length format-string) 0)
(not (string= format-string " ")))
(let ((deactivate-mark nil))
(save-mark-and-excursion
(with-current-buffer "*Messages*"
(let ((inhibit-read-only t))
(goto-char (point-max))
(unless (bolp) (newline))
(insert (format-time-string "[%T] " (current-time)))))))))
(advice-add 'message :before #'message--with-timestamp)
(defvar init-message-timestamp nil
"Timestamp used to track time between `init-message' calls.")
(setq init-message-timestamp (current-time))
(defun init-message (level format-string &rest args)
"Custom version of `message' to log messages during Emacs initialization.
LEVEL is the indentation level."
(let ((file (file-name-sans-extension
(file-name-nondirectory
(or load-file-name buffer-file-name (buffer-name)))))
(time (* (float-time (time-subtract (current-time) init-message-timestamp))
1000.0)))
(message (concat (format "[%4d] " time)
file " "
(make-string (* 2 level) ?-) "> "
(format format-string args) " "))
(setq init-message-timestamp (current-time))))
(init-message 2 "Start: Status Messages")
(defun emacs-startup-hook--message-startup-time ()
"Message the Emacs startup time and number of garbage collections."
(message "Emacs startup time: %.2f seconds"
(float-time (time-subtract after-init-time before-init-time)))
(message "Emacs startup garbage collections: %d" gcs-done))
(add-hook 'emacs-startup-hook #'emacs-startup-hook--message-startup-time)
(setq gc-cons-threshold (* 8 1024 1024))
(defun advice--ignore-all-errors (orig-fun &rest args)
"Ignore errors when calling ORIG-FUN with ARGS."
(ignore-errors
(apply orig-fun args)))
(defun advice--ignore-interactive-errors (orig-fun &rest args)
"Ignore errors when interactively calling ORIG-FUN with ARGS."
(condition-case err
(apply orig-fun args)
('error
(if (called-interactively-p 'any)
(message "%s" err)
(error err)))))
(defmacro when-lock-file-acquired (lock-file &rest body)
"Evaluate BODY unless another running Emacs instance has done so.
LOCK-FILE is a file name to be used as a lock for this BODY code.
Skips checks if run on Windows or Mac."
(declare (indent 1))
(let ((procdir (gensym "procdir")))
`(let ((,procdir (format "/proc/%d" (emacs-pid))))
(unless (or (string= system-type "windows-nt")
(string= system-type "darwin")
(file-exists-p ,lock-file))
(make-symbolic-link ,procdir ,lock-file t))
(when (or (string= system-type "windows-nt")
(string= system-type "darwin")
(file-equal-p ,lock-file ,procdir))
,@body))))
(init-message 1 "Package Manager")
(init-message 2 "Package Manager: Straight")
(require 'package)
(setq package-archives '(("elpa" . "https://elpa.gnu.org/packages/")
("nongnu" . "https://elpa.nongnu.org/nongnu/"))
native-comp-async-report-warnings-errors nil)
(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))
(straight-use-package 'use-package)
(setq straight-check-for-modifications '(find-when-checking check-on-save))
(init-message 1 "Environment")
(init-message 2 "Environment: Init Packages")
(use-package async
:straight t)
(use-package bind-key
:straight t
:custom
(bind-key-describe-special-forms t))
(use-package cl-generic
:straight (:type built-in))
(use-package cl-macs
:straight (:type built-in))
(use-package dash
:straight t
:demand t)
(use-package diminish
:straight (diminish
:type git
:host github
:repo "myrjola/diminish.el"))
(use-package f
:straight t
:demand t)
(use-package s
:straight t
:demand t)
(use-package seq
:straight (:type built-in))
(use-package subr-x
:straight (:type built-in))
(use-package org
:straight (:type built-in))
(use-package org-table
:straight (:type built-in))
(use-package ob-tangle
:straight (:type built-in))
(use-package ox
:straight (:type built-in))
(init-message 2 "Environment: Environment")
(prefer-coding-system 'utf-8)
(set-language-environment 'utf-8)
(set-default-coding-systems 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-selection-coding-system 'utf-8)
(set-keyboard-coding-system 'utf-8)
(setenv "TZ" "America/Chicago")
(defconst window-system-windows
(string= window-system "w32")
"Non-nil if running on a MS-Windows display.")
(defconst window-system-mac
(string= window-system "ns")
"Non-nil if running on a Macintosh GNUstep or Cocoa display.")
(defconst window-system-linux
(string= window-system "x")
"Non-nil if running on a Linux X display.")
(defconst work-system
(file-exists-p "~/.work")
"Non-nil if running on a work system.")
(cd "~")
(setq shell-file-name (or (getenv "SHELL") "/bin/bash")
shell-command-switch "-c"
explicit-shell-file-name shell-file-name
explicit-sh-args '("-login" "-i"))
(when window-system-windows
(defvar w32-quote-process-args ?\"
"Windows quote arguments."))
(when window-system-mac
(add-to-list 'exec-path "/usr/local/sbin")
(add-to-list 'exec-path "/usr/local/bin"))
(setq print-length nil
print-level nil
eval-expression-print-length nil
eval-expression-print-level nil)
(init-message 2 "Environment: Global Variables")
(defconst emacs-home-dir
(file-truename (expand-file-name "~/.emacs.d"))
"Emacs configuration home directory.")
(defmacro emacs-home-sub-dir (dir)
"Return expanded directory name of DIR if found as a
sub-directory of `emacs-home-dir', or just `emacs-home-dir'
otherwise."
`(let ((file (expand-file-name ,dir emacs-home-dir)))
(if (file-exists-p file)
(file-truename file)
emacs-home-dir)))
(defconst emacs-modules-dir
(emacs-home-sub-dir "modules")
"Emacs modules directory.")
(defconst local-modules-dir
(emacs-home-sub-dir "local-modules")
"Emacs local modules directory.")
(defconst local-work-modules-dir
(emacs-home-sub-dir "local-work-modules")
"Emacs local work modules directory.")
(defconst customization-file
(file-truename (expand-file-name "customization.el" emacs-home-dir))
"Emacs customization file.")
(setq custom-file customization-file)
(defconst init-emacs-true-file-name
(file-truename (expand-file-name "init-emacs.org" emacs-home-dir))
"The true file name of this buffer.")
(defconst user-name "kyle")
(defconst user-full-name "Kyle W T Sherman")
(defconst user-short-name "Kyle Sherman")
(defconst user-first-name "Kyle")
(defconst user-last-name "Sherman")
(defconst user-mail-address
(if (getenv "EMAIL")
(getenv "EMAIL")
(concat "kyle" "w" "sherman" "@" "gmail" "." "com"))
"User email address.")
(defconst user-mail-address-nospam
(replace-regexp-in-string "\\." " dot "
(replace-regexp-in-string "@" " at " user-mail-address))
"Slightly obfuscated user email address.")
(defun signature (&optional fortune)
"Return a signature.
A fortune is added if FORTUNE is non-nil."
(let ((name (or user-short-name user-full-name))
(mail user-mail-address))
(let ((sig (if (and name mail)
(concat name " <" mail ">")
(if name
name
mail))))
(concat (if sig sig "")
(if (and sig fortune) "\n\n" "")
(if fortune
(shell-command-to-string
(concat "fortune -a "
(shell-quote-argument (expand-file-name "~/quotes"))
" | xargs echo -n"))
"")))))
(init-message 2 "Environment: Load Path")
(when (file-exists-p local-modules-dir)
(add-to-list 'load-path local-modules-dir))
(when (file-exists-p emacs-modules-dir)
(add-to-list 'load-path emacs-modules-dir))
(when window-system
(init-message 3 "Environment: GUI: General")
(unless (fboundp 'gui-selection-value)
(defalias 'gui-selection-value 'x-cut-buffer-or-selection-value))
(when (string= window-system "x")
(setq select-enable-clipboard t select-enable-primary t x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING) save-interprogram-paste-before-kill t mouse-yank-at-point t interprogram-paste-function 'gui-selection-value) (setq-default select-enable-clipboard select-enable-clipboard
select-enable-primary select-enable-primary
x-select-request-type x-select-request-type
save-interprogram-paste-before-kill save-interprogram-paste-before-kill
mouse-yank-at-point mouse-yank-at-point))
(setq inverse-video t)
(setq-default inverse-video inverse-video)
(setq visible-bell t)
(setq-default visible-bell visible-bell)
(setq ring-bell-function 'ignore)
(blink-cursor-mode 0)
(setq x-stretch-cursor t)
(when (fboundp 'scroll-bar-mode)
(scroll-bar-mode -1))
(when (and (fboundp 'tool-bar-mode)
tool-bar-mode)
(tool-bar-mode -1))
(setq frame-resize-pixelwise t)
(setq frame-title-format "%b")
(bind-keys* ([vertical-scroll-bar down-mouse-1] . scroll-bar-drag))
(setq mouse-wheel-scroll-amount '(1 ((shift) . 1))
mouse-wheel-progressive-speed t)
(init-message 3 "Environment: GUI: Font")
(cl-labels
((set-font (font)
(set-face-attribute 'default nil :font font)
(set-face-attribute 'fixed-pitch nil :font font)
(set-face-attribute 'variable-pitch nil :font font)))
(cl-case window-system
(x
(condition-case nil
(set-font
(cond
((x-list-fonts "MesloLGS Nerd Font") "MesloLGS Nerd Font Mono-14")
((x-list-fonts "Dejavu Sans") "Dejavu Sans Mono-14")
((x-list-fonts "Hack Nerd Font") "Hack Nerd Font Mono-14")
((x-list-fonts "DroidSansMono Nerd Font") "DroidSansMono Nerd Font Mono-14")
((x-list-fonts "Fira Code") "Fira Code Mono-14")
(t
"9x15" nil)))
('error
(set-font "9x15"))))
(w32
(condition-case nil
(set-font "Hack Nerd Font Mono-14")
('error
nil)))
(ns
(condition-case nil
(set-font "Hack Nerd Font Mono-14")
('error
(set-font "Menlo"))))))
(init-message 3 "Environment: GUI: Faces")
(defvar background-alpha
100
"Background transparency alpha percentage.
Common values:
100 = none
90 = 10% transparency
85 = 15% transparency
80 = 20% transparency")
(setq background-alpha (if (or window-system-mac window-system-windows)
100 85)) (set-frame-parameter (selected-frame) 'alpha background-alpha)
(add-to-list 'default-frame-alist (cons 'alpha background-alpha))
(set-mouse-color color-mouse)
(init-message 3 "Environment: GUI: Modus Themes")
(use-package modus-themes
:straight (:type built-in)
:demand t
:bind ("<f2>" . modus-themes-toggle)
:init
(setq modus-themes-italic-constructs t
modus-themes-bold-constructs nil
modus-themes-mixed-fonts nil
modus-themes-subtle-line-numbers nil
modus-themes-intense-mouseovers nil
modus-themes-deuteranopia t
modus-themes-tabs-accented t
modus-themes-variable-pitch-ui nil
modus-themes-inhibit-reload t modus-themes-fringes nil
modus-themes-lang-checkers nil
modus-themes-mode-line '(accented borderless (padding . 4) (height . 0.9))
modus-themes-markup '(background italic)
modus-themes-syntax '(alt-syntax faint green-strings yellow-comments)
modus-themes-hl-line '(intense)
modus-themes-paren-match '(bold intense)
modus-themes-links '(neutral-underline background)
modus-themes-box-buttons '(variable-pitch flat faint 0.9)
modus-themes-prompts '(intense bold)
modus-themes-completions '((matches . (extrabold))
(selection . (semibold accented))
(popup . (accented intense)))
modus-themes-mail-citations nil
modus-themes-region nil
modus-themes-diffs 'desaturated
modus-themes-org-blocks nil
modus-themes-org-agenda '((header-block . (variable-pitch 1.3))
(header-date . (grayscale workaholic bold-today 1.1))
(event . (accented varied))
(scheduled . uniform)
(habit . traffic-light))
modus-themes-headings '((t . ()))
modus-themes-vivendi-color-overrides `((bg-main . ,color-background)
(fg-main . ,color-foreground)))
(load-theme 'modus-vivendi :no-error)
:config
(modus-themes-load-vivendi))
)
(init-message 2 "Environment: General")
(setq inhibit-startup-screen t)
(setq load-prefer-newer t)
(when (and (fboundp 'menu-bar-mode)
menu-bar-mode)
(menu-bar-mode -1))
(setq initial-major-mode 'org-mode)
(setq initial-scratch-message nil)
(normal-erase-is-backspace-mode 1)
(modify-syntax-entry ?_ "w")
(modify-syntax-entry ?- "w")
(global-subword-mode 1)
(setq open-paren-in-column-0-is-defun-start nil
defun-prompt-regexp nil)
(setq parse-sexp-ignore-comments t)
(setq-default parse-sexp-ignore-comments parse-sexp-ignore-comments)
(setq truncate-lines t)
(setq-default truncate-lines truncate-lines)
(toggle-truncate-lines 1)
(turn-off-auto-fill)
(global-visual-line-mode -1)
(setq visual-line-fringe-indicators '(left-curly-arrow right-curly-arrow))
(setq display-line-numbers-type 'relative)
(setq next-line-add-newlines nil)
(setq scroll-preserve-screen-position 'keep)
(setq scroll-step 1)
(setq scroll-conservatively 101)
(setq scroll-margin 2)
(setq auto-window-vscroll nil)
(setq case-fold-search t)
(setq search-highlight nil
query-replace-highlight nil)
(transient-mark-mode 1)
(setq-default transient-mark-mode transient-mark-mode)
(setq indent-tabs-mode nil tab-width 4 standard-indent 4 tab-always-indent 'complete tab-stop-list (number-sequence 4 180 4)) (setq-default indent-tabs-mode indent-tabs-mode
tab-width tab-width
standard-indent standard-indent
tab-always-indent tab-always-indent
tab-stop-list tab-stop-list)
(defconst custom-fill-column 78
"Custom `fill-column' value.")
(setq fill-column custom-fill-column)
(setq-default fill-column fill-column)
(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode)
(setq comment-column 40)
(setq-default comment-column comment-column)
(setq comment-fill-column nil)
(setq-default comment-fill-column comment-fill-column)
(put 'set-goal-column 'disabled nil)
(setq sentence-end-double-space nil)
(setq colon-double-space nil)
(show-paren-mode 1)
(set-face-foreground 'show-paren-match color-paren)
(set-face-attribute 'show-paren-match nil :weight 'extra-bold)
(setq highlight-tabs t)
(setq-default highlight-tabs highlight-tabs)
(setq whitespace-style '(face trailing tab-mark))
(custom-set-faces `(whitespace-tab ((t (:foreground ,color-foreground :background ,color-background)))))
(setq whitespace-display-mappings
'((space-mark 32 [183] [46]) (newline-mark 10 [182 10]) (tab-mark 9 [9655 9] [92 9]))) (global-whitespace-mode 1)
(hl-line-mode 1)
(global-hl-line-mode 1)
(global-font-lock-mode 1)
(setq font-lock-maximum-decoration t)
(delete-selection-mode 1)
(setq comment-style 'indent)
(setq enable-recursive-minibuffers t)
(minibuffer-depth-indicate-mode 1)
(setq apropos-do-all t)
(setq apropos-sort-by-scores t
apropos-documentation-sort-by-scores t)
(setq custom-unlispify-menu-entries nil
custom-unlispify-tag-names nil)
(setq-default custom-unlispify-menu-entries custom-unlispify-menu-entries
custom-unlispify-tag-names custom-unlispify-tag-names)
(setq grep-command "grep -n -H -i -r -e ")
(setq mail-sources `((pop :server "pop.gmail.com" :port 995
:user ,user-mail-address
:connection ssl :leave t)))
(setq browse-url-browser-function #'browse-url-firefox
browse-url-new-window-flag t
browse-url-firefox-new-window-is-tab t)
(setq browse-url-secondary-browser-function #'browse-url-default-browser)
(setq delete-active-region t)
(defun occur-mode-goto-occurrence--recenter (&optional arg)
"Recenter when an `occur' result is selected."
(recenter))
(advice-add 'occur-mode-goto-occurrence :after #'occur-mode-goto-occurrence--recenter)
(setq display-time-world-list
'(("Etc/UTC" "UTC")
("America/Los_Angeles" "San Diego")
("America/Chicago" "Minneapolis")
("America/New_York" "New York")
("Etc/GMT" "GMT")
("Europe/London" "London")
("Europe/Paris" "Paris")
("Asia/Tokyo" "Tokyo")))
(init-message 2 "Environment: System")
(setq max-specpdl-size 10000)
(setq max-lisp-eval-depth 10000)
(setq message-log-max 10000)
(setq history-length 250)
(setq history-delete-duplicates t)
(setq kill-ring-max 100)
(setq mark-ring-max 32)
(setq use-short-answers t)
(put 'upcase-region 'disabled nil)
(put 'downcase-region 'disabled nil)
(put 'narrow-to-region 'disabled nil)
(setq disabled-command-function nil)
(setq bidi-paragraph-direction 'left-to-right)
(setq-default bidi-paragraph-direction bidi-paragraph-direction)
(when (version<= "27.1" emacs-version)
(setq bidi-inhibit-bpa t))
(when (version<= "27.1" emacs-version)
(global-so-long-mode 1))
(setq ad-redefinition-action 'accept)
(setq-default ad-redefinition-action ad-redefinition-action)
(init-message 2 "Environment: Files")
(init-message 3 "Environment: Files: General")
(use-package files
:straight (:type built-in)
:custom
(make-backup-files nil)
(backup-inhibited t)
(find-file-existing-other-name t)
(require-final-newline t)
(auto-save-default nil)
(auto-save-list-file-prefix nil)
(delete-auto-save-files t)
(enable-local-variables t)
(enable-dir-local-variables t)
(enable-local-eval 'maybe)
(large-file-warning-threshold (* 50 1000 1000))
(backup-directory-alist `(("." . ,temporary-file-directory)))
(kill-emacs-query-functions
(cons (lambda () (yes-or-no-p "Really kill Emacs? "))
kill-emacs-query-functions)))
(add-to-list 'safe-local-variable-values '(org-babel-noweb-wrap-start . "{{"))
(add-to-list 'safe-local-variable-values '(org-babel-noweb-wrap-end . "}}"))
(defun create-buffer-file-name-directory-if-needed ()
"Create `buffer-file-name' directory if it does not already exist."
(when (and buffer-file-name
(not (file-exists-p (file-name-directory buffer-file-name))))
(make-directory (file-name-directory buffer-file-name) t)))
(add-hook 'before-save-hook #'create-buffer-file-name-directory-if-needed)
(setq delete-trailing-lines t)
(defun delete-trailing-whitespace-if-not-read-only (&optional beg end)
"Call `delete-trailing-whitespace' if current buffer is not read-only."
(interactive (if (use-region-p)
(list (region-beginning) (region-end))
(list nil nil)))
(unless buffer-read-only
(delete-trailing-whitespace beg end)))
(add-hook 'before-save-hook #'delete-trailing-whitespace-if-not-read-only)
(when (fboundp 'executable-make-buffer-file-executable-if-script-p)
(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p))
(add-to-list 'file-coding-system-alist '("\\.ASM\\'" . dos))
(add-to-list 'file-coding-system-alist '("\\.BAT\\'" . dos))
(add-to-list 'file-coding-system-alist '("\\.DO\\'" . dos))
(add-to-list 'file-coding-system-alist '("\\.SYS\\'" . dos))
(init-message 3 "Environment: Files: Version Control")
(use-package vc-hooks
:straight (:type built-in)
:custom
(vc-follow-symlinks t)
(vc-handled-backends nil))
(init-message 3 "Environment: Files: Compression")
(use-package jka-cmpr-hook
:straight (:type built-in)
:custom
(auto-compression-mode t))
(init-message 3 "Environment: Files: Auto-Revert")
(use-package autorevert
:straight (:type built-in)
:custom
(global-auto-revert-mode 1))
(init-message 3 "Environment: Files: Bookmark")
(use-package bookmark
:straight (:type built-in)
:custom
(bookmark-save-flag 1))
(init-message 3 "Environment: Files: Desktop")
(use-package desktop
:straight (:type built-in)
:custom
(desktop-dirname user-emacs-directory)
(desktop-save 'ask-if-new)
(desktop-load-locked-desktop 'check-pid)
(desktop-restore-eager 0) (desktop-buffers-not-to-save (concat "\\("
"\\.log\\|(ftp)\\|^tags\\|^TAGS"
"\\.diary\\|\\diary\\|\\.bbdb"
"\\)$"))
:init
(desktop-save-mode 1)
(add-to-list 'desktop-globals-to-save 'file-name-history t)
(add-to-list 'desktop-modes-not-to-save 'Info-mode t)
(add-to-list 'desktop-modes-not-to-save 'info-lookup-mode t))
(init-message 3 "Environment: Files: Minibuffer History")
(use-package savehist
:straight (:type built-in)
:custom
(savehist-save-minibuffer-history 1)
(savehist-additional-variables '(search-ring regexp-search-ring))
:init
(when (fboundp 'savehist-mode)
(when-lock-file-acquired (expand-file-name "emacs-minibuffer-history-lock-file"
temporary-file-directory)
(savehist-mode 1))))
(init-message 2 "Environment: Buffers and Windows")
(when (fboundp 'winner-mode)
(winner-mode 1))
(setq jit-lock-defer-time 0.05)
(setq switch-to-buffer-preserve-window-point t)
(setq mouse-wheel-scroll-amount '(1 ((shift) . 5) ((control))))
(setq max-mini-window-height 0.50)
(init-message 2 "Environment: Tabs")
(defvar custom-tab-width 4
"Regular tab width.")
(defvar custom-short-tab-width 2
"Short tab width used for certain modes.")
(defun set-tabs (enable &optional width)
"Set default tab settings.
If ENABLED is non-nil, enable TAB characters.
Otherwise, disable TAB characters.
If WIDTH is given, it is used to set the TAB width.
Otherwise, `custom-tab-width' is used."
(let ((width (or width custom-tab-width)))
(setq indent-tabs-mode enable tab-width width standard-indent width tab-always-indent 'complete tab-stop-list (number-sequence width 180 width) backward-delete-char-untabify-method nil)))
(defun disable-tabs (&optional width)
"Disable TAB character usage, using WIDTH if given."
(set-tabs nil width))
(defun enable-tabs (&optional width)
"Enable TAB character usage, using WIDTH if given."
(set-tabs t width))
(defun enable-tabs-4 ()
"Enable TAB character usage with a width of 4 spaces."
(set-tabs t 4))
(defun enable-tabs-8 ()
"Enable TAB character usage with a width of 8 spaces."
(set-tabs t 8))
(init-message 2 "Environment: Terminals")
(init-message 3 "Environment: Terminals: Configuration")
(setq custom-terminal-history-size 10000
custom-terminal-maximum-lines 10000)
(init-message 3 "Environment: Terminals: eshell")
(defun custom-eshell-first-time-mode-hook ()
(add-hook 'eshell-pre-command-hook #'eshell-save-some-history)
(add-to-list 'eshell-output-filter-functions #'eshell-truncate-buffer))
(use-package eshell
:straight (:type built-in)
:hook (eshell-first-time-mode . custom-eshell-first-time-mode-hook)
:custom
(eshell-history-size custom-terminal-history-size)
(eshell-buffer-maximum-lines custom-terminal-maximum-lines)
(eshell-hist-ignoredups t)
(eshell-scroll-to-bottom-on-input t)
:config
(setenv "PAGER" "cat")
(with-eval-after-load "esh-opt"
(setq eshell-destroy-buffer-when-process-dies t
eshell-visual-commands '("htop" "ssh" "vim" "zsh"))))
(use-package eshell-git-prompt
:straight t
:after (eshell)
:config
(eshell-git-prompt-use-theme 'powerline))
(init-message 3 "Environment: Terminals: term-bash")
(defun term-bash ()
"Start a BASH terminal-emulator in a new buffer."
(interactive)
(term "/bin/bash"))
(init-message 3 "Environment: Terminals: term-zsh")
(defun term-zsh ()
"Start a ZSH terminal-emulator in a new buffer."
(interactive)
(term "/bin/zsh"))
(init-message 2 "Environment: Bookmarks")
(init-message 1 "Key Bindings")
(init-message 2 "Key Bindings: System Keys")
(defun custom-key-bindings-system-keys ()
"Set custom system key bindings."
(cond
(window-system-mac
(when (fboundp 'new-scratch)
(bind-keys* ("s-t" . new-scratch))))
((or window-system-linux window-system-windows)
(if (fboundp 'kill-region-or-word)
(bind-keys* ("s-x" . kill-region-or-word))
(bind-keys* ("s-x" . kill-region)))
(bind-keys* ("s-c" . kill-ring-save))
(bind-keys* ("s-v" . yank))
(bind-keys* ("s-z" . undo))
(when (fboundp 'undo-tree-redo)
(bind-keys* ("s-y" . undo-tree-redo)))
(bind-keys* ("s-a" . mark-whole-buffer))
(bind-keys* ("s-f" . isearch-forward))
(bind-keys* ("s-g" . isearch-forward))
(bind-keys* ("s-r" . isearch-backward))
(bind-keys* ("s-o" . find-file))
(bind-keys* ("s-p" . print-buffer))
(if (fboundp 'save-buffer-always)
(bind-keys* ("s-s" . save-buffer-always))
(bind-keys* ("s-s" . save-buffer)))
(when (fboundp 'new-scratch)
(bind-keys* ("s-t" . new-scratch)))
(bind-keys* ("s-w" . kill-current-buffer))
(bind-keys* ("s-SPC" . set-mark-command)))))
(init-message 3 "custom-key-bindings-system-keys")
(custom-key-bindings-system-keys)
(init-message 2 "Key Bindings: Function Keys")
(defun custom-key-bindings-function-keys ()
"Set custom function key bindings."
(when (fboundp 'help-for-help)
(bind-keys ("<f1>" . help-for-help)))
(when (fboundp 'help-command)
(bind-keys ("S-<f1>" . help-command)))
(when (fboundp 'kmacro-start-macro-or-insert-counter)
(bind-keys ("<f3>" . kmacro-start-macro-or-insert-counter))) (when (fboundp 'kmacro-end-or-call-macro)
(bind-keys ("<f4>" . kmacro-end-or-call-macro))) (when (fboundp 'define-word-at-point-after-spell-check)
(bind-keys ("<f5>" . define-word-at-point-after-spell-check)))
(when (fboundp 'define-word-after-spell-check)
(bind-keys ("S-<f5>" . define-word-after-spell-check)))
(when (fboundp 'web-query-symbol-by-mode-at-point)
(bind-keys ("<f7>" . web-query-symbol-by-mode-at-point)))
(when (fboundp 'web-query)
(bind-keys ("<S-f7>" . web-query)))
(when (fboundp 'neotree)
(bind-keys ("<f8>" . neotree)))
(when (fboundp 'cycle-buffer-backward)
(bind-keys ("<f9>" . cycle-buffer-backward)))
(when (fboundp 'cycle-buffer-backward-permissive)
(bind-keys ("S-<f9>" . cycle-buffer-backward-permissive)))
(when (fboundp 'cycle-buffer)
(bind-keys ("<f10>" . cycle-buffer))) (when (fboundp 'cycle-buffer-permissive)
(bind-keys ("S-<f10>" . cycle-buffer-permissive)))
(unbind-key "<f11>") (unbind-key "<f12>"))
(init-message 3 "custom-key-bindings-function-keys")
(custom-key-bindings-function-keys)
(init-message 2 "Key Bindings: Extended Keys")
(defun custom-key-bindings-extended-keys ()
"Set custom extended key bindings."
(bind-keys* ("<home>" . beginning-of-line))
(bind-keys* ("<end>" . end-of-line))
(bind-keys* ("C-<home>" . beginning-of-buffer))
(bind-keys* ("C-<end>" . end-of-buffer)))
(init-message 3 "custom-key-bindings-extended-keys")
(custom-key-bindings-extended-keys)
(init-message 2 "Key Bindings: Movement Keys")
(defun custom-key-bindings-movement-keys (&optional keymap)
"Set custom movement key bindings on KEYMAP.
KEYMAP defaults to `override-global-map'."
(let ((keymap (or keymap override-global-map)))
(bind-keys* :map keymap
("M-i" . previous-line) ("M-k" . next-line) ("M-j" . left-char) ("M-l" . right-char))
(bind-keys* :map keymap
("C-<up>" . backward-paragraph) ("C-<down>" . forward-paragraph) ("C-<left>" . left-word) ("C-<right>" . right-word) ("C-M-u" . backward-paragraph) ("C-M-o" . forward-paragraph) ("M-u" . left-word) ("M-o" . right-word))
(bind-keys* :map keymap
("C-M-<up>" . scroll-down-command) ("C-M-<down>" . scroll-up-command) ("C-M-<left>" . move-beginning-of-line) ("C-M-<right>" . move-end-of-line) ("C-M-i" . scroll-down-command) ("C-M-k" . scroll-up-command) ("C-M-j" . move-beginning-of-line) ("C-M-l" . move-end-of-line))
(bind-keys* :map keymap
("C-x <up>" . windmove-up)
("C-x <down>" . windmove-down)
("C-x <left>" . windmove-left) ("C-x <right>" . windmove-right) ("C-x C-<up>" . windmove-up)
("C-x C-<down>" . windmove-down)
("C-x C-<left>" . windmove-left) ("C-x C-<right>" . windmove-right) ("C-x M-i" . windmove-up)
("C-x M-k" . windmove-down)
("C-x M-j" . windmove-left)
("C-x M-l" . windmove-right))
(when (fboundp 'window-shrink-vertically)
(bind-keys :map keymap ("C-M-S-i" . window-shrink-vertically)))
(when (fboundp 'window-enlarge-vertically)
(bind-keys :map keymap ("C-M-S-k" . window-enlarge-vertically)))
(when (fboundp 'window-shrink-horizontally)
(bind-keys :map keymap ("C-M-S-j" . window-shrink-horizontally)))
(when (fboundp 'window-enlarge-horizontally)
(bind-keys :map keymap ("C-M-S-l" . window-enlarge-horizontally)))
(when (fboundp 'move-line-up)
(bind-keys* :map keymap
("M-[" . move-line-up)))
(when (fboundp 'move-line-down)
(bind-keys* :map keymap
("M-]" . move-line-down)))))
(init-message 3 "custom-key-bindings-movement-keys")
(custom-key-bindings-movement-keys)
(init-message 2 "Key Bindings: Standard Keys")
(defun custom-key-bindings-standard-keys ()
"Set custom standard key bindings."
(when (fboundp 'insert-line-below)
(bind-keys ("C-M-<return>" . insert-line-below)))
(bind-keys ("C-SPC" . set-mark-command))
(when (fboundp 'cua-set-rectangle-mark)
(bind-keys ("C-x rm" . cua-set-rectangle-mark)
("C-M-SPC" . cua-set-rectangle-mark)))
(when (fboundp 'yank-as-rectangle)
(bind-keys ("C-x r C-y" . yank-as-rectangle)))
(when (fboundp 'just-one-space)
(bind-keys ("C-x C-SPC" . just-one-space)))
(bind-keys ("C-x C-h" . help-command)
("C-x ?" . help))
(when (fboundp 'describe-function-or-variable-at-point)
(bind-keys ("C-h z" . describe-function-or-variable-at-point)
("C-x C-h z" . describe-function-or-variable-at-point)))
(when (fboundp 'shortdoc-display-group)
(bind-keys ("C-h D" . shortdoc-display-group)
("C-x C-h D" . shortdoc-display-group)))
(when (fboundp 'tmm-menubar)
(bind-keys ("C-M-z" . tmm-menubar)))
(when (fboundp 'save-buffer-always-maybe)
(bind-keys ("C-x C-s" . save-buffer-always-maybe)))
(bind-keys ("C-`" . mode-line-other-buffer))
(bind-keys ("C-c y" . bury-buffer))
(bind-keys ("C-c C-y" . bury-buffer))
(bind-keys ("C-c r" . revert-buffer))
(bind-keys ("C-c C-r" . revert-buffer))
(bind-keys ("C-c d" . diff-current-buffer))
(when (fboundp 'mark-full-word)
(bind-keys ("M-@" . mark-full-word)))
(bind-keys ("M-&" . replace-regexp))
(when (fboundp 'insert-menu-prompt)
(bind-keys ("C-x i" . insert-menu-prompt)))
(bind-keys ("M-1" . delete-other-windows)) (bind-keys ("M-2" . split-window-horizontally)) (bind-keys ("M-3" . split-window-vertically)) (unbind-key "M-4") (if (fboundp 'swap-windows)
(bind-keys ("M-4" . swap-windows))) (unbind-key "M-5") (when (fboundp 'toggle-window-split)
(bind-keys ("M-5" . toggle-window-split))) (bind-keys ("M-6" . switch-to-buffer-other-window)) (unbind-key "M-7") (unbind-key "M-8") (unbind-key "M-8") (when (fboundp 'kill-other-window-buffer)
(bind-keys ("M-8" . kill-other-window-buffer))) (unbind-key "M-9") (when (fboundp 'kill-other-window-buffer-and-delete-window)
(bind-keys ("M-9" . kill-other-window-buffer-and-delete-window))) (bind-keys ("M-0" . delete-window))
(when (fboundp 'ace-window)
(bind-keys ("C-x o" . ace-window)))
(when (fboundp 'swap-windows)
(bind-keys ("C-x C-o" . swap-windows)))
(when (fboundp 'toggle-window-split)
(bind-keys ("C-x M-o" . toggle-window-split)))
(bind-keys ("C-$" . toggle-truncate-lines))
(bind-keys ("C-x C-k" . kill-current-buffer))
(when (fboundp 'delete-to-end-of-line)
(bind-keys ("C-k" . delete-to-end-of-line)))
(when (fboundp 'delete-line)
(bind-keys ("C-M-d" . delete-line)))
(when (fboundp 'delete-word)
(bind-keys ("M-d" . delete-word))) (when (fboundp 'backward-delete-word)
(bind-keys ("C-<backspace>" . backward-delete-word)))
(when (fboundp 'copy-line)
(bind-keys ("C-x C-y" . copy-line)))
(when (fboundp 'cut-line)
(bind-keys ("C-x M-y" . cut-line)))
(when (fboundp 'duplicate-line)
(bind-keys ("C-x C-d" . duplicate-line)))
(bind-keys ("C-x C-j" . join-line))
(when (fboundp 'join-next-line)
(bind-keys ("C-x j" . join-next-line)))
(when (fboundp 'titleize-word-enhanced)
(bind-keys ("M-t" . titleize-word-enhanced)) (bind-keys ("M-T" . titleize-line-or-region)))
(bind-keys ("C-x M-p" . describe-text-properties))
(bind-keys ("C-_" . undo))
(bind-keys ("M-_" . undo-redo))
(when (fboundp 'goto-last-change)
(bind-keys ("C-x C-_" . goto-last-change)))
(when (fboundp 'match-paren)
(bind-keys ("M-(" . match-paren)))
(bind-keys ("C-x C-e" . eval-current-sexp))
(when (fboundp 'eval-sexp-buffer)
(bind-keys ("C-x M-e" . eval-sexp-buffer)))
(when (fboundp 'comment-or-uncomment-sexp)
(define-key emacs-lisp-mode-map (kbd "C-M-;") 'comment-or-uncomment-sexp))
(when (fboundp 'indent-region-or-thing)
(bind-keys ("C-M-\\" . indent-region-or-thing)))
(when (fboundp 'append-equal-to-column-80)
(bind-keys ("C-c =" . append-equal-to-column-80)))
(when (fboundp 'append-dash-to-column-80)
(bind-keys ("C-c -" . append-dash-to-column-80)))
(when (fboundp 'append-asterisk-to-column-80)
(bind-keys ("C-c 8" . append-asterisk-to-column-80))
(bind-keys ("C-c *" . append-asterisk-to-column-80)))
(when (fboundp 'insert-lisp-comment-block-equal)
(bind-keys ("C-c C-=" . insert-lisp-comment-block-equal)))
(when (fboundp 'insert-lisp-comment-block-dash)
(bind-keys ("C-c C--" . insert-lisp-comment-block-dash)))
(bind-keys ("C-c |" . align-current))
(unbind-key "C-x f")
(when (fboundp 'compare-windows)
(bind-keys ("C-c C-w" . compare-windows)))
(when (fboundp 'unfill-paragraph)
(bind-keys ("M-Q" . unfill-paragraph)))
(when (and (fboundp 'pop-up-shell) (fboundp 'pop-up-shell-toggle))
(bind-keys ("C-x C-]" . pop-up-shell-toggle)))
(bind-keys ("C-x _" . describe-char)))
(init-message 3 "custom-key-bindings-standard-keys")
(custom-key-bindings-standard-keys)
(init-message 2 "Key Bindings: Modes and Module Keys")
(defun custom-key-bindings-modes-and-modules-keys ()
"Set custom modes and modules key bindings."
(when (fboundp 'diary)
(bind-keys ("C-x y" . diary)))
(bind-keys ("C-M-'" . imenu))
(define-key isearch-mode-map (kbd "C-o")
(lambda ()
(interactive)
(let ((case-fold-search isearch-case-fold-search))
(occur (if isearch-regexp isearch-string (regexp-quote isearch-string))))))
(bind-keys ("C-x M-n" . display-line-numbers-mode))
(when (fboundp 'display-line-numbers-type-toggle)
(bind-keys ("C-x M-N" . display-line-numbers-type-toggle)))
(when (fboundp 'occur)
(bind-keys ("C-c o" . occur)))
(bind-keys ("C-x !" . shell)))
(init-message 3 "custom-key-bindings-modes-and-modules-keys")
(custom-key-bindings-modes-and-modules-keys)
(init-message 2 "Key Bindings: Grouped Prefix Keys")
(defun custom-key-bindings-grouped-prefix-keys ()
"Set custom grouped prefix key bindings."
(unbind-key "C-h e")
(define-prefix-command 'help-find-map nil "Help Find Commands")
(bind-keys :prefix "C-h e"
:prefix-map help-find-map
:menu-name "Help Find Commands"
("e" . view-echo-area-messages)
("f" . find-function)
("k" . find-function-on-key)
("l" . find-library)
("v" . find-variable)
("V" . apropos-value))
(unbind-key "M-SPC")
(define-prefix-command 'space-map nil "Space Prefix Launching Point")
(bind-keys :prefix "M-SPC"
:prefix-map space-map
:menu-name "Space Prefix Launching Point")
(bind-keys ("C-." . space-map))
(bind-keys :map space-map ("M-SPC" . tmm-menubar))
(bind-keys :map space-map
:prefix "b"
:prefix-map space-buffer-map
:menu-name "Buffer Commands")
(when (fboundp 'switch-to-messages)
(bind-keys :map space-buffer-map ("m" . switch-to-messages)))
(when (fboundp 'new-scratch)
(bind-keys :map space-buffer-map ("n" . new-scratch)))
(when (fboundp 'new-emacs-lisp-scratch)
(bind-keys :map space-buffer-map ("e" . new-emacs-lisp-scratch)))
(when (fboundp 'new-org-scratch)
(bind-keys :map space-buffer-map ("o" . new-org-scratch)))
(when (fboundp 'switch-to-scratch)
(bind-keys :map space-buffer-map ("s" . switch-to-scratch)))
(when (fboundp 'switch-to-scratch-for-current-mode)
(bind-keys :map space-buffer-map ("c" . switch-to-scratch-for-current-mode)))
(bind-keys :map space-map
:prefix "c"
:prefix-map space-command-log-map
:menu-name "Command Log Commands"
("c" . command-log-mode-on)
("k" . command-log-mode-off)
("l" . clm/command-log-clear))
(bind-keys :map space-map
:prefix "g"
:prefix-map space-git-map
:menu-name "Git Commands"
("b" . magit-branch)
("c" . magit-branch-or-checkout)
("d" . magit-diff-unstaged)
("f" . magit-fetch)
("F" . magit-fetch-all)
("p" . magit-pull-branch)
("P" . magit-push-current)
("r" . magit-rebase)
("s" . magit-status))
(bind-keys :map space-git-map
:prefix "l"
:prefix-map space-git-log-map
:menu-name "Git Log Commands"
("l" . magit-log-current)
("f" . magit-log-buffer-file))
(bind-keys :map space-map
:prefix "G"
:prefix-map space-grep-map
:menu-name "Grep Commands")
(when (fboundp 'grep-bin)
(bind-keys :map space-grep-map ("b" . grep-bin)))
(when (fboundp 'grep-clojure)
(bind-keys :map space-grep-map ("c" . grep-clojure)))
(when (fboundp 'grep-clisp)
(bind-keys :map space-grep-map ("l" . grep-clisp)))
(when (fboundp 'grep-elisp)
(bind-keys :map space-grep-map ("e" . grep-elisp)))
(when (fboundp 'grep-elisp-extended)
(bind-keys :map space-grep-map ("E" . grep-elisp-extended)))
(when (fboundp 'grep-emacs-init)
(bind-keys :map space-grep-map ("i" . grep-emacs-init)))
(when (fboundp 'grep-home-init)
(bind-keys :map space-grep-map ("h" . grep-home-init)))
(when (fboundp 'grep-org)
(bind-keys :map space-grep-map ("o" . grep-org)))
(when (fboundp 'grep-python)
(bind-keys :map space-grep-map ("p" . grep-python)))
(when (fboundp 'grep-racket)
(bind-keys :map space-grep-map ("r" . grep-racket)))
(when (fboundp 'grep-web)
(bind-keys :map space-grep-map ("w" . grep-web)))
(bind-keys :map space-map
:prefix "i"
:prefix-map space-insert-map
:menu-name "Insert Commands"
("d" . insert-date)
("t" . insert-datetime)
("u" . insert-uuid))
(bind-keys :map space-insert-map
:prefix "o"
:prefix-map space-insert-org-map
:menu-name "Insert Org-Mode Commands"
("b" . org-insert-literate-programming-src)
("c" . org-insert-literate-programming-code-block)
("e" . org-insert-literate-programming-src-emacs-lisp)
("h" . org-insert-header)
("i" . org-insert-literate-programming-init-emacs-block)
("k" . org-insert-literate-programming-src-kotlin)
("n" . org-insert-literate-programming-name)
("p" . org-insert-literate-programming-project-euler-problem-block)
("r" . org-insert-literate-programming-src-racket)
("s" . org-insert-literate-programming-src-sh)
("t" . org-insert-table))
(bind-keys :map space-insert-map
:prefix "p"
:prefix-map space-insert-password-map
:menu-name "Insert Password Commands"
("p" . insert-password)
("h" . insert-password-phrase)
("2" . insert-password-20)
("3" . insert-password-phrase-3-space)
("6" . insert-password-phrase-6-space)
("-" . insert-password-phrase-6-hyphen-capitalize)
("!" . insert-password-phrase-6-symbol-capitalize))
(bind-keys :map space-map
:prefix "m"
:prefix-map space-miscellaneous-map
:menu-name "Miscellaneous Commands"
("b" . emacs-lisp-byte-compile)
("c" . customize-group)
("g" . magit-status)
("m" . macrostep-mode)
("s" . server-start-maybe)
("w" . webjump)
("x" . regexp-builder))
(bind-keys :map space-miscellaneous-map
:prefix "d"
:prefix-map space-miscellaneous-display-map
:menu-name "Display Commands"
("c" . list-colors-display)
("f" . list-faces-display)
("s" . list-character-sets)
("w" . display-time-world))
(when (fboundp 'term-bash)
(bind-keys :map space-miscellaneous-display-map ("u" . list-charset-unicode)))
(bind-keys :map space-miscellaneous-map
:prefix "e"
:prefix-map space-miscellaneous-eval-map
:menu-name "Eval Commands"
("b" . eval-buffer)
("i" . ielm)
("r" . eval-region))
(bind-keys :map space-miscellaneous-map
:prefix "f"
:prefix-map space-miscellaneous-format-map
:menu-name "Format Commands"
("j" . json-pretty-print)
("x" . xml-pretty-print))
(bind-keys :map space-miscellaneous-map
:prefix "t"
:prefix-map space-miscellaneous-toggle-map
:menu-name "Toggle Commands"
("d" . toggle-debug-on-error)
("q" . toggle-debug-on-quit)
("s" . toggle-case-fold-search)
("t" . toggle-truncate-lines)
("v" . visual-line-mode))
(bind-keys :map space-map
:prefix "p"
:prefix-map space-package-map
:menu-name "Package Commands"
("i" . package-install)
("l" . package-list-packages-no-fetch)
("L" . package-list-packages)
("R" . straight-pull-recipe-repositories)
("P" . straight-pull-all)
("F" . straight-fetch-all))
(bind-keys :map space-map
:prefix "r"
:prefix-map space-run-map
:menu-name "Run Commands")
(when (and (fboundp 'safe-load) (boundp 'emacs-home-dir))
(defun safe-load-init-elisp ()
(safe-load (file-truename (expand-file-name "init.el" emacs-home-dir))))
(bind-keys :map space-run-map ("i" . safe-load-init-elisp)))
(bind-keys :map space-map
:prefix "t"
:prefix-map space-terminal-map
:menu-name "Terminal Commands"
("a" . ansi-term)
("e" . eshell)
("s" . shell)
("t" . term))
(when (fboundp 'term-bash)
(bind-keys :map space-terminal-map ("b" . term-bash)))
(when (fboundp 'term-zsh)
(bind-keys :map space-terminal-map ("z" . term-zsh)))
(when (fboundp 'vterm)
(bind-keys :map space-terminal-map ("v" . vterm)))
(bind-keys :map space-map
:prefix "z"
:prefix-map space-browse-url-map
:menu-name "Browse URL Commands"
("." . browse-url-at-point)
("b" . browse-url-of-buffer)
("r" . browse-url-of-region)
("u" . browse-url)
("v" . browse-url-of-file)))
(init-message 3 "custom-key-bindings-grouped-prefix-keys")
(custom-key-bindings-grouped-prefix-keys)
(init-message 2 "Key Bindings: Set All Custom Key Bindings")
(defun custom-key-bindings-set-all ()
"Set all custom key bindings."
(init-message 3 "custom-key-bindings-function-keys")
(custom-key-bindings-function-keys)
(init-message 3 "custom-key-bindings-extended-keys")
(custom-key-bindings-extended-keys)
(init-message 3 "custom-key-bindings-movement-keys")
(custom-key-bindings-movement-keys)
(init-message 3 "custom-key-bindings-standard-keys")
(custom-key-bindings-standard-keys)
(init-message 3 "custom-key-bindings-modes-and-modules-keys")
(custom-key-bindings-modes-and-modules-keys)
(init-message 3 "custom-key-bindings-grouped-prefix-keys")
(custom-key-bindings-grouped-prefix-keys))
(init-message 1 "Org Mode")
(init-message 2 "Org Mode: Configuration")
(use-package org
:straight (:type built-in)
:demand t
:mode (("\\.org\\'" . org-mode)
("\\.org_archive\\'" . org-mode))
:bind* (("C-c a" . org-agenda)
("C-c c" . org-capture)
("C-c j" . org-babel-tangle-jump-to-org))
:custom
(org-directory (file-truename (expand-file-name "~/org")))
(org-adapt-indentation t)
(org-odd-levels-only t)
(org-hide-leading-stars t)
(org-startup-folded 'overview)
(org-replace-disputed-keys t)
(org-support-shift-select 'always)
(org-startup-with-inline-images t)
(org-blank-before-new-entry '((heading . nil) (plain-list-item . nil)))
(org-ellipsis " ▼")
(org-special-ctrl-a/e 'reversed)
(org-catch-invisible-edits 'show-and-error)
(org-use-fast-todo-selection t)
(org-treat-S-cursor-todo-selection-as-state-change nil)
(org-display-custom-times t)
(org-time-stamp-custom-formats '("<%Y-%m-%d %a>" . "<%Y-%m-%d %a %H:%M>"))
(org-show-context-detail
'((default . lineage)
(agenda . local)))
(org-log-note-headings
'((done . "CLOSING NOTE %t")
(state . "State %-12s %t")
(note . "Note taken on %t")
(reschedule . "Rescheduled from %S on %t")
(delschedule . "Not scheduled, was %S on %t")
(redeadline . "New deadline from %S on %t")
(deldeadline . "Removed deadline, was %S on %t")
(refile . "Refiled on %t")
(clock-out . "")))
:config
(custom-set-faces
`(org-ellipsis ((t (:underline nil))))
`(org-block ((t (:inherit shadow :foreground ,color-foreground)))))
(when window-system
(setq org-file-apps (quote ((auto-mode . emacs)
("\\.mm\\'" . default)
("\\.x?html?\\'" . default)
("\\.pdf\\'" . emacs)))))
(advice-add 'org-refile :after #'org-save-all-org-buffers)
(defun pabbrev-global-mode--org-disable (orig-fun &rest args)
"Turn off pabbrev mode (it interferes with org mode)."
(unless (eq major-mode 'org-mode)
(apply orig-fun args)))
(advice-add 'pabbrev-global-mode :around #'pabbrev-global-mode--org-disable)
(add-hook 'org-shiftup-final-hook #'windmove-up)
(add-hook 'org-shiftleft-final-hook #'windmove-left)
(add-hook 'org-shiftdown-final-hook #'windmove-down)
(add-hook 'org-shiftright-final-hook #'windmove-right)
(setq org-mobile-directory (file-truename (expand-file-name "~/Dropbox/MobileOrg")))
(setq org-mobile-inbox-for-pull (file-truename (expand-file-name "index.org" org-mobile-directory)))
(defun org-update-parent-cookie ()
"Update parent TODO cookies when children entries are killed."
(when (eq major-mode 'org-mode)
(save-mark-and-excursion
(ignore-errors
(org-back-to-heading)
(org-update-parent-todo-statistics)))))
(defun org-kill-src-buffers (&rest args)
"Kill temporary buffers created by `org-src-font-lock-fontify-block'."
(dolist (buffer (buffer-list))
(let ((buffer-name (buffer-name buffer)))
(when (string-prefix-p " org-src-fontification:" buffer-name)
(kill-buffer buffer)))))
(defun org-src-font-lock-fontify-block--kill-src-buffers (lang start end)
"Kill temporary buffers created by `org-src-font-lock-fontify-block'."
(org-kill-src-buffers))
(advice-add 'org-src-font-lock-fontify-block :after #'org-src-font-lock-fontify-block--kill-src-buffers)
(defun before-save-hook--update-last-modified-property ()
"Hook to update last modified property on save."
(when (and buffer-file-name
(string= (file-name-extension buffer-file-name) "org"))
(org-update-last-modified-property)))
(add-hook 'before-save-hook #'before-save-hook--update-last-modified-property)
(defun after-save-hook--generate-init-emacs-elisp-file ()
"Hook to generate init-emacs.el file on save."
(when (and buffer-file-name
(string= (file-truename buffer-file-name) init-emacs-true-file-name))
(if (fboundp 'org-babel-tangle-file-async)
(org-babel-tangle-file-async init-emacs-true-file-name)
(org-babel-tangle-file init-emacs-true-file-name))))
(add-hook 'after-save-hook #'after-save-hook--generate-init-emacs-elisp-file :append)
(unless (fboundp 'org-outline-overlay-data)
(defun org-outline-overlay-data (&optional use-markers)
"Return a list of the locations of all outline overlays.
These are overlays with the `invisible' property value `outline'.
The return value is a list of cons cells, with start and stop
positions for each overlay.
If USE-MARKERS is set, return the positions as markers."
(let (beg end)
(org-with-wide-buffer
(delq nil
(mapcar (lambda (x)
(when (eq (overlay-get x 'invisible) 'outline)
(setq beg (overlay-start x)
end (overlay-end x))
(and beg end (> end beg)
(if use-markers
(cons (copy-marker beg)
(copy-marker end t))
(cons beg end)))))
(overlays-in (point-min) (point-max))))))))
(unless (fboundp 'org-set-outline-overlay-data)
(defun org-set-outline-overlay-data (data)
"Create visibility overlays for all positions in DATA.
DATA should have been made by `org-outline-overlay-data'."
(org-with-wide-buffer
(org-show-all)
(dolist (c data) (org-flag-region (car c) (cdr c) t 'outline))))))
(init-message 2 "Org Mode: Outline")
(use-package outline
:straight (:type built-in)
:after (org)
:commands (outline-up-heading
outline-forward-same-level
outline-show-subtree)
:config
(advice-add 'outline-up-heading :around #'advice--ignore-interactive-errors))
(init-message 2 "Org Mode: Agenda")
(use-package org-agenda
:when (file-exists-p org-directory)
:straight (:type built-in)
:after (org)
:config
(setq org-log-done 'time)
(setq org-agenda-file-regexp "agenda-.*\\.org\\'"
org-agenda-files (mapcar (lambda (x) (expand-file-name x (file-name-as-directory org-directory)))
(cl-remove-if-not (lambda (x) (string-match org-agenda-file-regexp x))
(directory-files org-directory))))
(setq org-default-notes-file (car org-agenda-files))
(setq org-agenda-span 7)
(setq org-deadline-warning-days 14)
(setq org-agenda-show-all-dates t)
(setq org-agenda-skip-deadline-if-done t)
(setq org-agenda-skip-scheduled-if-done t)
(setq org-agenda-start-on-weekday nil)
(setq org-reverse-note-order t)
(setq org-fast-tag-selection-single-key 'expert)
(setq org-agenda-custom-commands
(quote (("d" todo "DONE" nil)
("w" todo "WAITING" nil)
("W" agenda "" ((org-agenda-ndays 21)))
("A" agenda ""
((org-agenda-skip-function
(lambda ()
(org-agenda-skip-entry-if 'notregexp "\\=.*\\[#A\\]")))
(org-agenda-ndays 1)
(org-agenda-overriding-header "Today's Priority #A tasks: ")))
("u" alltodo ""
((org-agenda-skip-function
(lambda ()
(org-agenda-skip-entry-if 'scheduled 'deadline 'regexp "<[^>\n]+>")))
(org-agenda-overriding-header "Unscheduled TODO entries: "))))))
(unless (boundp 'org-called-interactively-p)
(defalias 'org-called-interactively-p 'called-interactively-p))
(defun org-agenda-archive-done-tasks ()
"Archive DONE tasks."
(interactive)
(org-map-entries #'org-archive-subtree "/DONE" 'file))
(when (boundp 'org-archive-subtree-save-file-p)
(setq org-archive-subtree-save-file-p t)))
(init-message 2 "Org Mode: Capture")
(use-package org-capture
:when (file-exists-p org-directory)
:straight (:type built-in)
:after (org org-agenda)
:config
(let ((capture-file (car org-agenda-files))
(capture-headline "Inbox"))
(setq org-capture-templates
`(("i" "Inbox" entry
(file+headline ,capture-file ,capture-headline)
"* TODO %?\nOPENED: %U"
:prepend t)
("@" "Inbox [mu4e]" entry
(file+headline ,capture-file ,capture-headline)
"* TODO Email: \"%a\" %?\nOPENED: %U"
:prepend t)))))
(init-message 2 "Org Mode: Appear")
(use-package org-appear
:straight t
:hook (org-mode . org-appear-mode)
:custom
(org-appear-autolinks t)
(org-appear-autosubmarkers t)
(org-appear-autoentities t)
(org-appear-autokeywords t)
(org-appear-inside-latex t)
(org-appear-delay 0.5)
(org-appear-trigger #'always))
(init-message 2 "Org Mode: LaTeX")
(init-message 3 "Org Mode: LaTeX: ox-latex")
(use-package ox-latex
:straight (:type built-in)
:custom
(org-latex-listings t)
:init
(add-to-list 'org-latex-classes
`("org-latex-plain"
,(concat
"\\documentclass{article}\n"
"[NO-DEFAULT-PACKAGES]\n"
"[PACKAGES]\n"
"[EXTRA]")
("\\section{%s}" . "\\section*{%s}")
("\\subsection{%s}" . "\\subsection*{%s}")
("\\subsubsection{%s}" . "\\subsubsection*{%s}")
("\\paragraph{%s}" . "\\paragraph*{%s}")
("\\subparagraph{%s}" . "\\subparagraph*{%s}"))))
(init-message 3 "Org Mode: LaTeX: ob-latex-as-png")
(use-package ob-latex-as-png
:straight t)
(init-message 2 "Org Mode: Modules")
(org-load-modules-maybe t)
(init-message 2 "Org Mode: Functions")
(init-message 3 "Org Mode: Functions: org-get-property-list")
(defun org-get-property-list (&optional property buffer)
"Return an association list of org properties matching PROPERTY in BUFFER.
PROPERTY is used to `string-match' for properties to
return (defaults to \"PROPERTY\"). Multiple properties can be
queried in one call by using a regular expression. (E.g.
\"\\(AUTHOR\\|EMAIL\\|TITLE\\)\")
If BUFFER is nil, current buffer is used."
(let ((property (or property "PROPERTY")))
(with-current-buffer (or buffer (current-buffer))
(org-element-map (org-element-parse-buffer) 'keyword
(lambda (x) (let ((key (org-element-property :key x)))
(when (string-match property key)
(cons key (org-element-property :value x)))))))))
(init-message 3 "Org Mode: Functions: org-get-element-tree")
(defun org-get-element-tree (types &optional buffer)
"Return a tree structure representing the org levels found in
BUFFER for given TYPES.
TYPES is the same symbol or list of symbols used with
`org-element-map'.
If BUFFER is nil, current buffer is used."
(with-current-buffer (or buffer (current-buffer))
(org-element-map (org-element-parse-buffer) types
(lambda (x) (cons (org-element-property :level x)
(org-element-property :raw-value x))))))
(init-message 3 "Org Mode: Functions: org-get-file-data")
(defun org-get-file-data (file &optional path)
"Return tree structure version of given Org FILE.
PATH is an optional list of headlines to match starting from the
top level.
Output format:
(((\"KEY1\" . VALUE1)
(\"KEY2\" . VALUE2)
(\"KEY3\" . VALUE3))
((HEADLINE1)
(HEADLINE2
(HEADLINE21 . BODY21))
(HEADLINE3
(HEADLINE31
(HEADLINE311 . BODY311)
(HEADLINE312 . BODY312))
(HEADLINE32
(HEADLINE321 . BODY321)
(HEADLINE322 . BODY322)))))"
(let* ((property-headline-regexp "^[ \t]*\\** Org\\([ \t]*:noexport:\\)?$")
(property-regexp "^[ \t]*#\\+\\(.*\\): \\(.*\\)$")
(property-drawer-regexp "[ \t]*:PROPERTIES:.*:END:[ \t]*")
(headline-regexp "^\\(\*+ \\)\\(.*\\)$")
(property-alist nil)
(property-section t)
(level 0)
(tree (cons nil nil))
(start tree)
(stack nil)
(matches path)
(path-level (length path))
(parse-error "Error parsing at headline: %s"))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (not (eobp))
(cond
((and (bobp)
(looking-at property-headline-regexp))
nil)
((and property-section
(looking-at property-regexp))
(let ((key (match-string-no-properties 1))
(value (match-string-no-properties 2)))
(push (cons key value) property-alist)))
((looking-at headline-regexp)
(setq property-section nil)
(let ((headline-level (/ (length (match-string-no-properties 1))
(if org-odd-levels-only 2 1)))
(headline-value (match-string-no-properties 2))
(segment (car path)))
(when (and path
(not matches)
(>= path-level headline-level))
(setq matches path))
(when (or (and (not matches)
(> headline-level path-level))
(string= headline-value (car matches)))
(when (string= headline-value (car matches))
(setq matches (cdr matches)))
(cond
((> headline-level level)
(unless tree
(user-error parse-error headline-value))
(setcdr tree (cons (cons headline-value nil) nil))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree))
(setq level headline-level))
((= headline-level level)
(setq tree (pop stack))
(unless tree
(user-error parse-error headline-value))
(setcdr tree (cons (cons headline-value nil) nil))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree)))
((< headline-level level)
(while (< headline-level level)
(setq tree (pop stack))
(setq level (1- level)))
(setq tree (pop stack))
(unless tree
(user-error parse-error headline-value))
(setcdr tree (cons (cons headline-value nil) nil))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree))
(setq level headline-level))))))
((and (not matches)
(>= level path-level))
(setq property-section nil)
(when (> (length start) 1)
(let ((body "")
(point (point)))
(while (and (not (eobp))
(not (looking-at property-regexp))
(not (looking-at headline-regexp)))
(when (> (length body) 0)
(setq body (concat body "\n")))
(setq body (concat body
(replace-regexp-in-string "^[ \t\n]*" ""
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))))
(forward-line 1))
(when (>
(length
(replace-regexp-in-string property-drawer-regexp ""
(replace-regexp-in-string "\n" "" body)))
0)
(setcdr tree (cons (replace-regexp-in-string "[ \t]*$" "" body) nil))
(setq tree (cdr tree)))
(forward-line 0)
(when (> (point) point)
(forward-line -1)))))
(t
(setq property-section nil)))
(forward-line 1))
(cons property-alist (cdr start)))))
(init-message 3 "Org Mode: Functions: org-get-buffer-data")
(defun org-get-buffer-data (buffer &optional path with-markers)
"Return tree structure version of given Org BUFFER.
PATH is an optional list of headlines to match starting from the
top level.
If WITH-MARKERS is non-nil, include `point-marker' after HEADLINE
values in output.
Output format:
(((\"KEY1\" . VALUE1)
(\"KEY2\" . VALUE2)
(\"KEY3\" . VALUE3))
((HEADLINE1)
(HEADLINE2
(HEADLINE21 . BODY21))
(HEADLINE3
(HEADLINE31
(HEADLINE311 . BODY311)
(HEADLINE312 . BODY312))
(HEADLINE32
(HEADLINE321 . BODY321)
(HEADLINE322 . BODY322)))))
Output format if WITH-MARKERS is non-nil:
(((\"KEY1\" . VALUE1)
(\"KEY2\" . VALUE2)
(\"KEY3\" . VALUE3))
((HEADLINE1 . MARKER1)
(HEADLINE2 . MARKER2
(HEADLINE21 . MARKER21 . BODY21))
(HEADLINE3 . MARKER3
(HEADLINE31 . MARKER31
(HEADLINE311 . MARKER311 . BODY311)
(HEADLINE312 . MARKER312 . BODY312))
(HEADLINE32 . MARKER32
(HEADLINE321 . MARKER321 . BODY321)
(HEADLINE322 . MARKER322 . BODY322)))))"
(let* ((property-headline-regexp "^[ \t]*\\** Org\\([ \t]*:noexport:\\)?$")
(property-regexp "^[ \t]*#\\+\\(.*\\): \\(.*\\)$")
(property-drawer-regexp "[ \t]*:PROPERTIES:.*:END:[ \t]*")
(headline-regexp "^\\(\*+ \\)\\(.*\\)$")
(property-alist nil)
(property-section t)
(level 0)
(tree (cons nil nil))
(start tree)
(stack nil)
(matches path)
(path-level (length path)))
(with-current-buffer buffer
(goto-char (point-min))
(while (not (eobp))
(cond
((and (bobp)
(looking-at property-headline-regexp))
nil)
((and property-section
(looking-at property-regexp))
(let ((key (match-string-no-properties 1))
(value (match-string-no-properties 2)))
(push (cons key value) property-alist)))
((looking-at headline-regexp)
(setq property-section nil)
(let ((headline-level (/ (length (match-string-no-properties 1))
(if org-odd-levels-only 2 1)))
(headline-value (match-string-no-properties 2))
(segment (car path)))
(when (and path
(not matches)
(>= path-level headline-level))
(setq matches path))
(when (or (and (not matches)
(> headline-level path-level))
(string= headline-value (car matches)))
(when (string= headline-value (car matches))
(setq matches (cdr matches)))
(cond
((> headline-level level)
(if with-markers
(setcdr tree (cons (cons (cons headline-value (point-marker)) nil) nil))
(setcdr tree (cons (cons headline-value nil) nil)))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree))
(setq level headline-level))
((= headline-level level)
(setq tree (pop stack))
(if with-markers
(setcdr tree (cons (cons (cons headline-value (point-marker)) nil) nil))
(setcdr tree (cons (cons headline-value nil) nil)))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree)))
((< headline-level level)
(while (< headline-level level)
(setq tree (pop stack))
(setq level (1- level)))
(setq tree (pop stack))
(if with-markers
(setcdr tree (cons (cons (cons headline-value (point-marker)) nil) nil))
(setcdr tree (cons (cons headline-value nil) nil)))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree))
(setq level headline-level))))))
((and (not matches)
(>= level path-level))
(setq property-section nil)
(when (> (length start) 1)
(let ((body "")
(point (point)))
(while (and (not (eobp))
(not (looking-at property-regexp))
(not (looking-at headline-regexp)))
(when (> (length body) 0)
(setq body (concat body "\n")))
(setq body (concat body
(replace-regexp-in-string "^[ \t\n]*" ""
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))))
(forward-line 1))
(when (>
(length
(replace-regexp-in-string property-drawer-regexp ""
(replace-regexp-in-string "\n" "" body)))
0)
(setcdr tree (cons (replace-regexp-in-string "[ \t]*$" "" body) nil))
(setq tree (cdr tree)))
(forward-line 0)
(when (> (point) point)
(forward-line -1)))))
(t
(setq property-section nil)))
(forward-line 1))
(cons property-alist (cdr start)))))
(init-message 3 "Org Mode: Functions: org-get-buffer-tags-statistics")
(defun org-get-buffer-tags-statistics (&optional files)
"Return an alist of tags and counts for all tags in FILES.
FILES can be nil, a single file, or a list of files.
If FILES is nil, the current buffer is used instead."
(let ((files
(mapcar #'file-truename
(cond
((not files) (list (buffer-file-name)))
((stringp files) (list files))
((listp files) files)
(t (user-error "Invalid value for FILES: %S" files)))))
(loaded-files
(cl-remove-if #'null (mapcar #'buffer-file-name (buffer-list))))
stats)
(save-mark-and-excursion
(dolist (file files)
(find-file file)
(org-with-point-at 1
(let (tags)
(while (re-search-forward org-tag-line-re nil t)
(push (split-string (match-string-no-properties 2) ":") tags))
(dolist (tag (flatten-list tags))
(let ((node (assoc tag stats)))
(if node
(setcdr node (1+ (cdr node)))
(push (cons tag 1) stats))))))
(unless (member file loaded-files)
(kill-buffer))))
(sort stats (lambda (a b) (< (cdr a) (cdr b))))))
(init-message 3 "Org Mode: Functions: org-safe-meta")
(defmacro org-safe-meta-function (org-meta-function safe-function)
"Return SAFE-FUNCTION version of ORG-META-FUNCTION."
`(defun ,(intern safe-function) (&optional arg)
,(concat "Call `" org-meta-function "' ignoring any errors.")
(interactive)
(let ((pos (point)))
(condition-case nil
(,(intern org-meta-function) arg)
('error
(goto-char pos))))))
(defmacro org-safe-shiftmeta-function (org-shiftmeta-function safe-function)
"Return SAFE-FUNCTION version of ORG-SHIFTMETA-FUNCTION."
`(defun ,(intern safe-function) ()
,(concat "Call `" org-shiftmeta-function "' ignoring any errors.")
(interactive)
(let ((pos (point)))
(condition-case nil
(,(intern org-shiftmeta-function))
('error
(goto-char pos))))))
(org-safe-meta-function "org-metaleft" "org-safe-metaleft")
(org-safe-meta-function "org-metaright" "org-safe-metaright")
(org-safe-meta-function "org-metadown" "org-safe-metadown")
(org-safe-meta-function "org-metaup" "org-safe-metaup")
(org-safe-shiftmeta-function "org-shiftmetaleft" "org-safe-shiftmetaleft")
(org-safe-shiftmeta-function "org-shiftmetaright" "org-safe-shiftmetaright")
(org-safe-shiftmeta-function "org-shiftmetadown" "org-safe-shiftmetadown")
(org-safe-shiftmeta-function "org-shiftmetaup" "org-safe-shiftmetaup")
(init-message 3 "Org Mode: Functions: org-sort-multi")
(defun org-sort-multi (sort-types)
"Multiple sorts on a certain level of an outline tree, list items, or plan text.
SORT-TYPES is a list where each entry is either a character or a
list of parmeters to be passed to `org-sort-entries'.
If COMPARE-FUNC is provided, but GETKEY-FUNC is nil, then the
header string will be used.
Example: To sort first by TODO status, then by priority, then by
date, then alphabetically (case-sensitive) use the following
call:
(org-sort-multi '(?o ?p ?t (t ?a))
Example: To sort using `string<' use the following call:
(org-sort-multi '((nil ?f nil #'string<)))"
(save-mark-and-excursion
(forward-line 0)
(let ((type (car (org-element-at-point))))
(dolist (x (nreverse sort-types))
(when (characterp x)
(setq x (list nil x)))
(when (and (listp x)
(> (length x) 3)
(not (nth 2 x)))
(setq x `(,(car x)
,(cadr x)
(lambda ()
(replace-regexp-in-string
"^[\*]*[ \t]*" ""
(buffer-substring-no-properties
(line-beginning-position) (line-end-position))))
(lambda (a b) (funcall ,(cadddr x) a b))
,@(cddddr x))))
(cl-case type
('headline
(condition-case nil
(outline-up-heading 1)
('error (forward-line 0)))
(let ((beg (point)))
(while (and (not (bobp)) (not (eobp)) (<= (point) beg))
(condition-case nil
(outline-forward-same-level 1)
('error
(condition-case nil
(outline-up-heading 1)
('error (goto-char (point-max)))))))
(unless (> (point) beg)
(goto-char (point-max)))
(let ((end (point)))
(goto-char beg)
(ignore-errors
(apply #'org-sort-entries x))
(goto-char end)
(when (eobp)
(forward-line -1))
(when (looking-at "^\\s-*$")
(delete-line))
(goto-char beg)
(dotimes (_ 2)
(org-cycle)))))
('paragraph
(let* ((plist (cadr (org-element-at-point)))
(beg (plist-get plist :contents-begin))
(end (plist-get plist :contents-end)))
(sort-lines nil beg end)))
(t
(ignore-errors
(apply #'org-sort-list x))))))))
(init-message 3 "Org Mode: Functions: org-sort-current")
(defun org-sort-current (&optional sort-types)
"Sort the current org level.
SORT-TYPES is a list where each entry is either a character or a
list of parmeters to be passed to `org-sort-entries'.
If COMPARE-FUNC is provided, but GETKEY-FUNC is nil, then the
header string will be used. Entries are applied in back to front
order.
If entry at point has TODO and PRIORITY tags, then default
SORT-TYPE is \"?o ?p ?t (nil ?f nil #'string<)\" which is to sort
by TODO status, then by priority, then by timestamp, and finally
by ASCII code. Otherwise, default SORT-TYPE is \"(nil ?f nil
#'string<)\" which is to sort by ASCII code."
(interactive)
(when (derived-mode-p 'org-mode)
(let ((sort-types (or sort-types
(if (and (eq (car (org-element-at-point)) 'headline)
(org-entry-get nil "TODO")
(org-entry-get nil "PRIORITY"))
'(?o ?p ?t (nil ?f nil #'string<))
'((nil ?f nil #'string<))))))
(org-sort-multi sort-types))))
(defun org-fill-element--adapt-indentation (orig-fun &rest args)
"Modify `fill-column' based on current org block indentation."
(with-syntax-table org-mode-transpose-word-syntax-table
(let* ((element (save-excursion (end-of-line) (org-element-at-point)))
(type (org-element-type element)))
(if (or (eq type 'paragraph)
(eq type 'comment-block)
(eq type 'comment))
(let ((indent-min fill-column)
(fc fill-column)
(point (point)))
(while (and (not (bobp))
(eq type (org-element-type (org-element-at-point)))
(forward-line -1)))
(unless (eq type (org-element-type (org-element-at-point)))
(forward-line 1))
(while (and (not (eobp))
(eq type (org-element-type (org-element-at-point))))
(when (and (not (= (line-beginning-position) (line-end-position)))
(re-search-forward "^ *" (line-end-position) :noerror)
(< (current-column) indent-min))
(setq indent-min (current-column)))
(forward-line 1))
(goto-char point)
(let ((fill-column (+ fill-column indent-min)))
(apply orig-fun args)))
(apply orig-fun args)))))
(advice-add 'org-fill-element :around #'org-fill-element--adapt-indentation)
(init-message 3 "Org Mode: Functions: org-copy-to-clipboard")
(defun org-copy-to-clipboard (&optional beg end)
"Copy `org-mode' region (or entire buffer) to the `kill-ring'
and X clipboard, indenting and cleaning up links."
(interactive)
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(buffer (current-buffer)))
(deactivate-mark)
(with-temp-buffer
(insert-buffer-substring buffer beg end)
(untabify (point-min) (point-max))
(let ((indent-min fill-column))
(goto-char (point-min))
(while (re-search-forward "^\\(*+ \\| *- \\)" nil :noerror)
(replace-match (concat (make-string (- (match-end 0) (match-beginning 0) 2) ? ) "- "))
(when (< (- (current-column) 2) indent-min)
(setq indent-min (- (current-column) 2)))
(goto-char (line-end-position)))
(when (= indent-min fill-column)
(goto-char (point-min))
(while (not (eobp))
(when (and (not (= (line-beginning-position) (line-end-position)))
(re-search-forward "^ *" (line-end-position) :noerror)
(< (current-column) indent-min))
(setq indent-min (current-column)))
(forward-line 1)))
(when (> indent-min 0)
(goto-char (point-min))
(while (re-search-forward (concat "^" (make-string indent-min ? )) nil :noerror)
(replace-match "")
(goto-char (line-end-position))))
(goto-char (point-min))
(while (re-search-forward "\\[\\[\\(.*?\\)\\]\\[.*?\\]\\]" nil :noerror)
(replace-match (match-string 1)))
(clipboard-kill-region (point-min) (point-max))))))
(init-message 3 "Org Mode: Functions: org-fix-custom-ids")
(defun org-fix-custom-ids (&optional beg end)
"Fix CUSTOM_ID tags in region (or entire buffer), by lower casing them and
replacing spaces with dashes."
(interactive)
(let ((case-fold-search t)
(beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(buffer (current-buffer)))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "^[ \t]*:PROPERTIES:$" nil :noerror)
(forward-line 0)
(forward-char 1)
(while (and (not (looking-at "^[ \t]*:END:$"))
(re-search-forward "^[ \t]*:CUSTOM_ID: " (line-end-position) :noerror))
(let ((pos (point)))
(downcase-region pos (line-end-position))
(while (re-search-forward " " (line-end-position) :noerror)
(replace-match "-"))
(goto-char pos)
(while (re-search-forward ":" (line-end-position) :noerror)
(replace-match "-"))
(forward-line 0)
(forward-line 1)))))))))
(init-message 3 "Org Mode: Functions: org-update-last-modified-property")
(defun org-update-last-modified-property ()
"Update value of LAST-PROPERTY property to current timestamp,
if found and buffer has been modified."
(when (buffer-modified-p)
(save-mark-and-excursion
(save-match-data
(let ((case-fold-search t))
(goto-char (point-min))
(when (re-search-forward "^[ \t]*#\\+LAST_MODIFIED: \\(.*\\)$" nil :noerror)
(replace-match (format-time-string "%Y-%m-%d %H:%M" nil t) t t nil 1)))))))
(init-message 3 "Org Mode: Functions: org-export-to-json")
(use-package json
:straight (:type built-in)
:commands (json-encode)
:config
(defun org-export-to-json (&optional output beg end)
"Export the outline as JSON.
IF OUTPUT is nil, a default output buffer will be created and exported into.
If OUTPUT is non-nil, create a buffer with that name and export to it.
If OUTPUT is the symbol 'string, exported data is returned as a string.
If BEG and END are given, only that region is exported."
(interactive)
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(narrow-to-region beg end)
(let ((tree (org-element-parse-buffer)))
(org-element-map tree (append org-element-all-elements
org-element-all-objects
'(plain-text))
(lambda (x)
(when (org-element-property :parent x)
(org-element-put-property x :parent "none"))
(when (org-element-property :structure x)
(org-element-put-property x :structure "none"))))
(if (eq output 'string)
(json-encode tree)
(let ((buffer (generate-new-buffer (or output (concat buffer-file-name ".json")))))
(set-buffer buffer)
(insert (json-encode tree))
(switch-to-buffer buffer)))))))))
(init-message 3 "Org Mode: Functions: org-toggle-headline-checkbox")
(defun org-toggle-headline-checkbox (&optional beg end)
"Toggle between an Org headline and checkbox on current line or region."
(interactive)
(let ((beg (or beg (if (use-region-p) (region-beginning) (line-beginning-position))))
(end (or end (if (use-region-p) (region-end) (line-end-position)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (not (eobp))
(forward-line 0)
(if (re-search-forward "^\\*+ " (line-end-position) :noerror)
(replace-match (concat
(make-string (- (point) (line-beginning-position) 2) ? )
"- [ ] "))
(forward-line 0)
(when (re-search-forward "^[ \t]*- \\[[ X]\\] " (line-end-position) :noerror)
(replace-match (concat
(make-string (- (point) (line-beginning-position) 5) ?*)
" "))))
(forward-line 1)))))))
(init-message 3 "Org Mode: Functions: org-table-remove-commas")
(defun org-table-remove-commas ()
"Remove all commas in current Org table."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (org-table-begin))
(while (re-search-forward "," (org-table-end) :noerror)
(replace-match "")))))
(init-message 3 "Org Mode: Functions: org-days-between-dates")
(defun org-days-between-dates (beg end)
"Return the number of days between BEG (inclusive) and END (exclusive).
Where BEG and END dates are in one of these formats:
YYYY
YYYYMM
YYYYMMDD
YYYY-MM
YYYY-MM-DD"
(cl-labels
((convert-date (date)
(calendar-absolute-from-gregorian (org-date-to-gregorian date)))
(pad-date (date)
(let ((date (if (stringp date) date (number-to-string date))))
(cl-case (length date)
(4 (concat date "-01-01"))
(6 (concat (substring date 0 4) "-" (substring date 4) "-01"))
(7 (concat date "-01"))
(8 (concat (substring date 0 4) "-" (substring date 4 6) "-" (substring date 6)))
(10 date)))))
(let ((beg (convert-date (pad-date beg)))
(end (convert-date (pad-date end)))
x)
(when (> beg end)
(setq x beg
beg end
end x))
(- end beg))))
(init-message 3 "Org Mode: Functions: org-copy-tangled-sections")
(defun org-copy-tangled-sections (source-file target-file sections &optional prefix)
"Copy section blocks from tangled SOURCE-FILE to TARGET-FILE
that match the names in SECTIONS.
If PREFIX is non-nil, insert it verbatim at the top of the
TARGET-FILE."
(let ((buffer (find-file-noselect target-file)))
(set-buffer buffer)
(erase-buffer)
(insert ";; -*- mode: emacs-lisp; lexical-binding: t; no-byte-compile: t -*-\n")
(insert ";;==============================================================================\n")
(insert ";;; " (file-name-nondirectory target-file) "\n")
(insert ";;\n")
(insert ";; This file was generated from " (file-name-nondirectory source-file) ".\n")
(insert ";;==============================================================================\n\n")
(when prefix
(insert (concat prefix "\n")))
(with-temp-buffer
(insert-file-contents source-file)
(dolist (section sections)
(goto-char (point-min))
(re-search-forward (concat "^[ \t]*" section "$"))
(forward-line 0)
(forward-line -1)
(unless (looking-at "^[ \t]*;;--")
(forward-line 1))
(let ((beg (point))
(end (progn
(re-search-forward (concat "^[ \t]*;; .* ends here$"))
(forward-line 0)
(forward-line 1)
(point))))
(append-to-buffer buffer beg end))))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*(init-message [0-9] \"\\(.*\\)\")$" nil :noerror)
(delete-region (1- (line-beginning-position)) (1+ (line-end-position))))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*;; .* ends here$" nil :noerror)
(forward-line 0)
(delete-region (line-beginning-position) (line-end-position)))
(goto-char (point-max))
(insert ";;==============================================================================\n")
(insert ";;; " (file-name-nondirectory target-file) " ends here\n")
(insert ";;==============================================================================\n")
(save-buffer)
(kill-buffer buffer)))
(init-message 3 "Org Mode: Functions: org-screenshot")
(defun org-screenshot ()
"Take a screenshot into a time stamped unique-named file in the
same directory as the org-buffer and insert a link to this file."
(interactive)
(let ((file (concat (buffer-file-name)
"_"
(format-time-string "%Y%m%d_%H%M%S")
".png")))
(call-process "import" nil nil nil file)
(insert (concat "[[" file "]]\n"))))
(init-message 3 "Org Mode: Functions: org-convert-headings-from-odd-indented-to-oddeven-unindented")
(defun org-convert-headings-from-odd-indented-to-oddeven-unindented (&optional buffer)
"Convert Org BUFFER from having only odd heading levels and
indented body data (`org-odd-levels-only' and
`org-adapt-indentation') to having odd and even heading levels
and non-indented body data (`org-indent-mode').
If BUFFER is nil, current buffer is used."
(unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer"))
(with-current-buffer (or buffer (current-buffer))
(save-mark-and-excursion
(goto-char (point-min))
(while (re-search-forward "^\\(\\*+\\) " nil :noerror)
(when (evenp (length (match-string 1)))
(user-error "Even headings found")))
(goto-char (point-min))
(let ((spaces 0))
(while (not (eobp))
(cond
((looking-at "^\\(\\*+\\) ")
(let ((level (/ (1+ (length (match-string 1))) 2)))
(replace-match (make-string level ?*) nil nil nil 1)
(setq spaces (* level 2))))
((looking-at (concat "^" (make-string spaces ? ) "\\*"))
(replace-match ",*"))
((looking-at (concat "^" (make-string spaces ? )))
(replace-match "")))
(forward-line 1))))))
(init-message 3 "Org Mode: Functions: org-convert-headings-from-oddeven-unindented-to-odd-indented")
(defun org-convert-headings-from-oddeven-unindented-to-odd-indented (&optional buffer)
"Convert Org BUFFER from having odd and even heading levels and
non-indented body data (`org-indent-mode') to having only odd
heading levels and intended body data (`org-odd-levels-only'
and `org-adapt-indentation').
If BUFFER is nil, current buffer is used."
(unless (derived-mode-p 'org-mode)
(user-error "Not an Org buffer"))
(with-current-buffer (or buffer (current-buffer))
(save-mark-and-excursion
(goto-char (point-min))
(let (even subheading)
(while (re-search-forward "^\\(\\*+\\) " nil :noerror)
(when (evenp (length (match-string 1)))
(setq even t))
(when (> (length (match-string 1)) 2)
(setq subheading t)))
(when (and subheading (not even))
(user-error "Only odd headings found")))
(goto-char (point-min))
(let ((spaces 0))
(while (not (eobp))
(cond
((looking-at "^\\(\\*+\\) ")
(let ((level (length (match-string 1))))
(replace-match (make-string (1- (* level 2)) ?*) nil nil nil 1)
(setq spaces (* level 2))))
((looking-at "^,\\*")
(replace-match (concat (make-string spaces ? ) "*")))
((not (looking-at "^$"))
(insert (make-string spaces ? ))))
(forward-line 1))))))
(init-message 3 "Functions: Text Inserting Functions: org-insert-header")
(defun org-insert-header ()
"Insert literate programming header."
(interactive "*")
(let ((text
`("* Org :noexport:"
"#+TITLE: TITLE"
"#+AUTHOR: Kyle W. T. Sherman"
,(concat "#+EMAIL: " user-mail-address)
"#+FILENAME: FILENAME.org"
"#+DESCRIPTION: DESCRIPTION"
"#+KEYWORDS: KEYWORD, emacs, org-mode, babel, literate programming, reproducible research"
"#+LANGUAGE: en"
"#+PROPERTY: header-args :noweb yes :padline yes :comments no :results silent output :mkdirp yes :cache yes"
"#+OPTIONS: num:nil toc:nil d:(HIDE) tags:not-in-toc html-preamble:nil html-postamble:nil"
"#+STARTUP: noindent odd overview"
"#+TIMESTAMP: <>"
"")))
(dolist (x text)
(insert x)
(newline))))
(init-message 3 "Functions: Text Inserting Functions: org-insert-table")
(defun org-insert-table ()
"Insert table template."
(interactive "*")
(let ((text
'("|---|"
"| |"
"|---|"
"| |"
"|---|")))
(dolist (x text)
(insert x)
(newline))))
(init-message 3 "Functions: Text Inserting Functions: org-insert-toc-header")
(defun org-insert-toc-header ()
"Insert table of contents (TOC) header."
(interactive "*")
(let ((text
`("* Table of Contents"
" :PROPERTIES:"
" :CUSTOM_ID: table-of-contents"
" :TOC: :include all"
" :END:"
""
" :CONTENTS:"
" :END:"
"")))
(dolist (x text)
(insert x)
(newline))))
(init-message 2 "Org Mode: Hook")
(defun custom-org-mode-hook ()
"Custom `org-mode' hook."
(bind-keys :map org-mode-map
([remap org-metaleft] . org-safe-metaleft)
([remap org-metaright] . org-safe-metaright)
([remap org-metadown] . org-safe-metadown)
([remap org-metaup] . org-safe-metaup)
([remap org-shiftmetaleft] . org-safe-shiftmetaleft)
([remap org-shiftmetaright] . org-safe-shiftmetaright)
([remap org-shiftmetadown] . org-safe-shiftmetadown)
([remap org-shiftmetaup] . org-safe-shiftmetaup))
(bind-keys :map org-mode-map
("M-n" . scroll-up)
("M-p" . scroll-down)
("M-W" . org-copy-to-clipboard)
("C-M-b" . org-metaleft)
("C-M-f" . org-metaright)
("C-M-n" . org-metadown)
("C-M-p" . org-metaup)
("C-M-B" . org-shiftmetaleft)
("C-M-F" . org-shiftmetaright)
("C-M-N" . org-shiftmetadown)
("C-M-P" . org-shiftmetaup)
("C-c a" . org-agenda)
("C-c l" . org-store-link)
("C-c m" . org-insert-todo-heading)
("C-c p" . org-priority) ("C-c s" . org-sort-current) ("C-c z" . org-agenda-archive-done-tasks) ("C-c C-j" . consult-org-heading) ("C-c C-z" . geiser-mode-switch-to-repl) ("C-c C-x C-l" . org-toggle-link-display) ("C-c C-x t" . org-toggle-headline-checkbox) ("C-c C-x T" . org-toggle-literate-programming-code-block) ("C-c C-x F" . org-fix-literate-programming-heading) ("C-c C-v q" . org-babel-tangle-block) ("C-c C-v C-q" . org-babel-tangle-block)) (custom-key-bindings-movement-keys org-mode-map)
(setq indent-tabs-mode nil)
(turn-off-auto-fill)
(auto-save-mode nil)
)
(use-package org
:straight (:type built-in)
:hook (org-mode . custom-org-mode-hook))
(init-message 2 "Org Mode: Babel")
(init-message 3 "Org Mode: Babel: Configuration")
(use-package org
:straight (:type built-in)
:config
(require 'ob-shell nil :no-error))
(use-package ob-async
:straight t
:after (org))
(setq org-use-property-inheritance t
org-babel-use-quick-and-dirty-noweb-expansion t
org-src-tab-acts-natively t
org-src-preserve-indentation nil
org-src-fontify-natively t
org-src-ask-before-returning-to-edit-buffer nil
org-src-strip-leading-and-trailing-blank-lines t
org-src-window-setup 'current-window
org-confirm-babel-evaluate nil
org-confirm-shell-link-function nil
org-confirm-elisp-link-function nil)
(set-default 'org-export-backends '(ascii html icalendar latex md odt org))
(add-hook 'org-babel-after-execute-hook #'org-display-inline-images :append)
(init-message 3 "Org Mode: Babel: Structure Templates")
(use-package org-tempo
:straight (:type built-in)
:custom
(org-tempo-keywords-alist
'(("A" . "ascii")
("H" . "html")
("i" . "index")
("L" . "latex")
("n" . "name")))
(org-structure-template-alist
'(("c" . "center")
("C" . "comment")
("e" . "example")
("E" . "export")
("ea" . "export ascii")
("eh" . "export html")
("el" . "export latex")
("o" . "src org")
("q" . "quote")
("s" . "src")
("sel" . "src emacs-lisp")
("sk" . "src kotlin")
("sl" . "src latex")
("spy" . "src python")
("sql" . "src sql")
("sr" . "src racket")
("ssh" . "src sh")
("ssu" . "src sh :dir /sudo::")
("t" . "src text")
("v" . "verse")))
:config
(defun org-tempo-add-block (entry)
"Add block entry from `org-structure-template-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry))
(name-parts (split-string name " "))
(upcase-type (upcase (car name-parts)))
(upcase-name (mapconcat 'identity (cons upcase-type (cdr name-parts)) " "))
(special (member name '("src" "export"))))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
`(,(format "#+BEGIN_%s%s" upcase-name (if special " " ""))
,(when special 'p) '> n '> ,(unless special 'p) n
,(format "#+END_%s" upcase-type)
>)
key
(format "Insert a %s block" upcase-name)
'org-tempo-tags)))
(defun org-tempo-add-keyword (entry)
"Add keyword entry from `org-tempo-keywords-alist'."
(let* ((key (format "<%s" (car entry)))
(name (cdr entry))
(upcase-name (upcase name)))
(tempo-define-template (format "org-%s" (replace-regexp-in-string " " "-" name))
`(,(format "#+%s: " upcase-name) p '>)
key
(format "Insert a %s keyword" upcase-name)
'org-tempo-tags)))
(defun org-tempo--include-file ()
"Add #+INCLUDE: and a file name."
(let ((inhibit-quit t))
(unless (with-local-quit
(prog1 t
(insert
(format "#+INCLUDE: %S "
(file-relative-name
(read-file-name "Include file: "))))))
(insert "<I")
(setq quit-flag nil))))
(org-tempo-add-templates)
(defun tempo-insert--disable-org-src-tab-acts-natively (orig-fun &rest args)
"Disable `org-src-tab-acts-natively' during template indentation."
(let ((org-src-tab-acts-natively nil))
(apply orig-fun args)))
(advice-add 'tempo-insert :around #'tempo-insert--disable-org-src-tab-acts-natively))
(init-message 3 "Org Mode: Babel: Edit Source")
(use-package org
:straight (:type built-in)
:commands (org-edit-src-code
org-edit-src-exit)
:config
(require 'org-src)
(add-hook 'org-src-mode-hook #'custom-key-bindings-set-all)
(defun org-edit-src-exit--update-last-modified ()
"Update LAST_MODIFIED property timestamp on source update."
(org-update-last-modified-property))
(advice-add 'org-edit-src-exit :before #'org-edit-src-exit--update-last-modified)
(defun org-edit-src--recenter (&optional arg)
"Recenter when entering/exiting special editors."
(recenter))
(advice-add 'org-edit-special :after #'org-edit-src--recenter)
(advice-add 'org-edit-src-exit :after #'org-edit-src--recenter))
(init-message 3 "Org Mode: Babel: Tangle Case-Sensitive")
(defun org-babel-tangle-collect-blocks--case-sensitive (orig-fun &rest args)
"Set `case-fold-search' to nil so `string-match' calls are case-sensitive."
(let ((case-fold-search nil))
(apply orig-fun args)))
(advice-add 'org-babel-tangle-collect-blocks :around #'org-babel-tangle-collect-blocks--case-sensitive)
(init-message 3 "Org Mode: Babel: Tangle Update Timestamps")
(defun org-babel-post-tangle-hook--time-stamp ()
"Update timestamps in tangled files."
(time-stamp)
(save-buffer))
(add-hook 'org-babel-post-tangle-hook #'org-babel-post-tangle-hook--time-stamp)
(init-message 3 "Org Mode: Babel: Tangle Delete Trailing Whitespace")
(defun org-babel-post-tangle-hook--delete-trailing-whitespace ()
"Delete trailing whitespace in tangled files."
(delete-trailing-whitespace (point-min) (point-max))
(save-buffer))
(add-hook 'org-babel-post-tangle-hook #'org-babel-post-tangle-hook--delete-trailing-whitespace)
(init-message 3 "Org Mode: Babel: Tangle Generate PDF from TEX")
(defun org-babel-post-tangle-hook--generate-pdf-from-tex ()
"Generate PDF from tangled TEX file."
(let ((case-fold-search t)
(filename (expand-file-name (buffer-file-name)))
(output "*PDFLaTeX Output*"))
(when (string= (file-name-extension filename) "tex")
(shell-command
(concat "pdflatex -output-directory=" temporary-file-directory
" -halt-on-error \"" filename "\" && "
"cp \"" temporary-file-directory
(file-name-sans-extension
(file-name-nondirectory filename)) ".pdf" "\" "
"\"" (file-name-sans-extension filename) ".pdf" "\"")
output))))
(add-hook 'org-babel-post-tangle-hook #'org-babel-post-tangle-hook--generate-pdf-from-tex)
(init-message 3 "Org Mode: Babel: Racket")
(use-package ob-racket
:straight (ob-racket
:type git :host github :repo "hasu/emacs-ob-racket"
:files ("*.el" "*.rkt"))
:after (org)
:config
(add-hook 'ob-racket-pre-runtime-library-load-hook
#'ob-racket-raco-make-runtime-library)
(defvar org-babel-racket-command "racket")
(defvar org-babel-default-header-args:racket '())
(defvar org-babel-header-args:racket '((package . :any)))
(defun org-babel-execute:racket (body params)
"Execute a block of Racket Scheme code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block.
This function is called by `org-babel-execute-src-block'."
(let ((result
(if (with-temp-buffer
(insert (org-babel-expand-body:lisp body params))
(goto-char (point-min))
(re-search-forward "^[ \t]*#lang +\\([^ ]+\\)" nil :noerror))
(let ((src-file (org-babel-src-file "racket-" ".rkt")))
(with-temp-file src-file
(insert (org-babel-expand-body:lisp body params)))
(org-babel-eval (concat org-babel-racket-command " " src-file) ""))
(funcall (if (member "output" (cdr (assq :result-params params)))
(lambda (x) (cdr (assq (intern "output") x)))
(lambda (x) (cdr (assq (intern "result") x))))
(with-temp-buffer
(insert (org-babel-expand-body:lisp body params))
(racket-mode)
(goto-char (point-min))
(while (and (not (eobp))
(looking-at "^[ \t]*\\(;\\|$\\)"))
(forward-line 1))
(unless (eobp)
(if (fboundp 'geiser-eval-region)
(geiser-eval-region (point-min) (point-max) nil :raw)
(error "geiser-eval-region not defined"))))))))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assq :result-params params))
result
(condition-case nil
(read (org-babel-lisp-vector-to-list result))
(error result)))
(org-babel-pick-name (cdr (assq :colname-names params))
(cdr (assq :colnames params)))
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params)))))))
(init-message 3 "Org Mode: Babel: Java")
(use-package org
:straight (:type built-in)
:commands (org-babel-execute:java)
:config
(when (require 'ob-java nil :no-error)
(defun org-babel-execute:java (body params)
"Execute a block of Java code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block."
(let* ((classname (or (cdr (assoc :classname params))
(user-error ":classname parameter is required")))
(packagename (file-name-directory classname))
(src-file (concat classname ".java"))
(javacflags (or (cdr (assoc :javacflags params)) ""))
(javaflags (or (cdr (assoc :javaflags params)) ""))
(full-body (org-babel-expand-body:generic body params)))
(unless (or (not packagename) (file-exists-p packagename))
(make-directory packagename 'parents))
(with-temp-file src-file
(insert full-body)
(org-babel-eval (concat org-babel-java-compiler " " javacflags " " src-file) ""))
(let ((result (org-babel-eval (concat org-babel-java-command " " javaflags " " classname) "")))
(org-babel-reassemble-table
(org-babel-result-cond (cdr (assoc :result-params params))
(org-babel-read result)
(let ((temp-file (org-babel-temp-file "java-")))
(with-temp-file temp-file
(insert result)
(org-babel-import-elisp-from-file temp-file))))
(org-babel-pick-name (cdr (assoc :colname-names params))
(cdr (assoc :colnames params)))
(org-babel-pick-name (cdr (assoc :rowname-names params))
(cdr (assoc :rownames params)))))))))
(init-message 3 "Org Mode: Babel: Kotlin")
(use-package ob-kotlin
:straight t
:after (org kotlin-mode)
:commands (org-babel-execute:kotlin)
:functions (flycheck-mode
kotlin-send-buffer
org-babel-kotlin-command)
:defines (org-babel-kotlin-compiler)
:config
(defcustom org-babel-kotlin-command "kotlin"
"Name of the kotlin command.
May be either a command in the path, like kotlin or an absolute
path name, like /usr/local/bin/kotlin parameters may be used,
like kotlin -verbose"
:group 'org-babel
:type 'string)
(defcustom org-babel-kotlin-compiler "kotlinc"
"Name of the kotlin compiler.
May be either a command in the path, like kotlinc or an absolute
path name, like /usr/local/bin/kotlinc parameters may be used,
like kotlinc -verbose"
:group 'org-babel
:type 'string)
(defun org-babel-execute:kotlin (body params)
"If main function exists, then compile code and run jar
otherwise, run code in `kotlin-repl'."
(let* ((classname (or (cdr (assq :classname params)) "main"))
(src-file (org-babel-temp-file classname ".kt"))
(jar-file (concat (file-name-sans-extension src-file) ".jar"))
(cmpflag (or (cdr (assq :cmpflag params)) ""))
(cmdline (or (cdr (assq :cmdline params)) ""))
(full-body (org-babel-expand-body:generic body params)))
(if (or (string-match "fun main(args: Array<String>)" full-body)
(string-match "fun main()" full-body))
(progn
(with-temp-file src-file (insert full-body))
(org-babel-eval
(concat org-babel-kotlin-compiler " " cmpflag " " src-file " -include-runtime -d " jar-file) "")
(message (org-babel-eval (concat org-babel-java-command " " cmdline " -jar " jar-file) "")))
(with-temp-buffer
(insert body)
(kotlin-send-buffer))))))
(init-message 3 "Org Mode: Babel: Python")
(use-package org
:straight (:type built-in)
:after (python-mode)
:commands (org-babel-execute:python)
:config
(when (require 'ob-python nil :no-error)
(defun org-babel-execute:python (body params)
"Execute a block of Python code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block.
This function is called by `org-babel-execute-src-block'.
Note: This function only works with an iPython shell if it has
the autoindent feature turned off. Add '--no-autoindent' to
`py-ipython-command-args' to set this when an iPython process is
created."
(let* ((org-babel-python-command (or (cdr (assq :python params))
org-babel-python-command))
(session-name (cdr (assq :session params)))
(session (when (and session-name (not (string= session-name "none")))
(org-babel-python-initiate-session session)))
(result-params (cdr (assq :result-params params)))
(result-type (cdr (assq :result-type params)))
(return-val (when (and (eq result-type 'value) (not session))
(cdr (assq :return params))))
(preamble (cdr (assq :preamble params)))
(process (get-process python-shell-buffer-name))
(full-body
(org-babel-expand-body:generic
(concat body (if return-val (format "\nreturn %s" return-val) ""))
params (org-babel-variable-assignments:python params)))
(result (cond
(session
(org-babel-python-evaluate-session
session full-body result-type result-params))
(process
(process-send-string process (concat full-body "\n\n"))
(display-buffer (process-buffer process) t))
(t
(org-babel-python-evaluate-external-process
full-body result-type result-params preamble)))))
(org-babel-reassemble-table
result
(org-babel-pick-name (cdr (assq :colname-names params))
(cdr (assq :colnames params)))
(org-babel-pick-name (cdr (assq :rowname-names params))
(cdr (assq :rownames params))))))))
(init-message 3 "Org Mode: Babel: Rust")
(use-package ob-rust
:straight t
:after (org rust-mode)
:commands (org-babel-execute:rust)
:functions (flycheck-mode
rust-send-buffer
org-babel-rust-command)
:config
(when (require 'ob-rust nil :no-error)
(defun org-babel-execute:rust (body params)
"Execute a block of Rust code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block.
This function is called by `org-babel-execute-src-block'."
(let* ((tmp-src-file (org-babel-temp-file "rust-src-" ".rs"))
(tmp-run-file (org-babel-temp-file "rust-run-"))
(processed-params (org-babel-process-params params))
(_flags (cdr (assoc :flags processed-params)))
(_args (cdr (assoc :args processed-params)))
(coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8)
(wrapped-body
(save-match-data
(if (string-match "fn main()" body)
body
(if (string-match "fn \\(.*_test\\)()" body)
(concat body "\n\nfn main() {\n" (match-string 1 body) "();\n}")
(concat "fn main() {\n" body "\n}"))))))
(with-temp-file tmp-src-file (insert wrapped-body))
(let ((result
(org-babel-eval
(format "rustc -o %s %s && %s" tmp-run-file tmp-src-file tmp-run-file)
"")))
(when result
(org-babel-reassemble-table
(if (or (member "table" (cdr (assoc :result-params processed-params)))
(member "vector" (cdr (assoc :result-params processed-params))))
(let ((tmp-file (org-babel-temp-file "rust-")))
(with-temp-file tmp-file (insert (org-babel-trim result)))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read (org-babel-trim result) t))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))))))
(init-message 3 "Org Mode: Babel: V")
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("v" . "v"))
(defvar org-babel-v-command "v")
(defvar org-babel-default-header-args:v '())
(defvar org-babel-header-args:v '((package . :any)))
(defun org-babel-execute:v (body params)
"Execute a block of V code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block.
This function is called by `org-babel-execute-src-block'."
(let* ((tmp-src-file (org-babel-temp-file "v-src-" ".v"))
(tmp-run-file (org-babel-temp-file "v-run-"))
(processed-params (org-babel-process-params params))
(_flags (cdr (assoc :flags processed-params)))
(_args (cdr (assoc :args processed-params)))
(coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8)
(wrapped-body
(save-match-data
(if (string-match "fn main()" body)
body
(if (string-match "fn \\(test_.*\\)()" body)
(let ((start 0)
tests)
(while (string-match "fn \\(test_.*\\)()" body start)
(push (match-string 1 body) tests)
(setq start (match-end 0)))
(concat body
"\n\nfn main() {\n"
(apply #'concat (nreverse tests))
"()\n}"))
body)))))
(with-temp-file tmp-src-file (insert wrapped-body))
(let ((result
(org-babel-eval
(format "v -o %s %s && %s" tmp-run-file tmp-src-file tmp-run-file)
"")))
(when result
(org-babel-reassemble-table
(if (or (member "table" (cdr (assoc :result-params processed-params)))
(member "vector" (cdr (assoc :result-params processed-params))))
(let ((tmp-file (org-babel-temp-file "v-")))
(with-temp-file tmp-file (insert (org-babel-trim result)))
(org-babel-import-elisp-from-file tmp-file))
(org-babel-read (org-babel-trim result) t))
(org-babel-pick-name
(cdr (assoc :colname-names params)) (cdr (assoc :colnames params)))
(org-babel-pick-name
(cdr (assoc :rowname-names params)) (cdr (assoc :rownames params))))))))
(init-message 3 "Org Mode: Babel: Basic (Commander X16)")
(require 'basic)
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("basic" . "bas"))
(defvar org-babel-basic-command "x16emu -rom /usr/share/x16-rom/rom.bin")
(defun org-babel-execute:basic (body params)
"Execute a block of BASIC code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block."
(let ((src-file (org-babel-temp-file "basic-" ".bas")))
(with-temp-file src-file
(insert (org-babel-expand-body:generic body params)))
(org-babel-eval (concat org-babel-basic-command " -bas " src-file " -run &") "")))
(init-message 3 "Org Mode: Babel: Assembly Language (Commander X16)")
(defvar org-babel-tangle-lang-exts)
(add-to-list 'org-babel-tangle-lang-exts '("asm" . "asm"))
(defun org-babel-execute:asm (body params)
"Execute a block of Assembly Language code with Babel.
BODY is the contents of the block, as a string. PARAMS is a
property list containing the parameters of the block."
(let* ((base-file (org-babel-temp-file "asm-"))
(src-file (concat base-file ".asm"))
(list-file (concat base-file ".lst"))
(output-file (concat base-file ".prg"))
(defines (cdr (assoc :defines params)))
(cmpflag (or (cdr (assq :cmpflag params)) ""))
(cmdline (or (cdr (assq :cmdline params)) ""))
(x16emu (string= (cdr (assq :x16emu params)) "yes"))
(compile-command (concat "acme"
(if cmpflag (concat " " cmpflag) "")
(if defines (concat " -D " defines) "")
" --symbollist " list-file
" --outfile " output-file
" " src-file))
(run-command (when x16emu
(concat "x16emu -keymap en-us"
(if cmdline (concat " " cmdline) "")
" -prg " output-file " -run &"))))
(with-temp-file src-file
(insert (org-babel-expand-body:generic body params)))
(message "Compiling: %s" compile-command)
(org-babel-eval compile-command "")
(when x16emu
(message "Running: %s" run-command)
(org-babel-eval run-command ""))))
(init-message 3 "Org Mode: Babel: PlantUML")
(setq org-plantuml-jar-path "~/dev/java/lib/plantuml.jar")
(init-message 3 "Org Mode: Babel: Load Languages")
(org-babel-do-load-languages
'org-babel-load-languages '((C . t)
(clojure . t)
(css . t)
(ditaa . t)
(dot . t)
(emacs-lisp . t)
(gnuplot . t)
(java . t)
(js . t)
(kotlin . t)
(latex . t)
(lilypond . t)
(lisp . t)
(lua . t)
(makefile . t)
(org . t)
(perl . t)
(plantuml . t)
(python . t)
(racket . t)
(ruby . t)
(rust . t)
(scheme . t)
(shell . t)
(sql . t)))
(add-to-list 'org-src-lang-modes '("dot" . graphviz-dot))
(add-to-list 'org-src-lang-modes '("racket" . scheme))
(init-message 2 "Org Mode: Babel Functions")
(init-message 3 "Org Mode: Functions: org-babel-tangle-block")
(defun org-babel-tangle-block (&optional file)
"Tangle blocks for the tangle file of the block at point.
If FILE is non-nil, then search the buffer for blocks that tangle
to FILE and tangle them."
(interactive)
(if file
(save-excursion
(goto-char (point-min))
(when (re-search-forward (concat "#\\+BEGIN_SRC .* :tangle " file))
(org-babel-tangle '(16))))
(org-babel-tangle '(16))))
(init-message 3 "Org Mode: Functions: org-babel-tangle-file-async")
(defun org-babel-tangle-file-async (file &optional target-file lang-re)
"Asynchronous version of `org-babel-tangle-file'."
(interactive)
(let* ((file-hash (secure-hash 'md5 file))
(lock-file (expand-file-name
(concat "emacs-tangle-file-async-lock-file-" file-hash)
temporary-file-directory))
(run-file (expand-file-name
(concat "emacs-tangle-file-async-run-file-" file-hash)
temporary-file-directory)))
(if (file-exists-p lock-file)
(progn
(message "Tangle running: %s" file)
(unless (file-exists-p run-file)
(make-empty-file run-file)))
(message "Tangle started: %s" file)
(make-empty-file lock-file)
(eval
`(async-spinner
(lambda ()
(require 'ob-tangle)
(unless (file-exists-p ,run-file)
(make-empty-file ,run-file))
(while (file-exists-p ,run-file)
(delete-file ,run-file)
(org-babel-tangle-file ,file ,target-file ,lang-re)))
(lambda (result)
(message "Tangle finished: %s" ,file)
(delete-file ,lock-file)))))))
(mapc (lambda (x)
(mapc (lambda (f)
(delete-file f))
x))
(mapcar (lambda (x)
(file-expand-wildcards
(expand-file-name x temporary-file-directory)
:full))
'("emacs-tangle-file-async-lock-file-*"
"emacs-tangle-file-async-run-file-*")))
(init-message 3 "Org Mode: Babel Functions: org-generate-custom-id-from-title")
(defun org-generate-custom-id-from-title (title)
"Generate a proper `org-mode' CUSTOM_ID property from a given TITLE."
(replace-regexp-in-string
(rx (seq "-" "-")) "-"
(replace-regexp-in-string
(rx (seq "-" eol)) ""
(replace-regexp-in-string
(rx (seq bol "-")) ""
(replace-regexp-in-string
(rx (any ".")) "-dot-"
(replace-regexp-in-string
(rx (any " " "_" "/")) "-"
(replace-regexp-in-string
(rx (not (any alnum space "-" "_" "." "/"))) ""
(downcase title))))))))
(init-message 3 "Org Mode: Babel Functions: org-fix-literate-programming-heading")
(defun org-fix-literate-programming-heading ()
"Fix 'literate programming' heading of current org section.
Reset the CUSTOM_ID property, title comment, and `init-message'."
(interactive "*")
(save-window-excursion
(save-mark-and-excursion
(save-match-data
(org-with-wide-buffer
(forward-line 0)
(while (not (looking-at "^\*+ "))
(forward-line -1))
(let* ((case-fold-search t)
(start (point))
(count (length (progn
(re-search-forward "^\\(\*+\\) " (line-end-position))
(match-string-no-properties 1))))
(level (/ (1+ count) (if org-odd-levels-only 2 1)))
headings)
(goto-char start)
(while (and (not (bobp))
(> count 0))
(let ((regexp (concat "^\*\\{" (number-to-string count) "\\} \\(.*\\)$")))
(while (and (not (bobp))
(not (looking-at regexp)))
(forward-line -1))
(when (re-search-forward regexp (line-end-position))
(push (replace-regexp-in-string "+" "" (match-string-no-properties 1)) headings)
(setq count (- count (if org-odd-levels-only 2 1))))))
(let ((id (mapconcat (lambda (x) (org-generate-custom-id-from-title x))
headings "-"))
(title (mapconcat #'(lambda (x) x) headings ": ")))
(goto-char start)
(org-set-property "CUSTOM_ID" id)
(forward-line 1)
(indent-region (point) (re-search-forward "^[ \t]*:END:$"))
(let ((end (if (re-search-forward "^\*+ " nil :noerror) (point) (point-max))))
(goto-char start)
(when (re-search-forward "^[ \t]*#\\+BEGIN_SRC" end :noerror)
(org-babel-do-in-edit-buffer
(let* ((comment-1 (substring comment-start -1))
(comment-2 (if (= (length comment-start) 1)
(concat comment-start comment-start)
comment-start))
(comment-3 (concat comment-2 comment-1))
(comment-4 (concat comment-3 comment-1)))
(when (looking-at (concat
comment-2 "[=-]+\n"
comment-2 "+ .*\n"))
(replace-match
(concat
comment-2 (make-string 78 (if (> level 1) ?- ?=)) "\n"
(if (> level 2) comment-4 comment-3) " " title "\n"))
(forward-line 0)
(while (looking-at comment-2)
(when (looking-at (concat comment-2 "[=-]+\n"))
(replace-match
(concat comment-2 (make-string 78 (if (> level 1) ?- ?=)) "\n")))
(forward-line 1))))
(when (re-search-forward "(init-message .*$" nil :noerror)
(replace-match (concat "(init-message " (number-to-string level) " \"" title "\")")))))))))))))
(init-message 3 "Org Mode: Babel Functions: org-fix-literate-programming-heading-region")
(defun org-fix-literate-programming-heading-region (&optional beg end)
"Fix 'literate programming' headings contained with given region.
Reset the CUSTOM_ID property, title comment, and `init-message'."
(interactive "*")
(let ((case-fold-search t)
(beg (or beg (if (use-region-p)
(region-beginning)
(progn (beginning-of-line-text) (point)))))
(end (or end (if (use-region-p)
(region-end)
(line-end-position)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(org-with-wide-buffer
(narrow-to-region beg end)
(goto-char (point-min))
(while (and (re-search-forward "^[ \t]*:CUSTOM_ID:" nil :noerror)
(< (line-end-position) end))
(org-fix-literate-programming-heading)
(forward-line 1))))))))
(init-message 3 "Org Mode: Babel Functions: org-toggle-literate-programming-code-block")
(defun org-toggle-literate-programming-code-block ()
"Toggle 'literate programming' heading and code block on/off."
(interactive)
(save-window-excursion
(save-mark-and-excursion
(save-match-data
(org-with-wide-buffer
(org-back-to-heading t)
(let ((case-fold-search t)
(beg (point))
(end (progn
(forward-line 1)
(re-search-forward "^\*" nil 'move)
(1- (point)))))
(goto-char beg)
(re-search-forward " " (line-end-position))
(let ((toggle-on (looking-at "\+"))) (goto-char end)
(while (re-search-backward "^[ \t]*#\\+BEGIN_" beg :noerror)
(if toggle-on
(when (re-search-forward " :tangle no" (line-end-position) :noerror)
(replace-match ""))
(progn
(goto-char (line-end-position))
(insert " :tangle no")))
(forward-line 1)
(org-babel-do-in-edit-buffer
(if toggle-on
(uncomment-region (point-min) (point-max))
(comment-region (point-min) (point-max))))
(forward-line -2))
(goto-char beg)
(re-search-forward " " (line-end-position))
(if toggle-on
(dotimes (_ 2)
(when (re-search-forward "\+" (line-end-position))
(replace-match "")))
(progn
(insert "+")
(goto-char (line-end-position))
(insert "+"))))))))))
(init-message 3 "Org Mode: Babel Functions: org-insert-literate-programming-statics")
(defun org-insert-literate-programming-name ()
"Insert `org-babel' block NAME"
(interactive "*")
(org-indent-line)
(insert "#+NAME: "))
(defmacro org-insert-literate-programming-src-function (name &optional lang)
"Return org babel insert function from NAME and optional LANG.
LANG is only needed if the language section of the block is
different from NAME."
(let* ((lang (or lang name))
(funct (intern (concat "org-insert-literate-programming-src"
(if name (concat "-" name) ""))))
(doc (concat "Insert `org-babel'"
(if lang (concat " " name) "")
" source block"))
(block (concat "#+BEGIN_SRC"
(if lang (concat " " lang) "")
"\n\n#+END_SRC\n")))
`(defun ,funct ()
,doc
(interactive "*")
(let ((point (point)))
(insert ,block)
(indent-region point (point))
(forward-line -2)))))
(org-insert-literate-programming-src-function nil)
(org-insert-literate-programming-src-function "sh")
(org-insert-literate-programming-src-function "sh-sudo" "sh :dir /sudo::")
(org-insert-literate-programming-src-function "emacs-lisp")
(org-insert-literate-programming-src-function "racket")
(org-insert-literate-programming-src-function "kotlin")
(init-message 3 "Org Mode: Babel Functions: org-insert-literate-programming-block")
(defun org-insert-literate-programming-block (&optional title)
"Insert 'literate programming' block consisting of a heading,
properties, and source block."
(interactive "*")
(let* ((case-fold-search t)
(point (point))
(title (or title (read-string "Block title: ")))
(tag (org-generate-custom-id-from-title title)))
(org-insert-heading)
(insert title)
(org-set-property "CUSTOM_ID" tag)
(re-search-forward "^[ \t]*:END:$")
(newline)
(newline)
(insert "#+BEGIN_SRC conf-unix\n")
(insert "#+END_SRC\n")
(indent-region point (point))
(org-previous-visible-heading 1)
(goto-char (line-end-position))
(org-fix-literate-programming-heading)
(forward-line 12)))
(init-message 3 "Org Mode: Babel Functions: org-insert-literate-programming-init-emacs-block")
(defun org-insert-literate-programming-init-emacs-block (&optional title)
"Insert 'literate programming' init-emacs block consisting of a heading,
properties, source block, title comment, and `init-message'."
(interactive "*")
(let* ((case-fold-search t)
(point (point))
(title (or title (read-string "Block title: ")))
(tag (org-generate-custom-id-from-title title)))
(org-insert-heading)
(insert title)
(org-set-property "CUSTOM_ID" tag)
(re-search-forward "^[ \t]*:END:$")
(newline)
(newline)
(insert "#+BEGIN_SRC emacs-lisp\n")
(insert " ;;------------------------------------------------------------------------------\n")
(insert " ;;;; " title "\n")
(insert " ;;------------------------------------------------------------------------------\n")
(newline)
(insert " (init-message 2 \"" title "\")\n")
(newline)
(newline)
(insert "#+END_SRC\n")
(indent-region point (point))
(org-previous-visible-heading 1)
(goto-char (line-end-position))
(org-fix-literate-programming-heading)
(forward-line 12)))
(init-message 3 "Org Mode: Babel Functions: org-insert-literate-programming-code-block")
(defun org-insert-literate-programming-code-block ()
"Insert 'literate programming' code block consisting of a heading,
properties, source block, and title comment."
(interactive "*")
(let* ((case-fold-search t)
(point (point))
(title (read-string "Block title: "))
(funct (org-generate-custom-id-from-title title))
(lang (save-mark-and-excursion
(if (re-search-backward "^[ \t]*#\\+BEGIN_SRC \\([^ \t\n]*\\)" nil :noerror)
(match-string 1)
"emacs-lisp"))))
(org-previous-visible-heading 1)
(org-insert-heading-respect-content)
(insert title)
(org-set-property "CUSTOM_ID" funct)
(re-search-forward "^[ \t]*:END:$")
(newline)
(newline)
(insert "#+BEGIN_SRC " lang "\n")
(insert " ;;------------------------------------------------------------------------------\n")
(insert " ;;;; " title "\n")
(insert " ;;------------------------------------------------------------------------------\n")
(newline)
(insert " (define (" funct " num)\n")
(insert " )\n")
(insert "#+END_SRC\n")
(newline)
(insert "#+BEGIN_SRC " lang " :tangle no\n")
(insert " (define (" funct "-test)\n")
(insert " (check-equal? (" funct " ) )\n")
(insert " )\n")
(insert "#+END_SRC\n")
(indent-region point (point))
(org-previous-visible-heading 1)
(goto-char (line-end-position))
(org-fix-literate-programming-heading)
(forward-line 10)))
(init-message 3 "Org Mode: Babel Functions: org-insert-literate-programming-project-euler-problem-block")
(defun org-insert-literate-programming-project-euler-problem-block ()
"Insert 'literate programming' project euler problem block consisting of a
heading, properties, source block with title comment, and test block."
(interactive "*")
(let* ((case-fold-search t)
(point (point))
(num (read-string "Problem number: "))
(title (concat "Problem " num))
(funct (format "project-euler-%03d" (string-to-number num)))
(lang (save-mark-and-excursion
(if (re-search-backward "^[ \t]*#\\+BEGIN_SRC \\([^ \t\n]*\\)" nil :noerror)
(match-string 1)
"emacs-lisp"))))
(org-previous-visible-heading 1)
(org-insert-heading-respect-content)
(insert title)
(org-set-property "CUSTOM_ID" funct)
(re-search-forward "^[ \t]*:END:$")
(newline)
(newline)
(insert "#+BEGIN_SRC " lang "\n")
(insert " ;;------------------------------------------------------------------------------\n")
(insert " ;;;; " title "\n")
(insert " ;;\n")
(insert " ;;\n")
(insert " ;;\n")
(insert " ;; The correct answer is: \n")
(insert " ;;------------------------------------------------------------------------------\n")
(newline)
(insert " (define (" funct " [num 1000])\n")
(insert " )\n")
(insert "#+END_SRC\n")
(newline)
(insert "#+BEGIN_SRC " lang " :tangle no\n")
(insert " (define (" funct "-test)\n")
(insert " (check-equal? (" funct " ) )\n")
(insert " )\n")
(insert "#+END_SRC\n")
(indent-region point (point))
(org-previous-visible-heading 1)
(goto-char (line-end-position))
(org-fix-literate-programming-heading)
(forward-line 9)))
(init-message 2 "Org Mode: Visibility")
(use-package org-visibility
:straight t
:after (org)
:demand t
:bind* (:map org-visibility-mode-map
("C-x C-v" . org-visibility-force-save) ("C-x M-v" . org-visibility-remove)) :custom
(org-visibility-include-paths `(,(file-truename "~/.emacs.d/init-emacs.org")
,(file-truename "~/code/github-nullman")
,(file-truename "~/dev")
,(file-truename "~/doc/bbs")
,(file-truename "~/org")
,(file-truename "~/web/org")))
(org-visibility-exclude-paths `(,(file-truename "~/org/old")
,(file-truename "~/org/test")))
:init
(org-visibility-mode 1))
(init-message 2 "Org Mode: Present")
(use-package org-present
:straight t
:config
(defun org-present-read-only ()
"Make buffer read-only."
(interactive)
(setq buffer-read-only t)
(define-key org-present-mode-keymap (kbd "SPC") #'org-present-next))
(defun custom-org-present-mode-hook ()
"Customizations for entering `org-present-mode'."
(setq-local face-remapping-alist '((default (:height 1.5) variable-pitch)
(header-line (:height 4.0) variable-pitch)
(org-document-title (:height 1.75) org-document-title)
(org-code (:height 1.55) org-code)
(org-verbatim (:height 1.55) org-verbatim)
(org-block (:height 1.25) org-block)
(org-block-begin-line (:height 0.7) org-block)))
(setq-local header-line-format " ")
(org-display-inline-images)
(org-present-hide-cursor)
(org-present-read-only)
(when (fboundp 'visual-fill-column-mode)
(visual-fill-column-mode 1))
(visual-line-mode 1))
(add-hook 'org-present-mode-hook #'custom-org-present-mode-hook)
(defun custom-org-present-mode-quit-hook ()
"Customizations for exiting `org-present-mode'."
(setq-local face-remapping-alist '((default variable-pitch default)))
(setq-local header-line-format nil)
(org-remove-inline-images)
(org-present-show-cursor)
(org-present-read-write)
(when (fboundp 'visual-fill-column-mode)
(visual-fill-column-mode 0))
(visual-line-mode 0))
(add-hook 'org-present-mode-quit-hook #'custom-org-present-mode-quit-hook)
(defun custom-org-present-after-navigate-functions (buffer-name heading)
"Customizations for navigating in `org-present-mode'."
(org-overview)
(org-show-entry)
(org-show-children))
(add-hook 'org-present-after-navigate-functions #'custom-org-present-after-navigate-functions))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-guid")
(defun org-bookmarks-guid ()
"Return a twelve character GUID."
(cl-labels
((random-char ()
(let ((num (random 62)))
(cond
((< num 10)
(byte-to-string (+ num 48)))
((< num 36)
(byte-to-string (+ num 55)))
(t
(byte-to-string (+ num 61)))))))
(cl-loop repeat 12
concat (random-char))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-timestamp")
(defun org-bookmarks-timestamp ()
"Return time since the epoch in microseconds."
(floor (* (float-time (current-time)) 1000000)))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-parse")
(defun org-bookmarks-parse (file)
"Return a tree structure representing the org folders and
bookmarks found in FILE.
Example input:
* Folder 1
** Folder 2
*** Bookmark 1
URI1
*** Bookmark 2 [bm2]
URI2
** Folder 3
Example output:
((:type \"folder\" :title \"Folder 1\" :children
[(:type \"folder\" :title \"Folder 2\" :children
[(:type \"bookmark\" :title \"Bookmark 1\" :uri \"URI1\")
(:type \"bookmark\" :title \"Bookmark 2\" :uri \"URI2\" :keyword \"bm2\")])
(:type \"folder\" :title \"Folder 3\")]))"
(cl-labels
((parse (bm tree)
(cond
((not bm)
nil)
((and (stringp (car bm)) (stringp (cadr bm)))
(let* ((title (car x))
(uri (cadr x))
(keyword (if (string-match " \\[\\(.*\\)\\]$" title)
(match-string-no-properties 1 title)
nil))
(title (replace-regexp-in-string " \\[.*\\]$" "" title))
(entry (list :type "bookmark" :title title :uri uri)))
(when keyword
(setq entry (append entry (list :keyword keyword))))
entry))
((stringp (car bm))
(let* ((title (car bm))
(entry (list :type "folder" :title title)))
(if (cdr bm)
(append entry (list :children (map 'vector (lambda (x)
(parse x tree))
(cdr bm))))
entry))))))
(let ((bm (org-get-file-data file)))
(map 'vector (lambda (x)
(parse x nil))
(cdr bm)))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-export-to-json")
(defun org-bookmarks-export-to-json (org-file &optional json-file)
"Export from an Org Bookmarks file, ORG-FILE,
to a Mozilla/Firefox Bookmarks JSON file, JSON-FILE.
If JSON-FILE is nil, then output is returned."
(let* ((type-code-list '(("bookmark" . 1)
("folder" . 2)))
(type-value-list '(("bookmark" . "text/x-moz-place")
("folder" . "text/x-moz-place-container")))
(title-guid-list '(("Bookmarks Toolbar" . "toolbar_____")
("Bookmarks Menu" . "menu________")
("Other Bookmarks" . "unfiled_____")
("Mobile Bookmarks" . "mobile______")))
(title-root-list '(("Bookmarks Toolbar" . "toolbarFolder")
("Bookmarks Menu" . "bookmarksMenuFolder")
("Other Bookmarks" . "unfiledBookmarksFolder")
("Mobile Bookmarks" . "mobileFolder")))
(global-id 0)
(timestamp (org-bookmarks-timestamp)))
(cl-labels
((gen-id ()
(cl-incf global-id))
(parse (bm tree index)
(let* ((type (plist-get bm :type))
(type-value (cdr (assoc type type-value-list)))
(type-code (cdr (assoc type type-code-list)))
(title (plist-get bm :title))
(uri (plist-get bm :uri))
(keyword (plist-get bm :keyword))
(children (plist-get bm :children))
(guid (org-bookmarks-guid))
(id (gen-id))
(root (cdr (assoc title title-root-list)))
(custom-guid (cdr (assoc title title-guid-list)))
(entry (list
:guid (or custom-guid guid)
:title title
:index index
:dateAdded timestamp
:lastModified timestamp
:id id
:typeCode type-code
:type type-value)))
(when uri
(setq entry (append entry (list :uri uri))))
(when keyword
(setq entry (append entry (list :keyword keyword))))
(when root
(setq entry (append entry (list :root root))))
(when children
(let ((idx -1))
(setq entry (append entry (list :children (map 'vector (lambda (x) (parse x tree (cl-incf idx))) children))))))
(append tree entry))))
(let ((json-object-type 'plist)
(json-array-type 'vector)
(json-key-type 'string)
(bookmarks (org-bookmarks-parse org-file)))
(with-temp-buffer
(insert
(json-encode
(list :guid "root________"
:title ""
:index 0
:dateAdded timestamp
:lastModified timestamp
:id (gen-id)
:typeCode 2
:type (cdr (assoc "folder" type-value-list))
:root "placesRoot"
:children (map 'vector (lambda (x) (parse x nil 0)) bookmarks))))
(newline)
(json-pretty-print (point-min) (point-max))
(if json-file
(write-region (point-min) (point-max) json-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-export-to-text")
(defun org-bookmarks-export-to-text (org-file &optional text-file)
"Export from an Org Bookmarks file, ORG-FILE,
to a text file, TEXT-FILE.
If TEXT-FILE is nil, then output is returned."
(let ((title-root-list '(("Bookmarks Toolbar" . "Toolbar")
("Bookmarks Menu" . "Menu")
("Other Bookmarks" . "Other")
("Mobile Bookmarks" . "Mobile"))))
(cl-labels
((folder? (type)
(string= type "folder"))
(path-string (path)
(string-join (reverse path) " > "))
(parse (bm path)
(let* ((type (plist-get bm :type))
(folder? (folder? type))
(title (plist-get bm :title))
(uri (plist-get bm :uri))
(keyword (plist-get bm :keyword))
(children (plist-get bm :children))
(root? (cdr (assoc title title-root-list)))
(path path))
(unless folder?
(insert
(if keyword
(format "%s > %s [%s]: %s\n" (path-string path) title keyword uri)
(format "%s > %s: %s\n" (path-string path) title uri))))
(when children
(let ((path (if root? (list root?)
(cons title path))))
(map 'vector (lambda (x) (parse x path)) children))))))
(let ((bookmarks (org-bookmarks-parse org-file)))
(with-temp-buffer
(map 'vector (lambda (x) (parse x '())) bookmarks)
(if text-file
(write-region (point-min) (point-max) text-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-export-to-html")
(defun org-bookmarks-export-to-html (org-file &optional html-file)
"Export from an Org Bookmarks file, ORG-FILE,
to a Mozilla/Firefox Bookmarks HTML file, HTML-FILE.
If HTML-FILE is nil, then output is returned."
(let* ((type-code-list '(("bookmark" . 1)
("folder" . 2)))
(title-code-list '(("Bookmarks Toolbar" . "PERSONAL_TOOLBAR_FOLDER")
("Other Bookmarks" . "UNFILED_BOOKMARKS_FOLDER")))
(timestamp (number-to-string (truncate (org-bookmarks-timestamp) 1000000))))
(cl-labels
((indent (idt str)
(concat (spaces-string idt) str))
(parse (bm str idt)
(let* ((type (plist-get bm :type))
(type-code (cdr (assoc type type-code-list)))
(title (plist-get bm :title))
(title-code (cdr (assoc title title-code-list)))
(uri (url-encode-url (plist-get bm :uri)))
(keyword (plist-get bm :keyword))
(children (plist-get bm :children))
(entry (cl-case type-code
(2 (concat
(indent idt "<DT><H3")
" ADD_DATE=\"" timestamp "\""
" LAST_MODIFIED=\"" timestamp "\""
(if title-code (concat " " title-code "=\"true\"") "")
">" title "</H3>"))
(1 (concat
(indent idt "<DT>")
"<A HREF=\"" uri "\""
" ADD_DATE=\"" timestamp "\""
" LAST_MODIFIED=\"" timestamp "\""
(if keyword (concat " SHORTCUTURL=\"" keyword "\"") "")
">" title "</A>")))))
(when children
(setq entry (concat entry
"\n" (indent idt "<DL><p>\n")
(mapconcat (lambda (x) (parse x str (+ idt 4))) children "\n")
"\n" (indent idt "</DL><p>\n"))))
entry)))
(let ((bookmarks (org-bookmarks-parse org-file)))
(with-temp-buffer
(insert
(concat
"<!DOCTYPE NETSCAPE-Bookmark-file-1>
<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=UTF-8\">
<TITLE>Bookmarks</TITLE>
<H1>Bookmarks Menu</H1>
<DL><p>\n"
(mapconcat (lambda (x) (parse x "" 4)) bookmarks "\n"))
"</DL><p>\n")
(if html-file
(write-region (point-min) (point-max) html-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-export-to-nyxt")
(defun org-bookmarks-export-to-nyxt (org-file &optional nyxt-file)
"Export from an Org Bookmarks file, ORG-FILE,
to an NYXT Bookmarks Lisp file, NYXT-FILE.
If NYXT-FILE is nil, then output is returned."
(let ((timestamp (format-time-string "%FT%T.%6NZ"))
(title-root-list '(("Bookmarks Toolbar" . "toolbarFolder")
("Bookmarks Menu" . "bookmarksMenuFolder")
("Other Bookmarks" . "unfiledBookmarksFolder")
("Mobile Bookmarks" . "mobileFolder"))))
(cl-labels
((folder? (type)
(string= type "folder"))
(tags (name)
(split-string name " " :omit-nulls))
(parse (bm tags)
(let* ((type (plist-get bm :type))
(folder? (folder? type))
(title (plist-get bm :title))
(uri (plist-get bm :uri))
(keyword (plist-get bm :keyword))
(children (plist-get bm :children))
(root? (cdr (assoc title title-root-list)))
(tags tags))
(when (and folder? (not root?))
(setq tags (append tags (tags title))))
(when keyword
(setq tags (append tags (list keyword))))
(unless folder?
(insert
(format "%S\n" (list :url uri :title title :date timestamp :tags tags))))
(when children
(map 'vector (lambda (x) (parse x tags)) children)))))
(let ((bookmarks (org-bookmarks-parse org-file)))
(with-temp-buffer
(insert "(\n")
(map 'vector (lambda (x) (parse x '())) bookmarks)
(insert ")\n")
(if nyxt-file
(write-region (point-min) (point-max) nyxt-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(init-message 3 "Org Mode: Bookmarks: org-bookmarks-export-to-chrome-html")
(defun org-bookmarks-export-to-chrome-html (org-file &optional html-file)
"Export from an Org Bookmarks file, ORG-FILE,
to a Chrome/Chromium Bookmarks HTML file, HTML-FILE.
If HTML-FILE is nil, then output is returned."
(let* ((type-code-list '(("bookmark" . 1)
("folder" . 2)))
(title-code-list '(("Bookmarks Toolbar" . "PERSONAL_TOOLBAR_FOLDER")
("Other Bookmarks" . "UNFILED_BOOKMARKS_FOLDER")))
(title-rename-list '(("Bookmarks Toolbar" . "Bookmarks bar")
("Bookmarks Menu" . :none)
("Other Bookmarks" . :none)))
(timestamp (number-to-string (truncate (org-bookmarks-timestamp) 1000000))))
(cl-labels
((indent (idt str)
(concat (spaces-string idt) str))
(parse (bm str idt)
(let* ((type (plist-get bm :type))
(type-code (cdr (assoc type type-code-list)))
(title (plist-get bm :title))
(title-code (cdr (assoc title title-code-list)))
(title-rename (cdr (assoc title title-rename-list)))
(skip (eq title-rename :none))
(uri (url-encode-url (plist-get bm :uri)))
(keyword (plist-get bm :keyword))
(children (plist-get bm :children))
(entry (cl-case type-code
(2 (if skip
""
(concat
(indent idt "<DT><H3")
" ADD_DATE=\"" timestamp "\""
" LAST_MODIFIED=\"" timestamp "\""
(if title-code (concat " " title-code "=\"true\"") "")
">" (or title-rename title) "</H3>")))
(1 (concat
(indent idt "<DT>")
"<A HREF=\"" uri "\""
" ADD_DATE=\"" timestamp "\""
" LAST_MODIFIED=\"" timestamp "\""
(if keyword (concat " SHORTCUTURL=\"" keyword "\"") "")
">" title "</A>")))))
(when children
(setq entry (concat entry
(if skip "" (concat "\n" (indent idt "<DL><p>\n")))
(mapconcat (lambda (x) (parse x str (+ idt 4))) children "\n")
(if skip "" (concat "\n" (indent idt "</DL><p>\n"))))))
entry)))
(let ((bookmarks (org-bookmarks-parse org-file)))
(with-temp-buffer
(insert
(concat
"<!DOCTYPE NETSCAPE-Bookmark-file-1>
<META HTTP-EQUIV=\"Content-Type\" CONTENT=\"text/html; charset=UTF-8\">
<TITLE>Bookmarks</TITLE>
<H1>Bookmarks</H1>
<DL><p>\n"
(mapconcat (lambda (x) (parse x "" 4)) bookmarks "\n"))
"</DL><p>\n")
(if html-file
(write-region (point-min) (point-max) html-file)
(buffer-substring-no-properties (point-min) (point-max))))))))
(init-message 2 "Org Mode: Finances")
(init-message 3 "Org Mode: Finances: export-taxes")
(defun export-taxes ()
"Export tax information found at current org subtree."
(interactive)
(let* ((title (concat
"Sherman Taxes "
(save-mark-and-excursion
(save-match-data
(forward-line 0)
(re-search-forward "^\*+ " (line-end-position))
(buffer-substring-no-properties (point) (line-end-position))))))
(target-buffer (generate-new-buffer-name (concat "*" title "*"))))
(org-cycle 8)
(org-copy-subtree)
(set-buffer (get-buffer-create target-buffer))
(org-mode)
(buffer-disable-undo)
(org-paste-subtree)
(goto-char (point-min))
(kill-region (line-beginning-position) (line-end-position))
(insert title)
(newline)
(insert "------------------")
(while (re-search-forward "^\*\\{3\\} " nil :noerror)
(kill-region (line-beginning-position) (point))
(insert "\n\n")
(capitalize-region (line-beginning-position) (line-end-position))
(goto-char (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "^\*\\{5\\} " nil :noerror)
(kill-region (line-beginning-position) (point))
(insert "\n- ")
(capitalize-region (line-beginning-position) (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "^\*\\{7\\} " nil :noerror)
(kill-region (line-beginning-position) (point))
(insert " - ")
(capitalize-region (line-beginning-position) (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "^\|-" nil :noerror)
(forward-line 0)
(when (save-mark-and-excursion
(forward-line -1)
(not (looking-at "^$")))
(newline))
(goto-char (org-table-end)))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#\\+TBLFM:.*$" nil :noerror)
(kill-region (line-beginning-position) (1+ (point))))
(goto-char (point-min))
(switch-to-buffer target-buffer)))
(init-message 3 "Org Mode: Finances: nwm-add-monthly-account-data")
(defun nwm-add-monthly-account-data (data)
"Add Northwestern Mutual monthly entries for all accounts found in DATA."
(interactive "*sNorthwestern Mutual Account Summary: ")
(cl-labels
((date-to-year-month (date)
(concat
(substring date 6 10)
(substring date 0 2))))
(let ((buffer (get-buffer "personal-encrypted.org.gpg"))
(tables '("NWM_A40_344433"
"NWM_A40_344458"
"NWM_A40_345190"
"NWM_B40_300756"
"NWM_B40_300798"
"NWM_PX1_012685"
"NWM_PX1_012692"))
date
balances)
(with-temp-buffer
(insert data)
(goto-char (point-min))
(re-search-forward "^Period Ending: ")
(setq date (date-to-year-month
(buffer-substring-no-properties (point) (line-end-position))))
(mapcar (lambda (x)
(re-search-forward "%\\([0-9,]*\.[0-9][0-9]\\)[0-9.]*%")
(push (replace-regexp-in-string "," "" (match-string 1)) balances))
tables))
(with-current-buffer buffer
(do ((tables tables (cdr tables))
(balances (nreverse balances) (cdr balances)))
((null tables))
(goto-char (point-min))
(re-search-forward (concat "^[ \t]*#\\+NAME: " (car tables) "$"))
(goto-char (org-table-end))
(forward-line -4)
(org-table-insert-row)
(org-table-goto-column 1)
(insert "#")
(org-table-goto-column 2)
(insert date)
(org-table-goto-column 4)
(insert (car balances))
(org-table-recalculate)
(re-search-forward (concat "^[ \t]*#\\+NAME: " (car tables) "_STATS$"))
(forward-line 1)
(org-table-recalculate)
(org-table-recalculate))))))
(init-message 2 "Org Mode: Magic the Gathering")
(defconst mtg-cards-owned-file-name (file-truename (expand-file-name "~/org/magic-the-gathering-cards-owned.org")))
(init-message 3 "Org Mode: Magic the Gathering: mtg-card-list")
(defun mtg-card-list ()
"Create a list of Magic The Gathering cards in inventory."
(interactive)
(unless (string= (buffer-name) (file-name-nondirectory mtg-cards-owned-file-name))
(find-file mtg-cards-owned-file-name))
(let ((source-buffer (current-buffer))
(target-buffer (generate-new-buffer-name "*mtg*")))
(set-buffer (get-buffer-create target-buffer))
(buffer-disable-undo)
(insert-buffer-substring source-buffer)
(goto-char (point-min))
(search-forward "* mtg cards owned")
(forward-line 0)
(kill-region (point-min) (point))
(unless (search-forward "* mtg card sets" nil :noerror)
(goto-char (point-max)))
(forward-line 0)
(kill-region (point) (point-max))
(org-mode)
(goto-char (point-min))
(outline-show-subtree)
(while (re-search-forward "^| +|.*\n" nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward "| +Artist" nil :noerror)
(org-table-delete-column))
(goto-char (point-min))
(switch-to-buffer target-buffer)))
(init-message 3 "Org Mode: Magic the Gathering: mtg-deck-search")
(defun mtg-deck-search ()
"Show cards owned from a deck list.
LIST must have one card per line with the number of cards
followed by the card name."
(interactive)
(let ((buffer (current-buffer))
cards
(ignored '("Plains" "Island" "Swamp" "Mountain" "Forest")))
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(while (re-search-forward "^\s*\\([0-9]+\\)\s*\\(.*\\)\s*$" nil :noerror)
(let ((name (buffer-substring-no-properties (match-beginning 2) (match-end 2)))
(count (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(setq name (replace-regexp-in-string "\s*\\[.*\\]\s*" "" name))
(unless (member name ignored)
(push (list name count) cards))))))
(setq cards (sort cards (lambda (a b) (string< (car a) (car b)))))
(find-file mtg-cards-owned-file-name)
(occur (concat "\\(" (substring (apply #'concat (mapcar (lambda (x) (concat "\\|" (car x))) cards)) 2) "\\)"))
(switch-to-buffer buffer)))
(init-message 3 "Org Mode: Magic the Gathering: mtg-set-to-table")
(defun mtg-set-to-table (&optional owned)
"Convert `http://gatherer.wizards.com/' set checklist list to table.
If OWNED is non-nil, add an Owned column to the table."
(interactive "P")
(goto-char (point-min))
(let ((source-buffer (current-buffer))
(target-buffer (generate-new-buffer-name "*mtg-set-table*")))
(set-buffer (get-buffer-create target-buffer))
(buffer-disable-undo)
(insert-buffer-substring source-buffer)
(goto-char (point-min))
(delete-non-matching-lines "<tr class=\"cardItem\">" (point-min) (point-max))
(goto-char (point-min))
(while (re-search-forward "</tr><tr" nil :noerror)
(replace-match "</tr>\n<tr"))
(goto-char (point-min))
(while (re-search-forward "<td[^>]*>" nil :noerror)
(replace-match "| "))
(goto-char (point-min))
(while (re-search-forward "</td>" nil :noerror)
(replace-match " "))
(goto-char (point-min))
(while (re-search-forward "^\s*<tr[^>]*>" nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward "</tr>" nil :noerror)
(replace-match "|"))
(goto-char (point-min))
(while (re-search-forward "<a[^>]*>" nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward "</a>" nil :noerror)
(replace-match ""))
(goto-char (point-min))
(goto-char (point-min))
(insert (concat "|-+-+-+-+-+-|"))
(newline)
(insert (concat "| # | Name | Artist | Color | Rarity | Set |"))
(newline)
(insert (concat "|-+-+-+-+-+-|"))
(newline)
(goto-char (point-max))
(insert (concat "|-+-+-+-+-+-|"))
(goto-char (point-min))
(org-mode)
(org-table-align)
(when owned
(org-table-insert-column)
(insert "Owned")
(org-table-align))
(switch-to-buffer target-buffer)))
(init-message 2 "Org Mode: MechWarrior Online")
(init-message 3 "Org Mode: MechWarrior Online: mwo-export-mech")
(defun mwo-export-mech ()
"Export mech found at current org subtree."
(interactive)
(let ((target-buffer (generate-new-buffer-name "*mwo-mech*")))
(org-cycle 8)
(org-copy-subtree)
(set-buffer (get-buffer-create target-buffer))
(buffer-disable-undo)
(org-paste-subtree)
(goto-char (point-min))
(while (re-search-forward "^\*+ " (line-end-position) :noerror)
(replace-match ""))
(while (re-search-forward "^\*+ " nil :noerror)
(kill-region (line-beginning-position) (point))
(newline)
(capitalize-region (line-beginning-position) (line-end-position))
(goto-char (line-end-position))
(newline))
(switch-to-buffer target-buffer)
(goto-char (point-min))))
(init-message 2 "Org Mode: Dungeons and Dragons Online")
(init-message 3 "Org Mode: Dungeons and Dragons Online: ddo-get-item-info")
(defun ddo-get-item-info (&optional item)
"Look up ITEM in the DDO Wiki and return information about it."
(interactive "sDDO Item Name: ")
(save-current-buffer
(let* ((url (url-encode-url (concat "http://ddowiki.com/index.php?search=" item)))
(buffer (url-retrieve-synchronously url))
(enchantments ""))
(when buffer
(set-buffer buffer)
(goto-char (point-min))
(when (re-search-forward "Enchantments" nil :noerror)
(let ((start (point)))
(when (re-search-forward "</td>" nil :noerror)
(let ((end (point)))
(goto-char start)
(while (re-search-forward "<a .*>\\([^<]*\\)</a>" end :noerror)
(setq enchantments
(concat
enchantments
(if (zerop (length enchantments)) "" ", ")
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))
(when (re-search-forward "</span>\\([^<]*\\)</li>" end :noerror)
(setq enchantments
(concat
enchantments
(buffer-substring-no-properties (match-beginning 1) (match-end 1))))))))))
(concat item " (" enchantments ")\n" url)))))
(init-message 3 "Org Mode: Dungeons and Dragons Online: ddo-fix-wiki-description")
(defun ddo-fix-wiki-description ()
"Fix wiki description around point."
(interactive)
(forward-line 0)
(while (not (looking-at "\\*"))
(insert ", ")
(forward-line 0)
(delete-char -1)
(forward-line 0))
(while (re-search-forward "Icon tooltip\.png" (line-end-position) :noerror)
(replace-match ""))
(forward-line 0)
(while (re-search-forward " +," (line-end-position) :noerror)
(replace-match ","))
(forward-line 0)
(while (re-search-forward ",," (line-end-position) :noerror)
(replace-match ","))
(forward-line 0)
(while (re-search-forward " +" (line-end-position) :noerror)
(replace-match " "))
(forward-line 0)
(while (re-search-forward " +$" (line-end-position) :noerror)
(replace-match ""))
(goto-char (line-end-position))
(insert ")"))
(init-message 1 "Org Website")
(init-message 2 "Org Website: Configuration")
(init-message 3 "Org Website: Configuration: Publish Configuration")
(use-package org
:straight (:type built-in)
:commands (org-export-as
org-export-to-buffer
org-export-to-file)
:functions (org-export-collect-footnote-definitions
org-export-data
org-export-define-derived-backend
org-export-footnote-first-reference-p
org-export-get-footnote-number
org-export-get-previous-element
org-export-get-relative-level
org-website-convert-url-to-gopher-selector-hostname-port)
:config
(when (require 'ox nil :no-error)
(defun org-link-gopher-export-link (link desc format)
"Create export version of LINK and DESC to FORMAT."
(let ((link (concat "gopher:" link)))
(cond
((eq format 'html)
(format "<a href=\"%s\">%s</a>" link desc))
((eq format 'latex)
(format "\\href{%s}{%s}" link desc))
((eq format 'gopher)
(format "1\t%s\t%s" desc (org-website-convert-url-to-gopher-selector-hostname-port link)))
(t
(format "[%s](%s)" desc link)))))
(org-link-set-parameters "gopher" :export #'org-link-gopher-export-link))
(require 'ox-publish nil :no-error)
(require 'ox-ascii nil :no-error)
(when (require 'ox-html nil :no-error)
(let* ((site-extension "org")
(shared-extension "css")
(statics-extension (concat "html\\|css\\|js\\|sh\\|"
"txt\\|rss\\|"
"ico\\|gif\\|png\\|jpg\\|"
"mp4\\|webm\\|"
"eot\\|ttf\\|woff\\|"
"pdf\\|odt\\|doc\\|docx\\|"
"tgz\\|zip\\|"
"xml\\|xsd\\|xsl"))
(assets-extension (concat "org\\|" statics-extension)))
(setq org-publish-project-alist
`( ("nullman" :components ("nullman-shared"
"nullman-assets"
"nullman-site"
"nullman-site-statics"
"nullman-site-gopher"
"rsync"))
("nullman-shared"
:base-directory "~/web/sites/shared"
:base-extension ,shared-extension
:publishing-directory "~/web/sites/nullman/site"
:publishing-function org-publish-attachment
:recursive t)
("nullman-assets"
:base-directory "~/web/sites/nullman/assets"
:base-extension ,assets-extension
:publishing-directory "~/web/sites/nullman/site"
:publishing-function org-publish-attachment
:recursive t)
("nullman-site"
:base-directory "~/web/sites/nullman/site"
:base-extension ,site-extension
:publishing-directory "~/public_html/sites/nullman"
:publishing-function org-website-html-publish-to-html
:recursive t)
("nullman-site-statics"
:base-directory "~/web/sites/nullman/site"
:base-extension ,statics-extension
:publishing-directory "~/public_html/sites/nullman"
:publishing-function org-publish-attachment
:recursive t)
("nullman-site-gopher"
:base-directory "~/web/sites/nullman/site"
:base-extension ,site-extension
:publishing-directory "~/public_gopher/sites/nullman"
:publishing-function org-website-gopher-publish-to-gopher
:recursive t)
("blog" :components ("blog-shared"
"blog-assets"
"blog-site"
"blog-site-statics"
"rsync"))
("blog-shared"
:base-directory "~/web/sites/shared"
:base-extension ,shared-extension
:publishing-directory "~/web/sites/blog/site"
:publishing-function org-publish-attachment
:recursive t)
("blog-assets"
:base-directory "~/web/sites/blog/assets"
:base-extension ,assets-extension
:publishing-directory "~/web/sites/blog/site"
:publishing-function org-publish-attachment
:recursive t)
("blog-site"
:base-directory "~/web/sites/blog/site"
:base-extension ,site-extension
:publishing-directory "~/public_html/sites/blog"
:publishing-function org-website-html-publish-to-html
:recursive t)
("blog-site-statics"
:base-directory "~/web/sites/blog/site"
:base-extension ,statics-extension
:publishing-directory "~/public_html/sites/blog"
:publishing-function org-publish-attachment
:recursive t)
("nullware" :components ("nullware-shared"
"nullware-assets"
"nullware-site"
"nullware-site-statics"
"rsync"))
("nullware-shared"
:base-directory "~/web/sites/shared"
:base-extension ,shared-extension
:publishing-directory "~/web/sites/nullware/site"
:publishing-function org-publish-attachment
:recursive t)
("nullware-assets"
:base-directory "~/web/sites/nullware/assets"
:base-extension ,assets-extension
:publishing-directory "~/web/sites/nullware/site"
:publishing-function org-publish-attachment
:recursive t)
("nullware-site"
:base-directory "~/web/sites/nullware/site"
:base-extension ,site-extension
:publishing-directory "~/public_html/sites/nullware"
:publishing-function org-website-html-publish-to-html
:recursive t)
("nullware-site-statics"
:base-directory "~/web/sites/nullware/site"
:base-extension ,statics-extension
:publishing-directory "~/public_html/sites/nullware"
:publishing-function org-publish-attachment
:recursive t)
("kylesherman" :components ("kylesherman-shared"
"kylesherman-assets"
"kylesherman-site"
"kylesherman-site-statics"
"rsync"))
("kylesherman-shared"
:base-directory "~/web/sites/shared"
:base-extension ,shared-extension
:publishing-directory "~/web/sites/kylesherman/site"
:publishing-function org-publish-attachment
:recursive t)
("kylesherman-assets"
:base-directory "~/web/sites/kylesherman/assets"
:base-extension ,assets-extension
:publishing-directory "~/web/sites/kylesherman/site"
:publishing-function org-publish-attachment
:recursive t)
("kylesherman-site"
:base-directory "~/web/sites/kylesherman/site"
:base-extension ,site-extension
:publishing-directory "~/public_html/sites/kylesherman"
:publishing-function org-website-html-publish-to-html
:recursive t)
("kylesherman-site-statics"
:base-directory "~/web/sites/kylesherman/site"
:base-extension ,statics-extension
:publishing-directory "~/public_html/sites/kylesherman"
:publishing-function org-publish-attachment
:recursive t)
("shermanwest" :components ("shermanwest-shared"
"shermanwest-assets"
"shermanwest-site"
"shermanwest-site-statics"
"rsync"))
("shermanwest-shared"
:base-directory "~/web/sites/shared"
:base-extension ,shared-extension
:publishing-directory "~/web/sites/shermanwest/site"
:publishing-function org-publish-attachment
:recursive t)
("shermanwest-assets"
:base-directory "~/web/sites/shermanwest/assets"
:base-extension ,assets-extension
:publishing-directory "~/web/sites/shermanwest/site"
:publishing-function org-publish-attachment
:recursive t)
("shermanwest-site"
:base-directory "~/web/sites/shermanwest/site"
:base-extension ,site-extension
:publishing-directory "~/public_html/sites/shermanwest"
:publishing-function org-website-html-publish-to-html
:recursive t)
("shermanwest-site-statics"
:base-directory "~/web/sites/shermanwest/site"
:base-extension ,statics-extension
:publishing-directory "~/public_html/sites/shermanwest"
:publishing-function org-publish-attachment
:recursive t)
("rsync"
:base-directory "~/web"
:base-extension "none"
:publishing-directory "~/public_html")
))
(setq org-link-abbrev-alist
(append
'(("about" . "http://nullman.net/about/")
("blog" . "http://blog.nullman.net/")
("blog-post" . "%(org-website-blog-url)")
("emacs" . "http://nullman.net/emacs/")
("nullman" . "http://nullman.net/")
("pet-peeves" . "http://nullman.net/rants/pet-peeves.html")
("powerhouse" . "http://powerhouse.nullware.com/")
("projects" . "http://nullman.net/projects/")
("rants" . "http://nullman.net/rants/")
("tutorials" . "http://nullman.net/tutorials/"))
'(("cowiki" . "http://www.champions-online-wiki.com/wiki/")
("google" . "http://www.google.com/search?q=%h")
("urban" . "http://www.urbandictionary.com/define.php?term=")
("wiki" . "http://en.wikipedia.org/wiki/Special:Search?search=")
("word" . "http://en.wiktionary.org/wiki/")
("youtube" . "https://www.youtube.com/watch?v="))))
(setq org-html-toplevel-hlevel 1)
(setq org-html-table-default-attributes nil)
)))
(init-message 3 "Org Website: Configuration: Menu Lists")
(defconst org-website-menu-list
'((:home . (:name "Home" :title "Home Page" :url "http://nullman.net/"))
(:blog . (:name "Blog" :title "Personal Blog" :url "http://blog.nullman.net/"))
(:applications . (:name "Applications" :title "Nullware Applications" :url "http://nullware.com/"))
(:emacs . (:name "Emacs" :title "Emacs Customizations" :url "http://nullman.net/emacs/"))
(:projects . (:name "Projects" :title "Computer Programming Projects" :url "http://nullman.net/projects/"))
(:tutorials . (:name "Tutorials" :title "Computer Tutorials" :url "http://nullman.net/tutorials/"))
(:presentations . (:name "Presentations" :title "Presentations I've Given" :url "http://nullman.net/presentations/"))
(:interesting . (:name "Interesting" :title "Things of Interest" :url "http://nullman.net/interesting/"))
(:games . (:name "Games" :title "Computer Games" :url "http://nullman.net/games/"))
(:quotes . (:name "Quotes" :title "Collected Quotes" :url "http://nullman.net/quotes/"))
(:rants . (:name "Rants" :title "Random Ramblings and Rants" :url "http://nullman.net/rants/"))
(:social . (:name "Social" :title "Social Links" :url "http://nullman.net/social/"))
(:photos . (:name "Photos" :title "Personal Photographs" :url "http://nullman.net/photos/"))
(:bookmarks . (:name "Bookmarks" :title "Personal Bookmarks" :url "http://nullman.net/bookmarks/"))
(:about . (:name "About" :title "About This Site and Its Author" :url "http://nullman.net/about/")))
"Website standard menu list.
Format: ((TAG . (:name NAME :title TITLE :url URL)) ... )")
(defconst org-website-shermanwest-menu-list
'((:home . (:name "Home" :title "Home Page" :url "http://shermanwest.com/"))
(:pictures . (:name "Pictures" :title "Condo Pictures" :url "http://www.flickr.com/photos/nullman/sets/72157603365914146/show/"))
(:directions . (:name "Directions" :title "Sherman West Directions" :url "http://shermanwest.com/directions.html"))
(:restaurants . (:name "Restaurants" :title "San Diego Restaurants" :url "http://shermanwest.com/restaurants.html"))
(:bars . (:name "Bars" :title "San Diego Bars" :url "http://shermanwest.com/bars.html"))
(:attractions . (:name "Attractions" :title "San Diego Attractions" :url "http://shermanwest.com/attractions.html"))
(:shopping . (:name "Shopping" :title "San Diego Shopping" :url "http://shermanwest.com/shopping.html"))
(:rules . (:name "Rules" :title "House Rules" :url "http://shermanwest.com/rules.html"))
(:guestbook . (:name "Guestbook" :title "Guestbook" :url "http://shermanwest.com/guestbook.html")))
"Website Sherman West menu list.
Format: ((TAG . (:name NAME :title TITLE :url URL)) ... )")
(defconst org-website-gopher-menu-list
'((:home . (:name "Home" :title "Home Page" :selector "/nullman/index.gopher"))
(:blog . (:name "Blog" :title "Personal Blog" :selector "/blog/index.gopher"))
(:applications . (:name "Applications" :title "Nullware Applications" :selector "/nullware/index.gopher"))
(:emacs . (:name "Emacs" :title "Emacs Customizations" :selector "/nullman/emacs/index.gopher"))
(:projects . (:name "Projects" :title "Computer Programming Projects" :selector "/nullman/projects/index.gopher"))
(:tutorials . (:name "Tutorials" :title "Computer Tutorials" :selector "/nullman/tutorials/index.gopher"))
(:presentations . (:name "Presentations" :title "Presentations I've Given" :selector "/nullman/presentations/index.gopher"))
(:interesting . (:name "Interesting" :title "Things of Interest" :selector "/nullman/interesting/index.gopher"))
(:games . (:name "Games" :title "Computer Games" :selector "/nullman/games/index.gopher"))
(:quotes . (:name "Quotes" :title "Collected Quotes" :selector "/nullman/quotes/index.gopher"))
(:rants . (:name "Rants" :title "Random Ramblings and Rants" :selector "/nullman/rants/index.gopher"))
(:social . (:name "Social" :title "Social Links" :selector "/nullman/social/index.gopher"))
(:photos . (:name "Photos" :title "Personal Photographs" :selector "/nullman/photos/index.gopher"))
(:bookmarks . (:name "Bookmarks" :title "Personal Bookmarks" :selector "/nullman/bookmarks/index.gopher"))
(:about . (:name "About" :title "About This Site and Its Author" :selector "/nullman/about/index.gopher")))
"Website Gopher menu list.
Format: ((TAG . (:name NAME :title TITLE :selector SELECTOR)) ... )")
(init-message 3 "Org Website: Configuration: Gopher Configuration")
(defconst gopher-port 70
"Port used by Gopher server.")
(defconst gopher-text-width org-ascii-text-width
"Maximum width of Gopher text before word wrapping.")
(defconst gopher-type-text-file "0")
(defconst gopher-type-submenu "1")
(defconst gopher-type-binary-file "9")
(defconst gopher-type-gif-file "g")
(defconst gopher-type-image-file "i")
(defconst gopher-type-html-file "h")
(defconst gopher-type-sound-file "s")
(init-message 2 "Org Website: Functions")
(init-message 3 "Org Website: Functions: Get Property List")
(defun org-website-get-property-list (info)
"Return an association list of org properties in INFO."
(org-element-map (plist-get info :parse-tree) 'keyword
(lambda (x)
(let ((key (intern (concat ":" (replace-regexp-in-string "_" "-" (downcase (org-element-property :key x)))))))
(cons key (org-element-property :value x))))))
(init-message 3 "Org Website: Functions: Get Property Element")
(defun org-website-get-property-element (property-list element)
"Return ELEMENT from PROPERTY-LIST returned from `org-website-get-property-list', or empty string if element was not found."
(or (cdr (assoc element property-list)) ""))
(init-message 3 "Org Website: Functions: Get URL")
(defun org-website-get-url (property-list)
"Return target URL for current buffer being exported."
(concat
(org-website-get-property-element property-list :link-home)
(replace-regexp-in-string
"^.*/site/" ""
(replace-regexp-in-string "\.[^\.]*$" "" buffer-file-name))
".html"))
(init-message 3 "Org Website: Functions: Blog URL")
(defun org-website-blog-url (&optional name)
"Return URL of given blog NAME.
If NAME is non-nil, return base URL."
(let ((parts (split-string name "[.]")))
(concat
"http://blog.nullman.net/"
(nth 0 parts) "/"
(nth 1 parts) "/"
name ".html")))
(put #'org-website-blog-url 'org-link-abbrev-safe t)
(init-message 3 "Org Website: Functions: Is Blog Post")
(defun org-website-is-blog-post (property-list)
"Return non-nil if current page is a blog entry."
(zerop (length (replace-regexp-in-string
"^.*/[0-9]\\{4\\}.[0-9]\\{2\\}.[0-9]\\{2\\}.[0-9]\\{4\\}-.*$"
""
buffer-file-name))))
(init-message 3 "Org Website: Functions: Get Level")
(defun org-website-get-level (property-list)
"Return level of current project file."
(- (length (split-string (org-website-get-url property-list) "/")) 3))
(init-message 3 "Org Website: Functions: Format Headline")
(defun org-website-format-headline (headline &optional char col)
"Return HEADLINE surrounded by CHAR ending at COL length."
(let* ((char (or char ?=))
(col (or col org-ascii-text-width))
(text-width (- col 12))
(headline (if (> (length headline) text-width)
(let ((fill-column text-width))
(with-temp-buffer
(insert headline)
(fill-region (point-min) (point-max))
(buffer-string)))
headline)))
(mapconcat
(lambda (line)
(let ((str (concat (make-string 5 char) " " (upcase line) " " (make-string 5 char))))
(while (< (length str) col)
(setq str (concat str (string char))))
str))
(split-string headline "\n") "\n")))
(init-message 3 "Org Website: Functions: Get Gopher Selector Hostname Port")
(defun org-website-get-gopher-selector-hostname-port (selector)
"Return Gopher selector, hostname, and port from given SELECTOR."
(let* ((hostname "nullman.net")
(port (if (boundp 'gopher-port) gopher-port 70)))
(concat selector "\t" hostname "\t" (int-to-string port))))
(init-message 3 "Org Website: Functions: Convert URL to Gopher Selector Hostname Port")
(defun org-website-convert-url-to-gopher-selector-hostname-port (url)
"Return Gopher selector, hostname, and port from given URL."
(let* ((suffix (replace-regexp-in-string "^.*://" "" url))
(hostname (replace-regexp-in-string "/.*$" "" suffix))
(selector (replace-regexp-in-string "^.*?/" "/" suffix))
(port (if (boundp 'gopher-port) gopher-port 70)))
(concat selector "\t" hostname "\t" (int-to-string port))))
(init-message 3 "Org Website: Functions: Gopher Justify Lines")
(defun org-website-gopher-justify-lines (str &optional indent width justify)
"Return STR after justifying all lines.
INDENT is the amount to indent the final text (defaults to 0).
WIDTH is an integer specifying maximum length of a line (defaults
to `gopher-text-width' or `org-ascii-text-width').
JUSTIFY determines the type of justification: `left', `right',
`full', `center', or `none' (defaults to `none')."
(with-temp-buffer
(let ((indent (or indent 0))
(fill-column (or width
(and (boundp 'gopher-text-width)
gopher-text-width)
org-ascii-text-width)))
(insert str)
(goto-char (point-min))
(while (search-forward "\n" nil :noerror)
(replace-match "\n\n"))
(fill-region (point-min) (point-max) justify :nosqueeze :to-eop)
(goto-char (point-min))
(while (search-forward "\n\n" nil :noerror)
(replace-match "\n"))
(when (> indent 0)
(let ((spc (make-string indent ? )))
(goto-char (point-min))
(while (not (eobp))
(insert spc)
(forward-line 0)
(forward-line 1))))
(buffer-string))))
(init-message 2 "Org Website: Publish HTML")
(init-message 3 "Org Website: Publish HTML: Derived Backend")
(org-export-define-derived-backend 'org-website-html 'html
:translate-alist '((template . org-website-html-template)
(inner-template . org-website-html-inner-template)
(headline . org-website-html-headline)
(section . org-website-html-section)))
(init-message 3 "Org Website: Publish HTML: Publish to HTML")
(defun org-website-html-publish-to-html (plist file-name pub-dir)
"Publish a Website org file to HTML and return output file name.
FILE-NAME is the file name of the Org file to be published.
PLIST is the property list for the given project.
PUB-DIR is the publishing directory."
(org-publish-org-to 'org-website-html file-name
(concat "." (or (plist-get plist :html-extension)
org-html-extension
"html"))
plist pub-dir))
(init-message 3 "Org Website: Publish HTML: Template")
(defun org-website-html-template (contents info)
"Return complete document string after HTML conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(let* ((property-list (org-website-get-property-list info))
(site (org-website-get-property-element property-list :site))
(title (org-website-get-property-element property-list :title)))
(concat
"<!DOCTYPE html>\n"
(format "<html xmlns=\"http://www.w3.org/1999/xhtml\" lang=\"%s\">\n" (org-website-get-property-element property-list :language))
"\n"
"<head>\n"
"\n"
(format " <title>%s</title>\n" title)
"\n"
(format " <meta http-equiv=\"Content-Type\" content=\"text/html; charset=%s\" />\n" (or (coding-system-get org-html-coding-system 'mime-charset) "utf-8"))
" <meta name=\"viewport\" content=\"width=device-width, initial-scale=1\" />\n"
(format " <meta name=\"author\" content=\"%s\" />\n" (org-website-get-property-element property-list :author))
(format " <meta name=\"keywords\" content=\"%s\" />\n" (org-website-get-property-element property-list :keywords))
(format " <meta name=\"description\" content=\"%s\" />\n" (org-website-get-property-element property-list :description))
" <meta name=\"generator\" content=\"org-mode\" />\n"
" <meta name=\"robots\" content=\"all\" />\n"
" <meta name=\"google-site-verification\" content=\"" (org-website-get-property-element property-list :google-site-verification) "\" />\n"
"\n"
" <link rel=\"alternate\" type=\"application/rss+xml\" title=\"RSS Feed\" href=\"http://blog.nullman.net/index.rss\" />\n"
" <link rel=\"author\" href=\"http://nullman.net/about.html\" />\n"
" <link rel=\"home\" href=\"/\" />\n"
(cond
((and (string= site "kylesherman") (string= title "Resume"))
" <link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"/styles/resume.css\" />\n")
(t
" <link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"/styles/default.css\" />\n"))
" <link rel=\"stylesheet\" type=\"text/css\" media=\"print\" href=\"/styles/print.css\" />\n"
"\n"
" <!-- Google Analytics -->\n"
" <script><!--\n"
" var _gaq = _gaq || [];\n"
" _gaq.push(['_setAccount', '" (org-website-get-property-element property-list :google_analytics) "']);\n"
" _gaq.push(['_trackPageview']);\n"
" (function() {\n"
" var ga = document.createElement('script'); ga.async = true;\n"
" ga.src = ('https:' == document.location.protocol ? 'https://ssl' : 'http://www') + '.google-analytics.com/ga.js';\n"
" var s = document.getElementsByTagName('script')[0];\n"
" s.parentNode.insertBefore(ga, s);\n"
" })();\n"
" // --></script>\n"
"\n"
(concat
(org-element-normalize-string (plist-get info :html-head))
(org-element-normalize-string (plist-get info :html-head-extra)))
"\n"
"</head>\n"
"\n"
"<body>\n"
"\n"
" <div id=\"container\">\n"
"\n"
(cond
((and (string= site "kylesherman") (string= title "Resume"))
"")
(t
(concat
" <!-- header start -->\n"
"\n"
" <div id=\"header\">\n"
" <h1 class=\"title\">\n"
(format " <span>%s</span>\n" title)
" </h1>\n"
" </div>\n"
"\n"
" <!-- header end -->\n"
"\n")))
(if (> (length (org-website-get-property-element property-list :menu)) 0)
(concat
" <!-- menu start -->\n"
"\n"
" <div id=\"menu\">\n"
"\n"
(mapconcat
(lambda (x)
(let* ((plist (cdr x))
(name (plist-get plist :name))
(title (plist-get plist :title))
(url (plist-get plist :url))
(current (string= (org-website-get-property-element property-list :menu) name)))
(concat " <div class=\"" (if current "menu-item-current" "menu-item") "\">\n"
" <a title=\"" title "\" href=\"" url "\">" name "</a>\n"
" </div>\n")))
(if (string= site "shermanwest")
org-website-shermanwest-menu-list
org-website-menu-list)
"")
"\n"
" <!-- search start -->\n"
"\n"
" <div class=\"search\">\n"
" <form method=\"get\" action=\"http://www.google.com/search\">\n"
" <fieldset>\n"
" <input type=\"hidden\" name=\"q\" value=\"site:http://blog.nullman.net/ OR site:http://nullman.net/ OR site:http://nullware.com/\" />\n"
" <input type=\"hidden\" name=\"hl\" value=\"en\" />\n"
" <input type=\"text\" name=\"q\" maxlength=\"2048\" value=\"\" title=\"Search\" style=\"width: 5.5em\" />\n"
" <input type=\"image\" name=\"btnG\" src=\"/img/search.png\" alt=\"Search\" style=\"height: 100%; vertical-align: middle\" />\n"
" </fieldset>\n"
" </form>\n"
" </div>\n"
"\n"
" <!-- search end -->\n"
"\n"
" </div>\n"
"\n"
" <!-- menu end -->\n"
"\n")
"")
(cond
((string= site "blog")
(org-website-html-blog-contents-template contents info property-list))
((string= site "kylesherman")
(concat
" <!-- content start -->\n"
"\n"
(if (string= title "Resume")
contents
(concat
" <div id=\"content-generic\">\n"
"\n"
contents
"\n"
" </div>\n"))
"\n"
" <!-- content end -->\n"
"\n"))
(t
(concat
" <!-- content start -->\n"
"\n"
" <div id=\"content\">\n"
"\n"
contents
"\n"
" </div>\n"
"\n"
" <!-- content end -->\n"
"\n")))
(cond
((string= site "kylesherman")
"")
(t
(concat
" <!-- footer start -->\n"
"\n"
" <div id=\"footer\">\n"
"\n"
" <div class=\"validator\">\n"
" <a title=\"Check the validity of this page using W3C's unified validator\"\n"
(format " href=\"http://validator.w3.org/unicorn/check?ucn_task=conformance&ucn_uri=%s\">unicorn</a>\n" (org-website-get-property-element property-list :link-home))
" </div>\n"
"\n"
" <div class=\"validator\">\n"
" <a title=\"Check the validity of this page's XHTML\"\n"
" href=\"http://validator.w3.org/check?uri=referer\">xhtml</a>\n"
" </div>\n"
"\n"
" <div class=\"validator\">\n"
" <a title=\"Check the validity of this page's CSS\"\n"
" href=\"http://jigsaw.w3.org/css-validator/check/referer\">css</a>\n"
" </div>\n"
"\n"
" <div class=\"validator\">\n"
" <a title=\"Check the performance this page\"\n"
(format " href=\"https://developers.google.com/speed/pagespeed/insights/?url=%s\">pagespeed</a>\n" (org-website-get-url property-list))
" </div>\n"
"\n"
" <!--\n"
" <div class=\"validator\">\n"
" <a title=\"Check the accessibility of this page according to U.S. Section 508\"\n"
(format " href=\"http://www.contentquality.com/mynewtester/cynthia.exe?Url1=%s\">508</a>\n" (org-website-get-property-element property-list :link-home))
" </div>\n"
" -->\n"
"\n"
" <div class=\"license\">\n"
" <span>Last Modified: " (org-website-get-property-element property-list :last-modified) "<br />\n"
" " (org-website-get-property-element property-list :copyright) "<br />\n"
" <span class=\"license\">Creative Commons\n"
" <a title=\"View details of the license of this site\"\n"
" href=\"http://creativecommons.org/licenses/by-nc-sa/3.0/\">\n"
" Attribution-NonCommercial-ShareAlike\n"
" </a> license</span></span>\n"
" </div>\n"
"\n"
" </div>\n"
"\n"
" <!-- footer end -->\n"
"\n")))
" </div>\n"
"\n"
"</body>\n"
"\n"
"</html>\n")))
(init-message 3 "Org Website: Publish HTML: Blog Contents Template")
(defun org-website-html-blog-contents-template (contents info property-list)
"Return blog contents string after HTML conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options.
PROPERTY-LIST is the list of org properties found in INFO."
(let ((post (org-website-is-blog-post property-list))
(site-url (org-website-get-property-element property-list :link-home)))
(concat
(with-temp-buffer
(insert-file-contents "~/web/sites/blog/site/menu-index.html-nopub")
(goto-char (point-min))
(while (re-search-forward "^" nil :noerror)
(replace-match " "))
(buffer-string))
"\n"
" <!-- content-index start -->\n"
"\n"
" <div id=\"content-index\">\n"
"\n"
(if post
(concat
" <div class=\"timestamp\">"
(substring (org-website-get-property-element property-list :posted) 0 10)
"</div>\n"
(concat
" <h2><a href=\"" (org-website-get-url property-list) "\">"
(org-website-get-property-element property-list :description)
"</a></h2>\n"))
"")
contents
(if post
(concat
"\n"
" <div class=\"tags\">Tags: " (org-website-get-property-element property-list :tags) "</div>\n"
"\n")
"")
"\n"
" </div>\n"
"\n"
" <!-- content-index end -->\n"
"\n")))
(init-message 3 "Org Website: Publish HTML: Inner Template")
(defun org-website-html-inner-template (contents info)
"Return body of document string after HTML conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(require 'ox-html)
(concat
(let ((depth (plist-get info :with-toc)))
(when depth
(org-html-toc depth info)))
contents
(org-website-html-footnote-section info)))
(init-message 3 "Org Website: Publish HTML: Headline")
(defun org-website-html-headline (headline contents info)
"Transcode a HEADLINE element from Org to HTML.
CONTENTS holds the contents of the headline.
INFO is a plist holding contextual information."
(let ((level (+ (org-export-get-relative-level headline info)
(1- (or (plist-get info :html-toplevel-hlevel) 1))))
(id (org-export-data (org-element-property :CUSTOM_ID headline) info))
(title (org-export-data (org-element-property :title headline) info))
(contents (or contents "")))
(concat
(if id
(format "\n<h%d id=\"%s\">%s</h%d>\n" level id title level)
(format "\n<h%d>%s</h%d>\n" level title level))
contents)))
(init-message 3 "Org Website: Publish HTML: Section")
(defun org-website-html-section (section contents info)
"Transcode a SECTION element from Org to HTML.
CONTENTS holds the contents of the section.
INFO is a plist holding contextual information."
(or contents ""))
(init-message 3 "Org Website: Publish HTML: Footnote Reference")
(defun org-website-html-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to HTML.
CONTENTS is nil.
INFO is a plist holding contextual information."
(require 'ox-html)
(concat
(let ((prev (org-export-get-previous-element footnote-reference info)))
(when (eq (org-element-type prev) 'footnote-reference)
(plist-get info :html-footnote-separator)))
(let* ((n (org-export-get-footnote-number footnote-reference info))
(id (format "fnr.%d%s"
n
(if (org-export-footnote-first-reference-p
footnote-reference info)
""
".100"))))
(format
(plist-get info :html-footnote-format)
(org-html--anchor
id n (format " class=\"footnote-reference\" href=\"#fn.%d\"" n) info)))))
(init-message 3 "Org Website: Publish HTML: Footnote Section")
(defun org-website-html-footnote-section (info)
"Format the footnote section.
INFO is a plist used as a communication channel."
(let* ((fn-alist (org-export-collect-footnote-definitions info))
(fn-alist
(cl-loop for (n type raw) in fn-alist
collect (cons n (if (eq (org-element-type raw) 'org-data)
(org-trim (org-export-data raw info))
(format "<p>%s</p>" (org-trim (org-export-data raw info))))))))
(when fn-alist
(format
"<div class=\"footnotes\">\n%s</div>"
(mapconcat
(lambda (fn)
(let ((n (car fn))
(def (cdr fn)))
(format
"<div class=\"footnote\">\n%s\n%s\n</div>\n"
(format
org-html-footnote-format
(org-html--anchor
(format "fn.%s" n)
n
(format " class=\"footnote-number\" href=\"#fnr.%s\"" n)
info))
def)))
fn-alist "\n")))))
(init-message 2 "Org Website: Publish RSS")
(init-message 3 "Org Website: Publish RSS: Derived Backend")
(org-export-define-derived-backend 'org-website-rss 'html
:translate-alist '((template . org-website-rss-template)
(inner-template . org-website-rss-inner-template)))
(init-message 3 "Org Website: Publish RSS: Publish to RSS")
(defun org-website-rss-publish-to-rss (plist file-name pub-dir)
"Publish a Website org file to RSS and return output file name.
FILE-NAME is the file name of the Org file to be published.
PLIST is the property list for the given project.
PUB-DIR is the publishing directory."
(org-publish-org-to 'org-website-rss file-name ".rss" plist pub-dir))
(init-message 3 "Org Website: Publish RSS: Template")
(defun org-website-rss-template (contents info)
"Return complete document string after RSS conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(let* ((property-list (org-website-get-property-list info))
(link-home (org-website-get-property-element property-list :link-home))
(title (org-website-get-property-element property-list :title)))
(concat
"<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
"<rdf:RDF xmlns:rdf=\"http://www.w3.org/1999/02/22-rdf-syntax-ns#\"\n"
" xmlns=\"http://purl.org/rss/1.0/\"\n"
" xmlns:slash=\"http://purl.org/rss/1.0/modules/slash/\"\n"
" xmlns:taxo=\"http://purl.org/rss/1.0/modules/taxonomy/\"\n"
" xmlns:dc=\"http://purl.org/dc/elements/1.1/\"\n"
" xmlns:syn=\"http://purl.org/rss/1.0/modules/syndication/\"\n"
" xmlns:admin=\"http://webns.net/mvcb/\"\n"
" xmlns:feedburner=\"http://rssnamespace.org/feedburner/ext/1.0\">\n\n"
" <channel rdf:about=\"" link-home "\">\n"
" <title>" title "</title>\n"
" <link>" link-home "</link>\n"
" <description>" (org-website-get-property-element property-list :description) "</description>\n"
" <dc:language>en-us</dc:language>\n"
" <dc:rights>" (org-website-get-property-element property-list :copyright) "</dc:rights>\n"
" <dc:date>" (format-time-string "%FT%TZ" nil t) "</dc:date>\n"
" <dc:publisher>" (org-website-get-property-element property-list :author) "</dc:publisher>\n"
" <dc:creator>" (org-website-get-property-element property-list :author) "</dc:creator>\n"
" <dc:subject>Software Engineering</dc:subject>\n"
" <syn:updatePeriod>daily</syn:updatePeriod>\n"
" <syn:updateFrequency>1</syn:updateFrequency>\n"
" <syn:updateBase>2007-06-04T00:00:00Z</syn:updateBase>\n"
" <items>\n"
" <rdf:Seq>\n"
" </rdf:Seq>\n"
" </items>\n"
" <image rdf:resource=\"" link-home "img/image.jpg\" />\n"
" </channel>\n\n"
" <image rdf:about=\"" link-home "img/image.jpg\">\n"
" <title>" title "</title>\n"
" <url>" link-home "img/image.jpg</url>\n"
" <link>" link-home "</link>\n"
" </image>\n"
contents
"\n"
" <textinput rdf:about=\"" link-home "search.html\">\n"
" <title>Search " title "</title>\n"
" <description>Search " title " entries</description>\n"
" <name>query</name>\n"
" <link>" link-home "search.html</link>\n"
" </textinput>\n\n"
"</rdf:RDF>\n")))
(init-message 3 "Org Website: Publish RSS: Inner Template")
(defun org-website-rss-inner-template (contents info)
"Return body of document string after RSS conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(let ((property-list (org-website-get-property-list info)))
(concat
"\n"
" <item rdf:about=\"" (org-website-get-url property-list) "\">\n"
" <title>" (org-website-get-property-element property-list :description) "</title>\n"
" <link>" (org-website-get-url property-list) "</link>\n"
" <description>\n"
" <![CDATA[\n"
contents
" ]]>\n"
" </description>\n"
" </item>\n"
(org-website-html-footnote-section info))))
(init-message 2 "Org Website: Publish Gopher")
(init-message 3 "Org Website: Publish Gopher: Derived Backend")
(org-export-define-derived-backend 'gopher 'ascii
:translate-alist '((template . org-website-gopher-template)
(inner-template . org-website-gopher-inner-template)
(headline . org-website-gopher-headline)
(section . org-website-gopher-section)))
(init-message 3 "Org Website: Publish Gopher: Publish to Gopher")
(defun org-website-gopher-publish-to-gopher (plist file-name pub-dir)
"Publish a Website org file to Gopher and return output file name.
FILE-NAME is the file name of the Org file to be published.
PLIST is the property list for the given project.
PUB-DIR is the publishing directory."
(org-publish-org-to 'gopher file-name ".gopher" plist pub-dir))
(init-message 3 "Org Website: Publish Gopher: Template")
(defun org-website-gopher-template (contents info)
"Return complete document string after Gopher conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(let* ((property-list (org-website-get-property-list info))
(site (org-website-get-property-element property-list :site))
(title (org-website-get-property-element property-list :title)))
(concat
(format "%s\n\n" (org-website-format-headline title))
(if (string= (downcase title) "nullman")
(concat
(format "%s\n\n" (org-website-format-headline "menu"))
(mapconcat
(lambda (x)
(let* ((plist (cdr x))
(name (plist-get plist :name))
(title (plist-get plist :title))
(selector (plist-get plist :selector)))
(format "%s\t%s\t%s\n" gopher-type-submenu title (org-website-get-gopher-selector-hostname-port selector))))
(if (string= site "shermanwest")
org-website-shermanwest-menu-list
org-website-menu-list)
"")
"\n")
"")
(cond
((string= site "blog")
(org-website-gopher-blog-contents-template contents info property-list))
(t
(concat contents "\n")))
(cond
((string= site "kylesherman")
"")
(t
(concat
(format "%s\n\n" (make-string gopher-text-width ?=))
(format "Last Modified: %s\n" (org-website-get-property-element property-list :last-modified))
(format "%s\n" (org-website-get-property-element property-list :copyright))
(format "%s\t%s\t%s\t%s\n"
gopher-type-html-file
"Creative Commons Attribution-NonCommercial-ShareAlike license"
"http://creativecommons.org/licenses/by-nc-sa/3.0/"
gopher-port))))
)))
(init-message 3 "Org Website: Publish Gopher: Inner Template")
(defun org-website-gopher-inner-template (contents info)
"Return body of document string after Gopher conversion.
CONTENTS is the transcoded contents string.
INFO is a plist holding export options."
(require 'ox-ascii)
(concat
(replace-regexp-in-string "^ " "" contents)
(org-website-gopher-footnote-section info)))
(init-message 3 "Org Website: Publish Gopher: Headline")
(defun org-website-gopher-headline (headline contents info)
"Transcode a HEADLINE element from Org to Gopher.
CONTENTS holds the contents of the headline.
INFO is a plist holding contextual information."
(let ((level (+ (org-export-get-relative-level headline info)
(1- (or (plist-get info :gopher-toplevel-hlevel) 1))))
(text (org-export-data (org-element-property :title headline) info))
(contents (or contents "")))
(concat
(format "\n%s\n" (if (< level 3)
(org-website-format-headline text ?= gopher-text-width)
(org-website-format-headline text ?- gopher-text-width)))
contents)))
(init-message 3 "Org Website: Publish Gopher: Section")
(defun org-website-gopher-section (section contents info)
"Transcode a SECTION element from Org to Gopher.
CONTENTS holds the contents of the section.
INFO is a plist holding contextual information."
(or contents ""))
(init-message 3 "Org Website: Publish Gopher: Footnote Reference")
(defun org-website-gopher-footnote-reference (footnote-reference _contents info)
"Transcode a FOOTNOTE-REFERENCE element from Org to Gopher.
CONTENTS is nil.
INFO is a plist holding contextual information."
(require 'ox-ascii)
(concat
(let ((prev (org-export-get-previous-element footnote-reference info)))
(when (eq (org-element-type prev) 'footnote-reference)
(plist-get info :ascii-footnote-separator)))
(let ((n (org-export-get-footnote-number footnote-reference info)))
(format
(plist-get info :ascii-footnote-format)
(format "%d" n)))))
(init-message 3 "Org Website: Publish Gopher: Footnote Section")
(defun org-website-gopher-footnote-section (info)
"Format the footnote section.
INFO is a plist used as a communication channel."
(let* ((fn-alist (org-export-collect-footnote-definitions info))
(fn-alist
(cl-loop for (n type raw) in fn-alist
collect (cons n (if (eq (org-element-type raw) 'org-data)
(org-trim (org-export-data raw info))
(format "%s" (org-trim (org-export-data raw info))))))))
(when fn-alist
(format
"%s"
(mapconcat
(lambda (fn)
(let ((n (car fn))
(def (cdr fn)))
(format
"%s\n%s\n"
(format
org-ascii-footnote-format
(format "%s" n))
def)))
fn-alist "\n")))))
(init-message 2 "Org Website: Helper Functions")
(init-message 3 "Org Website: Helper Functions: Publish")
(defun org-website-publish (&optional project force)
"Publish org-website projects.
If PROJECT is non-nil, only publish that project.
If FORCE is non-nil, force publish all files in project."
(interactive)
(let ((files (directory-files "~/web/org/" nil "\.org\\'")))
(when (member "styles.org" files)
(setq files (append "styles.org" (remove "styles.org" files))))
(dolist (file files)
(let ((site (file-name-sans-extension file)))
(when (or (not project)
(string= project site))
(org-publish site force))))))
(defun org-website-publish-async (&optional project force)
"Asynchronous version of `org-website-publish'."
(interactive)
(eval
`(async-spinner
(lambda ()
(load "~/web/bin/init-emacs-website.el")
(org-website-publish ,project ,force))
(lambda (result)
(message "Website publish finished")))))
(init-message 3 "Org Website: Helper Functions: Tangle Publish")
(defun org-website-tangle-publish (&optional project force)
"Tangle and publish org-website projects.
If PROJECT is non-nil, only tangle/publish that project.
If FORCE is non-nil, force publish all files in project."
(interactive)
(let ((files (directory-files "~/web/org/" nil "\.org\\'"))
(org-html-htmlize-output-type 'css))
(when (member "styles.org" files)
(setq files (append "styles.org" (remove "styles.org" files))))
(dolist (file files)
(let ((site (file-name-sans-extension file)))
(when (or (not project)
(string= project site))
(org-babel-tangle-file (concat "~/web/org/" file))
(org-publish site force))))))
(defun org-website-tangle-publish-async (&optional project force)
"Asynchronous version of `org-website-tangle-publish'."
(interactive)
(eval
`(async-spinner
(lambda ()
(load "~/web/bin/init-emacs-website.el")
(org-website-tangle-publish ,project ,force))
(lambda (result)
(message "Website tangle/publish finished")))))
(init-message 3 "Org Website: Helper Functions: Blog Post Create")
(defun org-website-blog-post-create (&optional title)
"Create empty blog post entry with TITLE.
If TITLE is nil, caller is prompted for one."
(interactive "sTitle: ")
(save-match-data
(setq title (titleize title))
(find-file "~/web/org/blog.org")
(goto-char (point-min))
(re-search-forward "^\*\*\* Blog Posts$")
(org-forward-heading-same-level 1 t)
(forward-line -1)
(newline)
(let* ((ts (current-time))
(time (format-time-string "%Y.%m.%d.%H%M" ts))
(name (concat time "-" (org-generate-custom-id-from-title title)))
(path (format-time-string "%Y/%m" ts))
(file (concat "~/web/sites/blog/site/" path "/" name ".org"))
(posted (format-time-string "%Y-%m-%d %H:%M" ts)))
(insert
(concat
"******* " time " " title "\n"
" :PROPERTIES:\n"
" :CUSTOM_ID: site-blog-posts-" time "\n"
" :END:\n"
"\n"
"#+NAME: blog-" time "\n"
"#+BEGIN_SRC org :tangle " file "\n"
" <<level-2>>\n"
" ,#+TITLE: " title "\n"
" ,#+DESCRIPTION: \n"
" ,#+POSTED: " posted "\n"
" ,#+LAST_MODIFIED: " posted "\n"
" ,#+UUID: " (uuid) "\n"
" ,#+TAGS: \n"
"\n"
" ,#+ATTR_HTML: :class blog-img :title " title "\n"
" [[][<<site-url>>/" path "/img/]]\n"
"\n"
"\n"
"\n"
" ,#+BEGIN_QUOTE\n"
" ,#+END_QUOTE\n"
"#+END_SRC\n"))
(forward-line -14)
(goto-char (line-end-position)))))
(init-message 3 "Org Website: Helper Functions: Blog Post Update Posted")
(defun org-website-blog-post-update-posted (&optional date)
"Update posted time of current blog post entry.
Set blog timestamp to `current-time' or DATE, if non-nil."
(interactive)
(when (string= (expand-file-name "~/web/org/blog.org") buffer-file-name)
(save-mark-and-excursion
(save-match-data
(let* ((case-fold-search t)
(start (progn (org-previous-visible-heading 1) (point)))
(end (progn (org-next-visible-heading 1) (point)))
(title (progn (goto-char start) (re-search-forward "#\\+TITLE: \\(.*\\)" end) (match-string 1)))
(ts (if date (date-to-time date) (current-time)))
(time (format-time-string "%Y.%m.%d.%H%M" ts))
(name (concat time "-" (org-generate-custom-id-from-title title)))
(path (format-time-string "%Y/%m" ts))
(file (concat "~/web/sites/blog/site/" path "/" name ".org"))
(posted (format-time-string "%Y-%m-%d %H:%M" ts)))
(goto-char start)
(re-search-forward "^\*+ \\(.*\\)" (line-end-position))
(replace-match (concat time " " title) nil nil nil 1)
(re-search-forward "^[ \t]*:CUSTOM_ID: site-blog-posts-\\(.*\\)" end)
(replace-match time nil nil nil 1)
(re-search-forward "^[ \t]*#\\+NAME: blog-\\(.*\\)" end)
(replace-match time nil nil nil 1)
(re-search-forward "^[ \t]*#\\+BEGIN_SRC org :tangle \\(.*\\)" end)
(let ((old-file (match-string 1)))
(when (file-exists-p old-file)
(delete-file old-file)))
(replace-match file nil nil nil 1)
(re-search-forward "^[ \t]*#\\+POSTED: \\(.*\\)" end)
(replace-match posted nil nil nil 1)
(re-search-forward "^[ \t]*#\\+LAST_MODIFIED: \\(.*\\)" end)
(replace-match posted nil nil nil 1))))))
(init-message 3 "Org Website: Helper Functions: Unflatten")
(defun unflatten (xs &optional fn-value fn-level)
"Unflatten a list XS into a tree, e.g. (1 2 3 1) => (1 (2 (3)) 1).
FN-VALUE specifies how to extract the values from each element,
which are included in the output tree, FN-LEVEL tells how to
extract the level of each element. By default these are the
`identity' function so it will work on a list of numbers."
(let* ((level 1)
(tree (cons nil nil))
(start tree)
(stack nil)
(fn-value (or fn-value #'identity))
(fn-level (or fn-level #'identity)))
(dolist (x xs)
(let ((x-value (funcall fn-value x))
(x-level (funcall fn-level x)))
(cond
((> x-level level)
(setcdr tree (cons (cons x-value nil) nil))
(setq tree (cdr tree))
(push tree stack)
(setq tree (car tree))
(setq level x-level))
((= x-level level)
(setcdr tree (cons x-value nil))
(setq tree (cdr tree)))
((< x-level level)
(while (< x-level level)
(setq tree (pop stack))
(setq level (- level 1)))
(setcdr tree (cons x-value nil))
(setq tree (cdr tree))
(setq level x-level)))))
(cdr start)))
(init-message 2 "Org Website: Generate Website Emacs Initialization File")
(defun org-website-generate-website-emacs-initialization-file ()
"Generate minimal version of init-emacs.el called
init-emacs-website.el to be used with batch commands."
(save-mark-and-excursion
(save-match-data
(let ((source-file (expand-file-name "init-emacs.el" emacs-home-dir))
(target-file (expand-file-name "init-emacs-website.el" "~/web/bin"))
(sections (append '( ";;; Package Manager: Straight"
";; set emacs home directory"
";;;; Environment: Files: General"
";;;; Org Mode: Functions: org-get-file-data"
";;;; Org Mode: Babel: Configuration"
";;;; Org Mode: Babel: Tangle Update Timestamps"
";;;; Org Mode: Babel: Tangle Case-Sensitive"
";;;; Functions: Emacs Functions: delete-line"
";;; Packages: htmlize"
";;; Packages: w3m")
(let ((start (progn
(goto-char (point-min))
(re-search-forward "^[ \t]*:CUSTOM_ID: org-website$")))
(end (re-search-forward "^[ \t]*:CUSTOM_ID: org-website-generate-website-emacs-initialization-file$"))
list)
(goto-char start)
(while (re-search-forward "^[ \t]*\\(;;;; .*\\)$" end :noerror)
(push (match-string-no-properties 1) list))
(nreverse list))))
(prefix (concat "(require 'cl-macs)\n"
"(require 'subr-x)\n"
"(require 'org)\n"
"(require 'ox)\n")))
(org-copy-tangled-sections source-file target-file sections prefix)))))
(defun after-save-hook--generate-init-emacs-website-elisp-file ()
"Hook to generate init-emacs-website.el file on save."
(when (and buffer-file-name
(string= (file-truename buffer-file-name) init-emacs-true-file-name))
(org-website-generate-website-emacs-initialization-file)))
(add-hook 'after-save-hook #'after-save-hook--generate-init-emacs-website-elisp-file :append)
(init-message 2 "Org Website: Remote Synchronization")
(init-message 3 "Org Website: Remote Synchronization: Rsync to Morpheus")
(defun org-website-rsync-to-morpheus (&optional property-list)
"Synchronize published site with morpheus server."
(interactive)
(shell-command (concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" \"${HOME}/public_html/\""
" \"morpheus:${HOME}/public_html/\""))
(shell-command (concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" \"${HOME}/public_gopher/\""
" \"morpheus:${HOME}/public_gopher/\""))
(shell-command (concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" \"${HOME}/public_gemini/\""
" \"morpheus:${HOME}/public_gemini/\"")))
(defun org-website-rsync-to-morpheus-async (&optional property-list)
"Asynchronous version of `org-website-rsync-to-morpheus'."
(interactive)
(eval
`(async-spinner
(lambda ()
(fset 'org-website-rsync-to-morpheus ,(symbol-function 'org-website-rsync-to-morpheus))
(org-website-rsync-to-morpheus ,property-list))
(lambda (result)
(message "Website rsync to morpheus finished")))))
(init-message 3 "Org Website: Remote Synchronization: Rsync to DigitalOcean")
(defun org-website-rsync-to-digitalocean (&optional application force)
"Synchronize published site with digitalocean server.
Normally, applications are not synced. If APPLICATION is non-nil,
sync it instead. Supported applications:
\"powerhouse\"
\"bloodmoon\"
If FORCE is non-nil, do not prompt before synchronizing
applicaitons."
(interactive)
(let ((digitalocean "159.203.165.79"))
(if application
(when (or force
(yes-or-no-p (format "Website rsync %s to DigitalOcean" application)))
(shell-command
(concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" --rsh=\"ssh -l kyle\""
" \"${HOME}/public_html/sites/nullware/" application "/\""
" \"" digitalocean ":/home/kyle/public_html/sites/nullware/" application "/\"")))
(progn
(shell-command
(concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" --exclude=\"nullware/powerhouse/*\""
" --exclude=\"nullware/bloodmoon/*\""
" --rsh=\"ssh -l kyle\""
" \"${HOME}/public_html/sites/\""
" \"" digitalocean ":/home/kyle/public_html/sites/\""))
(shell-command
(concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" --rsh=\"ssh -l kyle\""
" \"${HOME}/public_gopher/\""
" \"" digitalocean ":/home/kyle/public_gopher/\""))
(shell-command
(concat "rsync -rlptx --delete --force"
" --exclude=\".git*\""
" --rsh=\"ssh -l kyle\""
" \"${HOME}/public_gemini/\""
" \"" digitalocean ":/home/kyle/public_gemini/\""))))))
(defun org-website-rsync-to-digitalocean-async (&optional application force)
"Asynchronous version of `org-website-rsync-to-digitalocean'."
(interactive)
(when (or (not application)
force
(yes-or-no-p (format "Website rsync %s to DigitalOcean" application)))
(eval
`(async-spinner
(lambda ()
(fset 'org-website-rsync-to-digitalocean ,(symbol-function 'org-website-rsync-to-digitalocean))
(org-website-rsync-to-digitalocean ,application ,force))
(lambda (result)
(message "Website rsync to DigitalOcean finished"))))))
(init-message 2 "Org Website: Deployment")
(init-message 1 "Functions")
(init-message 2 "Functions: Initialization Functions")
(init-message 3 "Functions: Initialization Functions: require-if-available")
(defun require-if-available (&rest args)
"Require symbols and load library strings.
Fails quietly if some are not available."
(let (lib)
(condition-case nil
(mapc (lambda (e)
(setq lib e)
(cond
((stringp e) (load-library e))
((symbolp e) (require e))))
args)
('file-error
(progn (message "Could not load extension: %s" lib) nil)))))
(init-message 3 "Functions: Initialization Functions: load-file-if-available")
(defun load-file-if-available (file)
"Load emacs lisp file, if it exists.
Fails quietly if file does not exist."
(when (file-exists-p file)
(load-file file)))
(init-message 3 "Functions: Initialization Functions: compile-file-if-needed")
(defun compile-file-if-needed-process-file (file)
"Byte-compile expanded FILE name."
(let* ((file (expand-file-name file))
(file-comp (concat file "c")))
(when (or
(not (file-exists-p file-comp))
(file-newer-than-file-p file file-comp))
(byte-compile-file file))))
(defun compile-file-if-needed (file)
"Byte-compile emacs lisp FILE if needed."
(unless (and (> (length file) 3)
(string= (substring file -3) ".el"))
(setq file (concat file ".el")))
(if (file-exists-p file)
(compile-file-if-needed-process-file file)
(dolist (path load-path)
(let ((file (concat path "/" file)))
(when (file-exists-p file)
(compile-file-if-needed-process-file file)))))
(when (get-buffer "*Compile-Log*")
(delete-other-windows)))
(init-message 3 "Functions: Initialization Functions: with-eval-after-load")
(unless (fboundp 'with-eval-after-load)
(defmacro with-eval-after-load (file &rest body)
(declare (indent 1))
`(eval-after-load ,file
`(funcall (function ,(lambda () ,@body))))))
(init-message 3 "Functions: Initialization Functions: eval-after-load-with-byte-compile")
(defmacro eval-after-load-with-byte-compile (file &rest body)
"After FILE is loaded, evaluate BODY.
BODY is byte compiled.
FILE may be a named feature or a file name, see `eval-after-load'
for details."
(declare (indent 1) (debug t))
`(,(if (or (not byte-compile-current-file)
(if (symbolp file)
(require file nil :no-error)
(load file :no-message :no-error)))
'progn
(message "eval-after-load-with-byte-compile: cannot find %s" file)
'with-no-warnings)
(with-eval-after-load ',file ,@body)))
(init-message 3 "Functions: Initialization Functions: safe-load")
(defvar safe-load-error-list ""
"List of files that reported errors when loaded with `safe-load'.")
(defun safe-load (file &optional noerror nomessage nosuffix)
"Load FILE safely.
If an error occurs when loading, report it and add FILE to
`safe-load-error-list'."
(interactive "f")
(condition-case nil
(load file noerror nomessage nosuffix)
('error
(setq safe-load-error-list (concat safe-load-error-list " " file))
(message "Error loading %s" file)
nil)))
(defun safe-load-check ()
"Check for any previous `safe-load' loading errors."
(interactive)
(unless (string= safe-load-error-list "")
(message "Error loading: %s" safe-load-error-list)))
(defun safe-load-compile (file &optional noerror nomessage nosuffix)
"Calls `compile-file-if-needed' followed by `safe-load'."
(interactive "f")
(compile-file-if-needed file)
(safe-load file noerror nomessage nosuffix))
(init-message 2 "Functions: General Functions")
(init-message 3 "Functions: General Functions: list-to-string")
(defun list-to-string (list &optional delimiter)
"Return concatenated characters in LIST using optional DELIMITER."
(let ((delimiter (or delimiter "")))
(mapconcat 'string list delimiter)))
(init-message 3 "Functions: General Functions: string-to-list")
(defun string-to-list (string)
"Return list of characters in STRING."
(cl-loop for x across string collect x))
(init-message 3 "Functions: General Functions: join-strings")
(defun join-strings (list &optional delim)
"Convert LIST of strings into a single string.
Use optional DELIM as a delimiter."
(if delim
(cl-reduce (lambda (x y) (concat x delim y)) list)
(cl-reduce (lambda (x y) (concat x y)) list)))
(init-message 3 "Functions: General Functions: file-to-string")
(defun file-to-string (file)
"Return the contents of FILE as a string."
(if (file-exists-p file)
(with-temp-buffer
(insert-file-contents file)
(buffer-string))
nil))
(init-message 3 "Functions: General Functions: safe-substring")
(defun safe-substring (string from &optional to)
"Calls the `substring' function safely.
No errors will be returned for out of range values of FROM and
TO. Instead the entire string is returned."
(let* ((len (length string))
(to (or to len)))
(when (< from 0)
(setq from (+ len from)))
(when (< to 0)
(setq to (+ len to)))
(if (or (< from 0) (> from len)
(< to 0) (> to len)
(< to from))
string
(substring string from to))))
(init-message 3 "Functions: General Functions: set-nth")
(defun set-nth (n list val)
"Destructively set the Nth element of LIST to VAL."
(setcar (nthcdr n list) val))
(init-message 3 "Functions: General Functions: delete-nth")
(defun delete-nth (n list)
"Destructively delete the Nth element of LIST."
(if (= n 0)
(progn
(setcar list (car (cdr list)))
(setcdr list (cdr (cdr list))))
(setcdr (nthcdr (1- n) list) (nthcdr (1+ n) list))))
(init-message 3 "Functions: General Functions: for-each")
(defun for-each (fn list)
"Call FN for each element in list LIST."
(when list
(funcall fn (car list))
(for-each fn (cdr list))))
(init-message 3 "Functions: General Functions: is-single")
(defun is-single (list)
"Return true if LIST is a list of one element."
(and (consp list) (null (cdr list))))
(init-message 3 "Functions: General Functions: append-element")
(defun append-element (list elm)
"Append ELM to end of list LIST."
(append list (list elm)))
(init-message 3 "Functions: General Functions: map-integer")
(defun map-integer (fn n)
"Call function FN once for every number from 0 to N-1."
(let ((acc nil))
(dotimes (x n)
(push (funcall fn x) acc))
(nreverse acc)))
(init-message 3 "Functions: General Functions: filter")
(defun filter (fn list)
"Call function FN for each element in list LIST and return the non-nil results."
(let (acc)
(dolist (x list (nreverse acc))
(let ((val (funcall fn x)))
(when val (push val acc))))))
(init-message 3 "Functions: General Functions: most")
(defun most (fn list)
"Call function FN for each element in LIST and return the highest score.
The function FN must return a number as a score for a given element.
The element with the highest result is returned with its score."
(if (null list)
(list nil nil)
(let* ((wins (car list))
(max (funcall fn wins)))
(dolist (x (cdr list))
(let ((score (funcall fn x)))
(when (> score max)
(setq wins x
max score))))
(list wins max))))
(init-message 3 "Functions: General Functions: quicksort")
(defun quicksort (list)
"Return sorted LIST (using the Quicksort algorithm)."
(if (null list) nil
(let* ((elt (car list))
(rst (cdr list))
(left-p (lambda (x) (< x elt))))
(append (quicksort (cl-remove-if-not left-p rst))
(list elt)
(quicksort (cl-remove-if left-p rst))))))
(init-message 3 "Functions: General Functions: hash-table-dump")
(defun hash-table-dump (table)
"Return contents of hash TABLE as an association list."
(let (result)
(maphash (lambda (k v) (push (cons k v) result)) table)
(nreverse result)))
(init-message 3 "Functions: General Functions: password")
(defun password (length)
"Return generated password of LENGTH characters."
(interactive "*nLength: ")
(cl-labels
((string-to-list (string) (cl-loop for x across string collect x))
(list-to-string (list) (mapconcat 'string list "")))
(let* ((upper (string-to-list "ABCDEFGHIJKLMNOPQRSTUVWXYZ"))
(lower (string-to-list "abcdefghijklmnopqrstuvwxyz"))
(numbers (string-to-list "0123456789")) (symbols (string-to-list "!@#$%^&*"))
(letters (append upper lower numbers symbols))
(letters-size (length letters))
(bookends (append upper lower numbers))
(bookends-size (length bookends))
(min-numbers 1)
(min-symbols 1)
(number-count 0)
(symbol-count 0)
password
valid)
(when (< length 6)
(user-error "Password LENGTH must be at least 6."))
(while (or (< (length password) length)
(not valid))
(when (= (length password) length)
(setq password nil))
(let ((char (if (and (> (length password) 0)
(< (length password) (1- length)))
(elt letters (random letters-size))
(elt bookends (random bookends-size)))))
(push char password)
(when (member char numbers)
(cl-incf number-count))
(when (member char symbols)
(cl-incf symbol-count))
(when (and (> number-count 0)
(> symbol-count 0))
(setq valid t))))
(list-to-string password))))
(defun password-to-clipboard (length)
"Call `password' with LENGTH and put the result on the
clipboard."
(interactive "*nLength: ")
(with-temp-buffer
(insert (password length))
(clipboard-kill-region (point-min) (point-max))))
(defun password-to-clipboard-20 ()
"Call `password' with a LENGTH of 20 and put the result on the
clipboard."
(interactive "*")
(with-temp-buffer
(insert (password 20))
(clipboard-kill-region (point-min) (point-max))))
(init-message 3 "Functions: General Functions: password-phrase")
(defun password-phrase (count &optional type capitalize)
"Return generated password phrase containing COUNT words.
TYPE (defaults to 'phrase):
'phrase \"threewordphrase\"
'space \"multi word phrase\"
'hyphen \"hyphen-word-phrase\"
'symbol \"symbol!word@phrase\"
'list (\"list\" \"word\" \"phrase\")
If CAPITALIZE is non-nil, capitalize each word."
(interactive
(list
(read-number "Count: ")
(intern (completing-read "Type: " '("phrase" "space" "hyphen" "symbol" "list") nil t))))
(let* ((words
'("abandon" "ability" "able" "about" "above" "absent" "absorb" "abstract" "absurd"
"abuse" "access" "accident" "account" "accuse" "achieve" "acid" "acoustic"
"acquire" "across" "act" "action" "actor" "actress" "actual" "adapt" "add" "addict"
"address" "adjust" "admit" "adult" "advance" "advice" "aerobic" "affair" "afford"
"afraid" "again" "age" "agent" "agree" "ahead" "aim" "air" "airport" "aisle" "alarm"
"album" "alcohol" "alert" "alien" "all" "alley" "allow" "almost" "alone" "alpha"
"already" "also" "alter" "always" "amateur" "amazing" "among" "amount" "amused"
"analyst" "anchor" "ancient" "anger" "angle" "angry" "animal" "ankle" "announce"
"annual" "another" "answer" "antenna" "antique" "anxiety" "any" "apart" "apology"
"appear" "apple" "approve" "april" "arch" "arctic" "area" "arena" "argue" "arm" "armed"
"armor" "army" "around" "arrange" "arrest" "arrive" "arrow" "art" "artefact" "artist"
"artwork" "ask" "aspect" "assault" "asset" "assist" "assume" "asthma" "athlete"
"atom" "attack" "attend" "attitude" "attract" "auction" "audit" "august" "aunt"
"author" "auto" "autumn" "average" "avocado" "avoid" "awake" "aware" "away" "awesome"
"awful" "awkward" "axis" "baby" "bachelor" "bacon" "badge" "bag" "balance" "balcony"
"ball" "bamboo" "banana" "banner" "bar" "barely" "bargain" "barrel" "base" "basic"
"basket" "battle" "beach" "bean" "beauty" "because" "become" "beef" "before" "begin"
"behave" "behind" "believe" "below" "belt" "bench" "benefit" "best" "betray" "better"
"between" "beyond" "bicycle" "bid" "bike" "bind" "biology" "bird" "birth" "bitter"
"black" "blade" "blame" "blanket" "blast" "bleak" "bless" "blind" "blood" "blossom"
"blouse" "blue" "blur" "blush" "board" "boat" "body" "boil" "bomb" "bone" "bonus" "book"
"boost" "border" "boring" "borrow" "boss" "bottom" "bounce" "box" "boy" "bracket"
"brain" "brand" "brass" "brave" "bread" "breeze" "brick" "bridge" "brief" "bright"
"bring" "brisk" "broccoli" "broken" "bronze" "broom" "brother" "brown" "brush"
"bubble" "buddy" "budget" "buffalo" "build" "bulb" "bulk" "bullet" "bundle" "bunker"
"burden" "burger" "burst" "bus" "business" "busy" "butter" "buyer" "buzz" "cabbage"
"cabin" "cable" "cactus" "cage" "cake" "call" "calm" "camera" "camp" "can" "canal"
"cancel" "candy" "cannon" "canoe" "canvas" "canyon" "capable" "capital" "captain"
"car" "carbon" "card" "cargo" "carpet" "carry" "cart" "case" "cash" "casino" "castle"
"casual" "cat" "catalog" "catch" "category" "cattle" "caught" "cause" "caution"
"cave" "ceiling" "celery" "cement" "census" "century" "cereal" "certain" "chair"
"chalk" "champion" "change" "chaos" "chapter" "charge" "chase" "chat" "cheap" "check"
"cheese" "chef" "cherry" "chest" "chicken" "chief" "child" "chimney" "choice"
"choose" "chronic" "chuckle" "chunk" "churn" "cigar" "cinnamon" "circle" "citizen"
"city" "civil" "claim" "clap" "clarify" "claw" "clay" "clean" "clerk" "clever" "click"
"client" "cliff" "climb" "clinic" "clip" "clock" "clog" "close" "cloth" "cloud" "clown"
"club" "clump" "cluster" "clutch" "coach" "coast" "coconut" "code" "coffee" "coil"
"coin" "collect" "color" "column" "combine" "come" "comfort" "comic" "common"
"company" "concert" "conduct" "confirm" "congress" "connect" "consider" "control"
"convince" "cook" "cool" "copper" "copy" "coral" "core" "corn" "correct" "cost"
"cotton" "couch" "country" "couple" "course" "cousin" "cover" "coyote" "crack"
"cradle" "craft" "cram" "crane" "crash" "crater" "crawl" "crazy" "cream" "credit"
"creek" "crew" "cricket" "crime" "crisp" "critic" "crop" "cross" "crouch" "crowd"
"crucial" "cruel" "cruise" "crumble" "crunch" "crush" "cry" "crystal" "cube"
"culture" "cup" "cupboard" "curious" "current" "curtain" "curve" "cushion" "custom"
"cute" "cycle" "dad" "damage" "damp" "dance" "danger" "daring" "dash" "daughter" "dawn"
"day" "deal" "debate" "debris" "decade" "december" "decide" "decline" "decorate"
"decrease" "deer" "defense" "define" "defy" "degree" "delay" "deliver" "demand"
"demise" "denial" "dentist" "deny" "depart" "depend" "deposit" "depth" "deputy"
"derive" "describe" "desert" "design" "desk" "despair" "destroy" "detail" "detect"
"develop" "device" "devote" "diagram" "dial" "diamond" "diary" "dice" "diesel" "diet"
"differ" "digital" "dignity" "dilemma" "dinner" "dinosaur" "direct" "dirt"
"disagree" "discover" "disease" "dish" "dismiss" "disorder" "display" "distance"
"divert" "divide" "divorce" "dizzy" "doctor" "document" "dog" "doll" "dolphin"
"domain" "donate" "donkey" "donor" "door" "dose" "double" "dove" "draft" "dragon"
"drama" "drastic" "draw" "dream" "dress" "drift" "drill" "drink" "drip" "drive" "drop"
"drum" "dry" "duck" "dumb" "dune" "during" "dust" "dutch" "duty" "dwarf" "dynamic"
"eager" "eagle" "early" "earn" "earth" "easily" "east" "easy" "echo" "ecology"
"economy" "edge" "edit" "educate" "effort" "egg" "eight" "either" "elbow" "elder"
"electric" "elegant" "element" "elephant" "elevator" "elite" "else" "embark"
"embody" "embrace" "emerge" "emotion" "employ" "empower" "empty" "enable" "enact"
"end" "endless" "endorse" "enemy" "energy" "enforce" "engage" "engine" "enhance"
"enjoy" "enlist" "enough" "enrich" "enroll" "ensure" "enter" "entire" "entry"
"envelope" "episode" "equal" "equip" "era" "erase" "erode" "erosion" "error" "erupt"
"escape" "essay" "essence" "estate" "eternal" "ethics" "evidence" "evil" "evoke"
"evolve" "exact" "example" "excess" "exchange" "excite" "exclude" "excuse"
"execute" "exercise" "exhaust" "exhibit" "exile" "exist" "exit" "exotic" "expand"
"expect" "expire" "explain" "expose" "express" "extend" "extra" "eye" "eyebrow"
"fabric" "face" "faculty" "fade" "faint" "faith" "fall" "false" "fame" "family"
"famous" "fan" "fancy" "fantasy" "farm" "fashion" "fat" "fatal" "father" "fatigue"
"fault" "favorite" "feature" "february" "federal" "fee" "feed" "feel" "female"
"fence" "festival" "fetch" "fever" "few" "fiber" "fiction" "field" "figure" "file"
"film" "filter" "final" "find" "fine" "finger" "finish" "fire" "firm" "first" "fiscal"
"fish" "fit" "fitness" "fix" "flag" "flame" "flash" "flat" "flavor" "flee" "flight"
"flip" "float" "flock" "floor" "flower" "fluid" "flush" "fly" "foam" "focus" "fog" "foil"
"fold" "follow" "food" "foot" "force" "forest" "forget" "fork" "fortune" "forum"
"forward" "fossil" "foster" "found" "fox" "fragile" "frame" "frequent" "fresh"
"friend" "fringe" "frog" "front" "frost" "frown" "frozen" "fruit" "fuel" "fun" "funny"
"furnace" "fury" "future" "gadget" "gain" "galaxy" "gallery" "game" "gap" "garage"
"garbage" "garden" "garlic" "garment" "gas" "gasp" "gate" "gather" "gauge" "gaze"
"general" "genius" "genre" "gentle" "genuine" "gesture" "ghost" "giant" "gift"
"giggle" "ginger" "giraffe" "girl" "give" "glad" "glance" "glare" "glass" "glide"
"glimpse" "globe" "gloom" "glory" "glove" "glow" "glue" "goat" "goddess" "gold" "good"
"goose" "gorilla" "gospel" "gossip" "govern" "gown" "grab" "grace" "grain" "grant"
"grape" "grass" "gravity" "great" "green" "grid" "grief" "grit" "grocery" "group"
"grow" "grunt" "guard" "guess" "guide" "guilt" "guitar" "gun" "gym" "habit" "hair" "half"
"hammer" "hamster" "hand" "happy" "harbor" "hard" "harsh" "harvest" "hat" "have" "hawk"
"hazard" "head" "health" "heart" "heavy" "hedgehog" "height" "hello" "helmet" "help"
"hen" "hero" "hidden" "high" "hill" "hint" "hip" "hire" "history" "hobby" "hockey" "hold"
"hole" "holiday" "hollow" "home" "honey" "hood" "hope" "horn" "horror" "horse"
"hospital" "host" "hotel" "hour" "hover" "hub" "huge" "human" "humble" "humor"
"hundred" "hungry" "hunt" "hurdle" "hurry" "hurt" "husband" "hybrid" "ice" "icon"
"idea" "identify" "idle" "ignore" "ill" "illegal" "illness" "image" "imitate"
"immense" "immune" "impact" "impose" "improve" "impulse" "inch" "include" "income"
"increase" "index" "indicate" "indoor" "industry" "infant" "inflict" "inform"
"inhale" "inherit" "initial" "inject" "injury" "inmate" "inner" "innocent" "input"
"inquiry" "insane" "insect" "inside" "inspire" "install" "intact" "interest" "into"
"invest" "invite" "involve" "iron" "island" "isolate" "issue" "item" "ivory" "jacket"
"jaguar" "jar" "jazz" "jealous" "jeans" "jelly" "jewel" "job" "join" "joke" "journey"
"joy" "judge" "juice" "jump" "jungle" "junior" "junk" "just" "kangaroo" "keen" "keep"
"ketchup" "key" "kick" "kid" "kidney" "kind" "kingdom" "kiss" "kit" "kitchen" "kite"
"kitten" "kiwi" "knee" "knife" "knock" "know" "lab" "label" "labor" "ladder" "lady"
"lake" "lamp" "language" "laptop" "large" "later" "latin" "laugh" "laundry" "lava"
"law" "lawn" "lawsuit" "layer" "lazy" "leader" "leaf" "learn" "leave" "lecture" "left"
"leg" "legal" "legend" "leisure" "lemon" "lend" "length" "lens" "leopard" "lesson"
"letter" "level" "liar" "liberty" "library" "license" "life" "lift" "light" "like"
"limb" "limit" "link" "lion" "liquid" "list" "little" "live" "lizard" "load" "loan"
"lobster" "local" "lock" "logic" "lonely" "long" "loop" "lottery" "loud" "lounge"
"love" "loyal" "lucky" "luggage" "lumber" "lunar" "lunch" "luxury" "lyrics" "machine"
"mad" "magic" "magnet" "maid" "mail" "main" "major" "make" "mammal" "man" "manage"
"mandate" "mango" "mansion" "manual" "maple" "marble" "march" "margin" "marine"
"market" "marriage" "mask" "mass" "master" "match" "material" "math" "matrix"
"matter" "maximum" "maze" "meadow" "mean" "measure" "meat" "mechanic" "medal" "media"
"melody" "melt" "member" "memory" "mention" "menu" "mercy" "merge" "merit" "merry"
"mesh" "message" "metal" "method" "middle" "midnight" "milk" "million" "mimic" "mind"
"minimum" "minor" "minute" "miracle" "mirror" "misery" "miss" "mistake" "mix" "mixed"
"mixture" "mobile" "model" "modify" "mom" "moment" "monitor" "monkey" "monster"
"month" "moon" "moral" "more" "morning" "mosquito" "mother" "motion" "motor"
"mountain" "mouse" "move" "movie" "much" "muffin" "mule" "multiply" "muscle" "museum"
"mushroom" "music" "must" "mutual" "myself" "mystery" "myth" "naive" "name" "napkin"
"narrow" "nasty" "nation" "nature" "near" "neck" "need" "negative" "neglect"
"neither" "nephew" "nerve" "nest" "net" "network" "neutral" "never" "news" "next"
"nice" "night" "noble" "noise" "nominee" "noodle" "normal" "north" "nose" "notable"
"note" "nothing" "notice" "novel" "now" "nuclear" "number" "nurse" "nut" "oak" "obey"
"object" "oblige" "obscure" "observe" "obtain" "obvious" "occur" "ocean" "october"
"odor" "off" "offer" "office" "often" "oil" "okay" "old" "olive" "olympic" "omit" "once"
"one" "onion" "online" "only" "open" "opera" "opinion" "oppose" "option" "orange"
"orbit" "orchard" "order" "ordinary" "organ" "orient" "original" "orphan" "ostrich"
"other" "outdoor" "outer" "output" "outside" "oval" "oven" "over" "own" "owner"
"oxygen" "oyster" "ozone" "pact" "paddle" "page" "pair" "palace" "palm" "panda" "panel"
"panic" "panther" "paper" "parade" "parent" "park" "parrot" "party" "pass" "patch"
"path" "patient" "patrol" "pattern" "pause" "pave" "payment" "peace" "peanut" "pear"
"peasant" "pelican" "pen" "penalty" "pencil" "people" "pepper" "perfect" "permit"
"person" "pet" "phone" "photo" "phrase" "physical" "piano" "picnic" "picture" "piece"
"pig" "pigeon" "pill" "pilot" "pink" "pioneer" "pipe" "pistol" "pitch" "pizza" "place"
"planet" "plastic" "plate" "play" "please" "pledge" "pluck" "plug" "plunge" "poem"
"poet" "point" "polar" "pole" "police" "pond" "pony" "pool" "popular" "portion"
"position" "possible" "post" "potato" "pottery" "poverty" "powder" "power"
"practice" "praise" "predict" "prefer" "prepare" "present" "pretty" "prevent"
"price" "pride" "primary" "print" "priority" "prison" "private" "prize" "problem"
"process" "produce" "profit" "program" "project" "promote" "proof" "property"
"prosper" "protect" "proud" "provide" "public" "pudding" "pull" "pulp" "pulse"
"pumpkin" "punch" "pupil" "puppy" "purchase" "purity" "purpose" "purse" "push" "put"
"puzzle" "pyramid" "quality" "quantum" "quarter" "question" "quick" "quit" "quiz"
"quote" "rabbit" "raccoon" "race" "rack" "radar" "radio" "rail" "rain" "raise" "rally"
"ramp" "ranch" "random" "range" "rapid" "rare" "rate" "rather" "raven" "raw" "razor"
"ready" "real" "reason" "rebel" "rebuild" "recall" "receive" "recipe" "record"
"recycle" "reduce" "reflect" "reform" "refuse" "region" "regret" "regular" "reject"
"relax" "release" "relief" "rely" "remain" "remember" "remind" "remove" "render"
"renew" "rent" "reopen" "repair" "repeat" "replace" "report" "require" "rescue"
"resemble" "resist" "resource" "response" "result" "retire" "retreat" "return"
"reunion" "reveal" "review" "reward" "rhythm" "rib" "ribbon" "rice" "rich" "ride"
"ridge" "rifle" "right" "rigid" "ring" "riot" "ripple" "risk" "ritual" "rival" "river"
"road" "roast" "robot" "robust" "rocket" "romance" "roof" "rookie" "room" "rose"
"rotate" "rough" "round" "route" "royal" "rubber" "rude" "rug" "rule" "run" "runway"
"rural" "sad" "saddle" "sadness" "safe" "sail" "salad" "salmon" "salon" "salt" "salute"
"same" "sample" "sand" "satisfy" "satoshi" "sauce" "sausage" "save" "say" "scale"
"scan" "scare" "scatter" "scene" "scheme" "school" "science" "scissors" "scorpion"
"scout" "scrap" "screen" "script" "scrub" "sea" "search" "season" "seat" "second"
"secret" "section" "security" "seed" "seek" "segment" "select" "sell" "seminar"
"senior" "sense" "sentence" "series" "service" "session" "settle" "setup" "seven"
"shadow" "shaft" "shallow" "share" "shed" "shell" "sheriff" "shield" "shift" "shine"
"ship" "shiver" "shock" "shoe" "shoot" "shop" "short" "shoulder" "shove" "shrimp"
"shrug" "shuffle" "shy" "sibling" "sick" "side" "siege" "sight" "sign" "silent" "silk"
"silly" "silver" "similar" "simple" "since" "sing" "siren" "sister" "situate" "six"
"size" "skate" "sketch" "ski" "skill" "skin" "skirt" "skull" "slab" "slam" "sleep"
"slender" "slice" "slide" "slight" "slim" "slogan" "slot" "slow" "slush" "small"
"smart" "smile" "smoke" "smooth" "snack" "snake" "snap" "sniff" "snow" "soap" "soccer"
"social" "sock" "soda" "soft" "solar" "soldier" "solid" "solution" "solve" "someone"
"song" "soon" "sorry" "sort" "soul" "sound" "soup" "source" "south" "space" "spare"
"spatial" "spawn" "speak" "special" "speed" "spell" "spend" "sphere" "spice" "spider"
"spike" "spin" "spirit" "split" "spoil" "sponsor" "spoon" "sport" "spot" "spray"
"spread" "spring" "spy" "square" "squeeze" "squirrel" "stable" "stadium" "staff"
"stage" "stairs" "stamp" "stand" "start" "state" "stay" "steak" "steel" "stem" "step"
"stereo" "stick" "still" "sting" "stock" "stomach" "stone" "stool" "story" "stove"
"strategy" "street" "strike" "strong" "struggle" "student" "stuff" "stumble"
"style" "subject" "submit" "subway" "success" "such" "sudden" "suffer" "sugar"
"suggest" "suit" "summer" "sun" "sunny" "sunset" "super" "supply" "supreme" "sure"
"surface" "surge" "surprise" "surround" "survey" "suspect" "sustain" "swallow"
"swamp" "swap" "swarm" "swear" "sweet" "swift" "swim" "swing" "switch" "sword" "symbol"
"symptom" "syrup" "system" "table" "tackle" "tag" "tail" "talent" "talk" "tank" "tape"
"target" "task" "taste" "tattoo" "taxi" "teach" "team" "tell" "ten" "tenant" "tennis"
"tent" "term" "test" "text" "thank" "that" "theme" "then" "theory" "there" "they" "thing"
"this" "thought" "three" "thrive" "throw" "thumb" "thunder" "ticket" "tide" "tiger"
"tilt" "timber" "time" "tiny" "tip" "tired" "tissue" "title" "toast" "tobacco" "today"
"toddler" "toe" "together" "toilet" "token" "tomato" "tomorrow" "tone" "tongue"
"tonight" "tool" "tooth" "top" "topic" "topple" "torch" "tornado" "tortoise" "toss"
"total" "tourist" "toward" "tower" "town" "toy" "track" "trade" "traffic" "tragic"
"train" "transfer" "trap" "trash" "travel" "tray" "treat" "tree" "trend" "trial"
"tribe" "trick" "trigger" "trim" "trip" "trophy" "trouble" "truck" "true" "truly"
"trumpet" "trust" "truth" "try" "tube" "tuition" "tumble" "tuna" "tunnel" "turkey"
"turn" "turtle" "twelve" "twenty" "twice" "twin" "twist" "two" "type" "typical" "ugly"
"umbrella" "unable" "unaware" "uncle" "uncover" "under" "undo" "unfair" "unfold"
"unhappy" "uniform" "unique" "unit" "universe" "unknown" "unlock" "until" "unusual"
"unveil" "update" "upgrade" "uphold" "upon" "upper" "upset" "urban" "urge" "usage"
"use" "used" "useful" "useless" "usual" "utility" "vacant" "vacuum" "vague" "valid"
"valley" "valve" "van" "vanish" "vapor" "various" "vast" "vault" "vehicle" "velvet"
"vendor" "venture" "venue" "verb" "verify" "version" "very" "vessel" "veteran"
"viable" "vibrant" "vicious" "victory" "video" "view" "village" "vintage" "violin"
"virtual" "virus" "visa" "visit" "visual" "vital" "vivid" "vocal" "voice" "void"
"volcano" "volume" "vote" "voyage" "wage" "wagon" "wait" "walk" "wall" "walnut" "want"
"warfare" "warm" "warrior" "wash" "wasp" "waste" "water" "wave" "way" "wealth" "weapon"
"wear" "weasel" "weather" "web" "wedding" "weekend" "weird" "welcome" "west" "wet"
"whale" "what" "wheat" "wheel" "when" "where" "whip" "whisper" "wide" "width" "wife"
"wild" "will" "win" "window" "wine" "wing" "wink" "winner" "winter" "wire" "wisdom"
"wise" "wish" "witness" "wolf" "woman" "wonder" "wood" "wool" "word" "work" "world"
"worry" "worth" "wrap" "wreck" "wrestle" "wrist" "write" "wrong" "yard" "year" "yellow"
"you" "young" "youth" "zebra" "zero" "zone" "zoo"))
(word-size (length words))
(symbols '("!" "@" "#" "$" "%" "^" "&" "*" "(" ")" "-" "_" "=" "+" ";" ":" "'" "\"" "," "<" "." ">" "/" "?"))
(symbol-size (length symbols))
phrase)
(while (< (length phrase) count)
(if capitalize
(cl-pushnew (capitalize (elt words (random word-size))) phrase)
(cl-pushnew (elt words (random word-size)) phrase))
(when (and (eq type 'symbol)
(> (length phrase) 1))
(cl-pushnew (concat (pop phrase) (elt symbols (random symbol-size))) phrase)))
(cl-case type
('list (format "%S" phrase))
('space (cl-reduce (lambda (x y) (concat x " " y)) phrase))
('hyphen (cl-reduce (lambda (x y) (concat x "-" y)) phrase))
(t (cl-reduce (lambda (x y) (concat x y)) phrase)))))
(defun password-phrase-to-clipboard (count &optional type capitalize)
"Call `password-phrase' with COUNT, TYPE, and CAPITALIZE and put
the result on the clipboard."
(interactive
(list
(read-number "Count: ")
(intern (completing-read "Type: " '("phrase" "space" "hyphen" "list") nil t))))
(let ((password (password-phrase count type capitalize)))
(with-temp-buffer
(insert password)
(clipboard-kill-region (point-min) (point-max)))
password))
(defun password-phrase-to-clipboard-3-space ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'space."
(interactive "*")
(password-phrase-to-clipboard 3 'space))
(defun password-phrase-to-clipboard-6-space ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'space."
(interactive "*")
(password-phrase-to-clipboard 6 'space))
(defun password-phrase-to-clipboard-3-hyphen ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'hyphen."
(interactive "*")
(password-phrase-to-clipboard 3 'hyphen))
(defun password-phrase-to-clipboard-3-hyphen-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'hyphen, with capitalized words."
(interactive "*")
(password-phrase-to-clipboard 3 'hyphen :capitalize))
(defun password-phrase-to-clipboard-3-symbol-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'symbol, with capitalized words."
(interactive "*")
(password-phrase-to-clipboard 3 'symbol :capitalize))
(defun password-phrase-to-clipboard-6-hyphen ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'hyphen."
(interactive "*")
(password-phrase-to-clipboard 6 'hyphen))
(defun password-phrase-to-clipboard-6-hyphen-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 a TYPE
of 'hyphen, with capitalized words."
(interactive "*")
(password-phrase-to-clipboard 6 'hyphen :capitalize))
(defun password-phrase-to-clipboard-6-symbol-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'symbol, with capitalized words."
(interactive "*")
(password-phrase-to-clipboard 6 'symbol :capitalize))
(init-message 2 "Functions: Emacs Functions")
(init-message 3 "Functions: Emacs Functions: inside-string")
(defun inside-string ()
"Return non-nil if point is inside a string."
(not (not (nth 3 (syntax-ppss)))))
(init-message 3 "Functions: Emacs Functions: inside-comment")
(defun inside-comment ()
"Return non-nil if point is inside a comment."
(nth 4 (syntax-ppss)))
(init-message 3 "Functions: Emacs Functions: try-finally")
(defmacro try-finally (fn &rest finally)
"Evaluate FN catching and returning any errors after FINALLY is
evaluated."
`(unwind-protect
(let (result)
(condition-case err
(setq result (progn ,fn))
('error
(message "Caught error: %s" err)
(setq result (cons 'error (list err)))))
result)
,@finally))
(init-message 3 "Functions: Emacs Functions: save-buffer-always")
(defun save-buffer-always ()
"Save current buffer in visited file even if it has not been modified."
(interactive)
(set-buffer-modified-p t)
(save-buffer))
(init-message 3 "Functions: Emacs Functions: save-buffer-always-maybe")
(defun save-buffer-always-maybe (arg)
"Call `save-buffer' if no prefix given, otherwise call
`save-buffer-always' to force a save."
(interactive "P")
(if arg
(save-buffer-always)
(save-buffer)))
(init-message 3 "Functions: Emacs Functions: describe-function-or-variable-at-point")
(defun describe-function-or-variable-at-point (&optional point)
"Describe function or variable at POINT (or `point' if not given).
Use `describe-function' or `describe-variable' as appropriate."
(interactive)
(let ((pos (or point (point))))
(save-mark-and-excursion
(goto-char pos)
(if (eq (variable-at-point) 0)
(call-interactively 'describe-function)
(call-interactively 'describe-variable)))))
(init-message 3 "Functions: Emacs Functions: mode-line-add")
(defun mode-line-add (item)
"Add ITEM to `global-mode-string' part of the mode line."
(or global-mode-string (setq global-mode-string '("")))
(add-to-list 'global-mode-string item t))
(init-message 3 "Functions: Emacs Functions: insert-line-below")
(defun insert-line-below ()
"Insert a line below current one."
(interactive)
(end-of-line)
(newline)
(indent-for-tab-command))
(init-message 3 "Functions: Emacs Functions: insert-line-above")
(defun insert-line-above ()
"Insert a line above current one."
(interactive)
(forward-line 0)
(newline)
(forward-line -1)
(indent-for-tab-command))
(init-message 3 "Functions: Emacs Functions: move-line-down")
(defun move-line-down ()
(interactive)
(let ((col (current-column))
(eol (line-end-position)))
(forward-line 1)
(unless (> (point) eol)
(goto-char eol)
(newline))
(transpose-lines 1)
(forward-line -1)
(move-to-column col)))
(init-message 3 "Functions: Emacs Functions: move-line-up")
(defun move-line-up ()
(interactive)
(let ((col (current-column))
(eol (line-end-position)))
(forward-line 1)
(unless (> (point) eol)
(goto-char eol)
(newline))
(ignore-errors (transpose-lines -1))
(forward-line -1)
(move-to-column col)))
(init-message 3 "Functions: Emacs Functions: kill-region-or-word")
(defun kill-region-or-word ()
"Call `kill-region' or `backward-kill-word' depending on
whether or not a region is selected."
(interactive "*")
(if (use-region-p)
(kill-region (point) (mark))
(backward-kill-word 1)))
(init-message 3 "Functions: Emacs Functions: kill-duplicate-lines")
(defun kill-duplicate-lines (&optional beg end)
"Kill duplicate lines in the pre-sorted selected region or entire buffer (if none)."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (not (eobp))
(kill-line 1)
(yank)
(let ((next-line (point)))
(while (re-search-forward (format "^%s" (regexp-quote (car kill-ring))) nil :noerror)
(replace-match "" nil nil))
(goto-char next-line))))))))
(init-message 3 "Functions: Emacs Functions: indent-or-expand")
(defun indent-or-expand ()
"Either indent according to mode, or expand the word preceding point."
(interactive "*")
(if (and
(not (bobp))
(not (eobp))
(= ?w (char-syntax (char-before)))
(not (= ?w (char-syntax (char-after)))))
(dabbrev-expand nil)
(indent-according-to-mode)))
(init-message 3 "Functions: Emacs Functions: swap-windows")
(defun swap-windows ()
"If you have two windows, swap them."
(interactive)
(if (not (= (count-windows) 2))
(message "You need exactly two windows to swap them.")
(let* ((w1 (first (window-list)))
(w2 (second (window-list)))
(b1 (window-buffer w1))
(b2 (window-buffer w2))
(s1 (window-start w1))
(s2 (window-start w2)))
(set-window-buffer w1 b2)
(set-window-buffer w2 b1)
(set-window-start w1 s2)
(set-window-start w2 s1))))
(init-message 3 "Functions: Emacs Functions: toggle-window-split")
(defun toggle-window-split ()
"If you have two windows, toggle them between horizontal and vertical layouts."
(interactive)
(if (not (= (count-windows) 2))
(message "You need exactly two windows to toggle them.")
(let* ((w1 (first (window-list)))
(w2 (second (window-list)))
(b1 (window-buffer w1))
(b2 (window-buffer w2))
(s1 (window-start w1))
(s2 (window-start w2))
(e1 (window-edges w1))
(e2 (window-edges w2))
(win-2nd (not (and (<= (car e1) (car e2))
(<= (cadr e1) (cadr e2)))))
(splitter
(if (= (car e1) (car e2))
'split-window-horizontally
'split-window-vertically)))
(delete-other-windows)
(funcall splitter)
(when win-2nd (other-window 1))
(set-window-buffer (selected-window) b1)
(set-window-buffer (next-window) b2)
(select-window w1)
(when win-2nd (other-window 1)))))
(init-message 3 "Functions: Emacs Functions: window-enlarge-vertically")
(defun window-enlarge-vertically (arg)
"Make current window 5 lines bigger vertically."
(interactive "P")
(if arg
(enlarge-window (* 5 arg))
(enlarge-window 5)))
(init-message 3 "Functions: Emacs Functions: window-shrink-vertically")
(defun window-shrink-vertically (arg)
"Make current window 5 lines smaller vertically."
(interactive "P")
(if arg
(shrink-window (* 5 arg))
(shrink-window 5)))
(init-message 3 "Functions: Emacs Functions: window-enlarge-horizontally")
(defun window-enlarge-horizontally (arg)
"Make current window 5 lines bigger horizontally."
(interactive "P")
(if arg
(enlarge-window (* 5 arg) :horizontal)
(enlarge-window 5 :horizontal)))
(init-message 3 "Functions: Emacs Functions: window-shrink-horizontally")
(defun window-shrink-horizontally (arg)
"Make current window 5 lines smaller horizontally."
(interactive "P")
(if arg
(shrink-window (* 5 arg) :horizontal)
(shrink-window 5 :horizontal)))
(init-message 3 "Functions: Emacs Functions: compile-elisp")
(defun compile-elisp (&optional dir)
"Byte compile DIR directory.
DIR defaults to `emacs-home-dir' or `~/.emacs.d'."
(interactive)
(byte-recompile-directory (or dir emacs-home-dir "~/.emacs.d") 0))
(init-message 3 "Functions: Emacs Functions: join-next-line")
(defun join-next-line (arg)
"Join next line with current one."
(interactive "*P")
(dotimes (_ (or arg 1))
(join-line -1)))
(init-message 3 "Functions: Emacs Functions: sort-all-lines")
(defun sort-all-lines (&optional reverse)
"Sort all lines in current buffer.
If REVERSE is non-nil, then sort in reverse order."
(interactive "*")
(save-mark-and-excursion
(sort-lines reverse (point-min) (point-max))))
(init-message 3 "Functions: Emacs Functions: sort-lines-removing-duplicates")
(defun sort-lines-removing-duplicates (&optional reverse beg end)
"Call `sort-lines' to sort lines in region or between BEG and END,
then remove all duplicate lines.
If REVERSE is non-nil, then sort in reverse order."
(interactive "*P\nr")
(sort-lines reverse beg end)
(save-mark-and-excursion
(goto-char end)
(let ((prev (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
(while (and (not (bobp))
(>= (point) beg))
(forward-line -1)
(let ((line (buffer-substring-no-properties
(line-beginning-position)
(line-end-position))))
(when (string= prev line)
(delete-region (line-beginning-position) (1+ (line-end-position))))
(setq prev line))))))
(init-message 3 "Functions: Emacs Functions: delete-word")
(defun delete-word (arg)
"Delete characters forward until encountering the end of the
type of character on point. Types are: whitespace, alphanumeric,
and symbol/other.
With argument ARG, do this that many times."
(interactive "p")
(let ((whitespace-regexp "[ \t\n]")
(alphanumeric-regexp "[[:alnum:]-_]"))
(dotimes (_ arg)
(delete-region
(point)
(save-mark-and-excursion
(let ((type (cond ((looking-at whitespace-regexp) :whitespace)
((looking-at alphanumeric-regexp) :alphanumeric)
(t :other)))
(char (char-after)))
(forward-char 1)
(while (and (not (eobp))
(cl-case type
(:whitespace (looking-at whitespace-regexp))
(:alphanumeric (looking-at alphanumeric-regexp))
(:other (= char (char-after)))))
(forward-char 1))
(point)))))))
(init-message 3 "Functions: Emacs Functions: backward-delete-word")
(defun backward-delete-word (arg)
"Delete characters backward until encountering the end of the
type of character on point. Types are: whitespace, alphanumeric,
and symbol/other.
With argument ARG, do this that many times."
(interactive "p")
(let ((whitespace-regexp "[ \t\n]")
(alphanumeric-regexp "[[:alnum:]-_]"))
(dotimes (_ arg)
(delete-region
(save-mark-and-excursion
(backward-char 1)
(let ((type (cond ((bobp) :bobp)
((looking-at whitespace-regexp) :whitespace)
((looking-at alphanumeric-regexp) :alphanumeric)
(t :other)))
(char (char-after)))
(unless (eq type :bobp)
(backward-char 1)
(while (cl-case type
(:bobp nil)
(:whitespace (looking-at whitespace-regexp))
(:alphanumeric (looking-at alphanumeric-regexp))
(:other (= char (char-after))))
(if (bobp)
(setq type :bobp)
(backward-char 1)))
(unless (eq type :bobp)
(forward-char 1)))
(point)))
(point)))))
(init-message 3 "Functions: Emacs Functions: copy-line")
(defun copy-line (&optional line)
"Copy the line containing the point or LINE."
(interactive)
(save-mark-and-excursion
(when line
(goto-char (point-min))
(forward-line (1- line)))
(forward-line 0)
(let ((beg (point)))
(if (eobp)
(goto-char (line-end-position))
(forward-line 1))
(copy-region-as-kill beg (point)))))
(init-message 3 "Functions: Emacs Functions: cut-line")
(defun cut-line (&optional line)
"Cut the line containing the point or LINE."
(interactive "*")
(save-mark-and-excursion
(when line
(goto-char (point-min))
(forward-line (1- line)))
(forward-line 0)
(let ((beg (point)))
(if (eobp)
(goto-char (line-end-position))
(forward-line 1))
(kill-region beg (point)))))
(init-message 3 "Functions: Emacs Functions: delete-line")
(defun delete-line (&optional line)
"Delete the line containing the point or LINE."
(interactive "*")
(let ((col (- (point) (line-beginning-position))))
(when line
(goto-char (point-min))
(forward-line (1- line)))
(forward-line 0)
(delete-region (point)
(progn
(forward-line 1)
(point)))
(if (<= (+ (point) col) (line-end-position))
(forward-char col)
(goto-char (line-end-position)))))
(init-message 3 "Functions: Emacs Functions: delete-to-end-of-line")
(defun delete-to-end-of-line (&optional arg)
"Delete from the point to the end of the line containing the point."
(interactive "*P")
(delete-region (point)
(progn
(if arg
(forward-line (prefix-numeric-value arg))
(if (not (eolp))
(goto-char (line-end-position))
(forward-char 1)))
(point))))
(init-message 3 "Functions: Emacs Functions: duplicate-line")
(defun duplicate-line (&optional comment line)
"Duplicate the line containing the point.
If COMMENT is non-nil, also comment out the original line.
If LINE is non-nil, duplicate that line instead.
Handles duplicating `org-table' lines correctly. Also fixes
closing s-expressions properly.
Cursor is left at current column in newly created line."
(interactive "*P")
(let ((col (current-column)))
(when line
(goto-char (point-min))
(forward-line (1- line)))
(let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position))))
(when comment
(comment-region (line-beginning-position) (line-end-position)))
(when (and (fboundp 'org-at-table-p) (org-at-table-p))
(org-table-insert-row)
(delete-region (line-beginning-position) (1+ (line-end-position))))
(goto-char (line-end-position))
(newline)
(insert line)
(move-to-column col)
(when (or (eq major-mode 'emacs-lisp-mode)
(eq major-mode 'lisp-mode))
(save-mark-and-excursion
(ignore-errors
(forward-line -1)
(forward-line 0)
(forward-sexp)
(when (looking-at "\\()+\\)[ \t]*;")
(replace-match (make-string (length (match-string 1)) ?\s) nil nil nil 1))
(when (looking-at ")+")
(replace-match ""))
(forward-line 1)))))))
(init-message 3 "Functions: Emacs Functions: duplicate-line-inc")
(defun duplicate-line-inc (&optional line)
"Duplicate the line containing the point or LINE and increment any numbers by 1."
(interactive "*")
(let ((col (current-column)))
(save-mark-and-excursion
(when line
(goto-char (point-min))
(forward-line (1- line)))
(copy-region-as-kill (line-beginning-position) (line-end-position))
(goto-char (line-end-position))
(if (eobp)
(newline)
(forward-line 1))
(open-line 1)
(yank))
(forward-line 1)
(while (re-search-forward "[0-9]+" (line-end-position) :noerror)
(let ((num (string-to-number
(buffer-substring-no-properties (match-beginning 0) (match-end 0)))))
(replace-match (int-to-string (1+ num)))))
(move-to-column col)))
(init-message 3 "Functions: Emacs Functions: yank-as-rectangle")
(defun yank-as-rectangle ()
"Yank the most recently killed text as a rectangle with upper left corner at point."
(interactive "*")
(with-temp-buffer
(yank)
(goto-char (point-min))
(rectangle-mark-mode 1)
(let ((width 0))
(while (not (eobp))
(end-of-line)
(when (> (current-column) width)
(setq width (current-column)))
(forward-line 1))
(forward-line 0)
(rectangle-right-char width))
(kill-rectangle (point-min) (point)))
(yank-rectangle))
(init-message 3 "Functions: Emacs Functions: display-line-numbers-type-toggle")
(defun display-line-numbers-type-toggle ()
"Toggle `display-line-numbers' between `t' and `relative' values."
(interactive)
(setq display-line-numbers
(if (eq display-line-numbers 'relative)
t
'relative)))
(init-message 3 "Functions: Emacs Functions: goto-line-enhanced")
(defun goto-line-enhanced ()
"Show line numbers while prompting for the line number to go to."
(interactive)
(if (or
display-line-numbers
current-prefix-arg)
(call-interactively 'goto-line)
(unwind-protect
(progn
(display-line-numbers-mode 1)
(call-interactively 'goto-line))
(display-line-numbers-mode -1))))
(bind-keys* ([remap goto-line] . goto-line-enhanced))
(init-message 3 "Functions: Emacs Functions: forward-sexp-enhanced")
(defun forward-sexp-enhanced (arg)
"Move point forward one balanced expression (sexp) or ARG sexp's (backward if ARG is negative)."
(interactive "P")
(let ((arg (or arg 1))
(p (point)))
(ignore-errors
(forward-sexp arg))
(when (= p (point))
(cond
((> arg 0)
(forward-char 1)
(when (> arg 1)
(forward-sexp-enhanced (1- arg))))
((< arg 0)
(forward-char -1)
(when (< arg -1)
(forward-sexp-enhanced (1+ arg))))
(t)))))
(bind-keys* ([remap forward-sexp] . forward-sexp-enhanced))
(init-message 3 "Functions: Emacs Functions: backward-sexp-enhanced")
(defun backward-sexp-enhanced (arg)
"Move point backward one balanced expression (sexp) or ARG sexp's (forward if ARG is negative)."
(interactive "P")
(let ((arg (or arg 1)))
(forward-sexp-enhanced (- 0 arg))))
(bind-keys* ([remap backward-sexp] . backward-sexp-enhanced))
(init-message 3 "Functions: Emacs Functions: scroll-up-enhanced")
(defun scroll-up-enhanced (arg)
"Scroll up one page or ARG amount.
If less than a page away, jump to the end of the buffer."
(interactive "P")
(let ((col (current-column)))
(condition-case nil
(if arg
(scroll-up arg)
(scroll-up))
('error
(goto-char (point-max))))
(move-to-column col)))
(bind-keys* ([remap scroll-up] . scroll-up-enhanced))
(init-message 3 "Functions: Emacs Functions: scroll-down-enhanced")
(defun scroll-down-enhanced (arg)
"Scroll down one page or ARG amount.
If less than a page away, jump to the beginning of the buffer."
(interactive "P")
(let ((col (current-column)))
(condition-case nil
(if arg
(scroll-down arg)
(scroll-down))
('error
(goto-char (point-min))))
(move-to-column col)))
(bind-keys* ([remap scroll-down] . scroll-down-enhanced))
(init-message 3 "Functions: Emacs Functions: scroll-up-command-enhanced")
(defun scroll-up-command-enhanced (arg)
"Scroll up one page or ARG amount.
If less than a page away, jump to the end of the buffer."
(interactive "P")
(let ((col (current-column)))
(condition-case nil
(if arg
(scroll-up-command arg)
(scroll-up-command))
('error
(goto-char (point-max))))
(move-to-column col)))
(bind-keys* ([remap scroll-up-command] . scroll-up-command-enhanced))
(init-message 3 "Functions: Emacs Functions: scroll-down-command-enhanced")
(defun scroll-down-command-enhanced (arg)
"Scroll down one page or ARG amount.
If less than a page away, jump to the beginning of the buffer."
(interactive "P")
(let ((col (current-column)))
(condition-case nil
(if arg
(scroll-down-command arg)
(scroll-down-command))
('error
(goto-char (point-min))))
(move-to-column col)))
(bind-keys* ([remap scroll-down-command] . scroll-down-command-enhanced))
(init-message 3 "Functions: Emacs Functions: downcase-region-enhanced")
(defun downcase-region-enhanced (&optional beg end)
"Convert region, or current line, to lower case."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (line-beginning-position))))
(end (or end (if (use-region-p) (region-end) (line-end-position)))))
(deactivate-mark)
(downcase-region beg end)))
(bind-keys* ("C-x C-l" . downcase-region-enhanced))
(init-message 3 "Functions: Emacs Functions: upcase-region-enhanced")
(defun upcase-region-enhanced (&optional beg end)
"Convert region, or current line, to upper case."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (line-beginning-position))))
(end (or end (if (use-region-p) (region-end) (line-end-position)))))
(deactivate-mark)
(upcase-region beg end)))
(bind-keys* ("C-x C-u" . upcase-region-enhanced))
(init-message 3 "Functions: Emacs Functions: downcase-word-enhanced")
(defun downcase-word-enhanced (arg)
"Convert word at point to lower case."
(interactive "*P")
(let ((p (point)))
(forward-word 1)
(when (> (point) p)
(forward-word -1)))
(downcase-word (or arg 1)))
(bind-keys* ([remap downcase-word] . downcase-word-enhanced))
(init-message 3 "Functions: Emacs Functions: upcase-word-enhanced")
(defun upcase-word-enhanced (arg)
"Convert word at point to upper case."
(interactive "*P")
(let ((p (point)))
(forward-word 1)
(when (> (point) p)
(forward-word -1)))
(upcase-word (or arg 1)))
(bind-keys* ([remap upcase-word] . upcase-word-enhanced))
(init-message 3 "Functions: Emacs Functions: capitalize-word-enhanced")
(defun capitalize-word-enhanced (arg)
"Capitalize word at point."
(interactive "*P")
(let ((syntax-table (copy-syntax-table (syntax-table))))
(modify-syntax-entry ?_ "." syntax-table)
(modify-syntax-entry ?- "." syntax-table)
(modify-syntax-entry ?' "w" syntax-table)
(with-syntax-table syntax-table
(let ((p (point)))
(forward-word 1)
(when (> (point) p)
(forward-word -1)))
(capitalize-word (or arg 1)))))
(bind-keys* ([remap capitalize-word] . capitalize-word-enhanced))
(init-message 3 "Functions: Emacs Functions: toggle-word-case")
(defun toggle-word-case (arg)
"Toggle between the following word states:
- lowercase
- capitalized
- uppercase"
(interactive "*P")
(save-mark-and-excursion
(let ((syntax-table (copy-syntax-table (syntax-table))))
(modify-syntax-entry ?_ "." syntax-table)
(modify-syntax-entry ?- "." syntax-table)
(modify-syntax-entry ?' "w" syntax-table)
(with-syntax-table syntax-table
(let ((p (point))
(arg (or arg 1)))
(forward-word 1)
(let ((w (point)))
(while (and (char-after)
(= (char-after) ?-))
(forward-word 1))
(let ((eow (point)))
(goto-char w)
(when (> (point) p)
(forward-word -1))
(let ((bow (point))
(word (buffer-substring-no-properties (point) eow)))
(goto-char bow)
(while (and (< (point) eow)
(or (= (point) bow)
(= (char-after) ?-)))
(cond
((s-lowercase-p word)
(capitalize-word-enhanced arg))
((s-uppercase-p word)
(downcase-word-enhanced arg))
(t
(upcase-word-enhanced arg))))))))))))
(bind-keys* ("M-c" . toggle-word-case))
(init-message 3 "Functions: Emacs Functions: eval-current-sexp")
(defun eval-current-sexp (eval-last-sexp-arg-internal)
"Evaluate current sexp; print value in minibuffer.
Interactively, with prefix argument, print output into current buffer.
Calls `eval-last-sexp' to handle eval."
(interactive "P")
(save-mark-and-excursion
(end-of-defun)
(eval-last-sexp eval-last-sexp-arg-internal)))
(init-message 3 "Functions: Emacs Functions: eval-sexp-buffer")
(defun eval-sexp-buffer (&optional buffer)
"Evaluate all sexp's in BUFFER.
BUFFER defaults to the current buffer."
(interactive)
(save-mark-and-excursion
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(let ((count 0))
(while (not (eobp))
(forward-sexp)
(eval-last-sexp nil)
(cl-incf count))
(message "Evaluated %d expressions." count))))
(init-message 3 "Functions: Emacs Functions: eval-and-replace-last-sexp")
(defun eval-and-replace-last-sexp ()
"Replace sexp before point with its evaluation."
(interactive "*")
(backward-kill-sexp)
(condition-case nil
(prin1 (eval (read (current-kill 0)))
(current-buffer))
('error
(message "Invalid expression")
(insert (current-kill 0)))))
(init-message 3 "Functions: Emacs Functions: eval-and-replace-current-sexp")
(defun eval-and-replace-current-sexp ()
"Replace current sexp with its evaluation."
(interactive "*")
(save-mark-and-excursion
(end-of-defun)
(eval-and-replace-last-sexp)))
(init-message 3 "Functions: Emacs Functions: macroexpand-and-replace")
(defun macroexpand-and-replace ()
"Replace sexp before point with its macroexpand."
(interactive "*")
(backward-kill-sexp)
(condition-case nil
(prin1 (macroexpand (read (current-kill 0)))
(current-buffer))
('error
(message "Invalid expression")
(insert (current-kill 0)))))
(init-message 3 "Functions: Emacs Functions: calc-eval-and-replace-region")
(defun calc-eval-and-replace-region (beg end)
"Evaluate region using `calc-eval' and replace it with the result."
(interactive "*r")
(let ((result (calc-eval (buffer-substring-no-properties beg end))))
(kill-region beg end)
(insert result)))
(init-message 3 "Functions: Emacs Functions: calc-eval-and-replace-line")
(defun calc-eval-and-replace-line ()
"Evaluate line using `calc-eval' and replace it with the result."
(interactive "*")
(calc-eval-and-replace-region (line-beginning-position) (line-end-position)))
(init-message 3 "Functions: Emacs Functions: indent-current-sexp")
(defun indent-current-sexp ()
"Indent current sexp."
(interactive "*")
(save-mark-and-excursion
(end-of-defun)
(let ((end (point)))
(beginning-of-defun)
(indent-sexp nil)
(while (< (point) end)
(goto-char (line-end-position))
(when (eq (get-text-property (point) 'face) 'font-lock-comment-face)
(comment-indent))
(forward-line 1)))))
(init-message 3 "Functions: Emacs Functions: indent-sexp-buffer")
(defun indent-sexp-buffer (&optional buffer)
"Indent all sexp's in BUFFER.
BUFFER defaults to the current buffer."
(interactive "*")
(save-mark-and-excursion
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(let ((count 0))
(while (not (eobp))
(forward-sexp 1)
(indent-current-sexp)
(cl-incf count))
(message "Indented %d expressions." count))))
(init-message 3 "Functions: Emacs Functions: comment-or-uncomment-sexp")
(defun uncomment-sexp (&optional n)
"Uncomment an sexp around point."
(interactive "P")
(let* ((initial-point (point-marker))
(point)
(end (save-mark-and-excursion
(save-match-data
(when (elt (syntax-ppss) 4)
(search-backward-regexp comment-start-skip
(line-beginning-position)
:noerror))
(setq point (point-marker))
(comment-forward (point-max))
(point-marker))))
(beg (save-mark-and-excursion
(save-match-data
(forward-line 0)
(while (= end (save-mark-and-excursion
(comment-forward (point-max))
(point)))
(forward-line -1))
(goto-char (line-end-position))
(search-backward-regexp comment-start-skip
(line-beginning-position)
:noerror)
(while (looking-at-p comment-start-skip)
(forward-char -1))
(point-marker)))))
(unless (= beg end)
(uncomment-region beg end)
(goto-char point)
(while (and (ignore-errors (backward-up-list) t)
(>= (point) beg))
(skip-chars-backward (rx (syntax expression-prefix)))
(setq point (point-marker)))
(ignore-errors
(comment-region beg point))
(goto-char point)
(forward-sexp (or n 1))
(skip-chars-forward "\r\n[:blank:]")
(if (< (point) end)
(ignore-errors
(comment-region (point) end))
(goto-char end)
(skip-chars-forward "\r\n[:blank:]")
(when (= 5 (car (syntax-after (point))))
(delete-indentation))))
(unless n
(goto-char initial-point))))
(defun comment-or-uncomment-sexp (&optional n)
"Comment the sexp at point and move past it.
If already inside (or before) a comment, uncomment instead.
With a prefix argument N, (un)comment that many sexps."
(interactive "P")
(if (or (elt (syntax-ppss) 4)
(< (save-mark-and-excursion
(skip-chars-forward "\r\n[:blank:]")
(point))
(save-mark-and-excursion
(comment-forward 1)
(point))))
(uncomment-sexp n)
(dotimes (_ (or n 1))
(pcase (or (bounds-of-thing-at-point 'sexp)
(save-mark-and-excursion
(skip-chars-forward "\r\n[:blank:]")
(bounds-of-thing-at-point 'sexp)))
(`(,l . ,r)
(goto-char r)
(skip-chars-forward "\r\n[:blank:]")
(comment-region l r)
(skip-chars-forward "\r\n[:blank:]"))))))
(init-message 3 "Functions: Emacs Functions: rename-buffer-and-file")
(defun rename-buffer-and-file (name &optional confirm)
"Rename current buffer and file to NAME."
(interactive
(list (if buffer-file-name
(read-file-name "Rename buffer to: " default-directory)
(user-error "Current buffer is not visiting a file"))
(not current-prefix-arg)))
(or (not name) (string= name "")
(let ((source-file buffer-file-name))
(unless source-file
(user-error "Current buffer is not visiting a file"))
(write-file name confirm)
(when (file-exists-p name)
(delete-file source-file)))))
(init-message 3 "Functions: Emacs Functions: move-buffer-and-file")
(defun move-buffer-and-file (dir &optional confirm)
"Move current buffer and file to DIR."
(interactive
(list (if buffer-file-name
(read-directory-name "Move to directory: " default-directory
(file-name-directory buffer-file-name))
(user-error "Current buffer is not visiting a file"))
(not current-prefix-arg)))
(let* ((source-file buffer-file-name)
(dir (if (or (string= dir "")
(not (string= (substring dir -1) "/")))
(concat dir "/")
dir))
(file (concat dir (file-name-nondirectory source-file))))
(if (not source-file)
(message "Buffer '%s' is not visiting a file" (buffer-name))
(progn
(unless (and confirm
(file-exists-p file)
(not (yes-or-no-p (format "File `%s' exists; overwrite? " file)))
(message "Canceled"))
(copy-file source-file file t)
(delete-file source-file)
(set-visited-file-name file)
(set-buffer-modified-p nil)
(vc-refresh-state))))))
(init-message 3 "Functions: Emacs Functions: delete-buffer-and-file")
(defun delete-buffer-and-file (&optional buffer)
"Delete BUFFER and file associated with it.
BUFFER defaults to the current buffer."
(interactive)
(let* ((buffer (or buffer (current-buffer)))
(file (buffer-file-name buffer)))
(if (not (and file (file-exists-p file)))
(if (fboundp 'ido-kill-buffer)
(ido-kill-buffer)
(kill-buffer))
(unless (and
(not (yes-or-no-p (format "Are you sure you want to delete '%s'? " file)))
(message "Canceled"))
(delete-file file)
(kill-buffer buffer)
(message "File '%s' successfully deleted" file)))))
(init-message 3 "Functions: Emacs Functions: expand-relative-file-name")
(defun expand-relative-file-name (name)
"Expand FILE-NAME found in current directory."
(file-truename (expand-file-name name (file-name-directory (or load-file-name buffer-file-name)))))
(init-message 3 "Functions: Emacs Functions: remove-trailing-blanks")
(defun remove-trailing-blanks (&optional ask)
(interactive "*")
"Remove trailing spaces and tabs from every line in the current buffer.
Also remove trailing newlines from the end of the buffer, apart
from one.
If ASK is non-nil, ask for confirmation."
(when (and (not (zerop (buffer-size)))
(char-equal (char-after (buffer-size)) ?\n)
(save-mark-and-excursion
(save-restriction
(save-match-data
(widen)
(goto-char (point-min))
(or (search-forward " \n" nil :noerror)
(search-forward "\t\n" nil :noerror)
(re-search-forward "\n\n$" nil :noerror)))))
(if ask
(yes-or-no-p "Remove trailing spaces and newlines before saving? ")
(message "Removing trailing spaces and newlines...")
t))
(save-mark-and-excursion
(save-restriction
(save-match-data
(widen)
(goto-char (point-min))
(while (re-search-forward "[ \t]+$" nil 'move)
(replace-match ""))
(when (bolp)
(skip-chars-backward "\n")
(delete-region (1+ (point)) (point-max)))))))
nil)
(defun remove-trailing-blanks-ask ()
(remove-trailing-blanks t))
(defun install-remove-trailing-blanks ()
(add-hook 'write-contents-functions #'remove-trailing-blanks))
(defun install-remove-trailing-blanks-ask ()
(add-hook 'write-contents-functions #'remove-trailing-blanks-ask))
(init-message 3 "Functions: Emacs Functions: remove-tabs")
(defun remove-tabs (&optional ask)
(interactive "*")
"Remove tabs from every line in the current buffer.
If ASK is non-nil, ask for confirmation.
If buffer is read-only quietly do nothing."
(unless buffer-read-only
(when (and (not (zerop (buffer-size)))
(char-equal (char-after (buffer-size)) ?\n)
(save-mark-and-excursion
(save-restriction
(save-match-data
(widen)
(goto-char (point-min))
(search-forward "\t" nil :noerror))))
(if ask
(yes-or-no-p "Remove tabs before saving? ")
(message "Removing tabs...")
t))
(save-mark-and-excursion
(save-restriction
(save-match-data
(goto-char (point-min))
(while (re-search-forward "[ \t]+$" nil :noerror)
(delete-region (match-beginning 0) (match-end 0)))
(goto-char (point-min))
(when (search-forward "\t" nil :noerror)
(untabify (1- (point)) (point-max))))))))
nil)
(defcustom remove-tabs-exceptions '((:file . "\.tsv\\'")
(:file . "\.gopher\\'")
(:file . "\\'.gopherus.bookmarks\\'")
(:file . "\\'Makefile\\'")
(:mode . 'make-mode))
"List of mode name and file name regexp patterns to exclude
from tab removal on file save."
:type 'list
:group 'files)
(defun remove-tabs-with-exceptions (&optional ask)
(let ((file (file-name-nondirectory buffer-file-name)))
(unless
(cl-remove-if (lambda (x)
(let ((type (car x))
(name (cdr x)))
(and
(not (and (eq type :mode)
(derived-mode-p name)))
(not (and (eq type :file)
(string-match name file))))))
remove-tabs-exceptions)
(remove-tabs ask))))
(defun remove-tabs-ask ()
(remove-tabs t))
(defun remove-tabs-with-exceptions-ask ()
(remove-tabs-with-exceptions t))
(defun install-remove-tabs ()
(add-hook 'write-contents-functions #'remove-tabs-with-exceptions))
(defun install-remove-tabs-ask ()
(add-hook 'write-contents-functions #'remove-tabs-with-exceptions-ask))
(add-hook 'write-contents-functions #'remove-tabs-with-exceptions)
(init-message 3 "Functions: Emacs Functions: indent-down")
(defun indent-down ()
"Indent current line via `lisp-indent-line' then go down one line via `next-line'."
(interactive "*")
(lisp-indent-line)
(forward-line 1))
(init-message 3 "Functions: Emacs Functions: server-start-maybe")
(defun server-start-maybe ()
"Safe way to start or restart an emacs server."
(unless (or window-system-windows
(and (fboundp 'server-runningp)
(server-running-p)))
(server-start :leave-dead)
(server-start)))
(init-message 3 "Functions: Emacs Functions: load-bookmarks")
(defun load-bookmarks (&optional file)
"Load bookmarks html FILE.
FILE defaults to `~/lynx_bookmarks.html'."
(interactive)
(let ((file (or file "~/lynx_bookmarks.html")))
(eww-open-in-new-buffer (file-truename (expand-file-name file)))))
(init-message 3 "Functions: Emacs Functions: find-file-updir")
(defun find-file-updir (name &optional directory)
"Return the absolute file name of NAME if it is found in the
current buffer's default directory or in any parent directory.
If DIRECTORY is non-nil, then it is used instead of the current
buffer's default directory."
(let ((name (file-truename (expand-file-name name directory))))
(while (and
(not (file-exists-p name))
(not (string= name (concat "/" (file-name-nondirectory name)))))
(setq name (file-truename (expand-file-name (concat
(file-name-directory name)
"../"
(file-name-nondirectory name))))))
(when (file-exists-p name) name)))
(init-message 3 "Functions: Emacs Functions: find-file-eof")
(defun find-file-eof (file)
"Run `find-file' with FILE, then move the point to the end of buffer."
(find-file file)
(goto-char (point-max)))
(init-message 3 "Functions: Emacs Functions: mark-full-word")
(defun mark-full-word (&optional arg allow-extend)
"Set mark ARG words away from start of word at point.
Point is moved to the beginning of the word at point, then
`mark-word' is called with the given arguments."
(interactive "P\np")
(beginning-of-thing 'word)
(mark-word arg allow-extend))
(init-message 3 "Functions: Emacs Functions: term-buffer")
(defun term-buffer ()
"Create or visit a persistent terminal buffer."
(interactive)
(let ((name "*ansi-term*"))
(if (not (get-buffer name))
(progn
(split-window-sensibly (selected-window))
(other-window 1)
(ansi-term (getenv "SHELL")))
(switch-to-buffer-other-window name))))
(init-message 3 "Functions: Emacs Functions: term-ansi")
(when (fboundp 'term-ansi-make-term)
(defun term-ansi (name cmd &rest switches)
"Run an application in an ansi-term window."
(let ((buffer (apply #'term-ansi-make-term
(generate-new-buffer-name (concat "*" name "*"))
cmd nil switches)))
(set-buffer buffer)
(when (fboundp 'term-mode) (term-mode))
(when (fboundp 'term-char-mode) (term-char-mode))
(when (fboundp 'term-set-escape-char) (term-set-escape-char ?\C-x))
(switch-to-buffer buffer))))
(init-message 3 "Functions: Emacs Functions: pop-up-shell")
(defun pop-up-shell (arg)
"Pop-up a shell in a side window passing ARG."
(interactive "P")
(select-window
(display-buffer-in-side-window
(save-window-excursion
(let ((prefix-arg arg))
(call-interactively #'shell))
(current-buffer))
'((side . bottom)))))
(init-message 3 "Functions: Emacs Functions: pop-up-shell-toggle")
(defun pop-up-shell-toggle (arg)
"Toggle visibility of `pop-up-shell'.
ARG is passed along if shell is being toggled on."
(interactive "P")
(let ((buffer-window (get-buffer-window "*shell*")))
(if buffer-window
(delete-window buffer-window)
(pop-up-shell arg))))
(init-message 3 "Functions: Emacs Functions: switch-to-scratch")
(defun switch-to-scratch ()
"Switch to `*scratch*' buffer, creating it if needed."
(interactive)
(switch-to-buffer "*scratch*"))
(init-message 3 "Functions: Emacs Functions: switch-to-scratch-for-current-mode")
(defun switch-to-scratch-for-current-mode ()
"Switch to `*scratch-MODE*' buffer, creating it if needed."
(interactive)
(let* ((mode major-mode)
(buffer (concat "*scratch-" (symbol-name mode) "*")))
(switch-to-buffer buffer)
(funcall mode)))
(init-message 3 "Functions: Emacs Functions: new-scratch")
(defun new-scratch ()
"Create a new scratch buffer."
(interactive)
(switch-to-buffer (generate-new-buffer-name "*scratch*")))
(init-message 3 "Functions: Emacs Functions: new-emacs-lisp-scratch")
(defun new-emacs-lisp-scratch (&optional use-existing)
"Create a new scratch buffer with `emacs-lisp-mode'.
If USE-EXISTING is non-nil, switch to an existing buffer if one
exists, otherwise create a new one."
(interactive)
(let ((buffer "*scratch-emacs-lisp*"))
(if (and use-existing (get-buffer buffer))
(switch-to-buffer buffer)
(switch-to-buffer (generate-new-buffer-name buffer))
(emacs-lisp-mode))))
(init-message 3 "Functions: Emacs Functions: new-org-scratch")
(defun new-org-scratch (&optional use-existing)
"Create a new scratch buffer with `org-mode'.
If USE-EXISTING is non-nil, switch to an existing buffer if one
exists, otherwise create a new one."
(interactive)
(let ((buffer "*scratch-org*"))
(if (and use-existing (get-buffer buffer))
(switch-to-buffer buffer)
(switch-to-buffer (generate-new-buffer-name buffer))
(org-mode))))
(init-message 3 "Functions: Emacs Functions: recreate-scratch-when-killed")
(defun recreate-scratch-when-killed ()
"Recreate scratch buffer, when it is killed.
Add the following to your init.el file for this to work:
\(add-hook 'kill-buffer-query-functions #'recreate-scratch-when-killed)"
(interactive)
(let ((buffer "*scratch*"))
(if (string= (buffer-name (current-buffer)) buffer)
(let ((kill-buffer-query-functions kill-buffer-query-functions))
(remove-hook 'kill-buffer-query-functions 'recreate-scratch-when-killed)
(kill-buffer (current-buffer))
(set-buffer (get-buffer-create buffer))
nil)
t)))
(add-hook 'kill-buffer-query-functions #'recreate-scratch-when-killed)
(init-message 3 "Functions: Emacs Functions: switch-to-messages")
(defun switch-to-messages ()
"Switch to `*Messages*' buffer, creating it if needed."
(interactive)
(switch-to-buffer "*Messages*"))
(init-message 3 "Functions: Emacs Functions: diff-current-buffer")
(defun diff-current-buffer ()
"Show a diff of the current buffer with its file contents."
(interactive)
(diff-buffer-with-file (current-buffer)))
(init-message 3 "Functions: Emacs Functions: get-char-property-here")
(defun get-char-property-here ()
"Get character property at current point."
(interactive)
(let (face)
(setq face (get-char-property (point) 'face))
(when (called-interactively-p 'any)
(message "%s" face))
face))
(init-message 3 "Functions: Emacs Functions: comments-in-buffer")
(defun comments-in-buffer (&optional beg end)
"Return a list of all the comments in the current buffer.
Optional START and END parameters will limit the search to a region."
(interactive)
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
comments)
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (comment-search-forward (point-max) t)
(push (buffer-substring-no-properties (point) (line-end-position)) comments))))
(nreverse comments))))
(init-message 3 "Functions: Emacs Functions: count-words")
(defun count-words (&optional beg end)
"Count the number of words in the selected region or entire buffer (if none)."
(interactive)
(let* ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(count (how-many "\\w+" beg end)))
(when (called-interactively-p 'any)
(message "%s" count))
count))
(init-message 3 "Functions: Emacs Functions: count-words-paragraph")
(defun count-words-paragraph ()
"Count the number of words in the current paragraph."
(interactive)
(save-mark-and-excursion
(let (end
(count 0))
(forward-paragraph 1)
(setq end (point))
(backward-paragraph 1)
(setq count (how-many "\\w+" (point) end))
(when (called-interactively-p 'any)
(message "%s" count))
count)))
(init-message 3 "Functions: Emacs Functions: count-lines-of-code")
(defun count-lines-of-code (&optional beg end)
"Count the number of code lines in the selected region or entire buffer (if none)."
(interactive)
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(count 0))
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (not (eobp))
(unless (comment-only-p (line-beginning-position) (line-end-position))
(cl-incf count))
(forward-line 1)))))
(when (called-interactively-p 'any)
(message "%s" count))
count))
(init-message 3 "Functions: Emacs Functions: date-offset")
(defun date-offset (&optional offset timezone format)
"Return current date/time plus OFFSET seconds.
OFFSET is the number of seconds to add to the current
time (defaults to 0).
TIMEZONE changes the timezone (defaults to local system setting).
FORMAT is a 'date' format string (defaults to
'+%Y-%m-%dT%H:%M:%SZ')."
(interactive)
(let* ((offset (or offset 0))
(format (or format (setq format "+%Y-%m-%dT%H:%M:%SZ")))
(date (replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string
(concat
(if timezone
(concat "TZ=" (shell-quote-argument timezone) " ")
"")
"date -d \"" (shell-quote-argument (number-to-string offset))
" sec\" " (shell-quote-argument format))))))
(when (called-interactively-p 'any)
(message "%s" date))
date))
(init-message 3 "Functions: Emacs Functions: memory-use-counts-pretty")
(defun memory-use-counts-pretty ()
"Pretty print version of `memory-use-counts'."
(interactive)
(let ((tags '(Conses Floats Vector-Cells Symbols String-Chars Miscs Intervals Strings))
(muc (memory-use-counts))
(str ""))
(dotimes (x (length tags))
(setq str (concat str (if (zerop (length str)) "" ", ")
(symbol-name (nth x tags)) ": " (number-to-string (nth x muc)))))
str))
(init-message 3 "Functions: Emacs Functions: git-paste-cleanup")
(defun git-paste-cleanup (beg end)
"Remove `+' characters from the start of lines in region."
(interactive "*r")
(save-mark-and-excursion
(goto-char beg)
(when (> (point) (line-beginning-position))
(forward-line 1)
(forward-line 0))
(while (< (point) end)
(when (looking-at "^+")
(delete-char 1))
(forward-line 1))))
(init-message 3 "Functions: Emacs Functions: execute-buffer")
(defun execute-buffer ()
"Execute or compile current file."
(interactive)
(let* ((file (shell-quote-argument buffer-file-name))
(file-type (substring (shell-command-to-string (concat "file " file)) 0 -1))
(type-map '(("Lisp" . "clisp")
("bash" . "bash")
("perl" . "perl")
("python" . "python")
("java" . "javac")
("kotlin" . "kotlinc")
("php" . "php")
(" c " . "gcc")))
cmd)
(delete-other-windows)
(cl-do ((type type-map (cdr type)))
((or (not type) cmd))
(when (cl-search (car type) file-type)
(setq cmd (cdr type))))
(shell-command (concat cmd " " file))))
(init-message 3 "Functions: Emacs Functions: file-in-exec-path")
(defun file-in-exec-path (name)
"Return non-nil if NAME is a file found in `exec-path'."
(catch 'done
(dolist (dir exec-path)
(when (file-exists-p (concat (file-name-as-directory dir) name))
(throw 'done t)))
nil))
(init-message 3 "Functions: Emacs Functions: unicode-shell")
(defun unicode-shell ()
"Execute the shell buffer in UTF-8 encoding.
Note that you need to set the environment variable LANG and
others appropriately."
(interactive)
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(coding-system-require-warning t))
(call-interactively 'shell)))
(init-message 3 "Functions: Emacs Functions: async-spinner")
(defmacro async-spinner (start-func &optional finish-func)
"Return `async-start' command for given params with a spinner."
(require 'async)
(require 'spinner)
(let ((spinner (spinner-start 'horizontal-moving))
(result (gensym)))
`(async-start
(lambda ()
(funcall ,start-func))
(lambda (,result)
(funcall ,spinner)
(funcall ,finish-func ,result)))))
(init-message 3 "Functions: Emacs Functions: with-time")
(defmacro with-time (&rest body)
"Return the time it takes (in seconds) to evaluate BODY."
(declare (indent 0))
`(let ((time (current-time)))
,@body
(float-time (time-since time))))
(init-message 3 "Functions: Emacs Functions: package-desc-summary-to-kill-ring")
(defun package-desc-summary-to-kill-ring ()
"When `thing-at-point' is a package library, return package
description summary and put it on the kill ring."
(interactive)
(let* ((name (thing-at-point 'symbol t))
(summary (package-desc-summary
(with-temp-buffer
(insert-file-contents-literally
(find-library-name name))
(package-buffer-info)))))
(kill-new summary)
(message "%s: %s" name summary)))
(init-message 3 "Functions: Emacs Functions: toggle-case-fold-search")
(defun toggle-case-fold-search ()
"Toggle search case sensitivity."
(interactive)
(setq case-fold-search (not case-fold-search))
(message "case-fold-search: %s" (if case-fold-search "ON" "OFF")))
(init-message 3 "Functions: Emacs Functions: derived-modes")
(defun derived-modes (&optional mode)
"Return a list of the ancestor modes that MODE is derived from.
MODE defaults to `major-mode'."
(let* ((mode (or mode major-mode))
(mode-list (list mode)))
(while (setq mode (get mode 'derived-mode-parent))
(push mode mode-list))
(nreverse mode-list)))
(init-message 3 "Functions: Emacs Functions: list-charset-unicode")
(defun list-charset-unicode ()
"Display a list of characters in character set `unicode-bmp'."
(interactive)
(list-charset-chars 'unicode-bmp))
(init-message 3 "Functions: Emacs Functions: url-refresh")
(defun url-refresh ()
"If cursor is on a URL, fetch it, following any redirects, then
update the URL to the new location."
(interactive)
(let ((url-regexp "https?:\/\/\\(www\.\\)?[-a-zA-Z0-9@:%._\+~#=]\\{1,256\\}\.[a-zA-Z0-9()]\\{1,6\\}\\b\\([-a-zA-Z0-9()@:%_\+.~#?&//=]*\\)"))
(save-mark-and-excursion
(forward-line 0)
(when (re-search-forward url-regexp (line-end-position))
(let* ((start (match-beginning 0))
(end (match-end 0))
(url (match-string-no-properties 0))
(new-url (shell-command-to-string
(join-strings (list
"curl" "--output" "/dev/null"
"--location"
"--silent"
"--write-out" "%{url_effective}"
url)
" "))))
(when (and (cl-plusp (length new-url))
(not (string= url new-url)))
(delete-region start end)
(goto-char start)
(insert new-url)))))))
(init-message 4 "Functions: Emacs Functions: url-test: url-test")
(defun url-test (&optional buffer)
"Display a report of testing all URLs in BUFFER.
If BUFFER is nil, use `current-buffer'."
(interactive)
(let ((max-threads 30)
(connect-timeout 30)
(url-regexp "https?:\/\/\\(www\.\\)?[-a-zA-Z0-9@:%._\+~#=]\\{1,256\\}\.[a-zA-Z0-9()]\\{1,6\\}\\b\\([-a-zA-Z0-9()@:%_\+.~#?&//=]*\\)")
(output-buffer (get-buffer-create "*Test URLs*"))
(filename (buffer-file-name (or buffer (current-buffer))))
bundles
failures
processes
(count 1))
(save-mark-and-excursion
(when buffer
(set-buffer buffer))
(goto-char (point-min))
(while (re-search-forward url-regexp nil :noerror)
(push (list (match-string-no-properties 0)
(line-number-at-pos (match-beginning 0)))
bundles)))
(setq bundles (nreverse bundles))
(switch-to-buffer-other-window output-buffer)
(buffer-disable-undo output-buffer)
(while (or bundles processes)
(while (and bundles (< (length processes) max-threads))
(let* ((bundle (append (pop bundles) (list count (current-time))))
(url (car bundle))
(name (format "url-test-%d" count))
(buffer (concat "*" name "*")))
(cl-incf count)
(push (list
bundle
(start-process
name
buffer
"curl" "--output" "/dev/null"
"--silent"
"--write-out" "%{http_code}\n"
"--connect-timeout" (number-to-string connect-timeout)
"--max-time" (number-to-string connect-timeout)
url))
processes)))
(set-buffer output-buffer)
(setq buffer-read-only nil)
(erase-buffer)
(insert "URL Testing Status")
(newline)
(newline)
(insert "URL Time")
(newline)
(insert "-------------------------------------------------------------------- ---------")
(newline)
(dolist (x (reverse processes))
(let* ((url (caar x))
(process (cadr x))
(status (process-status process))
(time (cadddr (car x)))
(time-diff (time-subtract (current-time) time))
(microsecs (caddr time-diff))
(secs (+ (* (car time-diff) 65536) (cadr time-diff))))
(when (> (length url) 68)
(setq url (substring url 0 68)))
(insert (format "%-68s %2d.%d" url secs microsecs))
(newline)))
(goto-char (point-min))
(setq buffer-read-only t)
(setq processes
(cl-remove-if
(lambda (x)
(let* ((process (cadr x))
(status (process-status process))
(time (cadddr (car x)))
(time-diff (time-subtract (current-time) time))
(secs (+ (* (car time-diff) 65536) (cadr time-diff))))
(unless (and (eq status 'run) (< secs connect-timeout))
(let* ((buffer (process-buffer process))
(code (progn
(set-buffer buffer)
(goto-char (point-min))
(string-to-number
(buffer-substring-no-properties (line-beginning-position) (line-end-position))))))
(when (not (= code 200))
(push (append (reverse (cdr (reverse (car x))))
(list code)) failures))
(delete-process process)
(kill-buffer buffer))
t)))
processes))
(sit-for 0.1))
(switch-to-buffer output-buffer)
(setq buffer-read-only nil)
(erase-buffer)
(insert "URL Testing Results")
(newline)
(newline)
(insert (format "Number of URLs checked: %d" count))
(newline)
(insert (format "Number of failed URLs: %d" (length failures)))
(newline)
(newline)
(insert "Code URL")
(newline)
(insert "---- --------------------------------------------------------------------")
(newline)
(dolist (x (sort failures #'(lambda (a b) (< (caddr a) (caddr b)))))
(let ((url (car x))
(pos (cadr x))
(code (cadddr x)))
(insert (format "\[\[file:%s::%d\]\[%-4d %s\]\]" filename pos code url))
(newline)))
(goto-char (point-min))
(org-mode)
(setq buffer-read-only t)))
(init-message 2 "Functions: Emacs Grouped Functions")
(init-message 3 "Functions: Emacs Grouped Functions: Buffer Kill")
(init-message 4 "Functions: Emacs Grouped Functions: Buffer Kill: kill-buffer-query-functions-maybe-bury")
(defconst bury-buffer-names '("*Messages*"))
(defun kill-buffer-query-functions-maybe-bury ()
"Bury certain buffers instead of killing them.
Return nil if buffer should be buried instead of killed.
Used as a `kill-buffer-query-functions' hook."
(if (member (buffer-name (current-buffer)) bury-buffer-names)
(progn
(kill-region (point-min) (point-max))
(bury-buffer)
nil)
t))
(add-hook 'kill-buffer-query-functions #'kill-buffer-query-functions-maybe-bury)
(init-message 4 "Functions: Emacs Grouped Functions: Buffer Kill: kill-other-window-buffer")
(defun kill-other-window-buffer (&optional delete-window)
"Kill buffer in other window, prompting user to select a window
if there are more than two.
When DELETE-WINDOW is non-nil, also delete the window."
(interactive)
(let ((orig-window (selected-window)))
(cond
((and (fboundp 'switch-window)
(> (length (window-list)) 1))
(switch-window)
(kill-buffer (current-buffer))
(when delete-window
(delete-window))
(select-window orig-window))
((= (length (window-list)) 2)
(other-window 1)
(kill-buffer (current-buffer))
(when delete-window
(delete-window))
(select-window orig-window))
(t
(message "No other window to kill")))))
(init-message 4 "Functions: Emacs Grouped Functions: Buffer Kill: kill-other-window-buffer-and-delete-window")
(defun kill-other-window-buffer-and-delete-window ()
"Kill buffer in other window, prompting user to select a window
if there are more than two. Then delete that window."
(interactive)
(kill-other-window-buffer t))
(init-message 3 "Functions: Emacs Grouped Functions: Clipboard")
(when (and (not window-system)
(executable-find "xsel"))
(init-message 4 "xclipboard-kill-region")
(defun xclipboard-kill-region (beg end)
"Kill the region, and save it in the X clipboard."
(interactive "*r")
(async-shell-command
(concat "echo "
(shell-quote-argument (buffer-substring-no-properties beg end))
" | xsel -i"))
(kill-region beg end))
(init-message 4 "xclipboard-kill-ring-save")
(defun xclipboard-kill-ring-save (beg end)
"Copy region to kill ring, and save in the X clipboard."
(interactive "r")
(async-shell-command
(concat "echo "
(shell-quote-argument (buffer-substring-no-properties beg end))
" | xsel -i"))
(kill-ring-save beg end))
(init-message 4 "xclipboard-yank")
(defun xclipboard-yank ()
"Insert the clipboard contents, or the last stretch of killed text."
(interactive "*")
(insert (shell-command-to-string "xsel -o"))))
(init-message 3 "Functions: Emacs Grouped Functions: Occur")
(init-message 4 "Functions: Emacs Grouped Functions: Occur: occur-inverse")
(defun occur-inverse (regexp)
"Show all lines in the current buffer not containing a match for REGEXP.
If a non-match spreads across multiple lines, all those lines are shown.
Otherwise, behaves the same as `occur'."
(interactive "sRegexp: ")
(let ((filtered
(mapconcat
(lambda (line)
(if (string-match-p regexp line)
""
line))
(split-string
(buffer-substring-no-properties (point-min) (point-max)) "\n")
"\n")))
(with-temp-buffer
(insert filtered)
(occur ".+"))))
(init-message 2 "Functions: Text Conversion Functions")
(init-message 3 "Functions: Text Conversion Functions: set-coding-system")
(defun set-coding-system (coding-system)
"Change buffer file coding system to CODING-SYSTEM.
CODING-SYSTEM could be:
'unix
'dos
'mac
Or any coding system returned by `list-coding-systems'."
(interactive)
(set-buffer-file-coding-system coding-system :force))
(init-message 3 "Functions: Text Conversion Functions: escape-xml")
(defun escape-xml (string)
"Escape XML in STRING."
(setq string (replace-regexp-in-string "&" "&" string))
(setq string (replace-regexp-in-string "'" "'" string))
(setq string (replace-regexp-in-string ">" ">" string))
(setq string (replace-regexp-in-string "<" "<" string))
(setq string (replace-regexp-in-string "\"" """ string))
string)
(init-message 3 "Functions: Text Conversion Functions: unescape-xml")
(defun unescape-xml (string)
"Unescape XML in STRING."
(setq string (replace-regexp-in-string "'" "'" string))
(setq string (replace-regexp-in-string ">" ">" string))
(setq string (replace-regexp-in-string "<" "<" string))
(setq string (replace-regexp-in-string """ "\"" string))
(setq string (replace-regexp-in-string "&" "&" string))
string)
(init-message 3 "Functions: Text Conversion Functions: titleize")
(defun titleize (string &optional cmos do-not-cap-ends)
"Capitalize STRING according to titling conventions.
If a word should be capitalized, `capitalize-word' is called,
otherwise `downcase-word' is called.
If CMOS is non-nil, adhere to the Chicago Manual of Style.
If DO-NOT-CAP-ENDS is non-nil, the first and last words will not
be automatically capitalized."
(interactive "*")
(let ((case-fold-search nil) (words-short
'( "a" "an" "and" "as" "at" "be" "but" "by" "for" "from" "in" "into"
"is" "it" "it's" "nor" "o'" "on" "or" "of" "onto" "per" "so" "the"
"that" "to" "yet" "upon" "vs" "via" "with"
"a" "al" "an" "asi" "como" "con" "de" "el" "en" "es" "esa" "ese"
"la" "las" "lo" "los" "ni" "o" "para" "pero" "por" "que" "ser"
"sobre" "todavia" "u" "vs" "via" "y"))
(words-single
'( "and" "as" "be" "into" "is" "it" "it's" "nor" "or" "so" "the" "that" "yet"
"a" "abaft" "aboard" "about" "above" "absent" "across" "afore"
"after" "against" "along" "alongside" "amid" "amidst" "among"
"amongst" "an" "anenst" "apropos" "apud" "around" "as" "aside"
"astride" "at" "athwart" "atop" "barring" "before" "behind" "below"
"beneath" "beside" "besides" "between" "beyond" "but" "by" "circa"
"concerning" "despite" "down" "during" "except" "excluding"
"failing" "following" "for" "forenenst" "from" "given" "in"
"including" "inside" "into" "like" "mid" "midst" "minus" "modulo"
"near" "next" "notwithstanding" "o'" "of" "off" "on" "onto"
"opposite" "out" "outside" "over" "pace" "past" "per" "plus" "pro"
"qua" "regarding" "round" "sans" "save" "since" "than" "through"
"thru" "throughout" "thruout" "till" "times" "to" "toward" "towards"
"under" "underneath" "unlike" "until" "unto" "up" "upon" "versus"
"vs" "via" "vice" "vis-à-vis" "vis-a-vis" "whereas" "with" "within"
"without" "worth"))
(words-double
'( "according to" "ahead of" "apart from" "as for" "as of" "as per"
"as regards" "aside from" "back to" "because of" "close to"
"due to" "except for" "far from" "in to" "inside of" "instead of"
"left of" "near to" "next to" "on to" "out from" "out of"
"outside of" "owing to" "prior to" "pursuant to" "rather than"
"regardless of" "right of" "subsequent to" "such as" "thanks to"
"that of" "up to"))
(words-triple
'( "as far as" "as long as" "as opposed to" "as well as" "as soon as"
"at the behest of" "by means of" "by virtue of" "for the sake of"
"in accordance with" "in addition to" "in case of" "in front of"
"in lieu of" "in order to" "in place of" "in point of"
"in spite of" "on account of" "on behalf of" "on top of"
"with regard to" "with respect to" "with a view to")))
(let ((words-short-regexp (regexp-opt (mapcar #'capitalize words-short) 'words))
(words-single-regexp (regexp-opt (mapcar #'capitalize words-single) 'words))
(words-double-regexp (regexp-opt (mapcar #'capitalize words-double) 'words))
(words-triple-regexp (regexp-opt (mapcar #'capitalize words-triple) 'words))
(abbreviation-word-regexp (rx word-boundary
(any digit upper)
(one-or-more (any "." digit upper))
(zero-or-more (not space))
word-boundary))
(mixed-word-regexp (rx word-boundary
(zero-or-more upper)
(zero-or-more digit)
(one-or-more lower)
(zero-or-more digit)
(one-or-more upper)
(zero-or-more (not space))
word-boundary))
(file-extension-word-regexp (rx "."
(one-or-more (not space))
eos))
(first-word-regexp (rx (or (seq bos
(zero-or-more (not space))
(group (one-or-more word)))
(seq (seq (or "." "!" "?" ":" ";" "\"" "&" "*" "(" ")" "[" "]" "/")
(zero-or-more space))
(group (one-or-more word)))
(seq (one-or-more space)
"-"
(one-or-more space)
(group (one-or-more word))))))
(last-word-regexp (rx (or (seq (group (one-or-more word))
(zero-or-more space)
eos)
(seq (group (one-or-more word))
(zero-or-more space)
(or "." "!" "?" ":" ";" "&" "*" "(" ")" "[" "]" "/"))
(seq (group (one-or-more word))
(one-or-more space)
"-"
(one-or-more space))))))
(cl-labels
((get-fixed (string regexp)
(let ((case-fold-search nil)
(pos 0)
fixed)
(while (string-match regexp string pos)
(push (list (match-beginning 0)
(match-end 0)
(match-string 0 string))
fixed)
(setq pos (match-end 0)))
(nreverse fixed)))
(set-fixed (string fixed)
(let ((string string))
(dolist (a fixed)
(setq string
(concat (substring string 0 (car a))
(caddr a)
(substring string (cadr a)))))
string))
(cap (string)
(if cmos
(replace-regexp-in-string
words-single-regexp 'downcase
(replace-regexp-in-string
words-double-regexp 'downcase
(replace-regexp-in-string
words-triple-regexp 'downcase
(capitalize string) t t) t t) t t)
(replace-regexp-in-string
words-short-regexp 'downcase
(capitalize string) t t))))
(let* ((extension (get-fixed string file-extension-word-regexp))
(string (if extension
(substring string 0 (caar extension))
string))
(fixed (append (get-fixed string abbreviation-word-regexp)
(get-fixed string mixed-word-regexp))))
(concat
(if do-not-cap-ends
(set-fixed (cap string) fixed)
(set-fixed
(replace-regexp-in-string
first-word-regexp 'capitalize
(replace-regexp-in-string
last-word-regexp 'capitalize
(cap string) t t) t t) fixed))
(if extension
(caddar extension)
"")))))))
(init-message 3 "Functions: Text Conversion Functions: titleize-word-enhanced")
(defun titleize-word-enhanced (arg)
"Titleize word at point."
(interactive "*p")
(let ((syntax-table (copy-syntax-table (syntax-table))))
(modify-syntax-entry ?_ "." syntax-table)
(modify-syntax-entry ?- "." syntax-table)
(modify-syntax-entry ?' "w" syntax-table)
(with-syntax-table syntax-table
(dotimes (_ (or arg 1))
(let ((p (point)))
(forward-word 1)
(forward-word -1)
(when (< (point) p)
(forward-word 1)))
(let ((bounds (bounds-of-thing-at-point 'word)))
(when bounds
(goto-char (car bounds)))
(when (re-search-forward "\\(\\w+\\)" nil :noerror)
(replace-match (titleize (match-string 0) nil :do-not-cap-ends) t)))))))
(init-message 3 "Functions: Text Conversion Functions: titleize-line-or-region")
(defun titleize-line-or-region (&optional beg end)
"Capitalize the current line or selected region according to
titling conventions.
If a word should be capitalized, `capitalize-word' is called,
otherwise `downcase-word' is called."
(interactive "*")
(let ((pos (point)))
(save-match-data
(let* ((beg (or beg (cond
((use-region-p)
(region-beginning))
((eq major-mode 'wdired-mode)
(point))
(t
(beginning-of-line-text) (point)))))
(end (or end (cond
((use-region-p)
(region-end))
(t
(line-end-position)))))
(col (- pos beg)))
(deactivate-mark)
(save-restriction
(narrow-to-region beg end)
(goto-char (point-min))
(let ((syntax-table (copy-syntax-table (syntax-table)))
(str (buffer-substring-no-properties beg end)))
(modify-syntax-entry ?_ "." syntax-table)
(modify-syntax-entry ?- "." syntax-table)
(modify-syntax-entry ?' "w" syntax-table)
(with-syntax-table syntax-table
(delete-region beg end)
(goto-char beg)
(insert (titleize str))
(goto-char (+ beg col)))))))
(goto-char pos)))
(init-message 3 "Functions: Text Conversion Functions: unfill-paragraph")
(defun unfill-paragraph ()
"Convert a multi-line paragraph into a single line of text."
(interactive)
(let ((fill-column (point-max)))
(fill-paragraph nil)))
(init-message 3 "Functions: Text Conversion Functions: single-space-punctuation")
(defun single-space-punctuation (&optional beg end)
"Single-space sentence ending punctuation in the current
paragraph or selected region."
(interactive "*")
(let ((beg (or beg (and (use-region-p) (region-beginning))))
(end (or end (and (use-region-p) (region-end)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(unless (and beg end)
(mark-paragraph)
(setq beg (point)
end (mark-marker)))
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "\\([^[:blank:]][.?!]['\"”)]?\\)[[:blank:]]\\([^[:blank:]]\\)" end :noerror)
(replace-match "\\1 \\2")))))))
(init-message 3 "Functions: Text Conversion Functions: double-space-punctuation")
(defun double-space-punctuation (&optional beg end)
"Double-space sentence ending punctuation in the current
paragraph or selected region."
(interactive "*")
(let ((beg (or beg (and (use-region-p) (region-beginning))))
(end (or end (and (use-region-p) (region-end)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(unless (and beg end)
(mark-paragraph)
(setq beg (point)
end (mark-marker)))
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "\\([^[:blank:]][.?!]['\"”)]?\\)[[:blank:]]\\([^[:blank:]]\\)" end :noerror)
(replace-match "\\1 \\2")))))))
(init-message 3 "Functions: Text Conversion Functions: convert-unicode-characters")
(defun convert-unicode-characters (&optional beg end)
"Convert common unicode characters of document or selected region."
(interactive "*")
(let ((beg (or beg (and (use-region-p) (region-beginning)) (point-min)))
(end (or end (and (use-region-p) (region-end)) (point-max))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(dolist (x '(("✴" . "•")
("…" . "...")
("–" . "--")
("—" . "---")
("‘" . "'")
("’" . "'")
("“" . "\"")
("”" . "\"")
("Æ" . "ae")
("fi" . "fi")
("fl" . "fl")
("ç" . "c")
))
(goto-char (point-min))
(while (re-search-forward (car x) end :noerror)
(replace-match (cdr x)))))))))
(init-message 3 "Functions: Text Conversion Functions: parse-csv")
(defun parse-csv (data)
"Parse DATA as a block of comma-separated values.
Return a list (one per row) of lists (one element per value).
Example input:
1,2,\"3\n4\",5,6
Example output:
((\"1\" \"2\" \"3\n4\" \"5\" \"6\")))))"
(cl-labels
((parse (data quote field line block)
(if (not data)
(if field
(parse data quote nil (cons (concat (nreverse field)) line) block)
(if line
(parse (cdr data) quote nil nil (cons (nreverse line) block))
(nreverse block)))
(let ((c (car data)))
(cl-case c
((?\n)
(if quote
(parse (cdr data) quote (push c field) line block)
(if field
(parse data quote nil (cons (concat (nreverse field)) line) block)
(parse (cdr data) quote nil nil (cons (nreverse line) block)))))
((?\,)
(if quote
(parse (cdr data) quote (push c field) line block)
(parse (cdr data) quote nil (cons (concat (nreverse field)) line) block)))
((?\")
(parse (cdr data) (not quote) field line block))
((?\\)
(parse (cddr data) quote (push (caar data) field) line block))
(t
(parse (cdr data) quote (push c field) line block)))))))
(parse (append data nil) nil nil nil nil)))
(init-message 2 "Functions: Text Inserting Functions")
(init-message 3 "Functions: Text Inserting Functions: insert-timestamp")
(defun insert-timestamp (&optional pos)
"Insert a timestamp at point or POS."
(interactive "*")
(if pos
(save-mark-and-excursion
(goto-char pos)
(insert (format-time-string "%Y-%m-%d %H:%M:%S")))
(insert (format-time-string "%Y-%m-%d %H:%M:%S"))))
(init-message 3 "Functions: Text Inserting Functions: insert-path")
(defun insert-path (path)
"Insert path."
(interactive "*FPath: ")
(insert (expand-file-name path)))
(init-message 3 "Functions: Text Inserting Functions: uuid")
(defmacro uuid ()
"Return a UUID.
Example: 5ac55464-24e6-419c-99cf-5e1682bb3819"
(cond
((executable-find "uuid")
`(replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string "uuid")))
((executable-find "uuidgen")
`(replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string "uuidgen")))
((executable-find "mcookie")
`(let ((uuid (replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string "mcookie"))))
(concat (substring uuid 0 8)
"-" (substring uuid 8 12)
"-" (substring uuid 12 16)
"-" (substring uuid 16 20)
"-" (substring uuid 20 32))))
(t
`(user-error "Could not find a suitable system command to produce a UUID"))))
(defalias 'guid 'uuid)
(init-message 3 "Functions: Text Inserting Functions: insert-uuid")
(defun insert-uuid ()
"Insert a UUID at point.
Example: 5ac55464-24e6-419c-99cf-5e1682bb3819"
(interactive "*")
(insert (uuid)))
(defalias 'insert-guid 'insert-uuid)
(init-message 3 "Functions: Text Inserting Functions: uuid-decimal")
(defun uuid-decimal ()
"Return a UUID as a 128-bit decimal number.
Example: 206479166935211742515584900341856848185"
(string-to-number (replace-regexp-in-string "-" "" (uuid)) 16))
(defalias 'guid-decimal 'uuid-decimal)
(init-message 3 "Functions: Text Inserting Functions: uuid-string")
(defun uuid-string ()
"Return a UUID as a 21 character ASCII string.
Example: 23MNvqBpz7dP53kZVeGmvR"
(cl-labels
( (n-to-s (num)
(cond
((< num 10)
(byte-to-string (+ num 48))) ((< num 36)
(byte-to-string (+ num 55))) ((< num 62)
(byte-to-string (+ num 61))) ((< num 63)
(byte-to-string 43)) ((< num 64)
(byte-to-string 45))))) (cl-do* ((n 0 (mod u 64))
(s "" (concat (n-to-s n) s))
(u (uuid-decimal) (/ u 64)))
((= u 0) s))))
(defalias 'guid-decimal 'uuid-string)
(init-message 3 "Functions: Text Inserting Functions: uuid-xml")
(defmacro uuid-xml ()
"Return a Java UUID serialized for XML.
Example:
<java.util.UUID>
<default>
<leastSigBits>-8689645201391190588</leastSigBits>
<mostSigBits>-4837091181110474279</mostSigBits>
</default>
</java.util.UUID>"
(let ((cmd "uuid-xml"))
(if (executable-find cmd)
`(shell-command-to-string (concat ,cmd " | tail -n +2"))
`(user-error "Could not find system command: %s" ,cmd))))
(init-message 3 "Functions: Text Inserting Functions: insert-uuid-xml")
(defun insert-uuid-xml ()
"Insert a Java UUID serialized for XML at point.
Example:
<java.util.UUID>
<default>
<leastSigBits>-8689645201391190588</leastSigBits>
<mostSigBits>-4837091181110474279</mostSigBits>
</default>
</java.util.UUID>"
(interactive "*")
(insert (uuid-xml)))
(init-message 3 "Functions: Text Inserting Functions: insert-incrementing-vertical-numbers")
(defun insert-incrementing-vertical-numbers (bound1 &optional bound2 repeat)
"Insert incrementing numbers vertically in the current column.
If BOUND2 is nil, number from 1 to BOUND1, inclusive.
If BOUND2 is non-nil, number from BOUND1 to BOUND2, inclusive.
If REPEAT is non-nil, repeat each number that many times."
(interactive "*nMaximum number: ")
(let ((start (if bound2 bound1 1))
(end (if bound2 bound2 bound1))
(repeat (or repeat 1))
(col (- (point) (line-beginning-position))))
(cl-do ((x start (1+ x)))
((> x end))
(cl-do ((y 1 (1+ y)))
((> y repeat))
(insert (number-to-string x))
(when (or (< x end) (< y repeat))
(or (zerop (forward-line 1))
(progn
(goto-char (line-end-position))
(newline)))
(let ((pos (+ (line-beginning-position) col)))
(while (< (point) pos)
(if (eobp)
(insert " ")
(forward-char 1)))))))))
(init-message 3 "Functions: Text Inserting Functions: insert-column-position-ruler")
(defun insert-column-position-ruler (&optional tens)
"Insert a column poisition ruler.
If TENS is non-nil, insert that many ruler segments of ten digits.
TENS defaults to 12."
(interactive "*")
(let ((tens (or tens 12)))
(dotimes (_ tens)
(insert "1234567890"))))
(init-message 3 "Functions: Text Inserting Functions: append-char-to-column")
(defun append-char-to-column (char col)
"Append character CHAR up to column COL and delete any past that point."
(save-mark-and-excursion
(goto-char (line-end-position))
(while (< (- (point) (line-beginning-position)) col)
(insert char))
(goto-char (+ (line-beginning-position) col))
(while (and
(char-after)
(char-equal (char-after) (string-to-char char)))
(delete-char 1))))
(init-message 3 "Functions: Text Inserting Functions: append-equal-to-column-80")
(defun append-equal-to-column-80 ()
"Insert equal characters up to column 80."
(interactive "*")
(append-char-to-column "=" 80))
(init-message 3 "Functions: Text Inserting Functions: append-dash-to-column-80")
(defun append-dash-to-column-80 ()
"Insert dash characters up to column 80."
(interactive "*")
(append-char-to-column "-" 80))
(init-message 3 "Functions: Text Inserting Functions: append-asterisk-to-column-80")
(defun append-asterisk-to-column-80 ()
"Insert asterisk characters up to column 80."
(interactive "*")
(append-char-to-column "*" 80))
(init-message 3 "Functions: Text Inserting Functions: insert-lisp-comment-block-equal")
(defun insert-lisp-comment-block-equal ()
"Insert lisp comment block (equal)."
(interactive "*")
(indent-according-to-mode)
(insert ";;")
(append-equal-to-column-80)
(end-of-line)
(newline-and-indent)
(insert ";;")
(newline-and-indent)
(insert ";;")
(append-equal-to-column-80)
(end-of-line)
(newline)
(forward-line -2)
(end-of-line)
(insert " "))
(init-message 3 "Functions: Text Inserting Functions: insert-lisp-comment-block-dash")
(defun insert-lisp-comment-block-dash ()
"Insert lisp comment block (dash)."
(interactive "*")
(indent-according-to-mode)
(insert ";;")
(append-dash-to-column-80)
(end-of-line)
(newline-and-indent)
(insert ";;")
(newline-and-indent)
(insert ";;")
(append-dash-to-column-80)
(end-of-line)
(newline)
(forward-line -2)
(end-of-line)
(insert " "))
(init-message 3 "Functions: Text Inserting Functions: insert-center-lisp-comment")
(defun insert-center-lisp-comment ()
"Insert center lisp comment (in comment block)."
(interactive "*")
(save-mark-and-excursion
(save-match-data
(forward-line 0)
(while (looking-at " +") (forward-char 1))
(while (looking-at ";+") (forward-char 1))
(let ((start (point)))
(forward-line -1)
(let ((len (- (line-end-position) (line-beginning-position)))
(spacer (char-before (line-end-position))))
(forward-line 1)
(while (search-forward (char-to-string spacer) (line-end-position) :noerror)
(replace-match ""))
(goto-char start)
(while (looking-at " ")
(delete-char 1 t))
(goto-char (line-end-position))
(while (eq (char-before (point)) ? )
(delete-char -1 t))
(let ((spacers (- (floor (/ (- len (- (point) start)) 2)) 4)))
(goto-char start)
(insert " " (make-string spacers spacer) " ")
(goto-char (line-end-position))
(insert " ")
(insert (make-string (- len (- (point) (line-beginning-position))) ?=))))))))
(init-message 3 "Functions: Text Inserting Functions: insert-c-comment-block")
(defun insert-c-comment-block ()
"Insert c/c++/java comment block."
(interactive "*")
(indent-according-to-mode)
(insert "/")
(append-asterisk-to-column-80)
(end-of-line)
(newline-and-indent)
(insert "*")
(indent-according-to-mode)
(newline-and-indent)
(insert "*")
(indent-according-to-mode)
(append-asterisk-to-column-80)
(end-of-line)
(delete-char -1)
(insert "/")
(newline)
(forward-line -2)
(end-of-line)
(insert " "))
(init-message 3 "Functions: Text Inserting Functions: insert-c-comment-stub")
(defun insert-c-comment-stub ()
"Insert c/c++/java comment stub."
(interactive "*")
(end-of-line)
(indent-according-to-mode)
(insert "/**")
(newline-and-indent)
(insert "*")
(indent-according-to-mode)
(newline-and-indent)
(insert "*/")
(indent-according-to-mode)
(newline)
(forward-line -2)
(end-of-line)
(insert " "))
(init-message 3 "Functions: Text Inserting Functions: insert-db-change-log-template-line")
(defun insert-db-change-log-template-line ()
"Insert Everest DB Change Log template line at point."
(interactive "*")
(insert (format-time-string "%m/%d" (current-time)))
(insert " | | | E_ | .D.Q.S.T.P. | yes")
(newline)
(forward-line -1)
(forward-char 8))
(init-message 3 "Functions: Text Inserting Functions: insert-db-change-log-template-line-legacy")
(defun insert-db-change-log-template-line-legacy ()
"Insert Legacy DB Change Log template line at point."
(interactive "*")
(insert (format-time-string "%m/%d" (current-time)))
(insert " | | | AwardCafe_Client | .D.S.P. | yes")
(newline)
(forward-line -1)
(forward-char 8))
(init-message 3 "Functions: Text Inserting Functions: insert-xml-header")
(defun insert-xml-header ()
"Insert standard XML header.
Specifically: <?xml version=\"1.0\" encoding=\"utf-8\"?>"
(interactive "*")
(insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>"))
(init-message 3 "Functions: Text Inserting Functions: insert-lexical-binding")
(defun insert-lexical-binding ()
"Insert file local variable `lexical-binding' in the first line
of the current buffer."
(interactive "*")
(save-mark-and-excursion
(goto-char (point-min))
(if (looking-at ";; -\\*-.*-\\*-")
(unless (looking-at ";; -\\*-.*lexical-binding:.*-\\*-")
(goto-char (line-end-position))
(forward-char -4)
(when (looking-at " -\\*-")
(forward-char -1)
(if (looking-at ";")
(forward-char 1)
(progn
(forward-char 1)
(insert ";")))
(insert " lexical-binding: t;")))
(insert ";; -*- lexical-binding: t; -*-\n;;\n"))))
(init-message 3 "Functions: Text Inserting Functions: insert-figlet")
(defun insert-figlet (text)
"Insert figlet version of TEXT, if figlet is installed."
(interactive "*sText: ")
(let ((figlet "figlet"))
(unless (executable-find figlet)
(user-error "Could not find system command: %s" figlet))
(insert (shell-command-to-string (concat figlet " " text)))))
(init-message 3 "Functions: Text Inserting Functions: insert-password")
(defun insert-password-20 ()
"Call `password-to-clipboard' with a LENGTH of 20 and insert the
result."
(interactive "*")
(insert (password-to-clipboard 20)))
(init-message 3 "Functions: Text Inserting Functions: insert-password-phrase")
(defun insert-password-phrase-3-space ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'space, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 3 'space)))
(defun insert-password-phrase-6-space ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'space, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 6 'space)))
(defun insert-password-phrase-3-hyphen ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'hyphen, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 3 'hyphen)))
(defun insert-password-phrase-3-hyphen-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 3 and a TYPE
of 'hyphen with capitalized words, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 3 'hyphen :capitalize)))
(defun insert-password-phrase-6-hyphen ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'hyphen, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 6 'hyphen)))
(defun insert-password-phrase-6-hyphen-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'hyphen with capitalized words, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 6 'hyphen :capitalize)))
(defun insert-password-phrase-6-symbol-capitalize ()
"Call `password-phrase-to-clipboard' with a COUNT of 6 and a TYPE
of 'symbol with capitalized words, and insert the result."
(interactive "*")
(insert (password-phrase-to-clipboard 6 'symbol :capitalize)))
(init-message 3 "Functions: Text Inserting Functions: insert-license-gpl")
(defun insert-license-gpl ()
"Insert GPL2 license block to be used at the top of code files."
(interactive "*")
(let ((text
`("General Public License (Version 2)"
""
,(concat "Copyright © " (format-time-string "%Y" nil t) " " user-full-name)
""
"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 2 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, write to the Free Software Foundation, Inc.,"
"51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.")))
(dolist (x text)
(call-interactively #'comment-dwim)
(insert x)
(newline))))
(init-message 3 "Functions: Text Inserting Functions: insert-license-mit")
(defun insert-license-mit ()
"Insert MIT license block to be used at the top of code files."
(interactive "*")
(let ((text
`("MIT License"
""
,(concat "Copyright © " (format-time-string "%Y" nil t) " " user-full-name)
""
"Permission is hereby granted, free of charge, to any person obtaining"
"a copy of this software and associated documentation files (the"
"\"Software\"), to deal in the Software without restriction, including"
"without limitation the rights to use, copy, modify, merge, publish,"
"distribute, sublicense, and/or sell copies of the Software, and to"
"permit persons to whom the Software is furnished to do so, subject to"
"the following conditions:"
""
"The above copyright notice and this permission notice shall be"
"included in all copies or substantial portions of the Software."
""
"THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND,"
"EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF"
"MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND"
"NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE"
"LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION"
"OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION"
"WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.")))
(dolist (x text)
(call-interactively #'comment-dwim)
(insert x)
(newline))))
(init-message 3 "Functions: Text Inserting Functions: insert-license-apache")
(defun insert-license-apache ()
"Insert Apache license block to be used at the top of code files."
(interactive "*")
(let ((text
`("Apache License"
""
,(concat "Copyright © " (format-time-string "%Y" nil t) " " user-full-name)
""
"Licensed under the Apache License, Version 2.0 (the \"License\");"
"you may not use this file except in compliance with the License."
"You may obtain a copy of the License at"
""
" http://www.apache.org/licenses/LICENSE-2.0"
""
"Unless required by applicable law or agreed to in writing, software"
"distributed under the License is distributed on an \"AS IS\" BASIS,"
"WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied."
"See the License for the specific language governing permissions and"
"limitations under the License.")))
(dolist (x text)
(call-interactively #'comment-dwim)
(insert x)
(newline))))
(init-message 2 "Functions: External Program Functions")
(init-message 3 "Functions: External Program Functions: insert-date")
(defun insert-date ()
"Insert current date in YYYY-MM-DD format."
(interactive "*")
(call-process "date" nil t nil "+%Y-%m-%d")
(delete-char -1))
(init-message 3 "Functions: External Program Functions: insert-datetime")
(defun insert-datetime ()
"Insert current date and time in YYYY-MM-DD HH:MM:SS format."
(interactive "*")
(call-process "date" nil t nil "+%Y-%m-%d %H:%M:%S")
(delete-char -1))
(init-message 3 "Functions: External Program Functions: insert-time")
(defun insert-time ()
"Insert current time in HH:MM:SS format."
(interactive "*")
(call-process "date" nil t nil "+%H:%M:%S")
(delete-char -1))
(init-message 3 "Functions: External Program Functions: insert-date-stamp")
(defun insert-date-stamp ()
"Insert current date in YYYYMMDD format."
(interactive "*")
(call-process "date" nil t nil "+%Y%m%d")
(delete-char -1))
(init-message 3 "Functions: External Program Functions: insert-fortune")
(defun insert-fortune (&optional file)
"Insert a random fortune.
If FILE is non-nil, use that fortune file."
(interactive "*")
(call-process "fortune" nil t nil "-a" (if file (shell-quote-argument file) "")))
(init-message 3 "Functions: External Program Functions: insert-quote")
(defun insert-quote ()
"Insert a random quote."
(interactive "*")
(insert-fortune (expand-file-name "~/quotes")))
(init-message 3 "Functions: External Program Functions: insert-arch-package-description")
(defun insert-arch-package-description (package &optional max-length)
"Insert Arch OS package description for given PACKAGE.
Optional parameter, MAX-LENGTH will truncate the description if
it is longer."
(interactive "*")
(cl-labels
((command-path (command)
(let ((path (string-trim (shell-command-to-string
(format "command -v \"%s\" 2>&1" command)))))
(if (string= path "")
nil
path))))
(let ((package-manager (or
(command-path "yay")
(command-path "yaourt")
(command-path "pacman")
(command-path "pamac"))))
(if package-manager
(let ((cmd (format
"%s %s %s 2>/dev/null | grep -A 2 '/%s ' | sed -n ':a ; /^[a-z]*\\/%s / { n ; p }'"
package-manager
(if (string= (substring package-manager -5) "pamac")
"search -a"
"-Ss")
package
package
package
package)))
(message "Searching for Arch package: %s" cmd)
(let* ((desc (string-trim (shell-command-to-string cmd))))
(insert (if (and max-length
(> (length desc) max-length))
(concat (substring desc 0 (- max-length 3)) "...")
desc))))
(user-error "Neither 'pacman', 'yay', 'pamac', or 'yaourt' where found in system path")))))
(init-message 3 "Functions: External Program Functions: set-arch-package-description")
(defun set-arch-package-description (&optional fast)
"Set Arch OS package description for package found on current line.
If FAST is non-nil, `org-table-align' will not be called before
or after."
(interactive "*")
(save-mark-and-excursion
(cond
((org-table-p)
(unless fast
(org-table-align))
(forward-line 0)
(when (re-search-forward "|[^|]*|[^|]*|[ \t]*\\([^ \t|]*\\)[ \t]*|[^|]*|" (line-end-position) :noerror)
(let ((package (match-string-no-properties 1)))
(forward-line 0)
(re-search-forward "|[^|]*|[^|]*|[^|]*|" (line-end-position))
(org-table-blank-field)
(insert-arch-package-description package 80)
(unless fast
(org-table-align)))))
(t
(forward-line 0)
(unless (re-search-forward "^[ \t]*#" (line-end-position) :noerror)
(forward-line 0)
(when (re-search-forward "\\([^ \t]+\\)" (line-end-position) :noerror)
(let ((package (match-string-no-properties 1)))
(forward-line 0)
(when (re-search-forward "#" (line-end-position) :noerror)
(kill-region (1- (point)) (line-end-position)))
(comment-indent)
(insert-arch-package-description package 80))))))))
(init-message 3 "Functions: External Program Functions: insert-nix-package-description")
(defun insert-nix-package-description (package &optional max-length)
"Insert Nix package description for given PACKAGE.
Optional parameter, MAX-LENGTH will truncate the description if
it is longer."
(interactive "*")
(let ((cmd (format
"nix search --quiet nixpkgs \"x86_64-linux\\.%s$\" 2>/dev/null | tail -n 1"
package)))
(message "Searching for Nix package: %s" cmd)
(let ((desc (string-trim (shell-command-to-string cmd))))
(insert (if (and max-length
(> (length desc) max-length))
(concat (substring desc 0 (- max-length 3)) "...")
desc)))))
(init-message 3 "Functions: External Program Functions: set-nix-package-description")
(defun set-nix-package-description ()
"Set Nix package description for package found on current line."
(interactive "*")
(save-mark-and-excursion
(forward-line 0)
(let ((package (re-search-forward "^[ \t]*\\([^ \t]*\\)" (line-end-position))))
(let ((package (match-string-no-properties 1)))
(kill-region (point) (line-end-position))
(comment-indent)
(insert-nix-package-description package 80)))))
(init-message 3 "Functions: External Program Functions: define-word")
(defun define-word (&optional word)
"Return definition of WORD and put it on the `kill-ring'."
(interactive "MWord: ")
(let ((def (with-temp-buffer
(call-process "trans" nil t nil "-no-ansi" (shell-quote-argument word))
(goto-char (point-min))
(when (re-search-forward "^Examples" nil :noerror)
(delete-region (1- (line-beginning-position)) (point-max)))
(buffer-string))))
(kill-new def)
(message "%s" def)))
(defun define-word-after-spell-check (word)
"Define WORD after spell checking.
Uses `ispell--run-on-word' to spell check word."
(interactive "MWord: ")
(ispell-set-spellchecker-params)
(ispell-accept-buffer-local-defs)
(let ((check (ispell--run-on-word word)))
(cond
((or (eq check t)
(stringp check))
(define-word word))
(t
(let ((buffer (generate-new-buffer-name "*define-word-after-spell-check*")))
(switch-to-buffer (get-buffer-create buffer))
(insert word)
(ispell-word)
(let ((checked-word (buffer-substring-no-properties (point-min) (point-max))))
(when (string= buffer (buffer-name))
(kill-buffer (current-buffer)))
(define-word checked-word)))))))
(defun define-word-at-point-after-spell-check ()
"Use `define-word-after-spell-check' to define word at point.
When the region is active, define the marked phrase."
(interactive)
(let ((word
(cond
((eq major-mode 'pdf-view-mode)
(car (pdf-view-active-region-text)))
((use-region-p)
(buffer-substring-no-properties
(region-beginning)
(region-end)))
(t
(substring-no-properties
(or (thing-at-point 'word) ""))))))
(when (plusp (length word))
(define-word-after-spell-check word))))
(init-message 3 "Functions: External Program Functions: run-command")
(defun run-command (command &optional destination)
"Use `call-process' to run COMMAND with optional DESTINATION.
See `call-process' documentation for instructions on how to use
DESTINATION."
(let ((destination (or destination 0))
(parts (split-string command (rx (one-or-more space)))))
(apply #'call-process `(,(car parts) nil ,destination nil ,@(cdr parts)))))
(init-message 2 "Functions: Newer Emacs Functionality Functions")
(init-message 3 "Functions: Newer Emacs Functionality Functions: line-number-at-pos")
(unless (fboundp 'line-number-at-pos)
(defun line-number-at-pos (&optional pos)
"Return (narrowed) buffer line number at position POS.
If POS is nil, use current buffer location."
(save-mark-and-excursion
(when pos
(goto-char pos))
(1+ (count-lines (point-min) (line-beginning-position))))))
(init-message 3 "Functions: Newer Emacs Functionality Functions: save-mark-and-excursion")
(unless (fboundp 'save-mark-and-excursion)
(defmacro save-mark-and-excursion (&rest body)
"Like `save-excursion', but also save and restore the mark state.
This macro does what `save-excursion' did before Emacs 25.1."
(declare (indent 0) (debug t))
(let ((saved-marker-sym (make-symbol "saved-marker")))
`(let ((,saved-marker-sym (save-mark-and-excursion--save)))
(unwind-protect
(save-excursion ,@body)
(save-mark-and-excursion--restore ,saved-marker-sym))))))
(init-message 2 "Functions: Grep Search Functions")
(init-message 3 "Functions: Grep Search Functions: grep-elisp")
(defun grep-elisp (query &optional extended)
"Grep custom elisp directories for QUERY.
Run `grep' COMMAND, where COMMAND is:
`grep-default-command' QUERY FILES
FILES is a list of files generated from the following
files/directories:
`emacs-home-dir' or ~/.emacs.d (if EXTENDED is t)
`local-init-dir' if it exists
`local-modules-dir' if it exists
A file matching pattern of `*.el$' is used."
(interactive "sGrep custom elisp files: ")
(let (paths
path
files)
(if extended
(if (and (boundp 'emacs-home-dir)
(file-exists-p emacs-home-dir))
(push emacs-home-dir paths)
"~/.emacs.d")
(progn
(when (and (boundp 'local-init-dir)
local-init-dir
(file-exists-p local-init-dir))
(push local-init-dir paths))
(when (and (boundp 'local-modules-dir)
local-modules-dir
(file-exists-p local-modules-dir))
(push local-modules-dir paths))))
(while paths
(setq path (file-truename (expand-file-name (car paths))))
(setq paths (cdr paths))
(if (file-directory-p path)
(dolist (file (nreverse (directory-files path t)))
(unless (string-match "^\\.\\.?$" (file-name-nondirectory file))
(if (file-directory-p file)
(push file paths)
(when (string-match "\\.el\\'" file)
(push file files)))))
(push path files)))
(let ((cmd (or grep-command "grep -n -H -i -r -e ")))
(setq cmd (concat cmd " \"" query "\""))
(dolist (file files)
(setq cmd (concat cmd " \"" file "\"")))
(grep cmd))))
(init-message 3 "Functions: Grep Search Functions: grep-elisp-extended")
(defun grep-elisp-extended (query)
"Call `grep-elisp' with QUERY and EXTENDED set to t."
(interactive "sGrep custom elisp files (extended): ")
(grep-elisp query t))
(init-message 3 "Functions: Grep Search Functions: grep-custom")
(defmacro grep-custom (dirs match)
"Return a custom grep function.
DIRS is a list of the directories to search.
MATCH is the file pattern to match."
`(lambda (query)
(let ((paths (reverse (quote ,dirs)))
(match ,match)
path
files)
(while paths
(setq path (file-truename (expand-file-name (car paths))))
(setq paths (cdr paths))
(if (file-directory-p path)
(dolist (file (nreverse (directory-files path t)))
(unless (or (string-match "^\\.\\.?$" (file-name-nondirectory file))
(string-match "\\.svn" (file-name-nondirectory file)))
(if (file-directory-p file)
(push file paths)
(when (or (not match)
(string-match match file))
(push file files)))))
(push path files)))
(let ((cmd (or grep-command "grep -n -H -i -e")))
(setq cmd (concat cmd " \"" query "\""))
(dolist (file files)
(setq cmd (concat cmd " \"" file "\"")))
(grep cmd)))))
(init-message 3 "Functions: Grep Search Functions: grep-custom-function")
(defmacro grep-custom-function (name prompt dirs match)
"Return custom grep function.
NAME is the function name.
PROMPT is displayed if no query is given.
DIRS is a list of the directories to search.
MATCH is the file pattern to match."
(let ((dirs dirs)
(match match))
`(defun ,name (query)
,(concat "Grep custom directories for QUERY.\n\n"
"Run `grep' COMMAND, where COMMAND is:\n\n"
"`grep-default-command' QUERY FILES\n\n"
"FILES is a list of files generated from the following\n"
"files/directories:\n\n"
(concat " " (cl-reduce (lambda (x y) (concat x "\n " y)) dirs) "\n\n")
"A file matching pattern of `" match "' is used.")
(interactive ,(concat "s" prompt))
(funcall (grep-custom ,dirs ,match) query))))
(init-message 3 "Functions: Grep Search Functions: grep-bin")
(grep-custom-function grep-bin "Grep HOME bin files: " ("~/bin") nil)
(init-message 3 "Functions: Grep Search Functions: grep-clojure")
(grep-custom-function grep-clojure "Grep Clojure files: " ("~/dev/clojure") "\\(\\.org$\\|\\.clj$\\)")
(init-message 3 "Functions: Grep Search Functions: grep-clisp")
(grep-custom-function grep-clisp "Grep CLISP files: " ("~/dev/clisp") "\\(\\.org$\\|\\.lisp$\\)")
(init-message 3 "Functions: Grep Search Functions: grep-emacs-init")
(grep-custom-function grep-emacs-init "Grep Emacs Initialization files: "
("~/.emacs.d/init.el"
"~/.emacs.d/init-emacs.org"
"~/.emacs.d/customization.el")
"\\(\\.org$\\|\\.el$\\)")
(init-message 3 "Functions: Grep Search Functions: grep-home-init")
(grep-custom-function grep-home-init "Grep Home Initialization files: "
("~/org/init-home.org") "\\.org\\'")
(init-message 3 "Functions: Grep Search Functions: grep-org")
(grep-custom-function grep-org "Grep Org files: " ("~/org") "\\.org\\'")
(init-message 3 "Functions: Grep Search Functions: grep-python")
(grep-custom-function grep-python "Grep Python files: " ("~/dev/python") "\\(\\.org$\\|\\.py$\\)")
(init-message 3 "Functions: Grep Search Functions: grep-racket")
(grep-custom-function grep-racket "Grep Racket files: " ("~/dev/racket") "\\.rkt\\'")
(init-message 3 "Functions: Grep Search Functions: grep-web")
(grep-custom-function grep-web "Grep web files: " ("~/web/org") "\\.org\\'")
(init-message 2 "Functions: TAGS File Functions")
(init-message 3 "Functions: TAGS File Functions: etags-create")
(defun etags-create (&optional local)
"Create local TAGS file.
If LOCAL is non-nil, visit the new TAGS file locally only.
First an existing TAGS file is searched for going up the
directory path. If none is found, a \"src\" directory is searched
for and, if found, its parent directory is used. Failing that the
user is prompted for the location."
(interactive)
(let ((file (or (find-file-updir "TAGS")
(when (find-file-updir "src")
(file-truename (expand-file-name (concat (find-file-updir "src") "/../TAGS"))))
(concat (read-directory-name "Top of source tree: " default-directory) "/TAGS")))
(extension (or (file-name-extension buffer-file-name)
"el"))
query)
(if (member extension '("h" "c" "hpp" "cpp"))
(setq query "-name \"*.h\" -o -name \"*.c\" -o -name \"*.hpp\" -o -name \"*.cpp\"")
(setq query (concat "-name \"*." extension "\"")))
(let ((cmd (concat "find " (file-name-directory file) " " query " -print0 | "
"grep -zZv \"/.svn/\" | "
"xargs -0 etags -o " file " && "
"echo 'Created TAGS file'")))
(message "Running command: %s" cmd)
(shell-command cmd)
(when (get-buffer "TAGS")
(kill-buffer "TAGS"))
(visit-tags-table file local))))
(init-message 2 "Functions: Code Formatting Functions")
(init-message 3 "Functions: Code Formatting Functions: indent-region-or-thing")
(defun indent-region-or-thing (&optional beg end)
"Indent selected region, or org code block, or sexp surrounding
point, or line."
(interactive)
(let ((case-fold-search t)
(beg (or beg (if (use-region-p) (region-beginning) nil)))
(end (or end (if (use-region-p) (region-end) nil)))
(eol (line-end-position)))
(deactivate-mark)
(save-window-excursion
(save-mark-and-excursion
(save-match-data
(cond
((and beg end)
(indent-region beg end))
((and (eq major-mode 'org-mode)
(eq (org-element-type (org-element-at-point)) 'src-block))
(condition-case nil
(let ((case-fold-search t)
(re "^[ \t]*#\\+BEGIN_\\(\\sw+\\)"))
(forward-line 0)
(unless (looking-at re)
(re-search-backward re))
(org-indent-block))
('error nil)))
((save-excursion
(and (beginning-of-defun)
(progn
(end-of-defun)
(>= (point) eol))))
(beginning-of-defun)
(indent-region (line-beginning-position) (line-end-position))
(let* ((bounds (bounds-of-thing-at-point 'sexp))
(beg (car bounds))
(end (cdr bounds)))
(indent-region beg end)))
(t
(indent-according-to-mode))))))))
(init-message 3 "Functions: Code Formatting Functions: indent-buffer")
(defun indent-buffer ()
"Indent current buffer."
(indent-region (point-min) (point-max)))
(init-message 3 "Functions: Code Formatting Functions: find-code-block")
(defun find-code-block (&optional regexp indent)
"Find the begin and end of code block containing point.
When run interactively, then begin and end points of the block
are printed in the minibuffer. Otherwise, a list containing them
is returned.
A code block is defined as contiguous lines of text having the
same indentation. So a code block ends when either the
indentation changes or a blank line is reached.
The begin point will be at the start of a line and the end point
will be at the end of a line, unless point is not in a code block
in which case nil is returned for both.
The optional parameter REGEXP is an additional regular expression
to match on. If non-nil, every line in the code block must also
match REGEXP.
If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'."
(interactive "*")
(let (beg
end
(ind 0)
(blank-line-regexp "^[ \t]*$"))
(save-mark-and-excursion
(setq ind (current-indentation))
(forward-line 0)
(unless (or
(looking-at blank-line-regexp)
(if regexp
(not (looking-at regexp))
nil))
(while (and
(not (bobp))
(not (looking-at blank-line-regexp))
(= ind (current-indentation))
(if regexp
(looking-at regexp)
t))
(forward-line -1)
(forward-line 0))
(unless (and
(not (looking-at blank-line-regexp))
(= ind (current-indentation))
(if regexp
(looking-at regexp)
t))
(forward-line 1))
(forward-line 0)
(setq beg (point))
(when indent
(indent-according-to-mode))
(setq ind (current-indentation))
(while (and
(not (eobp))
(not (looking-at blank-line-regexp))
(= ind (current-indentation))
(if regexp
(looking-at regexp)
t))
(forward-line 1)
(when indent
(indent-according-to-mode))
(forward-line 0))
(unless (and
(not (looking-at blank-line-regexp))
(= ind (current-indentation))
(if regexp
(looking-at regexp)
t))
(forward-line -1))
(end-of-line)
(setq end (point))))
(if (called-interactively-p 'any)
(message "%s %s" beg end)
(list beg end))))
(init-message 3 "Functions: Code Formatting Functions: align-assignment-commands")
(defun align-assignment-commands (&optional indent)
"Align a block of variable assignment commands.
Match any contiguous block of code (presumably assignment
commands) and align the equal signs.
If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'.
Example:
// assignments
var1 = value1; // var1
variable2 = value2; // var2
Becomes:
// assignments
var1 = value1; // var1
variable2 = value2; // var2"
(interactive "*")
(let* ((range (find-code-block nil indent)) (beg (car range)) (end (cadr range)) (pos 0)
(equal-regexp "[ \t]*=[ \t]*"))
(save-mark-and-excursion
(when (> end beg)
(save-restriction
(narrow-to-region beg end)
(save-match-data
(goto-char (point-min))
(while (< (point) (point-max))
(when (and
(re-search-forward equal-regexp (line-end-position) :noerror)
(not (equal (get-char-property (point) 'face)
'font-lock-comment-face)))
(forward-line 0)
(re-search-forward equal-regexp (line-end-position))
(replace-match " = ")
(backward-char 2)
(when (> (- (point) (line-beginning-position)) pos)
(setq pos (- (point) (line-beginning-position)))))
(forward-line 0)
(forward-line 1))
(goto-char (point-min))
(while (< (point) (point-max))
(when (and
(re-search-forward equal-regexp (line-end-position) :noerror)
(not (equal (get-char-property (point) 'face)
'font-lock-comment-face)))
(backward-char 2)
(while (< (- (point) (line-beginning-position)) pos)
(insert " ")))
(forward-line 0)
(forward-line 1))
(goto-char (point-min))
(while (< (point) (point-max))
(forward-line 0)
(forward-char (current-indentation))
(when (and
(not (equal (get-char-property (line-end-position) 'face)
'font-lock-comment-face))
(equal (get-char-property (line-end-position) 'face)
'font-lock-comment-face))
(comment-indent))
(forward-line 1))))))))
(init-message 3 "Functions: Code Formatting Functions: align-assignment-commands-indent")
(defun align-assignment-commands-indent ()
(interactive "*")
(align-assignment-commands t))
(init-message 3 "Functions: Code Formatting Functions: align-declaration-commands")
(defun align-declaration-commands (&optional indent)
"Align a block of variable declaration commands.
If optional parameter INDENT is non-nil then each line will be
indented via `indent-according-to-mode'.
Example:
// variables
public Integer i; // int example
public String s; // string example
private Integer i2; // int 2
private String s2; // string 2
protected Date dte; // date example
Becomes:
// variables
public Integer i; // int example
public String s; // string example
private Integer i2; // int 2
private String s2; // string 2
protected Date dte; // date example"
(interactive "*")
(let* ((range (find-code-block nil indent)) (beg (car range)) (end (cadr range)) face face-prev face-change (change -1) (change-prev -2) (whitespace-regexp "[ \t]+")) (save-mark-and-excursion
(when (> end beg)
(save-restriction
(narrow-to-region beg end)
(save-match-data
(goto-char (point-min))
(while (< (point) (point-max))
(forward-char (current-indentation))
(while (re-search-forward whitespace-regexp (line-end-position) :noerror)
(replace-match " "))
(forward-line 0)
(forward-line 1))
(while (> change change-prev)
(setq change-prev change)
(when (< change-prev 0)
(setq change-prev (current-indentation)))
(setq face nil)
(setq face-prev nil)
(goto-char (point-min))
(while (< (point) (point-max))
(forward-line 0)
(forward-char (current-indentation))
(unless (member (get-char-property (point) 'face)
(list 'font-lock-comment-face
'nxml-comment-delimiter-face
'nxml-comment-content-face))
(forward-line 0)
(forward-char change-prev)
(unless face-prev
(save-mark-and-excursion
(while (and (< (point) (line-end-position))
(looking-at whitespace-regexp))
(forward-char 1))
(when (< (point) (line-end-position))
(setq face-prev (get-char-property (point) 'face)))))
(setq face-change nil)
(while (and (< (point) (line-end-position))
(not (looking-at whitespace-regexp)))
(unless (equal face-prev (get-char-property (point) 'face))
(setq face-change t))
(forward-char 1))
(while (and (< (point) (line-end-position))
(or
(looking-at whitespace-regexp)
(and (not face-change)
(equal face-prev (get-char-property (point) 'face)))))
(forward-char 1))
(when (and (< (point) (line-end-position))
(< change (- (point) (line-beginning-position)))
(if face
(equal face (get-char-property (point) 'face))
t))
(unless face
(setq face (get-char-property (point) 'face)))
(setq change (- (point) (line-beginning-position)))))
(forward-line 1))
(when (> change change-prev)
(goto-char (point-min))
(while (< (point) (point-max))
(forward-line 0)
(forward-char (current-indentation))
(unless (member (get-char-property (point) 'face)
(list 'font-lock-comment-face
'nxml-comment-delimiter-face
'nxml-comment-content-face))
(forward-line 0)
(forward-char change-prev)
(while (and (< (point) (line-end-position))
(not (looking-at whitespace-regexp)))
(forward-char 1))
(while (and (< (point) (line-end-position))
(or
(looking-at whitespace-regexp)
(not (equal face (get-char-property (point) 'face)))))
(forward-char 1))
(while (< (- (point) (line-beginning-position)) change)
(insert " ")))
(forward-line 1))))
(goto-char (point-min))
(while (< (point) (point-max))
(forward-line 0)
(forward-char (current-indentation))
(when (and
(not (equal (get-char-property (line-end-position) 'face)
'font-lock-comment-face))
(equal (get-char-property (line-end-position) 'face)
'font-lock-comment-face))
(comment-indent))
(forward-line 1))))))))
(init-message 3 "Functions: Code Formatting Functions: align-declaration-commands-indent")
(defun align-declaration-commands-indent ()
(interactive "*")
(align-declaration-commands t))
(init-message 3 "Functions: Code Formatting Functions: align-comments")
(defun align-comments (&optional beg end)
"Align a block of commented lines.
If region is not given, one of the following blocks will be
used (tried in order):
- Org source block
- Symbolic expression
- Current line
Example:
// variables
public Integer i; // int example
public String s; // string example
private Integer i2; // int 2
private String s2; // string 2
protected Date dte; // date example
Becomes:
// variables
public Integer i; // int example
public String s; // string example
private Integer i2; // int 2
private String s2; // string 2
protected Date dte; // date example"
(interactive "*")
(let ((case-fold-search t)
(comment-regexp
(concat "\\(\\s-*\\)"
comment-start
(if (string= comment-start ";") " " "")))
(point (point))
(beg (or beg (if (use-region-p) (region-beginning) nil)))
(end (or end (if (use-region-p) (region-end) nil))))
(deactivate-mark)
(save-window-excursion
(save-mark-and-excursion
(save-match-data
(cond
((and beg end)
(align-regexp beg end comment-regexp))
((and (eq major-mode 'org-mode)
(eq (org-element-type (org-element-at-point)) 'src-block))
(condition-case nil
(let ((case-fold-search t)
(re "^\\([ \t]*\\)#\\+BEGIN_\\(\\sw+\\)"))
(forward-line 0)
(unless (looking-at re)
(re-search-backward re))
(re-search-forward (concat "^\\([ \t]*\\)#\\+END_" (match-string 2))))
('error nil))
(org-babel-do-in-edit-buffer (align-regexp (point-min) (point-max) comment-regexp)))
((beginning-of-defun)
(let* ((bounds (bounds-of-thing-at-point 'sexp))
(beg (car bounds))
(end (cdr bounds)))
(align-regexp beg end comment-regexp)))
(t
(align-regexp (line-beginning-position) (line-end-position) comment-regexp))))))
(goto-char point)))
(init-message 3 "Functions: Code Formatting Functions: java-toggle-comment-type")
(defun java-toggle-comment-type ()
"Toggle between single and multi-line Java/C comments.
Examples:
/*
// comment => * comment
*/
/*
* comment => // comment
*/"
(interactive "*")
(let ((indentation-regexp "^[ \t]*")
(empty-line-regexp "^[ \t]*$")
(single-line-comment-regexp "^[ \t]*// ")
(multi-line-comment-regexp "^[ \t]*\\* ")
(multi-line-comment-begin-regexp "^[ \t]*/\\*")
(multi-line-comment-end-regexp "^[ \t]*\\*/")
(class-regexp "\\bclass\\b"))
(save-mark-and-excursion
(save-match-data
(forward-line 0)
(if (looking-at single-line-comment-regexp)
(let ((beg (progn
(while (and (not (bobp))
(looking-at single-line-comment-regexp))
(forward-line -1))
(unless (looking-at single-line-comment-regexp)
(forward-line 1))
(line-beginning-position)))
(end (progn
(while (and (not (eobp))
(looking-at single-line-comment-regexp))
(forward-line 1))
(unless (looking-at single-line-comment-regexp)
(forward-line -1))
(line-end-position)))
(space (make-string (- (re-search-forward indentation-regexp) (line-beginning-position)) ? ))
(class (progn
(forward-line 0)
(forward-line 1)
(while (looking-at empty-line-regexp)
(forward-line 1))
(looking-at class-regexp))))
(goto-char beg)
(insert (concat space "/*"))
(newline)
(while (re-search-forward single-line-comment-regexp end :noerror)
(replace-match (concat space " * ")))
(goto-char (line-end-position))
(newline)
(insert (concat space " */")))
(let ((beg (progn
(while (and (not (bobp))
(or (looking-at multi-line-comment-regexp)
(looking-at multi-line-comment-end-regexp)))
(forward-line -1))
(if (looking-at multi-line-comment-begin-regexp)
(line-beginning-position)
nil)))
(end (progn
(while (and (not (eobp))
(or (looking-at multi-line-comment-regexp)
(looking-at multi-line-comment-begin-regexp)))
(forward-line 1))
(if (looking-at multi-line-comment-end-regexp)
(line-end-position)
nil)))
(space (make-string (- (re-search-forward indentation-regexp) (line-beginning-position) 1) ? )))
(when (and beg end)
(goto-char beg)
(delete-region (point) (progn (forward-line 1) (point)))
(while (re-search-forward multi-line-comment-regexp end :noerror)
(replace-match (concat space "// ")))
(goto-char (line-end-position))
(delete-region (point) (progn (forward-line 1) (goto-char (line-end-position)) (point))))))))))
(init-message 3 "Functions: Code Formatting Functions: c-toggle-comment-type")
(defalias 'c-toggle-comment-type 'java-toggle-comment-type)
(init-message 3 "Functions: Code Formatting Functions: java-remove-comments")
(defun java-remove-comments (&optional beg end)
"Remove all Java comments from buffer or region."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(narrow-to-region beg end)
(let (quote escape comment) (goto-char (point-min))
(while (not (eobp))
(forward-char 1)
(let ((char (preceding-char))
(next-char (following-char)))
(cl-case char
(?\" (unless (or comment escape)
(setq quote (not quote))))
(?\\ (unless comment
(setq escape (not escape))))
(t
(if comment (when (and (char-equal char ?*) (char-equal next-char ?/)) (forward-char 1)
(when (and (eolp) (not (eobp)))
(forward-char 1))
(delete-region comment (point))
(setq comment nil))
(unless (or quote escape) (cond
((and (char-equal char ?/) (char-equal next-char ?/))
(forward-char -1)
(while (and (not (bolp))
(or (char-equal (preceding-char) ? )
(char-equal (preceding-char) ?\t)))
(forward-char -1))
(let ((mark (point)))
(goto-char (line-end-position))
(unless (eobp)
(forward-char 1))
(delete-region mark (point))))
((and (char-equal char ?/) (char-equal next-char ?*))
(setq comment (1- (point))))))))))))))))
(init-message 3 "Functions: Code Formatting Functions: lisp-to-camel-case")
(defun lisp-to-camel-case ()
"Convert word under point from lisp notation to camel case notation."
(interactive "*")
(let* ((bounds (bounds-of-thing-at-point 'word))
(beg (car bounds))
(end (cdr bounds)))
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "-" nil :noerror)
(let ((p (point)))
(capitalize-word 1)
(goto-char p)))
(goto-char (point-min))
(while (re-search-forward "-" nil :noerror)
(replace-match "")))))))
(init-message 3 "Functions: Code Formatting Functions: camel-case-to-lisp")
(defun camel-case-to-lisp ()
"Convert word under point from camel case notation to lisp notation."
(interactive "*")
(let* ((bounds (bounds-of-thing-at-point 'word))
(beg (car bounds))
(end (cdr bounds))
(case-fold-search nil))
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(goto-char (point-min))
(while (re-search-forward "[A-Z]" nil :noerror)
(forward-char -1)
(insert "-")
(forward-char 1))
(goto-char (point-min))
(downcase-word 1))))))
(init-message 3 "Functions: Code Formatting Functions: c-pretty-print")
(defun c-pretty-print (&optional beg end)
"Pretty-print selected region."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(remove-tabs)
(remove-trailing-blanks)
(goto-char (point-min))
(while (re-search-forward "([ \t]*" nil :noerror)
(replace-match "("))
(goto-char (point-min))
(while (re-search-forward "[ \t]*)" nil :noerror)
(replace-match ")"))
(goto-char (point-min))
(while (re-search-forward "\\,\\([^ ]\\)" nil :noerror)
(replace-match ", \\1"))
(goto-char (point-min))
(while (re-search-forward "\\([^ \.]\\) +" nil :noerror)
(replace-match "\\1 "))
(goto-char (point-min))
(while (re-search-forward "\n\n\n+" nil :noerror)
(replace-match "\n\n"))
(goto-char (point-min))
(while (re-search-forward "\n\n[ \t]*{" nil :noerror)
(replace-match "\n{")
(indent-according-to-mode))
(indent-region (point-min) (point-max) nil))))))
(init-message 3 "Functions: Code Formatting Functions: ruby-pretty-print")
(defun ruby-pretty-print (&optional beg end)
"Pretty-print selected region."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(remove-tabs)
(remove-trailing-blanks)
(goto-char (point-min))
(while (re-search-forward "([ \t]*\\(.*?\\)[ \t]*)" nil :noerror)
(replace-match "(\\1)"))
(goto-char (point-min))
(while (re-search-forward "#{[ \t]*\\(.*?\\)[ \t]*}" nil :noerror)
(replace-match "#{\\1}"))
(goto-char (point-min))
(while (re-search-forward "\\[[ \t]*\\(.*?\\)[ \t]*\\]" nil :noerror)
(replace-match "[\\1]"))
(goto-char (point-min))
(while (re-search-forward "|[ \t]*\\(.*?\\)[ \t]*|" nil :noerror)
(replace-match "|\\1|"))
(goto-char (point-min))
(while (re-search-forward "\\,\\([^ ]\\)" nil :noerror)
(replace-match ", \\1"))
(goto-char (point-min))
(while (re-search-forward "\\([^ \.]\\) +" nil :noerror)
(replace-match "\\1 "))
(goto-char (point-min))
(while (re-search-forward "\n\n\n+" nil :noerror)
(replace-match "\n\n"))
(indent-region (point-min) (point-max) nil))))))
(init-message 3 "Functions: Code Formatting Functions: java-pretty-print")
(defun java-pretty-print (&optional beg end)
"Pretty-print selected region."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max)))))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(remove-tabs)
(remove-trailing-blanks)
(goto-char (point-min))
(while (re-search-forward "([ \t]*" nil :noerror)
(replace-match "("))
(goto-char (point-min))
(while (re-search-forward "[ \t]*)" nil :noerror)
(replace-match ")"))
(goto-char (point-min))
(while (re-search-forward "\\,\\([^ ]\\)" nil :noerror)
(replace-match ", \\1"))
(dolist (name '("catch" "else" "for" "if" "return" "switch" "while"))
(goto-char (point-min))
(while (re-search-forward (concat name "(") nil :noerror)
(replace-match (concat name " ("))))
(dolist (name '("catch" "else"))
(goto-char (point-min))
(while (re-search-forward (concat "}[ \t\n]*" name) nil :noerror)
(replace-match (concat "} " name))
(indent-according-to-mode)))
(goto-char (point-min))
(while (re-search-forward "\\([^ \.]\\) +" nil :noerror)
(replace-match "\\1 "))
(goto-char (point-min))
(while (re-search-forward "\n\n\n+" nil :noerror)
(replace-match "\n\n"))
(goto-char (point-min))
(while (re-search-forward "\n\n[ \t]*{" nil :noerror)
(replace-match "\n{")
(indent-according-to-mode))
(indent-region (point-min) (point-max) nil))))))
(init-message 3 "Functions: Code Formatting Functions: xml-pretty-print")
(defun xml-pretty-print (&optional beg end)
"Pretty-print selected region."
(interactive "*")
(let ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(mode major-mode))
(deactivate-mark)
(save-mark-and-excursion
(save-restriction
(save-match-data
(narrow-to-region beg end)
(xml-mode)
(let ((xml-eol "[ \t]*\n[ \t]*")
(xml-tag-end-regexp ">")
(xml-close-tag-regexp "</")
(xml-block-regexp "<[^>]*>[^<]*</[^>]*>"))
(goto-char (point-min))
(while (re-search-forward xml-eol nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward xml-tag-end-regexp nil :noerror)
(insert "\n")
(when (and
(looking-at xml-block-regexp)
(not (looking-at xml-close-tag-regexp)))
(re-search-forward xml-block-regexp nil :noerror)
(forward-char -1)))
(indent-region (point-min) (point-max)))
(funcall mode))))))
(init-message 2 "Functions: Code Inserting Functions")
(init-message 3 "Functions: Code Inserting Functions: project-euler-insert-template")
(defun project-euler-insert-template (num &optional count)
"Insert a Project Euler template for NUM.
If optional COUNT is given, repeat up to NUM+COUNT-1."
(let ((buffer "project-euler.lisp"))
(unless (string= (buffer-name) buffer)
(user-error "Current buffer is not: %s" buffer))
(dotimes (x (or count 1))
(let ((strnum (format "%03d" (+ num x))))
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(re-search-forward "^;;; Template")
(forward-line 0)
(forward-line 3)
(let ((beg (point)))
(forward-sexp 2)
(forward-line 0)
(forward-line 2)
(let ((template (replace-regexp-in-string
"\\?" strnum
(buffer-substring-no-properties beg (point)))))
(search-backward-regexp "^;;; New Problems")
(forward-line -1)
(insert template)))))))))
(init-message 3 "Functions: Code Inserting Functions: insert-tree")
(defun insert-tree (leaves padding)
"Insert binary tree with LEAVES at the bottom and PADDING on the left."
(let ((size (* 3 (expt 2 leaves)))
(pad (cl-do* ((l 1 (1+ l))
(pad 0 (+ pad (* 3 (expt 2 l)))))
((> l leaves) pad))))
(cl-do ((s size (1- s)))
((zerop s))
(let ((i ""))
(dotimes (_ (+ padding s))
(setq i (concat i " ")))
(setq i (concat i "/"))
(dotimes (_ (* (- size s) 2))
(setq i (concat i " ")))
(setq i (concat i "\\"))
(insert i)
(newline)))))
(init-message 2 "Functions: Esoteric Functions")
(init-message 3 "Functions: Esoteric Functions: Fahrenheit/Celsius Conversions")
(init-message 4 "Functions: Esoteric Functions: Fahrenheit/Celsius Conversions: fahrenheit-to-celsius")
(defun fahrenheit-to-celsius (deg)
"Convert fahrenheit degrees to celsius."
(/ (* (- deg 32.0) 5.0) 9.0))
(init-message 4 "Functions: Esoteric Functions: Fahrenheit/Celsius Conversions: fahrenheit-to-celsius-query")
(defun fahrenheit-to-celsius-query (deg)
"Prompt user for fahrenheit degrees to convert to celsius."
(interactive "nFahrenheit degrees: ")
(let ((cel (fahrenheit-to-celsius deg)))
(when (called-interactively-p 'any)
(message "Celsius degrees: %s" cel))
cel))
(init-message 4 "Functions: Esoteric Functions: Fahrenheit/Celsius Conversions: celsius-to-fahrenheit")
(defun celsius-to-fahrenheit (deg)
"Convert celsius degrees to fahrenheit."
(+ (* (/ deg 5.0) 9.0) 32.0))
(init-message 4 "Functions: Esoteric Functions: Fahrenheit/Celsius Conversions: celsius-to-fahrenheit-query")
(defun celsius-to-fahrenheit-query (deg)
"Prompt user for celsius degrees to convert to fahrenheit."
(interactive "nCelsius degrees: ")
(let ((cel (celsius-to-fahrenheit deg)))
(when (called-interactively-p 'any)
(message "Fahrenheit degrees: %s" cel))
cel))
(init-message 3 "Functions: Esoteric Functions: base-conversion")
(defun base-conversion (base-from base-to num)
"Convert NUM from BASE-FROM to BASE-TO."
(interactive)
(let ((num
(cl-do* ((n (mod num 10) (mod num 10))
(num (/ num 10) (/ num 10))
(pos 1 (* pos base-from))
(result (* pos n) (+ result (* pos n))))
((zerop num) result))))
(cl-do* ((n (mod num base-to) (mod num base-to))
(num (/ num base-to) (/ num base-to))
(pos 1 (* pos base-to))
(result (* pos n) (+ result (* pos n))))
((zerop num) result))))
(init-message 3 "Functions: Esoteric Functions: ldif-update-xml")
(defun ldif-update-xml ()
"Update an LDIF node with the base64 encoded value of an XML block.
Must be run from the attribute being updated, which must be in
the form of `attribute::'."
(interactive "*")
(let (beg
end
attr
block
(blank-line-regexp "^[ \t]*$"))
(save-mark-and-excursion
(save-match-data
(forward-line 0)
(when (search-forward "::" (line-end-position) :noerror)
(setq attr (point))
(when (search-forward "<?xml" nil :noerror)
(setq beg (line-beginning-position))
(while (and
(not (eobp))
(not (looking-at blank-line-regexp)))
(forward-line 1))
(forward-line -1)
(end-of-line)
(setq end (point))
(setq block (buffer-substring-no-properties beg end))
(with-temp-buffer
(insert block)
(goto-char (point-min))
(search-forward "<?xml")
(forward-line 0)
(when (char-equal (char-after (point)) ?#)
(while (char-equal (char-after (point)) ?#)
(delete-char 1)
(when (char-equal (char-after (point)) ? )
(delete-char 1))
(forward-line 1)
(forward-line 0)))
(goto-char (point-min))
(while (re-search-forward "^[ \t]*#" (point-max) :noerror)
(delete-region (line-beginning-position) (line-end-position))
(unless (eobp)
(delete-char 1)))
(base64-encode-region (point-min) (point-max))
(goto-char (point-min))
(while (not (eobp))
(forward-line 0)
(insert " ")
(forward-line 1))
(setq block (buffer-substring-no-properties (point-min) (point-max))))
(goto-char attr)
(delete-region (point) (line-end-position))
(forward-line 1)
(forward-line 0)
(while (char-equal (char-after (point)) ? )
(delete-region (line-beginning-position) (line-end-position))
(delete-char 1))
(goto-char attr)
(insert block)))))))
(init-message 3 "Functions: Esoteric Functions: lisp-to-racket-conversion")
(defun lisp-to-racket-conversion ()
"Find and convert next Lisp function header into Racket format."
(interactive "*")
(re-search-forward "^[ \t]*\(\\(defun\\)")
(backward-kill-word 1)
(let ((indent (buffer-substring-no-properties (line-beginning-position) (1- (point)))))
(insert "define")
(forward-char 1)
(insert "(")
(let ((fn-name-start (point)))
(re-search-forward " ")
(let ((fn-name
(replace-regexp-in-string
"-" " "
(buffer-substring-no-properties fn-name-start (1- (point))))))
(delete-char 1)
(forward-line 0)
(forward-line 1)
(let ((start (point)))
(re-search-forward "^[ \t]*\"" (line-end-position))
(let ((str-start (point))
(escape nil))
(while (not (and (not escape) (char-equal (char-after) ?\")))
(when (char-equal (char-after) ?\\)
(setq escape (not escape)))
(forward-char 1))
(let ((str (replace-regexp-in-string
(concat "\n" indent)
(concat "\n" indent ";; ")
(buffer-substring-no-properties str-start (point)))))
(forward-line 0)
(forward-line 1)
(delete-region start (point))
(forward-line -2)
(end-of-line)
(insert (concat "\n" indent ";;------------------------------------------------------------------------------\n"))
(insert (concat indent ";;;; " fn-name))
(titleize-line-or-region)
(insert (concat "\n" indent ";;\n" indent ";; " str "\n"))
(insert (concat indent ";;------------------------------------------------------------------------------\n\n"))
(forward-line 0)
(forward-line 2))))))))
(init-message 3 "Functions: Esoteric Functions: integer-to-roman-numerals")
(defun integer-to-roman-numerals (num)
"Return romain numeral version of given integer NUM.
Roman numerals use I, V, X, L, C, D, and M, standing respectively
for 1, 5, 10, 50, 100, 500, and 1,000."
(interactive "NInteger number: ")
(when (< num 0)
(user-error "NUM must be 1 or greater"))
(when (>= num 5000)
(user-error "NUM must be less than 5,000"))
(let ((roman))
(cl-labels
((convert (num)
(cond
((>= num 1000)
(push "M" roman)
(- num 1000))
((>= num 900)
(push "CM" roman)
(- num 900))
((>= num 500)
(push "D" roman)
(- num 500))
((>= num 400)
(push "CD" roman)
(- num 400))
((>= num 100)
(push "C" roman)
(- num 100))
((>= num 90)
(push "XC" roman)
(- num 90))
((>= num 50)
(push "L" roman)
(- num 50))
((>= num 40)
(push "XL" roman)
(- num 40))
((>= num 10)
(push "X" roman)
(- num 10))
((>= num 9)
(push "IX" roman)
(- num 9))
((>= num 5)
(push "V" roman)
(- num 5))
((>= num 4)
(push "IV" roman)
(- num 4))
((>= num 1)
(push "I" roman)
(- num 1)))))
(while (> num 0)
(setq num (convert num)))
(mapconcat 'identity (nreverse roman) ""))))
(init-message 2 "Functions: Table Generators")
(init-message 3 "Functions: Table Generators: ascii-table")
(defun ascii-table ()
"Display a table of the ASCII characters from 0 to 254 in a buffer."
(interactive)
(let ((special-chars ["NUL " "SOH " "STX " "ETX " "EOT "
"ENQ " "ACK " "BEL " "BS " "HT "
"LF " "VT " "FF " "CR " "SO "
"SI " "DLE " "DC1 " "DC2 " "DC3 "
"DC4 " "NAK " "SYN " "ETB " "CAN "
"EM " "SUB " "ESC " "FS " "GS "
"RS " "US "]))
(switch-to-buffer "*ASCII Table*")
(buffer-disable-undo)
(let (buffer-read-only)
(erase-buffer)
(dotimes (y 32)
(dotimes (x 8)
(when (and (> y 0) (zerop (mod x 8)))
(newline))
(let ((c (+ y (* x 32))))
(insert (format "%4d " c)
(cond
((< c 32)
(aref special-chars c))
((= c 127)
"DEL ")
((or (< c 127) (> c 159))
(format "%-4c" c))
(t " ")))))))
(setq buffer-read-only t)
(goto-char (point-min))))
(init-message 3 "Functions: Table Generators: http-status-code-table")
(defun http-status-code-table ()
"Display a table of the HTTP status codes in a buffer."
(interactive)
(let ((status-codes
'((100 . "Continue")
(101 . "Switching Protocols")
(102 . "Processing")
(103 . "Early Hints")
(104 . "Unassigned")
(200 . "OK")
(201 . "Created")
(202 . "Accepted")
(203 . "Non-Authoritative Information")
(204 . "No Content")
(205 . "Reset Content")
(206 . "Partial Content")
(207 . "Multi-Status")
(208 . "Already Reported")
(209 . "Unassigned")
(226 . "IM Used")
(227 . "Unassigned")
(300 . "Multiple Choices")
(301 . "Moved Permanently")
(302 . "Found")
(303 . "See Other")
(304 . "Not Modified")
(305 . "Use Proxy")
(306 . "(Unused)")
(307 . "Temporary Redirect")
(308 . "Permanent Redirect")
(400 . "Bad Request")
(401 . "Unauthorized")
(402 . "Payment Required")
(403 . "Forbidden")
(404 . "Not Found")
(405 . "Method Not Allowed")
(406 . "Not Acceptable")
(407 . "Proxy Authentication Required")
(408 . "Request Timeout")
(409 . "Conflict")
(410 . "Gone")
(411 . "Length Required")
(412 . "Precondition Failed")
(413 . "Payload Too Large")
(414 . "URI Too Long")
(415 . "Unsupported Media Type")
(416 . "Range Not Satisfiable")
(417 . "Expectation Failed")
(421 . "Misdirected Request")
(422 . "Unprocessable Entity")
(423 . "Locked")
(424 . "Failed Dependency")
(425 . "Too Early")
(426 . "Upgrade Required")
(427 . "Unassigned")
(428 . "Precondition Required")
(429 . "Too Many Requests")
(430 . "Unassigned")
(431 . "Request Header Fields Too Large")
(451 . "Unavailable For Legal Reasons")
(500 . "Internal Server Error")
(501 . "Not Implemented")
(502 . "Bad Gateway")
(503 . "Service Unavailable")
(504 . "Gateway Timeout")
(505 . "HTTP Version Not Supported")
(506 . "Variant Also Negotiates")
(507 . "Insufficient Storage")
(508 . "Loop Detected")
(509 . "Unassigned")
(510 . "Not Extended")
(511 . "Network Authentication Required"))))
(switch-to-buffer "*HTTP Status Code Table*")
(buffer-disable-undo)
(let (buffer-read-only)
(erase-buffer)
(insert "CODE DESCRIPTION\n")
(insert "---- -----------\n")
(mapc (lambda (c) (insert (format "%4d %s\n" (car c) (cdr c))))
status-codes))
(setq buffer-read-only t)
(goto-char (point-min))))
(init-message 3 "Functions: Table Generators: powers-of-two-table")
(defun powers-of-two-table ()
"Display a table of the first 64 Powers of two in a buffer."
(interactive)
(switch-to-buffer "*Powers of Two Table*")
(buffer-disable-undo)
(let (buffer-read-only)
(erase-buffer)
(insert "POWER DECIMAL HEX\n")
(insert "----- -------------------- -----------------\n")
(dotimes (x 65)
(if (<= x 60)
(let ((pow (expt 2 x)))
(insert (format "%5d %20d %17X\n" x pow pow)))
(let ((dec (progn (calc-radix 10)
(calc-eval (format "2^%d" x))))
(hex (progn (calc-radix 16)
(substring (calc-eval (format "2^%d" x)) 3))))
(insert (format "%5d %20s %17s\n" x dec hex))))))
(setq buffer-read-only t)
(goto-char (point-min)))
(init-message 3 "Functions: Table Generators: trigonometry-table")
(defun trigonometry-table ()
"Display a table of trigonometry values."
(interactive)
(switch-to-buffer "*Trigonometry Table*")
(buffer-disable-undo)
(let (buffer-read-only)
(erase-buffer)
(insert "RADIANS SIN COS TAN ARCSIN ARCCOS ARCTAN\n")
(insert "------- ------ ------ ------- ------ ------ -------\n")
(dotimes (x 81)
(let ((n (* float-pi (/ (- x 40) 40.0))))
(insert (format "% 7.3f % 6.3f % 6.3f % 7.3f % 6.3f % 6.3f % 7.3f\n" n
(sin n) (cos n)
(if (not (or (= x 20) (= x 60))) (tan n) (acos n))
(asin n) (acos n) (atan n))))))
(setq buffer-read-only t)
(goto-char (point-min)))
(init-message 3 "Functions: Table Generators: vga-colors-table")
(defun vga-colors-table ()
"Display a table of the VGA colors."
(interactive)
(let ((vga-colors
'((0 0 0) (0 0 170) (0 170 0) (0 170 170)
(170 0 0) (170 0 170) (170 85 0) (170 170 170)
(85 85 85) (85 85 255) (85 255 85) (85 255 255)
(255 85 85) (255 85 255) (255 255 85) (255 255 255)
(0 0 0) (20 20 20) (32 32 32) (44 44 44)
(56 56 56) (69 69 69) (81 81 81) (97 97 97)
(113 113 113) (130 130 130) (146 146 146) (162 162 162)
(182 182 182) (203 203 203) (227 227 227) (255 255 255)
(0 0 255) (65 0 255) (125 0 255) (190 0 255)
(255 0 255) (255 0 190) (255 0 125) (255 0 65)
(255 0 0) (255 65 0) (255 125 0) (255 190 0)
(255 255 0) (190 255 0) (125 255 0) (65 255 0)
(0 255 0) (0 255 65) (0 255 125) (0 255 190)
(0 255 255) (0 190 255) (0 125 255) (0 65 255)
(125 125 255) (158 125 255) (190 125 255) (223 125 255)
(255 125 255) (255 125 223) (255 125 190) (255 125 158)
(255 125 125) (255 158 125) (255 190 125) (255 223 125)
(255 255 125) (223 255 125) (190 255 125) (158 255 125)
(125 255 125) (125 255 158) (125 255 190) (125 255 223)
(125 255 255) (125 223 255) (125 190 255) (125 158 255)
(182 182 255) (199 182 255) (219 182 255) (235 182 255)
(255 182 255) (255 182 235) (255 182 219) (255 182 199)
(255 182 182) (255 199 182) (255 219 182) (255 235 182)
(255 255 182) (235 255 182) (219 255 182) (199 255 182)
(182 255 182) (182 255 199) (182 255 219) (182 255 235)
(182 255 255) (182 235 255) (182 219 255) (182 199 255)
(0 0 113) (28 0 113) (56 0 113) (85 0 113)
(113 0 113) (113 0 85) (113 0 56) (113 0 28)
(113 0 0) (113 28 0) (113 56 0) (113 85 0)
(113 113 0) (85 113 0) (56 113 0) (28 113 0)
(0 113 0) (0 113 28) (0 113 56) (0 113 85)
(0 113 113) (0 85 113) (0 56 113) (0 28 113)
(56 56 113) (69 56 113) (85 56 113) (97 56 113)
(113 56 113) (113 56 97) (113 56 85) (113 56 69)
(113 56 56) (113 69 56) (113 85 56) (113 97 56)
(113 113 56) (97 113 56) (85 113 56) (69 113 56)
(56 113 56) (56 113 69) (56 113 85) (56 113 97)
(56 113 113) (56 97 113) (56 85 113) (56 69 113)
(81 81 113) (89 81 113) (97 81 113) (105 81 113)
(113 81 113) (113 81 105) (113 81 97) (113 81 89)
(113 81 81) (113 89 81) (113 97 81) (113 105 81)
(113 113 81) (105 113 81) (97 113 81) (89 113 81)
(81 113 81) (81 113 89) (81 113 97) (81 113 105)
(81 113 113) (81 105 113) (81 97 113) (81 89 113)
(0 0 65) (16 0 65) (32 0 65) (48 0 65)
(65 0 65) (65 0 48) (65 0 32) (65 0 16)
(65 0 0) (65 16 0) (65 32 0) (65 48 0)
(65 65 0) (48 65 0) (32 65 0) (16 65 0)
(0 65 0) (0 65 16) (0 65 32) (0 65 48)
(0 65 65) (0 48 65) (0 32 65) (0 16 65)
(32 32 65) (40 32 65) (48 32 65) (56 32 65)
(65 32 65) (65 32 56) (65 32 48) (65 32 40)
(65 32 32) (65 40 32) (65 48 32) (65 56 32)
(65 65 32) (56 65 32) (48 65 32) (40 65 32)
(32 65 32) (32 65 40) (32 65 48) (32 65 56)
(32 65 65) (32 56 65) (32 48 65) (32 40 65)
(44 44 65) (48 44 65) (52 44 65) (60 44 65)
(65 44 65) (65 44 60) (65 44 52) (65 44 48)
(65 44 44) (65 48 44) (65 52 44) (65 60 44)
(65 65 44) (60 65 44) (52 65 44) (48 65 44)
(44 65 44) (44 65 48) (44 65 52) (44 65 60)
(44 65 65) (44 60 65) (44 52 65) (44 48 65)
(0 0 0) (0 0 0) (0 0 0) (0 0 0)
(0 0 0) (0 0 0) (0 0 0) (0 0 0)))
(color-names
'(("#000000" . "Black")
("#0000AA" . "Navy")
("#00AA00" . "Green")
("#00AAAA" . "Teal")
("#AA0000" . "Maroon")
("#AA00AA" . "Purple")
("#AA5500" . "Brown")
("#AAAAAA" . "Silver")
("#555555" . "Gray")
("#5555FF" . "Blue")
("#55FF55" . "Lime")
("#55FFFF" . "Cyan")
("#FF5555" . "Orange")
("#FF55FF" . "Magenta")
("#FFFF55" . "Yellow")
("#FFFFFF" . "White")
("#141414" . "Gray")
("#202020" . "Gray")
("#2C2C2C" . "Gray")
("#383838" . "Gray")
("#454545" . "Gray")
("#515151" . "Gray")
("#616161" . "Gray")
("#717171" . "Gray")
("#828282" . "Gray")
("#929292" . "Gray")
("#A2A2A2" . "Gray")
("#B6B6B6" . "Gray")
("#CBCBCB" . "Gray")
("#E3E3E3" . "Gray")
("#0000FF" . "Blue")
("#FF00FF" . "Magenta")
("#FF0000" . "Red")
("#FFFF00" . "Yellow")
("#00FF00" . "Green")
("#00FFFF" . "Cyan"))))
(switch-to-buffer "*VGA Color Table*")
(buffer-disable-undo)
(let (buffer-read-only)
(erase-buffer)
(insert "COLOR RGB (Decimal) RGB (Hex) HSV (0.0 - 1.0) NAME\n")
(insert "----- ------------- --------- --------------- ------------\n")
(dotimes (x (length vga-colors))
(let* ((rgb (nth x vga-colors))
(hex (apply #'format "#%02X%02X%02X" rgb))
(hsv (apply #'color-rgb-to-hsv (mapcar (lambda (x) (/ x 256.0)) rgb)))
(fg (readable-foreground-color hex))
(name (or (cdr (assoc-string hex color-names)) "")))
(insert (propertize
(format "%5d %3d, %3d, %3d %-9s %-15s %-12s\n"
x
(first rgb) (second rgb) (third rgb)
hex
(apply #'format "%.2f %.2f %.2f" hsv)
name)
'face `(:background ,hex :foreground ,fg))))))
(setq buffer-read-only t)
(goto-char (point-min))))
(init-message 2 "Functions: Programs")
(init-message 3 "Functions: Programs: Flesch Readability Index")
(defun flesch-readability-index (&optional beg end)
"Compute the Flesch Readability Index of the current region or entire buffer.
The Flesch Readability Index is defined on wikipedia here:
http://en.wikipedia.org/wiki/Flesch-Kincaid_Readability_Test
This function provides that index following the guidelines presented here:
http://cs.boisestate.edu/~amit/teaching/125/lab/p4.html
Guidelines:
- Count all words in the text. A word is any sequence of
characters delimited by white space, whether or not it is an
actual English word.
- Count all syllables in each word. To make this simple, use
the following rules. Each group of adjacent
vowels (a,e,i,o,u,y) counts as one syllable (for example, the
\"ea\" in \"real\" contributes one syllable, but the \"e..a\"
in \"regal\" count as two syllables). However, an \"e\" at
the end of a word doesn't count as a syllable. For example,
the word \"eagle\" would be one syllable by Flesch's rules.
However, the word \"intrigue\" is three syllables (since the
e is preceded by a vowel). Also, each word has at least one
syllable, even if the previous rules give a count of zero.
- Count all sentences. A sentence is ended by a period, colon,
semicolon, questions mark, or exclamation mark.
- The index is computed by:
index = 206.835 - (1.015 * words / sentences) - (84.6 * syllables / words)
- Index should be rounded to the nearest integer.
The index is a number, usually between 0 and 100, indicating how
difficult the text is to read."
(interactive)
(cl-labels
((count-words (beg end)
(how-many "\\w+" beg end))
(count-sentences (beg end)
(how-many "[\.\:\;\?\!]\\W" beg end))
(count-syllables (beg end)
(let ((letter-regexp "[A-Za-z]")
(vowel-regexp "[AEIOUYaeiouy]")
(e-end-regexp "[Ee]\\W"))
(save-mark-and-excursion
(let ((count 0))
(goto-char beg)
(while (< (point) end)
(while (and (< (point) end)
(not (looking-at letter-regexp)))
(forward-char 1))
(let ((state (if (looking-at vowel-regexp) 2 1)))
(when (= state 2)
(setq count (1+ count)))
(while (looking-at letter-regexp)
(if (and (= state 1)
(looking-at vowel-regexp)
(not (looking-at e-end-regexp)))
(setq state 2
count (1+ count))
(if (and (= state 2)
(not (looking-at vowel-regexp)))
(setq state 1)))
(forward-char 1))))
count)))))
(let* ((beg (or beg (if (use-region-p) (region-beginning) (point-min))))
(end (or end (if (use-region-p) (region-end) (point-max))))
(words (count-words beg end))
(sentences (count-sentences beg end))
(syllables (count-syllables beg end))
(index (round (- 206.835
(/ (* 1.015 words) (if (> sentences 0) sentences 1))
(/ (* 84.6 syllables) (if (> words 0) words 1)))))
(index-desc
(cond
((> index 90) "5th grader")
((> index 80) "6th grader")
((> index 70) "7th grader")
((> index 65) "8th grader")
((> index 60) "9th grader")
((> index 50) "High school student")
((> index 30) "College student")
((>= index 0) "College graduate")
(t "Law school graduate"))))
(message "Words: %s, Sentences: %s, Syllables %s, Flesch Readability Index: %s (%s)"
words sentences syllables index index-desc)
index)))
(init-message 3 "Functions: Programs: Phone Number Words")
(defun phone-number-words (num &optional word-file)
"Convert phone number NUM into word strings that may be used instead.
Single digits may appear between words.
WORD-FILE defaults to `/usr/share/dict/words'."
(interactive "sPhone number: ")
(let ((word-file (or word-file "/usr/share/dict/words")))
(defun file-to-string (file)
(with-temp-buffer
(insert-file-contents file)
(buffer-string)))
(defun string-to-list (string)
(cl-loop for x across string collect x))
(defun list-to-string (list)
(mapconcat 'string list ""))
(unless (file-exists-p word-file)
(user-error "Word file does not exist: %s" word-file))
(let* ((words (split-string (file-to-string word-file))) (word-hash (make-hash-table :size (length words))) (letter-digit '((?A . ?2) (?B . ?2) (?C . ?2)
(?D . ?3) (?E . ?3) (?F . ?3)
(?G . ?4) (?H . ?4) (?I . ?4)
(?J . ?5) (?K . ?5) (?L . ?5)
(?M . ?6) (?N . ?6) (?O . ?6)
(?P . ?7) (?Q . ?7) (?R . ?7) (?S . ?7)
(?T . ?8) (?U . ?8) (?V . ?8)
(?W . ?9) (?X . ?9) (?Y . ?9) (?Z . ?9)))) (dolist (word words)
(let* ((letters (string-to-list (upcase word)))
(number (list-to-string (mapcar (lambda (x) (char-to-string (cdr (assoc x letter-digit)))) letters))))
(setf (gethash number word-hash) word))))))
(init-message 3 "Functions: Programs: Keyboard Cat Mode")
(defvar keyboard-cat-overlay nil)
(defun keyboard-cat-next ()
(interactive)
(move-overlay keyboard-cat-overlay
(goto-char (min (1+ (overlay-start keyboard-cat-overlay))
(point-max)))
(overlay-end keyboard-cat-overlay)))
(defvar keyboard-cat-mode-map
(let ((map (make-sparse-keymap)))
(define-key map [remap self-insert-command] 'keyboard-cat-next)
(define-key map [remap keyboard-quit] 'keyboard-cat-mode)
map))
(define-minor-mode keyboard-cat-mode
"Minor mode that slowly exposes current buffer as keys are pressed."
:init nil
:keymap keyboard-cat-mode-map
(if keyboard-cat-mode
(overlay-put
(setq-local keyboard-cat-overlay
(make-overlay (point-min) (point-max)))
'invisible t)
(delete-overlay keyboard-cat-overlay)))
(init-message 3 "Functions: Programs: Keyboard Display Mode")
(defvar keyboard-display-process-name "gxmessage")
(defvar keyboard-display-key-log nil)
(defvar keyboard-display-key-log-width 0)
(defvar keyboard-display-key-log-size 10
"Maximum number of key presses to keep in the log.")
(defvar keyboard-display-key-log-duration 5
"Number of seconds to keep key presses in the key log.")
(defvar keyboard-display-message-duration 5
"Number of seconds to keep key press display showing.")
(defvar keyboard-display-last-key "")
(defvar keyboard-display-last-key-count 1)
(defun keyboard-display-key-press ()
"Display current key press using gxmessage."
(let ((key (concat (if current-prefix-arg
(concat current-prefix-arg " ")
"")
(symbol-name this-command))))
(when keyboard-display-key-log
(if (< (caar (reverse keyboard-display-key-log))
(- (float-time (current-time)) keyboard-display-key-log-duration))
(setq keyboard-display-key-log nil
keyboard-display-key-log-width 0
keyboard-display-last-key ""
keyboard-display-last-key-count 1)
(when (>= (length keyboard-display-key-log) keyboard-display-key-log-size)
(pop keyboard-display-key-log))))
(if (string= keyboard-display-last-key key)
(setq key (concat key " x " (number-to-string (cl-incf keyboard-display-last-key-count))))
(setq keyboard-display-last-key key
keyboard-display-last-key-count 1))
(when (> (length key) keyboard-display-key-log-width)
(setq keyboard-display-key-log-width (length key)))
(setq key (substring (concat key (make-string keyboard-display-key-log-width ? ))
0 keyboard-display-key-log-width))
(if (> keyboard-display-last-key-count 1)
(setcdr (car (last keyboard-display-key-log)) key)
(setq keyboard-display-key-log (append keyboard-display-key-log
(list (cons (float-time (current-time)) key)))))
(let ((msg (mapconcat (lambda (x) (cdr x)) keyboard-display-key-log "\n")))
(start-process keyboard-display-process-name nil
"gxmessage" "-borderless" "-nofocus" "-center"
"-timeout" (int-to-string keyboard-display-message-duration)
"-buttons" "" "-fn" "mono 32" msg))))
(defvar keyboard-display-mode-map
(let ((map (make-sparse-keymap)))
map))
(define-minor-mode keyboard-display-mode
"Minor mode that displays every key press in a pop-up message."
:init nil
:keymap keyboard-display-mode-map
(if keyboard-display-mode
(add-hook 'pre-command-hook #'keyboard-display-key-press)
(remove-hook 'pre-command-hook 'keyboard-display-key-press)))
(init-message 3 "Functions: Programs: Star Wars Scroll")
(defvar star-wars-scroll-substitution-list
'(("." . 0)
(" " . 0)
("[.,;:!?] " . 1)
("\\B[aeiou]\\B" . 0)
("\\B[bcdfghjklmnpqrstvwxyz]\\B" . 0)
("\\w\\b" . 0)
("[.,;:!?]" . 0)
("[^.,;:!?] " . 1)
("\\b\\w" . 0)
(".$" . 0)
("^." . 0))
"A list of dotted pairs with car equal to the regex matching
the character we want to delete and cdr equal to how many
characters we want to move the point forward before actually
deleting a character (useful in the case of space after a
punctuation). We begin with the substitutions we want to perform
first. If more than one regex matches, the last one is valid, so
it is probably a good idea to begin with \".\".")
(defun star-wars-scroll-center-line-no-tabs ()
"A simplified version of center-line, using no tabs (and not
taking into account leading/trailing whitespace."
(save-mark-and-excursion
(let ((length (progn (end-of-line)
(current-column))))
(forward-line 0)
(insert (make-string (max 0 (/ (- fill-column length) 2)) ?\s)))))
(defun star-wars-scroll-scroll-prepare-marker-list ()
"Prepare (and return) a list of markers pointing at characters
to delete from the current line, in the \"right\" order."
(save-mark-and-excursion
(save-match-data
(let ((limit (progn
(star-wars-scroll-center-line-no-tabs) (back-to-indentation)
(point)))
(subst-list star-wars-scroll-substitution-list)
(marker-list nil))
(while subst-list
(end-of-line)
(while (search-backward-regexp (caar subst-list) limit :noerror)
(forward-char (cdar subst-list))
(push (point-marker) marker-list))
(setq subst-list (cdr subst-list)))
(delete-dups marker-list)
(setq marker-list (nreverse marker-list))))))
(defvar star-wars-scroll-untouched-lines 3
"Number of lines at the bottom of the window which should not
be touched by character deletion.")
(defvar star-wars-scroll-delay .5
"Delay (in seconds) between frames of animation.")
(defun star-wars-scroll-scroll-current-buffer ()
"Actually do SW-like scroll in the current buffer."
(let (marker-list-list)
(goto-char (point-min))
(open-line (window-height))
(goto-char (point-max))
(move-beginning-of-line 0)
(while (progn
(push (star-wars-scroll-scroll-prepare-marker-list) marker-list-list)
(> (point) (+ (point-min) (window-height))))
(forward-line -1))
(while (< (point-min) (point-max)) (goto-char (point-min))
(kill-line 1)
(redisplay t)
(sleep-for star-wars-scroll-delay)
(let ((walker marker-list-list))
(while (progn
(goto-char (or (caar walker) (point-min)))
(and walker (< (line-number-at-pos) (- (window-height) star-wars-scroll-untouched-lines))))
(when (car walker)
(goto-char (caar walker))
(delete-char 1)
(setf (car walker) (cdar walker)))
(when (car walker)
(goto-char (caar walker))
(delete-char 1)
(setf (car walker) (cdar walker))
(forward-line 0)
(insert " "))
(setq walker (cdr walker)))))))
(defun star-wars-scroll ()
"Do Star-Wars-like scroll of the region, or the whole buffer if
no region is active, in a temporary buffer, and delete it
afterwards. Special care is taken to make the lines more or
less legible as long as possible, for example spaces after
punctuation are deleted before vowels, vowels are deleted
before consonants etc."
(interactive)
(save-mark-and-excursion
(let ((begin (point-min)) (end (point-max)))
(when (region-active-p)
(setq beg (region-beginning))
(setq end (region-end)))
(copy-region-as-kill beg end)
(with-temp-buffer
(switch-to-buffer (current-buffer))
(rename-buffer "*Star Wars Scroll*")
(buffer-disable-undo)
(untabify (point-min) (point-max))
(save-window-excursion
(delete-other-windows)
(yank)
(star-wars-scroll-scroll-current-buffer))))))
(init-message 2 "Functions: Games")
(init-message 3 "Functions: Games: Towers of Hanoi")
(defun towers (disks)
"Solve the clasical Towers of Hanoi problem for given number of DISKS."
(interactive "NNumber of disks: ")
(let ((buffer "*Towers*"))
(get-buffer-create buffer)
(set-buffer buffer)
(setq buffer-read-only nil)
(erase-buffer)
(insert (format "Towers of Hanoi puzzle with %d disks\n\n" disks))
(towers-move disks 1 3 2)
(setq buffer-read-only t)
(switch-to-buffer buffer)
(goto-char (point-min)))
(values))
(defun towers-move (n from to using)
"Make one Towers of Hanoi move.
N is the number of disks to move.
FROM is the source peg.
TO is the target peg.
USING is the remaining peg."
(when (> n 0)
(towers-move (1- n) from using to)
(insert (format "Move %d --> %d\n" from to))
(towers-move (1- n) using to from)))
(init-message 1 "Completions")
(init-message 2 "Completions: vertico/consult/corfu")
(init-message 3 "Completions: vertico/consult/company: vertico")
(use-package vertico
:straight t
:after (compat)
:demand t
:bind (:map vertico-map
("C-<return>" . vertico-exit-input) ("M-<return>" . vertico-exit-input) ("C-M-i" . vertico-scroll-down) ("C-M-k" . vertico-scroll-up)) :init
(vertico-mode))
(init-message 3 "Completions: vertico/consult/company: orderless")
(use-package orderless
:straight t
:after (vertico)
:custom
(completion-styles '(orderless))
(completion-category-overrides '((file (styles partial-completion)))))
(init-message 3 "Completions: vertico/consult/company: marginalia")
(use-package marginalia
:straight t
:after (vertico)
:init
(marginalia-mode))
(init-message 3 "Completions: vertico/consult/company: consult")
(use-package consult
:straight (consult-custom
:type git
:host github
:repo "minad/consult"
:pre-build "git checkout 0.17")
:after (vertico)
:bind ( ("C-c h" . consult-history)
("C-c m" . consult-mode-command)
("C-c k" . consult-kmacro))
:bind* (
("C-'" . consult-line) ("C-x M-:" . consult-complex-command) ("C-x b" . consult-buffer) ("C-x 4 b" . consult-buffer-other-window) ("C-x 5 b" . consult-buffer-other-frame) ("C-x r b" . consult-bookmark) ("C-x p b" . consult-project-buffer) ("M-#" . consult-register-load) ("M-'" . consult-register-store) ("C-M-#" . consult-register)
("M-y" . consult-yank-pop) ("<help> a" . consult-apropos) ("M-g e" . consult-compile-error)
("M-g f" . consult-flycheck)
("M-g F" . consult-flymake)
("M-g g" . consult-goto-line) ("M-g M-g" . consult-goto-line) ("M-g o" . consult-org-heading) ("M-g m" . consult-mark)
("M-g k" . consult-global-mark)
("M-g i" . consult-imenu)
("M-g I" . consult-imenu-multi)
("M-s d" . consult-find)
("M-s D" . consult-locate)
("M-s g" . consult-grep)
("M-s G" . consult-git-grep)
("M-s r" . consult-ripgrep)
("M-s l" . consult-line)
("M-s L" . consult-line-multi)
("M-s m" . consult-multi-occur)
("M-s k" . consult-keep-lines)
("M-s u" . consult-focus-lines)
("M-s e" . consult-isearch-history)
:map isearch-mode-map
("M-e" . consult-isearch-history) ("M-s e" . consult-isearch-history) ("M-s l" . consult-line) ("M-s L" . consult-line-multi) :map minibuffer-local-map
("M-s" . consult-history) ("M-r" . consult-history)) :hook (completion-list-mode . consult-preview-at-point-mode)
:init
(setq register-preview-function #'consult-register-format
register-preview-delay 0.5)
(advice-add 'register-preview :override #'consult-register-window)
(setq xref-show-xrefs-function #'consult-xref
xref-show-definitions-function #'consult-xref)
:config
(consult-customize
consult-theme
:preview-key '(:debounce 0.2 any)) (setq consult-narrow-key "<") (define-key consult-narrow-map (vconcat consult-narrow-key "?") #'consult-narrow-help)
(defun force-completing-read-default (orig-fun &rest args)
"Force a function to use `completing-read-default'."
(let ((completing-read-function 'completing-read-default))
(apply orig-fun args)))
(advice-add 'tmm-prompt :around #'force-completing-read-default)
(advice-add 'yas-expand-snippet :around #'force-completing-read-default))
(init-message 1 "cape")
(use-package cape
:straight t
:bind (("C-c p p" . completion-at-point) ("C-c p t" . complete-tag) ("C-c p d" . cape-dabbrev) ("C-c p h" . cape-history)
("C-c p f" . cape-file)
("C-c p k" . cape-keyword)
("C-c p s" . cape-symbol)
("C-c p a" . cape-abbrev)
("C-c p l" . cape-line)
("C-c p w" . cape-dict)
("C-c p \\" . cape-tex)
("C-c p _" . cape-tex)
("C-c p ^" . cape-tex)
("C-c p &" . cape-sgml)
("C-c p r" . cape-rfc1345))
:init
(add-to-list 'completion-at-point-functions #'cape-dabbrev)
(add-to-list 'completion-at-point-functions #'cape-file)
(add-to-list 'completion-at-point-functions #'cape-history)
(add-to-list 'completion-at-point-functions #'cape-keyword)
(add-to-list 'completion-at-point-functions #'cape-rfc1345)
:config
(when (version<= "29.0" emacs-version)
(advice-add 'pcomplete-completions-at-point :around #'cape-wrap-silent)
(advice-add 'pcomplete-completions-at-point :around #'cape-wrap-purify)))
(init-message 1 "Packages")
(init-message 2 "Modules: abbrev-mode")
(use-package abbrev
:straight (:type built-in)
:diminish abbrev-mode
:custom
(save-abbrevs 'silently)
:init
(defconst abbrev-file
(file-truename (expand-file-name "~/.abbrev_defs"))
"Abbreviations file used by `abbrev-mode'.")
(unless (file-exists-p abbrev-file)
(with-temp-buffer (write-file abbrev-file)))
(abbrev-mode 1)
:config
(setq dabbrev-case-replace nil) (quietly-read-abbrev-file abbrev-file)
(defun custom-kill-emacs-hook-write-abbrev-file ()
(write-abbrev-file abbrev-file))
(add-hook 'kill-emacs-hook #'custom-kill-emacs-hook-write-abbrev-file))
(init-message 2 "Modules: ag")
(use-package ag
:straight t
:commands (ag)
:custom
(ag-arguments (list "--smart-case" "--stats")))
(init-message 2 "Modules: alert")
(use-package alert
:straight t
:commands (alert)
:custom
(alert-default-style 'libnotify))
(init-message 2 "Modules: analog-clock")
(use-package analog-clock
:load-path (lambda () (file-truename (expand-file-name "analog-clock.el" emacs-modules-dir)))
:commands (analog-clock analog-clock-draw-analog)
:custom
(analog-clock-draw-function #'analog-clock-draw-analog)
:init
)
(init-message 2 "Modules: any-ini-mode")
(use-package any-ini-mode
:load-path (lambda () (file-truename (expand-file-name "any-ini-mode.el" emacs-modules-dir))))
(init-message 2 "Modules: async")
(use-package async
:straight t)
(init-message 2 "Modules: auto-compile")
(use-package auto-compile
:straight t
:custom
(load-prefer-newer t)
:init
(auto-compile-on-load-mode 1)
(auto-compile-on-save-mode 1))
(init-message 2 "Modules: avy")
(use-package avy
:straight t
:bind* (("C-;" . avy-goto-char)
("C-:" . avy-goto-word-or-subword-1)
("C-M-;" . pop-to-mark-command)))
(init-message 2 "Modules: bash-completion")
(use-package bash-completion
:straight t
:init (bash-completion-setup))
(init-message 2 "Modules: beacon")
(use-package beacon
:straight t
:demand t
:custom
(beacon-blink-duration 0.1)
(beacon-blink-delay 0.1)
:init (beacon-mode 1))
(init-message 2 "Modules: boxquote")
(use-package boxquote
:straight t
:init (unbind-key "C-c b")
:bind (("C-c by" . boxquote-yank)
("C-c br" . boxquote-region)
("C-c bu" . boxquote-unbox-region)
("C-c bt" . boxquote-title)
("C-c bi" . boxquote-insert-file)
("C-c bk" . boxquote-kill)
("C-c bs" . boxquote-shell-command)
("C-c bb" . boxquote-buffer)
("C-c bp" . boxquote-paragraph)
("C-c bn" . boxquote-narrow-to-boxquote)
("C-c bw" . boxquote-where-is)
("C-c bdf" . boxquote-describe-function)
("C-c bdk" . boxquote-describe-key)
("C-c bdv" . boxquote-describe-variable)))
(init-message 2 "Modules: browse-kill-ring")
(use-package browse-kill-ring
:straight t
:bind* (("C-M-y" . browse-kill-ring)
("C-M-_" . browse-kill-ring)))
(init-message 2 "Modules: bs")
(use-package bs
:straight t
:demand t
:after (cycle-buffer)
:commands (list-buffers bs-show)
:bind* (([remap list-buffers] . bs-show) ("C-x C-b" . bs-show)) :bind (:map bs-mode-map
("C-n" . bs-down)
("C-p" . bs-up))
:config
(defvar custom-bs-always-show-regexps
(list
(rx (seq bos "*" (or "scratch" "info" "grep") "*" eos)))
"*Buffer regexps to always show when buffer switching.")
(defvar custom-bs-never-show-regexps
(list
(rx (or (seq bos space)
(seq bos "*")
(seq "TAGS" eos)
(seq bos "Map_Sym.txt" eos)
(seq bos "magit"))))
"*Buffer regexps to never show when buffer switching.")
(defvar custom-ido-ignore-dired-buffers nil
"*If non-nil, buffer switching should ignore dired buffers.")
(defun custom-bs-string-in-regexps (string regexps)
"Return non-nil if STRING matches anything in REGEXPS list."
(let ((case-fold-search nil))
(catch 'done
(dolist (regexp regexps)
(when (string-match regexp string)
(throw 'done t))))))
(defun custom-bs-ignore-buffer (buffer)
"Return non-nil if BUFFER should be ignored."
(or (and (not (custom-bs-string-in-regexps buffer custom-bs-always-show-regexps))
(custom-bs-string-in-regexps buffer custom-bs-never-show-regexps))
(and custom-ido-ignore-dired-buffers
(with-current-buffer buffer
(equal major-mode 'dired-mode)))))
(defun bs-toggle-recent ()
"Toggle most recently visited buffers, ignoring certain ones."
(interactive)
(catch 'done
(dolist (buffer (buffer-list))
(unless (or (equal (current-buffer) buffer)
(and (fboundp 'my-bs-ignore-buffer)
(my-bs-ignore-buffer (buffer-name buffer))))
(switch-to-buffer buffer)
(throw 'done t)))))
(setq bs-configurations
'(("all" nil nil nil nil nil)
("files" nil nil nil (lambda (buffer) (custom-bs-ignore-buffer (buffer-name buffer))) nil))
bs-cycle-configuration-name "files")
(defun custom-bs-cycle-buffer-filter-extra ()
"Add ignore rules to `cycle-buffer'."
(not (custom-bs-ignore-buffer (buffer-name))))
(add-to-list 'cycle-buffer-filter-extra '(custom-bs-cycle-buffer-filter-extra) t)
(defun bs--up ()
"Move point vertically up one line."
(when (> (count-lines 1 (point)) bs-header-lines-length)
(forward-line -1)))
(defun bs--down ()
"Move point vertically down one line."
(if (< (line-end-position) (point-max))
(forward-line 1))))
(init-message 2 "Modules: calc")
(use-package calc
:straight (:type built-in)
:commands (calc calc-dispatch)
:bind* ("M-#" . calc-dispatch))
(init-message 2 "Packages: casual")
(use-package casual
:straight (casual
:type git
:host github
:repo "kickingvegas/casual"))
(init-message 2 "Packages: casual-calc")
(use-package casual-calc
:straight (casual-calc
:type git
:host github
:repo "kickingvegas/casual-calc")
:after (calc casual-lib)
:bind (:map calc-mode-map
("C-o" . casual-calc-tmenu))
:bind (:map calc-alg-map
("C-o" . casual-calc-tmenu)))
(init-message 2 "Packages: casual-dired")
(use-package casual-dired
:straight (casual-dired
:type git
:host github
:repo "kickingvegas/casual-dired")
:after (dired casual-lib)
:bind (:map dired-mode-map
("C-o" . casual-dired-tmenu)
("s" . casual-dired-sort-by-tmenu)
("/" . casual-dired-search-replace-tmenu)))
(init-message 2 "Modules: cedet/semantic")
(use-package cedet
:straight (:type built-in))
(use-package semantic
:straight (:type built-in)
:after (cedet)
:init (semantic-mode 1))
(init-message 2 "Packages: cheat-sh")
(use-package cheat-sh
:straight t)
(init-message 2 "Modules: command-log")
(use-package command-log-mode
:straight t
:demand t
:custom
(command-log-mode-auto-show t)
(command-log-mode-key-binding-open-log nil)
(command-log-mode-open-log-turns-on-mode t)
(command-log-mode-is-global t)
:config
(defun command-log-mode-on ()
"Turn on `command-log-mode' and open the log buffer."
(interactive)
(global-command-log-mode 1))
(defun command-log-mode-off ()
"Turn off `command-log-mode' and close the log buffer."
(interactive)
(global-command-log-mode -1)))
(init-message 2 "Modules: compile")
(use-package compile
:straight (:type built-in)
:custom
(compilation-ask-about-save nil)
(compilation-scroll-output 'next-error)
(compilation-skip-threshold 2)
:config
(make-variable-buffer-local 'custom-compilation-start-time)
(defun custom-compilation-start-hook (proc)
(setq custom-compilation-start-time (current-time)))
(add-hook 'compilation-start-hook #'custom-compilation-start-hook)
(defun custom-compilation-finish-function (buf why)
(let* ((elapsed (time-subtract nil custom-compilation-start-time))
(msg (format "Compilation took: %s" (format-time-string "%T.%N" elapsed t))))
(save-excursion (goto-char (point-max)) (insert msg))
(message "Compilation %s: %s" (string-trim-right why) msg)))
(add-hook 'compilation-finish-functions #'custom-compilation-finish-function))
(init-message 2 "Modules: cycle-buffer")
(use-package cycle-buffer
:load-path (lambda () (file-truename (expand-file-name "cycle-buffer.el" emacs-modules-dir)))
:demand t
:bind* (("C-x C-n" . cycle-buffer) ("C-x C-p" . cycle-buffer-backward) ("<f9>" . cycle-buffer-backward)
("S-<f9>" . cycle-buffer-backward-permissive)
("<f10>" . cycle-buffer) ("S-<f10>" . cycle-buffer-permissive))
:init
(advice-add 'cycle-buffer :around #'advice--ignore-interactive-errors)
(advice-add 'cycle-buffer-permissive :around #'advice--ignore-interactive-errors)
(advice-add 'cycle-buffer-backward :around #'advice--ignore-interactive-errors)
(advice-add 'cycle-buffer-backward-permissive :around #'advice--ignore-interactive-errors))
(init-message 2 "Modules: decide")
(use-package decide
:straight t)
(init-message 2 "Modules: demo-it")
(use-package demo-it
:straight t)
(init-message 2 "Modules: doom-modeline")
(use-package doom-modeline
:straight t
:after (all-the-icons nerd-icons)
:demand t
:custom
(doom-modeline-height 30)
:init
(doom-modeline-mode 1)
:config
(line-number-mode 1)
(column-number-mode 1))
(init-message 3 "all-the-icons")
(use-package all-the-icons
:straight t)
(init-message 3 "nerd-icons")
(use-package nerd-icons
:straight (nerd-icons
:type git
:host github
:repo "rainstormstudio/nerd-icons.el")
:custom
(nerd-icons-font-family "Symbols Nerd Font Mono"))
(use-package easy-kill
:straight t
:demand t
:bind* (([remap kill-ring-save] . easy-kill)
([remap mark-sexp] . easy-mark)))
(init-message 2 "Packages: eat")
(use-package eat
:straight (eat
:type git
:host codeberg
:repo "akib/emacs-eat"
:files ("*.el" ("term" "term/*.el") "*.texi"
"*.ti" ("terminfo/e" "terminfo/e/*")
("terminfo/65" "terminfo/65/*")
("integration" "integration/*")
(:exclude ".dir-locals.el" "*-tests.el"))))
(init-message 2 "Packages: editorconfig")
(use-package editorconfig
:straight t
:config
(editorconfig-mode 1))
(init-message 2 "Modules: eldoc")
(use-package eldoc
:straight (:type built-in)
:custom
(eldoc-idle-delay 0))
(init-message 2 "Modules: elfeed")
(use-package elfeed
:straight t
:commands (elfeed-bookmarks-edit)
:bind (:map elfeed-search-mode-map
("h" . elfeed-search-mode-help)
("?" . elfeed-search-mode-help))
:bind (:map elfeed-show-mode-map
("h" . elfeed-show-mode-help)
("?" . elfeed-show-mode-help))
:custom
(elfeed-use-curl nil)
(elfeed-curl-max-connections 6)
(elfeed-search-filter "-junk +unread")
(elfeed-feeds
(with-temp-buffer
(insert-file-contents (locate-user-emacs-file "elfeed-bookmarks"))
(goto-char (point-min))
(mapcar
(lambda (x) (list (plist-get x :rss) (intern (plist-get x :tag))))
(read (current-buffer)))))
:config
(defun custom-elfeed-show-mode-hook ()
(text-scale-set 2))
(add-hook 'elfeed-show-mode-hook #'custom-elfeed-show-mode-hook)
(defun elfeed-bookmarks-edit ()
"Open `init-emacs.org' and move point to Elfeed Bookmarks File for easy editing."
(interactive)
(find-file (file-truename (expand-file-name "init-emacs.org" emacs-home-dir)))
(goto-char (point-min))
(search-forward ";; Elfeed Bookmarks File\n")
(org-show-entry)
(recenter-top-bottom scroll-margin))
(defun elfeed-search-mode-help ()
"Display `elfeed-search-mode' commands in mini-buffer."
(interactive)
(message (concat "RET show entry, "
"+ tag all, "
"- untag all, "
"G fetch, "
"S set filter, "
"b browse url, "
"g update, "
"n next line, "
"p prev line, "
"q quit, "
"r untag unread, "
"s live filter, "
"u tag unread, "
"y yank")))
(defun elfeed-show-mode-help ()
"Display `elfeed-show-mode' commands in mini-buffer."
(interactive)
(message (concat "TAB next link, "
"BACKTAB previous link, "
"SPC scroll down, "
"BACKSPACE scroll up,"
"+ tag, "
"- untag, "
"P play enclosure, "
"b visit, "
"d save enclosure, "
"g refresh, "
"n next, "
"p prev, "
"q kill buffer, "
"s new live search, "
"u copy url, "
"y yank")))
(defun elfeed-bookmarks-to-opml ()
"Export Elfeed Bookmarks File to OPML."
(interactive)
(let* ((buffer (generate-new-buffer-name "*elfeed-bookmarks-opml*"))
(bookmarks
(with-temp-buffer
(insert-file-contents (locate-user-emacs-file "elfeed-bookmarks"))
(goto-char (point-min))
(read (current-buffer))))
(tags
(let (temp)
(dolist (x (mapcar (lambda (x) (plist-get x :tag)) bookmarks))
(cl-pushnew x temp :test #'string=))
(nreverse temp))))
(switch-to-buffer buffer)
(insert "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n")
(insert "<opml version=\"1.0\">\n")
(insert " <head>\n")
(insert " <title>Elfeed Bookmarks</title>\n")
(insert " </head>\n")
(insert " <body>\n")
(dolist (tag tags)
(let ((ctag (capitalize tag)))
(insert " <outline title=\"" ctag "\" text=\"" ctag "\">\n")
(dolist (item
(remove-if
(lambda (x) (not (string= tag (plist-get x :tag))))
bookmarks))
(let ((name (plist-get item :name))
(html (plist-get item :html))
(rss (plist-get item :rss)))
(insert " <outline title=\"" name "\" text=\"" name "\" type=\"rss\" xmlUrl=\"" rss "\" htmlUrl=\"" html "\"/>\n")))
(insert " </outline>\n")))
(insert " </body>\n")
(insert "</opml>\n"))))
(init-message 2 "Packages: elfeed-tube")
(use-package elfeed-tube
:straight t
:after elfeed
:bind (:map elfeed-search-mode-map
("F" . elfeed-tube-fetch)
([remap save-buffer] . elfeed-tube-save))
:bind (:map elfeed-show-mode-map
("F" . elfeed-tube-fetch)
([remap save-buffer] . elfeed-tube-save))
:config
(elfeed-tube-setup))
(init-message 2 "Packages: ellama")
(use-package ellama
:straight t
:after llm-ollama
:init
(setopt ellama-keymap-prefix "C-c e")
(setopt ellama-language "English")
(setopt ellama-auto-scroll t)
(setopt ellama-long-lines-length 80)
(setopt ellama-fill-paragraphs t)
(setopt ellama-naming-scheme 'ellama-generate-name-by-time)
(setopt ellama-provider
(make-llm-ollama
:chat-model "llama2-uncensored:latest"
:embedding-model "nomic-embed-text"
:default-chat-non-standard-params '(("num_ctx" . 8192))))
(setopt ellama-translation-provider (make-llm-ollama
:chat-model "phi3:14b"
:embedding-model "nomic-embed-text"))
(setopt ellama-providers
'(("llama2-uncensored" . (make-llm-ollama
:chat-model "llama2-uncensored:latest"
:embedding-model "nomic-embed-text"
:default-chat-non-standard-params '(("num_ctx" . 8192))))
("codellama" . (make-llm-ollama
:chat-model "codellama:7b"
:embedding-model "nomic-embed-text"
:default-chat-non-standard-params '(("num_ctx" . 8192))))
("llama3:8b" . (make-llm-ollama
:chat-model "llama3:8b"
:embedding-model "nomic-embed-text"
:default-chat-non-standard-params '(("num_ctx" . 8192))))
("llama3-chatqa" . (make-llm-ollama
:chat-model "llama3-chatqa"
:embedding-model "nomic-embed-text"
:default-chat-non-standard-params '(("num_ctx" . 8192)))))))
(init-message 2 "Modules: elnode")
(use-package elnode
:straight t
:commands (elnode))
(init-message 2 "Modules: elpher")
(use-package elpher
:straight t
:init
(defun elpher-bookmarks-edit ()
"Open `init-emacs.org' and move point to Elpher Bookmarks File for easy editing."
(interactive)
(find-file (file-truename (expand-file-name "init-emacs.org" emacs-home-dir)))
(goto-char (point-min))
(search-forward ";;;; Emacs Bookmark")
(org-show-entry)
(recenter-top-bottom scroll-margin)))
(init-message 2 "Packages: emacs-everywhere")
(use-package emacs-everywhere
:straight t)
(init-message 2 "Packages: epaint")
(use-package epaint
:straight (epaint
:type git
:host github
:repo "chuntaro/epaint"))
(init-message 2 "Modules: eperiodic")
(use-package eperiodic
:load-path (lambda () (file-truename (expand-file-name "eperiodic.el" emacs-modules-dir)))
:commands (eperiodic))
(init-message 2 "Packages: epg/epa")
(use-package epg
:straight (:type built-in)
:custom
(epa-file-cache-passphrase-for-symmetric-encryption t)
(epg-pinentry-mode 'loopback))
(init-message 2 "Modules: epoch")
(use-package epoch
:load-path (lambda () (file-truename (expand-file-name "epoch.el" local-modules-dir)))
:commands (epoch time-to-epoch epoch-to-time))
(init-message 2 "Modules: ert")
(use-package ert
:straight (:type built-in))
(init-message 2 "Modules: exec-path-from-shell")
(use-package exec-path-from-shell
:when window-system-mac
:straight t
:init (exec-path-from-shell-initialize))
(init-message 2 "Modules: expand-region")
(use-package expand-region
:straight t
:bind* (("C-=" . er/expand-region) ("C-+" . er/contract-region)))
(init-message 2 "Modules: flycheck")
(use-package flycheck
:straight t
:hook (after-init . global-flycheck-mode))
(init-message 3 "flycheck-package")
(use-package flycheck-package
:straight t
:after (flycheck)
:config
(flycheck-package-setup))
(init-message 2 "Modules: flymake-cursor")
(use-package flymake-cursor
:straight t)
(init-message 2 "Modules: flyspell")
(use-package flyspell
:straight (:type built-in)
:commands (flyspell-mode
flyspell-mode-off
flyspell-prog-mode)
:custom
(flyspell-issue-welcome-flag nil)
(flyspell-sort-corrections nil)
(flyspell-use-meta-tab nil))
(init-message 2 "Modules: fuzzy")
(use-package fuzzy
:straight t
:commands (turn-on-fuzzy-isearch)
:init (turn-on-fuzzy-isearch))
(init-message 2 "Packages: game-master-assistant")
(use-package game-master-assistant
:load-path (lambda () (file-truename (expand-file-name "~/code/github-nullman/emacs-game-master-assistant")))
:commands (game-master-assistant-random-query))
(defun game-master-assistant-insert-names (arg)
"Insert ARG number of randomly generated names at point."
(interactive "p")
(dotimes (_ arg)
(insert (format "%s\n" (game-master-assistant-random-query "generated-name")))))
(defun game-master-assistant-insert-short-names (arg)
"Insert ARG number of randomly generated short names at point."
(interactive "p")
(dotimes (_ arg)
(insert (format "%s\n" (game-master-assistant-random-query "generated-name-short")))))
(defun game-master-assistant-insert-medium-names (arg)
"Insert ARG number of randomly generated medium names at point."
(interactive "p")
(dotimes (_ arg)
(insert (format "%s\n" (game-master-assistant-random-query "generated-name-medium")))))
(init-message 2 "Packages: gcmh")
(use-package gcmh
:straight t
:config
(gcmh-mode 1))
(init-message 2 "Packages: guix")
(use-package guix
:straight t)
(init-message 2 "Packages: hide-mode-line")
(use-package hide-mode-line
:straight t)
(init-message 2 "Modules: hippie-exp")
(use-package hippie-exp
:straight (:type built-in)
:bind* (("M-/" . hippie-expand) ("C-M-/" . completion-at-point))
:custom
(hippie-expand-try-functions-list
'(try-expand-dabbrev
try-expand-dabbrev-all-buffers
try-expand-dabbrev-from-kill
try-complete-lisp-symbol-partially
try-complete-lisp-symbol
try-complete-file-name-partially
try-complete-file-name
try-expand-all-abbrevs
try-expand-list
try-expand-line
yas-hippie-try-expand)))
(init-message 2 "Modules: htmlize")
(use-package htmlize
:straight t
:commands (htmlize-buffer
htmlize-region
htmlize-file
htmlize-many-file
htmlize-many-files-dired
htmlize-region-for-paste
htmlize-region-for-paste-font-type)
:custom
(htmlize-output-type 'inline-css)
:config
(setq htmlize-face-overrides
'(
font-lock-comment-face (:foreground "#798188")
font-lock-string-face (:foreground "#cfe2f2")
font-lock-keyword-face (:foreground "#fa9a4b" :weight bold)
font-lock-builtin-face (:foreground "#fa9a4b" :weight bold)
font-lock-function-name-face (:foreground "#72aaca")
font-lock-variable-name-face (:foreground "#f6f080")
font-lock-type-face (:foreground "#72aaca")
font-lock-constant-face (:foreground "#b9d977")
font-lock-warning-face (:foreground "#f1e94b" :weight bold)
default (:foreground "green" :background "black"))))
(init-message 2 "Modules: hungry-delete")
(use-package hungry-delete
:straight t
:demand t
:commands (global-hungry-delete-mode
hungry-delete-skip-ws-forward
hungry-delete-skip-ws-backward)
:init
(global-hungry-delete-mode -1)
(defun hungry-delete-forward ()
"Delete the following character or all following whitespace
up to the next non-whitespace character. See
\\[c-hungry-delete-backward]."
(interactive)
(let ((here (point)))
(hungry-delete-skip-ws-forward)
(when (> (point) here)
(forward-char -1))
(if (/= (point) here)
(delete-region (point) here)
(let ((hungry-delete-mode nil))
(delete-char 1)))))
(defun hungry-delete-backward ()
"Delete the preceding character or all preceding whitespace
back to the previous non-whitespace character. See also
\\[c-hungry-delete-forward]."
(interactive)
(let ((here (point)))
(hungry-delete-skip-ws-backward)
(when (< (point) here)
(forward-char 1))
(if (/= (point) here)
(delete-region (point) here)
(let ((hungry-delete-mode nil))
(delete-char -1))))))
(init-message 2 "Modules: ibuffer")
(use-package ibuffer
:straight (:type built-in)
:bind* ("C-x i" . ibuffer) :commands (ibuffer)
:config
(setq ibuffer-saved-filters
'(("default"
("c" (mode . c-mode))
("calendar" (or
(name . "^\\*Calendar\\*$")
(name . "^\\*Remind\\*$")
(name . "^diary$")))
("dired" (mode . dired-mode))
("elisp" (mode . emacs-lisp-mode))
("emacs" (or
(name . "^\\*scratch\\*$")
(name . "^\\*Messages\\*$")))
("erc" (mode . erc-mode))
("gnus" (or
(mode . message-mode)
(mode . bbdb-mode)
(mode . mail-mode)
(mode . gnus-group-mode)
(mode . gnus-summary-mode)
(mode . gnus-article-mode)
(name . "^\\.bbdb$")
(name . "^\\.newsrc-dribble")))
("java" (or
(mode . java-mode)
(mode . jde-mode)))
("kotlin" (mode . kotlin-mode))
("lisp" (mode . lisp-mode))
("org" (mode . org-mode))
("perl" (mode . perl-mode))
("python" (mode . python-mode))
("racket" (mode . racket-mode))
("ruby" (mode . ruby-mode)))))
(defun custom-ibuffer-mode-hook ()
(ibuffer-switch-to-saved-filter-groups "default"))
(add-hook 'ibuffer-mode-hook #'custom-ibuffer-mode-hook))
(init-message 2 "Packages: isearch")
(use-package isearch
:straight (:type built-in)
:bind (:map isearch-mode-map
("C-M-<backspace>" . isearch-clear))
:config
(defun isearch-clear ()
"Clear `isearch' search string."
(interactive)
(isearch-del-char most-positive-fixnum)))
(init-message 2 "Modules: iedit")
(use-package iedit
:straight t
:commands (iedit-mode)
:bind* ("C-x ;" . iedit-mode))
(init-message 2 "Modules: ini")
(use-package ini
:straight (ini
:type git
:host github
:repo "daniel-ness/ini.el")
:commands (ini-decode
ini-encode))
(init-message 2 "Modules: ispell")
(use-package ispell
:straight (:type built-in)
:commands (ispell-buffer
ispell-change-dictionary-hook
ispell-complete-word-dict
ispell-message
ispell-region-end
ispell-set-spellchecker-params
ispell-word)
:bind (("<f6>" . ispell-word)
("<S-f6>" . ispell))
:config
(setq ispell-enable-tex-parser t))
(init-message 2 "Modules: json")
(use-package json
:straight (:type built-in))
(init-message 2 "Modules: key-chord")
(use-package key-chord
:straight t
:demand t
:init
(key-chord-mode 1)
:config
(key-chord-define-global ",." "<>\C-b")
(key-chord-define-global "hj" 'undo)
(key-chord-define-global "fg" 'undo-tree-redo)
(key-chord-define-global "jk" 'dabbrev-expand)
(key-chord-define-global "cv" 'reindent-then-newline-and-indent)
(key-chord-define-global "1q" "!")
(key-chord-define-global "2w" "@")
(key-chord-define-global "3e" "#")
(key-chord-define-global "4r" "$")
(key-chord-define-global "5t" "%")
(key-chord-define-global "6y" "^")
(key-chord-define-global "7y" "&")
(key-chord-define-global "8u" "*")
(key-chord-define-global "9i" "(")
(key-chord-define-global "0o" ")"))
(init-message 2 "Modules: keyfreq")
(use-package keyfreq
:straight t
:demand t
:custom
(keyfreq-file (expand-file-name ".emacs.keyfreq" user-emacs-directory))
(keyfreq-file-lock (expand-file-name ".emacs.keyfreq.lock" user-emacs-directory))
:init
(keyfreq-mode 1)
:config
(keyfreq-autosave-mode 1))
(init-message 2 "Modules: langtool")
(use-package langtool
:when (executable-find "languagetool") :straight t
:bind* (("C-x 4 w" . langtool-check)
("C-x 4 W" . langtool-check-done)
("C-x 4 l" . langtool-switch-default-language)
("C-x 4 4" . langtool-show-message-at-point)
("C-x 4 c" . langtool-correct-buffer))
:custom
(langtool-java-classpath
(concat "/usr/share/java/languagetool"
":/usr/share/java/languagetool/*"
":/usr/share/languagetool"
":/usr/share/languagetool/*")))
(init-message 2 "Packages: lorem-ipsum")
(use-package lorem-ipsum
:straight t)
(init-message 2 "Packages: lorem-ipsum-overlay")
(defcustom lorem-ipsum-overlay-exclude nil
"List of regexps to exclude from `lorem-ipsum-overlay'."
:type '(repeat regexp))
(setq lorem-ipsum-overlay-exclude
`(,(rx (or bol bos blank)
"#+"
(one-or-more alnum)
":"
(or eol eos blank))))
(defun lorem-ipsum-overlay (&optional replace-p)
"Overlay all text in current buffer with \"lorem ipsum\" text.
When called again, remove overlays. Useful for taking screenshots
without revealing buffer contents.
If REPLACE-P is non-nil (interactively, with prefix), replace
buffer contents rather than overlaying them. When a buffer is
very large and would have so many overlays that performance would
be prohibitively slow, you may replace the buffer contents
instead. (Of course, be careful about saving the buffer after
replacing its contents.)
Each piece of non-whitespace text in the buffer is compared with
regexps in `unpackaged/lorem-ipsum-overlay-exclude', and ones
that match are not overlaid. Note that the regexps are compared
against the entire non-whitespace token, up-to and including the
preceding whitespace, but only the alphabetic part of the token
is overlaid. For example, in an Org buffer, a line that starts
with:
#+TITLE: unpackaged.el
Could be matched against the exclude regexp (in `rx' syntax):
(rx (or bol bos blank) \"#+\" (1+ alnum) \":\" (or eol eos blank))
And the line would be overlaid like:
#+TITLE: parturient.et"
(interactive "P")
(require 'lorem-ipsum)
(let ((ovs (overlays-in (point-min) (point-max))))
(if (cl-loop for ov in ovs
thereis (overlay-get ov :lorem-ipsum-overlay))
(dolist (ov ovs)
(when (overlay-get ov :lorem-ipsum-overlay)
(delete-overlay ov)))
(let ((lorem-ipsum-words (--> lorem-ipsum-text
(-flatten it) (apply #'concat it)
(split-string it (rx (or space punct)) 'omit-nulls)))
(case-fold-search nil))
(cl-labels
((overlay-group (group)
(let* ((beg (match-beginning group))
(end (match-end group))
(replacement-word (lorem-word (match-string group)))
(ov (make-overlay beg end)))
(when replacement-word
(overlay-put ov :lorem-ipsum-overlay t)
(overlay-put ov 'display replacement-word))))
(replace-group (group)
(let* ((beg (match-beginning group))
(end (match-end group))
(replacement-word (lorem-word (match-string group))))
(when replacement-word
(setf (buffer-substring-no-properties beg end) replacement-word))))
(lorem-word (word)
(if-let* ((matches (lorem-matches (length word))))
(apply-case word (downcase (seq-random-elt matches)))
(apply-case word (downcase (compose-word (length word))))))
(lorem-matches (length &optional (comparator #'=))
(cl-loop for liw in lorem-ipsum-words
when (funcall comparator (length liw) length)
collect liw))
(apply-case (source target)
(cl-loop for sc across-ref source
for tc across-ref target
when (not (string-match-p (rx lower) (char-to-string sc)))
do (setf tc (string-to-char (upcase (char-to-string tc)))))
target)
(compose-word (length)
(cl-loop while (> length 0)
for word = (seq-random-elt (lorem-matches length #'<=))
concat word
do (cl-decf length (length word)))))
(save-excursion
(goto-char (point-min))
(while (re-search-forward (rx (group (one-or-more (or bol bos blank (not alpha)))
(zero-or-more (not (any alpha blank)))
(group (one-or-more alpha))
(zero-or-more (not (any alpha blank)))))
nil t)
(unless (cl-member (match-string 0) lorem-ipsum-overlay-exclude
:test (lambda (string regexp)
(string-match-p regexp string)))
(if replace-p
(replace-group 2)
(overlay-group 2)))
(goto-char (match-end 2)))))))))
(init-message 2 "Modules: magit")
(use-package magit
:straight t
:diminish magit-auto-revert-mode
:bind* (("C-x g" . magit-status)
("C-x M-g" . magit-dispatch))
:bind (:map magit-status-mode-map
("W" . magit-toggle-whitespace)
("C-c C-a" . magit-commit-amend-without-prompt))
:bind (:map magit-mode-map
("v" . magit-visit-pull-request-url))
:custom
(magit-log-margin '(t "%Y-%m-%d %H:%M " magit-log-margin-width t 18))
:init (setq magit-last-seen-setup-instructions "1.4.0")
:config
(defun magit-toggle-whitespace ()
"Toggle whitespace ignoring."
(interactive)
(let ((ws "--ignore-all-space"))
(if (member ws magit-diff-arguments)
(setq magit-diff-arguments (remove ws magit-diff-arguments))
(add-to-list 'magit-diff-arguments ws t))
(magit-refresh)))
(defun magit-commit-amend-without-prompt ()
"Amend without any prompt."
(interactive)
(save-window-excursion
(shell-command "git --no-pager commit --amend --reuse-message=HEAD")
(magit-refresh)))
(defun magit-visit-pull-request-url ()
"Visit the current branch's pull request on Github."
(interactive)
(browse-url
(format "https://github.com/%s/pull/new/%s"
(replace-regexp-in-string
"^.+github\\.com:\\(.+\\)\\.git$" "\\1"
(magit-get "remote"
(magit-get-remote nil)
"url"))
(cdr (magit-get-push-branch))))))
(init-message 2 "Packages: mastodon")
(use-package mastodon
:straight t
:after (persist)
:config
(let* ((env (expand-file-name "~/.mastodon"))
(url (string-trim (shell-command-to-string (concat "sed -n 's/emacs.ch-url=//p' " env))))
(username (string-trim (shell-command-to-string (concat "sed -n 's/emacs.ch-username=//p' " env)))))
(setq mastodon-instance-url url
mastodon-active-user username)))
(init-message 2 "Modules: mingus")
(use-package mingus
:straight t
:commands (mingus
mingus-create-NP-mark
mingus-get-details
mingus-get-insertion-number
mingus-get-new-playlist-version
mingus-goto-line
mingus-set-insertion-point
mingus-move
mingus-move-NP-mark
mingus-playlist-length
mingus-set-song-pos
mingus-switch-to-playlist
mingus-truncate-string
mpd-execute-command
mpd-get-status)
:bind* ("C-x /" . mingus-switch-to-buffer)
:bind (:map mingus-global-map
("<left>" . backward-char)
("<right>" . forward-char)
("<home>" . beginning-of-line)
("<end>" . end-of-line)
("C-c C-u" . mingus-mpc-update))
:bind (:map mingus-playlist-mode-map
("SPC" . mingus-pause)
("<left>" . backward-char)
("<right>" . forward-char)
("<home>" . beginning-of-line)
("<end>" . end-of-line)
("C-c C-e" . mingus-edit-id3v2)
("C-c C-l" . mingus-get-lyrics)
("C-c C-u" . mingus-mpc-update)
("<f1>" . mingus-set-song-rating-1)
("<f2>" . mingus-set-song-rating-2)
("<f3>" . mingus-set-song-rating-3)
("<f4>" . mingus-set-song-rating-4)
("<f5>" . mingus-set-song-rating-5)
("<f6>" . mingus-set-song-rating-0))
:bind (:map mingus-browse-mode-map
("C-c C-u" . mingus-mpc-update))
:config
(defmacro _mpdgv () `(aref conn 0))
(defmacro _mpdsv (val) `(aset conn 0 ,val))
(defmacro _mpdgo () `(aref conn 1))
(defmacro _mpdso (val) `(aset conn 1 ,val))
(defmacro _mpdgb () `(aref conn 2))
(defmacro _mpdsb (val) `(aset conn 2 ,val))
(defmacro _mpdgl () `(aref conn 3))
(defmacro _mpdsl (val) `(aset conn 3 ,val))
(defmacro _mpdgs () `(aref conn 4))
(defmacro _mpdss (val) `(aset conn 4 ,val))
(defmacro _mpdgf () `(aref conn 5))
(defmacro _mpdsf (val) `(aset conn 5 ,val))
(defmacro _mpdgt () `(aref conn 6))
(defmacro _mpdst (val) `(aset conn 6 ,val))
(defmacro _mpdgh () `(aref conn 7))
(defmacro _mpdsh (val) `(aset conn 7 ,val))
(defmacro _mpdgp () `(aref conn 8))
(defmacro _mpdsp (val) `(aset conn 8 ,val))
(defmacro _mpdga () `(aref conn 9))
(defmacro _mpdsa (val) `(aset conn 9 ,val))
(defun custom-mingus-hook-custom-settings ()
(buffer-disable-undo)
(setq show-trailing-whitespace nil)
)
(add-hook 'mingus-playlist-hooks #'custom-mingus-hook-custom-settings)
(add-hook 'mingus-browse-hook #'custom-mingus-hook-custom-settings)
(setq mingus-mpd-config-file "~/.mpd/mpd.conf")
(defcustom mingus-mpd-music-dir nil
"mpd music directory.")
(setq mingus-mpd-music-dir "~/.mpd/music/")
(setq mingus-fold-case t)
(setq mingus-use-ido-mode-p t)
(setq mingus-use-mouse-p nil)
(setq mingus-format-song-function 'mingus-format-song-custom-columns)
(defun mingus-switch-to-buffer ()
"Start mingus or switch to it if already running."
(interactive)
(if (get-buffer "*Mingus*")
(switch-to-buffer "*Mingus*")
(mingus)))
(defun mingus-truncate-string (string length)
(truncate-string-to-width string (max 1 length) nil 32 "..."))
(defun mingus-format-song-custom-columns (plist)
"Custom column playlist song format."
(let* ((show-albums (>= (window-text-width) 140))
(available-width (- (window-text-width) 19))
(song-width (/ available-width (if show-albums 3 2)))
(artist-width (/ available-width (if show-albums 3 2)))
(album-width (/ available-width 3))
(string
(concat
(format "% 4d.%.2d "
(/ (or (plist-get plist 'Time) 0) 60)
(mod (or (plist-get plist 'Time) 0) 60))
(mingus-truncate-string
(or (plist-get plist 'Title)
(plist-get plist 'Name)
(plist-get plist 'file))
song-width)
(concat " "
(mingus-truncate-string
(or (plist-get plist 'Artist)
(plist-get plist 'AlbumArtist)
"")
artist-width))
(if show-albums
(concat " "
(mingus-truncate-string
(or (plist-get plist 'Album) "")
album-width))
""))))
string))
(defun mingus-format-song-custom-simple (plist &optional separator)
"Make a string from PLIST.
Concatenate the results for the values with SEPARATOR, where SEPARATOR
defaults to the string \" - \"."
(let ((artist (plist-get plist 'Artist))
(album (plist-get plist 'Album))
(title (plist-get plist 'Title))
(albumartist (plist-get plist 'Albumartist))
(track (plist-get plist 'Track))
(name (plist-get plist 'Name))
(genre (plist-get plist 'Genre))
(date (plist-get plist 'Date))
(composer (plist-get plist 'Composer))
(performer (plist-get plist 'Performer))
(comment (plist-get plist 'Comment))
(disc (plist-get plist 'Disc))
(time (plist-get plist 'Time))
(pos (plist-get plist 'Pos))
(id (plist-get plist 'Id))
(file (plist-get plist 'file))
(separator (or separator " - ")))
(or (and mingus-use-caching
(gethash id mingus-song-strings))
(let ((val
(let* ((file (and file (file-name-nondirectory file)))
(short (remove nil (list (or artist albumartist)
(or title file)))))
(mapconcat 'identity short separator))))
(and mingus-use-caching
(puthash id val mingus-song-strings))
val))))
(defun mingus-goto-current-song--recenter ()
"Recenter screen after moving to current song."
(recenter-top-bottom))
(advice-add 'mingus-goto-current-song :after #'mingus-goto-current-song--recenter)
(defun mingus-insert-song-rating (rating)
"Insert song rating at current position."
(insert (format " [%s]" rating)))
(defun mingus-display-song-rating (highlight)
"Display song rating of currently selected mingus song.
If HIGHLIGHT is non-nil, highlight song."
(let ((buffer "*Mingus*"))
(unless (string= (buffer-name) buffer)
(user-error "Current buffer is not: %s" buffer))
(let (buffer-read-only)
(save-mark-and-excursion
(save-match-data
(forward-line 0)
(when (re-search-forward " \\[[0-9]\\]$" (line-end-position) :noerror)
(replace-match ""))
(goto-char (line-end-position))
(mingus-insert-song-rating (or (mingus-get-song-rating) 0))
(when highlight
(put-text-property (line-beginning-position) (line-end-position) 'face 'font-lock-keyword-face)))))))
(defun mingus-set-NP-mark--highlight-current-song (orig-fun &rest args)
"Mark entire line of currently playing song.
Use text properties to mark the line then call `mingus-set-NP-mark'."
(when (string= (buffer-name) "*Mingus*")
(ignore-errors
(let ((pos (or (and (> (length args) 1) (cadr args))
(plist-get (mpd-get-status mpd-inter-conn) 'song)))
buffer-read-only)
(when pos
(save-mark-and-excursion
(save-window-excursion
(remove-text-properties (point-min) (point-max) '(face nil))
(mingus-goto-line (1+ pos))
(mingus-display-song-rating t)))))))
(apply orig-fun args))
(advice-add 'mingus-set-NP-mark :around #'mingus-set-NP-mark--highlight-current-song)
(defun mingus-get-all-song-ratings ()
"Return all song ratings as a hash table of songs to ratings."
(let ((ratings (make-hash-table :test 'equal)))
(dotimes (x 5)
(let* ((rating (1+ x))
(file (file-truename
(expand-file-name
(concat mingus-ratings-prefix (number-to-string rating))
mingus-ratings-directory))))
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (not (eobp))
(puthash (buffer-substring-no-properties (line-beginning-position) (line-end-position)) rating ratings)
(forward-line 1)))))
ratings))
(defun mingus-display-all-song-ratings ()
"Display all song ratings in mingus playlist buffer."
(when (string= (buffer-name) "*Mingus*")
(save-mark-and-excursion
(save-window-excursion
(let ((ratings (mingus-get-all-song-ratings))
buffer-read-only)
(buffer-disable-undo)
(goto-char (point-min))
(while (not (eobp))
(ignore-errors
(let ((rating (get-byte (- (line-end-position) 2))))
(unless (and (= (get-byte (- (line-end-position) 1)) 93)
(= (get-byte (- (line-end-position) 3)) 91)
(>= rating 48)
(<= rating 53))
(let ((details (mingus-get-details)))
(when details
(let* ((file (plist-get details 'file))
(rating (gethash file ratings)))
(goto-char (line-end-position))
(mingus-insert-song-rating (number-to-string (or rating 0)))))))))
(forward-line 1)))))))
(advice-add 'mingus-switch-to-playlist :after #'mingus-display-all-song-ratings)
(advice-add 'mingus-redraw-buffer :after #'mingus-display-all-song-ratings)
(defun mingus-mpc-update ()
"Update (refresh) mpc (Music Player Client)"
(interactive)
(mpd-update mpd-inter-conn mingus-mpd-music-dir))
(defun mingus-id3v2-info (file)
"Return plist of id3v2 information of FILE."
(let ((id3v2 "id3v2")
(fields '(("TPE1" Artist)
("TALB" Album)
("TIT2" Title)
("TYER" Year)
("TRCK" Track)
("TCON" Genre))))
(unless (executable-find id3v2)
(user-error "Could not find system command: %s" id3v2))
(let ((info (shell-command-to-string (concat id3v2 " --list \"" file "\"")))
result)
(dolist (x fields)
(let ((tag (car x))
(name (cadr x)))
(when (string-match (concat "^" tag " [^:]*: \\(.*\\)$") info)
(let ((val (match-string 1 info)))
(setq result
(cond
((string= tag "TCON")
(when (string-match "(\\([0-9]+\\))" val)
(plist-put result 'Genre
(string-to-number
(match-string 1 val)))))
(t
(plist-put result name val))))))))
result)))
(defun mingus-id3v2-set (file field value)
"Set id3v2 information of FIELD in FILE to VALUE."
(let ((id3v2 "id3v2")
(process-name "mingus-id3v2-set-process")
(fields '((Artist "TPE1")
(Album "TALB")
(Title "TIT2")
(Year "TYER")
(Track "TRCK")
(Genre "TCON"))))
(unless (executable-find id3v2)
(user-error "Could not find system command: %s" id3v2))
(let ((frame (cadr (assoc field fields))))
(if (string= value "")
(start-process process-name nil id3v2 "--remove-frame" value file)
(start-process process-name nil id3v2 (concat "--" frame) value file)))))
(defun mingus-edit-id3v2 ()
"Edit id3 tag of the selected song."
(interactive)
(cl-labels
((expand-mpd-file (file)
(expand-file-name (concat mingus-mpd-music-dir file)))
(get-info (info field)
(or (plist-get info field) ""))
(format-name (name)
(substring (concat name ": ") 0 8))
(genre-id-to-name (genres name)
(caar (remove-if-not (lambda (x) (= (cdr x) name))
genres))))
(let* ((buffer-name "*Mingus Edit ID3 Tags*")
(id3v2 "id3v2")
(file (plist-get (mingus-get-details) 'file))
(genres (mapcar (lambda (x)
(let ((s (split-string x ": ")))
(cons (cadr s) (string-to-number (car s)))))
(split-string
(shell-command-to-string (concat id3v2 " --list-genres"))
"\n" :omit-nulls " +"))))
(unless (executable-find id3v2)
(user-error "Could not find system command: %s" id3v2))
(let* ((buffer (get-buffer-create buffer-name))
(info (mingus-id3v2-info (expand-mpd-file file)))
(fields `((File "File" ,file 70)
(Artist "Artist" ,(get-info info 'Artist) 70)
(Album "Album" ,(get-info info 'Album) 70)
(Title "Title" ,(get-info info 'Title) 70)
(Track "Track" ,(get-info info 'Track) 5)
(Year "Year" ,(get-info info 'Year) 4)
(Genre "Genre" ,(genre-id-to-name genres (get-info info 'Genre)) nil))))
(with-current-buffer buffer
(erase-buffer)
(kill-all-local-variables)
(setq-local file file)
(setq-local info info)
(setq-local genres genres)
(setq-local fields fields)
(widget-insert (concat (propertize "Edit ID3 Tags" 'face 'font-lock-keyword-face) "\n\n"))
(dolist (x fields)
(let ((field (car x))
(name (cadr x))
(val (caddr x))
(size (cadddr x)))
(widget-insert (propertize (format-name name) 'face 'font-lock-keyword-face))
(cond
((eq field 'Genre)
(funcall `(lambda ()
(setq-local ,(intern (concat "wid-" name))
(widget-create 'menu-choice
:tag "Select"
:value ,val
,@(mapcar (lambda (x)
`'(choice-item ,(car x)))
genres))))))
(t
(funcall `(lambda ()
(setq-local ,(intern (concat "wid-" name))
(widget-create 'editable-field
:value ,val
:size ,size))))))
(widget-insert "\n")))
(widget-create 'push-button
:value "OK"
:notify (lambda (&rest _)
(cl-labels
((expand-mpd-file (file)
(expand-file-name (concat mingus-mpd-music-dir file))))
(let ((file (expand-mpd-file file)))
(dolist (x (reverse fields)) (let* ((field (car x))
(name (cadr x))
(val (caddr x))
(new-val (funcall `(lambda () (widget-value ,(intern (concat "wid-" name)))))))
(when (not (string= val new-val))
(cond
((eq field 'File)
(rename-file file (expand-mpd-file new-val)))
((eq field 'Genre)
(mingus-id3v2-set file field (number-to-string (cdr (assoc new-val genres)))))
(t
(mingus-id3v2-set file field new-val))))))
(kill-buffer)))))
(widget-insert " ")
(widget-create 'push-button
:value "Cancel"
:notify (lambda (&rest _)
(kill-buffer)))
(set-buffer-modified-p nil)
(use-local-map widget-keymap)
(widget-setup)
(switch-to-buffer buffer)
(goto-char (point-min))
(widget-forward 1))))))
(init-message 3 "Mingus Fetch Lyrics Commands")
(defun mingus-get-lyrics-azlyrics (artist title)
"Return the lyrics for a song matching ARTIST and TITLE
by scraping the azlyrics.com site."
(interactive)
(message "artist: %s, title: %s" artist title)
(let* ((start-regexp "<!-- Usage of azlyrics.com")
(end-regexp "<!-- MxM banner -->")
(ret-regexp "
")
(bracket-regexp " *\\[[^\]].*\\]")
(starting-spaces-regexp "^ +")
(ending-spaces-regexp " +$")
(feat-regexp "<span class=\"feat\">\\(.*\\)</span>")
(site "azlyrics.com")
(user-agent "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; WOW64; Trident/4.0; SLCC1)")
(referer "http://www.google.com/")
(search-file (shell-command-to-string "echo -n /tmp/mingus-search-$$.html"))
(lyrics-file (shell-command-to-string "echo -n /tmp/mingus-lyrics-$$.html"))
(parsed-title
(replace-regexp-in-string ending-spaces-regexp ""
(replace-regexp-in-string starting-spaces-regexp ""
(replace-regexp-in-string bracket-regexp "" title))))
(query (concat "http://www.google.com/search?q="
"lyrics "
(if artist (concat "\"" artist "\" ") "")
"\"" parsed-title "\" "
"site:" site
"&btnI=Search"))
url
lyrics
error)
(call-process "wget" nil nil nil
"--no-verbose"
"--convert-links"
(concat "--user-agent=" user-agent)
(concat "--referer=" referer)
"-O" search-file
query)
(message "query: %s" query)
(message "wget call: wget --no-verbose --convert-links --user-agent=\"%s\" --referer=%s -O %s %s" user-agent referer search-file query)
(with-temp-buffer
(buffer-disable-undo)
(condition-case err
(progn
(insert-file-contents search-file)
(goto-char (point-min))
(re-search-forward (concat "https://www." site "[^\"]*"))
(setq url (match-string-no-properties 0)))
('error
(message "Error trying to find lyrics url: %s" err)
(setq error t))))
(if (and error artist)
(mingus-get-lyrics-azlyrics nil title)
(progn
(call-process "wget" nil nil nil
"--no-verbose"
"--convert-links"
(concat "--user-agent=" user-agent)
(concat "--referer=" referer)
"-O" lyrics-file
url)
(with-temp-buffer
(buffer-disable-undo)
(condition-case err
(progn
(insert-file-contents lyrics-file)
(fundamental-mode)
(goto-char (point-min))
(when (re-search-forward start-regexp nil :noerror)
(forward-line 0)
(forward-line 1)
(let ((pos (point)))
(forward-line -3)
(delete-region (point) pos))
(forward-line -2)
(delete-region (point-min) (point)))
(when (re-search-forward end-regexp nil :noerror)
(delete-region (line-beginning-position) (point-max)))
(goto-char (point-min))
(while (re-search-forward ret-regexp nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward feat-regexp nil :noerror)
(replace-match "\\1"))
(shr-render-region (point-min) (point-max))
(goto-char (point-max))
(delete-blank-lines)
(goto-char (point-min))
(insert (upcase artist) ": " (upcase title))
(newline)
(newline)
(setq lyrics (buffer-substring-no-properties (point-min) (point-max))))
('error
(message "Error trying to format lyrics result: %s" err)))
lyrics)))))
(defun mingus-get-lyrics-leoslyrics (artist title)
"Return the lyrics for a song matching ARTIST and TITLE
using the api.leoslyrics.com site."
(interactive)
(let ((query (concat "wget -q \"http://api.leoslyrics.com/api_search.php?auth=emacs"
(if artist (concat "&artist=" (url-hexify-string artist)) "")
"&songtitle=" (url-hexify-string title)
"\" -O - | xmlstarlet sel -t -v \"/leoslyrics/searchResults/result/@hid\"")))
(let ((hid (shell-command-to-string query)))
(when hid
(let ((query (concat "wget -q \"http://api.leoslyrics.com/api_lyrics.php?auth=emacs&hid="
(url-hexify-string hid)
"\" -O - | xmlstarlet sel -t -v \"/leoslyrics/lyric/text/text()\""
" | xmlstarlet unesc | tr -d '\r'")))
(let ((lyrics (shell-command-to-string query)))
lyrics))))))
(defun mingus-get-lyrics-metrolyrics (artist title)
"Return the lyrics for a song matching ARTIST and TITLE
by scraping the metrolyrics.com site."
(interactive)
(let* ((start-regexp "<div id=\"lyrics-body-text\">")
(end-regexp "</div>")
(ret-regexp "
")
(bracket-regexp " *\\[[^\]].*\\]")
(starting-spaces-regexp "^ +")
(ending-spaces-regexp " +$")
(site "metrolyrics.com")
(user-agent "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.0; WOW64; Trident/4.0; SLCC1)")
(referer "http://www.google.com/")
(file (shell-command-to-string "echo -n /tmp/mingus-lyrics-$$.html"))
(parsed-title
(replace-regexp-in-string ending-spaces-regexp ""
(replace-regexp-in-string starting-spaces-regexp ""
(replace-regexp-in-string bracket-regexp "" title))))
(query (concat "http://www.google.com/search?q="
"lyrics "
(if artist "\"" artist "\" " "")
"\"" parsed-title "\" "
"site:" site
"&btnI=Search"))
(lyrics))
(call-process "wget" nil nil nil
"--no-verbose"
"--convert-links"
(concat "--user-agent=" user-agent)
(concat "--referer=" referer)
"-O" file
query)
(message "query: %s" query)
(message "wget call: wget --no-verbose --convert-links --user-agent=\"%s\" --referer=%s -O %s %s" user-agent referer file query)
(with-temp-buffer
(buffer-disable-undo)
(condition-case err
(progn
(insert-file-contents file)
(fundamental-mode)
(goto-char (point-min))
(when (re-search-forward start-regexp nil :noerror)
(forward-line 0)
(forward-line 1)
(let ((pos (point)))
(forward-line -3)
(delete-region (point) pos))
(forward-line -2)
(delete-region (point-min) (point)))
(when (re-search-forward end-regexp nil :noerror)
(delete-region (line-beginning-position) (point-max)))
(goto-char (point-min))
(while (re-search-forward ret-regexp nil :noerror)
(replace-match ""))
(shr-render-region (point-min) (point-max))
(goto-char (point-max))
(delete-blank-lines)
(goto-char (point-min))
(insert (upcase artist) ": " (upcase title))
(newline)
(newline)
(setq lyrics (buffer-substring-no-properties (point-min) (point-max))))
('error
(message "Error trying to format lyrics result: %s" err)))
lyrics)))
(defun mingus-get-lyrics ()
"Display lyrics for the selected song."
(interactive)
(let ((details (mingus-get-details)))
(when details
(let ((artist (plist-get details 'Artist))
(title (plist-get details 'Title))
(funct 'mingus-get-lyrics-azlyrics))
(setq artist (replace-regexp-in-string ", The$" "" artist))
(setq title (replace-regexp-in-string " ?([^)]*)" "" title))
(let ((buffer (concat "*" artist ": " title "*"))
(lyrics (funcall funct artist title)))
(when (or (not lyrics)
(zerop (length lyrics)))
(setq lyrics (funcall funct nil title)))
(if (and lyrics
(> (length lyrics) 0))
(progn
(get-buffer-create buffer)
(set-buffer buffer)
(let ((buffer-read-only nil))
(erase-buffer)
(insert lyrics)
(delete-trailing-whitespace)
(switch-to-buffer buffer)
(goto-char (point-min))
(view-mode)))
(message "No lyrics found for Artist: %s, Title: %s" artist title)))))))
(init-message 3 "Mingus Song Rating System")
(defcustom mingus-ratings-directory `,(file-truename (expand-file-name "~/.song-ratings"))
"Directory to store rating play lists."
:type 'string
:group 'mingus)
(defcustom mingus-ratings-prefix "songs-rated-"
"Ratings play list files prefix."
:type 'string
:group 'mingus)
(defun mingus-get-song-rating ()
"Return song rating of the selected song."
(interactive)
(let ((details (mingus-get-details)))
(when details
(let* ((file (plist-get details 'file))
(song-name (propertize
(replace-regexp-in-string "^.*/\\([^/]+\\)\\..*$" "\\1" file)
'face
'font-lock-keyword-face))
(get-cmd (concat
"cd " mingus-ratings-directory " && "
"(for x in $(ls " mingus-ratings-prefix "*) ; do grep -q -F \""
(replace-regexp-in-string "\"" "\"" file)
"\" \"${x}\" && echo ${x: -1}; done)")))
(unless (file-exists-p mingus-ratings-directory)
(make-directory mingus-ratings-directory))
(let ((rating (shell-command-to-string get-cmd)))
(when (string-match "\r?\n$" rating)
(setq rating (replace-match "" t nil rating)))
(when (zerop (length rating))
(setq rating "0"))
(let ((rating-name (propertize rating 'face 'font-lock-keyword-face)))
(if (called-interactively-p 'any)
(message "Rating for %s is %s" song-name rating-name)
(string-to-number rating))))))))
(defun mingus-set-song-rating (rating)
"Set song rating of the selected song.
RATING may be a number from 0 to 5, where 1 is least favorite and
5 is most favorite. 0 will unset the rating."
(interactive)
(unless (and (>= rating 0) (<= rating 5))
(user-error "Rating must be a number from 0 through 5"))
(let ((details (mingus-get-details)))
(when details
(let* ((file (plist-get details 'file))
(song-name (propertize
(replace-regexp-in-string "^.*/\\([^/]+\\)\\..*$" "\\1" file)
'face
'font-lock-keyword-face))
(rating-name (propertize (number-to-string rating) 'face 'font-lock-keyword-face))
(playlist (concat mingus-ratings-prefix (number-to-string rating)))
(clear-cmd (concat
"cd " mingus-ratings-directory " && "
"(for x in $(find . -name '" mingus-ratings-prefix "*') ; do grep -v -F \""
(replace-regexp-in-string "\"" "\"" file)
"\" \"${x}\" > tmp ; mv tmp \"${x}\" ; done)"))
(set-cmd (concat
"cd " mingus-ratings-directory " && "
"(echo \""
(replace-regexp-in-string "\"" "\"" file)
"\" >> " playlist ") && "
"(cat " playlist " | sort > tmp ; mv tmp " playlist ")")))
(unless (file-exists-p mingus-ratings-directory)
(make-directory mingus-ratings-directory))
(shell-command clear-cmd)
(if (> rating 0)
(if (> (shell-command set-cmd) 0)
(user-error "Could not set rating for \"%s\"" song-name)
(message "\"%s\" rating was set to %s" song-name rating-name))
(message "%s rating was cleared" song-name))
(let (buffer-read-only)
(buffer-disable-undo)
(mingus-display-song-rating nil))))))
(defun mingus-set-song-rating-1 ()
"Call `mingus-set-song-rating' with a rating of 1."
(interactive)
(mingus-set-song-rating 1))
(defun mingus-set-song-rating-2 ()
"Call `mingus-set-song-rating' with a rating of 2."
(interactive)
(mingus-set-song-rating 2))
(defun mingus-set-song-rating-3 ()
"Call `mingus-set-song-rating' with a rating of 3."
(interactive)
(mingus-set-song-rating 3))
(defun mingus-set-song-rating-4 ()
"Call `mingus-set-song-rating' with a rating of 4."
(interactive)
(mingus-set-song-rating 4))
(defun mingus-set-song-rating-5 ()
"Call `mingus-set-song-rating' with a rating of 5."
(interactive)
(mingus-set-song-rating 5))
(defun mingus-set-song-rating-0 ()
"Call `mingus-set-song-rating' with a rating of 0."
(interactive)
(mingus-set-song-rating 0)))
(init-message 2 "Modules: minions")
(use-package minions
:straight t
:config
(minions-mode 1))
(init-message 2 "Modules: multiple-cursors")
(use-package multiple-cursors
:straight t
:bind* (("C-c C-." . mc/edit-lines)
("C-c C-," . mc/mark-all-like-this)
("C-M-." . mc/mark-next-like-this) ("C-M-," . mc/mark-previous-like-this) ("C-M->" . mc/unmark-next-like-this)
("C-M-<" . mc/unmark-previous-like-this)))
(init-message 2 "Packages: mwim")
(use-package mwim
:straight t
:bind* (([remap move-beginning-of-line] . mwim-beginning-of-line-or-code)
([remap move-end-of-line] . mwim-end-of-line-or-code)
("<C-tab>" . mwim)))
(init-message 2 "Modules: neotree")
(use-package neotree
:straight t
:commands (neo-global--select-window
neo-global--window-exists-p
neotree-toggle)
:bind ("<f8>" . neotree-select-or-toggle)
:custom
(neo-smart-open t)
(projectile-switch-project-action #'neotree-projectile-action)
:config
(defun neotree-select-or-toggle ()
"Make an existing neotree window active or toggle it on/off."
(interactive)
(if (and (neo-global--window-exists-p)
(not (eq (current-buffer) (get-buffer neo-buffer-name))))
(neo-global--select-window)
(neotree-toggle))))
(init-message 2 "Packages: nov")
(use-package nov
:straight t
:mode ("\\.epub\\'" . nov-mode))
(init-message 2 "Modules: occur")
(use-package replace
:straight (:type built-in)
:config
(when (fboundp 'occur-inverse)
(bind-keys* :map occur-mode-map ("C-c C-i" . occur-inverse))))
(init-message 2 "Packages: org-tree-slide")
(use-package org-tree-slide
:straight t
:bind (("S-<f8>" . org-tree-slide-mode)
("C-<f8>" . org-tree-slide-skip-done-toggle))
:bind (:map org-tree-slide-mode-map
("<f11>" . org-tree-slide-move-previous-tree)
("<f12>" . org-tree-slide-move-next-tree))
:hook ((org-tree-slide-play . org-tree-slide-presentation-setup)
(org-tree-slide-stop . org-tree-slide-presentation-reset))
:custom
(org-tree-slide-slide-in-effect t)
(org-tree-slide-activate-message "Presentation Mode: On")
(org-tree-slide-deactivate-message "Presentation Mode: Off")
(org-tree-slide-header t)
(org-tree-slide-breadcrumbs " > ")
(org-image-actual-width nil)
:config
(use-package hide-mode-line
:straight t)
(defun org-tree-slide-presentation-setup ()
(setq text-scale-mode-amount 3)
(when (fboundp 'hide-mode-line-mode)
(hide-mode-line-mode 1))
(org-display-inline-images)
(text-scale-mode 1))
(defun org-tree-slide-presentation-reset ()
(when (fboundp 'hide-mode-line-mode)
(hide-mode-line-mode 0))
(text-scale-mode 0)))
(init-message 2 "Packages: olivetti")
(use-package olivetti
:straight t)
(init-message 2 "Modules: persistent-scratch")
(use-package persistent-scratch
:straight t
:demand t
:init
(persistent-scratch-setup-default))
(init-message 2 "Packages: pocket-reader")
(use-package pocket-reader
:straight t
:after (peg)
:custom
(pocket-reader-archive-on-open nil))
(init-message 2 "Modules: proced")
(use-package proced
:straight t
:commands (proced))
(init-message 2 "Modules: projectile")
(use-package projectile
:straight t
:diminish (projectile-mode . "Proj")
:bind* ("C-x p" . projectile-command-map)
:custom
(projectile-switch-project-action #'projectile-dired)
:init
(projectile-mode)
:config
(dolist (x '("~/dev" "~/code" "~/web"))
(when (file-directory-p x)
(add-to-list 'projectile-project-search-path x))))
(init-message 2 "Modules: rainbow-mode")
(use-package rainbow-mode
:straight t
:init
(rainbow-mode 1))
(init-message 2 "Modules: recentf")
(use-package recentf
:straight (:type built-in)
:commands (recentf-mode)
:custom
(recentf-max-menu-items 25)
:init
(recentf-mode 1))
(init-message 2 "Modules: regex-tool")
(use-package regex-tool
:straight t
:commands (regex-tool))
(init-message 2 "Modules: replacer")
(use-package replacer
:load-path (lambda () (file-truename (expand-file-name "replacer.el" local-modules-dir)))
:after (company)
:commands (replacer-mode company-replacer-backend)
:custom
(replacer-trigger-start ";")
(replacer-trigger-end " ")
(replacer-replacements
'(
("h" . replacer-help)
("help" . replacer-help)
("id" . insert-date)
("idt" . insert-datetime)
("it" . insert-time)
("iuuid" . insert-uuid)
("iguid" . insert-guid)
("ipw" . insert-password-20)
("ipp" . insert-password-phrase-three-hyphen)
("i=" . append-equal-to-column-80)
("i-" . append-dash-to-column-80)
("i*" . append-asterisk-to-column-80)
("ilgpl" . insert-license-gpl)
("ilmit" . insert-license-mit)
("ilapache" . insert-license-apache)
("on" . org-insert-literate-programming-name)
("os" . org-insert-literate-programming-src)
("ossh" . org-insert-literate-programming-src-sh)
("ossu" . org-insert-literate-programming-src-sh-sudo)
("osel" . org-insert-literate-programming-src-emacs-lisp)
("osr" . org-insert-literate-programming-src-racket)
("osk" . org-insert-literate-programming-src-kotlin)
("ospy" . org-insert-literate-programming-src-python)
("obie" . org-insert-literate-programming-init-emacs-block)
("obc" . org-insert-literate-programming-code-block)
("obpe" . org-insert-literate-programming-project-euler-problem-block)
))
:init
(replacer-mode 1)
:config
(defun replacer-replacements-edit ()
"Open `init-emacs.org' and move point to `replacer-replacements' variable for easy editing."
(interactive)
(find-file (expand-file-name "init-emacs.org" emacs-home-dir))
(goto-char (point-min))
(search-forward "replacer-replacements")
(org-show-entry))
(defun replacer-help ()
"Show list of `replacer-replacements'."
(describe-variable 'replacer-replacements)))
(init-message 2 "Modules: s")
(use-package s
:straight t)
(init-message 2 "Modules: saveplace")
(use-package saveplace
:straight (:type built-in)
:after (org-visibility) :custom
(save-place-file (locate-user-emacs-file ".saveplace"))
(save-place-limit 100)
(save-place-ignore-files-regexp
(rx (or
(seq ".org" eol)
"/.cddb/")))
:init (save-place-mode 1)
:config
(defun save-place-find-file-hook--ignore-hidden-point ()
"Only restore position if point is visible."
(when (invisible-p (point))
(beginning-of-buffer)))
(advice-add 'save-place-find-file-hook :after #'save-place-find-file-hook--ignore-hidden-point))
(init-message 2 "Modules: smerge")
(use-package smerge-mode
:straight (:type built-in)
:init
(defun smerge-mode-maybe ()
"Auto turn on smerge mode when a file with merge conflicts is loaded.
Do not perform the search on very large files (to avoid a delay when loaded)."
(when (<= (buffer-size) 10000)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (re-search-forward "^<<<<<<< " nil :noerror)
(smerge-mode 1))))))
(add-hook 'find-file-hook #'smerge-mode-maybe :append))
(init-message 2 "Modules: sokoban")
(use-package sokoban
:load-path (lambda () (file-truename (expand-file-name "sokoban/sokoban.el" emacs-modules-dir)))
:commands (sokoban sokoban-mode)
:custom
(sokoban-levels-dir (file-truename (expand-file-name "sokoban/sokoban-levels" emacs-modules-dir))))
(init-message 2 "Modules: split-move")
(use-package split-move
:load-path (lambda () (file-truename (expand-file-name "split-move.el" local-modules-dir)))
:commands (split-move-up split-move-down))
(init-message 2 "Modules: spinner")
(use-package spinner
:straight t)
(init-message 2 "Modules: sudoku")
(use-package sudoku
:straight (sudoku
:type git
:host github
:repo "zevlg/sudoku.el")
:commands (sudoku))
(init-message 2 "Packages: svg-2048")
(use-package svg-2048
:straight (svg-2048
:type git
:host github
:repo "wasamasa/svg-2048")
:bind (:map svg-2048-mode-map
("<left>" . svg-2048-move-left)
("<right>" . svg-2048-move-right)
("<up>" . svg-2048-move-up)
("<down>" . svg-2048-move-down)))
(init-message 2 "Packages: svg-clock")
(use-package svg-clock
:straight t)
(init-message 2 "Modules: switch-window")
(use-package switch-window
:straight t
:demand t
:commands (switch-window switch-window-then-delete)
:custom
(switch-window-shortcut-style 'qwerty))
(init-message 2 "Modules: telnet")
(use-package telnet
:straight (:type built-in))
(init-message 2 "Modules: timeclock")
(use-package timeclock
:straight (:type built-in)
:bind (("C-c ti" . timeclock-in)
("C-c to" . timeclock-out)
("C-c tc" . timeclock-change)
("C-c tr" . timeclock-reread-log)
("C-c tu" . timeclock-update-mode-line)
("C-c tw" . timeclock-when-to-leave-string)
("C-c tv" . timeclock-visit-timelog)
("C-c ts" . timeclock-status-string)
("C-c td" . timeclock-mode-line-display)
("C-c tg" . timeclock-generate-report))
)
(init-message 2 "Modules: time-stamp")
(use-package time-stamp
:straight (:type built-in)
:commands (time-stamp)
:custom
(time-stamp-active t)
:init
(setq time-stamp-line-limit 50
time-stamp-start "[Tt][Ii][Mm][Ee][-]?[Ss][Tt][Aa][Mm][Pp]:[ \t]+\\\\?[\"<]+"
time-stamp-format "%Y-%02m-%02d %02H:%02M (%u)")
(add-hook 'before-save-hook #'time-stamp))
(init-message 2 "Modules: tramp")
(use-package tramp
:straight (:type built-in)
:commands (tramp)
:custom
(tramp-default-method "ssh")
:config
(add-to-list 'tramp-default-method-alist '("^localhost$" "^root$" "su") t))
(init-message 3 "Find File as Root")
(use-package tramp
:straight (:type built-in)
:commands (find-alternative-file-as-root
find-file-as-root
find-file-as-root-or-find-alternative-file-as-root
tramp
tramp-dissect-file-name
tramp-file-name-localname
tramp-tramp-file-p)
:bind ("C-c M-r" . find-alternative-file-as-root)
:config
(defvar find-file-as-root-prefix "/sudo:root@localhost:"
"*The file name prefix used to open a file with `find-file-as-root'.")
(defvar find-file-as-root-history nil
"History list for files found using `find-file-as-root'.")
(defvar find-file-as-root-hook nil
"Normal hook for functions to run after finding files with `find-file-as-root'.")
(defun find-file-as-root ()
"*Open a file as the root user.
Prepends `find-file-as-root-prefix' to the selected file name so
that it maybe accessed via the corresponding tramp method."
(interactive)
(require 'tramp)
(let* ((file-name-history find-file-as-root-history)
(name (or buffer-file-name default-directory))
(tramp (and (tramp-tramp-file-p name) (tramp-dissect-file-name name)))
path dir file)
(when tramp
(setq path (tramp-file-name-localname tramp)
dir (file-name-directory path)))
(when (setq file (read-file-name "Find file as root: " dir path))
(find-file (concat find-file-as-root-prefix file))
(setq find-file-as-root-history file-name-history)
(run-hooks 'find-file-as-root-hook))))
(defun find-alternative-file-as-root ()
"Find alternative file as root."
(interactive)
(when buffer-file-name
(find-alternate-file
(concat "/sudo:root@localhost:"
buffer-file-name))))
(defun find-file-as-root-or-find-alternative-file-as-root ()
"If current buffer is read-only, run `file-alternative-file-as-root',
otherwise run `find-file-as-root'."
(interactive)
(if buffer-read-only
(find-alternative-file-as-root)
(find-file-as-root))))
(init-message 2 "Modules: undo-tree")
(use-package undo-tree
:straight (undo-tree
:type git
:host github
:repo "apchamberlain/undo-tree.el")
:demand t
:diminish undo-tree-mode
:bind* (("<M-mouse-5>" . undo-tree-redo)
("<M-mouse-4>" . undo-tree-undo))
:init
(global-undo-tree-mode 1))
(init-message 2 "Modules: vimish-fold")
(use-package vimish-fold
:straight t)
(init-message 2 "Packages: visual-fill-column")
(use-package visual-fill-column
:straight t
:custom
(visual-fill-column-center-text t)
(visual-fill-column-width 80))
(init-message 2 "Modules: w3m")
(use-package w3m
:when (executable-find "w3m") :straight t
:commands (w3m
w3m-antenna
w3m-browse-url
w3m-encode-specials-string
w3m-find-file
w3m-namazu
w3m-next-buffer
w3m-previous-buffer
w3m-region
w3m-search
w3m-weather)
:defines (w3m-use-tab-line)
:bind (:map w3m-mode-map
("," . w3m-previous-buffer)
("." . w3m-next-buffer))
:custom
(w3m-icon-directory "/usr/share/emacs-w3m/icon")
(w3m-use-cookies t)
:config
(defun w3m-buffer (&optional buffer)
"Render the current buffer or BUFFER if given."
(interactive)
(when buffer
(switch-to-buffer buffer))
(w3m-region (point-min) (point-max)))
(defun custom-w3m-display-hook (url)
"Hook to auto-rename buffers to page title or url."
(rename-buffer
(format "*w3m: %s*" (or w3m-current-title w3m-current-url)) t))
(add-hook 'w3m-display-hook #'custom-w3m-display-hook))
(init-message 2 "Modules: web-query")
(use-package web-query
:load-path (lambda () (file-truename (expand-file-name "web-query.el" local-modules-dir)))
:commands (web-query
web-query-word
web-query-word-at-point
web-query-symbol-by-mode
web-query-symbol-by-mode-at-point)
:bind ( ("S-<f6>" . web-query)
("S-<f7>" . web-query-symbol-by-mode-at-point)
("C-c w" . web-query)))
(init-message 2 "Modules: webjump")
(use-package webjump
:straight (:type built-in)
:config
(add-to-list 'webjump-sites '("Urban Dictionary" . [simple-query "www.urbandictionary.com" "http://www.urbandictionary.com/define.php?term=" ""]) t))
(init-message 2 "Modules: weblogger")
(use-package weblogger
:straight t
:commands (weblogger-select-configuration
weblogger-setup-weblog
weblogger-start-entry)
:custom
(weblogger-config-alist
`(("nullman" "http://www.blogger.com/api" ,user-mail-address "" "6007591")
("Nullman on Life" "http://www2.blogger.com/api" ,user-mail-address "" "6007591"))))
(init-message 2 "Modules: wgrep")
(use-package wgrep
:straight t
:bind (:map grep-mode-map
("C-x C-q" . wgrep-change-to-wgrep-mode)))
(init-message 2 "Modules: which-key")
(use-package which-key
:straight t
:demand t
:init (which-key-mode))
(init-message 2 "Modules: wtf")
(use-package wtf
:load-path (lambda () (file-truename (expand-file-name "wtf.el" emacs-modules-dir)))
:commands (wtf-is wtf-get-term-at-point))
(init-message 2 "Modules: wttrin")
(use-package wttrin
:straight t
:custom
(wttrin-default-cities '("Austin"
"London"
"Minneapolis"
"New York"
"San Diego"))
(wttrin-default-accept-language '("Accept-Language" . "en-US")))
(init-message 1 "Modes")
(init-message 2 "Modes: Configuration")
(setq electric-indent-inhibit t)
(setq-default electric-indent-inhibit electric-indent-inhibit)
(setq c-electric-flag nil)
(setq-default c-electric-flag c-electric-flag)
(init-message 2 "Modes: ASM")
(use-package asm-mode
:straight (:type built-in)
:mode ("\\.asm\\'" . asm-mode)
:config
(defun custom-asm-mode-hook ()
"Customizations for asm-mode."
(local-unset-key [asm-comment-char])
)
(add-hook 'asm-mode-hook #'custom-asm-mode-hook))
(init-message 2 "Modes: Brainfuck")
(use-package brainfuck
:load-path (lambda () (file-truename (expand-file-name "brainfuck.el" local-modules-dir)))
:mode ("\\.bf\\'" . brainfuck-mode))
(init-message 2 "Modes: BASIC")
(use-package basic
:load-path (lambda () (file-truename (expand-file-name "basic.el" local-modules-dir)))
:mode ("\\.bas\\'" . basic-mode))
(init-message 2 "Modes: C Mode")
(use-package cc-mode
:straight (:type built-in)
:demand t
:mode (("\\.c\\'" . c-mode)
("\\.h\\'" . c-mode)
("\\.ice\\'" . c-mode)
("\\.cpp\\'" . c++-mode)
("\\.hpp\\'" . c++-mode)
("\\.c++\\'" . c++-mode)
("\\.h++\\'" . c++-mode))
:commands (c-skip-comments-and-strings)
:config
(defvar custom-c-style
'((c-tab-always-indent . 'complete)
(c-basic-offset . 4)
(c-comment-only-line-offset . 0)
(c-hanging-braces-alist . ((substatement-open after)
(brace-list-open)))
(c-hanging-colons-alist . ((member-init-intro before)
(inher-intro)
(case-label after)
(label after)
(access-label after)))
(c-cleanup-list . (scope-operator
empty-defun-braces
defun-close-semi))
(c-offsets-alist . ((arglist-close . c-lineup-arglist)
(substatement-open . 0)
(substatement-label . 0)
(label . 0)
(case-label . +)
(block-open . 0)
(defun-block-intro . +)
(statement-block-intro . +)
(substatement . +)
(knr-argdecl-intro . -)
(inline-open . 0)
(defun-block-intro . 4)))
(c-echo-syntactic-information-p . nil)))
(defun custom-c-mode-common-hook ()
"Customizations for `c-mode', `c++-mode', `objc-mode', `java-mode', and `idl-mode'."
(c-add-style "local" custom-c-style t)
(when (fboundp 'c-toggle-electric-state)
(c-toggle-electric-state 1))
(when (fboundp 'c-toggle-auto-hungry-state)
(c-toggle-auto-hungry-state -1))
(disable-tabs)
(setq fill-column custom-fill-column)
(when (boundp 'flyspell-prog-mode)
(flyspell-prog-mode))
(when (boundp 'eldoc-mode)
(eldoc-mode 1))
(setq compile-command "make -k"
compilation-window-height 10
compilation-ask-about-save nil
)
)
(add-hook 'c-mode-common-hook #'custom-c-mode-common-hook)
)
(init-message 2 "Modes: Calendar")
(use-package calendar
:straight (:type built-in)
:bind* ("C-x c" . calendar)
:bind (:map calendar-mode-map
(">" . calendar-scroll-left)
("<" . calendar-scroll-right)
("C-x >" . calendar-scroll-left)
("C-x <" . calendar-scroll-right))
:config
(setq calendar-view-diary-initially-flag nil)
(setq diary-number-of-entries 10)
(setq mark-diary-entries-in-calendar t)
(setq calendar-today-visible-hook 'calendar-star-date)
(setq calendar-today-visible-hook 'calendar-mark-today)
(setq calendar-mark-holidays-flag t))
(init-message 3 "calendar-remind")
(use-package calendar-remind
:load-path (lambda () (file-truename (expand-file-name "calendar-remind.el" local-modules-dir)))
:after (calendar)
:commands (calendar-remind-lookup
calendar-remind-visit
calendar-remind-visit-insert)
:bind (:map calendar-mode-map
("<return>" . calendar-remind-lookup)
("r" . calendar-remind-lookup)
("v" . calendar-remind-visit)
("V" . calendar-remind-visit-insert)))
(init-message 2 "Modes: CSS Mode")
(use-package css-mode
:straight (:type built-in)
:mode (("\\.css\\'" . css-mode)
("\\.scss\\'" . css-mode))
:custom
(cssm-indent-function #'cssm-c-style-indenter))
(init-message 2 "Modes: Dired")
(defun custom-dired-mode-hook ())
(use-package dired
:straight (:type built-in)
:commands (dired dired-jump)
:bind (:map dired-mode-map
("e" . wdired-change-to-wdired-mode)
("C-a" . dired-mwim-beginning-of-line)
("C-c C-z f" . browse-url-of-dired-file))
:custom
(dired-recursive-deletes 'top)
(dired-auto-revert-buffer t)
(dired-listing-switches "-alhGv1 --time-style=+%F --group-directories-first")
(dired-guess-shell-alist-user
'(("\\.pdf\\'" "evince")
("\\.htm?l\\'" "firefox")
("\\.doc?x\\'" "libreoffice --writer")
("\\.odt\\'" "libreoffice --writer")
("\\.p[bgpn]m\\'" "gpicview")
("\\.bmp\\'" "gpicview")
("\\.gif\\'" "gpicview")
("\\.tif?f\\'" "gpicview")
("\\.png\\'" "gpicview")
("\\.jpe?g\\'" "gpicview")
("\\.mpe?g\\'" "vlc")
("\\.avi\\'" "vlc")
("\\.mkv\\'" "vlc")
("\\.mp4\\'" "vlc")
("\\.wmv\\'" "vlc")
("\\.mp3\\'" "audacious")
("\\.ogg\\'" "audacious")
("\\.wav\\'" "audacious")))
:config
(when window-system-mac
(setq insert-directory-program "gls"
dired-use-ls-dired t))
(setq dired-compress-files-alist
'(("\\.tar\\.bz2\\'" . "tar -cf - %i | bzip2 -c9 > %o")
("\\.bz2\\'" . "bzip2 -c9 %i > %o")
("\\.tar\\.xz\\'" . "tar -cf - %i | xz -c9 > %o")
("\\.xz\\'" . "xz -c9 %i > %o")
("\\.tar\\.zst\\'" . "tar -cf - %i | zstd -19 -o %o")
("\\.zst\\'" . "zstd -19 %i -o %o")
("\\.zip\\'" . "zip %o -r --filesync %i")))
(defun dired-mwim-beginning-of-line ()
(interactive)
(let ((regexp (rx (seq (= 4 digit) "-" (= 2 digit) "-" (= 2 digit)
(one-or-more space)))))
(if (= (line-beginning-position) (point))
(re-search-forward regexp (line-end-position) :noerror)
(forward-line 0))))
(defun dired-move-to-top ()
(interactive)
(goto-char (point-min))
(dired-next-line 4))
(define-key dired-mode-map [remap beginning-of-buffer] 'dired-move-to-top)
(defun dired-move-to-bottom ()
(interactive)
(goto-char (point-max))
(dired-next-line -1))
(define-key dired-mode-map [remap end-of-buffer] 'dired-move-to-bottom))
(init-message 3 "dired-single")
(use-package dired-single
:straight t
:commands (dired dired-jump)
:bind (:map dired-mode-map
("<return>" . dired-single-buffer)
("f" . dired-single-buffer)
("^" . dired-single-buffer-up)
("b" . dired-single-buffer-up)
("<mouse-1>" . dired-single-buffer-mouse))
:init
(defun dired-single-buffer-up ()
(interactive)
(dired-single-buffer ".."))
:config
(advice-add 'dired-single-buffer-mouse :around #'advice--ignore-interactive-errors))
(init-message 3 "dired-open")
(use-package dired-open
:straight t
:custom
(dired-open-extensions
'(("png" . "display")
("gif" . "display")
("jpg" . "display")
("jepg" . "display")
("mpg" . "vlc")
("mpeg" . "vlc")
("avi" . "vlc")
("mov" . "vlc"))))
(init-message 3 "dired-hide-dotfiles")
(use-package dired-hide-dotfiles
:straight t
:bind (:map dired-mode-map
("H" . dired-hide-dotfiles-mode)))
(init-message 3 "dired-narrow")
(use-package dired-narrow
:straight t
:bind (("C-c C-n" . dired-narrow)
("C-c C-f" . dired-narrow-fuzzy)))
(init-message 2 "Modes: Ediff")
(use-package ediff
:straight (:type built-in)
:custom
(ediff-split-window-function 'split-window-horizontally)
(ediff-highlight-all-diffs nil)
(ediff-diff-options "-w")
(ediff-window-setup-function 'ediff-setup-windows-plain)
)
(init-message 2 "Modes: Erlang Mode")
(use-package erlang
:straight t
:after (flyspell)
:mode ("\\.erl\\'" . erlang-mode)
:interpreter ("erlang" . erlang-mode)
:commands (erlang-start)
:init
(add-to-list 'exec-path "/usr/lib/erlang/bin" t)
(setq erlang-root-dir "/usr/lib/erlang"
erlang-electric-commands nil)
:config
(defun custom-erlang-hook ()
(flyspell-prog-mode))
(add-hook 'erlang-hook #'custom-erlang-hook)
)
(init-message 2 "Modes: Fundamental Mode")
(setq indent-tabs-mode nil)
(auto-save-mode nil)
(init-message 2 "Modes: Geiser (Racket Scheme REPL)")
(use-package geiser
:straight t
:commands (geiser-mode
run-geiser)
:init
:config
(defun geiser-insert-sigma ()
"Insert ∑ character."
(interactive "*")
(insert-char ?∑))
(defun custom-geiser-mode-hook ()
(local-set-key (kbd "C-c \\") 'geiser-insert-lambda)
(local-set-key (kbd "C-c C-\\") 'geiser-insert-lambda)
(local-set-key (kbd "C-c s") 'geiser-insert-sigma)
(local-set-key (kbd "C-c C-s") 'geiser-insert-sigma))
(add-hook 'geiser-mode-hook #'custom-geiser-mode-hook)
(add-hook 'geiser-repl-mode-hook #'custom-geiser-mode-hook))
(use-package geiser-racket
:straight t
:after (geiser)
:commands (run-racket)
:init
:config
(setq geiser-default-implementation 'racket)
(setq geiser-active-implementations '(racket)))
(init-message 2 "Modes: GNU Plot")
(use-package gnuplot
:straight t
:mode ("\\.gp\\'" . gnuplot-mode)
:commands (gnuplot-mode gnuplot-make-buffer gnuplot-send-string-to-gnuplot))
(init-message 2 "Modes: Graphviz Dot Mode")
(use-package graphviz-dot-mode
:straight t
:mode (("\\.dot\\'" . graphviz-dot-mode)
("\\.gv\\'" . graphviz-dot-mode))
:commands (graphviz-dot-mode))
(init-message 2 "Modes: INI Mode")
(use-package ini-mode
:straight t
:mode ("\\.ini\\'" . ini-mode))
(init-message 2 "Modes: Javascript: js2 Mode")
(use-package js2-mode
:straight t
:mode (("\\.js\\'" . js2-mode)
("\\.gradle\\'" . js-mode)) :interpreter ("node" . js2-mode)
:config
(setq-local py-indent-offset custom-short-tab-width)
(setq js2-auto-indent-p t
js2-cleanup-whitespace t
js2-enter-indents-newline t
js2-indent-on-enter-key t
js2-bounce-indent-p nil
js2-mirror-mode nil
js2-mode-escape-quotes nil)
(add-hook 'js2-mode-hook #'js2-imenu-extras-mode)
)
(init-message 3 "js2-refactor")
(use-package js2-refactor
:straight t
:after (js2-mode)
:bind (:map js2-mode-map
("C-k" . js2r-kill)
("M-." . nil)) :config
(js2r-add-keybindings-with-prefix "C-c C-r")
(add-hook 'js2-mode-hook #'js2-refactor-mode))
(init-message 3 "xref-js2")
(use-package xref-js2
:straight t
:after (js2-mode)
:config
(defun js2-mode-hook--js2-refactor ()
(add-hook 'xref-backend-functions #'xref-js2-xref-backend nil t)
(add-hook 'js2-mode-hook #'js2-mode-hook--js2-refactor)))
(init-message 3 "js-comint")
(use-package js-comint
:straight t
:after (js2-mode)
:commands (js-send-buffer
js-send-buffer-and-go
js-send-last-sexp
js-send-last-sexp-and-go
js-load-file-and-go)
:bind (:map js2-mode-map
("C-c C-c" . js-eval-sexp-and-go)
("C-x C-e" . js-send-last-sexp)
("C-M-x" . js-eval-sexp-and-go)
("C-c b" . js-send-buffer)
("C-c C-b" . js-send-buffer-and-go)
("C-c C-k" . js-send-buffer-and-go)
("C-c l" . js-load-file-and-go))
:config
(defun js-eval-sexp ()
"js-comint evaluate current sexp."
(interactive)
(save-mark-and-excursion
(end-of-defun)
(js-send-last-sexp)))
(defun js-eval-sexp-and-go ()
"js-comint evaluate current sexp and switch to js buffer."
(interactive)
(save-mark-and-excursion
(end-of-defun)
(js-send-last-sexp-and-go)))
(defun js2-mode-hook--js-comint ()
(when (fboundp 'skewer-mode)
(skewer-mode -1)))
(add-hook 'js2-mode-hook #'js-mode-hook--js-comint))
(init-message 2 "Modes: JSON Mode")
(use-package json-mode
:straight t
:mode ("\\.json\\'" . json-mode)
:config
(setq json-encoding-default-indentation " "
json-encoding-pretty-print t))
(init-message 2 "Modes: LaTeX")
(init-message 3 "Packages: tex")
(use-package tex
:straight (:type built-in)
:mode ("\\.tex\\'" . latex-mode)
:custom
(TeX-auto-save t)
(TeX-parse-self t)
(TeX-source-correlate-mode t)
(TeX-source-correlate-method 'synctex)
(reftex-plug-into-AUCTeX t)
(TeX-view-program-selection '((output-pdf "PDF Tools")))
(TeX-source-correlate-start-server t)
(latex-noindent-commands '("footnote"))
:config
(add-hook 'TeX-after-compilation-finished-functions #'TeX-revert-document-buffer))
(init-message 3 "Packages: pdf-tools")
(use-package pdf-tools
:straight t
:bind (:map pdf-view-mode-map
("C-s" . isearch-forward)
("C-r" . isearch-backward))
:config
(pdf-tools-install))
(init-message 2 "Modes: Ledger Mode")
(use-package ledger-mode
:straight t
:functions (ledger-align-amounts)
:config
(defun custom-ledger-align-amounts ()
"Return `ledger-align-amounts' for entire buffer."
(save-mark-and-excursion
(goto-char (point-min))
(ledger-align-amounts 52)))
(defun custom-ledger-mode-hook ()
(add-hook 'before-save-hook #'custom-ledger-align-amounts 0 :local))
(add-hook 'ledger-mode-hook #'custom-ledger-mode-hook))
(init-message 2 "Modes: Lisp Mode")
(defun custom-lisp-mode-hook ()
(disable-tabs)
(when (equal major-mode 'lisp-mode)
(setq-local lisp-indent-function 'lisp-indent-function))
(modify-syntax-entry ?_ "w" lisp-mode-syntax-table)
(modify-syntax-entry ?- "w" lisp-mode-syntax-table)
(local-set-key (kbd "<return>") 'newline-and-indent)
(local-set-key (kbd "S-<tab>") 'lisp-complete-symbol)
(flyspell-prog-mode)
(eldoc-mode 1)
(setq-local outline-regexp "\\(;; [*]\\{1,8\\} \\|;;[;]\\{1,8\\} \\)")
(setq-local outline-level 'lisp-outline-level))
(use-package lisp-mode
:straight (:type built-in)
:after (flyspell eldoc info-look)
:commands (emacs-lisp-mode)
:functions (custom-lisp-mode-hook)
:mode (("\\.el\\'" . emacs-lisp-mode)
("\\.lisp\\'" . lisp-mode)
("\\.clisp\\'" . lisp-mode))
:hook ((emacs-lisp-mode . custom-lisp-mode-hook)
(lisp-mode . custom-lisp-mode-hook)
(common-lisp-mode . custom-lisp-mode-hook))
:config
)
(init-message 2 "Modes: LUA Mode")
(use-package lua-mode
:straight t
:mode ("\\.lua\\'" . lua-mode))
(init-message 2 "Modes: Makefile Mode")
(use-package make-mode
:straight (:type built-in)
:mode ("Makefile" . makefile-mode)
:config
(defun custom-makefile-mode-hook ()
(enable-tabs))
(add-hook 'makefile-mode-hook #'custom-makefile-mode-hook))
(init-message 2 "Modes: Markdown Mode")
(use-package markdown-mode
:straight t
:after (org-table)
:mode (("\\.md\\'" . markdown-mode)
("\\.markdown\\'" . markdown-mode))
:functions (markdown-mode-fix-org-tables)
:hook (markdown-mode . orgtbl-mode)
:config
(defun markdown-mode-fix-org-tables ()
"Hook to fix org table format on save."
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(while (search-forward "-+-" nil :noerror)
(replace-match "-|-")))))
(defun before-save-hook--markdown-mode-fix-org-tables ()
"Add hook to run `markdown-mode-fix-org-tables' before saving
Markdown files."
(add-hook 'before-save-hook #'markdown-mode-fix-org-tables nil 'make-it-local))
(add-hook 'markdown-mode-hook #'before-save-hook--markdown-mode-fix-org-tables))
(init-message 2 "Modes: Nix Mode")
(use-package nix-mode
:straight t
:after (lsp-mode)
:mode ("\\.nix\\'" . nix-mode)
:config
(add-to-list 'lsp-language-id-configuration '(nix-mode . "nix"))
(lsp-register-client
(make-lsp-client :new-connection (lsp-stdio-connection '("rnix-lsp"))
:major-modes '(nix-mode)
:server-id 'nix)))
(init-message 2 "Modes: Perl Mode")
(use-package perl-mode
:straight (:type built-in)
:after (flyspell)
:mode (("\\.\\([pP][Llm]\\|al\\|t\\)\\'" . perl-mode)
("perl" . perl-mode)
("perl5" . perl-mode))
:interpreter ("miniperl" . perl-mode)
:config
(defun custom-perl-mode-hook ()
(setq perl-indent-level 4)
(setq perl-indent-parens-as-block t)
(setq perl-indent-continued-arguments t)
(setq perl-continued-statement-offset 4)
(flyspell-prog-mode))
(add-hook 'perl-mode-hook #'custom-perl-mode-hook)
(defun perl-mode-maybe ()
"Determine if file is a perl script and switch to perl-mode if it is."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (or
(search-forward "#!/usr/bin/perl" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env perl" (line-end-position) :noerror))
(perl-mode)))))
(add-hook 'find-file-hook #'perl-mode-maybe)
)
(init-message 2 "Modes: PlantUML Mode")
(use-package plantuml-mode
:straight t)
(init-message 2 "Modes: Python Mode")
(use-package python-mode
:straight t
:after (company elpy)
:mode (("\\.py\\'" . python-mode)
("\\.python\\'" . python-mode))
:commands (py--buffer-filename-remote-maybe)
:functions (custom-python-mode-hook)
:config
(setq py-python-command-args '("--no-autoindent" "--colors=Linux"))
(setq py-keep-windows-configuration 'force)
(setq py-smart-indentation t)
(setq py-max-specpdl-size 999)
(defun custom-python-mode-hook ()
(when (fboundp 'backward-delete-word)
(bind-keys* ("C-<backspace>" . backward-delete-word)))
(setq-local py-indent-offset custom-short-tab-width)
(setq-local outline-regexp " *\\(def \\|clas\\|#hea\\)")
(when (and (not (fboundp 'python-shell-completion-at-point))
(memq 'python-shell-completion-at-point completion-at-point-functions))
(setq completion-at-point-functions
(remove 'python-shell-completion-at-point completion-at-point-functions)))
)
(add-hook 'python-mode-hook #'custom-python-mode-hook))
(use-package elpy
:straight t
:commands (elpy-enable
elpy-shell-switch-to-shell)
:config
(elpy-enable)
(setq elpy-eldoc-show-current-function nil)
(defun elpy-shell-switch-to-shell ()
"Switch to inferior Python process buffer."
(interactive)
(setq elpy--shell-last-py-buffer (buffer-name))
(pop-to-buffer (process-buffer (elpy-shell-get-or-create-process)) t))
(when (fboundp 'flycheck-mode)
(setq elpy-modules (delq 'elpy-module-flymake elpy-modules))
(add-hook 'elpy-mode-hook #'flycheck-mode)))
(init-message 2 "Modes: Racket Mode")
(use-package scheme
:straight (:type built-in)
:after (geiser)
:mode ("\\.rkt\\'" . racket-mode)
:interpreter ("racket" . racket-mode)
:commands (racket-mode
scheme-mode)
:config
(define-derived-mode racket-mode scheme-mode "Scheme"
"Major mode for editing Racket Scheme code. Editing commands
are similar to those of `lisp-mode'.
In addition, if an inferior Racket Scheme process is running,
some additional commands will be defined, for evaluating
expressions and controlling the interpreter, and the state of the
process will be displayed in the mode line of all Scheme buffers.
The names of commands that interact with the Scheme process start
with \"xscheme-\" if you use the MIT Scheme-specific `xscheme'
package; for more information see the documentation for
`xscheme-interaction-mode'. Use \\[run-scheme] to start an
inferior Scheme using the more general `cmuscheme' package.
Commands:
- Delete converts tabs to spaces as it moves back.
- Blank lines separate paragraphs.
- Semicolons start comments.
\\{scheme-mode-map}"
(when (fboundp 'geiser-mode)
(geiser-mode t)))
)
(init-message 2 "Modes: Ruby Mode")
(use-package ruby-mode
:straight (:type built-in)
:after (flyspell)
:mode ("\\.rb\\'" . ruby-mode)
:config
(defun custom-ruby-mode-hook ()
(setq ruby-indent-level 2)
(define-key ruby-mode-map (kbd "<return>") 'reindent-then-newline-and-indent)
(define-key ruby-mode-map (kbd "{") 'self-insert-command)
(define-key ruby-mode-map (kbd "}") 'self-insert-command)
(when (boundp 'flyspell-prog-mode)
(flyspell-prog-mode)))
(add-hook 'ruby-mode-hook #'custom-ruby-mode-hook :append)
(flyspell-prog-mode)
(defun ruby-mode-maybe ()
"Determine if file is a ruby script and switch to `ruby-mode' if it is."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (or
(search-forward "#!/usr/bin/ruby" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env ruby" (line-end-position) :noerror))
(ruby-mode)))))
(add-hook 'find-file-hook #'ruby-mode-maybe)
)
(init-message 3 "robe")
(use-package robe
:straight t
:after (ruby-mode)
:commands (robe-mode)
:config
(add-hook 'ruby-mode-hook #'robe-mode))
(init-message 2 "Modes: Rust Mode")
(use-package rust-mode
:straight t
:after (flyspell)
:mode ("\\.rs\\'" . rust-mode)
:bind (:map rust-mode-map
("C-c C-c" . rust-run)
("C-c C-d" . rust-dbg-wrap-or-unwrap)
("C-c C-f" . rust-format-buffer)
("C-c C-n" . rust-goto-format-problem))
:custom
(rustic-lsp-client nil)
:config
(defun custom-rust-mode-hook ()
(setq indent-tabs-mode nil)
(setq rust-indent-level 4)
(setq rust-format-on-save t)
(when (boundp 'flyspell-prog-mode)
(flyspell-prog-mode)))
(add-hook 'rust-mode-hook #'custom-rust-mode-hook :append)
(flyspell-prog-mode)
(defun rust-mode-maybe ()
"Determine if file is a rust script and switch to `rust-mode' if it is."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (or
(search-forward "#!/usr/bin/rust" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env rust" (line-end-position) :noerror))
(rust-mode)))))
(add-hook 'find-file-hook #'rust-mode-maybe)
)
(init-message 3 "Rustic")
(use-package rustic
:straight t
:after (rust-mode))
(init-message 2 "Modes: SH Script")
(use-package sh-script
:straight (:type built-in)
:mode (("\\.sh\\'" . sh-mode)
("\\.shell\\'" . sh-mode)
("\\.bash\\'" . sh-mode)
("\\.ldif\\'" . sh-mode)
("\\.schema\\'" . sh-mode)
("\\.reminders\\'" . sh-mode)
("^reminders_" . sh-mode))
:config
(add-hook 'sh-mode-hook #'disable-tabs)
(setq sh-indent-comment t)
(defun sh-mode-maybe ()
"Determine if file is a shell script and switch to sh-mode if it is."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (or
(search-forward "#!/bin/sh" (line-end-position) :noerror)
(search-forward "#!/bin/bash" (line-end-position) :noerror)
(search-forward "#!/bin/csh" (line-end-position) :noerror)
(search-forward "#!/bin/tsh" (line-end-position) :noerror)
(search-forward "#!/bin/zsh" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env sh" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env bash" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env csh" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env tsh" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env zsh" (line-end-position) :noerror)
(search-forward "#=========" (line-end-position) :noerror)
(search-forward "#---------" (line-end-position) :noerror))
(sh-mode)))))
(add-hook 'find-file-hook #'sh-mode-maybe)
)
(init-message 2 "Modes: Shell Mode")
(use-package shell
:straight (:type built-in)
:commands (shell-mode)
:config
(add-hook 'shell-mode-hook #'disable-tabs)
(setq comint-prompt-read-only t)
)
(init-message 3 "ansi-color")
(use-package ansi-color
:straight (:type built-in)
:after (shell)
:commands (ansi-color-for-comint-mode-on)
:config
(add-hook 'shell-mode-hook #'ansi-color-for-comint-mode-on))
(init-message 2 "Modes: Slime Mode (Common Lisp)")
(use-package slime
:straight t
:commands (slime-autoloads
slime
slime-eval-buffer
slime-eval-last-expression
slime-interactive-eval
slime-last-expression
slime-mode
slime-setup
clisp
clojure
swank-clojure-init
swank-clojure-slime-mode-hook
swank-clojure-cmd
swank-clojure-project)
:config
(setq swank-clojure-jar-path (file-truename (expand-file-name "~/.clojure/clojure.jar"))
swank-clojure-binary (file-truename (expand-file-name "~/bin/clojure"))
swank-clojure-extra-classpaths
(list (file-truename (expand-file-name "~/.clojure/clojure.jar"))
(file-truename (expand-file-name "~/.clojure/jline.jar"))
(file-truename (expand-file-name "~/.clojure/clojure-contrib.jar"))))
(slime-setup)
(defun slime-eval-sexp ()
"Slime evaluate current sexp."
(interactive)
(save-mark-and-excursion
(end-of-defun)
(slime-interactive-eval (slime-last-expression))))
(defun slime-lisp-mode-hook ()
(slime-mode 1)
(setq-local lisp-indent-function 'lisp-indent-function))
(defun custom-slime-lisp-mode-hook ()
(slime-mode 1)
(bind-keys :map slime-mode-map
("C-c C-c" . slime-eval-sexp)
("C-x C-e" . slime-eval-last-expression)
("C-M-x" . slime-eval-sexp)
("C-c C-k" . slime-eval-buffer))
)
(add-hook 'lisp-mode-hook #'custom-slime-lisp-mode-hook)
(add-hook 'common-lisp-mode-hook #'custom-slime-lisp-mode-hook)
(add-hook 'clojure-mode-hook #'custom-slime-lisp-mode-hook)
(autoload 'turn-on-cldoc-mode "cldoc" nil t)
(add-hook 'common-lisp-mode-hook #'turn-on-cldoc-mode)
(setq cldoc-idle-delay 3)
(add-to-list 'slime-lisp-implementations '(clisp ("/usr/bin/clisp" "-K" "base")) t)
(defun clisp ()
"Start Common Lisp in Slime."
(interactive)
(slime 'clisp))
(add-to-list 'slime-lisp-implementations '(sbcl ("/usr/bin/sbcl")) t)
(defun sbcl ()
"Start Steel Bank Common Lisp in Slime."
(interactive)
(slime 'sbcl))
(add-to-list 'slime-lisp-implementations `(clojure ("/usr/bin/clojure")) t)
(defun clojure ()
"Start Clojure in Slime."
(interactive)
(slime 'clojure))
(defun custom-lisp-mode-hook-slime-mode ()
"Hook to load slime-mode when lisp-mode is loaded."
(slime-mode 1))
(add-hook 'lisp-mode-hook #'custom-lisp-mode-hook-slime-mode)
)
(init-message 3 "elisp-slime-nav-mode")
(use-package elisp-slime-nav
:straight t
:after (slime)
:diminish elisp-slime-nav-mode
:commands (elisp-slime-nav-mode)
:config (elisp-slime-nav-mode))
(init-message 2 "Modes: SQL Mode")
(use-package sql
:straight (:type built-in)
:mode (("\\.sql\\'" . sql-mode)
("\\.tbl\\'" . sql-mode)
("\\.sp\\'" . sql-mode))
:hook (sql-interactive-mode . custom-sql-interactive-hook)
:config
(defun sql-remove-prompt (output)
"Remove prompt so output lines up correctly."
(save-mark-and-excursion
(let ((inhibit-read-only t))
(forward-line 0)
(while (and (not (bobp))
(not (looking-at "^GO$")))
(while (re-search-forward (concat sql-prompt-regexp "[ \t]*") (line-end-position) :noerror)
(replace-match ""))
(forward-line -1))))
output)
(defun custom-sql-interactive-hook ()
(toggle-truncate-lines 1)
(set (make-local-variable 'sql-input-ring-file-name)
(expand-file-name "history-sql" user-emacs-directory))
(add-hook 'comint-preoutput-filter-functions #'sql-remove-prompt)))
(use-package sqlup-mode
:straight t
:after (sql)
:bind (:map sql-mode-map
("C-c b" . sqlup-capitalize-keywords-in-buffer)
("C-c r" . sqlup-capitalize-keywords-in-region))
:bind (:map sql-interactive-mode-map
("C-c b" . sqlup-capitalize-keywords-in-buffer)
("C-c r" . sqlup-capitalize-keywords-in-region))
:hook ((sql-mode . sqlup-mode)
(sql-interactive-mode . sqlup-mode)))
(use-package sql-transform
:straight t
:after (sql)
:bind (:map sql-mode-map
("C-c s" . sql-to-select)
("C-c i" . sql-to-insert)
("C-c u" . sql-to-update)
("C-c d" . sql-to-delete))
:bind (:map sql-interactive-mode-map
("C-c s" . sql-to-select)
("C-c i" . sql-to-insert)
("C-c u" . sql-to-update)
("C-c d" . sql-to-delete)))
(init-message 2 "Modes: Text Mode")
(use-package text-mode
:straight (:type built-in)
:after (flyspell)
:mode (("\\.txt\\'" . text-mode)
("\\.text\\'" . text-mode)
("\\'README\\'" . text-mode)
("\\'INSTALL\\'" . text-mode)
("\\'CHANGELOG\\'" . text-mode))
:config
(defun custom-text-mode-hook ()
(setq tab-width 8)
(setq tab-stop-list (number-sequence 8 76 8))
(setq fill-column custom-fill-column)
(turn-on-auto-fill)
(modify-syntax-entry ?_ "w" text-mode-syntax-table)
(modify-syntax-entry ?- "w" text-mode-syntax-table)
(flyspell-mode 1)
(setq sentence-end-double-space nil)
(setq colon-double-space nil)
)
(add-hook 'text-mode-hook #'custom-text-mode-hook)
)
(init-message 2 "Modes: TypeScript Mode")
(use-package typescript-mode
:straight t
:mode (("\\.ts\\'" . typescript-mode)
("\\.tsx\\'" . typescript-mode))
:hook (typescript-mode . lsp-deferred)
:config
(setq typescript-indent-level 2))
(use-package tide
:straight t
:after (typescript-mode company flycheck)
:hook ((typescript-mode . tide-setup)
(typescript-mode . tide-hl-identifier-mode)
(before-save . tide-format-before-save))
:config
(flycheck-add-next-checker 'typescript-tide 'javascript-eslint))
(use-package add-node-modules-path
:straight t
:hook (typescript-mode . add-node-modules-path))
(init-message 2 "Modes: V Mode")
(use-package v-mode
:straight (v-mode
:type git :host github :repo "damon-kwok/v-mode"
:files ("tokens" "v-mode.el"))
:after (flyspell)
:mode ("\\.v?v\\.vsh\\'" . v-mode)
:bind (:map v-mode-map
("C-c C-b" . v-project-build)
("C-c C-c" . v-project-run)
("C-c C-f" . v-format-buffer)
("C-c C-f" . v-menu))
:config
(defun custom-v-mode-hook ()
(setq indent-tabs-mode nil)
(when (boundp 'flyspell-prog-mode)
(flyspell-prog-mode)))
(add-hook 'v-mode-hook #'custom-v-mode-hook :append)
(flyspell-prog-mode)
(defun v-mode-maybe ()
"Determine if file is a v script and switch to `v-mode' if it is."
(interactive)
(save-mark-and-excursion
(save-match-data
(goto-char (point-min))
(when (or
(search-forward "#!/usr/bin/v" (line-end-position) :noerror)
(search-forward "#!/usr/bin/env v" (line-end-position) :noerror))
(v-mode)))))
(add-hook 'find-file-hook #'v-mode-maybe)
)
(init-message 2 "Modes: Vimrc Mode")
(use-package vimrc-mode
:straight t
:mode (("\\.vimrc\\'" . vimrc-mode)
("\\.vim\\'" . vimrc-mode)
("\\.exrc\\'" . vimrc-mode)))
(init-message 2 "Modes: XML Mode")
(use-package nxml-mode
:straight (:type built-in)
:after (flyspell)
:mode (("\\.dtd\\'" . nxml-mode)
("\\.htm\\'" . nxml-mode)
("\\.html\\'" . nxml-mode)
("\\.rdf\\'" . nxml-mode)
("\\.rhtml\\'" . nxml-mode)
("\\.rss\\'" . nxml-mode)
("\\.sgml\\'" . nxml-mode)
("\\.svg\\'" . nxml-mode)
("\\.xhtml\\'" . nxml-mode)
("\\.xml\\'" . nxml-mode)
("\\.xsd\\'" . nxml-mode)
("\\.xsl\\'" . nxml-mode)
("\\.tt\\'" . nxml-mode))
:config
(add-to-list 'magic-mode-alist '("<\\?xml " . nxml-mode) t)
(defun custom-nxml-mode-hook ()
(bind-key "<tab>" 'indent-for-tab-command nxml-mode-map)
(turn-off-auto-fill)
(flyspell-prog-mode)
(setq nxml-slash-auto-complete-flag t)
(setq-local outline-regexp "\\s *<\\([h][1-6]\\|html\\|body\\|head\\)\\b")
)
(add-hook 'nxml-mode-hook #'custom-nxml-mode-hook)
(fset 'xml-mode 'nxml-mode)
(fset 'html-mode 'nxml-mode))
(init-message 2 "Modes: YAML Mode")
(use-package yaml-mode
:straight t
:mode (("\\.yaml\\'" . yaml-mode)
("\\.yml\\'" . yaml-mode)))
(init-message 1 "Menus")
(init-message 2 "Menus: Configuration")
(init-message 3 "Menus: Setup: Easy Menu")
(use-package easymenu
:straight (:type built-in))
(init-message 3 "Menus: Setup: Auto-Menu")
(use-package auto-menu
:load-path (lambda () (file-truename (expand-file-name "auto-menu.el" local-modules-dir)))
:commands (auto-menu
auto-menu-dired
auto-menu-file
auto-menu-file-dir))
(init-message 3 "Menus: Setup: Find or Browse File")
(defun find-or-browse-file (file)
"Based on file type either open FILE or browse FILE."
(let ((file (file-truename (expand-file-name file))))
(if (string= (file-name-extension file) "html")
(browse-url (concat "file://" file))
(find-file file))))
(init-message 2 "Menus: Buffer-Switch Menu")
(auto-menu
"Buffer-Switch"
`(("*scratch*" "(switch-to-buffer \"*scratch*\")" "Switch to '*scratch*' buffer.")
("*scratch* (new)" "(switch-to-buffer (generate-new-buffer-name \"*scratch*\"))" "Create and switch to a '*scratch*' buffer.")
("Current Mode *scratch*" "(switch-to-scratch-for-current-mode)" "Switch to '*scratch-MODE*' buffer.")
("Emacs Lisp *scratch*" "(new-emacs-lisp-scratch :use-existing)" "Switch to '*scratch-emacs-lisp*' buffer.")
("Emacs Lisp *scratch* (new)" "(new-emacs-lisp-scratch)" "Create and switch to '*scratch-emacs-lisp*' buffer.")
("Org *scratch*" "(new-org-scratch :use-existing)" "Switch to '*scratch-org*' buffer.")
("Org *scratch* (new)" "(new-org-scratch)" "Create and switch to '*scratch-org*' buffer.")
("*messages*" "(switch-to-buffer \"*Messages*\")" "Switch to '*Messages*' buffer.")))
(init-message 2 "Menus: Dired Menu")
(auto-menu
"Dired"
(auto-menu-dired `(("home" . "~/")
,(cons "emacs" emacs-home-dir)
("config" . "~/config")
("config-private" . "~/config-private")
("bin" . "~/bin")
("org" . "~/org")
("web" . "~/web")
("web/org" . "~/web/org")
("public_html" . "~/public_html")
("reminders" . "~/reminders")
("doc" . "~/doc")
("bbs" . "~/doc/bbs")
("dev" . "~/dev")
("prj" . "~/prj")
("code" . "~/code")
("github" . "~/code/github-nullman")
("media" . "/home/data/media")
("music" . "/home/data/media/Audio/Music")
("text" . "/home/data/media/Text")
("softwre" . "/home/data/media/Software")
("repos" . "/home/data/media/Repos")
("Downloads" . "~/Downloads")
("Documents" . "~/Documents")
("QubesIncoming" . "~/QubesIncoming")
("clisp" . "~/dev/clisp")
("racket" . "~/dev/racket")
("erlang" . "~/dev/erlang")
("basic" . "~/dev/basic")
("java" . "~/dev/java")
("javascript" . "~/dev/javascript")
("kotlin" . "~/dev/kotlin")
,(cons "emacs-help" (concat emacs-home-dir "/help")))))
(init-message 2 "Menus: Load Menu")
(auto-menu
"Load"
`(
("Home Files..."
,(auto-menu-file '((".alias" . "~/.alias")
(".alias-local" . "~/.alias-local")
(".alias-work" . "~/.alias-work")
(".aspell.en.pws" . "~/.aspell.en.pws")
(".bashrc" . "~/.bashrc")
(".funct" . "~/.funct")
(".funct-local" . "~/.funct-local")
(".funct-work" . "~/.funct-work")
(".gopherus.bookmarks" . "~/.gopherus.bookmarks")
(".profile" . "~/.profile")
(".profile-local" . "~/.profile-local")
(".profile-work" . "~/.profile-work")
(".profile_run" . "~/.profile_run")
(".xbindkeysrc" . "~/.xbindkeysrc"))))
("Emacs Initialization..."
,(auto-menu-file `(("init-emacs.org" . ,(file-truename (expand-file-name "init-emacs.org" emacs-home-dir)))
("customization.el" . ,(file-truename (expand-file-name "customization.el" emacs-home-dir))))))
("Emacs Personal Modules..."
,(auto-menu-file-dir local-modules-dir "\\.el\\'" "find-file" t))
("Bin Files..."
,(auto-menu-file '(("get-emacs-modules" . "~/bin/get-emacs-modules"))))
("Web Org Files..."
,(auto-menu-file-dir "~/web/org" "\\.org\\'" "find-file" t))
("Org Files..."
,(cl-remove-if (lambda (x) (string-prefix-p "agenda-" (car x)))
(auto-menu-file-dir "~/org" "\\.\\(org\\|org\\.gpg\\)\\'" "find-file" t)))
("Agenda Files..."
,(cl-remove-if (lambda (x) (not (string-prefix-p "agenda-" (car x))))
(auto-menu-file-dir "~/org" "\\.\\(org\\|org\\.gpg\\)\\'" "find-file" t)))
("Bookmarks" "load-bookmarks" "Load `~/lynx_bookmarks.html' file.")
("Emacs Work Modules..."
,(auto-menu-file-dir local-work-modules-dir "\\.el\\'" "find-file" t))
("Clojure Files..."
,(auto-menu-file-dir "~/dev/clojure" "\\.clj\\'" "find-file" t))
("CLisp Files..."
,(auto-menu-file-dir "~/dev/clisp" "\\.lisp\\'" "find-file" t))
("Erlang Files..."
,(auto-menu-file-dir "~/dev/erlang" "\\.erl\\'" "find-file" t))
("BASIC Files..."
,(auto-menu-file-dir "~/dev/basic" "\\.bas\\'" "find-file" t))
("Javascript Files..."
,(auto-menu-file-dir "~/dev/javascript" "\\.js\\'" "find-file" t))
))
(init-message 2 "Menus: Application Menu")
(auto-menu
"Applications"
`(("Bookmarks" "load-bookmarks" "Load bookmarks.")
("Calc" "calc" "Run Calc (The Emacs Calculator).")
("Elfeed" "elfeed" "Run Elfeed (Emacs Atom/RSS feed reader).")
("Elpher" "elpher" "Run Elpher (Emacs Gopher Client).")
("ERC" "erc" "Run ERC (Emacs Internet Relay Chat client).")
("Gnus" "gnus" "Run Gnus (Newsreader)")
("Mastodon" "mastodon" "Run Mastodon (Social Client)")))
(init-message 2 "Menus: Run-File Menu")
(auto-menu
"Run-File"
`(("init.el" ,(concat "(safe-load \"" (file-truename (expand-file-name "init.el" emacs-home-dir)) "\")") "Run init.el to re-initialize Emacs.")
("Emacs Personal Modules..."
,(auto-menu-file-dir local-modules-dir "\\.el\\'" "safe-load-compile" t))
("Clojure Files..."
,(auto-menu-file-dir "~/dev/clojure" "\\.clj\\'" "slime-load-file" t))
("CLisp Files..."
,(auto-menu-file-dir "~/dev/clisp" "\\.lisp\\'" "slime-load-file" t))
))
(init-message 2 "Menus: Website Menu")
(auto-menu
"Website"
`(("Blog"
(("Blog Post" "org-website-blog-post-create" "Create a new blog post.")
("Update Blog Post Timestamp" "org-website-blog-post-update-posted" "Update blog post timestamp.")))
("Publish"
(("Publish" "org-website-publish-async" "Publish entire website.")
("Force Publish" "(org-website-publish-async nil t)" "Force publish entire website.")
("nullman" "(org-website-publish-async \"nullman\")" "Publish nullman website.")
("nullman (Force)" "(org-website-publish-async \"nullman\" t)" "Force publish nullman website.")
("blog" "(org-website-publish-async \"blog\")" "Publish blog website.")
("blog (Force)" "(org-website-publish-async \"blog\" t)" "Force publish blog website.")
("nullware" "(org-website-publish-async \"nullware\")" "Publish nullware website.")
("nullware (Force)" "(org-website-publish-async \"nullware\" t)" "Force publish nullware website.")
("kylesherman" "(org-website-publish-async \"kylesherman\")" "Publish kylesherman website.")
("kylesherman (Force)" "(org-website-publish-async \"kylesherman\" t)" "Force publish kylesherman website.")
("shermanwest" "(org-website-publish-async \"shermanwest\")" "Publish shermanwest website.")
("shermanwest (Force)" "(org-website-publish-async \"shermanwest\" t)" "Force publish shermanwest website.")))
("Tangle and Publish"
(("All" "org-website-tangle-publish-async" "Tangle and publish entire website.")
("Force All" "(org-website-tangle-publish-async nil t)" "Force tangle and publish entire website asynchronously.")
("nullman" "(org-website-tangle-publish-async \"nullman\")" "Tangle and publish nullman website.")
("nullman (Force)" "(org-website-tangle-publish-async \"nullman\" t)" "Force tangle and publish nullman website.")
("blog" "(org-website-tangle-publish-async \"blog\")" "Tangle and publish blog website.")
("blog (Force)" "(org-website-tangle-publish-async \"blog\" t)" "Force tangle and publish blog website.")
("nullware" "(org-website-tangle-publish-async \"nullware\")" "Tangle and publish nullware website.")
("nullware (Force)" "(org-website-tangle-publish-async \"nullware\" t)" "Force tangle and publish nullware website.")
("kylesherman" "(org-website-tangle-publish-async \"kylesherman\")" "Tangle and publish kylesherman website.")
("kylesherman (Force)" "(org-website-tangle-publish-async \"kylesherman\" t)" "Force tangle and publish kylesherman website.")
("shermanwest" "(org-website-tangle-publish-async \"shermanwest\")" "Tangle and publish shermanwest website.")
("shermanwest (Force)" "(org-website-tangle-publish-async \"shermanwest\" t)" "Force tangle and publish shermanwest website.")))
("Remote Synchronization"
( ("Website to Morpheus" "org-website-rsync-to-morpheus-async" "Rsync website to morpheus server.")
("Website to DigitalOcean" "org-website-rsync-to-digitalocean-async" "Rsync website to DigitalOcean server.")
("Powerhouse to DigitalOcean" "(org-website-rsync-to-digitalocean-async \"powerhouse\")" "Rsync Powerhouse to DigitalOcean server.")
("Bloodmoon to DigitalOcean" "(org-website-rsync-to-digitalocean-async \"bloodmoon\")" "Rsync Bloodmoon to DigitalOcean server.")))
))
(init-message 2 "Menus: Package Manager Menu")
(auto-menu
"Package Manager"
`(("List Packages" "(package-list-packages :nofetch)" "List packages.")
("List Packages (Refresh)" "package-list-packages" "List packages (after refresh).")
("Install Package" "package-install" "Install package.")
("Refresh Recipes (straight)" "straight-pull-recipe-repositories" "Refresh recipe repositories.")
("Pull All (straight)" "straight-pull-all" "Pull all packages.")
("Remove Unused (straight)" "(straight-remove-unused-repos t)" "Remove unused recipies.")
))
(init-message 2 "Menus: Miscellaneous Menu")
(setq bbs-directory (file-truename (expand-file-name "~/doc/bbs")))
(auto-menu
"Misc"
`(("BBS"
(("Level 29 BBS Fetch"
"(progn (find-file (file-truename (expand-file-name \"level-29-bbs.org\" bbs-directory))) (unless (fboundp 'l29-fetch-messages-new) (org-babel-execute-buffer)) (l29-fetch-messages-new))"
"Run `l29-fetch-messages-new' to fetch new messages from the Level 29 BBS into level-29-bbs.org.")
("House of Lunduke BBS Fetch"
"(progn (find-file (file-truename (expand-file-name \"house-of-lunduke-bbs.org\" bbs-directory))) (unless (fboundp 'lunduke-fetch-messages-new) (org-babel-execute-buffer)) (lunduke-fetch-messages-new))"
"Run `lunduke-fetch-messages-new' to fetch new messages from the House of Lunduke BBS into house-of-lunduke-bbs.org.")))
("Byte-Compile"
(("Generate `init-emacs.el'"
"(org-babel-generate-elisp-file (file-truename (expand-file-name \"init-emacs.org\" emacs-home-dir)))"
"Run `org-babel-generate-elisp-file' on init-emacs.org to produce init-emacs.el.")
("Generate and Byte-Compile `init-emacs.el'"
"(org-babel-generate-elisp-file (file-truename (expand-file-name \"init-emacs.org\" emacs-home-dir)) t t)"
"Run `org-babel-generate-elisp-file' on init-emacs.org to produce init-emacs.el and init-emacs.elc.")
,(list (concat "Compile Personal Modules Directory")
(concat "(compile-elisp \"" local-modules-dir "\")")
(concat "Byte-Compile `" local-modules-dir "' directory."))
))
("Command Log"
(("Command Log Mode ON" "command-log-mode-on" "Turn on ‘command-log-mode’ and open the log buffer.")
("Command Log Mode OFF" "command-log-mode-off" "Turn off ‘command-log-mode’ and close the log buffer.")
("Clear Command Log Buffer" "clm/command-log-clear" "Clear the command log buffer.")))
("Coding System"
(("UNIX Coding System" "(set-coding-system 'unix)" "Call `set-coding-system' to set the coding system to UNIX.")
("DOS Coding System" "(set-coding-system 'dos)" "Call `set-coding-system' to set the coding system to DOS.")
("Mac Coding System" "(set-coding-system 'mac)" "Call `set-coding-system' to set the coding system to Mac.")))
("Development"
(("Racket REPL" "run-racket" "Start Racket REPL for interactively evaluating Racket expressions.")
("Kotlin REPL" "kotlin-repl" "Start Kotlin REPL for interactively evaluating Kotlin expressions.")
("Common Lisp SLIME Mode" "(slime 'clisp)" "Start SLIME mode for interactively evaluating Common Lisp expressions.")
("Steel Bank Common Lisp SLIME Mode" "(slime 'sbcl)" "Start SLIME mode for interactively evaluating Common Lisp expressions.")
("Clojure SLIME Mode" "(slime 'clojure)" "Start SLIME mode for interactively evaluating Clojure expressions.")
("Evaluate SLIME Buffer" "slime-eval-buffer" "Run `slime-eval-buffer' on the current buffer.")
("Python REPL" "elpy-shell-switch-to-shell" "Start Python REPL for interactively evaluating Python expressions.")))
("Display"
(("World Time" "display-time-world" "Display the time in various time zones.")
("Colors Display" "list-colors-display" "List Emacs font colors.")
("Faces Display" "list-faces-display" "List Emacs font faces.")
("Character Sets Display" "list-character-sets" "List character sets.")
("Unicode Character Set Display" "list-charset-unicode" "List `unicode-bmp' character set.")))
("Edit"
(("Replacer Replacements" "replacer-replacements-edit" "Edit `replacer-replacements'.")
("Elfeed Boookmarks" "elfeed-bookmarks-edit" "Edit Elfeeds bookmarks file.")
("Elpher Bookmarks" "elpher-bookmarks-edit" "Edit Elpher bookmarks file.")
("YouTube Get Videos" "(org-link-open-from-string \"file:~/config-private/common/org/init-home.org::get-youtube-videos\")" "Edit get-youtube-videos file.")))
("Export"
(("Export Bookmarks to JSON" "(org-bookmarks-export-to-json \"~/org/bookmarks.org\" \"~/Documents/bookmarks.json\")" "Export bookmarks.org to ~/Documents/bookmarks.json.")
("Export Bookmarks to Text" "(org-bookmarks-export-to-text \"~/org/bookmarks.org\" \"~/Documents/bookmarks.txt\")" "Export bookmarks.org to ~/Documents/bookmarks.txt.")
("Export Bookmarks to HTML" "(org-bookmarks-export-to-html \"~/org/bookmarks.org\" \"~/Documents/bookmarks.html\")" "Export bookmarks.org to ~/Documents/bookmarks.html.")
("Export Bookmarks to NYXT" "(org-bookmarks-export-to-nyxt \"~/org/bookmarks.org\" \"~/config/local/.local/share/nyxt/bookmarks.lisp\")" "Export bookmarks.org to ~/config/local/.local/share/nyxt/bookmarks.lisp.")
("Export Bookmarks to Chrome HTML" "(org-bookmarks-export-to-chrome-html \"~/org/bookmarks.org\" \"~/Documents/bookmarks-chrome.html\")" "Export bookmarks.org to ~/Documents/bookmarks-chrome.html.")))
("Fonts"
(("Hack Nerd Font Mono-12" "(set-frame-font \"Hack Nerd Font Mono-12\" nil t)" "Call `set-frame-font` to set the font to 'Hack Nerd Font Mono-12'.")
("Hack Nerd Font Mono-14" "(set-frame-font \"Hack Nerd Font Mono-14\" nil t)" "Call `set-frame-font` to set the font to 'Hack Nerd Font Mono-14'.")
("BitstreamVeraSansMono Nerd Font Mono-12" "(set-frame-font \"BitstreamVeraSansMono Nerd Font Mono-12\" nil t)" "Call `set-frame-font` to set the font to 'BitstreamVeraSansMono Nerd Font Mono-12'.")
("BitstreamVeraSansMono Nerd Font Mono-14" "(set-frame-font \"BitstreamVeraSansMono Nerd Font Mono-14\" nil t)" "Call `set-frame-font` to set the font to 'BitstreamVeraSansMono Nerd Font Mono-14'.")
("DroidSansMono Nerd Font Mono-12" "(set-frame-font \"DroidSansMono Nerd Font Mono-12\" nil t)" "Call `set-frame-font` to set the font to 'DroidSansMono Nerd Font Mono-12'.")
("DroidSansMono Nerd Font Mono-14" "(set-frame-font \"DroidSansMono Nerd Font Mono-14\" nil t)" "Call `set-frame-font` to set the font to 'DroidSansMono Nerd Font Mono-14'.")
("9x15" "(set-frame-font \"9x15\" nil t)" "Call `set-frame-font` to set the font to '9x15'.")))
("Reformat"
(("JSON Reformat" "json-pretty-print" "Reformat (pretty-print) JSON in current buffer.")
("XML Reformat" "xml-pretty-print" "Reformat (pretty-print) XML in current buffer.")
("Java Reformat" "java-pretty-print" "Reformat (pretty-print) Java code in current buffer.")
("Ruby Reformat" "ruby-pretty-print" "Reformat (pretty-print) Ruby code in current buffer.")
("C Reformat" "c-pretty-print" "Reformat (pretty-print) C code in current buffer.")))
("Toggle"
(("Debug on Error Mode" "toggle-debug-on-error" "Toggle `debug-on-error'.")
("Debug on Quit Mode" "toggle-debug-on-quit" "Toggle `debug-on-quit'.")
("Truncate Line Mode" "toggle-truncate-lines" "Toggle `truncate-lines' in current buffer.")
("Visual Line Mode" "visual-line-mode" "Toggle `visual-line-mode' in current buffer.")
("Search Case Sensitivity" "toggle-case-fold-search" "Toggle case-fold-search in current buffer.")))
("TAGS"
(("Visit Local TAGS" "(when (find-file-updir \"TAGS\") (visit-tags-table (find-file-updir \"TAGS\") t))" "Visit local tags table.")
("Create Local TAGS" "etags-create" "Create local tags table.")))
("Revert Buffer" "revert-buffer" "Run `revert-buffer' on current buffer.")
("Git Status" "(magit-status default-directory)" "Open Git Status buffer.")
("Web Jump" "webjump" "Jump to a Web site from a programmable hotlist.")
("IELM Mode" "ielm" "Open buffer for interactively evaluating Emacs Lisp expressions.")
("Evaluate Buffer" "eval-buffer" "Run `eval-buffer' on the current buffer.")
("Customize Group" "customize-group" "Run `customize-group' function.")
("Regular Expression Builder" "regexp-builder" "Start Regular Expression Builder in current buffer.")
("Restart Emacs Server" "server-start-maybe" "Restart Emacs server.")
))
(init-message 2 "Menus: Manuals Menu")
(auto-menu
"Manuals"
`(("Help Files" ,(auto-menu-file-dir (concat emacs-home-dir "/help") ".*" "find-or-browse-file" t))
("Man Pages" "woman" "Browse man pages.")
("Emacs Manual" "(info \"emacs-24/emacs\")" "Open Emacs manual.")
("Elisp Manual" "(info \"emacs-24/elisp\")" "Open Elisp manual.")
("Org Mode Manual" "(info \"/usr/share/info/org.gz\")" "Open Org Mode manual.")
("Screen Manual" "(info \"screen\")" "Open Screen manual.")
("SED Manual" "(info \"sed\")" "Open SED manual.")
("Grep Manual" "(info \"grep\")" "Open Grep pattern matching manual.")
("DC Manual" "(info \"dc\")" "Open arbitrary precision RPN Desktop Calculator manual.")
("Wget Manual" "(info \"wget\")" "Open Wget manual.")))
(init-message 2 "Menus: Web Menu")
(when (boundp 'web-query-list)
(auto-menu
"Web"
(mapcar (lambda (x)
(list (car x)
(concat "(web-query \"" (car x) "\")")
(concat "Query web for \\\"" (car x) "\\\".")))
web-query-list)))
(init-message 2 "Menus: Insert Menu")
(auto-menu
"Insert"
'(("Org Inserts"
(("Header" "org-insert-header" "Insert literate programming header.")
("Table" "org-insert-table" "Insert table template.")
("TOC Header" "org-insert-toc-header" "Insert table of contents header.")
("Name" "org-insert-literate-programming-name" "Insert #+NAME.")
("Block" "org-insert-literate-programming-block" "Insert block.")
("Emacs Init Block" "org-insert-literate-programming-init-emacs-block" "Insert Emacs Init block.")
("Code Block" "org-insert-literate-programming-code-block" "Insert Code block.")
("Project Euler Block" "org-insert-literate-programming-project-euler-problem-block" "Insert Project Euler block.")
("Source Block" "org-insert-literate-programming-src" "Insert #+BEGIN_SRC ... #+END_SRC block.")
("Shell Block" "org-insert-literate-programming-src-sh" "Insert #+BEGIN_SRC sh ... #+END_SRC block.")
("Emacs Lisp Source Block" "org-insert-literate-programming-src-emacs-lisp" "Insert #+BEGIN_SRC emacs-lisp ... #+END_SRC block.")
("Racket Source Block" "org-insert-literate-programming-src-racket" "Insert #+BEGIN_SRC racket ... #+END_SRC block.")
("Kotlin Source Block" "org-insert-literate-programming-src-kotlin" "Insert #+BEGIN_SRC kotlin ... #+END_SRC block.")))
("Lisp Inserts"
(("Lisp Comment Block (Equal)" "insert-lisp-comment-block-equal" "Insert Lisp style comment block using equals.")
("Lisp Comment Block (Dash)" "insert-lisp-comment-block-dash" "Insert Lisp style comment block using dashes.")))
("C Inserts"
(("C Comment Block" "insert-c-comment-block" "Insert C/C++/Java style comment block.")
("C Comment Stub" "insert-c-comment-stub" "Insert C/C++/Java style comment stub.")))
("Date YYYY-MM-DD" "insert-date" "Insert date in YYYY-MM-DD format.")
("Date/Time YYYY-MM-DD HH:MM:SS" "insert-datetime" "Insert date/time in YYYY-MM-DD HH:MM:SS format.")
("Time HH:MM:SS" "insert-time" "Insert time in HH:MM:SS format.")
("UUID" "insert-uuid" "Insert a UUID.")
("GUID" "insert-guid" "Insert a GUID.")
("Password" "insert-password-20" "Insert a random password (length 20).")
("Password Phrase" "insert-password-phrase-6-symbol-capitalize" "Insert a random password phrase (six words, hyphenated, capitalized, with symbols).")
("Figlet" "insert-figlet" "Insert figlet text.")
("Equals" "append-equal-to-column-80" "Append `=' characters up to column 80.")
("Dashes" "append-dash-to-column-80" "Append `-' characters up to column 80.")
("Asterisks" "append-asterisk-to-column-80" "Append `*' characters up to column 80.")
("XML Header" "insert-xml-header" "Insert XML header line.")
("DB Change Log" "insert-db-change-log-template-line" "Insert template line for DB change log.")
("DB Change Log Legacy" "insert-db-change-log-template-line-legacy" "Insert template line for legacy DB change log.")
("Capture Table" "(table-capture (mark) (point) \" \" \"\n\" 'left 20)" "Capture table from selected text.")
("Apostrophe" "(insert \"’\")" "Insert a fancy apostrophe `’'.")
("Lexical Binding" "insert-lexical-binding" "Insert elisp lexical binding header.")
))
(init-message 2 "Menus: Weather Menu")
(when (and (functionp 'wttrin-query)
(boundp 'wttrin-default-cities))
(auto-menu
"Weather"
(mapcar (lambda (x)
(list x
(concat "(wttrin-query \"" x "\")")
(concat "Show weather report for \\\"" x "\\\".")))
wttrin-default-cities)))
(init-message 2 "Menus: Games Menu")
(auto-menu
"Games"
`(("5x5" "5x5" "Simple little puzzle game.")
("Blackbox" "blackbox" "Blackbox is a game of hide and seek.")
("Bubbles" "bubbles" "Remove all bubbles with as few moves as possible.")
("Doctor" "doctor" "Psychological help for frustrated users.")
("Dunnet" "dunnet" "Text adventure game.")
("Gomoku" "gomoku" "Gomoku game between you and Emacs.")
("Hanoi" "hanoi" "Towers of Hanoi diversion.")
("Life" "life" "John Horton Conway's game of Life.")
("Mpuz" "mpuz" "Multiplication puzzle.")
("Pong" "pong" "Classical implementation of pong.")
("Snake" "snake" "Implementation of the Snake game.")
("Solitaire" "solitaire" "Game of solitaire.")
("Tetris" "tetris" "Implementation of Tetris.")))
(init-message 1 "Snippets")
(init-message 2 "Snippets: Configuration")
(init-message 3 "Snippets: Setup: Yasnippet")
(use-package yasnippet
:straight t
:diminish yas-minor-mode
:bind (:map yas-minor-mode-map
("C-c & n" . yas-new-snippet)
("C-c & s" . yas-insert-snippet)
("C-c & v" . yas-visit-snippet-file)
("C-/" . yas-insert-snippet)) :config
(yas-global-mode 1)
(define-key yas-minor-mode-map [(tab)] nil)
(define-key yas-minor-mode-map (kbd "TAB") nil)
(define-key yas-minor-mode-map (kbd "<tab>") nil)
)
(init-message 4 "Snippets: Setup: Yasnippet: Yasnippet Snippets")
(use-package yasnippet-snippets
:straight t
:after (yasnippet))
(init-message 2 "Snippets: Org-Mode")
(init-message 1 "Hydras")
(init-message 2 "Hydras: Configuration")
(init-message 3 "hydra")
(use-package hydra
:straight t)
(when window-system-windows
(init-message 1 "Windows OS")
(setenv "TEMP" "c:/windows/temp")
(setenv "TMP" "c:/windows/temp")
(bind-keys ("<next>" . scroll-up-enhanced)
("<prior>" . scroll-down-enhanced)))
(init-message 1 "Gnus")
(use-package gnus
:straight (:type built-in)
:defines (gnus-subscribe-newsgroup-method
sendmail-program mail-envelope-from
smtpmail-smtp-server
smtpmail-smtp-service)
:config
(setq gnus-select-method '(nnimap "gmail"
(nnimap-address "imap.gmail.com")
(nnimap-server-port 993)
(nnimap-stream ssl)))
(setq smtpmail-smtp-server "smtp.gmail.com"
smtpmail-smtp-service 587
gnus-ignored-newsgroups "^to\\.\\|^[0-9. ]+\\( \\|$\\)\\|^[\"]\"[#'()]")
(setq mail-sources nil)
(setq mail-user-agent 'gnus-user-agent)
(setq gnus-agent-cache t)
(setq gnus-auto-expirable-newsgroups "Trash")
(setq gnus-large-newsgroup nil)
(setq gnus-summary-line-format "%U%R%z %o %I%(%[%-25,25n%]%) %s\n")
(setq sendmail-program "/usr/bin/msmtp"
mail-specify-envelope-from t
mail-envelope-from 'header)
(setq mail-from-style 'angles
mail-host-address user-mail-address
mail-interactive t)
(setq message-signature #'signature)
(add-hook 'message-send-hook #'ispell-message))
(init-message 3 "supercite")
(use-package supercite
:straight t
:after (gnus)
:commands (sc-cite-original)
:config
(setq sc-citation-leader "")
(setq message-cite-function 'sc-cite-original)
(add-hook 'mail-yank-hooks #'sc-cite-original))
(init-message 1 "ERC")
(init-message 2 "ERC: Configuration")
(use-package erc
:straight (:type built-in)
:config
(require 'erc-imenu)
(require 'erc-menu)
(require 'erc-notify)
(require 'erc-ring)
(erc-button-mode 1)
(erc-completion-mode 1)
(erc-fill-mode 1)
(erc-match-mode 1)
(erc-netsplit-mode 1)
(erc-services-mode 1)
(erc-timestamp-mode 1)
(erc-track-mode 1)
(add-hook 'erc-mode-hook #'erc-add-scroll-to-bottom)
)
(init-message 2 "ERC: Customization")
(use-package erc
:straight (:type built-in)
:config
(setq erc-auto-query t)
(setq erc-echo-notices-in-minibuffer-flag t)
(setq erc-fill-column (- (window-width) 2))
(setq erc-fill-function 'erc-fill-static)
(setq erc-interpret-mirc-color t)
(setq erc-hide-list '("JOIN" "PART" "QUIT"))
(setq erc-nick "nullman")
(setq erc-pals '("jam" "dmitri" "peter" "glenn" "vin"))
(setq erc-notify-list erc-pals)
(setq erc-autojoin-channels-alist '((".*freenode\.net" . ("#emacs"
"#lisp"
))
(".*dowjones\.net" . ("#dev"))
("sbkdevtick11" . ("#dev"))
("localhost" . ("#collab"))))
(mapc (lambda (x) (add-to-list 'erc-modules x t))
'(autojoin button completion fill identd irccontrols list match menu
move-to-prompt netsplit networks noncommands readonly ring
scrolltobottom services stamp spelling track))
(defconst erc-auth-file-name (file-truename (expand-file-name "~/.erc-auth")))
(when (file-exists-p erc-auth-file-name)
(setq erc-prompt-for-nickserv-password nil)
(load erc-auth-file-name)))
(init-message 2 "ERC: Functions")
(init-message 3 "ERC: Functions: Nick from System Name")
(use-package erc
:straight (:type built-in)
:config
(defun erc-nick-from-system-name ()
"Return a nickname based on machine name.
Defaults to \"nullman\" if no match is found."
(let* ((server-nick '(
))
(nick (cdr (assoc (system-name) server-nick))))
(or nick erc-nick))))
(init-message 3 "ERC: Functions: Localhost")
(use-package erc
:straight (:type built-in)
:commands (erc)
:config
(defun erc-localhost ()
"Connect to localhost irc server."
(interactive)
(let ((nick (erc-nick-from-system-name)))
(erc-services-disable)
(erc :server "localhost" :port "6667" :nick nick :password nil :full-name "Kyle Sherman"))))
(init-message 3 "ERC: Functions: Localhost Bitlbee")
(use-package erc
:straight (:type built-in)
:config
(defun erc-localhost-bitlbee ()
"Connect to localhost bitlbee server."
(interactive)
(let ((nick (erc-nick-from-system-name)))
(erc-services-disable)
(erc :server "localhost" :port "6668" :nick nick :password nil :full-name "Kyle Sherman"))))
(init-message 3 "ERC: Functions: Freenode")
(use-package erc
:straight (:type built-in)
:config
(defun erc-freenode ()
"Connect to irc.freenode.net irc server."
(interactive)
(let ((nick (erc-nick-from-system-name)))
(erc-services-enable)
(erc :server "irc.freenode.net" :port "6667" :nick nick :password nil :full-name "Kyle Sherman"))))
(init-message 3 "ERC: Functions: Work")
(use-package erc
:straight (:type built-in)
:config
(defun erc-work ()
"Connect to work IRC server."
(interactive)
"Connect to irc.win.dowjones.net IRC server."
(erc-services-disable)
(erc :server "irc.win.dowjones.net" :port "6667" :nick "kyle" :password nil :full-name "Kyle Sherman")))
(init-message 2 "ERC: Commands")
(init-message 3 "ERC: Commands: UPTIME")
(use-package erc
:straight (:type built-in)
:commands (erc-send-message)
:config
(defun erc-cmd-UPTIME (&rest _)
"Display the uptime of the system, as well as some load-related stuff,
to the current ERC buffer."
(let ((uname-output
(replace-regexp-in-string
", load average: " "] {Load average} ["
(replace-regexp-in-string
" +" " "
(replace-regexp-in-string
"^ +\\|[ \n]+$" ""
(shell-command-to-string "uptime"))))))
(erc-send-message
(concat "{Uptime} [" uname-output "]")))))
(init-message 3 "ERC: Commands: WI")
(use-package erc
:straight (:type built-in)
:config
(defun erc-cmd-WI (nick &rest _)
"`/WHOIS' command with extra user information."
(erc-server-send (mapconcat #'identity (list "WHOIS" nick nick) " "))))
(init-message 3 "ERC: Commands: IDENTIFY")
(use-package erc
:straight (:type built-in)
:commands (erc-server-send)
:config
(defun erc-cmd-IDENTIFY (password &rest _)
"Send PASSWORD to NickServ, `/msg NickServ identify PASSWORD'."
(erc-server-send (mapconcat #'identity (list "identify" password) " "))))
(when work-system
(init-message 1 "Work"))
(when work-system
(init-message 2 "Work: Modules")
)
(when work-system
(init-message 2 "Work: Settings")
(setq browse-url-browser-function #'browse-url-default-browser)
(setq browse-url-secondary-browser-function #'browse-url-default-browser)
(add-to-list 'remove-tabs-exceptions '(:file . "\\.t\\'") t)
(add-to-list 'remove-tabs-exceptions '(:file . "\\.tt\\'") t)
(add-to-list 'remove-tabs-exceptions '(:file . "\\.pm\\'") t)
(setq sql-product 'ms)
(setq sql-ms-program "sqlcmd")
(setq sql-ms-options '("-I" "-k" "-s" "|"))
(setq sql-connection-alist
'((dev (sql-product 'ms)
(sql-server "wk8683.infinitecampus.com")
(sql-port 1344)
(sql-database "CampusMasterMN")
(sql-user "dev")
(sql-password "devTest"))
(issuetest (sql-product 'ms)
(sql-server "b4660797-app001.infinitecampus.com")
(sql-port 1344)
(sql-database "3384-littleton-20210801_2101")
(sql-user "IssueTestUser-3384-littleton-20210801_2101-962")
(sql-password "h*cjFmVd9S0Hoqui7GQpiZ%chEit@y"))))
(defun sql-ms-dev ()
"Connect to local dev database."
(interactive)
(sql-connect 'dev))
(defun sql-ms-issuetest ()
"Connect to issuetest database."
(interactive)
(sql-connect 'issuetest)))
(when work-system
(init-message 2 "Work: Functions"))
(when (and work-system
(fboundp 'work-git-commit-start-end-log)
(fboundp 'work-linkify-jira-card))
(init-message 3 "Work: Functions: work-insert-release-pr-list")
(defun work-insert-release-pr-list (&optional commit-start commit-end)
"Insert a list of pull requests between COMMIT-START and COMMIT-END."
(interactive)
(cl-labels
((fix-branch ()
(save-mark-and-excursion
(save-match-data
(while (re-search-forward " " (line-end-position) :noerror)
(replace-match "-" t))))
(save-mark-and-excursion
(save-match-data
(while (re-search-forward "\\(\\[\\|\\]\\)" (line-end-position) :noerror)
(replace-match "" t))))))
(cl-multiple-value-bind (commit-start commit-end log)
(work-git-commit-start-end-log commit-start commit-end)
(let (prs)
(with-temp-buffer
(insert log)
(goto-char (point-min))
(while (re-search-forward "\\bfeature/" nil :noerror)
(replace-match ""))
(goto-char (point-min))
(while (re-search-forward "\\[?\\b[Aa][Nn][Dd][Rr][Oo][Ii][Dd]-" nil :noerror)
(replace-match "ANDROID-" t)
(fix-branch)
(forward-line 0)
(when (re-search-forward "\\b\\(ANDROID-[[:digit:]]+\\)\\([a-zA-Z0-9-_\.]*\\)\\b" nil :noerror)
(cl-pushnew (match-string 0) prs :test 'string=))
(goto-char (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "\\[?\\b[Aa][Dd][Ss][Gg][Rr][Oo][Uu][Pp]-" nil :noerror)
(replace-match "ADSGROUP-" t)
(fix-branch)
(forward-line 0)
(when (re-search-forward "\\b\\(ADSGROUP-[[:digit:]]+\\)\\([a-zA-Z0-9-_\.]*\\)\\b" nil :noerror)
(cl-pushnew (match-string 0) prs :test 'string=))
(goto-char (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "\\[?\\b[Bb][Ff][Oo]-" nil :noerror)
(replace-match "BFO-" t)
(fix-branch)
(forward-line 0)
(when (re-search-forward "\\b\\(BFO-[[:digit:]]+\\)\\([a-zA-Z0-9-_\.]*\\)\\b" nil :noerror)
(cl-pushnew (match-string 0) prs :test 'string=))
(goto-char (line-end-position)))
(goto-char (point-min))
(while (re-search-forward "\\[?\\b[Qq][Uu][Ii][Zz]-" nil :noerror)
(replace-match "QUIZ-" t)
(fix-branch)
(forward-line 0)
(when (re-search-forward "\\b\\(QUIZ-[[:digit:]]+\\)\\([a-zA-Z0-9-_\.]*\\)\\b" nil :noerror)
(cl-pushnew (match-string 0) prs :test 'string=))
(goto-char (line-end-position))))
(when prs
(insert
(with-temp-buffer
(dolist (pr prs)
(insert
(concat "- " pr))
(work-linkify-jira-card)
(newline))
(buffer-string)))))))))
(init-message 3 "Work: Functions: work-fix-json-array")
(defun work-fix-json-array ()
"Fix invalid JavaScript JSON array."
(interactive "*")
(save-mark-and-excursion
(goto-char (point-min))
(while (and (not (eobp))
(not (= (char-after) ?\[)))
(delete-char 1))
(goto-char (point-max))
(while (and (not (bobp))
(not (= (char-before) ?\])))
(backward-delete-char 1))
(goto-char (point-min))
(while (re-search-forward "\{" nil :no-error)
(let ((beg (point-marker))
(end (progn
(re-search-forward "\}")
(forward-char -1)
(point-marker))))
(goto-char (marker-position beg))
(while (re-search-forward "\n *" (marker-position end) :no-error)
(replace-match " "))))
(goto-char (point-min))
(while (re-search-forward ", \}" nil :no-error)
(replace-match " }"))
(goto-char (point-min))
(while (re-search-forward "\},\n[ \t]*\]" nil :no-error)
(replace-match "}\n]"))
(goto-char (point-min))
(while (re-search-forward "'" nil :no-error)
(replace-match "\""))))
(when work-system
(init-message 2 "Work: Menu")
(auto-menu
"Work"
`(("Dired..."
,(auto-menu-dired '(("work" . "~/work")
("Tomcat" . "~/ICAS-DEV-999.2.29/INFINITECAMPUS/tomcat/tigger-999.2.29")
("exceptionals-campus" . "~/work/exceptionals-campus")
("exceptionals-tl-ui" . "~/work/exceptionals-tl-ui")
("campus-5.0-apps" . "~/work/campus-5.0-apps"))))
("org-copy-to-clipboard" "org-copy-to-clipboard" "Reformat and copy org region to clipboard.")
("org-toggle-link-display" "org-toggle-link-display" "Toggle the literal or descriptive display of links.")
("org-toggle-headline-checkbox" "org-toggle-headline-checkbox" "Toggle between an Org headline and checkbox on current line.")
("org-table-remove-commas" "org-table-remove-commas" "Remove all commas in current Org table.")
("org-table-convert-region" "org-table-convert-region" "Convert region to a table."))))
(init-message 1 "Other")
(init-message 2 "Other: Apply Advice")
(init-message 3 "Other: Apply Advice: Compile Goto Error Org")
(defun compile-goto-error--org (&optional event)
"Open compilation bugs in org file for errors in tangled elisp code."
(when (eq major-mode 'emacs-lisp-mode)
(ignore-errors (org-babel-tangle-jump-to-org))))
(defun compilation-mode-hook--compile-goto-error ()
"Hook to advise `compile-goto-error'."
(advice-add 'compile-goto-error :after #'compile-goto-error--org))
(add-hook 'compilation-mode-hook #'compilation-mode-hook--compile-goto-error)
(init-message 2 "Other: Apply Patches")
(add-hook 'find-file-hook #'hack-local-variables)
(init-message 1 "Aliases")
(let ((data '(("Alias" "Function") ("lml" "list-matching-lines") ("qrr" "query-replace-regexp") ("rb" "revert-buffer") ("rxb" "regexp-builder"))))
(init-message 2 "Aliases: General")
(mapc (lambda (x) (defalias (intern (car x)) (intern (cadr x)))) (cdr data))
)
(init-message 1 "Final")
(init-message 2 "Final: Set Key Bindings")
(custom-key-bindings-set-all)
(init-message 2 "Final: Compile Personal Modules")
(let ((dir local-modules-dir))
(when (file-exists-p dir)
(dolist (file (directory-files dir t))
(when (file-readable-p file)
(cond
((string-match "^\\.\\.?$" (file-name-nondirectory file)))
((string-match ".*\\.el\\'" file)
(unless (file-directory-p file)
(compile-file-if-needed file))))))))
(init-message 2 "Final: Start Emacs Server")
(when (fboundp 'server-start-maybe)
(server-start-maybe))
(init-message 2 "Final: Remove Logging Buffers")
(when (get-buffer "Map_Sym.txt")
(kill-buffer "Map_Sym.txt"))
(init-message 2 "Final: Fix Info-Directory-List")
(when (boundp 'Info-directory-list)
(mapc (lambda (x) (add-to-list 'Info-directory-list x t))
Info-default-directory-list))
(init-message 2 "Final: Turn off Scroll Bar")
(when (fboundp 'scroll-bar-mode)
(scroll-bar-mode -1))
(init-message 2 "Final: Reset Emacs Lisp Garbage Collection Threshold")
(setq gc-cons-threshold (car (get 'gc-cons-threshold 'standard-value)))
(init-message 1 "End")