Skip to content

pdcawley/dotemacs

Repository files navigation

Piers Cawley’s Literate Emacs Config

Why a Literate Emacs Config?

Background

I tend to suck at writing comments, but I also tend to leave things for ages between bursts of activity, so having some way of picking up my thoughts is really handy. I want to be able to get context back when I return to a project, and I’ve found from the experience of running the bakery with emacs that a literate programming approach can really help.

My Setup

There’s any number of ways of setting up a literate Emacs configuration. My plan is to have this file as the Single Source Of Truth for everything emacs related that I’ve written and which isn’t otherwise available in another package.

I’ll be using XDG based paths, and placing most of the product files in ~/.config/pdcmacs/ and using a Chemacs2 checkout in ~/.config/emacs/ to select this configuration.

The config is divided into the following parts.

  1. Bog standard early-init.el setting up things like straight.el
  2. An init.el with the more detailed configuration
  3. Package specific support functions and configuration in a modules/ subdirectory
  4. My yasnippet snippets in snippets/

And, in the “nice to have” department:

  1. build script to bring up Emacs how I like it
  2. The various support bits and bobs to allow exporting this to my hugo-based blog.

Noweb

Part of the point of literate programming is to let you present code ‘out of sequence’, so, for instance, one might have all the config relating to a given programming language in one place in this file, but the associated code might be tangled into, say, your org-mode configuration. We do this with noweb. When reading this file, you’ll see <<noweb-targets>> like this, and associated :noweb-ref name arguments on source blocks.

Porting from legacy to Literate [3/4]

  • [X] Move early-init.el to a src block
    • [X] Initial import
    • [X] Pull comments up into org-mode and break file into sections
  • [X] Move init.el to a src block
    • [X] Initial import
    • [X] Make more literate
  • [X] Move config.el to src block
    • [X] Initial import
    • [X] Break into sections
    • [X] Merge with init.el
  • [-] Move modules/ into src blocks and make literate
    • [X] pdcmacs-feeds.el
    • [X] pdcmacs-org.el
    • [ ] pdcmacs-global-bindings.el
    • [ ] pdcmacs-hugo-support.el
    • [X] pdcmacs-webservice.el

Things to investigate [0/2]

RESEARCH Org-transclusion

The org-transclusion package is, apparently a way to link to a document in a way that includes its content in the linking file and which is updated when the linked document is. Not sure if it’s useful for my purposes.

STARTED Dogears

  • State “STARTED” from “RESEARCH” [2024-10-23 Wed 09:43]
Looks useful, a tool for remembering where you’ve been and jumping back there without having to set explicit bookmarks

Initial Setup

This only needs executing the first time you use this setup. It moves any prexisting ~/.emacs.d/ directory to ~/.emacs.d.bak/, ~/.emacs GOES to ~/.emacs.bak/ and any non-chemacs2 version of ~/.config/emacs/ goes to ~/.config/emacs.default/. Execute the block using C-c C-c

# Error out early

set -euo pipefail
set -o noclobber

echo "Setting up emacs folder in ~/.config"
mkdir -p ~/.config/emacs/secrets
mkdir -p ~/.config/emacs/snippets
mkdir -p ~/.config/emacs/abbrevs

if [ -L ~/.emacs.d ] && [ -d ~/.emacs.d ]
then
    echo "~/.emacs.d is already a symlink"
else
    echo "Creating symlink"
    if [ -d ~/.emacs.d ]
    then
        echo "~/.emacs.d exists, moving to .emacs.d.bak"
        mv ~/.emacs.d ~/.emacs.d.bak
    fi
    ln -s ~/.config/emacs ~/.emacs.d
fi

echo "Tangling README.org"
cd ~/.config/emacs
emacs --batch -l org --eval '(org-babel-tangle-file "README.org")'

Early Initialisation

I use early-init.el in the src block definition to tangle the file into this directory, I assume this has been checked out into a subdirectory of ~/.config/ that matches a Chemacs2 profile name. This file is loaded before the package system or GUI of Emacs is loaded and is ideally code that does not depend on any packages or the size of the frame.

Turn on lexical binding and warn about editing

Your basic preamble comment

;;; early-init.el --- Piers Cawley's initial Emacs config -*- lexical-binding: t; no-byte-compile: t -*-
;;; WARNING: This file is generated by an org file, don't edit it directly

Who are we?

(setq user-full-name "Piers Cawley"
      user-email-address "piers@singingtogether.co.uk")

Claim authorship

;;; Made by Piers Cawley <piers@singingtogether.co.uk> and fiddled with by them
;;; over the years from around 1996 until at least 2024

Inhibit packages at startup

We use straight and configure it a little later.

(setq package-enable-at-startup nil)

Accelerate startup some

Increasing the GC thresholds and turning off file name handlers during startup makes things a fair bit faster, so we do that. The ‘proper’ values will be restored by our after-init-hook.

(setq-default lexical-binding t
              load-prefer-newer t)
(defvar initial-gc-cons-threshold gc-cons-threshold)
(defvar initial-gc-cons-percentage gc-cons-percentage)
(defvar initial-file-name-handler-alist file-name-handler-alist)

(setq gc-cons-threshold most-positive-fixnum
      gc-cons-percentage 0.6)

(add-hook 'after-init-hook
          (lambda ()
            (setq gc-cons-threshold initial-gc-cons-threshold
                  gc-cons-percentage initial-gc-cons-percentage
                  file-name-handler-alist initial-file-name-handler-alist)))

Set up native compilation as we like it.

  • Prefer the loading the newest compiled .el file
  • Silence deferred native compilation warnings and compile asynchronously
  • Drop the compiled files in eln-cache/
