diff options
Diffstat (limited to '.config/emacs')
| -rw-r--r-- | .config/emacs/custom.el | 55 | ||||
| -rw-r--r-- | .config/emacs/eighters-theme.el | 600 | ||||
| -rw-r--r-- | .config/emacs/gnus/init.el | 368 | ||||
| -rw-r--r-- | .config/emacs/icons/compilation-failure.png | bin | 0 -> 124293 bytes | |||
| -rw-r--r-- | .config/emacs/icons/compilation-success.png | bin | 0 -> 269969 bytes | |||
| -rw-r--r-- | .config/emacs/init.el | 1018 |
6 files changed, 2041 insertions, 0 deletions
diff --git a/.config/emacs/custom.el b/.config/emacs/custom.el new file mode 100644 index 0000000..709ed2f --- /dev/null +++ b/.config/emacs/custom.el @@ -0,0 +1,55 @@ +(custom-set-variables + ;; custom-set-variables was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + '(after-save-hook '(executable-make-buffer-file-executable-if-script-p)) + '(async-shell-command-buffer 'new-buffer) + '(auto-revert-avoid-polling t) + '(backup-directory-alist '(("" . "~/.emacs.backup"))) + '(column-number-mode t) + '(comint-scroll-show-maximum-output nil) + '(delete-selection-mode t) + '(describe-bindings-outline t) + '(diff-default-read-only t) + '(electric-pair-mode t) + '(enable-recursive-minibuffers t) + '(epg-pinentry-mode 'loopback) + '(eshell-scroll-show-maximum-output nil) + '(find-ls-option '("-exec ls -ld {} +" . "-ld")) + '(font-use-system-font t) + '(footnote-body-tag-spacing 1) + '(footnote-section-tag "") + '(frame-resize-pixelwise t) + '(gdb-many-windows t) + '(global-page-break-lines-mode t nil (page-break-lines)) + '(gnus-cloud-method "nnimap:gmail") + '(highlight-nonselected-windows t) + '(hscroll-step 1) + '(ibuffer-default-sorting-mode 'filename/process) + '(indent-tabs-mode nil) + '(inhibit-startup-screen t) + '(line-number-display-limit-width 2000) + '(lua-indent-level 2) + '(menu-bar-mode nil) + '(minibuffer-depth-indicate-mode t) + '(page-break-lines-modes '(fundamental-mode text-mode prog-mode special-mode)) + '(read-char-by-name-sort 'code) + '(repeat-mode t) + '(scroll-bar-mode nil) + '(scroll-conservatively 10) + '(scroll-preserve-screen-position t) + '(send-mail-function 'smtpmail-send-it) + '(split-width-threshold 120) + '(switch-to-buffer-obey-display-actions t) + '(tab-bar-show 1) + '(tool-bar-mode nil) + '(truncate-lines t) + '(visual-line-fringe-indicators '(left-curly-arrow right-curly-arrow)) + '(what-cursor-show-names t)) +(custom-set-faces + ;; custom-set-faces was added by Custom. + ;; If you edit it by hand, you could mess it up, so be careful. + ;; Your init file should contain only one such instance. + ;; If there is more than one, they won't work right. + ) diff --git a/.config/emacs/eighters-theme.el b/.config/emacs/eighters-theme.el new file mode 100644 index 0000000..d81a070 --- /dev/null +++ b/.config/emacs/eighters-theme.el @@ -0,0 +1,600 @@ +;; -*- lexical-binding: t -*- + +(require 'color) +(require 'compile) ; compilation-*-directory-face +(require-theme 'modus-themes) + +(deftheme eighters + "Eighters gonna eight.") + +(defun eighters-hsl-to-hex (h s l) + (apply + 'color-rgb-to-hex + `(,@(color-hsl-to-rgb h s l) 2))) + +(defun eighters-decline-hue (name light-step) + (interactive + (list (read-color "Color to decline? ") + (read-number "Light step? (1β100) "))) + (pcase-let* ((`(,r ,g ,b) (color-name-to-rgb name)) + (`(,h _ _) (color-rgb-to-hsl r g b))) + (let ((variants (seq-map + (lambda (l) + (cons l (eighters-hsl-to-hex h 1.0 (/ l 100.0)))) + (number-sequence 0 100 light-step))) + (buf (format "*%s variants*" name))) + (with-current-buffer (get-buffer-create buf) + (pcase-dolist (`(,l . ,hex) variants) + (let ((cr (modus-themes-contrast "#fff" hex))) + (when (> cr 7.0) + (insert + (propertize (format "%s %3s\t%6.3f\n" hex l cr) + 'face `(:background ,hex :extend t)))))) + (pcase-dolist (`(,l . ,hex) variants) + (let ((cr (modus-themes-contrast "#000" hex))) + (when (> cr 7.0) + (insert + (propertize (format "%s %3s\t%6.3f\n" hex l cr) + 'face `(:foreground ,hex))))))) + (pop-to-buffer buf)))) + +(defvar eighters-hues + '((red . "brown2") + (green . "chartreuse2") + (yellow . "gold") + (blue . "steelblue1") + (magenta . "violet") + (cyan . "cadetblue2"))) + +(defvar eighters-palette + '((bg "#000") (bg-hl-dimmer "#0f0f0f") (bg-hl-dim "#181818") (bg-hl "#222") + (fg-red "#ed5e5e") (fg-red-dim "#ba5e5e") (fg-red-subtle "#f4a3a3") + (bg-red "#4c0000") (bg-red-dim "#300000") (bg-red-dimmer "#1e0000") + (fg-green "#a5ed5e") (fg-green-dim "#8bba5e") (fg-green-subtle "#cbf4a3") + (bg-green "#122600") (bg-green-dim "#0b1600") (bg-green-dimmer "#060c00") + (fg-yellow "#edd65e") (fg-yellow-dim "#baab5e") (fg-yellow-subtle "#f4e8a3") + (bg-yellow "#262000") (bg-yellow-dim "#161300") (bg-yellow-dimmer "#0c0a00") + (fg-blue "#5eaced") (fg-blue-dim "#5e90ba") (fg-blue-subtle "#a3cff4") + (bg-blue "#00223f") (bg-blue-dim "#001426") (bg-blue-dimmer "#000b14") + (fg-magenta "#ed5eed") (fg-magenta-dim "#ba5eba") (fg-magenta-subtle "#f4a3f4") + (bg-magenta "#420042") (bg-magenta-dim "#280028") (bg-magenta-dimmer "#190019") + (fg-cyan "#5edfed") (fg-cyan-dim "#5eb1ba") (fg-cyan-subtle "#a3edf4") + (bg-cyan "#002428") (bg-cyan-dim "#001416") (bg-cyan-dimmer "#000b0c") + (fg "#fff") (fg-dim "#bbb") (fg-dimmer "#888"))) + +(defun eighters--step-while (init step predicate) + (let ((result init) + (next init)) + (while (funcall predicate (cl-incf next step)) + (setq result next)) + result)) + +(defun eighters--brightest-bg (hue contrast-min) + (eighters-hsl-to-hex + hue 1 + (eighters--step-while + 0 .005 + (lambda (luminance) + (let ((candidate (eighters-hsl-to-hex hue 1 luminance))) + (> (modus-themes-contrast "#fff" candidate) contrast-min)))))) + +(defun eighters-set-palette () + (interactive) + (pcase-dolist (`(,hue-sym . ,hue-name) eighters-hues) + (let ((hue (car (apply 'color-rgb-to-hsl (color-name-to-rgb hue-name))))) + (setf + (eighters-color 'fg hue-sym nil) (eighters-hsl-to-hex hue .8 .65) + (eighters-color 'fg hue-sym 'dim) (eighters-hsl-to-hex hue .4 .55) + (eighters-color 'fg hue-sym 'subtle) (eighters-hsl-to-hex hue .8 .8) + (eighters-color 'bg hue-sym nil) (eighters--brightest-bg hue 16) + (eighters-color 'bg hue-sym 'dim) (eighters--brightest-bg hue 18.5) + (eighters-color 'bg hue-sym 'dimmer) (eighters--brightest-bg hue 19.75)))) + (load-theme 'eighters t)) + +(defun eighters-showcase--insert (&rest _) + (erase-buffer) + (pcase-dolist (`(,sym ,color) + eighters-palette) + (pcase-let* ((`(,r ,g ,b) (color-name-to-rgb color)) + (`(,h ,s ,l) (color-rgb-to-hsl r g b))) + (let (bg fg face) + (if (string-prefix-p "fg" (symbol-name sym)) + (setq fg color + bg "#000") + (setq bg color + fg "#fff")) + (setq face `(:foreground ,fg :background ,bg :extend t)) + (insert + (propertize (format "%-16s\t(%.3f %.3f %.3f) (%.3f %.3f %.3f)\t\t%.3f\n" + sym r g b h s l (modus-themes-contrast fg bg)) + 'face face)))))) + +(defun eighters-showcase () + (interactive) + (let ((buf (get-buffer-create "*Eighters palette*"))) + (with-current-buffer buf + (eighters-showcase--insert) + (setq-local revert-buffer-function 'eighters-showcase--insert) + (pop-to-buffer buf)))) + +(defun eighters-serialize () + (interactive) + (let ((blacks '(bg bg-hl-dimmer bg-hl-dim bg-hl)) + (colors '(red green yellow blue magenta cyan)) + (whites '(fg fg-dim fg-dimmer)) + (beg (point)) + (format-sym + (lambda (sym) + (format "(%s \"%s\")" + sym (car (alist-get sym eighters-palette)))))) + (insert + "(defvar eighters-palette\n'(" + (string-join (seq-map format-sym blacks) " ") + "\n") + (let ((beg (point))) + (dolist (hue colors) + (dolist (template '("fg-%s" "fg-%s-dim" "fg-%s-subtle")) + (insert (funcall format-sym (intern (format template hue))))) + (insert "\n") + (dolist (template '("bg-%s" "bg-%s-dim" "bg-%s-dimmer")) + (insert (funcall format-sym (intern (format template hue))))) + (insert "\n")) + (align-regexp beg (point) "\\(\\s-*\\)\\(\"[^)]\\|(\\)" 1 1 t)) + (insert + (string-join (seq-map format-sym whites) " ") + "))\n") + (indent-region beg (point)))) + +(defun eighters-color (symbol) + (car (alist-get symbol eighters-palette))) + +(defun eighters--sym (xground hue qualifier) + (intern + (apply 'concat `( ,(symbol-name xground) "-" + ,(symbol-name hue) + ,@(when qualifier `("-" ,(symbol-name qualifier))))))) + +(defun eighters-color-set (xground hue qualifier value) + (let ((sym (eighters--sym xground hue qualifier))) + (setf (car (alist-get sym eighters-palette)) value))) + +(gv-define-simple-setter eighters-color eighters-color-set) + +(defface eighters-button nil + "Face for elements that can be \"pushed\" with RET.") +(defface eighters-checkbox nil + "Face for text that represents togglable boxes.") +(defface eighters-citation-1 nil + "Face for level 1 citations.") +(defface eighters-citation-2 nil + "Face for level 2 citations.") +(defface eighters-citation-3 nil + "Face for level 3 citations.") +(defface eighters-citation-4 nil + "Face for level 4 citations.") +(defface eighters-citation-5 nil + "Face for level 5 citations.") +(defface eighters-citation-6 nil + "Face for level 6 citations.") +(defface eighters-date nil + "Face for text that describes dates.") +(defface eighters-identity nil + "Face for names of persons.") +(defface eighters-markup nil + "Face for text that describes \"structure\" rather than content.") +(defface eighters-metadata nil + "Face for extra context surrounding something of interest.") +(defface eighters-title-1 nil + "Face for level 1 headings.") +(defface eighters-title-2 nil + "Face for level 2 headings.") +(defface eighters-title-3 nil + "Face for level 3 headings.") +(defface eighters-title-4 nil + "Face for level 4 headings.") +(defface eighters-title-5 nil + "Face for level 5 headings.") +(defface eighters-title-6 nil + "Face for level 6 headings.") +(defface eighters-title-7 nil + "Face for level 7 headings.") +(defface eighters-title-8 nil + "Face for level 8 headings.") +(defface eighters-ui nil + "Face for inalterable UI elements.") + +(defmacro eighters-with-palette (&rest body) + `(let ,eighters-palette ,@body)) + +(eighters-with-palette + (custom-theme-set-faces + 'eighters +;;; Theme faces. + `(eighters-button ((t (:background ,bg-hl-dimmer :box (:color ,bg-hl :style released-button) :inherit eighters-ui)))) + `(eighters-checkbox ((t (:background ,bg-hl-dim :foreground ,fg-blue-dim)))) + `(eighters-citation-1 ((t (:foreground ,fg-cyan-dim)))) + `(eighters-citation-2 ((t (:foreground ,fg-green-dim)))) + `(eighters-citation-3 ((t (:foreground ,fg-yellow-dim)))) + `(eighters-citation-4 ((t (:foreground ,fg-red-dim)))) + `(eighters-citation-5 ((t (:foreground ,fg-magenta-dim)))) + `(eighters-citation-6 ((t (:foreground ,fg-blue-dim)))) + `(eighters-date ((t (:foreground ,fg-magenta-dim)))) + `(eighters-identity ((t (:foreground ,fg-red-subtle)))) + `(eighters-markup ((t (:foreground ,fg-dim)))) + `(eighters-metadata ((t (:foreground ,fg-magenta-dim)))) + `(eighters-title-1 ((t (:foreground ,fg-cyan-subtle :weight bold :height 1.28 :inherit variable-pitch)))) + `(eighters-title-2 ((t (:foreground ,fg-green-subtle :weight bold :height 1.20 :inherit variable-pitch)))) + `(eighters-title-3 ((t (:foreground ,fg-yellow-subtle :weight bold :height 1.12 :inherit variable-pitch)))) + `(eighters-title-4 ((t (:foreground ,fg-red-subtle :weight bold :height 1.04 :inherit variable-pitch)))) + `(eighters-title-5 ((t (:foreground ,fg-magenta-subtle :weight bold :inherit variable-pitch)))) + `(eighters-title-6 ((t (:foreground ,fg-blue-subtle :weight bold :inherit variable-pitch)))) + `(eighters-title-7 ((t (:foreground ,fg-cyan-subtle :weight bold :inherit variable-pitch)))) + `(eighters-title-8 ((t (:foreground ,fg-green-subtle :weight bold :inherit variable-pitch)))) + `(eighters-ui ((t (:inherit variable-pitch)))) +;;; Standard faces. + `(ansi-color-black ((t (:foreground ,bg :background ,bg)))) + `(ansi-color-red ((t (:foreground ,fg-red :background ,bg-red-dim)))) + `(ansi-color-green ((t (:foreground ,fg-green :background ,bg-green-dim)))) + `(ansi-color-yellow ((t (:foreground ,fg-yellow :background ,bg-yellow-dim)))) + `(ansi-color-blue ((t (:foreground ,fg-blue :background ,bg-blue-dim)))) + `(ansi-color-magenta ((t (:foreground ,fg-magenta :background ,bg-magenta-dim)))) + `(ansi-color-cyan ((t (:foreground ,fg-cyan :background ,bg-cyan-dim)))) + `(ansi-color-white ((t (:foreground ,fg-dim :background ,fg-dim)))) + `(ansi-color-bright-black ((t (:foreground ,bg-hl :background ,bg-hl)))) + `(ansi-color-bright-red ((t (:foreground ,fg-red-subtle :background ,bg-red)))) + `(ansi-color-bright-green ((t (:foreground ,fg-green-subtle :background ,bg-green)))) + `(ansi-color-bright-yellow ((t (:foreground ,fg-yellow-subtle :background ,bg-yellow)))) + `(ansi-color-bright-blue ((t (:foreground ,fg-blue-subtle :background ,bg-blue)))) + `(ansi-color-bright-magenta ((t (:foreground ,fg-magenta-subtle :background ,bg-magenta)))) + `(ansi-color-bright-cyan ((t (:foreground ,fg-cyan-subtle :background ,bg-cyan)))) + `(ansi-color-bright-white ((t (:foreground ,fg :background ,fg)))) + `(button ((t (:inherit eighters-button)))) + `(calendar-today ((t (:inverse-video t)))) + `(change-log-date ((t (:inherit eighters-date)))) + `(change-log-email ((t (:inherit (eighters-identity fixed-pitch-serif))))) + `(change-log-name ((t (:inherit eighters-identity)))) + `(compilation-column-number ((t (:inherit eighters-metadata)))) + `(compilation-line-number ((t (:inherit eighters-metadata)))) + `(compilation-mode-line-exit ((t (:inherit compilation-info)))) + `(compilation-mode-line-fail ((t (:inherit compilation-error)))) + `(compilation-mode-line-run ((t (:inherit compilation-warning)))) + `(completions-annotations ((t (:inherit font-lock-doc-face)))) + `(completions-common-part ((t (:inherit shadow)))) + `(completions-first-difference ((t (:foreground ,fg-magenta :weight bold)))) + `(completions-highlight ((t (:background ,bg-magenta)))) + `(custom-button ((t (:inherit eighters-button)))) + `(custom-comment ((t (:background ,bg-hl-dim :foreground ,fg-dim)))) + `(custom-variable-tag ((t (:inherit eighters-title-3)))) + `(default ((t (:background ,bg :foreground ,fg)))) + `(dired-broken-symlink ((t (:background ,bg-red :foreground ,fg-yellow :weight bold)))) + `(dired-directory ((t (:weight bold :foreground ,fg-blue)))) + `(dired-header ((t (:inherit eighters-title-1)))) + `(dired-special ((t (:foreground ,fg-yellow-dim)))) + `(eglot-highlight-symbol-face ((t (:background ,bg-cyan-dim :underline ,fg-cyan-dim)))) + `(eldoc-highlight-function-argument ((t (:background ,bg-red-dim :foreground ,fg-magenta :inverse-video t :weight bold)))) + `(emacs-authors-author ((t (:inherit (bold eighters-identity variable-pitch))))) + `(emacs-authors-descriptor ((t (:inherit (shadow variable-pitch))))) + `(emacs-news-does-not-need-documentation ((t (:foreground ,fg-dimmer)))) + `(emacs-news-is-documented ((t (:foreground ,fg-blue-dim)))) + `(erc-button ((t (:inherit link)))) + `(erc-current-nick-face ((t (:weight bold :inherit eighters-identity)))) + `(erc-direct-msg-face ((t (:inherit font-lock-doc-face)))) + `(erc-error-face ((t (:inherit error)))) + `(erc-input-face ((t (:inherit eighters-citation-1)))) + `(erc-keyword-face ((t (:inherit font-lock-keyword-face)))) + `(erc-my-nick-face ((t (:foreground ,fg-red-dim)))) + `(erc-nick-default-face ((t (:inherit eighters-identity)))) + `(erc-nick-msg-face ((t (:weight bold :inherit eighters-identity)))) + `(erc-notice-face ((t (:inherit font-lock-comment-face)))) + `(erc-prompt-face ((t (:inherit minibuffer-prompt)))) + `(erc-timestamp-face ((t (:inherit eighters-date)))) + `(error ((t :foreground ,fg-red :weight bold))) + `(escape-glyph ((t (:foreground ,fg-red-dim :inherit fixed-pitch-serif)))) + `(eww-invalid-certificate ((t (:inherit error)))) + `(eww-valid-certificate ((t (:inherit success)))) + `(flymake-error ((t (:underline (:color ,fg-red :style wave))))) + `(flymake-note ((t (:underline (:color ,fg-blue :style wave))))) + `(flymake-warning ((t (:underline (:color ,fg-yellow :style wave))))) + `(flyspell-duplicate ((t (:underline (:color ,fg-yellow :style wave))))) + `(flyspell-incorrect ((t (:underline (:color ,fg-red :style wave))))) + `(font-lock-builtin-face ((t (:foreground ,fg-blue)))) + `(font-lock-comment-face ((t (:foreground ,fg-dim :slant italic)))) + `(font-lock-constant-face ((t (:foreground ,fg-magenta)))) + `(font-lock-doc-face ((t (:foreground ,fg-green-dim :slant italic)))) + `(font-lock-function-name-face ((t (:foreground ,fg-blue :weight bold)))) + `(font-lock-keyword-face ((t (:foreground ,fg-cyan :weight bold)))) + `(font-lock-negation-char-face ((t (:inherit warning)))) + `(font-lock-preprocessor-face ((t (:foreground ,fg-blue :inherit fixed-pitch-serif)))) + `(font-lock-regexp-grouping-backslash ((t (:foreground ,fg-yellow-dim)))) + `(font-lock-regexp-grouping-construct ((t (:foreground ,fg-yellow :weight bold)))) + `(font-lock-string-face ((t (:foreground ,fg-magenta-dim)))) + `(font-lock-type-face ((t (:foreground ,fg-green)))) + `(font-lock-variable-name-face ((t (:foreground ,fg-yellow)))) + `(font-lock-warning-face ((t (:inherit warning)))) + `(fringe ((t (:background ,bg-hl-dimmer :foreground ,fg-dimmer)))) + `(gnus-group-mail-1 ((t (:foreground ,fg-yellow :weight bold)))) + `(gnus-group-mail-1-empty ((t (:foreground ,fg-yellow-dim)))) + `(gnus-group-mail-3 ((t (:foreground ,fg-green :weight bold)))) + `(gnus-group-mail-3-empty ((t (:foreground ,fg-green-dim)))) + `(gnus-group-mail-low ((t (:foreground ,fg-dim :weight bold)))) + `(gnus-group-mail-low-empty ((t (:foreground ,fg-dimmer)))) + `(gnus-group-news-3 ((t (:foreground ,fg-magenta :weight bold)))) + `(gnus-group-news-3-empty ((t (:foreground ,fg-magenta-dim)))) + `(gnus-button ((t (:inherit link)))) + `(gnus-cite-1 ((t (:inherit eighters-citation-1)))) + `(gnus-cite-2 ((t (:inherit eighters-citation-2)))) + `(gnus-cite-3 ((t (:inherit eighters-citation-3)))) + `(gnus-cite-4 ((t (:inherit eighters-citation-4)))) + `(gnus-cite-5 ((t (:inherit eighters-citation-5)))) + `(gnus-cite-6 ((t (:inherit eighters-citation-6)))) + `(gnus-cite-7 ((t (:inherit eighters-citation-1)))) + `(gnus-cite-8 ((t (:inherit eighters-citation-2)))) + `(gnus-cite-9 ((t (:inherit eighters-citation-3)))) + `(gnus-cite-10 ((t (:inherit eighters-citation-4)))) + `(gnus-cite-11 ((t (:inherit eighters-citation-5)))) + `(gnus-header ((t ()))) + `(gnus-header-content ((t (:foreground ,fg-dim :inherit gnus-header)))) + `(gnus-header-from ((t (:inherit (eighters-identity gnus-header))))) + `(gnus-header-name ((t (:background ,bg-blue-dim :foreground ,fg-blue-subtle :inherit (eighters-ui gnus-header))))) + `(gnus-header-newsgroups ((t (:inherit (warning gnus-header))))) + `(gnus-header-subject ((t (:inherit (eighters-title-1 gnus-header))))) + `(gnus-server-closed ((t (:inherit shadow)))) + `(gnus-server-cloud ((t (:foreground ,fg-dimmer)))) + `(gnus-server-cloud-host ((t (:foreground ,fg-dim :underline t)))) + `(gnus-server-denied ((t (:inherit error)))) + `(gnus-server-offline ((t (:inherit error)))) + `(gnus-server-opened ((t (:inherit success)))) + `(gnus-signature ((t (:inherit font-lock-comment-face)))) + `(gnus-summary-cancelled ((t (:strike-through t :inherit shadow)))) + `(gnus-summary-normal-ancient ((t (:foreground ,fg-dim)))) + `(gnus-summary-normal-read ((t (:foreground ,fg-dim :slant italic)))) + `(gnus-summary-normal-ticked ((t (:foreground ,fg-yellow-dim)))) + `(gnus-summary-selected ((t (:inherit highlight)))) + `(header-line ((t (:background ,bg-hl :inherit eighters-ui)))) + `(help-key-binding ((t (:background ,bg-hl-dimmer :foreground ,fg-magenta :inherit fixed-pitch-serif)))) + `(highlight ((t (:background ,bg-hl-dim)))) + `(icomplete-selected-match ((t (:inherit completions-highlight)))) + `(info-title-1 ((t (:inherit eighters-title-1)))) + `(info-title-2 ((t (:inherit eighters-title-2)))) + `(info-title-3 ((t (:inherit eighters-title-3)))) + `(info-title-4 ((t (:inherit eighters-title-4)))) + `(isearch ((t (:background ,bg-red-dim :foreground ,fg-magenta :inverse-video t)))) + `(isearch-fail ((t (:background ,bg-red :weight bold)))) + `(isearch-group-1 ((t (:background ,bg-red :foreground ,fg-red :inverse-video t)))) + `(isearch-group-2 ((t (:background ,bg-red :foreground ,fg-blue :inverse-video t)))) + `(lazy-highlight ((t (:background ,bg-cyan :foreground ,fg-cyan :inverse-video t)))) + `(link ((t (:foreground ,fg-blue :underline t)))) + `(link-visited ((t (:foreground ,fg-magenta-dim :underline t)))) + `(log-edit-header ((t (:inherit minibuffer-prompt)))) + `(log-edit-headers-separator ((t (:inherit separator-line)))) + `(log-edit-summary ((t (:inherit eighters-title-1)))) + `(Man-overstrike ((t (:foreground ,fg-cyan :inherit bold)))) + `(match ((t (:background ,bg-cyan-dim :underline ,fg-cyan-dim)))) + `(message-cited-text-1 ((t (:inherit eighters-citation-1)))) + `(message-cited-text-2 ((t (:inherit eighters-citation-2)))) + `(message-cited-text-3 ((t (:inherit eighters-citation-3)))) + `(message-cited-text-4 ((t (:inherit eighters-citation-4)))) + `(message-header-cc ((t (:inherit eighters-identity)))) + `(message-header-from ((t (:inherit eighters-identity)))) + `(message-header-name ((t (:background ,bg-blue-dim :foreground ,fg-blue-subtle :inherit eighters-ui)))) + `(message-header-newsgroups ((t (:inherit warning)))) + `(message-header-subject ((t (:inherit eighters-title-1)))) + `(message-header-other ((t (:foreground ,fg-dim)))) + `(message-header-to ((t (:weight bold :inherit eighters-identity)))) + `(message-header-xheader ((t (:inherit font-lock-preprocessor-face)))) + `(message-mml ((t (:foreground ,fg-blue :inherit eighters-ui)))) + `(message-separator ((t (:background ,bg-hl-dim :inherit (eighters-ui shadow))))) + `(message-signature-separator ((t (:background ,bg-hl-dim :inherit (eighters-ui shadow))))) + `(minibuffer-prompt ((t (:background ,bg-blue :foreground ,fg-blue-subtle :weight bold :inherit eighters-ui)))) + `(mm-uu-extract ((t (:background ,bg-hl-dimmer)))) + `(mode-line ((t (:background ,bg-hl :box (:color ,fg) :inherit eighters-ui)))) + `(mode-line-inactive ((t (:background ,bg-hl-dimmer :foreground ,fg-dimmer :box (:color ,bg-hl-dimmer) :inherit eighters-ui)))) + `(nobreak-space ((t (:background ,bg-magenta-dimmer :underline t :inherit escape-glyph)))) + `(outline-1 ((t (:inherit eighters-title-1)))) + `(outline-2 ((t (:inherit eighters-title-2)))) + `(outline-3 ((t (:inherit eighters-title-3)))) + `(outline-4 ((t (:inherit eighters-title-4)))) + `(outline-5 ((t (:inherit eighters-title-5)))) + `(outline-6 ((t (:inherit eighters-title-6)))) + `(outline-7 ((t (:inherit eighters-title-7)))) + `(outline-8 ((t (:inherit eighters-title-8)))) + `(org-block ((t (:background ,bg-hl-dimmer :inherit fixed-pitch-serif)))) + `(org-block-begin-line ((t (:background ,bg-hl-dim :inherit shadow :extend t)))) + `(org-block-end-line ((t (:background ,bg-hl-dim :inherit shadow :extend t)))) + `(org-checkbox ((t (:inherit eighters-checkbox)))) + `(org-code ((t (:background ,bg-hl-dim :inherit fixed-pitch-serif)))) + `(org-date ((t (:inherit eighters-date)))) + `(org-done ((t (:inherit success)))) + `(org-drawer ((t (:inherit shadow)))) + `(org-ellipsis ((t (:inherit shadow)))) + `(org-footnote ((t (:inherit font-lock-comment-face)))) + `(org-mode-line-clock ((t (:inherit font-lock-constant-face)))) + `(org-special-keyword ((t (:inherit shadow)))) + `(org-table ((t (:foreground ,fg-dim :inherit fixed-pitch-serif)))) + `(org-tag ((t (:inherit eighters-metadata)))) + `(org-todo ((t (:inherit error)))) + `(org-verbatim ((t (:background ,bg-hl-dim :foreground ,fg-magenta :inherit fixed-pitch-serif)))) + `(region ((t (:background ,bg-cyan)))) + `(rst-adornment ((t (:inherit shadow)))) + `(rst-block ((t (:inherit (bold rst-adornment))))) + `(rst-definition ((t (:inherit font-lock-type-face)))) + `(rst-directive ((t (:foreground ,fg-dim)))) + `(rst-external ((t (:inherit font-lock-constant-face)))) + `(rst-level-1 ((t (:inherit eighters-title-1)))) + `(rst-level-2 ((t (:inherit eighters-title-2)))) + `(rst-level-3 ((t (:inherit eighters-title-3)))) + `(rst-level-4 ((t (:inherit eighters-title-4)))) + `(rst-level-5 ((t (:inherit eighters-title-5)))) + `(rst-level-6 ((t (:inherit eighters-title-6)))) + `(rst-literal ((t (:background ,bg-hl-dim :foreground ,fg-magenta :extend t :inherit fixed-pitch-serif)))) + `(rst-reference ((t (:inherit font-lock-string-face)))) + `(separator-line ((t (:background ,bg-hl :height 0.1)))) + `(sh-heredoc ((t (:background ,bg-hl-dimmer :extend t :inherit fixed-pitch-serif)))) + `(sh-quoted-exec ((t (:background ,bg-hl-dim :inherit fixed-pitch-serif)))) + `(shadow ((t (:foreground ,fg-dimmer)))) + `(shortdoc-heading ((t (:inherit eighters-title-1)))) + `(show-paren-match ((t (:foreground ,fg-cyan :inverse-video t)))) + `(show-paren-mismatch ((t (:foreground ,fg-red :inverse-video t)))) + `(shr-h1 ((t (:inherit eighters-title-1)))) + `(shr-h2 ((t (:inherit eighters-title-2)))) + `(shr-h3 ((t (:inherit eighters-title-3)))) + `(shr-h4 ((t (:inherit eighters-title-4)))) + `(shr-h5 ((t (:inherit eighters-title-5)))) + `(shr-h6 ((t (:inherit eighters-title-6)))) + `(success ((t (:foreground ,fg-blue :weight bold)))) + `(tab-bar ((t (:background ,bg-hl-dimmer :inherit eighters-ui)))) + `(tab-bar-tab ((t (:weight bold :box (:style released-button) :inherit tab-bar)))) + `(tab-bar-tab-inactive ((t (:foreground ,fg-dimmer :weight normal :box (:style pressed-button) :inherit tab-bar-tab)))) + `(tab-line ((t (:inherit tab-bar :height 0.9)))) + `(tab-line-tab-current ((t (:inherit (tab-line-tab tab-bar-tab))))) + `(tab-line-tab-inactive ((t (:inherit (tab-line-tab tab-bar-tab-inactive))))) + `(textsec-suspicious ((t (:background ,bg-red)))) + `(trailing-whitespace ((t (:background ,bg-red)))) + `(transient-argument ((t :weight bold :inherit font-lock-string-face))) + `(transient-key ((t :inherit help-key-binding))) + `(transient-key-exit ((t :inherit (bold transient-key)))) + `(transient-key-return ((t :inherit (bold transient-key)))) + `(transient-key-stay ((t :inherit transient-key))) + `(transient-unreachable-key ((t :inherit (shadow help-key-binding)))) + `(vc-dir-directory ((t (:inherit dired-directory)))) + `(vc-dir-file ((t (:inherit default)))) + `(vc-dir-header ((t (:foreground ,fg-blue-subtle)))) + `(vc-dir-header-value ((t (:foreground ,fg-dim)))) + `(vc-dir-mark-indicator ((t (:inherit dired-mark)))) + `(vc-dir-status-edited ((t (:foreground ,fg-yellow)))) + `(vertical-border ((t (:foreground ,bg-hl)))) + `(warning ((t (:foreground ,fg-yellow :weight bold)))) + `(whitespace-hspace ((t (:weight bold :inherit whitespace-space)))) + `(whitespace-indentation ((t (:background ,bg-yellow-dim :foreground ,fg-red)))) + `(whitespace-newline ((t (:foreground ,fg-blue-dim)))) + `(whitespace-space ((t (:background ,bg-blue-dimmer :foreground ,fg-blue-dim)))) + `(whitespace-space-after-tab ((t (:inherit whitespace-indentation)))) + `(whitespace-tab ((t (:inherit whitespace-space)))) + `(whitespace-trailing ((t (:background ,bg-red-dim :foreground ,fg-yellow :weight bold)))) + `(widget-field ((t (:background ,bg-hl-dim)))) +;;;; Diff faces. + `(diff-header ((t (:background ,bg-hl-dimmer :foreground ,fg-dim)))) + `(diff-file-header ((t (:background ,bg-hl-dimmer :foreground ,fg :weight bold)))) + `(diff-hunk-header ((t (:background ,bg-hl-dim :foreground ,fg-dim)))) + `(diff-function ((t (:background ,bg-hl-dim :weight bold)))) + `(diff-context ((t :foreground ,fg-dim))) + `(diff-removed ((t (:background ,bg-red-dimmer)))) + `(diff-refine-removed ((t (:background ,bg-red)))) + `(diff-indicator-removed ((t (:foreground ,fg-red :inherit diff-removed)))) + `(diff-added ((t :background ,bg-blue-dimmer))) + `(diff-refine-added ((t (:background ,bg-blue)))) + `(diff-indicator-added ((t (:foreground ,fg-blue :inherit diff-added)))) + `(diff-changed ((t :background ,bg-yellow-dimmer))) + `(diff-refine-changed ((t (:background ,bg-yellow)))) + `(diff-indicator-changed ((t (:foreground ,fg-yellow :inherit diff-changed)))) + `(ediff-even-diff-A ((t (:background ,bg-hl-dimmer)))) + `(ediff-even-diff-B ((t (:background ,bg-hl-dimmer)))) + `(ediff-even-diff-C ((t (:background ,bg-hl-dimmer)))) + `(ediff-even-diff-Ancestor ((t (:background ,bg-hl-dimmer)))) + `(ediff-odd-diff-A ((t (:background ,bg-hl-dimmer)))) + `(ediff-odd-diff-B ((t (:background ,bg-hl-dimmer)))) + `(ediff-odd-diff-C ((t (:background ,bg-hl-dimmer)))) + `(ediff-odd-diff-Ancestor ((t (:background ,bg-hl-dimmer)))) + `(ediff-current-diff-A ((t (:inherit diff-removed)))) + `(ediff-current-diff-B ((t (:inherit diff-added)))) + `(ediff-current-diff-C ((t (:inherit diff-changed)))) + `(ediff-current-diff-Ancestor ((t (:background ,bg-magenta-dimmer)))) + `(ediff-fine-diff-A ((t (:inherit diff-refine-removed)))) + `(ediff-fine-diff-B ((t (:inherit diff-refine-added)))) + `(ediff-fine-diff-C ((t (:inherit diff-refine-changed)))) + `(ediff-fine-diff-Ancestor ((t (:background ,bg-magenta)))) + `(smerge-markers ((t (:background ,bg-hl-dim :foreground ,fg-dim)))) + `(smerge-base ((t (:background ,bg-yellow-dim)))) + ;; Do *NOT* customize smerge-refined-changed, because that tells + ;; smerge to use it for both removed and added sections. + `(smerge-upper ((t (:background ,bg-red-dim)))) + `(smerge-refined-removed ((t (:inherit diff-refine-removed)))) + `(smerge-lower ((t (:background ,bg-blue-dim)))) + `(smerge-refined-added ((t (:inherit diff-refine-added)))) +;;; Third-party faces. + `(diff-hl-delete ((t (:foreground ,fg-red :background ,bg-red)))) + `(diff-hl-insert ((t (:foreground ,fg-blue :background ,bg-blue)))) + `(diff-hl-change ((t (:foreground ,fg-yellow :background ,bg-yellow)))) + `(forge-dimmed ((t (:inherit shadow)))) + `(forge-post-author ((t (:inherit eighters-identity)))) + `(forge-post-date ((t (:inherit eighters-date)))) + `(forge-pullreq-merged ((t (:inherit forge-dimmed)))) + `(forge-pullreq-open ((t ()))) + `(forge-pullreq-rejected ((t (:inherit forge-dimmed :strike-through t)))) + `(forge-topic-done ((t ()))) + `(forge-topic-slug-completed ((t (:foreground ,fg-blue-dim)))) + `(forge-topic-slug-open ((t (:foreground ,fg-red-subtle)))) + `(forge-topic-slug-saved ((t (:foreground ,fg-yellow)))) + `(forge-topic-slug-unplanned ((t (:inherit forge-dimmed :strike-through t)))) + `(forge-topic-slug-unread ((t ()))) + `(markdown-blockquote-face ((t (:inherit eighters-citation-1)))) + `(markdown-code-face ((t (:inherit fixed-pitch-serif)))) + `(markdown-gfm-checkbox-face ((t :inherit eighters-checkbox))) + `(markdown-header-face-1 ((t (:inherit eighters-title-1)))) + `(markdown-header-face-2 ((t (:inherit eighters-title-2)))) + `(markdown-header-face-3 ((t (:inherit eighters-title-3)))) + `(markdown-header-face-4 ((t (:inherit eighters-title-4)))) + `(markdown-header-face-5 ((t (:inherit eighters-title-5)))) + `(markdown-header-face-6 ((t (:inherit eighters-title-6)))) + `(markdown-inline-code-face ((t (:background ,bg-hl-dim :foreground ,fg-magenta :inherit markdown-code-face)))) + `(markdown-line-break-face ((t (:background ,bg-hl-dimmer :underline t :inherit markdown-markup-face)))) + `(markdown-pre-face ((t (:background ,bg-hl-dimmer :inherit markdown-code-face :extend t)))) + `(markdown-url-face ((t (:inherit (markdown-markup-face markdown-plain-url-face))))) + `(which-key-group-description-face ((t (:foreground ,fg-green-dim)))) + `(which-key-key-face ((t :weight bold :inherit help-key-binding))) +;;;; Magit. + `(magit-blame-highlight ((t (:foreground ,fg-blue-dim :background ,bg-blue-dimmer)))) + `(magit-branch-current ((t (:inverse-video t :inherit magit-branch-local)))) + `(magit-branch-local ((t (:foreground ,fg-blue)))) + `(magit-branch-remote ((t (:foreground ,fg-green-dim)))) + `(magit-branch-remote-head ((t (:inverse-video t :inherit magit-branch-remote)))) + `(magit-keyword ((t (:inherit eighters-metadata)))) + `(magit-process-ng ((t (:inherit error)))) + `(magit-process-ok ((t (:inherit success)))) + `(magit-log-date ((t (:inherit eighters-date)))) + `(magit-hash ((t (:inherit shadow)))) + `(magit-log-author ((t (:inherit eighters-identity)))) + `(magit-log-graph ((t (:inherit eighters-markup)))) + `(magit-mode-line-process ((t (:inherit compilation-mode-line-run)))) + ;; FIXME: Teach magit-section overlays to de-prioritize their + ;; :background so that tags can have one. + `(magit-tag ((t (:foreground ,fg-yellow)))) +;;;;; Section backgrounds. + `(magit-section-highlight ((t :background ,bg-hl-dimmer))) + `(magit-diff-revision-summary ((t (:inherit (magit-diff-hunk-heading eighters-title-1))))) + `(magit-section-heading ((t (:inherit eighters-title-2)))) + `(magit-diff-file-heading ((t (:inherit eighters-title-3)))) + `(magit-diff-context ((t (:foreground ,fg-dim)))) + `(magit-diff-context-highlight ((t (:background ,bg-hl-dimmer :inherit magit-diff-context)))) + `(magit-diff-hunk-heading ((t (:background ,bg-hl-dim)))) + `(magit-diff-hunk-heading-highlight ((t (:background ,bg-hl)))) +;;;;; Selections. + `(magit-section-heading-selection ((t (:foreground ,fg-cyan :background ,bg-cyan-dim)))) + `(magit-diff-file-heading-selection ((t (:foreground ,fg-cyan :background ,bg-cyan-dim)))) + `(magit-diff-hunk-heading-selection ((t (:foreground ,fg-cyan :background ,bg-cyan-dim)))) + `(magit-diff-lines-heading ((t (:foreground ,fg-cyan :inverse-video t)))) +;;;;; Diffs. + `(magit-diff-base ((t (:foreground ,fg-dim :inherit diff-changed)))) + `(magit-diff-base-highlight ((t (:background ,bg-yellow-dim)))) + `(magit-diff-removed ((t (:foreground ,fg-dim :inherit diff-removed)))) + `(magit-diff-removed-highlight ((t (:background ,bg-red-dim)))) + `(magit-diffstat-removed ((t (:foreground ,fg-red)))) + `(magit-diff-added ((t (:foreground ,fg-dim :inherit diff-added)))) + `(magit-diff-added-highlight ((t (:background ,bg-blue-dim)))) + `(magit-diffstat-added ((t (:foreground ,fg-blue)))) +;;;;; Git commit. + `(git-commit-comment-action ((t (:inherit eighters-title-3)))) + `(git-commit-comment-branch-local ((t (:inherit magit-branch-local)))) + `(git-commit-comment-branch-remote ((t (:inherit magit-branch-remote)))) + `(git-commit-comment-file ((t (:foreground ,fg-dim)))) + `(git-commit-comment-heading ((t (:inherit eighters-title-2)))) + `(git-commit-keyword ((t (:inherit eighters-metadata)))) + `(git-commit-known-pseudo-header ((t (:inherit message-header-name)))) + `(git-commit-pseudo-header ((t (:inherit eighters-identity)))) + `(git-commit-summary ((t (:inherit eighters-title-1))))) + (custom-theme-set-variables + 'eighters + '(compilation-enter-directory-face 'dired-directory) + `(compilation-leave-directory-face '(:foreground ,fg-blue-dim)))) + +(provide-theme 'eighters) diff --git a/.config/emacs/gnus/init.el b/.config/emacs/gnus/init.el new file mode 100644 index 0000000..ab5b7f3 --- /dev/null +++ b/.config/emacs/gnus/init.el @@ -0,0 +1,368 @@ +;;; -*- lexical-binding: t -*- + +;;; Externalities. + +;; user-full-name from /etc/passwd; set with chfn(1). +;; user-mail-address from EMAIL variable; set with ~/.profile, +;; ~/.xsessionrc, DE's convention-du-jour. + +;; ~/.authinfo.gpg: +;; machine imap.gmail.com login LOGIN password PASSWORD port 993 +;; machine smtp.gmail.com login LOGIN password PASSWORD port 587 + +;;; Γe Olde Setq. +(setq gnus-select-method + '(nnimap "gmail" + (nnimap-address "imap.gmail.com") + (nnimap-server-port 993) + (nnmail-expiry-target "nnimap+gmail:[Gmail]/Trash") + (nnmail-expiry-wait immediate)) + gnus-secondary-select-methods + '((nntp "archive.lwn.net") + (nntp "news.gmane.io")) + + smtpmail-smtp-server "smtp.gmail.com" + smtpmail-smtp-service 587 + + ;; Archival of sent messages. + gnus-gcc-mark-as-read t + ;; The next setting makes the previous one useless; keeping both + ;; for now because I'm not sure which I'll settle for. + gnus-message-archive-group nil + + ;; Groups. + gnus-group-uncollapsed-levels 2 + + ;; Summary. + gnus-summary-line-format "%*%U%R %-16,16&user-date; %B%-23,23f %s\n" + gnus-summary-dummy-line-format " β %S\n" + gnus-summary-make-false-root 'dummy + gnus-sum-thread-tree-root "β " + gnus-sum-thread-tree-false-root "β¬ " + gnus-sum-thread-tree-single-indent " " + gnus-sum-thread-tree-indent " " + gnus-sum-thread-tree-single-leaf "β°βΊ " + gnus-sum-thread-tree-leaf-with-other "ββΊ " + gnus-sum-thread-tree-vertical "β" + gnus-thread-sort-functions + '(gnus-thread-sort-by-number + (not gnus-thread-sort-by-most-recent-date)) + gnus-user-date-format-alist '(((gnus-seconds-today) + . "%H:%M") + ((+ 86400 (gnus-seconds-today)) + . "Yesterday %H:%M") + ((* 6 86400) + . "%a %H:%M") + ((gnus-seconds-month) + . "%a %d") + ((gnus-seconds-year) + . "%b %d") + (t + . "%F")) + ;; Articles. + gnus-cite-parse-max-size nil + gnus-header-face-alist + '(("From" nil gnus-header-from) + ("Subject" nil gnus-header-subject) + ("Date" nil eighters-date) + ("Newsgroups:.*," nil gnus-header-newsgroups) + ("" gnus-header-name gnus-header-content)) + gnus-sorted-header-list + (list + ;; What, when. + "^Subject:" "^Summary:" "^Keywords:" "^Date:" + ;; Who. + "^From:" "^Organization:" "^Followup-To:" "^To:" "^Cc:" "^Newsgroups:") + gnus-treat-display-smileys nil + ;; Do not fill anything; let visual-line-mode wrap text. + ;;; NB: for format=flowed, there is no setting to say "un-fill + ;;; flowed lines", so we *enable* filling, setting an absurd + ;;; line length limit, in order to un-fill flowed lines. + fill-flowed-display-column most-positive-fixnum + mm-fill-flowed t + ;;; More long-line-folding settings. + gnus-article-unfold-long-headers t + gnus-treat-fill-article nil + gnus-treat-fill-long-lines nil + gnus-treat-fold-headers nil) + +;;; Window configurations. + +(defvar my/gnus-side-by-side-threshold 160) + +(gnus-add-configuration + '(article + (if (>= (frame-width) my/gnus-side-by-side-threshold) + '(horizontal 1.0 + (summary 1.0 point) + (article 80)) + '(vertical 1.0 + (summary 0.25 point) + (article 1.0))))) + +(dolist (buf-name '(forward reply reply-yank)) + (gnus-add-configuration + `(,buf-name + (if (>= (frame-width) my/gnus-side-by-side-threshold) + '(vertical 1.0 + (summary 0.25) + (horizontal 1.0 + (article 0.5) + (message 1.0 point))) + '(vertical 1.0 + (summary 0.2) + (article 0.2) + (message 1.0 point)))))) + +;;; Summary tweaks. + +(defun my/gnus-toggle-article-wrap () + (interactive) + (with-current-buffer gnus-article-buffer + (visual-line-mode 'toggle))) + +(defun my/gnus-summary-tweak-keys () + (keymap-local-set "C-c d v" 'my/gnus-toggle-article-wrap)) + +(add-hook 'gnus-summary-mode-hook 'my/gnus-summary-tweak-keys) + +;; message-subject-re-regexp is used both in Gnus summary buffers to +;; detect and elide similar subjects in a thread, and by message mode +;; when replying, to determine what to strip from the subject. +;; +;; Some MUAs add cruft to the subject, turning "Re: bug#123: foobar" +;; into "RE: [External] : Re: bug#1234: foobar", which Debbugs will +;; then turn into "bug#1234: [External] : Re: bug#1234: foobar". +;; +;; The only way I can find to tell the Gnus summary code to +;; canonicalize all that cruft away is by tweaking this regexp, but +;; setting its global value causes message-mode to elide stuff it +;; shouldn't when crafting subjects. Therefore, chase down the best +;; Gnus hook for the job, and set the regexp locally. +(defun my/gnus-reply-prefixes () + (mapcan (lambda (prefix) (list prefix (upcase prefix) (capitalize prefix))) + '("re" "aw" "sv" "fw" "fwd"))) + +(setq my/gnus-summary-normalize-subject + (rx-to-string + `(seq bol + (+ (or (seq word-start (or ,@(my/gnus-reply-prefixes)) word-end) + (seq "bug#" (+ digit)) + (seq "[" (or "External" "SPAM UNSURE") "]")) + (? (* space) ":") (* space))))) + +(add-hook 'gnus-summary-generate-hook + (lambda () + (setq-local message-subject-re-regexp + my/gnus-summary-normalize-subject))) + +(let* ((initials (mapconcat (lambda (s) (substring s 0 1)) + (split-string user-full-name) + nil)) + (sent-prefix (format "%s β " initials))) + (setq gnus-summary-to-prefix sent-prefix + gnus-summary-newsgroup-prefix sent-prefix)) + +;;; Article tweaks. + +(defun my/gnus-article-eschew-tables () + ;; I set shr-fill-text to nil because I prefer letting + ;; visual-line-mode manage wrapping. Unfortunately, many HTML + ;; emails rely on <table>s for layouts, and rendering can get ugly. + ;; Work around this by treating <table> & children as any other + ;; <div>. + (make-local-variable 'shr-external-rendering-functions) + (pcase-dolist (`(,tag . ,shr-function) + '((table . shr-tag-div) + (thead . shr-tag-div) + (tbody . shr-tag-div) + (tr . shr-tag-ul) + (th . shr-tag-li) + (td . shr-tag-li))) + (setf (alist-get tag shr-external-rendering-functions) shr-function))) + +(defun my/gnus-article-has-html () + ;; Hard to tell the difference between + ;; * the variable `gnus-article-mime-handles', + ;; * the function `gnus-article-mime-handles', + ;; * the variable `gnus-article-mime-handle-alist'. + ;; + ;; Stealing debbugs.el's patch-finding logic. + (seq-some + (lambda (handle) + (string= (mm-handle-media-type (cdr handle)) "text/html")) + (gnus-article-mime-handles))) + +(defun my/gnus-article-should-wrap () + (save-excursion + (message-goto-body) + (let ((should-wrap nil) + (has-html (my/gnus-article-has-html))) + (while-let (((not should-wrap)) + ((not (eobp))) + (current-line (thing-at-point 'line))) + (setq should-wrap + (and + ;; The line is bigger than the target width. + (> (length current-line) + (window-width (get-buffer-window gnus-article-buffer))) + ;; The line is not boring (citation, diff addition/removal). + (not (string-match-p "\\`[>+-]" current-line)) + ;; Lines that start with spaces are boring, except in + ;; HTML parts: those are choked with <table> tags that + ;; shr left-pads with spaces. + ;; NB: HAS-HTML is a naive heuristic: we are assuming + ;; that "any text/html part is present" means "we are + ;; looking at this text/html part". + (or (not (string-match-p "\\` " current-line)) has-html))) + (forward-line)) + should-wrap))) + +(defun my/gnus-article-wrap-maybe () + ;; Enable visual-line-mode when it helps, i.e. when the message has + ;; long lines that are not part of citations nor patches. + (with-current-buffer gnus-article-buffer + (visual-line-mode + (unless (my/gnus-article-should-wrap) -1)))) + +;; Article setup is tricky. In order, `gnus-article-prepare' +;; +;; (1) calls `gnus-article-setup-buffer', which +;; (a) calls `gnus-article-mode', which runs +;; gnus-article-mode-hook, +;; (b) sets truncate-lines from gnus-article-truncate-lines, +;; +;; (2) calls `gnus-display-mime', which may end up calling `mm-shr'; +;; this can call `shr-tag-table', which turns truncate-lines on +;; unconditionally. +;; +;; (3) runs gnus-article-prepare-hook. +;; +;; Gnus will only run (1a) once, and skip that step when it re-uses +;; the same *Article* buffer for subsequent articles. So for our +;; purposes, we need to +;; +;; (β
) hack the shr rendering functions in mode-hook, before `mm-shr' +;; gets to work. +;; (β
‘) call `visual-line-mode' (if needed) in prepare-hook, after +;; truncate-lines has been set. + +(add-hook 'gnus-article-mode-hook 'my/gnus-article-eschew-tables) +(add-hook 'gnus-article-prepare-hook 'my/gnus-article-wrap-maybe) + +;;; MIME display. +(defun my/mm-display-markdown-inline (handle) + (mm-display-inline-fontify handle 'markdown-mode)) + +(with-eval-after-load 'mm-decode + ;; bug-gnu-emacs:<jwvzfsnntlq.fsf-monnier+emacs@gnu.org> + (setf (alist-get "text/markdown" mm-inline-media-tests nil nil 'equal) + '(my/mm-display-markdown-inline))) + +;;; Key bindings. +;; +;; m compose +;; +;; Group buffer: +;; +;; L list all groups +;; RET view unread mail in group +;; C-u RET view all mail in group +;; g refresh +;; G G search group +;; +;; Summary buffer: +;; +;; B m move message to group +;; / N fetch new +;; M-g refresh (expire, move, fetch new, show unread) +;; C-u M-g refresh (expire, move, fetch new, show all) +;; C-u g show raw, undecoded message source; g to decode +;; T h collapse (hide) thread +;; T s expand (show) thread +;; T k, C-M-k mark thread as read +;; M-1 T k mark thread as unread +;; r reply +;; R reply (quoting) +;; S w reply-all +;; S W reply-all (quoting) +;; C-c C-f forward +;; d mark read +;; M-u clear marks (β‘ mark unread) +;; E expire +;; # toggle mark for next action +;; M-#, M P u unmark for next action +;; +;; Draft summary buffer: +;; +;; D e edit draft +;; +;; Article buffer: +;; +;; o save attachment at point +;; K b add button for inlined MIME part +;; +;; Composing: +;; +;; C-c C-c send +;; C-c C-a attach +;; C-c C-f s change the subject (append "was:") +;; +;;; FAQ. +;; +;; - how to see *all mails*, not just unread? +;; - C-u RET +;; +;; - how to do something on a bunch of mail matching a pattern? +;; - M P R ; mark all mails with subjects matching regexp +;; - M-& <x> ; do <x> on all marked mails +;; +;; - how to delete mail? +;; - E to mark as expired +;; - C-u M-g to refresh +;; +;; - how to remove groups deleted on the IMAP server? +;; - b to iterate over "bogus" groups and remove them +;; +;; - how to list most-recent mails on top? +;; - cf. gnus-thread-sort-functions +;; +;; - how to close a mail without going back to the group list? +;; - = to make summary full-screen +;; +;; - how to get contact completion? +;; - install ebdb from GNU ELPA +;; - or just use message-mail-alias-type +;; +;; - how to refresh? +;; - summary buffer: +;; - / N (fetch new) +;; - M-g (expire, move, fetch & redisplay) +;; - group buffer: g +;; +;; - what do all those letters mean? +;; (info "(gnus) Marking Articles") +;; - O old β‘ read during previous session +;; - R just read +;; - r manually marked as read +;; - A answered +;; - E expirable +;; - G cancelled (e.g. moved somewhere else) +;; - . unseen +;; +;; - how to subscribe to mailing lists? +;; - to browse an NNTP server, either +;; - hit B in the group buffer, then nntp *some server* +;; - or add (nntp "*some server*") to gnus-secondary-methods +;; - over the list: u +;; +;;; TODO. +;; +;; - gnus-summary-line-format (π for attachments) +;; +;; - how to archive mails and news locally? +;; +;; - describe-key is mostly useless in article mode: +;; > X runs the command gnus-article-read-summary-keys +;; +;; - detect possibly missing attachments from keywords diff --git a/.config/emacs/icons/compilation-failure.png b/.config/emacs/icons/compilation-failure.png Binary files differnew file mode 100644 index 0000000..4de1294 --- /dev/null +++ b/.config/emacs/icons/compilation-failure.png diff --git a/.config/emacs/icons/compilation-success.png b/.config/emacs/icons/compilation-success.png Binary files differnew file mode 100644 index 0000000..a30a972 --- /dev/null +++ b/.config/emacs/icons/compilation-success.png diff --git a/.config/emacs/init.el b/.config/emacs/init.el new file mode 100644 index 0000000..9d4cd34 --- /dev/null +++ b/.config/emacs/init.el @@ -0,0 +1,1018 @@ +;;; -*- lexical-binding: t -*- + +;;; "Custom"ization & theming. + +;; Trying to migrate to use-package instead of Custom's serialized +;; forms. It's a long-term project; until that's done, start by +;; setting and loading the `custom-file'. +(setq custom-file (file-name-concat user-emacs-directory "custom.el")) +(load custom-file) + +;; Compatibility shim for setopt. +(if (fboundp 'setopt) + (defalias 'my/setopt 'setopt) + (defmacro my/setopt (&rest pairs) + `(let ((pairs (quote ,pairs))) + (while pairs + (customize-set-variable (pop pairs) (pop pairs)))))) + +;; Helper for customizing list options. +;; +;; None of Emacs's customization tools (Custom, setopt, use-package) +;; can be told "add this element, take those two away": I need to "set +;; in stone" an exhaustive list that will make me (1) scratch my head +;; a few months later when I try to remember which of those items I +;; deliberately added vs which were part of the default list (2) miss +;; out on additions to the default list, unless I cautiously audit +;; every release of every package. +;; +;; Examples: erc-modules, git-commit-setup-hook, package-archives. +(defmacro my/setopt-update-list (l to-add &optional to-remove) + `(my/setopt ,l (thread-first + ,l (seq-union ,to-add) (seq-difference ,to-remove)))) + +(load-theme 'eighters t) + +;;; Key bindings. + +;; C-h is a special snowflake in many situations; this is the most +;; reliable way I found to consistently get C-h to do what DEL does. +;; +;; Likewise, C-M-h is re-bound by some major modes (CC, Python, Perl), +;; so this is the simplest way I know of to make sure C-M-h sticks as +;; "backward-kill-word". +;; +;; Same story with M-h (mark-paragraph) which gets re-bound by eg +;; markdown-mode and nxml-mode. +(define-key input-decode-map (kbd "C-h") (kbd "DEL")) +(define-key input-decode-map (kbd "C-M-h") (kbd "M-DEL")) + +(global-set-key (kbd "C-x C-b") 'ibuffer) + +(when (< emacs-major-version 28) + (defun my/other-window (count &optional all-frames) + (interactive "p") + (let ((repeat-map (make-sparse-keymap))) + (define-key repeat-map [?o] #'other-window) + (set-transient-map repeat-map t) + (other-window count all-frames))) + (global-set-key (kbd "C-x o") #'my/other-window)) + +;; Hopefully these will be easier to remember than TeX commands: + +(quail-define-package + "my/symbols" "UTF-8" "π°" t + "Input arbitrary Unicode symbols with other arbitrary symbols.") + +(pcase-dolist + (`(,key ,translation) + '(;; Punctuation + ("..." ?β¦) + ;; Math symbols + ("~~" ?β) ("~~=" ?β) ("~==" ?β
) ("~=" ?β) + ("==" ?β‘) ("^=" ?β) (":=" ?β) + ("<=" ?β€) (">=" ?β₯) + ("-->" ?β) ("-/>" ?β) ("==>" ?β) ("=/>" ?β) + ("<--" ?β) ("</-" ?β) ("<==" ?β) ("</=" ?β) + ("<->" ?β) ("<=>" ?β) + ;; Emojis + ("\\o/" ?π) ("\\m/" ?π€) + ;; Pictograms + ("/!\\" ?β ))) + (quail-defrule key translation "my/symbols")) + +(defmacro my/make-input-toggle (input-method) + (let ((fsym (intern (format "my/toggle-input-%s" input-method))) + ;; Unfortunately, by default `help-make-xrefs' does not try to + ;; cross-reference input methods, as `help-xref-mule-regexp' + ;; is nil. This can be worked around by setting this variable + ;; to `help-xref-mule-regexp-template'. + (doc (format "Toggle `%s' input method." input-method))) + `(defun ,fsym () + ,doc + (interactive) + ;; `current-input-method' is a string; if INPUT-METHOD is a + ;; symbol, neither eq, eql nor equal would return t. + (if (string= current-input-method ',input-method) + (deactivate-input-method) + (set-input-method ',input-method t))))) + +(defun my/set-tab-width (&optional arg) + (interactive "P") + (let ((new-width (cond (arg (prefix-numeric-value arg)) + ((= tab-width 4) 8) + (4))) + (old-width tab-width)) + ;; TODO: for some reason, set-variable takes effect immediately, + ;; but setq(-local)? do not: I need to move the cursor before tabs + ;; are re-drawn. + (set-variable 'tab-width new-width) + (message "changed from %s to %s" old-width new-width))) + +(defvar-local my/centered-width 'fill-column) +(defvar-local my/centered-set-right-margin nil) + +(defun my/centered--before-split (&optional _size window-to-split) + (let ((windows (if (frame-root-window-p window-to-split) + (window-list) + (list window-to-split)))) + (dolist (w windows) + (when (buffer-local-value 'my/centered-mode (window-buffer w)) + (set-window-margins w nil nil))))) + +(defun my/centered--around-splittable (splittable window &optional horizontal) + (if (and horizontal + (buffer-local-value 'my/centered-mode (window-buffer window))) + (let ((margins (window-margins window))) + (set-window-margins window nil nil) + (prog1 + (funcall splittable window horizontal) + (apply 'set-window-margins window margins))) + (funcall splittable window horizontal))) + +(advice-add 'split-window-right :before 'my/centered--before-split) +(advice-add 'window-splittable-p :around 'my/centered--around-splittable) + +(define-minor-mode my/centered-mode + "Update margins to keep content centered." + :init-value nil + (if my/centered-mode + (progn + (add-hook 'window-state-change-functions 'my/centered-set-margins nil t) + (dolist (win (get-buffer-window-list)) + (my/centered-set-margins win))) + (remove-hook 'window-state-change-functions 'my/centered-set-margins t) + (dolist (win (get-buffer-window-list)) + (set-window-margins win nil)))) + +(defun my/centered-set-margins (window) + (with-current-buffer (window-buffer window) + (let* ((target-body-width + (cond + ((symbolp my/centered-width) + (symbol-value my/centered-width)) + ((integerp my/centered-width) + my/centered-width))) + (adjustable-width + (- (window-total-width window) + (+ (fringe-columns 'left) (fringe-columns 'right)))) + (left-margin + (when (> adjustable-width target-body-width) + (/ (- adjustable-width target-body-width) 2))) + (right-margin (and my/centered-set-right-margin + left-margin))) + (set-window-margins window left-margin right-margin)))) + +(defun my/kill (stuff) + (kill-new stuff) + (message "%s" stuff)) + +;; TODO: my/kill-where +;; * filename +;; * absolute, project-relative (w/o project), namespace-relative, base +;; * function +;; * line number +;; * public URL + +;; TODO: my/kill-cite +;; * prefix: nil, >, | +;; * indent +;; * attribution: see my/kill-where +;; * concise: "(manual) Node", "manual(7)" +;; * executable: (info "(manual) Node"), "man 7 manual" +;; * <https://somewhe.re/manual.html#node> + +(defun my/read (prompt default) + (read-string (format-prompt prompt default) nil nil default)) + +(defvar my/run-strip-newline t + "Whether `my/run' will remove a trailing newline from a command's output.") + +(defun my/run (program &rest args) + "Return output from 'PROGRAM [ARGSβ¦]'. +Raise a user error if the command fails. Heed `my/run-strip-newline'." + (with-temp-buffer + (let* ((status (apply 'call-process program nil t nil args)) + (output (buffer-string))) + (if (eq status 0) + (if my/run-strip-newline + (string-remove-suffix "\n" output) + output) + (user-error "%s returned %d:\n%s" program status output))))) + +(defun my/kill-command (program &rest args) + "Send output from PROGRAM to kill-ring. +See `my/run' for details, e.g. status handling and output massaging." + (my/kill (apply 'my/run program args))) + +(defun my/kill-date (date format) + (interactive + (if current-prefix-arg + (list (my/read "Date spec?" "today") + (my/read "Format?" "%F")) + (list "today" "%F"))) + (my/kill-command "date" (concat "-d" date) (concat "+" format))) + +(defun my/kill-filename () + (interactive) + (my/kill (or (buffer-file-name) default-directory))) + +(defun my/kill-pipe-region (command) + (interactive (list (read-shell-command "Shell command on region: "))) + (let ((input (funcall region-extract-function nil))) + (with-temp-buffer + (insert input) + (call-process-region (point-min) (point-max) shell-file-name + t t nil shell-command-switch command) + (my/kill (buffer-string))))) + +(defun my/kill-shell (command) + "Send output from COMMAND to kill-ring. +Meant for interactive prompting for full commands passed to a shell. +For Lisp use, prefer `my/kill-command', where arguments are passed via a +list and require no escaping." + (interactive (list (read-shell-command "Shell command: "))) + (with-temp-buffer + (call-process-shell-command command nil t) + (my/kill (buffer-string)))) + +(defun my/shell-command-help (command) + (interactive + (list (read-shell-command "Show --help for: "))) + (let* ((command--help (concat command " --help")) + (help-buf (get-buffer-create (format "*%s*" command--help)))) + (shell-command (concat command--help) help-buf) + (display-buffer help-buf))) + +(defun my/magit-project () + (interactive) + (require 'project) + (magit-status (project-prompt-project-dir))) + +(defun my/magit-toggle-margin-date () + (interactive) + (let ((do-message + (lambda (old new) + (message + "%s β %s" + (propertize old 'face 'shadow) + (propertize new 'face 'bold))))) + (apply do-message (if magit-log-margin-show-committer-date + '("commit" "author") '("author" "commit"))) + (setq magit-log-margin-show-committer-date + (not magit-log-margin-show-committer-date)) + (revert-buffer))) + +(defmacro my/define-prefix-command (name doc bindings) + (declare (indent defun)) + `(defvar ,name + (let ((map (define-prefix-command ',name))) + (pcase-dolist (`(,key ,fun) ,bindings) + (define-key map key fun)) + map) + ,doc)) + +(my/define-prefix-command my/buffer-map + "Keymap for buffer manipulation commands." + '(("b" bury-buffer) + ("g" revert-buffer) + ("r" rename-buffer))) + +(my/define-prefix-command my/display-map + "Keymap for display-related commands." + '(("c" my/centered-mode) + ("l" hl-line-mode) + ("n" display-line-numbers-mode) + ("t" toggle-truncate-lines) + ("v" visual-line-mode))) + +(my/define-prefix-command my/editing-map + "Keymap for toggling editing features." + '(("f" auto-fill-mode))) + +(my/define-prefix-command my/magit-map + "Keymap for Magit commands." + '(("d" my/magit-toggle-margin-date) + ("f" magit-file-dispatch) + ("g" magit-status) + ("p" my/magit-project) + ("x" magit-dispatch) + ("\C-f" magit-find-file))) + +(my/define-prefix-command my/input-map + "Keymap for input methods shortcuts." + `(("e" ,(my/make-input-toggle emoji)) + ("t" ,(my/make-input-toggle TeX)) + ("u" ,(my/make-input-toggle my/symbols)))) + +(my/define-prefix-command my/kill-map + "Keymap for adding things to the kill ring." + '(("d" my/kill-date) + ("f" my/kill-filename) + ("|" my/kill-pipe-region) + ("!" my/kill-shell))) + +(my/define-prefix-command my/manual-map + "Keymap for reading manuals." + '(("h" my/shell-command-help) + ("i" info-display-manual) + ("m" man) + ("s" shortdoc-display-group))) + +(my/define-prefix-command my/whitespace-map + "Keymap for whitespace-related commands." + '(("c" whitespace-cleanup) + ("f" page-break-lines-mode) + ("m" whitespace-mode) + ("t" my/set-tab-width))) + +;; C-c [[:alpha:]] is reserved for users - let's make good use of it. + +(global-set-key (kbd "C-c b") 'my/buffer-map) +(global-set-key (kbd "C-c c") 'compile) +(global-set-key (kbd "C-c d") 'my/display-map) +(global-set-key (kbd "C-c e") 'my/editing-map) +(global-set-key (kbd "C-c g") 'my/magit-map) +(global-set-key (kbd "C-c i") 'my/input-map) +(global-set-key (kbd "C-c k") 'my/kill-map) +(global-set-key (kbd "C-c m") 'my/manual-map) +(global-set-key (kbd "C-c w") 'my/whitespace-map) + +(rg-enable-default-bindings) ; Uses the C-c s prefix. + +;; What's life without a little risk? +(setq disabled-command-function nil) + +;;; Window management. + +;; Bindings ala Terminator +(when window-system + (global-set-key (kbd "C-S-o") 'split-window-below) + (global-set-key (kbd "C-S-e") 'split-window-right) + (global-set-key (kbd "C-+") 'text-scale-adjust) + (global-set-key (kbd "C--") 'text-scale-adjust) + (global-set-key (kbd "C-0") 'text-scale-adjust) + (global-set-key (kbd "C-S-<up>") 'enlarge-window) + (global-set-key (kbd "C-S-<down>") 'shrink-window) + (global-set-key (kbd "C-S-<right>") 'enlarge-window-horizontally) + (global-set-key (kbd "C-S-<left>") 'shrink-window-horizontally)) + +;;; Lighters. + +(defun my/symbol-as-icon (c) + ;; By default, Emacs 28 uses color fonts for characters from (1) the + ;; 'emoji script (2) the 'symbol script, when followed by VS-16. + ;; Meanwhile, Emacs 27 knows how to display color fonts, but (1) it + ;; has no 'emoji script (2) it doesn't know what to do with VS-16. + ;; Bottomline: on Emacs 28, explicitly ask for the emoji + ;; presentation with VS-16; on older emacsen, just use the + ;; character, and rely on a blanket fontset rule to prefer color + ;; fonts for the whole 'symbol script. + (apply 'string `(,c ,@(when (>= emacs-major-version 28) + '(?\N{VARIATION SELECTOR-16}))))) + +;; So long, Will Mengarini. +(delight 'abbrev-mode nil 'abbrev) +(delight 'auto-fill-function "β" t) +(delight 'auto-revert-mode "β³" 'autorevert) +(delight 'auto-revert-tail-mode "β€" 'autorevert) +(delight 'footnote-mode "ΒΉ" 'footnote) +(delight 'flyspell-mode (propertize (my/symbol-as-icon ?π) + 'face 'flyspell-incorrect) + 'flyspell) +(delight 'hi-lock-mode nil 'hi-lock) +(delight 'hs-minor-mode "β¦" 'hideshow) +(delight 'mml-mode "π§" 'mml) +(delight 'page-break-lines-mode nil 'page-break-lines) +(delight 'scroll-lock-mode "π" 'scroll-lock) +(delight 'text-scale-mode + '(:eval (if (>= text-scale-mode-amount 0) "π" "π")) + 'face-remap) +(delight 'visual-line-mode nil t) +(delight 'with-editor-mode "βΈ" 'with-editor) +;; TODO: Narrow (β, βΆ) + +(if (< emacs-major-version 27) + (delight 'compilation-in-progress + (propertize "β" 'face 'compilation-mode-line-run) + 'compile) + (let* ((indicator (alist-get 'compilation-in-progress mode-line-modes)) + (old-props (text-properties-at 0 (car indicator))) + (face '(:inverse-video t :inherit compilation-mode-line-run)) + (new-props (append `(face ,face) old-props)) + (icon (my/symbol-as-icon ?β))) + (setcar indicator (concat (apply #'propertize icon new-props) " ")))) + +(setq eglot-menu-string "π¦»") + +(with-eval-after-load 'flymake + (let ((indicator (propertize (my/symbol-as-icon ?β) 'face 'flymake-error))) + ;; Prefer customizing the string instead delight'ing, as flymake + ;; slaps a bunch of helpful properties on top of the lighter, + ;; which delight would strip. + (if (boundp 'flymake-mode-line-lighter) + (setq flymake-mode-line-lighter indicator) + (delight 'flymake-mode indicator 'flymake)))) + +;;; Version control. + +(defvar my/git-commit-fill-columns + '((my/emacs-repo-p . 63))) + +(defun my/git-upstreams () + ;; TODO: memoize, perhaps? + (seq-uniq + (seq-keep + (lambda (remote-desc) + (and (string-match "\\`.*\t\\(.*\\) (fetch)\\'" remote-desc) + (match-string 1 remote-desc))) + (process-lines "git" "remote" "-v")))) + +(cl-defun my/git-commit-maybe-set-fill-column () + (let ((remotes (my/git-upstreams))) + (pcase-dolist (`(,pred . ,column) my/git-commit-fill-columns) + (when (funcall pred remotes) + (cl-return-from my/git-commit-maybe-set-fill-column + (setq fill-column column)))))) + +(defun my/revision-at-point () + (cond + ((derived-mode-p 'magit-mode) + (magit-branch-or-commit-at-point)) + ((derived-mode-p 'vc-git-log-view-mode) + (log-view-current-tag)) + ((derived-mode-p 'vc-annotate-mode) + (car (vc-annotate-extract-revision-at-line))))) + +(defun my/describe-revision (rev) + "Format a Git revision in a format suitable for changelogs." + (interactive + (list (my/read "Revision" (my/revision-at-point)))) + (my/kill-command + "git" "show" "--no-patch" "--date=short" "--format=%cd \"%s\" (%h)" rev)) + +;;; Major modes configuration. + +(defun my/c-modes-hook () + (c-set-style "bsd") + (c-set-offset 'arglist-close 0)) + +(add-hook 'c-mode-common-hook 'my/c-modes-hook) + +(defun my/calendar-iso-week (year month day) + ;; NIH version of `calendar-intermonth-text''s serving suggestion. + (propertize + (format-time-string "%V" (encode-time (list 0 0 0 day month year))) + 'font-lock-face 'eighters-date)) + +(defun my/compilation-notify (buffer results) + (let* ((title (buffer-name buffer)) + (status (if (string-equal results "finished\n") "success" "failure")) + (icon (format "%s/icons/compilation-%s.png" user-emacs-directory status))) + (require 'notifications) + (notifications-notify :title title :body results :app-icon icon :timeout 3000))) + +(add-to-list 'compilation-finish-functions 'my/compilation-notify) + +(defun my/make-tabless (f) + "Make a function which will run F with `indent-tabs-mode' disabled." + (lambda () + (:documentation (format "Run `%s' with `indent-tabs-mode' set to nil." f)) + (interactive) + (let ((indent-tabs-mode nil)) + (call-interactively f)))) + +(defun my/makefile-hook () + ;; I would rather align backslashes with spaces rather than tabs; + ;; however, I would also like indent-tabs-mode to remain non-nil. + (local-set-key (kbd "C-c C-\\") (my/make-tabless 'makefile-backslash-region)) + (local-set-key (kbd "M-q") (my/make-tabless 'fill-paragraph))) + +(add-hook 'makefile-mode-hook 'my/makefile-hook) + +(defun my/shell-hook () + (setq truncate-lines nil) + (setq-local recenter-positions '(top middle bottom))) + +(add-to-list 'ibuffer-saved-filter-groups + '("my/ibuffer-groups" + ("REPL" + (or (derived-mode . comint-mode) + (mode . lisp-interaction-mode))) + ("Programming" (derived-mode . prog-mode)) + ("Folders" (mode . dired-mode)) + ("Messaging" + (or (mode . erc-mode) + (mode . message-mode) + (derived-mode . gnus-mode))) + ("Documentation" + (or (mode . Info-mode) + (mode . Man-mode) + (mode . help-mode))) + ("Version control" + (or (derived-mode . magit-mode) + (name . "\\`\\*vc"))))) + +(add-hook 'ibuffer-mode-hook + (lambda () + (ibuffer-switch-to-saved-filter-groups "my/ibuffer-groups"))) + +;;; Development helpers. +(defun my/emacs-repo-p (upstreams) + "Guess whether we are working in the Emacs repository. +UPSTREAMS is a list of fetch URLs." + (member "https://git.savannah.gnu.org/git/emacs.git" upstreams)) + +(defun my/emacs-run-testcase () + (interactive) + (require 'which-func) + (let* ((emacs-root (project-root (project-current))) + (testfile (file-name-sans-extension + (file-relative-name + buffer-file-name (file-name-concat + emacs-root "test")))) + (cores (num-processors 'all)) + (options + `(("SELECTOR" . ,(which-function)) + ("TEST_BACKTRACE_LINE_LENGTH" . nil))) + (options-list + (seq-map + (lambda (opt) (format "%s=%s" (car opt) (cdr opt))) + options)) + (compile-command + (format "make -j%s && make -C test %s %s" + cores testfile (string-join options-list " ")))) + (call-interactively 'project-compile))) + +;;; Helper functions and miscellaneous settings. + +;;;; French quick toggle. +(defun my/froggify () + (ispell-change-dictionary "fr") + (setq-local colon-double-space nil) + (setq-local sentence-end-double-space nil) + (setq-local fill-nobreak-predicate + (cons 'fill-french-nobreak-p fill-nobreak-predicate)) + (setq-local my/froggified t)) + +(defun my/unfroggify () + (ispell-change-dictionary "default") + (setq-local colon-double-space t) + (setq-local sentence-end-double-space t) + (setq-local fill-nobreak-predicate + (remq 'fill-french-nobreak-p fill-nobreak-predicate)) + (setq-local my/froggified nil)) + +(defun my/croak () + (interactive) + (if (and (boundp 'my/froggified) my/froggified) + (my/unfroggify) + (my/froggify))) + +;;;; Mailing lists utilities. +(defun my/kill-message-id () + (interactive) + (my/kill (mail-header-message-id (gnus-summary-article-header)))) + +(defun my/describe-message (id url) + (my/kill (format "%s\n%s\n" + (if (string-prefix-p "<" id) + id + (format "<%s>" id)) + url))) + +(defun my/describe-message-id (list id) + "Format references from the Message-ID of a gnu.org list." + (interactive + (list + (read-string "List: ") ; TODO: default to current list. + (let ((default-id + (mail-header-message-id (gnus-summary-article-header)))) + (read-string (format-prompt "Message-ID" default-id) + nil nil default-id)))) + (with-current-buffer + (url-retrieve-synchronously + (concat + ;; For some reason, literal "+" chars cause the search to fail. + ;; Escape them. + "https://lists.gnu.org/archive/cgi-bin/namazu.cgi" + "?query=%2Bmessage-id:" + (replace-regexp-in-string "\\+" "%2B" id) + "&submit=Search!" + "&idxname=" list)) + (search-forward-regexp + (rx "<a href=\"" + (group "/archive/html/" (literal list) "/" + (+ (any "0-9-")) "/msg" (+ (any "0-9")) ".html") + "\">")) + (let ((url (concat "https://lists.gnu.org" (match-string 1)))) + (my/describe-message id url)))) + +(defun my/describe-message-url (url) + "Format references from an article archived on MHonArc." + (interactive + (list + (let ((default (or (thing-at-point 'url) + (and (derived-mode-p 'eww-mode) + (shr-url-at-point nil))))) + (read-string (format-prompt "URL" default) nil nil default)))) + (with-current-buffer (url-retrieve-synchronously url) + (search-forward-regexp "^<!--X-Message-Id: \\(.+\\) -->$") + (let ((id (xml-substitute-numeric-entities (match-string 1)))) + (my/describe-message id url)))) + +;;;; Font stuff π€·π€¦. +(when (= emacs-major-version 27) + ;; Emacs 27 added support for color fonts, but the default fontset + ;; did not use any such font for emoji. + (set-fontset-font t 'symbol "Noto Color Emoji" nil 'prepend) + ;; Make sure the default font does not get overzealous: β β. + ;; For Emacs 28, prefer VS-16: β οΈβοΈ. + (setq use-default-font-for-symbols nil)) + +;;;; Frame title. +(defun my/project-root () + (and-let* ((project (project-current))) + (project-root project))) + +(defun my/project-name () + (and-let* ((root (my/project-root)) + ;; Home is under VC to track dotfile changes. Not a + ;; "project" I want shown in the UI though. + ((not (file-equal-p root "~")))) + (file-name-nondirectory (directory-file-name root)))) + +(defun my/connection-name () + (let ((method (file-remote-p default-directory 'method))) + (pcase method + ;; No method: nil. + ('nil method) + ;; sudo(edit): just "METHOD". + ((pred (string-match-p "sudo")) method) + ;; Default: "METHOD:HOST". + (_ (format "%s:%s" method (file-remote-p default-directory 'host)))))) + +(defun my/frame-title-format () + (let ((prefix + ;; Messing with match data during redisplay is dangerous + ;; (cf. bug#33697). + (save-match-data + ;; For some reason, calling filename-parsing functions + ;; while TRAMP is busy opens the gates to Infinite + ;; Minibuffer Recursion Hell. Cautiously side-step that. + (or + (my/connection-name) + (my/project-name))))) + (concat (when prefix (format "[%s] " prefix)) + "%b"))) + +(setq frame-title-format '(:eval (my/frame-title-format))) + +;;;; Clipboard interaction. +(defun my/kill-as-html (text markup) + (interactive + (list (buffer-substring (region-beginning) (region-end)) + (or (alist-get major-mode '((markdown-mode . "markdown") + (org-mode . "org") + (rst-mode . "rst"))) + (let ((default "plain")) + (read-string (format-prompt "Convert from:" default) + nil nil default))))) + ;; TODO: make this a transient to easily (un)set pandoc extensions. + (with-temp-buffer + (call-process-region text nil "pandoc" nil t nil + "--from" markup "--to" "html") + ;; TODO: could `gui-set-selection' help here? The docstring makes + ;; it sound like passing a value with a 'text/html property set to + ;; the HTML string should work, but empirically it doesn't. + ;; Maybe look into `selection-converter-alist'. + (call-process-region nil nil "xclip" nil nil nil + "-selection" "clipboard" "-target" "text/html"))) + +(defun my/yank-from-html (html markup) + (interactive + (list + (gui-get-selection 'CLIPBOARD 'text/html) + (or (alist-get major-mode '((markdown-mode . "markdown") + (org-mode . "org") + (rst-mode . "rst"))) + (let ((default "plain")) + (read-string (format-prompt "Convert to:" default) + nil nil default))))) + ;; TODO: make this a transient to easily (un)set + ;; * extensions + ;; * switches (--wrap) + ;; * filters (remove all attributes) + (let* ((disabled-html-extensions (list + "native_divs" + "native_spans" + )) + (disabled-markup-extensions (list + ;; "smart" + )) + (html-spec + (funcall 'string-join `("html" ,@disabled-html-extensions) "-")) + (markup-spec + (funcall 'string-join `(,markup ,@disabled-markup-extensions) "-"))) + (call-process-region html nil "pandoc" nil t t + "--wrap=none" + "--from" html-spec "--to" markup-spec))) + +;;;; Miscellany. +(setq-default paragraph-start (concat "[ ]*- \\|" paragraph-start)) + +(defun my/screenshot (output) + (interactive + (list + (let ((default (format-time-string "/tmp/Emacs-Screenshot-%F-%T.pdf"))) + (read-file-name (format-prompt "Output?" default) nil default)))) + (let ((data (x-export-frames)) + (buf (find-file output))) + (insert data) + (save-buffer) + (kill-buffer buf))) + +;; Trying out use-package. + +(use-package use-package + :custom + (use-package-always-defer t)) + +(use-package package + :custom + (package-selected-packages + (append '(auctex + debbugs + delight + diff-hl + elisp-benchmarks + forge + gnus-mock + magit + markdown-mode + page-break-lines + rg + rust-mode + wgrep) + (when (< emacs-major-version 29) + '(eglot use-package)) + (when (< emacs-major-version 30) + '(which-key)))) + :config + (my/setopt-update-list + package-archives '(("melpa" . "https://melpa.org/packages/")))) + +(use-package calendar + :custom + (calendar-intermonth-text '(my/calendar-iso-week year month day)) + (calendar-today-visible-hook '(calendar-mark-today)) + (calendar-week-start-day 1)) + +(use-package diff-hl + :custom + (diff-hl-flydiff-mode t) + (global-diff-hl-mode t) + + ;; FIXME: Adding to these hooks _here_ clobbers them, i.e. they end + ;; up containing (a) the diff-hl functions (b) whatever functions + ;; their libraries add dynamically (c) *none* of the functions + ;; included in the defcustom's default value. + ;; + ;; Therefore, set these hooks up in the :config form _for the + ;; libraries that define these hooks_, so that (presumably) the + ;; default values for these hooks are loaded *before* adding the + ;; diff-hl functions. + ;; + ;; :hook + ;; ((dired-mode . diff-hl-dired-mode-unless-remote) + ;; (magit-pre-refresh . diff-hl-magit-pre-refresh) + ;; (magit-post-refresh . diff-hl-magit-post-refresh)) + ) + +(use-package dired + :custom + (dired-kill-when-opening-new-dired-buffer t) + (dired-listing-switches "-al -Fhv --group-directories-first") + :config + (add-hook 'dired-mode-hook 'diff-hl-dired-mode-unless-remote)) + +(use-package dired-aux + :custom + (dired-vc-rename-file t)) + +(use-package ediff + :custom + (ediff-merge-split-window-function 'split-window-vertically) + (ediff-split-window-function 'split-window-horizontally) + (ediff-window-setup-function 'ediff-setup-windows-plain)) + +(use-package eldoc + :delight "π") + +(use-package erc + :custom + (erc-log-channels-directory + (concat user-emacs-directory "erc/logs")) + (erc-log-write-after-insert t) + (erc-log-write-after-send t) + (erc-notifications-icon + (concat data-directory "images/icons/hicolor/scalable/apps/emacs.svg")) + (erc-prompt-for-nickserv-password nil) + (erc-prompt-for-password nil) + (erc-use-auth-source-for-nickserv-password t) + (erc-user-full-name 'user-full-name) + ;; Timestamps are a mess. + ;; + ;; The default `left-and-right' tries to keep timestamps flush right + ;; either with hard-spacing or with :align-to; both cause jank when + ;; splitting windows or rescaling faces. The default `left' does + ;; not do the separate-date-and-time thing. + ;; + ;; It may be possible to define my own function to do the + ;; date-if-changed-then-time-if-changed thing, but that would + ;; require a lot of cargo-culting of erc-stamp.el which, as of + ;; 30.0.50, makes this look more complex than I have patience for: + ;; an obsolete variable (`erc-stamp-prepend-date-stamps-p'), an + ;; internal minor mode (`erc-stamp--date-mode'), lots of text + ;; properties ('field, 'invisible)β¦ + ;; + ;; The options below seem like the least bad compromise, even though + ;; they yield a huge left margin interrupted by continuation lines; + ;; `erc-fill-wrap' _should_ help with those, except it causes + ;; impromptu recentering. `visual-wrap' could help here. + (erc-insert-timestamp-function 'erc-insert-timestamp-left) + (erc-timestamp-format "[%F %H:%M] ") + :config + (my/setopt-update-list erc-modules '(log notifications stamp track) '(fill)) + (my/setopt-update-list erc-track-exclude-types '("JOIN" "PART" "QUIT"))) + +(use-package forge + ;; Auto-load after Magit, to ensure `f n' works. + :after magit + ;; We have `use-package-always-defer' set, so `:after' does nothing + ;; unless we also set `:demand' (xref GH#572): + :demand t) + +(use-package generic-x + :demand t + :custom + (generic-extras-enable-list + '(etc-fstab-generic-mode + etc-modules-conf-generic-mode + etc-passwd-generic-mode + etc-services-generic-mode + etc-sudoers-generic-mode + hosts-generic-mode + pkginfo-generic-mode + resolve-conf-generic-mode + x-resource-generic-mode))) + +(use-package git-commit + :config + (my/setopt-update-list + git-commit-setup-hook '(git-commit-turn-on-flyspell + my/git-commit-maybe-set-fill-column))) + +(use-package gnus + :custom + ;; Only set file locations here; let gnus-init-file do the heavy + ;; lifting. + (gnus-home-directory (file-name-concat user-emacs-directory "gnus")) + (gnus-init-file (file-name-concat user-emacs-directory "gnus" "init.el"))) + +(use-package isearch + :delight "π" + :custom + (isearch-allow-scroll t) + (isearch-lazy-count t) + (search-default-mode 'char-fold-to-regexp)) + +(use-package magit + :custom + (magit-define-global-key-bindings nil) + (magit-diff-refine-hunk t) + (magit-ediff-dwim-show-on-hunks t) + (magit-revision-show-gravatars t) + :config + (setq magit-process-finish-apply-ansi-colors t) + ;; See `diff-hl' form for rationale. + (add-hook 'magit-pre-refresh-hook 'diff-hl-magit-pre-refresh) + (add-hook 'magit-post-refresh-hook 'diff-hl-magit-post-refresh)) + +(use-package magit-blame + :delight "π") + +(use-package markdown-mode + :custom + (markdown-asymmetric-header t) + (markdown-command "pandoc -s") + (markdown-enable-math t) + (markdown-header-scaling t) + (markdown-indent-on-enter 'indent-and-new-item)) + +(use-package message + :custom + (message-confirm-send t)) + +;; Gripes: +;; - underused keys: C-M-i, C-j +;; - (minibuffer-)choose-completion ignore completion-no-auto-exit +;; when the candidate is a directory: the candidate is inserted in +;; the minibuffer and the user does *not* exit the minibuffer. +;; +;; In minibuffer: +;; - TAB complete, or show/update completions +;; - TABΒ² jump to completions +;; - C-M-n, C-M-p highlight candidate (without changing minibuffer) +;; - RET, C-j accept minibuffer input +;; - M-RET accept highlighted candidate +;; - C-u M-RET insert highlighted candidate (without accepting) +;; +;; In completions: +;; - n, TAB, p highlight candidate (without changing minibuffer) +;; - RET accept highlighted candidate +;; - C-u RET insert highlighted candidate in minibuffer (without accepting) +;; - C-g, q back to minibuffer +(use-package minibuffer + :config + (setq completion-ignore-case t) + (define-key completion-in-region-mode-map (kbd "C-M-n") 'minibuffer-next-completion) + (define-key completion-in-region-mode-map (kbd "C-M-p") 'minibuffer-previous-completion) + (define-key minibuffer-mode-map (kbd "C-M-n") 'minibuffer-next-completion) + (define-key minibuffer-mode-map (kbd "C-M-p") 'minibuffer-previous-completion) + :custom + (completion-auto-help 'visible) + (completion-auto-select 'second-tab) + (completion-pcm-leading-wildcard t) + (completion-show-help nil) + (completions-detailed t) + (completions-format 'one-column) + (completions-group t) + (completions-max-height 10) + (minibuffer-completion-auto-choose nil) + (read-buffer-completion-ignore-case t) + (read-file-name-completion-ignore-case t)) + +(use-package org + :config + (when (version< org-version "9.4") + (define-key org-mode-map (kbd "C-j") 'org-return) + (define-key org-mode-map (kbd "RET") 'org-return-indent)) + :custom + (org-edit-src-content-indentation 0) + (org-ellipsis "β¦") + (org-fontify-done-headline nil) + (org-fontify-quote-and-verse-blocks t) + (org-goto-interface 'outline-path-completion) + (org-startup-indented t) + (org-use-extra-keys t) + (org-use-speed-commands t) + ;; Make org-refile a bit more eager. + (org-outline-path-complete-in-steps nil) + (org-refile-targets '((nil . (:maxlevel . 10)))) + (org-refile-use-outline-path t)) + +(use-package org-indent + :delight "Β»") + +(use-package paren + :custom + (show-paren-mode t) + (show-paren-predicate t)) + +(use-package python + :custom + (python-fill-docstring-style 'pep-257-nn) + (python-forward-sexp-function nil) + (python-indent-def-block-scale 1)) + +(use-package shell + :config + (setq shell-font-lock-keywords nil) + (add-hook 'shell-mode-hook 'my/shell-hook)) + +(use-package shr + :custom + ;; Prefer visual-line-mode, which refills text automatically when + ;; the window width changes. + (shr-fill-text nil)) + +(use-package which-key + :custom + (which-key-dont-use-unicode nil) + (which-key-idle-delay 0.5) + (which-key-mode t) + :delight) + +(use-package whitespace + :config + (my/setopt-update-list whitespace-style nil '(lines missing-newline-at-eof)) + :delight + ;; FIXME: without :demand t, enabling whitespace-mode in a diff + ;; buffer first causes diff-mode's settings to be applied globally. + :demand t) + +;;; TODO: +;; * decruftify mode-line (e.g. remove superflous parens). +;; * teach some modes to give better names to their buffers to reduce +;; clobbering: info, occur |
