diff options
Diffstat (limited to '.config/emacs/init.el')
| -rw-r--r-- | .config/emacs/init.el | 1018 |
1 files changed, 1018 insertions, 0 deletions
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 |