(when (featurep 'native-compile)
  (setq native-comp-async-report-warnings-errors nil
        native-comp-deferred-compilation t)
  (add-to-list 'native-comp-eln-load-path (expand-file-name "eln-cache/" user-emacs-directory)))

(add-to-list 'display-buffer-alist
             '("\\`\\*\\(Warnings\\|Compile-Log\\)\\*\\'"
               (display-buffer-no-window)
               (allow-no-window . t)))

Add the mode to the frame title format

I plan to start voice coding again some time, and find it’s easier to switch the coding grammar if the emacs mode is visible in the window name.

(setq frame-title-format '(mode-name ":%b"))

Inhibit a bunch of startup cruft

(setq frame-resize-pixelwise t
      frame-inhibit-implied-resize t
      ring-bell-function 'ignore
      use-dialog-box t
      use-file-dialog nil
      inhibit-splash-screen t
      inhibit-startup-screen t
      inhibit-x-resources t
      inhibit-startup-echo-area-message user-login-name
      inhibit-startup-buffer-menu t
      inhibit-startup-message t
      confirm-kill-processes nil)

(setq default-frame-alist
      (append default-frame-alist
              '((fullscreen . maximized)
                (tool-bar-lines . 0)
                (menu-bar-lines . 0)
                (vertical-scroll-bars . nil)
                (internal-border-width . 2)
                (undecorated-round . t)
                (scroll-bar-mode . -1))))

(menu-bar-mode -1)
(scroll-bar-mode -1)
(tool-bar-mode -1)

(setq scroll-margin 0
      scroll-conservatively 100000
      scroll-preserve-screen-position 1)

(setopt large-file-warning-threshold (* 100 1000 1000))

Life’s to short to type “no” when Emacs asks.

Newish Emacs versions have use-short-answers so we use that when it’s available. Otherwise we fall back to making yes-or-no-p and alias of y-or-n-p. It’s great that Emacs does this out of the box now, but it will most likely be another ten years before I remove the obsolete hack from this bit of my config.

(if (boundp 'use-short-answers)
    (setq use-short-answers t)
  (defalias 'yes-or-no-p 'y-or-no-p))

The Emacs Server

We’ll emulate the --daemon switch here, and start the server after we’ve finished initializing everything. (Hence the third argument to add-hook).

If this doesn’t work with a Mac GUI version, try adding TMPDIR to the configuration of exec-path-from-shell.

(defun server-start-idempotently ()
  (require 'server)
  (or (server-running-p)
      (server-start)))
(add-hook 'emacs-startup-hook #'server-start-idempotently 100)

init.el

Info block

Again, we’re tangling into a init.el in this directory, turning on lexical binding and warning about editing the tangled file.

;;; init.el --- Piers Cawley's Emacs config -*- lexical-binding: t; no-byte-compile: t -*-
;;; WARNING: This file is generated by an org file, don't edit it directly

<<copyright-block>>

Finding our modules

Next we set up our modules directory

(add-to-list 'load-path (expand-file-name "modules/" user-emacs-directory))

And setup some support variables relating to the structure of our config directory.

(defvar pdcmacs-config-file (expand-file-name "config.el"  user-emacs-directory)
  "Our post-init config file.")

(defvar pdc/org-config-file (expand-file-name "README.org" user-emacs-directory)
  "Literate source of config truth")

(defvar pdcmacs-init-file (expand-file-name "init.el" user-emacs-directory))

Prefer UTF-8

Next we let Emacs know, unequivocally, that we prefer utf-8 encoding.

(set-charset-priority 'unicode)
(setopt locale-coding-system 'utf-8
        coding-system-for-read 'utf-8
        coding-system-for-write 'utf-8)
(set-default-coding-systems 'utf-8)
(set-keyboard-coding-system 'utf-8)
(set-terminal-coding-system 'utf-8)
(set-selection-coding-system 'utf-8)
(prefer-coding-system 'utf-8)

(set-clipboard-coding-system 'utf-8)
(setopt x-select-request-type '(UTF8_STRING COMPOUND_TEXT TEXT STRING))
(setopt default-process-coding-system '(utf-8-unix . utf-8-unix))

Add some C-x 8 helper bindings

(use-package emacs
  :bind (
         :map iso-transl-ctl-x-8-map
         (". ;" . [?…])))

Package Management

Get straight.el up and running

We use straight.el and use-package to manage our packages. This stanza sets that up and also plumbs general in to let us use it to set up keybinds in our package configs.

(defvar bootstrap-version)
(let ((bootstrap-file
       (expand-file-name
  	    "straight/repos/straight.el/bootstrap.el"
  	    (or (bound-and-true-p straight-base-dir)
  	        user-emacs-directory)))
      (bootstrap-version 7))
  (unless (file-exists-p bootstrap-file)
    (with-current-buffer
  	    (url-retrieve-synchronously
  	     "https://radian-software.github.io/straight.el/install.el"
  	     'silent 'inhibit-cookies)
      (goto-char (point-max))
      (eval-print-last-sexp)))
  (load bootstrap-file nil 'nomessage))

(if (< emacs-major-version 29)
    (straight-use-package 'use-package)
  (require 'use-package))
(setq use-package-verbose nil
      use-package-always-defer t
      use-package-enable-imenu-support t)
;; For some reason, I'm getting loads of warnings about use-package parse
;; errors while I'm editing stuff and *of course* I am. While I go searching
;; for whatever's so eagerly running these checks while I'm halfway through
;; typing stuff, I'm just suppressing the warnings from popping up a warnings
;; buffer. They're still logged.
(add-to-list 'warning-suppress-types '(use-package))

(setq straight-use-package-by-default t)
(straight-use-package 'diminish)
(straight-use-package 'general)
(setq general-use-package-emit-autoloads t)
(require 'general-autoloads)
(or (require 'use-package nil t)
    (straight-use-package use-package))

;; Get autocompilation or whatever sorted nice and early.
<<early-compile-tweaks>>
;; get org loaded early
(straight-use-package 'org)

Tweak binding

Out of the box, use-package is a bit too conservative about what it’ll accept in a :bind stanza – it rejects stuff like ("M-m t" . ("wk-description" . some-command)), which makes me unhappy.

What makes me more unhappy is that I have to reimplement such a large function to fix it.

(defun use-package-normalize-binder (name keyword args)
  (let ((arg args)
        args*)
    (while arg
      (let ((x (car arg)))
        (cond
         ;; (KEY . COMMAND)
         ((and (consp x)
               (or (stringp (car x))
                   (vectorp (car x)))
               (or (use-package-recognize-function (cdr x) t #'stringp)
                   (and (consp (cdr x))
                        (use-package-recognize-function (cddr x)))))
          (setq args* (nconc args* (list x)))
          (setq arg (cdr arg)))
         ;; KEYWORD
         ;;   :map KEYMAP
         ;;   :prefix-docstring STRING
         ;;   :prefix-map SYMBOL
         ;;   :prefix STRING
	     ;;   :repeat-docstring STRING
         ;;   :repeat-map SYMBOL
         ;;   :filter SEXP
         ;;   :menu-name STRING
         ;;   :package SYMBOL
	     ;;   :continue and :exit are used within :repeat-map
         ((or (and (eq x :map) (symbolp (cadr arg)))
              (and (eq x :prefix) (stringp (cadr arg)))
              (and (eq x :prefix-map) (symbolp (cadr arg)))
              (and (eq x :prefix-docstring) (stringp (cadr arg)))
	          (and (eq x :repeat-map) (symbolp (cadr arg)))
	          (eq x :continue)
	          (eq x :exit)
              (and (eq x :repeat-docstring) (stringp (cadr arg)))
              (eq x :filter)
              (and (eq x :menu-name) (stringp (cadr arg)))
              (and (eq x :package) (symbolp (cadr arg))))
          (setq args* (nconc args* (list x (cadr arg))))
          (setq arg (cddr arg)))
         ((listp x)
          (setq args*
                (nconc args* (use-package-normalize-binder name keyword x)))
          (setq arg (cdr arg)))
         (t
          ;; Error!
          (use-package-error
           (concat (symbol-name name)
                   " wants arguments acceptable to the `bind-keys' macro,"
                   " or a list of such values"))))))
    args*))

Setup Helper Functions and Macros

Add use-feature for Emacs builtins

First, let’s set up a use-feature macro that works like use-package for libraries that come with emacs. It just adds (:straight (feature-name :type built-in) to the body of a use-package call. I always forget the exact incantation, so into a macro it goes.

(defmacro use-feature (feature &rest body)
  "`use-package' for stuff that comes with Emacs."
  (declare (indent defun))
  `(use-package ,feature
     :straight (,feature :type built-in)
     ,@body))

(defconst use-feature-font-lock-keywords
  '(("(\\(use-feature\\)\\_>[ \t']*\\(\\(?:\\sw\\|\\s_\\)+\\))?"
     (1 font-lock-keyword-face)
     (2 font-lock-constant-face nil t))))

(font-lock-add-keywords 'emacs-lisp-mode use-feature-font-lock-keywords)

Conditional config macros

for-(terminal|gui|mac) allow us to setup behaviour that only applies in specific UI contexts.

(defmacro for-terminal (&rest body)
  (declare (indent defun))
  (unless (display-graphic-p) `(progn ,@body)))

(defmacro for-gui (&rest body)
  (declare (indent defun))
  (when (display-graphic-p) `(progn ,@body)))

(defmacro for-mac (&rest body)
  (declare (indent defun))
  (when (eq "darwin" system-type) `(progn ,@body)))

which-key

We want to plumb which-key into use-package and set up a couple of variables associated with our leader-key based keymaps.

(defvar pdc-leader "M-m")
(defvar pdc-mode-leader "C-,")
(use-package which-key
  :diminish
  :custom
  (which-key-separator " ")
  (which-key-prefix "+")
  (which-key-show-early-on-C-h t)
  ;; Let's experiment with using C-h to invoke which-key display
  (which-key-idle-delay 10.0)
  :config
  ;; TODO: Replace this with something advice based.
  (defun which-key--compute-binding (binding)
    (copy-sequence (if-let* ((docstring (get binding 'variable-documentation)))
                       (format "+%s" docstring)
                     (symbol-name
                      (or (and which-key-compute-remaps
                               (command-remapping binding))
                          binding)))))
  (which-key-mode 1))

Grab dash, s, f

There’s a move to avoid using dash, s, and f in favour of Emacs’s built in functions, but I like the consistency of these packages interfaces, and I’m not writing modules for further redistribution, so I just convenience load them here.

(use-package dash
  :config
  (dash-enable-font-lock))
(use-package s)
(use-package f)

Prevent Emacs dropping files hither and yon

no-littering is a handy tool to stop Emacs dropping temporary files all over the shop.

(use-package no-littering
  :config
  <<no-littering-config>>

Move auto-save and backups into no-littering directories

(setopt auto-save-file-name-transforms
      `(("\\`/[^/]*:\\([^/]*/\\)*\\([^/]*\\)\\'" ,(no-littering-expand-var-file-name "auto-save/\\2") t)
        (".*" ,(no-littering-expand-var-file-name "auto-save/") t)))
(setopt backup-directory-alist
      `((".*" . ,(no-littering-expand-var-file-name "backups/")))))

Save preferences in ./etc/preferences.el

We don’t make much use of the internal custom facility, but when we do, we don’t want it stomping all over init.el, so we move it away:

(setopt custom-file (no-littering-expand-etc-file-name "preferences.el"))

Browsing links

Use EWW in text mode

(use-feature eww
  :unless (display-graphic-p)
  :custom (browse-url-browser-function #'eww-browse-url))

Miscellaneous niggly things

Better (IMHO) defaults

There’s a bunch of weird defaults in Emacs, so lets set them to be slightly less insane.

(setopt sentence-end-double-space nil
        compilation-scroll-output 'first-error
        truncate-string-ellipsis ""
        create-lockfiles nil

        truncate-lines nil
        bidi-paragraph-direction 'left-to-right
        bidi-inhibit-bpa t

        warning-suppress-types '((comp) (use-package))
        fill-column 79
        gnutls-verify-error t
        gnutls-min-prime-bits 2048
        password-cache-expiry nil
        track-eol t
        mouse-yank-at-point t
        save-interprogram-paste-before-kill t

        apropos-do-all t
        require-final-newline t
        tramp-default-method "ssh"
        tramp-copy-size-limit nil
        tramp-use-ssh-controlmaster-options nil
        vc-follow-symlinks t
        grep-use-headings t
        completions-detailed t
        read-minibuffer-restore-windows nil
        mode-line-compact 'long
        kill-do-not-save-duplicates t
        auto-window-vscroll nil
        fast-but-imprecise-scrolling t
        custom-safe-themes t
        enable-local-variables :all

        delete-old-versions 0
        vc-make-backup-files t

        history-length t
        history-delete-duplicates t

        ad-redefinition-action 'accept

        line-move-visual nil

        tab-width 4
        indent-tabs-mode nil

        ;; New feature in 28. Let's try it.
        next-error-message-highlight t)

Tweak recentering

(setopt scroll-error-top-bottom t
        recenter-positions '(middle top bottom))

Let’s try these slightly altered scrolling defaults and see how they feel.

Enable ‘dangerous’ commands

And, by default, emacs disables a few useful commands, so we re-enable them:

(dolist (cmd '(erase-buffer
               narrow-to-page
               narrow-to-region
               upcase-region
               downcase-region))
  (put cmd 'disabled nil))

Adjust compile warnings

We’d like to see compile warnings promptly.

(setq byte-compile-warnings '(not free-vars unresolved noruntime lexical make-local))
(defun dont-delay-compile-warnings (fun type &rest args)
  (if (eq type 'bytecomp)
      (let ((after-init-time t))
        (apply fun type args))
    (apply fun type args)))
(advice-add 'display-warning :around #'dont-delay-compile-warnings)

Deindent the Kill ring

(if (fboundp 'kill-ring-deindent-mode)
    (kill-ring-deindent-mode 1))

Word Wrap

Disable fill-paragraph when visual-line-mode is enabled.

(use-feature visual-line-mode
  :bind (:map visual-line-mode-map
              ([remap fill-paragraph] . ignore)))

Keybinding support functions

I got heavily invested in general.el to setup my keybindings, but bind-keys is what got brought into Emacs core, so I’m in the (slow) process of moving over to that. But for the time being, I still need the old system.

(require 'pdcmacs-global-bindings)

Set up the UI

Line numbers in programming modes ftw

(use-package display-line-numbers
  :hook
  ((conf-mode prog-mode text-mode) . 'display-line-numbers-mode)
  :custom
  (display-line-numbers-grow-only t)
  (display-line-numbers-type t)
  (display-line-numbers-width nil)
  :config
  (defvar pdc/line-number-states '(nil t relative visual)
    "States to cycle through for line numbers.")

  (defvar-local pdc/current-line-number-index 1
    "Current index in `pdc/line-number-states` for the current buffer.")

  (defun pdc/cycle-line-numbers ()
    "Cycle through different line number modes."
    (interactive)
    (setq pdc/current-line-number-index
          (mod (1+ pdc/current-line-number-index)
               (length pdc/line-number-states)))
    ;; Update display-line-numbers
    (setq display-line-numbers
          (nth pdc/current-line-number-index pdc/line-number-states))

    ;; Force a UI update
    (redraw-display)

    (message "Line numbers: %s" display-line-numbers)))

I like to see the time

(display-time-mode 1)

Configuration

Help with Emacs commands

The help system in Emacs is great, but it can be improved. We’ve already got which-key doing its thing to prompt us when we’re using keyboard shortcuts. Let’s add helpful to improve the help system.

(use-package helpful
  :custom
  (counsel-describe-function-function #'helpful-callable)
  (counsel-describe-variable-function #'helpful-variable)
  :bind (("C-c C-d" . helpful-at-point)
         ([remap describe-command]  . helpful-command)
         ([remap describe-function] . helpful-callable)
         ([remap describe-key]      . helpful-key)
         ([remap describe-variable] . helpful-variable)
         ([remap describe-symbol]   . helpful-symbol)
         :map help-map
         ("F" . helpful-function)
         :map helpful-mode-map
         ([remap revert-buffer] . helpful-update)))

Info tweaks

We use casual-info

(use-package casual
  :bind (:map Info-mode-map ("C-o" . casual-info-tmenu)))

Look and feel

Theme

Modus Vivendi

(use-package modus-themes
  :init
  (load-theme 'modus-vivendi))

Display background colour for strings with the colour value

rainbow-mode is a minor mode for Emacs which displays strings representing colours with the colour they represent as background.

(use-package rainbow-mode
  :diminish rainbow-mode
  :hook prog-mode)

Padding between elements

This adds some space between various elements in Emacs: https://protesilaos.com/codelog/2023-06-03-emacs-spacious-padding

(use-package spacious-padding
  :custom
  (spacious-padding-widths . ( :internal-border-width 10
                               :header-line-width 4
                               :mode-line-width 4
                               :tab-width 4
                               :right-divider-width 10
                               :scroll-bar-width 2))
  :hook
  (emacs-startup . spacious-padding-mode))

Modeline

doom-modeline

So many modeline packages. I ended up settling on the doom-modeline package.

(use-package doom-modeline
  :custom
  (doom-modeline-height 15)
  (doom-modeline-bar-width 6)
  (doom-modeline-minor-modes t)
  (doom-modeline-buffer-encoding 1)
  (doom-modeline-buffer-file-name-style 'truncate-except-project)
  :hook after-init)

‘Diminish’ major mode names

There’s a lot going on in some modelines, and long major mode names can take up a sizeable chunk of the 80 columns available in terminal mode. So let’s pinch an idea from http://whattheemacsd.com/appearance.el-01.html and shorten a few:

(defmacro rename-modeline (mode new-name &optional feature)
  "After loading FEATURE, rename MODE to NEW-NAME on the modeline."
  (let ((f (or feature `(quote ,mode))))
    `(with-eval-after-load ,f
       (define-advice ,mode (:after (&optional args) rename-modeline)
         (setq mode-name ,new-name)))))

(rename-modeline emacs-lisp-mode "λ(e)" 'elisp-mode)

Diminish a few minor modes too

(with-eval-after-load 'diminish
  (diminish 'visual-line-mode ""))

Fonts

Extend font-lock

(use-feature font-lock)

(use-package font-lock+
  :straight
  (:type git :host github :repo "emacsmirror/font-lock-plus"))

Icons and such

nerd-icons seems to fit the bill in terminal mode, all-the-icons is more comprehensive in graphic mode though, so we’ll load that then.

(use-package nerd-icons
  :unless (display-graphic-p))

(use-package nerd-icons-corfu
  :after (nerd-icons corfu)
  :config
  (add-to-list 'corfu-margin-formatters #'nerd-icons-corfu-formatter))

(use-package nerd-icons-dired
  :after (nerd-icons dired)
  :hook dired-mode)

(use-package all-the-icons
  :if (display-graphic-p))

(use-package all-the-icons-dired
  :after (all-the-icons dired)
  :hook dired-mode)

(use-package all-the-icons-completion
  :after (all-the-icons marginalia)
  :hook
  (marginalia-mode . all-the-icons-completion-marginalia-setup)
  (after-init . all-the-icons-completion-mode))

(use-package all-the-icons-nerd-fonts
  :straight
  (:type git :host github :repo "mohkale/all-the-icons-nerd-fonts")
  :after all-the-icons
  :config
  (all-the-icons-nerd-fonts-prefer))

(use-package all-the-icons-ibuffer
  :after all-the-icons
  :hook ibuffer-mode)

(use-package svg-lib :if (display-graphic-p))

Coping with running in a terminal

Sometimes, I run emacs in a terminal emulator on my iPad, it’s fine – not as rich an experience as the GUI, but more than good enough.

Mouse support

xterm-mouse-mode is our friend.

(for-terminal
  (xterm-mouse-mode 1))

Cut/paste integration

Of course there are multiple clipboards in play. clipetty fixes at least some of the niggles.

(for-terminal
  (use-package clipetty
    :diminish
    :hook (emacs-startup . global-clipetty-mode)))

Translate modifiers for stuff

(for-terminal
  (keymap-set input-decode-map
              "M-[ 2 7 ; 4 ; 9 ~" [M-backtab])
  (keymap-set input-decode-map
              "M-[ 2 7 ; 8 ; 9 ~" [C-M-backtab]))

Quality of Life stuff

Make C-g a little more helpful

Another one lifted from Prot’s config.

(defun prot/keyboard-quit-dwim ()
  "Do-What-I-Mean behaviour for a general `keyboard-quit'.

The generic `keyboard-quit' does not do the expected thing when
the minibuffer is open.  Whereas we want it to close the
minibuffer, even without explicitly focussing on it.

Our DWIM behaviour is as follows:

- When the region is active, disabled it.
- When a minibuffer is open, but not focussed, close it.
- When the Completions buffer is selected, close it.
- Otherwise, just do `keyboard-quit'."
  (interactive)
  (cond
   ((region-active-p)
    (keyboard-quit))
   ((derived-mode-p 'completion-list-mode)
    (delete-completion-window))
   ((> (minibuffer-depth) 0)
    (abort-recursive-edit))
   (t
    (keyboard-quit))))
(bind-keys :map global-map
           ("C-g" . prot/keyboard-quit-dwim))

Versioning

Well, of course I’m using Magit to manage git. I’m not an idiot!

Magit & Transient

Loading transient before magit helps with a potential race condition

(use-package transient)

(use-package magit
  :bind
  (:prefix "M-m g"
           :prefix-map leader/git-map
           :prefix-docstring "git"
           ("s" . magit-status)
           ("d" . magit-dispatch)
           ("f" . magit-file-dispatch)
           ("l" . magit-log))
  :config
  (define-advice magit-status (:around (oldfun &rest args) magit-fullscreen)
    (window-configuration-to-register :magit-fullscreen)
    (apply oldfun args)
    (delete-other-windows))
  (define-advice magit-mode-quit-window (:around (oldfun &rest args) magit-restore-screen)
    (apply oldfun args)
    (jump-to-register :magit-fullscreen))
  :custom
  (magit-define-global-key-bindings nil)
  (magit-section-invisibility-indicator '(""))
  (git-commit-summary-max-length 50)
  (git-commit-style-convention-checks '(non-empty-second-line))
  (magit-diff-refine-hunk t)
  (magit-no-confirm '(stage-all-changes
                      unstage-all-changes
                      set-and-push)))

Diff-hl

Time to experiment with diff-hl – apparently better than git-gutter

(use-package diff-hl
  :init
  (defun +diff-hl-use-margin-on-tty ()
    (unless (display-graphic-p)
      (diff-hl-margin-local-mode)))
  :hook
  (emacs-startup . global-diff-hl-mode)
  (emacs-startup . diff-hl-flydiff-mode)
  (dired-mode . diff-hl-dired-mode)
  (magit-pre-refresh . diff-hl-magit-pre-refresh)
  (magit-post-refresh . diff-hl-magit-post-refresh)
  (diff-hl-mode-on . +diff-hl-use-margin-on-tty))

Smerge

Smerge is what handles merging and we’d like to plumb it into our leader key based bindings

(use-feature smerge-mode
  :after which-key
  :custom
  (smerge-auto-leave nil)
  :config
  (map-keymap
   (lambda (_key cmd)
     (when (symbolp cmd)
       (put cmd 'repeat-map 'smerge-basic-map)))
   smerge-basic-map))

git-modes

Various minor and major modes for different git-related files.

(use-package git-modes)

Navigation

Moving around within Emacs (buffers, frames, windows, etc.)

Winner mode

Capture and restore window configuration

(use-feature winner
  :hook after-init
  :config
  (setopt winner-boring-buffers
          (append winner-boring-buffers
                  '("*Completions*"
                    "*Compile-Log*"
                    "*inferior-lisp*"
                    "*Fuzzy Completions*"
                    "*Apropos*"
                    "*Help*"
                    "*cvs*"
                    "*Buffer List*"
                    "*Ibuffer*"
                    "*esh command on file*"))))

Buffer name relative

I’m not sure what it does, but apparently it makes recognising names easier. So, I’ll give buffer-name-relative a go.

(use-package buffer-name-relative
  :hook emacs-startup)

Buffer management

Casual ibuffer mode

The various casual-* modules are great, so let’s try the ibuffer one.

(use-feature ibuffer
  :hook (ibuffer-mode . ibuffer-auto-mode))

(use-package ibuffer
  :bind (:map
         ibuffer-mode-map
         ("C-o" . casual-ibuffer-tmenu)
         ("F" . casual-ibuffer-filter-tmenu)
         ("s" . casual-ibuffer-sortby-tmenu)
         ("<double-mouse-1>" . ibuffer-visit-buffer)
         ("M-<double-mouse-1>" . ibuffer-visit-buffer-other-window)
         ("{" . ibuffer-backwards-next-marked)
         ("}" . ibuffer-forwards-next-marked)
         ("[" . ibuffer-backward-filter-group)
         ("]" . ibuffer-forward-filter-group)
         ("$" . ibuffer-toggle-filter-group))
  :after (ibuffer))

Quick navigation in the mini-buffer

(use-package consult-dir
  :after vertico consult
  :bind (([list-directory] . consult-dir)
         :map vertico-map
         ("C-x C-d" . consult-dir)
         ("C-x C-j" . consult-dir-jump-file)))

Dired

Basic configuration nicked from Prot: https://protesilaos.com/codelog/2023-06-26-emacs-file-dired-basics/

(use-feature dired
  :after vertico pdcmacs-global-bindings
  :bind (("M-m a d" . dired)
         ("M-m j d" . dired-jump)
         ("M-m j D" . dired-jump-other-window)
         :map dired-mode-map
         (", w"     . wdired-change-to-wdired-mode))
  :config
  (put 'dired-find-alternate-file 'disabled nil)
  <<dired-config>>
  :hook
  (after-init . file-name-shadow-mode)
  (rfn-eshadow-update-overlay . vertico-directory-tidy)
  (dired-mode . dired-hide-details-mode)
  :custom
  (dired-dwim-target t)
  (dired-guest-shell-alist-user
   '(("\\.\\(png\\|jpe?g\\|tiff?\\)" "feh" "xdg-open")
     ("\\.\\(mp[34]\\|m4a\\|ogg\\|flac\\|webm\\|mkv\\)" "mpv" "xdg-open")
     (".*" "xdg-open")))
  (insert-directory-program (or (executable-find "gls")
                                (executable-find "ls")))
  (dired-recursive-copies 'always)
  (dired-recursive-deletes 'always)
  (dired-use-ls-dired nil)
  (dired-listing-switches (if (string-match-p "/gls$" insert-directory-program)
                              "-al --group-directories-first"
                            "-al"))
  (dired-omit-file-p t)
  (dired-omit-files "^\\.?#"))

(use-package dired-subtree
  :after dired
  :bind
  ( :map dired-mode-map
    ("<tab>" . dired-subtree-toggle)
    ("TAB"   . dired-subtree-toggle)
    ("<backtab>" . dired-subtree-remove)
    ("S-TAB"     . dired-subtree-remove))
  :custom
  (dired-subtree-use-backgrounds nil))

(use-feature dired-x
  :commands (dired-jump dired-jump-other-window dired-omit-mode))

(use-package casual
  :bind (:map dired-mode-map ("C-o" . casual-dired-tmenu)))

Avoid autocompletion when prompting for new directories and files

Taken from James Dyer

(defun pdc/dired-create-directory ()
  "Wrapper to dired-create-directory to avoid minibuffer completion"
  (interactive)
  (let ((search-term
         (read-from-minibuffer "Dir : ")))
    (dired-create-directory search-term)))

(defun pdc/dired-create-empty-file ()
  "Wrapper to `dired-create-empty-file' to avoid minibuffer expansion"
  (interactive)
  (let ((search-term
         (read-from-minibuffer "File : ")))
    (dired-create-empty-file search-term)))

(bind-keys :map dired-mode-map
           ("_"       . pdc/dired-create-empty-file)
           ("+"       . pdc/dired-create-directory))

Navigate with some buffers in read only mode

Using the built in view-mode works like a char, it converts buffers to view only and doesn’t allow them to be modified. The following added behaviour is nicked from http://yummymelon.com/devnull/enhancing-navigation-in-emacs-view-mode.html.

(use-feature view
  :hook (view-mode . pdc/view-mode-hook)
  :custom
  (view-read-only t)
  :preface
  (defun pdc/view-mode-hook ()
    (cond ((derived-mode-p 'org-mode)
           (bind-keys :map view-mode-map
                      ("p" . org-previous-visible-heading)
                      ("n" . org-next-visible-heading)))
          ((derived-mode-p 'markdown-mode)
           (bind-keys :map view-mode-map
                      ("p" . markdown-outline-previous)
                      ("n" . markdown-outline-next)))
          ((derived-mode-p 'python-mode)
           (bind-keys :map view-mode-map
                      ("p" . python-nav-backward-block)
                      ("n" . python-nav-forward-block)))
          ((derived-mode-p 'emacs-lisp-mode)
           (bind-keys :map view-mode-map
                      ("p" . backward-sexp)
                      ("n" . forward-sexp)))
          ((derived-mode-p 'makefile-mode)
           (bind-keys :map view-mode-map
                      ("p" . makefile-previous-dependency)
                      ("n" . makefile-next-dependency)))
          ((derived-mode-p 'c-mode)
           (bind-keys :map view-mode-map
                      ("p" . c-beginning-of-defun)
                      ("n" . c-end-of-defun)))

          ((derived-mode-p 'prog-mode)
           (bind-keys :map view-mode-map
                      ("p" . backward-sexp)
                      ("n" . forward-sexp)))
          (t
           (bind-keys :map view-mode-map
                      ("p" . scroll-down-command)
                      ("n" . scroll-up-command))))))

Imenu

Not sure I’ve put this in the right place, but it’s a start. imenu allows for jumping about a buffer based on a mode specific index. I should remember it’s there more often.

(use-package imenu
  :bind
  (("M-m j i" . imenu))
  :hook
  (font-lock-mode .  pdc/try-to-add-imenu)
  :custom
  (imenu-sort-function 'imenu--sort-by-name)
  :init
  (defun pdc/try-to-add-imenu ()
    "Add Imenu to modes that have font-lock-mode activated."
    (condition-case nil (imenu-add-to-menubar "Imenu")
      (error nil))))

(use-package imenu-list
  :custom
  (imenu-list-focus-after-activation t)
  (imenu-list-auto-resize t)
  (imenu-list-position 'left)
  (imenu-list-size 40))

Jumping with avy

(use-package avy
  :bind (("M-m j '" . avy-goto-char)
         ("M-m j ;" . avy-goto-char-timer))
  :custom
  (avy-timeout-seconds 0.3)
  (avy-single-candidate-jump nil)
  :config
  (defun pdc/avy-action-embark (pt)
    (unwind-protect
        (save-excursion
          (goto-char pt)
          (embark-act))
      (select-window
       (cdr (ring-ref avy-ring 0))))
    t)
  (setf (alist-get ?. avy-dispatch-alist) 'pdc/avy-action-embark))


(use-package casual
  :bind ("M-m j A" . casual-avy-tmenu)
  :after avy)

Jumping between windows

(use-package ace-window
  :bind
  ([other-window] . ace-window)
  ("M-m w o" . ace-window)
  ("M-m w s" . ace-swap-window))

Dogears

(use-package dogears
  :hook emacs-startup
  :bind (("M-m j d" . dogears-go)
         ("M-m j M-b" . dogears-back)
         ("M-m j M-f" . dogears-forward)
         ("M-m j M-d" . dogears-list)
         ("M-m j M-D" . dogears-sidebar)))

Bookmarks

I don’t know that much about using emacs bookmarks, but I definitely want them dropping into the no-littering directory tree.

(use-feature bookmark
  :config
  (setq bookmark-default-file (no-littering-expand-var-file-name "bookmarks"))
  (setopt bookmark-save-flat 1))

File handling

Autorevert

We want to keep buffers in sync with their underlying files (and directories) so we use autorevert

(use-feature autorevert
  :commands global-auto-revert-mode
  :custom
  (global-auto-revert-non-file-buffers t)
  (auto-revert-verbose nil)
  :hook (after-init . global-auto-revert-mode))

Whitespace butler

I’m not a fan of trailing white space, nor am I fan of surprise whitespace diffs on lines I didn’t touch when adding changes to git. ws-butler-mode tidies up trailing whitespace on file save, but only on lines I modified. Perfect!

(use-package ws-butler
  :straight (ws-butler :type git
                       :host github
                       :repo "lewang/ws-butler"
                       :branch "master")
  :diminish
  :hook
  ((prog-mode text-mode) . ws-butler-mode))

Editing

General/global tools

Highlighting the line

Pulse the current line or region on demand, and after certain commands.

(defun pulse-line (&rest _)
  "Pulse the current line."
  (pulse-momentary-highlight-one-line (point)))

(defun pulse-line-command ()
  "Interactively pulse the current line."
  (interactive)
  (pulse-line))

(defun pdc/--pulse-current-region-raw (&rest _)
  "Pulse the current implicit or active region."
  (if mark-active
      (pulse-momentary-highlight-region (region-beginning) (region-end))
    (pulse-momentary-highlight-region (point) (mark))))

(defun pdc/pulse-current-region (&rest _)
  "Interactively pulse the current implicit or active region."
  (interactive)
  (pdc/--pulse-current-region-raw))


(defun pdc-reveal-entry ()
  "Reveal Org or Outline entry and pulse the current line."
  (cond
   ((and (eq major-mode 'org-mode)
         (org-at-heading-p))
    (org-show-entry))
   ((and (or (eq major-mode 'outline-mode)
             (bound-and-true-p outline-minor-mode))
         (outline-on-heading-p))
    (outline-show-entry))))

(defun pdc-recenter ()
  (recenter-top-bottom 2))

(dolist (command '(scroll-up-command
                   scroll-down-command
                   recenter-top-bottom
                   other-window))
  (advice-add command :after #'pulse-line))

(advice-add #'copy-region-as-kill :after #'pdc/--pulse-current-region-raw)

;; (advice-add #'copy-region-as-kill :before #'pdc/pulse-current-region)

(bind-keys
 ("C-c h p" . pulse-line-command))

(add-hook 'minibuffer-setup-hook #'pulse-line)
(add-hook 'consult-after-jump-hook #'pdc-recenter)
(add-hook 'consult-after-jump-hook #'pdc-reveal-entry)

(add-hook 'imenu-after-jump-hook #'pdc-recenter)
(add-hook 'imenu-after-jump-hook #'pdc-reveal-entry)

(add-hook 'occur-mode-find-occurrence-hook #'pdc-recenter)
(add-hook 'occur-mode-find-occurrence-hook #'pulse-line)

Some modes are less confusing if the current line is always highlighted though.

(use-feature hl-line-mode
  :hook
  ((occur-mode dired-mode package-menu-mode) . hl-line-mode))

Smart Parentheses

Like paredit but for more modes…

(use-package smartparens
  :diminish
  :hook
  (((org-mode css-mode python-mode) . smartparens-mode)
   (minibuffer-setup . turn-on-smartparens-strict-mode)
   (emacs-startup . show-smartparens-global-mode))
  :config
  (require 'smartparens-config)

  (sp-with-modes '(minibuffer-inactive-mode minibuffer-mode)
    (sp-local-pair "'" nil :actions nil)
    (sp-local-pair "(" nil :wrap "C-c ("))

  (sp-with-modes 'org-mode
    (sp-local-pair "=" "=" :wrap "C-c =")
    (sp-local-pair "/" "/" :wrap "C-c /")
    (sp-local-pair "~" "~" :wrap "C-c ~"))

  (sp-with-modes 'web-mode
    (sp-local-pair "{{#if" "{//if}")
    (sp-local-pair "{{#unless" "{//unless"))

  (sp-with-modes '(tex-mode plain-tex-mode latex-mode)
    (sp-local-tag "i" "\"<" "\">"))
  (let ((sp-paredit-bindings
         (-reject (-compose
                   (-partial #'string-match-p "^\\(?:C-\\)?[CM]-<")
                   #'car)
                  sp-paredit-bindings)))
    (sp-use-paredit-bindings)))

Multi-cursors

“Yeah, yeah,” the purists will tell you, “Emacs isn’t really set up to handle multiple cursors efficiently, you’re better using keyboard macros!” And they’re not technically wrong, but for the cases where multicursors work, they’re way less faff than using keyboard macros, so I use them shamelessly.

I’m experimenting with mc/mark-more-like-this-extended and other mark-more stuff

(use-package multiple-cursors
  :after transient
  :bind
  (:prefix "M-m m"
           :prefix-map pdc-multi-map
           :prefix-docstring "multi"
           ("a" . mc/edit-beginnings-of-lines)
           ("e" . mc/edit-ends-of-lines)
           ("^" . mc/edit-beginnings-of-lines)
           ("$" . mc/edit-ends-of-lines)
           ("m" . mc/edit-lines)
           ("C-o" . mc/mark-more-tmenu))
  (:map
   mc/keymap
   ("RET" . multiple-cursors-mode))

  :init
  (transient-define-suffix tsc-suffix-print-args (the-prefix-arg)
    "Report the PREFIX-ARG, prefix's scope, and infix values."
    ;; :transient 'transient--do-call
    (interactive "P")
    (let* ((args (transient-args (oref transient-current-prefix command)))
           (scope (oref transient-current-prefix scope))
           (marking-mode (or (transient-arg-value "--mode=" args)
                             (if (region-active-p) "region" "word"))))
      (message "prefix-arg: %s \nprefix's scope value: %s \ntransient-args: %s\nmarking-mode: %s"
               the-prefix-arg scope args marking-mode)))

  (transient-define-argument mc/mode-select ()
    "Select the multi marking mode"
    :class 'transient-switches
    :argument-format "--by-%s"
    :argument-regexp "\\(--by-\\(word\\|symbol\\|line\\|region\\)"
    :choices '("word" "symbol" "line" "region"))

  (defun +mc--default-marking-mode ()
    (if (region-active-p) "region" "line"))

  (defvar +mc--marking-functions
    '((forward . ((word   . mc/mark-next-like-this-word)
                  (symbol . mc/mark-next-like-this-symbol)
                  (line   . mc/mark-next-lines)
                  (region . mc/mark-next-like-this)))
      (backward . ((word   . mc/mark-previous-like-this-word)
                   (symbol . mc/mark-previous-like-this-symbol)
                   (line   . mc/mark-previous-lines)
                   (region . mc/mark-previous-like-this)))))

  (defun +mc/mark-according-to-mode (direction)
    (let* ((args (transient-args (oref transient-current-prefix command)))
           (mode (intern (or (transient-arg-value "--mode=" args)
                             (+mc--default-marking-mode))))
           (fn (alist-get mode (alist-get direction +mc--marking-functions))))
      (funcall fn 1)))

  (defun +mc/mark-more-quit-label ()
    (if +mc/marking-direction "quit marking" "quit"))

  (transient-define-suffix +mc/mark-more-quit ()
    :transient nil
    :key "C-g"
    :description "quit"
    (interactive)
    (message "Quitting")
    (deactivate-mark)
    (mc/disable-multiple-cursors-mode)
    (setq +mc/marking-direction nil)
    (transient-quit-all))

  (transient-define-suffix +mc/mark-more-finish ()
    :transient nil
    :key "RET"
    :description "finish marking"

    (interactive)
    (setq +mc/marking-direction nil))


  (defun +mc/mark-more-finish-fn ()
    (interactive)
    (setq +mc/marking-direction nil))


  (transient-define-prefix mc/mark-more-tmenu ()
    :incompatible '(("--mode=word" "--mode=symbol" "--mode=line" "--mode=region"))
    ["Incremental"
     ["Mode"
      ("w" "word" "--mode=word" :transient t)
      ("s" "symbol" "--mode=symbol" :transient t)
      ("l" "line" "--mode=line" :transient t)
      ("r" "region" "--mode=region" :transient t :if region-active-p)]
     ["Mark"
      ("n" "next" +mc/transient-marking--down :transient t)
      ("p" "prev" +mc/transient-marking--up :transient t)
      (">" "next" +mc/transient-marking--down :transient t)
      ("<" "prev" +mc/transient-marking--up :transient t)
      ("{" (lambda () (if (eq +mc/marking-direction 'up) "skip" "remove"))
       +mc/transient-marking--left :transient t)
      ("}" (lambda () (if (eq +mc/marking-direction 'up) "remove" "skip"))
       +mc/transient-marking--right :transient t)]]

    ["Done"
     ("S" "show arguments" tsc-suffix-print-args :transient t)]

    [:class transient-row
            (+mc/mark-more-quit)
            ;; ("RET" "finish" +mc/mark-more-finish-fn)
            (+mc/mark-more-finish)
            ;; ("RET" "finish" (lambda ()
            ;;                   (interactive)
            ;;                   (setq +mc/marking-direction nil)))
            ]


    (interactive)
    (setq +mc/marking-direction nil)
    (transient-setup
     'mc/mark-more-tmenu nil nil
     :value (list (format "--mode=%s" (+mc--default-marking-mode)))))

  (defvar +mc/marking-direction nil)
  ;; (defvar +mc/marking-mode 'region)

  (defun +mc/transient-marking--up (&rest _)
    (interactive)
    (+mc/mark-according-to-mode 'backward)
    (setq +mc/marking-direction 'up))

  (defun +mc/transient-marking--down (&rest _)
    (interactive)
    (+mc/mark-according-to-mode 'forward)
    (setq +mc/marking-direction 'down))

  (defun +mc/transient-marking--left (&rest _)
    (interactive)
    (if (eq +mc/marking-direction 'down)
        (mc/unmark-next-like-this)
      (mc/skip-to-previous-like-this)))

  (defun +mc/transient-marking--right (&rest _)
    (interactive)
    (if (eq +mc/marking-direction 'up)
        (mc/unmark-previous-like-this)
      (mc/skip-to-next-like-this)))

  :config
  (dolist (cmd '(+mc/transient-marking--right
                 +mc/transient-marking--left
                 +mc/transient-marking--down
                 +mc/transient-marking--up))
    (add-to-list 'mc/cmds-to-run-once cmd)))

;; (use-package phi-search)
;; (use-package phi-search-mc :config (phi-search-mc/setup-keys))
(use-package mc-extras
  :bind
  (:map
   mc/keymap
   ("M-m m =" . mc/compare-chars)
   ("M-m m ." . mc/move-to-column)))


Fill/unfill long lines

The unfill package lets me toggle between filled and unfilled variants of a line/para.

(use-package unfill
  :bind ([remap fill-paragraph] . unfill-toggle))

Recent files

An emacs builtin, we’re just configuring it.

(use-feature recentf
  :hook
  after-init
  (find-file . pdc/recentf-find-file-hook)
  :custom
  (recentf-max-saved-items 1000)
  (recentf-auto-cleanup 'never)
  (recentf-auto-save-timer (run-with-idle-timer 600 t 'recentf-save-list))
  (recentf-max-menu-items 25)
  (recentf-save-file-modes nil)
  (recentf-auto-cleanup nil)
  :init
  (defun pdc/recentf-find-file-hook ()
    (unless recentf-mode
      (recentf-mode)
      (recentf-track-opened-file)))
  :config
  (add-to-list 'recentf-exclude no-littering-etc-directory)
  (add-to-list 'recentf-exclude (expand-file-name package-user-dir))
  (add-to-list 'recentf-exclude "COMMIT_EDITMSG\\'"))

Undo

Let’s try vundo for a bit

(use-package vundo
  :bind
  ("M-m a u" . vundo)
  :custom
  (vundo-compact-display t)
  (vundo-window-max-height 8)
  (vundo-glyph-alist vundo-unicode-symbols))

Snippets

(use-package yasnippet
  :demand t
  :mode ("~/.config.*/snippets/" . snippet-mode)
  :commands yas-hippie-try-expand
  :bind (:map
         yas-minor-mode-map
         ("\t" . hippie-expand))
  :hook
  (emacs-startup . yas-global-mode)
  :diminish yas-minor-mode
  :init
  (with-eval-after-load 'hippie-expand
    (add-hook 'hippie-expand-try-functions-list 'yas-hippie-try-expand))
  :custom
  (yas-key-syntaxes '("w_" "w_." "^ "))
  (yas-expand-only-for-last-commands nil)
  (yas-triggers-in-field t)
  (yas-wrap-around-region t)
  (yas-prompt-functions '(yas-completing-prompt))
  :init
  (defvar pdc-snippet-dirs (seq-filter 'file-directory-p
                                       (list (expand-file-name "snippets/" user-emacs-directory)
                                             (expand-file-name "~/.config/snippets"))))

  (setq yas-snippet-dirs pdc-snippet-dirs))

(use-package yasnippet-snippets :after yasnippet)

(use-package consult-yasnippet :after (consult yasnippet)
  :bind
  (("M-g y" . consult-yasnippet)
   :map yas-minor-mode-map))

Treesitter

Load up treesitter support and turn on treesit-auto-install-grammar

(use-package treesit-auto
  :demand t
  :custom
  ((treesit-auto-install t)
   (treesit-auto-langs
    '( bash c clojure commonlisp cpp css dart
       dockerfile go gomod html javascript json
       latex lua org perl python r ruby rust
       sql toml tsx typescript typst yaml)))
  :config
  (global-treesit-auto-mode))

Markdown

(use-package markdown-mode
  :mode (("README\\.md\\'" . gfm-mode)
         ("\\.\\(?:md\\|markdown\\|mkdn?\\|mdo?wn\\)\\'" . markdown-mode))
  :preface
  :custom
  (markdown-command "multimarkdown | pandoc"))

Configuration Languages

YAML

YAML Ain’t Markup Language, but it is almost as ubiquitous as CSV, so let’s load it up here.

(use-feature yaml-mode
  :mode "\\.ya?ml\\'")

TOML

I can’t say I love toml, but Hugo uses it by default, so let’s add toml-mode

(use-package toml-mode
  :mode "\\.toml\\'")

CSV Mode

Let emacs guess and set the separator for csv files.

(use-package csv-mode
  :hook (csv-mode . csv-guess-set-separator)
  :mode ("\\.csv\\'" . csv-mode))

The amazing emacs calculator

calc and casual-calc are rather fine.

(use-feature calc)


(use-package casual
  :bind (:map
         calc-mode-map ("C-o" . 'casual-calc-tmenu)
         :map
         calc-alg-map ("C-o" . 'casual-calc-tmenu))
  :after (calc))

Delete selected text on text insertion

Lifted from Prot’s snippets.

(use-feature delsel
  :hook (after-init . delete-selection-mode))

Sudo Edit

Yeah, sometimes I want to edit /etc/whatever and I don’t want to have to leave Emacs to do so. So let’s try sudo-edit

(use-package sudo-edit)

Movement

Borrowed from Charles Choi’s blog where he tweaks forward-sexp to jump to the beginning of the next sexp, rather than the end of the current one. Seems very sensible.

(use-package emacs
  :bind ([remap forward-sexp] . pdc/next-sexp)
  :init

  (defun pdc/--next-sexp-raw ()
    "Raw implementation to move point to the beginning of the next sexp.
This has no error checking."
    (require 'paredit)
    (cond (paredit-mode (paredit-forward 2)
                        (paredit-backward))
          (t (forward-sexp 2)
             (backward-sexp))))

  (defun pdc/next-sexp ()
    "Move point to the beginning of the next balanced expression (sexp)."
    (interactive)
    (condition-case nil
        (pdc/--next-sexp-raw)
      (error (condition-case nil
                 (if paredit-mode (paredit-forward) (forward-sexp))
               (error
                (message
                 "Unable to move point to next balanced expression (sexp)."))))))

  ;; (with-eval-after-load 'paredit
  ;;   (bind-keys :map paredit-mode-map
  ;;              ([remap paredit-forward] . pdc/next-sexp)))
  )

Completion stuff

Like everyone else and their sibling, I use orderless, corfu, consult, embark, marginalia and vertico as the current fleet of completion related packages that work, when I configure them right.

History is important

I like to save the history of the mini-buffer

(use-package savehist
  :hook (emacs-startup . savehist-mode)
  :custom
  (savehist-file (no-littering-expand-var-file-name "savehist"))
  (history-length 100)
  (history-delete-duplicates t)
  (savehist-save-minibuffer-history t)
  (savehist-save-minibuffer-history t "Save minibuffer history")
  (savehist-additional-variables '(kill-ring
                                   search-ring
                                   regexp-search-ring
                                   register-alist)
                                 "Save more histories"))

And remembering the state of the *scratch* buffer is handy too.

(use-package persistent-scratch
  :init (persistent-scratch-setup-default))

Dynamic abbreviation

We use the in-built dabbrev package. It doesn’t need much configuration, but it doesn’t hurt to do some.

(use-feature dabbrev
  :commands (dabbrev-expand dabbrev-completion)
  :custom
  (dabbrev-abbrev-char-regexp "\\sw\\|\\s_")
  (dabbrev-abbrev-skip-leading-regexp "[$*/=~']")
  (dabbrev-backward-only nil)
  (dabbrev-case-distinction 'case-replace)
  (dabbrev-check-other-buffers t)
  (dabbrev-eliminate-newlines t)
  (dabbrev-upcase-means-case-search t)
  (dabbrev-ignored-buffer-modes
   '(archive-mode image-mode doc-view-mode pdf-view-mode tags-table-mode)))

Abbreviations

(use-package emacs
  :bind ( ("M-/" . 'hippie-expand))
  :custom
  (hippie-expand-try-functions-list
   '(yas-hippie-try-expand
     try-expand-all-abbrevs
     try-complete-file-name-partially
     try-complete-file-name
     try-expand-dabbrev
     try-expand-dabbrev-from-kill
     try-expand-dabbrev-all-buffers
     try-expand-list
     try-expand-line
     try-complete-lisp-symbol-partially
     try-complete-lisp-symbol))
  :config
  (remove-hook 'save-some-buffers-functions 'abbrev--possibly-save))

(use-feature abbrev
  :diminish
  :hook emacs-startup)

Minibuffer

Let’s set up the minibuffer to play nicely with the completion frameworks we’re going to use.

(use-feature minibuffer
  :custom
  (completions-format 'one-column)
  (completion-auto-help 'always)
  (completion-auto-select t)
  (completions-detailed t)
  (completion-show-inline-help t)
  (completions-max-height 48)
  (completions-highlight-face 'completions-highlight)
  (minibuffer-completion-auto-choose t)
  (completion-styles '(orderless))
  (completion-category-defaults nil)
  (completion-category-overrides
   '((file (styles . (orderless)))
     (command (styles . (orderless)))
     (bookmark (styles . (orderless)))
     (library (styles . (orderless)))
     (embark-keybinding (styles . (orderless)))
     (imenu (styles . (orderless)))
     (consult-location (styles . (orderless)))
     (kill-ring (styles . (emacs22 orderless)))
     (eglot (styles . (emacs22 orderless))))))

Editing the minibuffer

Sometimes, it’s nice to edit the contents of the mini-buffer in a full buffer. So I’ll add the miniedit package. This binds C-M-e within a minibuffer to throw the content into a temporary buffer for editing

(use-package miniedit
  :commands minibuffer-edit
  :init (miniedit-install))

Corfu

The perfect in-buffer pop-up completion system doesn’t exist. Or, at least, I’ve yet to find it. corfu in conjunction with vertico etc is about as good as I’ve found.

(use-package corfu
  :after savehist
  :custom
  ;; Works with `indent-for-tab-command'. Make sure tab doesn't indent when you
  ;; want to perform completion
  (tab-always-indent 'complete)
  (tab-first-completion 'word)

  (completion-cycle-threshold 3)

  (corfu-cycle t)
  (corfu-auto t)
  (corfu-auto-prefix 3)
  (corfu-auto-delay 0.2)
  (corfu-preview-current nil)
  (corfu-quit-at-boundary 'separator)

  (global-corfu-modes '((not org-mode) prog-mode))

  (corfu-preselect nil)

  ;; quarantine
  (corfu-history-mode 1)
  (corfu-popupinfo-delay '(1.25 . 0.5))
  :config
  (add-to-list 'savehist-additional-variables 'corfu-history)

  :hook
  (eshell-history-mode . +eshell-history-mode-setup-completion)
  (lsp-completion-mode . +lsp-mode-setup-completion)
  ;; (after-init . global-corfu-mode)
  ;; (after-init . corfu-popupinfo-mode)

  :bind
  (:map corfu-map
        ("M-SPC"      . corfu-insert-separator)
        ("RET"        . corfu-insert)
        ("M-RET"      . newline-and-indent)
        ("S-<return>" . corfu-insert)
        ("M-m"        . +corfu-move-to-minibuffer)
        ("TAB"        . +pdc/corfu-complete-common-or-next)
        ("<tab>"      . +pdc/corfu-complete-common-or-next))


  :init
  (global-corfu-mode)
  (corfu-popupinfo-mode)
  ;; TODO: Write a function to attach to tab that first completes a common prefix and, on second hit, inserts the current selection

  (defun +pdc/corfu-complete-common-or-next ()
    "Complete common prefix or go to next candidate."
    (interactive)
    (if (= corfu--total 1)
        (progn
          (corfu--goto 1)
          (corfu-insert))
      (let* ((input (car corfu--input))
             (str (if (thing-at-point 'filename) (file-name-nondirectory input) input))
             (pt (length str))
             (common (try-completion str corfu--candidates)))
        (if (and (> pt 0)
                 (stringp common)
                 (not (string= str common)))
            (insert (substring common pt))
          (corfu-next)))))

  (defun +pdc/corfu-insert ()
    "Insert current candidate or newline."
    (interactive))

  (defun +corfu-move-to-minibuffer ()
    (interactive)
    (let (completion-cycle-threshold completion-cycling)
      (apply #'consult-completion-in-region completion-in-region--data)))

  (defun +lsp-mode-setup-completion ()
    (setf (alist-get 'styles (alist-get 'lsp-capf completion-category-defaults))
          '(orderless)))

  (defun +eshell-history-mode-setup-completion ()
    (setq-local corfu-quit-at-boundary t
                corfu-quit-no-match t
                corfu-auto nil)
    (corfu-mode t)))

(use-package corfu-terminal
  :if
  (not window-system)
  :init
  (corfu-terminal-mode t))

As well as corfu, cape does some good stuff with completion-at-point.

(use-package cape
  :preface
  (bind-keys :prefix "M-m ."
             :prefix-map pdc-completion-at-point-map
             :prefix-docstring "completion…")
  :bind (:map
         pdc-completion-at-point-map
         ("p"  . completion-at-point)
         ("t"  . complete-tag)
         ("d"  . cape-dabbrev)
         ("h"  . cape-history)
         ("f"  . cape-file)
         ("k"  . cape-keyword)
         ("s"  . cape-symbol)
         ("a"  . cape-abbrev)
         ("l"  . cape-line)
         ("w"  . cape-dict)
         ("\\" . cape-tex)
         ("_"  . cape-tex)
         ("^"  . cape-tex)
         ("&"  . cape-sgml)
         ("r"  . cape-rfc1345))
  :init
  (add-to-list 'completion-at-point-functions #'cape-dabbrev)
  (add-to-list 'completion-at-point-functions #'cape-abbrev)
  (add-to-list 'completion-at-point-functions #'cape-file)
  (add-to-list 'completion-at-point-functions #'cape-elisp-block)
  (add-to-list 'completion-at-point-functions #'cape-history)
  (add-to-list 'completion-at-point-functions #'cape-keyword)
  (add-to-list 'completion-at-point-functions #'cape-tex))

Consult

The consult package provides a way to search, filter, preview and select entries based on lists provided by completion-at-point. I’ve also added

  • consult-yasnippet to help expand yasnippet
(use-package consult
  :hook (completion-list-mode . consult-preview-at-point-mode)
  :custom
  (register-preview-delay 0.5)
  (register-preview-function #'consult-register-format)
  (consult-line-numbers widen t)
  (consult-async-min-input 3)
  (consult-async-input-debounce 0.5)
  (consult-async-input-throttle 0.8)
  (consult-narrow-key "<")
  (consult-preview-key 'any)

  :init
  (advice-add #'register-preview :override #'consult-register-window)

  (with-eval-after-load 'xref
    (setq xref-show-xrefs-function #'consult-xref
          xref-show-definitions-function #'consult-xref))

  :config
  (bind-keys ([remap isearch-forward] . consult-line)
             ([remap Info-search]        . consult-info)
             ([remap imenu]              . consult-imenu)
             ([remap recentf-open-files] . consult-recent-file)

             ("C-x M-:" . consult-complex-command)
             ("C-x b"   . consult-buffer)
             ("C-x 4 b" . consult-buffer-other-window)
             ("C-x 5 b" . consult-buffer-other-frame)
             ("C-x r b" . consult-bookmark)
             ("C-x p b" . consult-project-buffer)
             ("M-#"     . consult-register-load)
             ("M-'"     . consult-register-store)
             ("C-M-#"   . consult-register)
             ("M-y"     . consult-yank-pop)
             :map isearch-mode-map
             ("M-e" . consult-isearch-history)
             ("M-s e" . consult-isearch-history)
             ("M-s l" . consult-line)
             ("M-s L" . consult-line-multi)
             :map minibuffer-local-map
             ("C-s" ("insert-current-symbol" . (lambda ()
                                                 "Insert the current symbol"
                                                 (interactive)
                                                 (insert (save-excursion
                                                           (set-buffer (window-buffer (minibuffer-selected-window)))
                                                           (or (thing-at-point 'symbol t) ""))))))
             ("M-s" . consult-history)
             ("M-r" . consult-history)
             :map search-map
             ("d" . consult-find)
             ("D" . consult-locate)
             ("g" . consult-grep)
             ("G" . consult-git-grep)
             ("r" . consult-ripgrep)
             ("l" . consult-line)
             ("L" . consult-line-multi)
             ("k" . consult-keep-lines)
             ("u" . consult-focus-lines)
             ("e" . consult-isearch-history))
  (consult-customize
   consult-goto-line
   consult-theme :preview-key '(:debounce 0.4 any))
  :demand t)

Embark

The embark package is analogous to the right click menu, but rather more… more.

(use-feature xref)

(use-package embark
  :after xref
  :bind
  (("C-." . embark-act)
   ("M-." . embark-act)
   ("M-," . embark-dwim)
   ("C-;" . embark-dwim)
   ("M-m ." . embark-act)
   ("M-m ;" . embark-dwim)
   (([remap describe-bindings] . embark-bindings))
   ("C-h B" . embark-bindings)
   :map embark-file-map
   ("V" . view-file))
  :custom
  (embark-cycle-key "M-.")
  (prefix-help-command #'embark-prefix-help-command)
  (embark-confirm-act-all nil)
  (embark-mixed-indicator-both nil)
  (embark-mixed-indicator-delay nil)
  (embark-indicators '(embark-mixed-indicator embark-highlight-indicator))
  (embark-verbose-indicator-nested nil)
  (embark-verbose-indicator-buffer-sections '(bindings))
  (embark-verbose-indicator-excluded-actions '(embark-cycle embark-act-all embark-collect embark-export embark-insert)))


(use-package embark-consult
  :after consult
  :hook
  (embark-collect-mode . consult-preview-at-point-mode))

Vertico

Using vertico and orderless together makes for a rather pleasant experience.

(use-package vertico
  :after consult
  :custom
  (vertico-cycle t)
  (vertico-scroll-margin 0)
  (vertico-count 5)
  (vertico-resize t)
  (vertico-multiform-mode 1)
  (vertico-multiform-commands
   '((consult-recent-file buffer)
     (consult-mode-command buffer)
     (consult-complex-command buffer)
     (embark-bindings buffer)
     (consult-locate buffer)
     (consult-project-buffer buffer)
     (consult-ripgrep buffer)
     (consult-fd buffer)))
  (vertico-multiform-categories '((buffer flat (vertico-cycle . t))))
  :hook
  (after-init . vertico-mode)
  :bind
  (:map vertico-map
        :prefix "M-,"
        :prefix-map vertico-options-map
        ("r" . vertico-reverse-mode)
        ("g" . vertico-grid-mode))
  (:map vertico-map
        ("M-q"        . vertico-quick-insert)
        ("C-q"        . vertico-quick-exit)
        ("C-k"        . kill-whole-line)
        ("C-u"        . kill-whole-line)
        ("C-o"        . vertico-next-group)
        ("<tab>"      . vertico-insert)
        ("TAB"        . vertico-insert)
        ("M-<return>" . minibuffer-force-complete)))

(use-package emacs
  :init
  (setq minibuffer-prompt-properties
        '(read-only t cursor-intangible t face minibuffer-prompt))
  (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
  (setq enable-recursive-minibuffers t))

(use-feature vertico-directory
  :after vertico
  :bind
  (:map vertico-map
        ("RET" . vertico-directory-enter)
        ("DEL" . vertico-directory-delete-char)
        ("M-DEL" . vertico-directory-delete-word))
  :hook
  (rfn-eshadow-update-overlay . vertico-directory-tid))

Orderless

Completing the group, we have orderless a pattern matching package for parsing user input and turning it into patterns that match against completing-read. I usually just require it and leave it alone, but I’m trying out some fancy stuff from https://github.com/minad/wiki#minads-orderless-configuration because, why not?

(use-package orderless
  :commands (orderless-define-completion-style)
  :after minibuffer
  :init
  (defun +orderless--consult-suffix ()
    "Regexp which matches the end of string with Consult tofu support."
    (if (and (boundp 'consult--tofu-char) (boundp 'consult--tofu-range))
        (format "[%c-%c]*$"
                consult--tofu-char
                (+ consult--tofu-char consult--tofu-range -1))
      "$"))

  (defun +orderless-consult-dispatch (word _index _total)
    (cond
     ((string-suffix-p "$" word)
      `(orderless-regexp . ,(concat (substring word 0 -1) (+orderless--consult-suffix))))
     ((and (or minibuffer-completing-file-name
               (derived-mode-p 'eshell-mode))
           (string-match-p "\\`\\.." word))
      `(orderless-regexp . ,(concat "\\." (substring word 1) (+orderless--consult-suffix))))))

  (orderless-define-completion-style +orderless-with-initialism
    (orderless-matching-styles
     '(orderless-initialism orderless-literal orderless-regexp)))

  (orderless-define-completion-style +orderless-without-initialism
    (orderless-matching-styles
     '(orderless-literal orderless-regexp)))

  :custom
  hd
  (completion-styles '(orderless basic))
  (completion-category-defaults nil)
  (orderless-component-separator #'orderless-escapable-split-on-space)
  (orderless-style-dispatchers (list #'+orderless-consult-dispatch
                                     #'orderless-affix-dispatch))

  :config
  (dolist
      (kv '((file (styles +orderless-with-initialism))
            (command (styles +orderless-with-initialism))
            (variable (styles +orderless-with-initialism))
            (symbol (styles +orderless-with-initialism))))
    (setf  (alist-get (car kv) completion-category-overrides)
           (cdr kv)))

  :bind (:map minibuffer-local-completion-map
              ("SPC" . nil)
              ("?" . nil)))

Marginalia

This annotates completion targets rather nicely. Mostly, it just works.

(use-package marginalia
  :commands marginalia-mode
  :hook (emacs-startup . marginalia-mode)
  :bind (("M-A" . marginalia-cycle)
         :map minibuffer-local-map
         ("M-A" . marginalia-cycle)
         ("C-M-a" . marginalia-cycle)))

(use-package nerd-icons-completion
  :after marginalia
  :hook
  (emacs-startup . nerd-icons-completion-mode)
  (marginalia-mode . nerd-icons-completion-marginalia-setup))

Shells and such

Setup our environment based on the shell

A few mods:

(use-package exec-path-from-shell
  :config
  (exec-path-from-shell-initialize))

Use direnv for per directory environment modules

(use-package envrc
  :commands envrc-global-mode
  :init
  (envrc-global-mode))

Configure eshell

(use-feature eshell
  :custom
  (eshell-where-to-jump 'begin)
  (eshell-review-quick-commands nil)
  (eshell-smart-space-goes-to-end t))

(use-package dwim-shell-command
  :after dired
  :bind (([remap shell-command] . dwim-shell-command)
         :map dired-mode-map
         ([remap dired-do-async-shell-command] . dwim-shell-command)
         ([remap dired-do-shell-command]       . dwim-shell-command)
         ([remap dired-smart-shell-command]    . dwim-shell-command))
  :custom (dired-dwim-target t))

Writing

Visual fill column

In writing modes, I like the way visual-fill-column-mode handles things, centring the text block in the window.

(use-package visual-fill-column
  :defer nil
  :hook
  ((text-mode org-mode) . visual-fill-column-mode)
  :custom
  (visual-fill-column-enable-sensible-window-split t)
  (visual-fill-column-center-text t))

Writing aids

Make life easier when writing plain-ish text in Emacs.

Spell checking

Trying out jinx from https://gihub.com/minad/jinx, enabling globally.

(use-package jinx
  :hook (emacs-startup . global-jinx-mode)
  :bind (("M-$" . jinx-correct)
         ("C-M-$" . jinx-languages))
  :custom (jinx-languages "en_GB")
  :diminish " 🅙"
  :config
  (defun +jinx--add-to-abbrev (overlay word)
    "Add abbreviation to `global-abbrev-table`.
The misspelled word is taken from OVERLAY. WORD is the corrected word."
    (let ((abbrev (buffer-substring-no-properties
                   (overlay-start overlay)
                   (overlay-end overlay))))
      (message "Abbrev: %s -> %s" abbrev word)
      (define-abbrev global-abbrev-table abbrev word)))
  (advice-add 'jinx--correct-replace :before #'+jinx--add-to-abbrev))
Single key binding to add a word to our jinx dictionary

I bet it’s a solved problem, to DDG I go! Eventually.

Grammar

Not sure how I feel about emacs suggesting improvements on my grammar, but let’s give writegood-mode a go.

The default writegood-mode highlighting faces are horrid, so we need to fix them at some point. Thankfully, the modus-vivendi theme addresses that. Huzzah.

(use-package writegood-mode
  :diminish
  :bind ("M-m W" . writegood-mode)
  :hook
  (text-mode . writegood-mode)
  ((view-mode emacs-news-view-mode) . (lambda () (writegood-mode nil)))
  :config
  (setq writegood-weasel-words
        (seq-uniq (append writegood-weasel-words
                          '("one of the"
                            "sort of" "a lot" "probably"
                            "maybe" "perhaps" "I think"
                            "really" "pretty" "nice"
                            "action" "utilize" "leverage"))))
  (writegood-weasels-turn-on)
  (writegood-passive-voice-turn-off)
  (writegood-duplicates-turn-on))

Distraction free writing

Let’s try writeroom mode. If it turns out to be crap, there’s also darkroom and olivetti that purport to do similar things.

(use-package writeroom-mode
  :bind (:map writeroom-mode-map
              ("<C-M-left>" . writeroom-decrease-width)
              ("<C-M-right>" . writeroom-increase-width)
              ("C-M-=" . writeroom-adjust-width)
              ("M-m , [" . writeroom-decrease-width)
              ("M-m , ]" . writeroom-increase-width)
              ("M-m , =" . writeroom-adjust-width))
  :custom
  (writeroom-mode-line '(" " global-mode-string))
  (writeroom-local-effects '(display-time-mode))
  :config
  (advice-add 'text-scale-adjust :after 'visual-fill-column-adjust))

Thesaurus

emacs-powerthesaurus is a plugin to integrate Emacs with the powerthesaurus.org service. Not sure I’ll actually use this, but why not try it?

(use-package powerthesaurus)

Search and destroy^Wreplace

Sometimes it’s useful to have multiple interfaces to a thing because we have multiple states of mind. Sorry… I have multiple states of mind. We already have consult-ripgrep in place, but let’s try deadgrep too

(use-package deadgrep
  :bind (("M-s R" . deadgrep)))

Org Mode

It’s almost reached the point where it’s not really an Emacs configuration if it doesn’t include org-mode, especially if it’s a literate configuration, so let’s get it loaded up. We use use-package here rather than use-feature to hopefully fetch the most recent version. This may be a mistake :)

Loading Org itself

Let’s get org-mode and org-contrib loaded first, then we can style it out with supporting packages.

(use-package org
  :mode ("\\.txt$" . org-mode)
  :diminish org-src-mode
  :bind-keymap
  :bind
  (:map org-mode-map
        ("C-M-<return>"   . org-insert-subheading)
        ("C-c M-<return>" . org-insert-subheading)
        ("C-c M-RET"      . org-insert-subheading)
        ("C-M-i"          . completion-at-point)
        ("C-M-w"          . append-next-kill)
        ("M-m , v"        . org-show-todo-tree)
        ("M-m , r"        . org-refile)
        ("M-m , R"        . org-reveal))

  :preface
  <<org-preface>>
  :init
  (bind-keys :prefix "M-m o"
             :prefix-map pdc-org-prefix
             :prefix-docstring "org"
             ("c" . org-capture)
             ("A" . org-agenda)
             ("l" . org-store-link)
             ("L" . org-insert-link-global)
             ("O" . org-open-at-point-global))

  (defun my-adjoin-to-list-or-symbol (element list-or-symbol)
    (let ((list (if (not (listp list-or-symbol))
                    (list list-or-symbol)
                  list-or-symbol)))
      (require 'cl-lib)
      (cl-adjoin element list)))
  (defvar org-directory "~/Documents/org")

  (defvar pdc/org-inbox-file
    (+org-file-path "inbox.org"))

  <<org-init>>
  :custom
  (prettify-symbols-alist
   '(("#+BEGIN_SRC" . "»")
     ("#+END_SRC" . "«")
     ("#+begin_src" . "»")
     ("#+end_src" . "«")))
  (prettify-symbols-unprettify-at-point 'right-edge)
  (org-auto-align-tags nil)
  (org-tags-column 0)
  (org-fold-catch-invisible-edits 'smart)
  (org-special-ctrl-a/e t)
  (org-insert-heading-respect-content t)
  (org-hide-emphasis-markers (display-graphic-p))
  (org-pretty-entities t)
  ;; I use … a lot myself, custom C-x 8 entry included, so let's use
  ;; something different here.
  (org-ellipsis "")
  (org-agenda-block-separator ?—)
  (org-agenda-time-grid
   '((daily today require-timed)
     (800 1000 1200 1400 1600 1800 2000)
     " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄"))
  (org-agenda-current-time-string
   "←⭠ now ───────────────────────────────────────────────")
  (org-agenda-start-with-log-mode t)
  (org-log-done 'time)
  (org-log-into-drawer t)
  (org-pretty-entities t)
  (org-use-sub-superscripts "{}")
  (org-startup-with-inline-images (display-graphic-p))
  (org-image-actual-width '(300))
  (org-structure-template-alist
   (append '(("c" . "center")
             ("C" . "comment")
             ("e" . "example")
             ("q" . "quote")
             ("E" . "export")
             ("h" . "export html")
             ("a" . "export ascii")
             ("M" . "export markdown")
             ("m" . "markdown")
             ("s" . "src")
             ("v" . "verse"))
           '(
             <<org-structure-templates>>)))
  (org-indent-indentation-per-level 2)
  (org-edit-src-content-indentation 0)
  (org-src-preserve-indentation t)
  (org-src-strip-leading-and-trailing-blank-lines t)
  (org-src-tab-acts-natively t)
  (org-footnote-auto-adjust t)
  (org-adapt-indentation nil)
  (org-return-follows-link t)
  (org-special-ctrl-k t)
  (org-use-speed-commands
   (lambda ()
     (and (looking-at org-outline-regexp-bol)
          (not (org-in-src-block-p)))))
  (org-loop-over-headlines-in-active-region t)
  (org-blank-before-new-entry '((heading . t) (plain-list-item . auto)))
  (org-cycle-include-plain-lists nil)
  (org-support-shift-select t)
  ;; From Sacha Chua
  (org-todo-keyword-faces
   (when (fboundp 'modus-themes-get-color-value)
     `(("TODO" . (:foreground ,(modus-themes-get-color-value 'blue-warmer) :weight bold))
       ("DONE" . (:foreground ,(modus-themes-get-color-value 'green-warmer) :weight bold))
       ("WAITING" . (:foreground ,(modus-themes-get-color-value 'red-warmer) :weight bold))
       ("SOMEDAY" . (:foreground ,(modus-themes-get-color-value 'fg-dim) :weight bold)))))
  <<org-custom>>
  :hook
  (org-mode . visual-line-mode)
  (org-mode . prettify-symbols-mode)
  <<org-hook>>
  :config
  (for-gui
    (add-hook 'org-mode-hook 'variable-pitch-mode))

  ;; (dolist (face '(org-code org-block))
  ;;   (set-face-attribute
  ;;    face nil
  ;;    :inherit
  ;;    (my-adjoin-to-list-or-symbol 'fixed-pitch
  ;;                                 (face-attribute face :inherit))))
  (setf (alist-get "cpandoc" org-link-abbrev-alist nil t 'equal)
        "https://metacpan.org/pod/")
  <<org-config>>)

(use-package org-mac-link)
(use-package org-notify)
(use-package org-contrib
  :after (org)
  :custom
  (org-modules '(ol-bbdb
                 ol-bookmark
                 ol-elisp-symbol
                 ol-eshell
                 ol-info
                 ol-man
                 org-annotate-file
                 org-choose
                 org-collector
                 org-expiry
                 org-interactive-query
                 org-mac-iCal
                 org-mac-link
                 org-mouse
                 org-notify
                 org-panel
                 org-protocol
                 org-registry
                 org-screen
                 org-tempo
                 org-toc
                 orgtbl-sqlinsert))
  :config
  (org-load-modules-maybe))

Update appearances

In a GUI
Modernise things a little

In a gui environment, org-modern looks great.

(use-package org-modern
  :after org
  :if (display-graphic-p)
  :straight
  (:host github :repo "minad/org-modern")
  :hook
  (org-mode        . org-modern-mode)
  (org-modern-mode . pdc/maybe-toggle-org-bullets-mode)
  :init
  (let (old-org-bullets-mode)
    (defun pdc/maybe-toggle-org-bullets-mode ()
      (if org-modern-mode
          (when (featurep 'org-bullets)
            (setq old-org-bullets-mode (if (boundp 'org-bullets-mode)
                                           org-bullets-mode nil))
            (org-bullets-mode nil))
        (when (featurep 'org-bullets)
          (org-bullets-mode old-org-bullets-mode)))))
  :config
  (setq org-modern-keyword
        '((t . t)
          ("bibliography" . " ")
          ("cite_export" . "  ")
          ("include" . "")
          ("setupfile" . "")
          ("html_head" . "🅷")
          ("html" . "🅗")
          ("latex_class" . "🄻")
          ("latex_header" . "🅻")
          ("latex" . "🅛")
          ("beamer_theme" . "🄱")
          ("beamer_header" . "🅱")
          ("beamer" . "🅑")
          ("attr_latex" . "🄛")
          ("attr_html" . "🄗")
          ("attr_org" . "")
          ("header" . "")
          ("caption" . "")
          ("name" . "")
          ("results" . "")))
  (setq org-modern-block-name
        '((t . t)
          ("src" "»" "")
          ("example" "»-" "")
          ("quote" "" "")))
  (setq org-modern-fold-stars
        `(,@(when (eq system-type 'gnu/linux)
              '(("" . "")
                ("" . "")))
          ("" . "") ("" . "") ("" . "") ("" . ""))))
Improve table alignment

Apparently valign is great. Let’s give it a go.

(use-package valign
  :if (display-graphic-p)
  :hook org-mode)
In the terminal
… or use Better Bullets in the terminal

Asterisks are boring.

(use-package org-bullets
  :unless (display-graphic-p)
  :hook
  (org-mode . org-bullets-mode))
Generally
Manage inline element markers

When the point isn’t actually inside a pair of inline markers, I don’t want to see them, I just want to see the effect. But when I’m editing text that’s within them, I definitely want to see the bounds. Enter org-appear

(use-package org-appear
  :after org
  :hook org-mode)
Allow dashes in tags
(defun +org-add-dashes-to-tag-regexps ()
  (setq org-complex-heading-regexp
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(\\[#.\\]\\)\\)?"
                "\\(?: +\\(.*?\\)\\)??"
                "\\(?:[ \t]+\\(:[-[:alnum:]_@#%:]+:\\)\\)?"
                "[ \t]*$")
        org-complex-heading-regexp-format
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(\\[#.\\]\\)\\)?"
                "\\(?: +"
                ;; Stats cookies can be stuck to body.
                "\\(?:\\[[0-9%%/]+\\] *\\)*"
                "\\(%s\\)"
                "\\(?: *\\[[0-9%%/]+\\]\\)*"
                "\\)"
                "\\(?:[ \t]+\\(:[-[:alnum:]_@#%%:]+:\\)\\)?"
                "[ \t]*$")
        org-todo-line-tags-regexp
        (concat "^\\(\\*+\\)"
                "\\(?: +" org-todo-regexp "\\)?"
                "\\(?: +\\(.*?\\)\\)??"
                "\\(?:[ \t]+\\(:[-[:alnum:]:_@$%]+:\\)\\)?"
                "[ \t]*$")))

And add a hook

(org-mode . +org-add-dashes-to-tag-regexps)

Rich paste

Make it easier to paste code blocks in org mode with org-rich-yank

(use-package org-rich-yank
  :bind (:map org-mode-map
              ("C-M-y" . org-rich-yank)
              ("M-m M-y" . org-rich-yank))
  :custom
  (org-rich-yank-format-paste '+org-rich-yank-format-paste)
  :init
  (defun +org-rich-yank-format-paste (language contents link)
    "Format LANGUAGE, CONTENTS and LINK as an `org-mode' source block.

Uses lower case block declaration."
    (format "#+begin_src %s\n%s\n#+end_src\n%s"
            language
            (org-rich-yank--trim-nl contents)
            (or link ""))))

Capturing stuff

(use-feature org-capture
  :init
  (defvar pdc/org-basic-task-templates "* TODO %^{Task}
  :PROPERTIES:
  :Effort: %^{effort|1:00|0:05|0:15|0:30|2:00|4:00}
  :END:
  Captured %<%Y-%m-%d %H:%M>
  %?

  %i
  " "Basic task data")
  :config
  (dolist (it
           `(("r" "Inbox note" entry
              (file ,pdc/org-inbox-file)
              "* %?\n:PROPERTIES:\n:created: %U\n:END:\n\n%i\n\n~ %a"
              :prepend t)
             ("t" "Task with annotation" entry
              (file ,pdc/org-inbox-file)
              "* TODO %?\n:PROPERTIES:\n:created: %U\n:END:\n%a\n"
              :prepend t)
             ("i" "Interrupting task" entry
              (file ,pdc/org-inbox-file)
              "* STARTED %^{Task}\n:PROPERTIES:\n:created: %U\n:END:\n%a\n"
              :clock-in :clock-resume
              :prepend t)
             ("T" "Task without annotation" entry
              (file ,pdc/org-inbox-file)
              "* TODO %^{Task}\n:PROPERTIES:\n:created: %U\n:END:\n\n"
              :prepend t)
             ("c" "Contents to current clocked task"
              plain (clock)
              "%i%?"
              :empty-lines 1)
             ("." "Today" entry
              (file ,pdc/org-inbox-file)
              "* TODO %^{Task}\nSCHEDULED: %t\n:PROPERTIES:\n:created: %U\n:END:\n"
              :immediate-finish t)
             ("e" "Errand" entry
              (file ,pdc/org-inbox-file)
              "* TODO %^{Task}  :errands:\n:PROPERTIES:\n:created: %U\n:END:\n"
              :immediate-finish t)
             ("j" "Journal entry" plain
              (file+olp+datetree ,(expand-file-name "journal.org" org-directory))
              "%K - %a\n%i\n%?\n"
              :unnarrowed t)
             <<org-capture-templates>>
             ))
    (add-to-list 'org-capture-templates it t
                 (lambda (a b) (equal (car a) (car b))))))

Corg

Add completion at point support to org with corg

(use-package corg
  :disabled t
  :hook (org-mode . corg-setup)
  :straight (:host github :repo "isamert/corg.el"))

Agenda, scheduling etc with org

Yeah, I’m really going to get on top of this. Still, let’s borrow some setup from https://forgemacs.bharathpalavalli.com/

Set up todo sequences, common keywords, etc
Todo sequences

The fun game of setting up a task status sequence that is simple and expressive enough.

(org-todo-keywords
 '((sequence "TODO(t)"
             "STARTED(s!)"
             "WAITING(w@/!)"
             "SOMEDAY(.)" "BLOCKED(k@/!)" "|" "CANCELLED(c!)" "DONE(d!)")
   (sequence "RESEARCH(r)" "|" "BLOGGED(q!)" "BOOKMARKED(b!)" "ZETTLED(z!)" "COMPLETE(x!)")
   (sequence "TOLEARN(-)" "LEARNING(l!)" "|" "KNOWN(n)")))
Common org tags and hotkeys
(org-tag-alist '(("games" . ?g)
                 ("songs" . ?s)
                 ("writing" . ?w)
                 ("coding" . ?c)
                 ("learning" . ?a)
                 ("reading" . ?r)
                 ("computer" . ?l)
                 ("errands" . ?e)))
Make it easier to mark a task as done from the agenda
  (defun pdc/org-agenda-done (&optional arg)
    "Mark current TODO as done.

With a prefix argument, cancel the task"
    (interactive "P")
    (if arg
        (org-agenda-todo "CANCELLED")
      (org-agenda-todo "DONE")))
  (with-eval-after-load 'org-agenda
    (bind-key "x" 'pdc/org-agenda-done org-agenda-mode-map))
Make it easy to mark a task as done and create a followup task
(defun pdc/org-agenda-mark-done-and-add-followup ()
  "Mark the current TODO as done and add another task to it.
       Creates it at the same level as the previous task, so it's better to use
       this with to-do items than with projects or headings."
  (interactive)
  (org-agenda-todo "DONE")
  (org-agenda-switch-to)
  (org-capture 0 "t"))
(with-eval-after-load 'org-agenda
  (bind-key "F" 'pdc/org-agenda-mark-done-and-add-followup org-agenda-mode-map))
Let’s experiment with time tracking
Settings
(org-expiry-inactive-timestamps t)
(org-clock-idle-time nil)
(org-log-done 'time)
(org-clock-autoclock-resolution nil)
(org-clock-continuously nil)
(org-clock-persist t)
(org-clock-in-switch-to-state "STARTED")
(org-clock-in-resume nil)
(org-show-notification-handler 'message)
(org-clock-report-include-clocking-task t)
(org-clock-into-drawer 1)
… and make use of them
(org-clock-persistence-insinuate)
Task dependencies
(org-enforce-todo-dependencies t)
(org-track-ordered-property-with-tag t)
(org-agenda-dim-blocked-tasks t)
Splitting blocks

It’s often helpful to split an Org Mode block to add more commentary between them. This code is based on https://scripter.co/splitting-an-org-block-in-two/ by way of Sacha Chua’s config.

(defun modi/org-split-block ()
  "Sensibly split the current Org block at point"
  (interactive)
  (if (modi/org-in-any-block-p)
      (save-match-data
        (save-restriction
          (widen)
          (let ((case-fold-search t)
                (at-bol (bolp))
                block-start
                block-end)
            (save-excursion
              (re-search-backward "^\\(?1:[[:blank:]]*#\\+begin_.+?\\)\\(?: .*\\)*$" nil nil 1)
              (setq block-start (match-string-no-properties 0))
              (setq block-end (replace-regexp-in-string
                               "begin_" "end_"
                               (match-string-no-properties 1))))
            (unless at-bol
              (end-of-line 1))
            (insert (concat (if at-bol "" "\n")
                            block-end
                            "\n\n"
                            block-start
                            (if at-bol "\n" "")))
            (beginning-of-line (if at-bol -1 0)))))
    (message "Point is not in an Org block")))
(defalias '+org-demarcate-block #'modi/org-split-block)
(defalias '+org-split-block #'modi/org-split-block)

(defun modi/org-in-any-block-p ()
  "Return non-nil if the point is in any Org block

The Org block can by *any*: src, example, verse, etc., even any
Org Special block.

This function is heavily adapted from `org-between-regexps-p'."
  (save-match-data
    (let ((pos (point))
          (case-fold-search t)
          (block-begin-re "^[[:blank:]]*#\\+begin_\\(?1:.+?\\)\\(?: .*\\)*$")
          (limit-up (save-excursion (outline-previous-heading)))
          (limit-down (save-excursion (outline-next-heading)))
          beg end)
      (save-excursion
        ;; Point is on a block when on BLOCK-BEGIN-RE or if
        ;; BLOCK-BEGIN-RE can be found before it...
        (and (or (org-in-regexp block-begin-re)
                 (re-search-backward block-begin-re limit-up :noerror))
             (setq beg (match-beginning 0))
             ;; ... and BLOCK-END-RE after it...
             (let ((block-end-re (concat "^[[:blank:]]*#\\+end_"
                                         (regexp-quote (match-string-no-properties 1))
                                         "\\( .*\\)*$")))
               (goto-char (match-end 0))
               (re-search-forward block-end-re limit-down :noerror))
             (> (setq end (match-end 0)) pos)
             ;; ... without another BLOCK-BEGIN-RE in-between.
             (goto-char (match-beginning 0))
             (not (re-search-backward block-begin-re (1+ beg) :noerror))
             ;; Return value.
             (cons beg end))))))
Org+Transient = LOVE
(with-eval-after-load 'transient
  (transient-define-prefix pdct/base-org-mode ()
    ["Org Mode"
     ("n" "Next" org-forward-heading-same-level :transient t)
     ("p" "Previous" org-backward-heading-same-level :transient t)
     ("a" "Archive" org-archive-subtree-default :transient t)
     ("k" "Kill" org-cut-subtree :transient t)])
  (transient-define-prefix pdct/org-link ()
    [:class transient-row "Org Link"
            ("RET" "Open" org-open-at-point :transient t)
            ("e" "Edit" org-insert-link :transient t)
            ("u" "< General" pdct/base-org-mode :transient transient--do-replace)])
  (transient-define-prefix pdct/org-src ()
    [ "Org Src"
      [("e" "Exec" org-babel-execute-src-block :transient t)
       ("i" "edIt" org-edit-special :transient t)
       ("d" "Demarcate" org-babel-demarcate-block :transient t)
       ("g" "Goto" org-babel-goto-named-src-block :transient t)
       ("/" "Split" +org-split-block :transient nil)]
      [("r" "Result" org-babel-open-src-block-result :transient t)
       ("x" "eXpand" org-babel-expand-src-block :transient t)
       ("t" "Tangle at point" (lambda ()
                                (interactive)
                                (org-babel-tangle '(4))) :transient t)
       ("T" "Tangle target file" (lambda ()
                                   (interactive)
                                   (org-babel-tangle '(16))) :transient t)]]
    [("u" "< General" pdct/base-org-mode :transient transient--do-replace)])

  (defun pdc/org-dwim ()
    (interactive)
    (if (derived-mode-p 'org-mode)
        (let ((context (org-element-context)))
          (cond
           ((and (bolp) (looking-at org-outline-regexp))
            ;; We don't do anything in this 'speed commands' context. Yet.
            (pdct/base-org-mode))
           ((org-in-src-block-p) (pdct/org-src))
           ((eq (org-element-type context) 'link) (pdct/org-link))
           (t (pdct/base-org-mode))))))

  (keymap-set org-mode-map "M-m , ," #'pdc/org-dwim))

We’re poaching this from Sacha again

Other agenda config stuff
(org-log-done 'time)
(org-agenda-window-setup 'current-window)
(org-agenda-current-time-string "")
(org-agenda-hide-tags-regexp ".*")
(org-agenda-block-separator nil)
(org-agenda-compact-blocks t)
(org-agenda-files  (+org-file-paths "inbox.org"
                                    "DwarfFortress.org"
                                    "blog.org"
                                    "coding.org"
                                    "codex.org"
                                    "isolation-sessions.org"
                                    "lyrics.org"
                                    "scratch.org"
                                    "todo.org"
                                    "house.org"
                                    "~/Sites/bofh.org.uk/org-content/"
                                    "~/Documents/RoamNotes/"))
(org-agenda-span 2)
(org-agenda-tags-column -100)
(org-agenda-sticky nil)
(org-agenda-inhibit-startup t)
(org-agenda-use-tag-inheritance t)
(org-agenda-show-log t)
(org-agenda-skip-scheduled-if-done t)
(org-agenda-skip-deadline-if-done t)
(org-agenda-skip-deadline-prewarning-if-scheduled 'pre-scheduled)
(org-columns-default-format "%14SCHEDULED %Effort:(:) %1PRIORITY %TODO %50ITEM %TAGS")

(org-complete-tags-always-offer-all-agenda-tags t)
(org-use-fast-tag-selection nil)

(org-agenda-prefix-format
 '((agenda . "  %?-2i %t ")
   (todo   . " %i %-12:c")
   (tags   . " %i %-12:c")
   (search . " %i %-12:c")))

Refiling stuff

org-refile lets you organise notes by typing in the headline to file them under.

Add an +org-extra-refile-targets variable as a handy target for directory and file local variables to easily extend the list of refile targets without making the full target list unwieldy.

(defvar +org-extra-refile-targets nil
  "Extra files to consider as refile targets.

The expectation is that this will be overridden by file or directory
local variables to add refile targets that make sense in different contexts, without completely clogging the list.")

If a buffer is open, and it’s in org mode, then it should be a refile target, no? This snippet inspired by Yiming Chen and doctored a bit to use derived-mode-p rather than checking if the file name matches \.org$ seems to fit the bill. It might remove the need for +org-extra-refile-targets.

(defun +org/opened-buffer-files ()
  "Return the list of org files currently opened in emacs."
  (delq nil
        (mapcar (lambda (x)
                  (with-current-buffer x
                    (if (and (buffer-file-name x)
                             (derived-mode-p 'org-mode))
                        (buffer-file-name))))
                (buffer-list))))
(org-reverse-note-order t)
(org-refile-use-outline-path 'file)
(org-outline-path-complete-in-steps nil)
(org-refile-allow-creating-parent-nodes 'confirm)
(org-refile-use-cache nil)
(org-refile-blank-before-new-entry nil)
(org-refile-targets
 `((nil . (:maxlevel . 9))
   (,(+org-file-paths
      "organiser.org"
      "routines.org"
      "reference.org"
      "decisions.org"
      "posts.org"
      "easterley.org"
      "inbox.org"
      "songs.org")
    . (:maxlevel . 9))
   (+org-extra-refile-targets
    . (:maxlevel . 9))))

Helper functions

Finding .org files

We want to be able to find foo.org in any of the directories where org files live and to create in org-directory otherwise. So we’ll set up +org-extra-directories and write +org-file-path which will do that.

(defvar +org-extra-directories '("~/Dropbox/MobileOrg"))

(defun +org-file-path (file)
  "Expand FILE in the correct directory of org files.
If it exists in any of `+org-extra-directories', return that path,
otherwise return a path within `org-directory', whether the file exists or not."
  (require 'dash)
  (if (file-name-absolute-p file)
      file
    (or (-first #'file-exists-p
                (mapcar (lambda (d)
                          (expand-file-name file d))
                        (if (member org-directory +org-extra-directories)
                            +org-extra-directories
                          (cons org-directory +org-extra-directories))))
        (expand-file-name file org-directory))))

(defun +org-file-paths (l-or-f &rest files)
  "Expand files with `+org-file-path'."
  (let ((all-files (if (listp l-or-f)
                       (concat l-or-f (flatten-list files))
                     (cons l-or-f (flatten-list files)))))
    (mapcar #'+org-file-path all-files)))
Jump to Org location by substring
(defun +org-refile-get-location-by-substring (regexp &optional file)
  "Return the refile location identified by REGEXP."
  (let ((org-refile-targets org-refile-targets) tbl)
    (setq org-refile-target-table (org-refile-get-targets)))
  (unless org-refile-target-table
    (user-error "No refile targets"))
  (cl-find regexp org-refile-target-table
           :test
           (lambda (a b)
             (and
              (string-match a (car b))
              (or (null file)
                  (string-match file (elt b 1)))))))

(defun +org-refile-subtree-to (name)
  (org-refile nil nil (+org-refile-get-location-exact name)))

(defun +org-refile-get-location-exact (name &optional file)
  "Return the refile location identified by NAME."
  (let ((org-refile-targets org-refile-targets) tbl)
    (setq org-refile-target-table (org-refile-get-targets)))
  (unless org-refile-target-table
    (user-error "No refile targets"))
  (cl-find name org-refile-target-table
           :test (lambda (a b)
                   (and (string-equal a (car b))
                        (or (null file)
                            (string-match file (elt b 1)))))))

(defun +org-clock-in-refile (location &optional file)
  "Clocks into LOCATION.
LOCATION and FILE can also be regular expressions for `+org-refile-get-location-by-substring'."
  (interactive (list (+org-refile-get-location)))
  (save-window-excursion
    (save-excursion
      (when (stringp location)
        (setq location (+org-refile-get-location-by-substring location file)))
      (org-refile 4 nil location)
      (org-clock-in))))
Moving lines around

Nicked from sachac’s config again.

(defun +org-move-line-to-destionation ()
  "Moves the current list item to DESTINATION in the current buffer.
If no DESTINATIon is found, move it to the end of the list
and indent it one level."
  (interactive)
  (require 's)
  (save-window-excursion
    (save-excursion
      (let ((string
             (buffer-substring-no-properties
              (line-beginning-position) (line-end-position)))
            (case-fold-search nil)
            found)
        (delete-region (line-beginning-position)
                       (1+ (line-end-position)))
        (save-excursion
          (goto-char (point-min))
          (when (re-search-forward "DESTINATION" nil t)
            (insert "\n" (make-string (- (match-beginning 0) (line-beginning-position)) ?\ ) (s-trim string))
            (setq found t)))
        (unless found
          (org-end-of-item-list)
          (insert string "\n"))))))
(defun +org-move-line-to-end-of-list ()
  "Move the current list item to the end of the list."
  (interactive)
  (save-excursion
    (let ((string (buffer-substring-no-properties (line-beginning-position)
                                                  (line-end-position))))
      (delete-region (line-beginning-position) (1+ (line-end-position)))
      (org-end-of-item-list)
      (insert string))))
Inserting code

Sometimes I want to drop an existing defun into an org mode source block. So I’m nicking this from sachac to automate it.

(defun +org-insert-defun (function)
  "Inserts and Org source block with the definition for FUNCTION."
  (interactive (find-function-read))
  (let* ((buffer-point (condition-case nil (find-definition-noselect function nil) (error nil)))
         (new-buf (car buffer-point))
         (new-point (cdr buffer-point))
         definition)
    (if (and buffer-point new-point)
        (with-current-buffer new-buf
          (save-excursion
            (goto-char new-point)
            (setq definition (buffer-substring-no-properties (point)
                                                             (save-excursion (end-of-defun) (point))))))
      (setq definition (concat (prin1-to-string (symbol-function function)) "\n")))
    (if (org-in-src-block-p)
        (insert-definition)
      (insert "#+begin_src emacs-lisp\n"
              definition
              "#+end_src\n"))))

(defun +org-insert-function-and-key (keys)
  (interactive (list (caar (help--read-key-sequence))))
  (insert (format "=%s= (=%s=" (symbol-name (key-binding keys t))
                  (key-description keys))))
Save when emacs loses focus
(defvar pdc/unfocusing nil "None-nil when I'm in the middle of unfocusing.")

(defmacro +org-debounce-idle-timer (seconds var body &rest args)
  `(progn
     (defvar ,var nil "Timer.")
     (when (timerp ,var) (cancel-timer ,var))
     (setq ,var (run-with-idle-timer ,seconds nil ,body ,@args))))

(defun +org-save-all-org-buffers ()
  (unless pdc/unfocusing
    (let ((pdc/unfocusing t))
      (+org-debounce-idle-timer 10
                                pdc/org-save-all-org-buffers-timer
                                'org-save-all-org-buffers))))
(add-function :after after-focus-change-function '+org-save-all-org-buffers)

Contacts

Use org-contacts to manage our contacts

(use-package org-contacts
  :disabled t
  :custom
  (org-contacts-file (+org-file-path "people.org")))

And add a capture template to help acquire them

("@" "Contacts" entry (file ,(+org-file-path "contacts.org"))
    "* %(org-contacts-template-name)
:PROPERTIES:
:EMAIL: %(org-contacts-template-email)
:PHONE:
:ALIAS:
:NICKNAME:
:IGNORE:
:ICON:
:NOTE:
:ADDRESS:
:BIRTHDAY:
:END:")

Org-ql and Super agenda

Not sure if I actually need this, but again, I’m lifting code to get started.

(use-package org-ql)

;; (use-package org-super-agenda
;;   :hook emacs-startup
;;   :custom
;;   (org-super-agenda-groups
;;    '((:name " TODAY"
;;             :deadline today
;;             :date today
;;             :scheduled today
;;             :order 1
;;             :face 'warning)
;;      (:name " Upcoming Deadlines"
;;             :deadline future
;;             :order 2))))

(use-package casual
  :bind (:map
         org-agenda-mode-map
         ("C-o" . casual-agenda-tmenu))
  :after org-agenda)

Org babel

The literate programming and language support that comes with org-babel are why this file exists, so of course I’m going to make use of it. There’s no real need to explicitly use the ob package, but I like to keep my configs wrapped in use-package calls where possible. Call me weird.

This stanza

  • loads a bunch of language support modules, including external modules
    • ob-http
    • ob-raku
    • ob-racket
  • Sets up language based fontification
  • Lowercases the evaluation results block
(use-package ob-http :after org)
(use-package ob-raku :after org)
(use-package ob-racket :after org
  :hook
  (ob-racket-pre-runtime-library-load . ob-racket-raco-make-runtime-library)
  :straight (ob-racket :host github
                       :repo "hasu/emacs-ob-racket"
                       :files ("*.el" "*.rkt")))
(use-package ob-yaml
  :straight
  (:type git :host github :repo "llhotka/ob-yaml")
  :after org
  :config
  (require 'yaml-ts-mode)
  (defalias 'yaml-mode 'yaml-ts-mode))

(use-feature ob-shell
  :after org)
(use-feature ob
  :after org
  :custom
  (org-src-fontify-natively t)
  (org-babel-results-keyword "results")
  (org-babel-default-header-args
   '((:session . "none")
     (:results . "drawer replace")
     (:comments . "both")
     (:exports . "code")
     (:cache . "no")
     (:eval . "never-export")
     (:hlines . "no")
     (:tangle . "no")
     (:noweb . "yes")))
  (org-edit-src-auto-save-idle-delay 5)
  :config
  <<ob-config>>
  (org-babel-do-load-languages
   'org-babel-load-languages
   '((css . t)
     (dot . t)
     (emacs-lisp . t)
     (http . t)
     (org . t)
     (perl . t)
     (haskell . t)
     (shell . t)
     (sql . t)
     (raku . t)
     (racket . t)
     (yaml . t)
     (shell . t)
     <<ob-languages>>
     )))
Source structure templates

Org structure templates are great, so let’s add some more to make language specific #+begin_src blocks

("el" . "src emacs-lisp")
("ent" . "src emacs-lisp :tangle nil")
("ett" . "src emacs-lisp :tangle nil :noweb-ref")
("pl" . "src perl")
("p6" . "src raku")
("sh" . "src sh")
("md" . "src markdown")
("rk" . "src racket")
("hs" . "src haskell")
("sql" . "src sql")
Start editing template content after insertion

This got a little out of hand… Initially, all I wanted to do was to jump straight into org-edit-special after inserting a structural template, but then I added my ett template, which includes an unpopulated :noweb-ref header argument and I would immediately jump out of the edit buffer to sort that out, before jumping back into the editor. But that was unsatisfactory too, because I was freehand typing the noweb reference name and every time I type the name of something without completion help, it’s an opportunity to fuck up.

Which is why we have this now

(defun +org-babel-noweb-refs ()
  "find all the noweb refs in the current buffer"
  (require 's)
  (require 'dash)
  (let ((match-exp (org-babel-noweb-wrap))
        result)
    (org-babel-map-src-blocks nil
      (let ((plain-body (substring-no-properties body)))
        (setq result (-concat
                      result
                      (-map (-partial #'s-replace "(.*)\\'" "")
                            (-map #'second
                                  (s-match-strings-all match-exp plain-body)))))))
    (-sort #'string< result)))

(defvar +org-suppress-insert-structure-template-advice nil)

(defun +org-insert-structure-template/after-advice (&rest _)
  (unless +org-suppress-insert-structure-template-advice
    (when (derived-mode-p 'org-mode)
      (let* ((datum (org-element-context)))
        (save-excursion
          (goto-char (org-element-begin datum))
          (if (re-search-forward "\\(:\\S-+\\)\\(\\s-*\\)$" (pos-eol) t)
              (let* ((arg (match-string-no-properties 1))
                     (value (cond ((string= arg ":noweb-ref")
                                   (completing-read ":noweb-ref: "
                                                    (+org-babel-noweb-refs)
                                                    nil nil))
                                  (t
                                   (read-from-minibuffer (format "Value for `%s': " arg))))))
                (end-of-line)
                (unless (looking-back "\\s-" 1)
                  (insert " "))
                (insert value)))))
      (org-edit-special))))

(advice-add 'tempo-insert-template :after #'+org-insert-structure-template/after-advice)

(advice-add 'org-insert-structure-template :after #'+org-insert-structure-template/after-advice)
JSON stuff

Load up JSON and plumb it into org-mdoe

(use-package json-mode)

(use-package ox-json
  :after ox)

(use-package org-json)

This snippet lets us evaluate blocks of JSON using org-babel, which lets us use JSON data in workflows and such.

(defun org-babel-execute:json (body params)
  (let ((jq (cdr (assoc :jq params)))
        (node (cdr (assoc :node params))))
    (cond
     (jq
      (with-temp-buffer
        ;; Insert the JSON into the temp buffer.
        (insert body)
        ;; Run jq command on the whole buffer, and replace the buffer contents
        ;; with the result returned from jq.
        (shell-command-on-region (point-min) (point-max)
                                 (format "jq -r \"%s\"" jq) nil 't)
        ;; Return the contents of the temp buffer as the result
        (buffer-string)))
     (node
      (with-temp-buffer
        (insert (format "const it = %s;" body))
        (insert node)
        (shell-command-on-region (point-min) (point-max)
                                 "node -p" nil 't)
        (buffer-string))))))
JQ

JQ’s an amazing swiss army knife for manipulating JSON, but I do need to work on actually learning it.

(use-package jq-mode
  :config
  (org-babel-do-load-languages 'org-babel-load-languages
                               '((jq . t))))
Literate Programming stuff
Editing source code

I don’t want to get distracted by the same code in the other window, so have org-src use the current window.

(org-src-window-setup 'current-window)
Copying and sharing code
(use-package gist
  :after org
  :init
  (defun pdc/copy-code-as-org-block-and-gist (beg end)
    (interactive "r")
    (let ((filename (or (file-name-base) ""))
          (mode (symbol-name major-mode))
          (contents
           (if (use-region-p)
               (buffer-substring beg end) (buffer-string)))
          (gist (if (use-region-p) (gist-region beg end) (gist-buffer))))
      (kill-new
       (format "\n%s\n#+begin_src %s\n%s\n#+end_src\n"
               (org-link-make-string (oref (oref gist :data) :html-url) filename)
               (replace-regexp-in-string "-mode%" mode)
               contents)))))

Add auto tangle

It’s really handy to automatically tangle on save for some stuff. Especially this particular file :)

(use-package org-auto-tangle
  :hook org-mode
  :diminish " 🧶")

Exporters

Sometimes, your victim can’t make use of org-mode, so we make use of the ox system.

Export to Github flavoured markdown
(use-package ox-gfm
  :commands (org-gfm-export-as-markdown org-gfm-export-to-markdown)
  :after org)
Presentation in HTML with org-re-reveal

I’m entirely convinced I’ll be doing much presenting in the future, and even less convinced I’ll be doing it directly from org (I tend to make heavy use of Keynote’s “magic move” capabilities when I’m presenting – it’s great for showing how code moves about during refactoring. Fiddly as fuck, but great).

Anyway, for quick stuff, this is almost certainly useful.

See https://gitlab.com/oer/org-re-reveal for more details on this.

(use-package org-re-reveal
  :after org
  :custom
  (org-re-reveal-root "https://cdd.jsdelivr.net/npm/reveal.js")
  (org-re-reveal-revealjs-version "4")
  (org-re-reveal-history t))
(use-package oer-reveal
  :custom
  (oer-reveal-plugin-4-config
   "audioslideshow RevealAudioSlideShow plugin/audio-slideshow/plugin.js
anything RevealAnything https://cdn.jsdelivr.net/npm/reveal.js-plugins@latest/anything/plugin.js"))
Eliminate reveal CDN?

CDN’s are a vulnerability waiting to happen, so I need to look into what needs doing to set up a local reveal installation.

Transclusion

(use-package org-transclusion
  :straight (:host github :repo "nobiot/org-transclusion")
  :after org
  :bind
  (:map org-mode-map
        ("M-m , t" . org-transclusion-add)
        ("M-m , T" . org-transclusion-mode)))

Blogging

I keep a blog at bofh.org.uk and have done for years. These days it’s pretty desultory in terms of posting, but sometimes inspiration Viewing.

Static Site Generation

Org and Hugo, best buddies

These days I write everything in a big org file and export it to Hugo with ox-hugo, so let’s set that up. We add some commands to handle marginnotes and footnotes, and tweak some exports.

(use-package ox-hugo
  :defer nil
  :straight (:type git :host github
                   :repo "kaushalmodi/ox-hugo"
                   :fork (:host github :repo "pdcawley/ox-hugo"))
  :config

  (defun +org-hugo-set-shortcode-props (code &rest props)
    (setf (alist-get code org-hugo-special-block-type-properties)
          props))

  (+org-hugo-set-shortcode-props "newthought" :trim-pre nil :trim-post t)
  (+org-hugo-set-shortcode-props "marginnote" :trim-pre t :trim-post t)

  (defun pdc/wrap-table-in-shortcode (md)
    (if (string-match-p "{{[%<] +table" md)
        md
      (concat "{{% table %}}\n" md "{{% /table %}}")))
  (advice-add 'org-blackfriday-table :filter-return #'pdc/wrap-table-in-shortcode)

  (defun pdc/unfuck-bare-url (url)
    (if (string-match-p "^<.*>$" url)
        (replace-regexp-in-string "^<\\|>$" "" url)
      url))
  (advice-add 'org-hugo-link :filter-return #'pdc/unfuck-bare-url)

  (defun pdc/org-replace-footnote-with-marginnote (ref)
    (let ((fntext (nth 3 (org-footnote-get-definition ref)))
          (x (org-footnote-at-reference-p)))
      (unless (and x (equalp (car x) ref))
        (org-footnote-goto-previous-reference ref))
      (org-footnote-delete ref)
      (pdc/org-marginnote-new)
      (insert fntext)))

  (defun pdc/convert-footnote-to-marginnote (&optional label)
    "Convert the footnote reference at point to a marginnote."
    (interactive)
    (let ((label (cond (label)
                       ((setq x (org-footnote-at-reference-p))
                        (or (car x)
                            (error "We don't currently handle anonymous footnotes. TODO")))
                       ((setq x (org-footnote-at-definition-p))
                        (car x))
                       (t (error "Don't know which footnote to remove.")))))
      (pdc/org-replace-footnote-with-marginnote label)))

  (defun pdc/wrap-in-shortcode (code)
    "Wrap the point/region with a shortcode, `CODE'"
    (let ((string "")
          (startcode (concat "@@hugo:{{%" code " %}}@@"))
          (endcode (concat "@@hugo:{{% /" code " %}}@@"))
          beg end move)
      (if (org-region-active-p)
          (setq beg (region-beginning)
                end (region-end)
                string (buffer-substring beg end))
        (setq move t))
      (setq string (concat startcode string endcode))
      (when beg (delete-region beg end))
      (insert string)
      (when move (backward-sexp))))

  (defun pdc/org-marginnote-new ()
    "Insert a new marginnote."
    (interactive)
    (pdc/wrap-in-shortcode "marginnote"))

  (defun pdc/org-newthought ()
    "Wrap point/region with a newthought shortcode."
    (interactive)
    (pdc/wrap-in-shortcode "newthought"))

  (defun pdc/marginnote-dwim ()
    "Either convert footnote at point to a MN or start a new MN."
    (interactive)
    (if (or (org-footnote-at-definition-p)
            (org-footnote-at-reference-p))
        (save-excursion (pdc/convert-footnote-to-marginnote))
      (pdc/org-marginnote-new)))

  (defun hugo-site-dir (&optional path)
    (let ((search-start (or path
                            (buffer-file-name)
                            default-directory)))
      (or (locate-dominating-file search-start "config.toml")
          (locate-dominating-file search-start "config.yaml"))))

  (defun +ox-hugo-log-export-advice (retval)
    (prog1 retval
      (when (stringp retval)
        (with-temp-buffer
          (insert retval)
          (insert "\n")
          (when-let* ((site-dir (hugo-site-dir retval)))
            (append-to-file (point-min)
                            (point-max)
                            (expand-file-name "./exports" site-dir)))))))

  (advice-add 'org-hugo--export-subtree-to-md :filter-return
              #'+ox-hugo-log-export-advice)
  <<ox-hugo-config>>
  )

Set up some structure templates for blogging

("d" . "description")
("mn" . "marginnote")
Running Hugo in development

Prodigy is a great package for running services without leaving Emacs. We set up a helper function to define hugo services for the different sites we manage. By default, the hugo serve binds to localhost, which is crap when we’re using an iPad to check the site, so we add --bind 0.0.0.0 to our arguments.

First we define a pdc-site-directories-alist which maps between short site names and the directories they live in.

(defvar pdc-site-directories-alist
  '(("bofh" . "~/Sites/bofh.org.uk/")
    ("st" . "~/Sites/singingtogether.co.uk")
    ("pdc" . "~/Sites/pierscawley.co.uk"))
  "The locations of our hugo managed websites.")

And a helper function to access it

(defun pdc/site-dir (site)
  "Get the working directory for a website."
  (cdr (assoc site pdc-site-directories-alist)))

Then set up prodigy from the data.

(use-package prodigy
  :commands (prodigy-define-service)
  :general
  (pdcmacs-leader-def :infix "a" "P" 'prodigy)
  :config
  (defvar pdc-hugo-command "hugo")
  (defvar pdc-hugo-server-args
    `("serve"
      "--buildDrafts"
      "--buildFuture"
      "--disableFastRender"
      "--navigateToChanged"
      "--watch"
      "-M"
      "--environment" "development"
      "--bind" "0.0.0.0"
      "--baseURL" "studio-mini.local"))
  (defun pdc-define-hugo-site (name dir tags &rest args)
    (apply 'prodigy-define-service
           `(:name ,name
                   :command ,pdc-hugo-command
                   :args ,(append pdc-hugo-server-args args)
                   :tags (hugo ,@(-list tags))
                   :cwd ,dir
                   :stop-signal sigkill
                   :kill-process-buffer-on-stop t)))

  (pcase-dolist (`(,name . ,path) pdc-site-directories-alist)
    (pdc-define-hugo-site name path (list (intern name)))))
Hugo Support module

Historically, Hugo stuff is setup in a support module. I’m slowly bringing it into the Literate realm though.

(with-eval-after-load 'ox
  (require 'ox-hugo))
(require 'pdcmacs-hugo-support)
Hugo Introspection

Right now ox-hugo uses a short code to expand links to generated markdown files, but I’d really rather do the lookup in emacs lisp because then it becomes available to emacs. This needs to be available to my site building elisp scripts too, so we’re going to tangle to a separate file which can be required from there.

Here’s the boilerplate.

;;; hugo-query.el --- Find the URL generatd by a markdown source  -*- lexical-binding: t; -*-

;; First saved in 2025 by  Piers Cawley


;; Author: Piers Cawley <pdcawley@Studio-Mini.local>


;;; Commentary:

;; TODO

;;; Code:

<<hugo-query-body>>

(provide 'hugo-query)
;;; hugo-query.el ends here

Load some necessary packages. We’re going to use at least tomlparse to parse config.toml and ox-hugo for some of its utility functions.

(use-package tomlparse
  :autoload (tomlparse-buffer
             tomlparse-file
             tomlparse-string))

(use-package csv
  :defer nil)

(use-package ht)
(use-package s)

(use-package ox-hugo
  :config
  (defun hugo-query--keep-map-updated (&rest _)
    (hugo-query-update-site-map nil t))
  (advice-add 'org-hugo--after-all-exports-function
              :before #'hugo-query--keep-map-updated))

Hmm… Not sure those are actually necessary. Let’s try a few things

(defvar hugo-query-hugo-cmd "hugo")

(defvar hugo-query-site-map nil)

(defun hq--hugo-dir-p (dir)
  "Return non-nil if DIR contains a config file for Hugo."
  (or
   (file-exists-p (expand-file-name "config.toml" dir))
   (file-exists-p (expand-file-name "config.yaml" dir))))

(defun hugo-query-site-dir (&optional path)
  "Return the Hugo site directory that contains PATH."
  (let ((search-start (or path buffer-file-name default-directory)))
    (when-let* ((dir (locate-dominating-file search-start #'hq--hugo-dir-p)))
      (expand-file-name dir))))

(defun hugo-query-update-site-map (&optional dir force?)
  "Update `hugo-query-site-map' for the given DIR."
  (interactive "i\nP")
  (if-let* ((site-dir (hugo-query-site-dir dir)))
      (when (or force?
                (not hugo-query-site-map)
                (not (equal site-dir (gethash :site-dir hugo-query-site-map))))
        (setq hugo-query-site-map (hq--build-site-map site-dir))
        (puthash :site-dir site-dir hugo-query-site-map))
    (message "%s isn't in a Hugo site directory!"
             (or dir buffer-file-name default-directory))))

(defun hugo-query-url-for-source (file)
  (require 'ht)
  (let ((site-dir (hugo-query-site-dir file)))
    (hugo-query-update-site-map file)
    (ht-get* hugo-query-site-map
             (file-relative-name file site-dir)
             "permalink")))

(defun hq--build-site-map (dir)
  (require 'ht)
  (with-temp-buffer
    (call-process hugo-query-hugo-cmd
                  nil t nil
                  "-M"
                  "-s" (expand-file-name dir)
                  "list" "all")
    (goto-char (point-min))
    (when-let* ((result (make-hash-table :test 'equal))
                (mappings (csv-parse-buffer t)))
      (dolist (alist mappings)
        (when-let* ((path (cdr (assoc-string "path" alist)))
                    (hash (ht<-alist alist 'equal))
                    (permalink-url (url-generic-parse-url
                                    (gethash "permalink" hash)))
                    (rel-permalink (car (url-path-and-query permalink-url))))
          (puthash "rel-permalink" rel-permalink hash)
          (puthash path hash result)))
      result)))

(defun +org-hugo--get-article-info ()
  (let* ((org-use-property-inheritance (org-hugo--selective-property-inheritance)))
    (org-combine-plists
     (org-export--get-export-attributes
      'hugo t nil)
     (org-export--get-buffer-attributes)
     (org-export-get-environment 'hugo t))))


(defun +org-hugo-get-article-url ()
  (save-excursion
    (org-hugo--get-valid-subtree)
    (hugo-query-update-site-map)
    (let* ((info (+org-hugo--get-article-info))
           (md-file (org-export-output-file-name
                     ".md" t (org-hugo--get-pub-dir info))))
      (hugo-query-url-for-source md-file))))

(defun hugo-query-site-config (&optional file)
  (let* ((config-file (expand-file-name "config.toml" (hugo-site-dir file))))
    (tomlparse-file config-file)))

(defun hugo-query--fmt-permalink (template heading info)
  (let* ((pub-time (date-to-time
                    (or (org-hugo--format-date :date info)
                        (org-hugo--format-date :hugo-publishdate info))))
         (values-plist
          (list
           :slug (org-hugo--heading-get-slug heading info)
           :section (s-chop-suffix "/" (org-hugo--get-section-path info))
           :title (org-hugo--get-sanitized-title info)
           :filename (org-hugo--get-anchor heading info)
           :contentbasename (org-hugo--get-anchor heading info)
           :year (format-time-string "%G" pub-time)
           :month (format-time-string "%m" pub-time)
           :monthname (format-time-string "%b" pub-time)
           :day (format-time-string "%d" pub-time)
           :weekday (format-time-string "%U" pub-time)
           :weekdayname (format-time-string "%a" pub-time)
           :slugorcontentbasename
           (or (plist-get info :hugo-slug)
               (org-hugo--get-anchor heading info)))))
    (--> template
         (s-split "/" it)
         (--map (if (s-prefix? ":" it)
                    (plist-get values-plist it 'string-equal)
                  it) it)
         (s-join "/" it))))

(defun +org-hugo-guess-rel-permalink (&optional heading info)
  (save-excursion
    (let* ((backend (plist-get info :back-end ))
           (info (org-combine-plists
                  (or info (+org-hugo--get-article-info))
                  (list :back-end
                        (if (symbolp backend)
                            (org-export-get-backend 'hugo)
                          backend))))
           (heading (or heading (org-hugo--get-valid-subtree)))
           (site-config (hugo-query-site-config))
           (section-path (org-hugo--get-section-path info))
           (section (s-chop-suffix "/" section-path))
           (url (plist-get info :hugo-url)))
      (cond (url (car (url-path-and-query (url-generic-parse-url url))))
            ((when-let*
                 ((permalink-template (ht-get* site-config
                                               "permalinks"
                                               "page"
                                               section)))
               (hugo-query--fmt-permalink permalink-template heading info)))
            (t (format "%s%s/"
                       section-path
                       (org-hugo--get-anchor heading info)))))))

And let’s make sure we load the resulting package.

(require 'hugo-query)

Hugo builds

Marking webmentions

I’d like to be able to include webmentions within the body of an article, but both Markdown and Org-mode don’t have obvious ways of adding a class (and hence a microformat) to a link. However, our blog them looks at the contents of a mentions list in our frontmatter, so let’s write some commmands to do some of that for us.

(defun +org-hugo-get-custom-frontmatter ()
  (let ((info (org-combine-plists
               (org-export--get-export-attributes 'hugo t)
               (org-export--get-buffer-attributes)
               (org-export-get-environment 'hugo t))))
    (org-hugo--parse-property-arguments (plist-get info :hugo-custom-front-matter))))

(defun +org-hugo-get-mentions ()
  (alist-get 'mentions (+org-hugo-get-custom-frontmatter)))

(defun +org-hugo-add-to-mentions (url &optional description type)
  (save-excursion
    (org-hugo--get-valid-subtree)
    (let* ((mentions (+org-hugo-get-mentions)))
      (cl-pushnew `((url . ,url)
                    ,@(when description (list (cons 'description description)))
                    (type . ,(or type 'in-reply-to)))
                  mentions)
      (+org-hugo-put-custom-frontmatter 'mentions mentions))))


(defun +org-hugo--format-frontmatter-entry (entry)
  (format
   (concat ":%s "
           (if (listp (cdr entry)) "'%S" "%S"))
   (car entry)
   (cdr entry)))

(defun +org-hugo-put-custom-frontmatter (keysym value)
  "Put `VALUE' in the current entry's custom hugo frontmater at `KEYSYM'.

This can radically reshape the look of the PROPERTIES: drawer, but data is preserved."
  (save-excursion
    (org-hugo--get-valid-subtree)
    (let* ((frontmatter (+org-hugo-get-custom-frontmatter)))
      (setf (alist-get keysym frontmatter) value)
      (org-entry-put (point)
                     "export_hugo_custom_front_matter"
                     (+org-hugo--format-frontmatter-entry (pop frontmatter)))
      (when frontmatter
        (org-entry-put (point)
                       "export_hugo_custom_front_matter+"
                       (+org-hugo--format-frontmatter-entry (pop frontmatter))))
      (when frontmatter
        (goto-char (cdr (org-get-property-block)))
        (dolist (entry frontmatter)
          (insert ":export_hugo_custom_front_matter+: "
                  (+org-hugo--format-frontmatter-entry entry))
          (newline))))))
Captures

Add the captures setup below to org-capture-templates.

(with-eval-after-load 'org-capture
  (dolist (it `(
                <<hugo-capture-templates>>
                ))
    (setf (alist-get (car it) org-capture-templates nil t #'string=)
          (cdr it))))

For each kind of blog related capture, we’ll use a support function to generate the template because it allows for more flexible prompting for information and for a more dynamic template.

We’ll also define a few support functions with information about the various sites.

(defun pdc-site-posts-file (site)
  "Path to the all-posts.org file for a site."
  (require 'dash)
  (let* ((site-dir (cdr (assoc site pdc-site-directories-alist))))
    (-first #'file-exists-p
            (-map (-rpartial #'expand-file-name site-dir)
                  (list "Content.org"
                        "org-content/all-posts.org")))))
Blog post

We’ll use a function to setup the template, because it allows for more flexible prompting than in static templates.

(defun +org-hugo-new-subtree-post-capture-template ()
  "Returns `org-capture' template string for new Hugo post.
See `org-capture-templates' for more information."
  (let* ((title (read-from-minibuffer "Post Title: "))
         (fname (concat (format-time-string "%+4Y%m%d-")
                        (org-hugo-slug title))))
    (mapconcat #'identity
               `(
                 ,(concat "* TODO " title)
                 ":PROPERTIES:"
                 ,(concat ":EXPORT_HUGO_BUNDLE: " fname)
                 ":EXPORT_FILE_NAME: index"
                 ":END:"
                 "%?\n")
               "\n")))

(defun +org-hugo-new-subtree-reply-capture-template ()
  "Returns `org-capture' template string for new Hugo post.
See `org-capture-templates' for more information."
  (let* ((title (read-from-minibuffer "Reply Title: "))
         (url (read-from-minibuffer "URL: "))
         (fname (concat (format-time-string "%+4Y%m%d-")
                        (org-hugo-slug title))))
    (mapconcat #'identity
               `(
                 ,(concat "* TODO " title)
                 ":PROPERTIES:"
                 ,(concat ":EXPORT_HUGO_BUNDLE: " fname)
                 ":EXPORT_FILE_NAME: index"
                 ,(concat ":EXPORT_HUGO_CUSTOM_FRONT_MATTER+: :mentions "
                          (format "'(((url . %S) (type . in-reply-to)))" url))
                 ":END:"
                 "%?\n")
               "\n")))
Capture Template
("b" "bofh.org.uk post" entry
 (file+olp ,(pdc-site-posts-file "bofh") "Posts" "Uncategorised")
 (function +org-hugo-new-subtree-post-capture-template)
 :prepend t
 :jump-to-captured t)
("R" "bofh.org.uk reply" entry
 (file+olp ,(pdc-site-posts-file "bofh") "Posts" "Uncategorised")
 (function +org-hugo-new-subtree-reply-capture-template)
 :prepend t
 :jump-to-captured t)
Legacy post

This is possibly a bad place for this to live, but we want to be able to pull truncated old markdown posts into Content.org, grab the full post from the Wayback Machine, tidy them up a little before committing to the updated content, and the capture system sort of fits the bill.

(use-package tomelr)
(use-package tomlparse
  :defer nil)

(defun +org-hugo-fixup-typo:code-blocks ()
  (require 'web-mode)
  (unwind-protect
      (let* ((code-fixup-alist
              '(("" . "...")
                ("" . "=>")
                ("" . "->")
                ("<br>" . "")
                ("<br/>" . "")))
             (fixup-re (regexp-opt (mapcar 'car code-fixup-alist))))
        (major-mode-suspend)
        (web-mode)
        (goto-char (point-min))
        (while (re-search-forward "<typo:code>" nil t)
          (web-mode-element-parent)
          (when (string= (web-mode-element-tag-name) "typo:code")
            (web-mode-element-rename "code")
            (web-mode-element-content-select)
            (web-mode-element-wrap "pre")
            (web-mode-element-content-select)
            (save-restriction
              (narrow-to-region (point) (mark))
              (while (re-search-forward fixup-re nil t)
                (replace-match
                 (alist-get (match-string-no-properties 0)
                            code-fixup-alist nil t 'string=) t t))))))
    (major-mode-restore)))



(defun +org-hugo--get-legacy-page-from-wayback (file-or-url &optional date)
  (require 'wayback)
  (let* ((url (s-replace-regexp
               (rx bos "https://") "http://"
               (if (string-match-p "\\`https?://" file-or-url)
                   file-or-url
                 (hugo-query-url-for-source file-or-url)))))
    (wayback-with-page-from-before url (or date 2015)
      (call-process-region nil nil "tidy" t t nil
                           "-i" "-ashtml" "--gnu-emacs" "yes")
      (+org-hugo-fixup-typo:code-blocks)
      (call-process-region nil nil "pandoc" t t nil
                           "-f" "html" "-t" "org-smart")

      (org-string-nw-p
       (buffer-substring-no-properties (point-min) (point-max))))))

(defun +org-has-link-with-description (desc)
  (let ((link-re
         (rx (seq "[["
                  (+ (or (not (any "[]\\"))
                         (and "\\" (* "\\\\") (any "[]"))
                         (and (+ "\\" (not (any "[]"))))))
                  "]"
                  "[" (regexp desc)))))
    (save-excursion
      (goto-char (point-min))
      (re-search-forward link-re nil t))))

(defvar legacy-post-type-identifiers
  `((,(-partial '+org-has-link-with-description "scribbish")
     ( :post-variant scribbish
       :comment-id "comments")
     (,(rx (group
            bol "<<content>>\n\n"
            "<<article-" (+ digit) ">>\n")
           (regexp org-heading-regexp) "\n"
           (regexp org-property-drawer-re) "\n"
           "Posted by\n"
           (regexp org-link-bracket-re)
           (+ not-newline) "\n")
      . ,(rx (group
              bol
              "Comments\nName:\\\\")))
     legacy-strip-wbm-from-links
     legacy-parse-and-remove-metadata-stanza
     legacy-guess-metadata
     legacy-add-org-hugo-metadata
     legacy-strip-pandoc-inferred-classes
     legacy-fixup-scribbish-comments)
    (t
     ( :post-variant default
       :comment-id "commentaires")
     (,(rx (group
            bol "<<page>>\n\n"
            "<<article-" (+ digit) ">>\n")
           (regexp org-heading-regexp) "\n"
           (regexp org-property-drawer-re) "\n")
      . "\\(^<<commentform>>\n\\)")
     legacy-parse-and-remove-metadata-stanza
     legacy-guess-metadata
     legacy-strip-wbm-from-links
     legacy-add-org-hugo-metadata
     legacy-strip-pandoc-inferred-classes
     legacy-fixup-default-comments
     ))
  "Matchers and cleanup functions for different site variants.")

(defvar legacy-date-re
  (rx (or "Sat" "Sun" "Mon" "Tue" "Wed" "Thu" "Fri") ", "
      (+ digit) " "
      (or "Jan" "Feb" "Mar" "Apr" "May" "Jun"
          "Jul" "Aug" "Sep" "Oct" "Nov" "Dec") " "
      (= 4 digit) " "
      (= 2 (= 2 digit) ":") (= 2 digit) " "
      (or (= 3 alpha)
          (seq (any "+-") (= 2 digit) ":" (= 2 digit))))  )

(defvar legacy-article-metadata-matchers-plist
  `(
    scribbish legacy-parse-and-remove-scribbish-metadata
    default ,(rx bol "Published on "
                 (group-n 3 (regexp legacy-date-re))
                 " by "
                 (+ alnum)
                 (*? (+ space) (+ alnum))
                 " "
                 (or (seq "under\n"
                          (group-n 1
                            (regexp org-link-bracket-re)
                            (* ",\n" (regexp org-link-bracket-re)))
                          ".\n")
                     (seq ".\n"))
                 (? "Tags "
                    (group-n 2
                      (regexp org-link-bracket-re)
                      (* ",\n" (regexp org-link-bracket-re))))
                 (* "\n")
                 "If you liked this article you can" (any " \n")
                 (regexp org-link-bracket-re)
                 "\n")))

(defun legacy-guess-metadata (&optional info)
  (unless (plist-get info :slug)
    (org-back-to-heading-or-point-min)
    (if-let* ((slug (org-element-property
                     :CUSTOM_ID
                     (org-element-at-point)
                     nil t)))
        (plist-put info :slug slug))))

(defun legacy-parse-and-remove-scribbish-metadata (&optional info)
  (prog1 nil
    (cl-block nil
      (org-element-map (org-element-parse-buffer) 'plain-list
        (lambda (list)
          (goto-char (org-element-contents-begin list))
          (when (looking-at (rx "- " (or "Posted in" "Tags")))
            (org-element-map list 'item
              (lambda (item)
                (goto-char (org-element-contents-begin item))
                (when (looking-at "Tags")
                  (plist-put
                   info :tags (org-element-map item 'link
                                (lambda (l)
                                  (goto-char (org-element-begin l))
                                  (when (looking-at org-link-bracket-re)
                                    (match-string-no-properties 2))))))))
            (delete-region (org-element-begin list)
                           (org-element-end list))
            (cl-return)))))))


(defun legacy-parse-and-remove-metadata-stanza (&optional info)
  (prog1 nil
    (let ((matcher (plist-get legacy-article-metadata-matchers-plist
                              (plist-get info :post-variant))))
      (cond ((or (symbolp matcher)
                 (functionp matcher)) (funcall matcher info))
            ((stringp matcher)
             (when (re-search-forward matcher nil t)
               (let ((categories-start (match-beginning 1))
                     (categories-end (match-end 1))
                     (tags-start (match-beginning 2))
                     (tags-end (match-end 2))
                     (pub-date (date-to-time (match-string 3)))
                     (categories nil)
                     (tags nil))
                 (save-match-data
                   (save-excursion
                     (when categories-start
                       (goto-char categories-start)
                       (while (re-search-forward org-link-bracket-re categories-end t)
                         (cl-pushnew (match-string-no-properties 2) categories :test 'string=)))
                     (when tags-start
                       (goto-char tags-start)
                       (while (re-search-forward org-link-bracket-re tags-end t)
                         (cl-pushnew (match-string-no-properties 2) tags :test 'string=)))))
                 (delete-region (match-beginning 0) (match-end 0))
                 (setf (plist-get info :categories) categories)
                 (setf (plist-get info :tags) tags)
                 (setf (plist-get info :pub-date) pub-date))))))))

(defun legacy-cleanup-wayback-article (&optional info)
  (interactive)
  (goto-char (point-min))
  (save-excursion
    (pcase-dolist
        (`(,pred ,variant-info (,pre-re . ,post-re) . ,cleanup-funcs) legacy-post-type-identifiers)
      (when (or (eq 't pred)
                (funcall pred))
        (when (re-search-forward pre-re nil t)
          (delete-region (point-min) (match-end 1)))
        (when (re-search-forward post-re nil t)
          (delete-region (match-beginning 1) (point-max)))
        (unwind-protect
            (let ((info (org-combine-plists info variant-info))
                  (org-todo-keywords '((sequence "TODO" "REVISING" "|"
                                                 "DONE")))
                  (org-log-into-drawer t))
              (major-mode-suspend)
              (org-mode)
              (goto-char (point-min))
              ;; Pre cleanup
              ;; We want a level 1 heading.
              ;; Capture can sort out the eventual level
              (while (> (org-current-level) 1)
                (org-promote-subtree))
              ;; Run any per post type cleanup functions
              (when cleanup-funcs
                (goto-char (point-min))
                (dolist (f cleanup-funcs)
                  (save-excursion
                    (save-restriction
                      (deactivate-mark)
                      (setq info (or (funcall f info)
                                     info))
                      )))))
          (major-mode-restore))
        (cl-return)))))


(defun legacy-strip-wbm-from-links (&optional info)
  (while (re-search-forward org-link-bracket-re nil t)
    (replace-match
     (replace-regexp-in-string
      (rx bos
          (: (? (| "//web.archive.org" "https://web.archive.org"))
             "/web/")
          (+ (not "/"))
          "/"
          (group (or "http" "https") "://"))
      "\\1"
      (match-string 1))
     nil t nil 1)))

(defun legacy-add-org-hugo-metadata (info)
  (setq-local org-todo-log-states '(("REVISING" time nil)
                                    ("DONE" time nil)))
  (org-todo "DONE")
  (org-add-log-note)
  (org-todo "REVISING")
  (org-add-log-note)
  (re-search-forward org-logbook-drawer-re (org-entry-end-position))
  (goto-char (match-beginning 0))
  (re-search-forward "^- State \"DONE\".*\\[\\(.*\\)]" (match-end 0))
  (replace-match
   (format-time-string "%F %a" (plist-get info :pub-date))
   nil t nil 1)
  (org-set-property "export_hugo_bundle"
                    (plist-get info :slug))
  (org-set-property "export_file_name" "index")
  (when-let* ((tags (plist-get info :tags)))
    (org-hugo--get-valid-subtree)
    (org-set-tags tags)))

(defun legacy-strip-pandoc-inferred-classes (&optional info)
  (prog1 nil
    (org-hugo--get-valid-subtree)
    (org-map-entries (-partial 'org-delete-property "CLASS") t 'tree)))


(defun +org-hugo-get-legacy-frontmatter (file)
  (org-with-file-buffer file
    (save-excursion
      (save-restriction
        (widen)
        (goto-char (point-min))
        (when (looking-at (rx "+++"))
          (forward-line))
        (let ((start (point)))
          (while (not (looking-at (rx "+++")))
            (forward-line))
          (narrow-to-region start (point))
          (goto-char (point-min))
          (tomlparse-buffer :object-type 'alist :datetime-as 'datetime))))))

(defvar +org-hugo--import-skip-front-matter-re
  (rx (: buffer-start (group (| "+++" "---") "\n")
         (*? anychar)
         (backref 1))))

(defun +org-hugo--import-file-body-as-org (file)
  "Skip over the front matter and import the body with pandoc"
  (org-with-file-buffer file
    ;; In case we're in an existing file buffer
    (save-excursion
      (save-restriction
        (widen)
        (let* ((buf-name " *legacy-import*"))
          (with-current-buffer (get-buffer-create buf-name)
            (erase-buffer))
          (goto-char (point-min))
          (re-search-forward +org-hugo--import-skip-front-matter-re nil t)
          (call-process-region (point) (point-max)
                               "pandoc"
                               nil buf-name nil
                               "-f" "markdown"
                               "-t" "org")
          (with-current-buffer buf-name
            (goto-char (point-min))
            (save-excursion
              (when (re-search-forward (rx bol "<!--more-->" eol) nil t)
                (replace-match "#+hugo: more")))
            (org-string-nw-p
             (substring-no-properties (buffer-string)))))))))


(defun +org-hugo-import-legacy-article-somehow (file)
  (or (+org-hugo--get-legacy-page-from-wayback file)
      (prog1 (+org-hugo--import-file-body-as-org file)
        (message "Wayback Record missing. Fallling back to .md file."))
      ""))


(defun +org-hugo-import-legacy-article-capture-template ()
  (interactive)
  (let* ((file (read-file-name "Legacy MD: "
                               "~/Sites/bofh.org.uk/legacy-content/post/"
                               nil t))
         (front-matter (+org-hugo-get-legacy-frontmatter file))
         (pub-time (date-to-time (alist-get 'date front-matter)))
         (extra-front-matter
          (seq-reduce
           (lambda (init pair)
             (if (member (car pair)
                         '(date title slug draft))
                 init
               (cons pair init)))
           front-matter nil)))
    (prog1
        (mapconcat
         #'identity
         `(
           ,(concat "* REVISING "
                    (alist-get 'title front-matter))
           ":PROPERTIES:"
           ,(concat ":EXPORT_HUGO_BUNDLE: "
                    (format-time-string "%y%m%d-" pub-time)
                    (alist-get 'slug front-matter))
           ":EXPORT_FILE_NAME: index"
           ":END:"
           ":LOGBOOK:"
           ,(format-time-string
             "- State \"REVISING\"   from \"DONE\"       [%F %a]")
           ,(format-time-string
             "- State \"DONE\"       from \"TODO\"       [%F %a]"
             pub-time)
           ":END:\n"
           ,@(when extra-front-matter
               `(
                 "#+begin_src toml :front-matter-extra t"
                 ,(let ((tomelr-indent-multi-line-strings t))
                    (tomelr-encode extra-front-matter))
                 "#+end_src"))
           "%?\n"
           ,(+org-hugo-import-legacy-article-somehow file))
         "\n")
      (setq pdc/last-imported-legacy-file file))))

(defvar hugo-legacy-gravatar-prefix-re
  (rx "//web.archive.org/web/" (+? digit) "im_/"))

(defun +org-set--heading-level (target-level)
  (save-excursion
    (let* ((after-change-functions
            (remq 'flyspell-after-change-function
                  after-change-functions))
           (old-level (org-current-level))
           (diff (- target-level old-level))
           (new-head (concat (make-string target-level ?*) " ")))
      (replace-match
       (apply #'propertize new-head
              (text-properties-at (match-beginning 0))) t)
      (unless (or (zerop diff)
                  (= target-level 1))
        (when org-auto-align-tags (org-align-tags))
        (when org-adapt-indentation (org-fixup-indentation diff)))
      (cond ((< diff 0) (run-hooks 'org-after-promote-entry-hook))
            ((> diff 0) (run-hooks 'org-after-demote-entry-hook))))))

(defun +org-hugo--fixup-comments-heading (&optional info)
  (let ((level (org-current-level))
        (comment-id (or (plist-get info :comment-id)
                        "commentaires")))
    (org-map-entries
     (lambda ()
       ;; Correct *** depth
       (let ((case-fold-search t))
         (if (looking-at-p "^[ \t]*\\** .*\\[0 comments\\]")
             (delete-region (point) (org-entry-end-position))
           (+org-set--heading-level (1+ level))
           ;; Note that comments are historic
           (when (re-search-forward org-link-bracket-re (pos-eol) t)
             (let* ((desc (match-string 2)))
               (replace-match (replace-regexp-in-string
                               "\\(?:historic \\)?comment"
                               "historic comment"
                               desc)
                              nil nil nil 2)))
           ;; Remove the link to the comment form
           (when (re-search-forward org-link-bracket-re (pos-eol) t)
             (replace-match "»"))
           ;; Anglicise comments id
           (org-set-property "CUSTOM_ID" "comments")
           (org-end-of-meta-data)
           (let (
                 (+org-suppress-insert-structure-template-advice t))
             (unless (looking-at-p "\\n*[ \t]*#\\+BEGIN_MARGINNOTE")
               (org-insert-structure-template "marginnote")
               (insert "These are archived comments. To respond to this post, use a webmention\n"))))))
     (format "CUSTOM_ID=\"%s\"" comment-id) 'tree     )))

(defvar legacy-post-meta-re
  (rx bol "Published on "
      (group (+? anychar))
      " by Piers Cawley . Tags"))

(defun legacy-post-reformat-meta-stuff ()
  (save-excursion
    (org-hugo--get-valid-subtree)
    (let ((tags ()))
      (save-excursion
        (save-restriction
          (when (re-search-forward legacy-post-meta-re nil t)
            (org-narrow-to-element)
            (goto-char (point-min))
            (while (re-search-forward org-link-bracket-re nil t)
              (push (match-string-no-properties 2) tags))
            (delete-region (point-min) (point-max))))
        (while (looking-at "^$")
          (forward-line))
        (when (looking-at "If you liked this article you can")
          (let ((elem (org-element-at-point)))
            (delete-region (org-element-begin elem)
                           (org-element-end elem)))))
      (unless (null tags)
        (org-set-tags tags))
      )))

(defun legacy-fixup-scribbish-comments (info)
  (let ((comment-id (plist-get info :comment-id))
        (comment-count 0))
    (org-map-entries
     (lambda ()
       (while (> (org-current-level) 2)
         (org-promote-subtree))
       (org-set-property "HTML_CONTAINER" "section")
       (org-set-property "HTML_CONTAINER_CLASS" "comments")
       (save-restriction
         (org-narrow-to-subtree)
         (goto-char (org-entry-beginning-position))
         (re-search-forward org-property-drawer-re (org-entry-end-position))
         (next-line)
         (beginning-of-line)

         (delete-matching-lines
          (rx (or "[[#commentform][Leave a response]]"
                  (: "<<"
                     (or "comments_div"
                         (: "comment-" (+ digit)))
                     ">>"))))
         (let ((+org-suppress-insert-structure-template-advice t))
           (org-insert-structure-template "marginnote")
           (insert "These are archived comments. To respond to this post, use a webmention.\n"))
         (while (re-search-forward
                 (rx bol (+ digit) ". "
                     (group-n 1 (+ "\n" (* space)))
                     (regexp org-link-bracket-re)
                     (group-n 2 (+? anychar) "later:" eol))
                 nil t)
           (replace-match
            (replace-regexp-in-string
             (rx (+ (any space "\n")))
             " " (match-string 2))
            nil t nil 2)
           (replace-match "!" nil t nil 1)
           (setq comment-count (1+ comment-count)))
         ;; Turn the plain list into headlines
         (org-element-map (org-element-parse-buffer) 'plain-list
           (lambda (list)
             (goto-char (org-element-begin list))
             (let ((current-prefix-arg '(4)))
               (org-toggle-heading))))
         ;; Fix the Comments headline
         (goto-char (point-min))
         (org-edit-headline (format "%s historic comments"
                                    comment-count))))
     (format "CUSTOM_ID=\"%s\"" comment-id) 'tree)))

(use-package org-ml
  :defer nil)

(defun legacy-fixup-default-comment-node (node info)

  )




(defun legacy-fixup-default-comments (info)
  (let ((comment-id (plist-get info :comment-id))
        (comment-count 0))
    (org-map-entries
     (lambda ()
       (while (> (org-current-level) 2)
         (org-promote-subtree))
       (org-set-property "HTML_CONTAINER" "section")
       (org-set-property "HTML_CONTAINER_CLASS" "comments")
       (org-set-property "CUSTOM_ID" "comments")
       (save-restriction
         (org-narrow-to-subtree)
         (goto-char (org-entry-beginning-position))
         (re-search-forward org-property-drawer-re (org-entry-end-position))
         (next-line)
         (beginning-of-line)
         (let ((+org-suppress-insert-structure-template-advice t))
           (org-insert-structure-template "marginnote")
           (insert "These are archived comments. To respond to this post, use a webmention.\n"))
         (org-back-to-heading)
         (save-excursion
           (when (re-search-forward "comments\\]\\].*" (pos-eol) t)
             (replace-match "historic comments]]"))
           ;; (while (re-search-forward "^  " nil t)
           ;;   (when (looking-at-p "\\*\\{4\\} ")
           ;;     (insert "*")))
           ;; Turn the plain list into headlines
           (org-element-map (org-element-parse-buffer) 'plain-list
             (lambda (list)
               (goto-char (org-element-begin list))
               (let ((current-prefix-arg '(4)))
                 (org-toggle-heading)))))
         (delete-matching-lines "^-----")))
     (format "CUSTOM_ID=\"%s\"" comment-id) 'tree)))

(defun +org-hugo--fixup-comments (&optional info)
  "Sort out broken spacing of historic comments.
Called with point at the beginning of the comments entry."
  (interactive)
  (let* ((comment-level (1+ (org-current-level))))
    (org-narrow-to-subtree)
    ;; Fixup individual comment headings
    (save-excursion
      (while (re-search-forward "^  \\*\\{4\\} " nil t)
        (replace-match (concat
                        (make-string comment-level ?*) " "))))
    ;; Remove excessive indents and hlines
    (save-excursion
      (while (re-search-forward "^  \\(?:-\\{3,\\}\n\\)?" nil t)
        (replace-match "")))
    ;; Fixup gravatar links and move them into the comment headers
    ;; match-string 1: link destination
    ;; match-string 2: link description (empty)
    ;; match-string 3: heading stars
    (while (re-search-forward
            (rx (seq
                 ;; The broken gravatar link
                 bol "- " (regexp org-link-bracket-re)
                 (+? anychar)
                 ;; The fixed up headline
                 bol (group (+ "*") " ")))
            nil t)
      (let ((gravatar-link (replace-regexp-in-string "\\`//web\\.archive\\.org/web/[0-9]+?im_/" "" (match-string 1)))
            (heading-stars (match-string 3))
            )
        (unless (string= gravatar-link (match-string 1))
          (replace-match (s-lex-format "${heading-stars}![[${gravatar-link}][${gravatar-link}]] ")))))))

(defun +org-hugo-fixup-legacy-comments (&optional info)
  "Reformat our legacy comments"
  (interactive)
  (save-excursion
    (save-restriction
      (org-hugo--get-valid-subtree)
      (org-narrow-to-subtree)
      (+org-hugo--fixup-comments-heading info)
      (org-map-entries
       (lambda ()
         (+org-hugo--fixup-comments info))
       "CUSTOM_ID=\"comments\"" 'tree))))

(defun legacy-post-fixup-import (&optional buffer-or-name)
  (interactive)
  (+org-hugo-fixup-legacy-comments buffer-or-name)
  (legacy-post-reformat-meta-stuff))


(defun +maybe-remove-legacy-file ()
  (if (and pdc/last-imported-legacy-file
           (file-exists-p pdc/last-imported-legacy-file)
           (y-or-n-p (format "Delete %s"
                             pdc/last-imported-legacy-file)))
      (delete-file pdc/last-imported-legacy-file)))
Capture template
("R" "Recover article" entry
 (file+headline ,(pdc-site-posts-file "bofh") "Recovered Posts")
 (function +org-hugo-import-legacy-article-capture-template)
 :hook legacy-post-fixup-import
 :after-finalize +maybe-remove-legacy-file
 :jump-to-captured t)
Book report
Grab cover images from OpenLibrary
  • State “DONE” from “TODO” [2025-08-28 Thu 23:07]
(defvar book-data-search-endpoint "https://openlibrary.org/search.json"
  "An endpoint that conforms to the openlibrary.org book search api")
(defvar book-cover-display-endpoint "https://covers.openlibrary.org/b/olid"
  "An endpoint that conforms to the openlibrary.org book cover api")

(defun pdc-get-book-cover (author title)
  (require 'dash)
  (let* ((query-string
          (url-build-query-string
           `((author ,author)
             (title ,title)
             (fields "author,key,cover_edition_key,isbn,title"))))
         (response-buf (url-retrieve-synchronously
                        (format "%s?%s"
                                book-data-search-endpoint
                                query-string))))
    (save-excursion
      (with-current-buffer response-buf
        ;; Move to just after the headers
        (goto-char (point-min))
        (while (not (looking-at "^$"))
          (forward-line))
        (let ((json-object-type 'alist)
              (json-key-type 'symbol)
              (json-array-type 'list))
          (when-let* ((result (json-read))
                      (cover-edition-key
                       (-first #'identity
                               (-map (-partial #'alist-get 'cover_edition_key)
                                     (-filter (-compose
                                               (-partial #'string-equal-ignore-case title)
                                               (-partial #'alist-get 'title))
                                              (alist-get 'docs result))))))
            (mapcar (lambda (size)
                      (cons (intern (downcase size))
                            (format "%s/%s-%s.jpg"
                                    book-cover-display-endpoint
                                    cover-edition-key
                                    size)))
                    '("S" "M" "L"))))))))
Generate a template for a book report Should include frontmatter pointing to the book’s cover images on openlibrary.org.
(defun +org-hugo-new-subtree-book-capture-template ()
  "Returns `org-capture' template string for new Hugo book report."
  (let* ((title (read-from-minibuffer "Book Title: "))
         (author (read-from-minibuffer "Author: "))
         (fname (org-hugo-slug (concat author " " title)))
         (covers (pdc-get-book-cover author title)))
    (mapconcat #'identity
               `(
                 ,(concat "* TODO " title ", by " author)
                 ":PROPERTIES:"
                 ,(format ":EXPORT_HUGO_CUSTOM_FRONT_MATTER+: :work '%S"
                          `((author . ,author)
                            (title . ,title)
                            (type . ,title)))
                 ,@(if covers
                       (list (concat ":EXPORT_HUGO_CUSTOM_FRONT_MATTER+: :cover '"
                                     (format "%S" covers))))
                 ,(concat ":EXPORT_HUGO_BUNDLE: " fname)
                 ":EXPORT_FILE_NAME: index"
                 ":END:"
                 "%?\n")
               "\n")))
Capture template
("B" "Book Note" entry
 (file+headline ,(pdc-site-posts-file "bofh") "Book Reports")
 (function +org-hugo-new-subtree-book-capture-template)
 :jump-to-captured t)
Note

Notes are analogous to toots/skeets or whatever the microblogging platform du jour calls them. I want to encourage myself to write with as little ceremony as possible, so I’ve added something similar to bofh.org.uk.

(defun +org-hugo-new-subtree-note-capture-template ()
  "Returns an `org-capture' template string for a new Hugo note.
See `org-capture-templates' for more information."
  (mapconcat #'identity `("* TODO %U" "%?") "\n"))

(defun +org-hugo-fixup-note-name ()
  "Set the captured note's filename to n `(1+ lastnote-number)."
  (interactive)                         ; For debugging purposes
  (save-restriction
    (widen)
    (save-excursion
      (+org-hugo-back-to-article-heading)
      (let* ((last-note-fname (or (ignore-errors
                                    (save-excursion
                                      (org-backward-heading-same-level 1 t)
                                      (org-entry-get (point) "export_file_name" nil)))
                                  "0"))
             (new-note-number (1+ (string-to-number last-note-fname))))
        (org-entry-put (point) "export_file_name" (number-to-string new-note-number)))))
  ;; Notes are always done as soon as they're captured. I could just put DONE
  ;; in the template, but then I'd have also add the time tracking stuff we
  ;; want for other bits of front matter. So we'll just use the org API to do
  ;; that here instead.
  (org-todo 'done))

Capture template
("n" "Note" entry
 (file+headline ,(pdc-site-posts-file "bofh") "Notes")
 (function +org-hugo-new-subtree-note-capture-template)
 :prepare-finalize +org-hugo-fixup-note-name
 :before-finalize org-hugo-export-wim-to-md)
Week Notes

I used to have a discipline of capturing notes for a weekly summary post, but lately I’ve not really been on top of that. However, I’m keeping the support machinery around for a while longer.

Support code I’m just importing this from the old pdcmacs-hugo-support.el without comment at the moment
(defun week< (string time)
  (string< string (format-time-string "%Y-%m-%d" time)))

(defun weekday< (string time)
  (< (1+ (-elem-index string '("Monday" "Tuesday" "Wednesday"
                               "Thursday" "Friday" "Saturday"
                               "Sunday")))
     (string-to-number (format-time-string "%u" time))))

;;; I really dislike the practice of `defvar'ing private variables, so
;;; we introduce a let form in which define
;;; `+org-pathbuilder-find-create-path' and `+org-pathbuilder-insert-line'
;;; to allow them to share a private `current-level' variable.
;;;
;;; TODO: make the treebuilder state something that's passed around --
;;; I want to be able to clean up after an aborted capture, for instance.
(let ((current-level))
  (defun +org-pathbuilder-find-create-path (keep-restriction pathspec)
    "Find or create a place in FILE at the PATHSPEC given."
    (when pathspec
      (save-restriction
        (cond ((eq keep-restriction 'subtree-at-point)
               (unless (org-at-heading-p) (error "Not at heading"))
               (widen)
               (org-narrow-to-subtree))
              ((not keep-restriction)
               (widen)))
        (goto-char (point-min))
        (setq current-level (org-get-valid-level (or (org-current-level) 0) 1))
        (when pathspec
          (let* ((targetspec (-list (car pathspec)))
                 (remainder (cdr pathspec))
                 (target (car targetspec))
                 (insertion (or (cadr targetspec) target)))
            (+org-pathbuilder--find-create target insertion)
            (+org-pathbuilder-find-create-path 'subtree-at-point remainder))))))

  (defun +org-pathbuilder-insert-line (insert)
    (delete-region
     (save-excursion (skip-chars-backward " \t\n") (point))
     (point))
    (when (org--blank-before-heading-p) (insert "\n"))

    (insert "\n"
            (make-string current-level ?*)
            " \n")
    (backward-char)
    (insert insert)
    (org-narrow-to-subtree)
    (goto-char (point-min))
    (widen)))

(defun +org-pathbuilder--find-create (target insert)
  (let* ((target-regex (cond ((string-match-p "\\\\(\\?1:" target)
                              target)
                             ((string-match "\\\\(" target)
                              (replace-match "\\(?1:" nil t target))
                             (t
                              (s-wrap target "\\(?1:" "\\)"))))
         (re (format org-complex-heading-regexp-format target-regex))
         (match))
    (goto-char (point-min))
    (when (setq match (re-search-forward re nil t))
      (goto-char (match-beginning 1)))
    (cond ((not match)
           (goto-char (point-max))
           (unless (bolp) (insert "\n"))
           (+org-pathbuilder-insert-line insert))
          (t (forward-line 0)))))

(defun pdc:weeknote-path (&optional d)
  (let* ((d (or d (-> (org-current-effective-time)
                      time-to-days
                      calendar-gregorian-from-absolute)))
         (eow-d (pdc:end-of-week-date d))
         (eow-time (org-encode-time 0 0 0
                                    (calendar-extract-day eow-d)
                                    (calendar-extract-month eow-d)
                                    (calendar-extract-year eow-d))))
    (list (format-time-string "%Y" eow-time)
          (let* ((heading-title (format-time-string "Week ending %Y-%m-%d" eow-time))
                 (full-heading (format-time-string
                                (s-join "\n"
                                        `(,(s-concat "OPEN " heading-title)
                                          ":PROPERTIES:"
                                          ":export_file_name: week-ending-%Y%m%d"
                                          ":export_hugo_slug: week-note"
                                          ":END:"
                                          ""
                                          "#+hugo: more"))
                                eow-time)))
            (list heading-title full-heading))
          (format-time-string "%A" (org-current-effective-time)))))

(defun pdc:end-of-week-date (&optional d)
  "Get the gregorian date of the end of the week for the given gregorian date `D'."
  (let* ((d (or d (-> (org-current-effective-time)
                      time-to-days
                      calendar-gregorian-from-absolute)))
         (iso-date (-> d calendar-absolute-from-gregorian
                       calendar-iso-from-absolute))
         (iso-week (nth 0 iso-date))
         (iso-year (nth 2 iso-date))
         (end-of-week-gregorian (-> (list iso-week 7 iso-year)
                                    calendar-iso-to-absolute
                                    calendar-gregorian-from-absolute)))
    end-of-week-gregorian))

(defun pdc:default-weeknote-path ()
  (pdc:weeknote-path
   (calendar-gregorian-from-absolute
    (cond (org-overriding-default-time
           (time-to-days org-overriding-default-time))
          ((or (org-capture-get :time-prompt)
               (equal current-prefix-arg 1))
           (let* ((org-time-was-given nil)
                  (org-end-time-was-given nil)
                  (prompt-time (org-read-date
                                nil t nil "Date for daynote entry:")))
             (org-capture-put
              :default-time
              (if (or org-time-was-given
                      (= (time-to-days prompt-time) (org-today)))
                  prompt-time

                (org-encode-time
                 (apply #'list
                        0 0 org-extend-today-until
                        (cl-cdddr (decode-time prompt-time))))))
             (time-to-days prompt-time)))
          (t (time-to-days (org-current-effective-time)))))))

(defun +org-hugo-find-weeknote-entry (&rest olp)
  "Find or create today in this week's week note."

  ;; This leaves point at the start of the last heading it created.
  (+org-pathbuilder-find-create-path
   nil (-concat olp (pdc:default-weeknote-path)))
  ;; Skip to the end of the subtree
  (save-restriction
    (org-narrow-to-subtree)
    (goto-char (point-max))))

(defun +org-hugo-find-weeknote-summary (&rest olp)
  (+org-pathbuilder-find-create-path
   nil (-concat olp (-take 2 (pdc:default-weeknote-path))))
  (save-restriction
    (org-narrow-to-subtree)
    (org-goto-first-child)
    (backward-char)
    (delete-region
     (save-excursion (skip-chars-backward " \t\n") (point))
     (point))
    (beginning-of-line)
    (cond ((looking-at (rx "#+hugo: more"))
           (delete-region
            (save-excursion (skip-chars-backward " \t\n") (point))
            (point))
           (insert "\n\n\n\n")
           (backward-char 2))
          (t
           (end-of-line)
           (insert "\n\n")))))

(defun +org-hugo-back-to-article-heading ()
  "Move to the heading of the current article.

Not robust, assumes an article is a direct descendent of a single top level section. Sadly not valid at present."
  (interactive)
  (org-up-heading-all (- (length (org-get-outline-path)) 1)))

(defun +org-hugo-make-default-filename (title)
  "Make a 'safe' file name for a hugo post."
  (require 's)
  (s-concat (format-time-string "%+4Y%m%d") "-" (org-hugo-slug title)))

(defun pdcmacs-hugo-add-properties ()
  "Derive the hugo export file name from the title"
  (interactive)
  (unless (or (org-entry-get (point) "export_file_name" t)
              (org-entry-get (point) "export_hugo_bundle" t))
    (save-excursion
      (+org-hugo-back-to-article-heading)
      (let* ((headline (org-get-heading t t t t)))
        (unless (org-entry-get (point) "export_file_name")
          (org-entry-put (point) "export_file_name"
                         (+org-hugo-make-default-filename headline)))))))

(with-eval-after-load 'org-capture
  (require 'cl-lib)
  (require 's)
  (defun +org-hugo-new-note-post-capture-template ()
    "Returns `org-capture' template string for new Hugo note.
See `org-capture-templates' for more information"
    (let* ((title (read-from-minibuffer)))))

  (add-to-list
   'org-capture-templates
   `("w" "Week Note" plain
     (file+function "~/Sites/bofh.org.uk/org-content/all-posts.org" ,#'(lambda () (+org-hugo-find-weeknote-entry "Week Notes")))
     "%?"
     :empty-lines 1
     :jump-to-captured 1))
  (add-to-list
   'org-capture-templates
   `("W" "Week Summary" plain
     (file+function "~/Sites/bofh.org.uk/org-content/all-posts.org" ,#'(lambda () (+org-hugo-find-weeknote-summary "Week Notes")))
     "%?"
     :empty-lines 1
     :jump-to-captured 1)))

Reading Stuff

PDF Tools

(use-package pdf-tools)

Programming stuff

Language Server Protocol

Eglot

The Language Server Protocol is probably the future, but I’m still experimenting with it. So let’s see about configuring eglot, which is the LSP support that made it into Emacs core. If I don’t get on with it, I’ll give lsp-mode a go.

(use-feature eglot
  :hook
  ((sh-mode bash-ts-mode c-mode) . eglot-ensure)
  :bind
  (:map
   eglot-mode-map
   ("M-m , a" . eglot-code-actions)
   ("M-m , o" . eglot-code-actions-organize-imports)
   ("M-m , r" . eglot-rename)
   ("M-m , f" . eglot-format)
   ("M-m , d" . eldoc))
  :custom
  (eglot-stay-out-of '(flymake))
  (eglot-workspace-configuration '((:gopls . ((staticcheck . t)
                                              (matcher . "CaseSensitive"))))))

;;  (use-feature jsonrpc)

LSP Mode

Let’s try lsp-mode instead.

(defun pdc/lsp-mode-setup ()
  (setq lsp-headerline-breadcrumb-segments '(path-up-to-project file symbols))
  (lsp-headerline-breadcrumb-mode))

(use-package lsp-mode
  :commands (lsp lsp-deferred)
  :hook (lsp-mode pdc/lsp-mode-setup)
  :init
  (setq lsp-keymap-prefix "M-m l")
  :bind-keymap
  ("M-m l" . lsp-command-map)
  :hook ((css-mode
          js-mode
          js2-mode
          python-mode
          ruby-mode
          clojure-mode) . lsp-deferred)
  :config
  (setopt lsp-completion-provider :capf
          lsp-enable-symbol-highlighting t)
  (lsp-enable-which-key-integration t))

(use-package lsp-ui
  :after lsp-mode
  :hook (lsp-mode . lsp-ui-mode)
  :custom
  (lsp-ui-doc-enable t)
  (lsp-ui-doc-position 'bottom)
  (lsp-ui-sideline-enable t)
  (lsp-ui-sideline-show-hover t)
  (lsp-ui-peek-find-references t)
  (lsp-ui-sideline-ignore-duplicate t)
  (lsp-ui-sideline-show-code-actions t))

Syntax checking

Flymake

I’m trying flymake for syntax checking.

(use-feature flymake
  :disabled
  :hook prog-mode
  :bind (:map flymake-mode-map
              ("m-m c n" . flymake-goto-next-error)
              ("M-m c p" . flymake-goto-prev-error)
              ("M-m c l" . flymake-show-buffer-diagnostics))
  :init
  (defun maybe-turn-off-byte-compile-check ()
    (when (bound-and-true-p no-byte-compile)
      (remove-hook flymake-diagnostic-functions
                   'elisp-flymake-byte-compile t))))
Try doing prose checking too?
(use-package flymake-vale
  :disabled
  :straight (:host github :repo "/tpeacock19/flymake-vale"))

Flycheck

(use-package flycheck-posframe
  :if (display-graphic-p)
  :hook (flycheck-mode
         (lsp-mode . (lambda () (flycheck-posframe-mode 0)))
         (post-command . flycheck-posframe-monitor-post-command))
  :custom
  (flycheck-posframe-warning-prefix "")
  (flycheck-posframe-error-prefix "")
  (flycheck-posframe-info-prefix "")
  :config
  (defun flycheck-posframe-monitor-post-command ()
    (when (not (flycheck-posframe-check-position))
      (posframe-hide flycheck-posframe-buffer)))
  (set-face-attribute 'flycheck-posframe-info-face nil :inherit 'font-lock-variable-name-face)
  (set-face-attribute 'flycheck-posframe-warning-face nil :inherit 'warning)
  (set-face-attribute 'flycheck-posframe-error-face nil :inherit 'error))

(use-package flycheck
  :diminish
  :hook
  (prog-mode . flycheck-mode)
  ;;(flycheck-mode . flycheck-set-indication-mode)
  :bind (:map
         flycheck-mode-map
         ("M-m c n" . flycheck-next-error)
         ("M-m c p" . flycheck-previous-error)
         ("M-m c l" . flycheck-list-errors))
  :config
  (with-eval-after-load 'org
    (defun disable-checkdoc-in-org-src-block ()
      (add-to-list 'flycheck-disabled-checkers 'emacs-lisp-checkdoc))
    (add-hook 'org-src-mode-hook #'disable-checkdoc-in-org-src-block))
  :custom
  (checkdoc-force-docstrings-flag nil)
  (flycheck-check-syntax-automatically '(save idle-buffer-switch mode-enabled))
  (flycheck-standard-error-navigation nil)
  (flycheck-indication-mode (if (display-graphic-p) 'left-fringe 'left-margin))
  (flycheck-stylelintrc ".stylelintrc.json"))

Add documentation

(use-package eldoc
  :diminish
  :hook (emacs-startup . global-eldoc-mode)
  :config
  (eldoc-add-command-completions "paredit-")
  (eldoc-add-command-completions "lispy-"))

Aggressive Indent

I like it when my editor keeps things indented according to rules. Saves thought. So as well as the per-language modes, I use aggressive-indent.

(use-package aggressive-indent
  :diminish ""
  :hook (emacs-startup . aggressive-indent-global-mode))

Alignment helpers

I do like a neatly formatted alist etc, so I wrote some alignment functions. Not sure how attached I am to them, but here they are anyway.

(defun +align-repeat (start end regexp &optional justify-right after)
  "Repeat alignment with respect to the given regular expression.
if JUSTIFY-RIGHT is non nil justify to the right instead of the left. If AFTER is non-nil, add whitespace to the left instead of the right."
  (interactive "r\nsAlign regexp: ")
  (let* ((ws-regexp (if (string-empty-p regexp)
                        "\\(\\s-+\\)"
                      "\\(\\s-*\\)"))
         (complete-regexp (if after
                              (concat regexp ws-regexp)
                            (concat ws-regexp regexp)))
         (group (if justify-right -1 1)))
    (message "%S" complete-regexp)
    (align-regexp start end complete-regexp group 1 t)))

(defmacro pdc|create-align-repeat-x (name regexp &optional justify-right default-after)
  (let ((new-func (intern (concat "+align-" name))))
    `(defun ,new-func (start end switch)
       (interactive "r\nP")
       (let ((after (not (eq (if switch t nil) ,(if default-after t nil)))))
         (+align-repeat start end ,regexp ,justify-right after)))))

(defun +align-decimal (start end)
  "Align a table of numbers on decimal points and dollar signs (both optional)"
  (interactive "r")
  (require 'align)
  (align-regexp start end nil
                '((nil (regexp . "\\([\t ]*\\)\\$?\\([\t ]+[0-9]+\\)\\.?")
                       (repeat . t)
                       (group 1 2)
                       (spacing 1 1)
                       (justify nil t)))
                nil))

(pdc|create-align-repeat-x "comma"     "," nil t)
(pdc|create-align-repeat-x "semicolon" ";" nil t)
(pdc|create-align-repeat-x "colon"     ":" nil t)
(pdc|create-align-repeat-x "equal"     "=")
(pdc|create-align-repeat-x "math-oper" "[+\\-*/]")
(pdc|create-align-repeat-x "ampersand" "&")
(pdc|create-align-repeat-x "bar"       "|")
(pdc|create-align-repeat-x "left-paren" "(")
(pdc|create-align-repeat-x "right-paren" ")" t)
(pdc|create-align-repeat-x "backslash" "\\\\")
(pdc|create-align-repeat-x "quote" "['`]'")

(bind-keys
 :prefix "M-m |"
 :prefix-map pdc-align-map
 :prefix-docstring "Where the alignments live."

 (","  . ("on ," . +align-comma))
 (";"  . ("on ;" . +align-semicolon))
 (":"  . ("on :" . +align-colon))
 ("="  . ("on =" . +align-equal))
 ("+"  . ("on +" . +align-math-oper))
 ("*"  . ("on *" . +align-math-oper))
 ("/"  . ("on /" . +align-math-oper))
 ("-"  . ("on -" . +align-math-oper))
 ("|"  . ("on |" . +align-bar))
 ("("  . ("on (" . +align-left-paren))
 (")"  . ("on )" . +align-right-paren))
 ("\\" . ("on \\" . +align-backslash))
 ("'"  . ("on '" . +align-quote))
 ("`"  . ("on `" . +align-quote)))

(which-key-add-key-based-replacements
  "M-m |" "align")

Languages and Frameworks

Lisps

Setup some common lisp mode stuff

(defvar lisp-modes '(emacs-lisp-mode
                     inferior-emacs-lisp-mode
                     ielm-mode
                     lisp-mode
                     inferior-lisp-mode
                     lisp-interaction-mode
                     extempore-mode)
  "A list of Lisp style modes.")

(defvar lisp-mode-hooks
  (dolist (it lisp-modes)
    (intern (concat (symbol-name it) "-hook")))
  "Hook variables associated with `lisp-modes'.")
Paredit

Paredit is an excellent mode for working in Lisps. At its simplest it ‘just’ keeps parens balanced and ensures your lisp is always well formed, but it comes into its own once you start needing to fiddle with the structure of code.

I’ve also added a bit of extra cleverness around what happens after closing a sexp. An early version of paredit used to insert a newline after closing parens, but roll that back if the next character you typed was a space. I liked that behaviour, so when paredit removed the behaviour (presumably because it was too surprising), I added it back in.

Also, paredit and embark fight a little, so added a hook to add paredit-mode’s bindings to minor-mode-overriding-map-alist. My approach is almost certainly overkill, but it works, which is what matters.

(use-package paredit
  :diminish ""
  :bind
  (:map paredit-mode-map
        ("DEL"   . pdc/paredit-backward-delete)
        ("("     . pdc/paredit-open-parenthesis)
        (")"     . paredit-close-round-and-newline)
        ("M-)"   . paredit-close-round)
        ("C-M-l" . paredit-recenter-on-sexp)
        ("C-M-s" . paredit-backward-up)
        ("M-I"   . paredit-splice-sexp)
        ("]"     . paredit-close-square-and-newline)
        ("}"     . paredit-close-curly-and-newline)
        (";"     . pdc/paredit-semicolon))

  :config
  (defun pdc/paredit-backward-delete ()
    (interactive)
    (if mark-active
        (call-interactively 'delete-region)
      (paredit-backward-delete)))

  (defun pdc/paredit-semicolon (&optional n)
    (interactive "P")
    (when (looking-at-p "  +\(")
      (search-forward "(")
      (backward-char))
    (cond ((and n (not (= 1 n)))
           (paredit-semicolon n))
          ((and (equal last-command this-command)
                (looking-back "; " 2))
           (undo)
           (self-insert-command 1))
          ((or (looking-back ";" 1)
               (and (looking-at-p "[[:blank:]]*$")
                    (not (save-excursion
                           (beginning-of-line)
                           (looking-at-p "[[:blank:]]*$")))))

           (self-insert-command (or n 1)))

          ((and (not mark-active)
                (looking-at-p "^[[:blank:]]*$"))
           (insert ";;; "))
          ((and (not mark-active)
                (save-excursion
                  (beginning-of-line)
                  (looking-at-p "[[:blank:]]*$")))
           (insert ";; "))
          (t (paredit-semicolon n))))

  (defun pdc/in-string-p ()
    (eq 'string (syntax-ppss-context (syntax-ppss))))

  (defun pdc/in-comment-p ()
    (eq 'comment (syntax-ppss-context (syntax-ppss))))

  (defun pdc/paredit-open-parenthesis (&optional n)
    (interactive "P")
    (cond ((and (looking-back "\(" 1)
                (looking-at "\)"))
           (paredit-open-parenthesis n))
          ((equal last-command this-command)
           (undo)
           (insert " ")
           (backward-char 1)
           (paredit-open-parenthesis n))
          ((and (not (or mark-active (pdc/in-string-p)))
                (looking-at-p "[\(a-z\"#\\[{]"))
           (mark-sexp)
           (paredit-open-parenthesis n)
           (when (looking-at-p "[\(\"#\\[{]")
             (save-excursion (insert " "))))
          (t (paredit-open-parenthesis n))))

  (defvar +paredit--post-close-keymap (make-sparse-keymap))
  (general-define-key :keymaps '+paredit--post-close-keymap
                      "SPC" (lambda () (interactive) (just-one-space -1))
                      "RET" (lambda () (interactive))
                      "DEL" (lambda ()
                              (interactive)
                              (delete-all-space t)))

  (defun pdc/enable-post-close-keymap ()
    (set-transient-map +paredit--post-close-keymap))

  (dolist (closer '(paredit-close-square-and-newline
                    paredit-close-round-and-newline
                    paredit-close-curly-and-newline
                    paredit-close-angled-and-newline))
    (advice-add closer :after 'pdc/enable-post-close-keymap))

  (defun +paredit-maybe-close-doublequote-and-newline (&optional n)
    (cond ((and (paredit-in-string-p)
                (eq (point) (- (paredit-enclosing-string-end) 1)))
           (forward-char)
           (let ((comment.point (paredit-find-comment-on-line)))
             (newline)
             (if comment.point
                 (save-excursion
                   (forward-line -1)
                   (end-of-line)
                   (indent-to (cdr comment.point))
                   (insert (car comment.point))))
             (lisp-indent-line)
             (paredit-ignore-sexp-errors (indent-sexp))
             (pdc/enable-post-close-keymap)
             t))
          (t nil)))

  (advice-add 'paredit-doublequote :before-until '+paredit-maybe-close-doublequote-and-newline)

  :preface
  (defun pdc/prioritise-paredit-bindings ()
    (push (assoc 'paredit-mode minor-mode-map-alist)
          minor-mode-overriding-map-alist))

  :hook
  (paredit-mode . pdc/prioritise-paredit-bindings)
                                        ; (paredit-mode . (lambda () (if (fboundp 'lispy-mode) (lispy-mode))))
  ((lisp-mode scheme-mode racket-mode emacs-lisp-mode) . enable-paredit-mode))
Emacs Lisp
Display evaluation results as overlays

eros-mode displays elisp evaluation results as an overlay, which is a little neater than the default behaviour.

(use-package eros
  :hook emacs-lisp-mode)
Macro expansion

We use macrostep to examine macro expansion in Emacs Lisp buffers.

(use-package macrostep
  :bind
  (:map emacs-lisp-mode-map
        :prefix "M-m ,"
        :prefix-map leader/mode/elisp-map
        :prefix-docstring "mode(elisp)"
        ("e" . macrostep-expand)))
Auto compilation

Let’s try compile-angel, which claims to be lighter and more comprehensive than auto-compile.

(use-package compile-angel
  :straight (compile-angel
             :type git
             :host github
             :repo "jamescherti/compile-angel.el")
  :config
  (compile-angel-on-save-mode t)
  (compile-angel-on-load-mode t))
Edit list

Experiment with M-x edit-list which apparently makes it easier to edit an Emacs Lisp list

(use-package edit-list
  :commands edit-list
  :config
  (with-eval-after-load 'embark
    (define-key embark-variable-map "l" 'edit-list)))
More cargo culted setup from sachac
(use-feature elisp-mode
  :bind
  (:map
   emacs-lisp-mode-map
   ("C-c C-d C-d" . describe-function)
   ("C-c C-d d" . describe-function)
   ("M-m , d" . describe-function)))

(use-package highlight-quoted
  :hook emacs-lisp-mode)

(use-package suggest :defer t)

(use-package ipretty
  :diminish ""
  :config (ipretty-mode 1))

;;; Bloody use-package's :bind-keymap doesn't play nicely with which-key
;;; TODO: Fix this
(use-package erefactor
  :diminish ""
  :bind-keymap
  ("M-m , r" . erefactor-map))

(use-package redshank
  :diminish redshank-mode
  :hook emacs-lisp-mode)
Edebug
(require 'eros)
(defun adviced:edebug-previous-result (_ &rest r)
  "Adviced `edebug-previous-result'."
  (eros--make-result-overlay edebug-previous-result
    :where (point)
    :duration eros-eval-result-duration))

(advice-add #'edebug-previous-result
            :around
            #'adviced:edebug-previous-result)

(defun adviced:edebug-compute-previous-result (_ &rest r)
  "Adviced `edebug-compte-previous-result."
  (let ((previous-value (nth 0 r)))
    (when edebug-unwrap-results
      (setq previous-value
            (edebug-unwrap* previous-value)))
    (setq edebug-previous-result
          (edebug-safe-prin1-to-string previous-value))))

(advice-add #'edebug-compute-previous-result
            :around
            #'adviced:edebug-compute-previous-result)
Sorting

Big old lists of custom settings, keybindings, etc are often best sorted as a way of spotting any duplicates, so let’s have a handy function for that.

(defun pdc/sort-sexps-in-region (beg end)
  "Can be handy for sorting out duplicates.
Sorts the sexps from BEG to END. Leaves point at where it
couldn't figure things out (eg: syntax errors)."
  (interactive "r")
  (let ((input (buffer-substring beg end))
        list last-point form result)
    (save-restriction
      (save-excursion
        (narrow-to-region beg end)
        (goto-char (point-min))
        (setq last-point (point-min))
        (setq form t)
        (while (and form (not (eobp)))
          (setq form (ignore-errors (read (current-buffer))))
          (when form
            (add-to-list
             'list
             (cons
              (prin1-to-string form)
              (buffer-substring last-point (point))))
            (setq last-point (point))))
        (setq list (sort list (lambda (a b) (string< (car a) (car b)))))
        (delete-region (point-min) (point))
        (insert (mapconcat
                 (lambda (c)
                   (replace-regexp-in-string "^\n\\|\n\\'" "" (cdr c)))
                 list "\n"))))))

(with-eval-after-load 'embark
  (bind-key "s" #'pdc/sort-sexps-in-region embark-region-map))
Auto insert

Emacs expects a certain amount of boilerplate in a .el file, so let’s auto generate it.

(use-feature autoinsert
  :hook (emacs-startup . auto-insert-mode)
  :config
  (add-to-list 'auto-insert-alist
               '(("\\.el\\'" . "Emacs Lisp header")
                 "Short description: "
                 ";;; " (file-name-nondirectory (buffer-file-name)) " --- " str
                 (make-string (max 2 (- 80 (current-column) 27)) ?\s)
                 "-*- lexical-binding: t; -*-" '(setq lexical-binding t)
                 "

;; First saved in " (format-time-string "%Y") " by  "
                 (getenv "ORGANIZATION") | (progn user-full-name) "


;; Author: " (user-full-name)
                 '(when (search-backward "&" (line-beginning-position) t)
                    (replace-match (capitalize (user-login-name)) t t))
                 '(end-of-line 1) " <" (progn user-mail-address) ">
"
                 "

\;;; Commentary:

\;; " _ "

\;;; Code:



\(provide '" (file-name-base (buffer-file-name)) ")
\;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n")))
Lisp Interaction mode
(defun my-lisp-interaction-mode-hook ()
  (setq mode-name "λ(eⁱ)"))

(add-hook 'lisp-interaction-mode-hook #'my-lisp-interaction-mode-hook)
Easy Escape

Let’s try easy-escape to make regular expressions and such look nicer in lisp modes.

(use-package easy-escape
  :defer nil
  :diminish easy-escape-minor-mode
  :hook ((lisp-mode emacs-lisp-mode) . 'easy-escape-minor-mode))

Haskell

I don’t use Haskell much, but I do use it occasionally. I should work out how I really like it configured, but for now I just use it.

(use-package haskell-mode
  :init
  (rename-modeline haskell-mode "λ(>>=)"))

JavaBloodyScript

There’s no avoiding it, I fear, but there you go.

(use-package js2-mode
  :mode "\\.jsx?\\'"
  :init
  (rename-modeline js2-mode "JS2")
  :magic
  ("#!/usr/bin/env node" . js2-mode)
  ("#!/usr/bin/env bun" . js2-mode)
  :custom
  (js2-mode-show-strict-warnings nil)
  (js-indent-level 2))

Web Mode

The web-mode package aims to cope with all the HTML templating tools. I’m not sure if it really works well, but again, one has to start somewhere.

(use-package web-mode
  :mode
  "\\.\\(html?\\|ejs\\|tsx\\|jsx\\|s?css\\|go\\(html\\|tmpl\\)\\)\\'"
  :hook ((web-mode . turn-on-font-lock)
         (web-mode . visual-line-mode))
  :preface
  (require 'regexp-opt)
  :custom
  (web-mode-engines-alist
   `(("go" . "\\(/layouts/.*\\.\\(html?\\|json\\|xml\\|jfw\\)\\|\\.go\\(html?\\|tmpl\\)\\)\\|\\`\\*Org Src.*\\[ \\(html\\|json\\|xml\\) \\]\\*\\'")
     ("template-toolkit" . "\\.tt3?\\'")
     ("erb" . ,(concat
                (regexp-opt '(".erb" ".rhtml" ".ejs"))
                "\\'"))))
  (web-mode-content-types-alist
   `(("css" . "\\`\\*Org Src.*\\[ \\(s?css\\|css\\.erb\\) \\]\\*\\'")
     ("json" . "\\`\\*Org Src.*\\[ \\(api\\|json\\jsonld\\) \\]\\*\\'")
     ("jsx" . "\\`\\*Org Src.*\\[ [j t]sx \\]\\*\\'")
     ("javascript" . "\\`\\*Org Src.*\\[ javascript \\]\\*\\'")
     ("typescript" . "\\`\\*Org Src.*\\[ typescript \\]\\*\\'")))
  (web-mode-indent-style 2)
  (web-mode-code-indent-offset 2)
  (web-mode-markup-indent-offset 2)
  (web-mode-attribute-indent-offset 2)
  :init
  (with-eval-after-load 'org
    (setf (alist-get "html" org-src-lang-modes nil t 'equal)
          'web))

  :config
  (dolist (mode '(html-ts-mode mhtml-mode css-mode css-ts-mode json-mode json-ts-mode scss-mode scss-ts-mode))
    (rassq-delete-all mode auto-mode-alist)))

SQLite

(use-package sqlite-mode
  :commands sqlite-mode-open-file
  :init
  (defun +sqlite-view-file-magically ()
    "Runs `sqlite-mode-open-file' on the file name visited by the current buffer, killing it."
    (require 'sqlite-mode)
    (let ((file-name buffer-file-name))
      (kill-current-buffer)
      (sqlite-mode-open-file file-name)))
  :magic ("SQLite format 3\x00" . +sqlite-view-file-magically))

(use-package emacsql)
(use-package emacsql-sqlite3)

Fiddling with webservices

It’s to useful be to able talk to webservices without necessarily having to shell out to (the admittedly marvellous) curl.

(use-package restclient
  :mode
  "\\`\\*restclient\\*\\'"
  :straight (:type git :host github
                   :repo "pashky/restclient.el"
                   :fork (:host github
                                :repo "pdcawley/restclient.el")))

(use-package ob-restclient
  :after org
  :straight
  (:type git :host github
   :repo "alf/ob-restclient.el"
   :fork (:host github
          :repo "pdcawley/ob-restclient.el")))

Web stuff

Using the Wayback Machine

I’ve discovered that I fucked up about a decade ago when moving from Typo/Publify to my current Hugo based blog and truncated a bunch of posts. Also, I lost the comments. The first step to recovering from that where possible is to fetch “complete” posts from the Internet Archive’s Wayback Machine. I was doing things in a fairly ad hoc fashion, but I’ve reached the point where I want an API to work with.

Let’s make a wayback.el library for that stuff because I might want to publish it, or use it in emacs scripts.

;;; wayback.el --- Work with the Wayback Machine     -*- lexical-binding: t; -*-

;; First saved in 2025 by  Piers Cawley


;; Author: Piers Cawley <pdcawley@Studio-Mini.local>


;;; Commentary:

;; Interacts with the Wayback machine to fetch versions from specific dates,
;; using the CDX api to find appropriate targets.

;;; Code:
;;; Load up modules we need
<<wayback-requirements>>
;;; And here's the actual code
<<wayback-body>>

(provide 'wayback)
;;; wayback.el ends here

And make sure we load it in init.el

(require 'wayback)

Requirements

Request

Emacs has a built in library to fetch URLs, but it makes my head hurt to use it. The request package has an interface I prefer and uses curl to actually do the HTTP stuff, which I’m very much in favour of.

(use-package request
  :autoload (request))
s.el

I try to avoid s.el, but s-lex-format is too damned useful

(use-package s
  :autoload (s-lex-format))

Implementation

(defvar wayback-cdx-endpoint "https://web.archive.org/cdx/search/cdx"
  "The endpoint for the Wayback Machine's CDX server.")

(defvar wayback-cdx-json-parser
  (apply-partially 'json-parse-buffer :array-type 'list)
  "Parser for json data returned from the CDX server.")

(defun wayback-get-capture-before (url date)
  "Use the CDX applet to find any version of URL captured before DATE string.
Returns nil if there's no such capture"
  (let ((capture-url nil))
    (request wayback-cdx-endpoint
      :params `((url . ,url)
                (to . ,(if (or (numberp date)
                               (stringp date))
                           date
                         (format-time-string "%Y%m%d%H%M%S" date)))
                (collapse . digest)
                (output . json)
                (fl . "timestamp,original")
                (limit . -1))
      :parser wayback-cdx-json-parser
      :sync t
      :success (cl-function
                (lambda (&key data &allow-other-keys)
                  (setq capture-url
                        (pcase (cadr data)
                          (`() nil)
                          (`(,timestamp ,target-url)
                           (s-lex-format "https://web.archive.org/web/${timestamp}/${target-url}")))))))
    capture-url))

(defmacro wayback-with-page-from-before (url date &rest body)
  (declare (indent 2) (debug t))
  (let ((capture-url (make-symbol "capture-url")))
    `(when-let* ((,capture-url (wayback-get-capture-before ,url ,date)))
       (with-temp-buffer
         (request ,capture-url
           :sync t
           :success (cl-function
                     (lambda (&key data &allow-other-keys)
                       (insert data))))
         ,@body))))
(defalias 'with-wayback-page-from-before 'wayback-with-page-from-before)

Personal Knowledge Management

I’m not entirely convinced I’ll use this, but it’s probably worth at least trying to get better at note taking and such.

Social Media etc

Mastodon

Looks like mastodon.el got some love from a terminal user or two, so it’s working a bit better now.

(use-package mastodon
  :straight
  (:source melpa)
  :hook
  (mastodon-toot-mode . visual-fill-column-mode)
  :general
  (pdcmacs-app-def "m" 'mastodon)
  (pdcmacs-app-def
    :infix "M"
    "" '(:wk "mastodon")
    "h" '(mastodon-tl--get-home-timeline :wk "Home")
    "@" '(mastodon-notifications--get-mentions :wk "Mentions")
    "t" 'mastodon-toot)

  :init
  (setq-default mastodon-toot--language "en")
  (setq mastodon-instance-url "https://mendeddrum.org"
        mastodon-active-user "pdcawley"
        mastodon-tl--display-media-p window-system
        mastodon-tl--enable-proportional-fonts window-system)
  :config
  (defun ad-mastodon-toot--restore-previous-window-config (window-config)
    (car window-config))
  (advice-add 'mastodon-toot--restore-previous-window-config :before-until 'ad-mastodon-toot--restore-previous-window-config)

  (advice-add 'mastodon-toot--format-attachments
              :before-until #'(lambda () (fboundp 'image-transforms-p)))
  (mastodon-discover))

NewsFeeds

I miss RSS. Let’s attempt to get back on that horse with elfeed.

(use-package elfeed
  :bind (:map elfeed-show-mode-map
              ([remap scroll-up-command] . +elfeed-scroll-up-cmd)
              ([remap scroll-down-command] . +elfeed-scroll-down-cmd))
  :init
  (defun +elfeed-scroll-up-cmd (&optional arg)
    "Scroll up or go to next feed item in Elfeed."
    (interactive "^P")
    (let ((scroll-error-top-bottom nil))
      (condition-case-unless-debug nil
          (scroll-up-command arg)
        (error (elfeed-show-next)))))
  (defun +elfeed-scroll-down-cmd (&optional arg)
    "Scroll down or got to previous feed item in Elfeed."
    (interactive "^P")
    (let ((scroll-error-top-bottom nil))
      (condition-case-unless-debug nil
          (scroll-down-command arg)
        (error (elfeed-show-prev))))))

;; (use-package elfeed-goodies
;;   :after elfeed
;;   :custom
;;   (elfeed-goodies/entry-pane-size 0.5)
;;   :init
;;   (elfeed-goodies/setup))

Load extra configuration and customizations

The pre-literate version of this file separated initialization into init.el and config.el file, so we need to load config.el and then any customizations. However, eventually, the plan is to eliminate config.el entirely.

(load pdcmacs-config-file :no-error-if-file-is-missing)
(load custom-file :no-error-if-file-is-missing)

And load our support modules. I’ll be pulling these into here too and either tangling them into init.el or leaving into their own module files. Decision for later.

About

Emacs configuration

Resources

Stars

Watchers

Forks

Releases

No releases published

Packages

No packages published