I DECLARE BANKRUPTCY ... 8

Didn't think to do this till pretty .. written, so here we are.

1 files changed, 36 insertions, 859 deletions

@@ -1,869 +1,46 @@
-;;; acdw.el --- miscellaneous    -*- lexical-binding: t; coding: utf-8-unix -*-
-
-;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
-;; Created: Sometime during Covid-19, 2020
-;; Keywords: configuration
-;; URL: https://tildegit.org/acdw/emacs
-
-;; This file is NOT part of GNU Emacs.
-
-;;; License:
-;; Everyone is permitted to do whatever with this software, without
-;; limitation.  This software comes without any warranty whatsoever,
-;; but with two pieces of advice:
-;; - Don't hurt yourself.
-;; - Make good choices.
+;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*-
 
 ;;; Commentary:
-;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life
-;; functions for me, acdw.
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'auth-source)
-(require 'recentf)
-
-;;; Variables
-
-(defconst acdw/system
-  (pcase system-type
-    ('gnu/linux :home)
-    ((or 'msdos 'windows-nt) :work)
-    (_ :other))
-  "Which computer system is currently being used.")
-
-(defmacro acdw/system (&rest args)
-  "Macro for interfacing, depending on ARGS, with symbol `acdw/system'.
-
-When called without arguments, it returns symbol `acdw/system'.  When
-called with one (symbol) argument, it returns (eq acdw/system
-ARG).  When called with multiple arguments or a list, it returns
-`pcase' over each argument."
-  (cond
-   ((null args) acdw/system)
-   ((atom (car args))
-    `(when (eq acdw/system ,(car args))
-       ,(car args)))
-   (t
-    `(pcase acdw/system
-       ,@args))))
-
-
-;;; Utility functions
-;; I don't prefix these because ... reasons.  Honestly I probably should prefix
-;; them.
-
-(defun truncate-string (len str &optional ellipsis)
-  "If STR is longer than LEN, cut it down and add ELLIPSIS to the end.
-When not specified, ELLIPSIS defaults to '...'."
-  (declare (pure t) (side-effect-free t))
-  (unless ellipsis
-    (setq ellipsis "..."))
-  (if (> (length str) len)
-      (format "%s%s" (substring str 0 (- len (length ellipsis))) ellipsis)
-    str))
-
-;; Why isn't this a thing???
-(defmacro fbound-and-true-p (func)
-  "Return the value of function FUNC if it is bound, else nil."
-  `(and (fboundp ,func) ,func))
-
-(defmacro when-unfocused (name &rest forms)
-  "Define a function NAME, executing FORMS, for when Emacs is unfocused."
-  (declare (indent 1))
-  (let ((func-name (intern (concat "when-unfocused-" (symbol-name name)))))
-    `(progn
-       (defun ,func-name () "Defined by `when-unfocused'."
-              (when (seq-every-p #'null
-                                 (mapcar #'frame-focus-state (frame-list)))
-                ,@forms))
-       (add-function :after after-focus-change-function #',func-name))))
-
-(defmacro with-eval-after-loads (features &rest body)
-  "Execute BODY after FEATURES are loaded.
-This macro simplifies `with-eval-after-load' for multiple nested
-features."
-  (declare (indent 1)
-           (debug (form def-body)))
-  (unless (listp features)
-    (setq features (list features)))
-  (if (null features)
-      (macroexp-progn body)
-    (let* ((this (car features))
-           (rest (cdr features)))
-      `(with-eval-after-load ',this
-         (with-eval-after-loads ,rest ,@body)))))
-
-(defmacro with-message (message &rest body)
-  "Execute BODY, messaging 'MESSAGE...' before and 'MESSAGE... Done.' after."
-  (declare (indent 1))
-  ;; Wrap a progn inside a prog1 to return the return value of the body.
-  `(prog1
-       (progn (message "%s..." ,message)
-              ,@body)
-     (message "%s... Done." ,message)))
-
-(defun clone-buffer-write-file (filename &optional confirm)
-  "Clone current buffer to a file named FILENAME and switch.
-FILENAME and CONFIRM are passed directly to `write-file'."
-  (interactive                          ; stolen from `write-file'
-   (list (if buffer-file-name
-             (read-file-name "Write file: "
-                             nil nil nil nil)
-           (read-file-name "Write file: " default-directory
-                           (expand-file-name
-                            (file-name-nondirectory (buffer-name))
-                            default-directory)
-                           nil nil))
-         (not current-prefix-arg)))
-  (let ((buf (clone-buffer nil nil)))
-    (with-current-buffer buf
-      (write-file filename confirm))
-    (switch-to-buffer buf)))
-
-;; https://old.reddit.com/r/emacs/comments/pjwkts
-(defun acdw/goto-last-row ()
-  "Move point to last row of buffer, but save the column."
-  (interactive)
-  (let ((col (current-column)))
-    (goto-char (point-max))
-    (move-to-column col t)))
-
-(defun acdw/goto-first-row ()
-  "Move point to first row of buffer, but save the column."
-  (interactive)
-  (let ((col (current-column)))
-    (goto-char (point-min))
-    (move-to-column col t)))
-
-(defun dos2unix (buffer)
-  "Replace \r\n with \n in BUFFER."
-  (interactive "*b")
-  (save-excursion
-    (with-current-buffer buffer
-      (goto-char (point-min))
-      (while (search-forward (string ?\C-m ?\C-j) nil t)
-        (replace-match (string ?\C-j) nil t)))))
-
-(defun expand-file-name-exists-p (&rest args)
-  "Return `expand-file-name' ARGS if it exists, or nil."
-  (let ((file (apply #'expand-file-name args)))
-    (if (file-exists-p file)
-        file
-      nil)))
-
-(defun kill-region-or-backward-word (arg)
-  "If region is active, kill; otherwise kill word backward with ARG."
-  (interactive "p")
-  (if (region-active-p)
-      (kill-region (region-beginning) (region-end))
-    (if (bound-and-true-p paredit-mode)
-        (paredit-backward-kill-word)
-      (backward-kill-word arg))))
-
-(defun unfill-buffer (&optional buffer-or-name)
-  "Unfill entire contents of BUFFER-OR-NAME."
-  (with-current-buffer (or buffer-or-name (current-buffer))
-    (save-excursion
-      (save-restriction
-        (unfill-region (point-min) (point-max))))))
-
-(defun waterfall-list (car list rest)
-  "Cons CAR with each element in LIST in a waterfall fashion, end with REST.
-For use with the `with-eval-after-loads' function."
-  (cond ((atom list) `(,car ',list ,@rest))
-        ((= 1 (length list)) `(,car ',(car list) ,@rest))
-        (t
-         `(,car ',(car list)
-                ,(waterfall-list car (cdr list) rest)))))
-
-
-;;; Comment-or-uncomment-sexp
-;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
-
-(defun uncomment-sexp (&optional n)
-  "Uncomment N sexps around point."
-  (interactive "P")
-  (let* ((initial-point (point-marker))
-         (inhibit-field-text-motion t)
-         (p)
-         (end (save-excursion
-                (when (elt (syntax-ppss) 4)
-                  (re-search-backward comment-start-skip
-                                      (line-beginning-position)
-                                      t))
-                (setq p (point-marker))
-                (comment-forward (point-max))
-                (point-marker)))
-         (beg (save-excursion
-                (forward-line 0)
-                (while (and (not (bobp))
-                            (= end (save-excursion
-                                     (comment-forward (point-max))
-                                     (point))))
-                  (forward-line -1))
-                (goto-char (line-end-position))
-                (re-search-backward comment-start-skip
-                                    (line-beginning-position)
-                                    t)
-                (ignore-errors
-                  (while (looking-at-p comment-start-skip)
-                    (forward-char -1)))
-                (point-marker))))
-    (unless (= beg end)
-      (uncomment-region beg end)
-      (goto-char p)
-      ;; Indentify the "top-level" sexp inside the comment.
-      (while (and (ignore-errors (backward-up-list) t)
-                  (>= (point) beg))
-        (skip-chars-backward (rx (syntax expression-prefix)))
-        (setq p (point-marker)))
-      ;; Re-comment everything before it.
-      (ignore-errors
-        (comment-region beg p))
-      ;; And everything after it.
-      (goto-char p)
-      (forward-sexp (or n 1))
-      (skip-chars-forward "\r\n[:blank:]")
-      (if (< (point) end)
-          (ignore-errors
-            (comment-region (point) end))
-        ;; If this is a closing delimiter, pull it up.
-        (goto-char end)
-        (skip-chars-forward "\r\n[:blank:]")
-        (when (eq 5 (car (syntax-after (point))))
-          (delete-indentation))))
-    ;; Without a prefix, it's more useful to leave point where
-    ;; it was.
-    (unless n
-      (goto-char initial-point))))
-
-(defun comment-sexp--raw ()
-  "Comment the sexp at point or ahead of point."
-  (pcase (or (bounds-of-thing-at-point 'sexp)
-             (save-excursion
-               (skip-chars-forward "\r\n[:blank:]")
-               (bounds-of-thing-at-point 'sexp)))
-    (`(,l . ,r)
-     (goto-char r)
-     (skip-chars-forward "\r\n[:blank:]")
-     (save-excursion
-       (comment-region l r))
-     (skip-chars-forward "\r\n[:blank:]"))))
-
-(defun comment-or-uncomment-sexp (&optional n)
-  "Comment the sexp at point and move past it.
-If already inside (or before) a comment, uncomment instead.
-With a prefix argument N, (un)comment that many sexps."
-  (interactive "P")
-  (if (or (elt (syntax-ppss) 4)
-          (< (save-excursion
-               (skip-chars-forward "\r\n[:blank:]")
-               (point))
-             (save-excursion
-               (comment-forward 1)
-               (point))))
-      (uncomment-sexp n)
-    (dotimes (_ (or n 1))
-      (comment-sexp--raw))))
-
-
-;;; Sort sexps
-;; from https://github.com/alphapapa/unpackaged.el#sort-sexps
-;; and https://github.com/alphapapa/unpackaged.el/issues/20
-
-(defun sort-sexps (beg end &optional key-fn sort-fn)
-  "Sort sexps between BEG and END.
-Comments stay with the code below.
-
-Optional argument KEY-FN will determine where in each sexp to
-start sorting.  e.g. (lambda (sexp) (symbol-name (car sexp)))
-
-Optional argument SORT-FN will determine how to sort two sexps'
-strings.  It's passed to `sort'.  By default, it sorts the sexps
-with `string<' starting with the key determined by KEY-FN."
-  (interactive "r")
-  (cl-flet ((skip-whitespace () (while (looking-at (rx (1+ (or space "\n"))))
-                                  (goto-char (match-end 0))))
-            (skip-both () (while (cond ((or (nth 4 (syntax-ppss))
-                                            (ignore-errors
-                                              (save-excursion
-                                                (forward-char 1)
-                                                (nth 4 (syntax-ppss)))))
-                                        (forward-line 1))
-                                       ((looking-at (rx (1+ (or space "\n"))))
-                                        (goto-char (match-end 0)))))))
-    (save-excursion
-      (save-restriction
-        (narrow-to-region beg end)
-        (goto-char beg)
-        (skip-both)
-        (cl-destructuring-bind (sexps markers)
-            (cl-loop do (skip-whitespace)
-                     for start = (point-marker)
-                     for sexp = (ignore-errors
-                                  (read (current-buffer)))
-                     for end = (point-marker)
-                     while sexp
-                     ;; Collect the real string, then one used for sorting.
-                     collect (cons (buffer-substring (marker-position start)
-                                                     (marker-position end))
-                                   (save-excursion
-                                     (goto-char (marker-position start))
-                                     (skip-both)
-                                     (if key-fn
-                                         (funcall key-fn sexp)
-                                       (buffer-substring
-                                        (point)
-                                        (marker-position end)))))
-                     into sexps
-                     collect (cons start end)
-                     into markers
-                     finally return (list sexps markers))
-          (setq sexps (sort sexps (if sort-fn sort-fn
-                                    (lambda (a b)
-                                      (string< (cdr a) (cdr b))))))
-          (cl-loop for (real . sort) in sexps
-                   for (start . end) in markers
-                   do (progn
-                        (goto-char (marker-position start))
-                        (insert-before-markers real)
-                        (delete-region (point) (marker-position end)))))))))
-
-(defun acdw/sort-setups ()
-  "Sort `setup' forms in the current buffer.
-Actually sorts all forms, but based on the logic of `setup'.
-In short, DO NOT USE THIS FUNCTION!!!"
-  (save-excursion
-    (sort-sexps
-     (point-min) (point-max)
-     ;; Key function
-     nil
-     ;; Sort function
-     (lambda (s1 s2)                  ; oh god, this is worse.
-       (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves
-              (require-regexp (rx bos (* nonl) ":require"))
-              (straight-regexp (rx bos (* nonl) ":straight"))
-              (s1-require (string-match require-regexp s1))
-              (s2-require (string-match require-regexp s2))
-              (s1-straight (string-match straight-regexp s1))
-              (s2-straight (string-match straight-regexp s2)))
-         (cond
-          ;; Straight forms require some weirdness
-          ((and s1-straight s2-straight)
-           (let* ((r (rx ":straight" (? "-when") (* space) (? "(")))
-                  (s1 (replace-regexp-in-string r "" s1))
-                  (s2 (replace-regexp-in-string r "" s2)))
-             (string< s1 s2)))
-          ;; requires should go first
-          ((and s1-require (not s2-require)) t)
-          ((and (not s1-require) s2-require) nil)
-          ;; straights should go last
-          ((and s1-straight (not s2-straight)) nil)
-          ((and (not s1-straight) s2-straight) t)
-          ;; else, just sort em.
-          (t (string< s1 s2))))))))
-
-
-;;; Emacs configuration functions
-
-(defun emacs-git-pull-config (&optional remote branch)
-  "`git-pull' Emacs' configuration from REMOTE and BRANCH.
-REMOTE defaults to 'origin', BRANCH to 'main'."
-  (let ((remote (or remote "origin"))
-        (branch (or branch "main")))
-    (with-message (format "Pulling Emacs's configuration from %s" branch)
-      (shell-command (concat "git -C "
-                             "\"" (expand-file-name user-emacs-directory) "\""
-                             " pull " remote " " branch)
-                     (get-buffer-create "*emacs-git-pull-config-output*")
-                     (get-buffer-create "*emacs-git-pull-config-error*")))))
-
-(defun emacs-reload (&optional git-pull-first)
-  "Reload Emacs's configuration files.
-With a prefix argument GIT-PULL-FIRST, run git pull on the repo
-first."
-  (interactive "P")
-  (when git-pull-first
-    (emacs-git-pull-config))
-  (let ((init-files (append
-                     ;; Load lisp libraries first, in case their functionality
-                     ;; is used by {early-,}init.el
-                     (let* ((dir (expand-file-name "lisp/"
-                                                   user-emacs-directory))
-                            (full-name (lambda (f)
-                                         (concat
-                                          (file-name-as-directory dir) f))))
-                       (mapcar full-name (directory-files dir nil "\\.el\\'")))
-                     ;; Load regular init files
-                     (list (locate-user-emacs-file "early-init.el")
-                           (locate-user-emacs-file "init.el" ".emacs"))))
-        (debug-on-error t))
-    (with-message "Saving init files"
-      (save-some-buffers :no-confirm (lambda () (member (buffer-file-name)
-                                                        init-files))))
-    (dolist (file init-files)
-      (with-message (format "Loading %s" file)
-        (when (file-exists-p file)
-          (load-file file))))))
-
-
-;;; Specialized functions
-
-(defun acdw/copy-region-plain (beg end)
-  "Copy a region from BEG to END to clipboard, removing all Org formatting."
-  (interactive "r")
-  (let ((s (buffer-substring-no-properties beg end))
-        (extracted-heading (when (derived-mode-p 'org-mode)
-                             (acdw/org-extract-heading-text))))
-    (with-temp-buffer
-      (insert s)
-      (let ((sentence-end-double-space nil))
-        ;; Remove org stuff
-        (when extracted-heading         ; Replace org heading with plaintext
-          (goto-char (point-min))
-          (kill-line)
-          (insert extracted-heading))
-        ;; Delete property drawers
-        (replace-regexp org-property-drawer-re "")
-        ;; Delete logbook drawers
-        (replace-regexp org-logbook-drawer-re "")
-        ;; Replace list items with their contents, paragraphed
-        (replace-regexp org-list-full-item-re "
-\4")
-        ;; Delete comment lines
-        (replace-regexp (concat org-comment-regexp ".*$") "")
-        ;; Re-fill text for clipboard
-        (unfill-region (point-min) (point-max))
-        (flush-lines "^$" (point-min) (point-max)))
-      ;; Copy buffer
-      (copy-region-as-kill (point-min) (point-max))))
-  (when (called-interactively-p 'interactive)
-    (indicate-copied-region))
-  (setq deactivate-mark t)
-  nil)
 
-;; https://emacs.stackexchange.com/questions/36366/
-(defun html-body-id-filter (output backend info)
-  "Remove random ID attributes generated by Org."
-  (when (eq backend 'html)
-    (replace-regexp-in-string
-     " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\""
-     ""
-     output t)))
+;; What's that saying about how the hardest things in computer science
+;; are naming and off-by-one errors?  Well, the naming one I know very
+;; well.  I've been trying to figure out a good way to prefix my
+;; bespoke functions, other stuff I found online, and various emacs
+;; lisp detritus for quite some time (I reckon at over a year, as of
+;; 2021-11-02).  Finally, I found the answer in the writings of Daniel
+;; Mendler: I'll prefix everything with a `+' !
 
-(defun html-body-div-filter (output backend info)
-  "Remove wrapping divs generated by Org."
-  (when (eq backend 'html)
-    (replace-regexp-in-string
-     "</?div[^>]*>\n*" ""
-     output t)))
+;; To that end, pretty much everything in lisp/ will have a filename
+;; like "+org.el", except of course this file, and maybe a few
+;; /actually original/ libraries I haven't had the wherewithal to
+;; package out properly yet.
 
-(defun org-demote-headings (backend)
-  (while (/= (point) (point-max))
-    (org-next-visible-heading 1)
-    (org-demote-subtree)))
+;; Is it perfect?  No.  Is it fine?  Yes.  Here it is.
 
-(defun acdw/org-export-copy-html ()
-  "Copy a tree as HTML."
-  (interactive)
-  (require 'ox-html)
-  (org-export-with-buffer-copy
-   ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t)
-   (let ((extracted-heading (acdw/org-extract-heading-text))
-         (org-export-show-temporary-export-buffer nil)
-         (org-export-filter-final-output-functions
-          '(html-body-id-filter html-body-div-filter)))
-     (insert "* ORG IS STUPID SOMETIMES\n")
-     (goto-char (point-min))
-     (org-html-export-as-html nil t nil t
-                              (list :with-smart-quotes nil
-                                    :with-special-strings t))
-     (with-current-buffer "*Org HTML Export*"
-       (goto-char (point-min))
-       (replace-regexp "<h2>.*</h2>" "")
-       (insert "<h2>" extracted-heading "</h2>")
-       (flush-lines "^$" (point-min) (point-max))
-       (let ((sentence-end-double-space nil))
-         (unfill-region (point-min) (point-max)))
-       (replace-regexp "<h" "\n<h" nil (1+ (point-min)) (point-max))
-       (replace-regexp "<p" "\n<p" nil (point-min) (point-max))
-       (replace-regexp "<p> +" "<p>" nil (point-min) (point-max))
-       (replace-regexp " +</p>" "</p>" nil (point-min) (point-max))
-       (copy-region-as-kill (point-min) (point-max)))))
-  (when (called-interactively-p 'interactive)
-    (indicate-copied-region))
-  (setq deactivate-mark t)
-  nil)
-
-(defun acdw/org-export-copy ()
-  "Copy a tree as ASCII."
-  (interactive)
-  (require 'ox-ascii)
-  (let ((extracted-heading (acdw/org-extract-heading-text)))
-    ;; Export to ASCII - not async, subtree only, visible-only, body-only
-    (let ((org-export-show-temporary-export-buffer nil))
-      (org-ascii-export-as-ascii nil t nil t
-                                 (list :with-smart-quotes t
-                                       :with-special-strings t)))
-    (with-current-buffer "*Org ASCII Export*"
-      (goto-char (point-min))
-      (insert extracted-heading)
-      (newline 2)
-
-      (replace-regexp org-list-full-item-re "\n\4")
-      
-      (let ((sentence-end-double-space nil))
-        (unfill-region (point-min) (point-max)))
-      (flush-lines "^$" (point-min) (point-max))
-      
-      (copy-region-as-kill (point-min) (point-max)))
-
-    (when (called-interactively-p 'interactive)
-      (indicate-copied-region))
-    (setq deactivate-mark t)
-    nil))
-
-(defun acdw/org-extract-heading-text ()
-  "Extract the heading text from an `org-mode' heading."
-  (let ((heading (org-no-properties (org-get-heading t t t t))))
-    (message
-     (replace-regexp-in-string org-link-bracket-re
-                               (lambda (match)
-                                 (match-string-no-properties 2 match))
-                               heading))))
-
-(defun acdw/sync-dir (&optional file make-directory)
-  "Return FILE from ~/Sync.
-Optional argument MAKE-DIRECTORY makes the directory.
-Logic is as in `acdw/dir', which see."
-  (let ((dir (expand-file-name (convert-standard-filename "~/Sync/"))))
-    (if file
-        (let ((file-name (expand-file-name (convert-standard-filename file)
-                                           dir)))
-          (when make-directory
-            (make-directory (file-name-directory file-name) 'parents))
-          file-name)
-      dir)))
-
-(defun acdw/dir (&optional file make-directory)
-  "Place Emacs files in one place.
-
-If called without parameters, `acdw/dir' expands to
-~/.emacs.d/var or similar.  If called with FILE, `acdw/dir'
-expands FILE to ~/.emacs.d/var, optionally making its directory
-if MAKE-DIRECTORY is non-nil."
-  (let ((dir (expand-file-name (convert-standard-filename "var/")
-                               user-emacs-directory)))
-    (if file
-        (let ((file-name (expand-file-name (convert-standard-filename file)
-                                           dir)))
-          (when make-directory
-            (make-directory (file-name-directory file-name) 'parents))
-          file-name)
-      dir)))
-
-(defun acdw/find-emacs-source () ;; doesn't work right now
-  "Find where Emacs' source tree is."
-  (acdw/system
-   (:work (expand-file-name
-           (concat "~/src/emacs-" emacs-version "/src")))
-   (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src"))
-   (:other nil)))
-
-(defun acdw/gc-disable ()
-  "Functionally disable the Garbage collector."
-  (setq gc-cons-threshold most-positive-fixnum
-        gc-cons-percentage 0.8))
-
-(defun acdw/gc-enable ()
-  "Enable the Garbage collector."
-  (setq gc-cons-threshold (* 800 1024 1024)
-        gc-cons-percentage 0.1))
-
-(defun acdw/insert-iso-date (arg)
-  "Insert the ISO-8601-formatted date, optionally including time (pass ARG)."
-  (interactive "P")
-  (let ((format (if arg "%FT%T%z" "%F")))
-    (insert (format-time-string format (current-time)))))
-
-(defun acdw/kill-a-buffer (&optional prefix)
-  "Kill this buffer, or other buffers, depending on PREFIX.
-
-\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window
-\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window
-\\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows
-
-Prompt only if there are unsaved changes."
-  (interactive "P")
-  (pcase (or (car prefix) 0)
-    (0  (kill-current-buffer)
-        (unless (one-window-p) (delete-window)))
-    (4  (other-window 1)
-        (kill-current-buffer)
-        (unless (one-window-p) (delete-window)))
-    (16 (mapc 'kill-buffer (delq (current-buffer) (buffer-list)))
-        (delete-other-windows))))
-
-(defun acdw/sunrise-sunset (sunrise-command sunset-command)
-  "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset."
-  (let* ((times-regex (rx (* nonl)
-                          (: (any ?s ?S) "unrise") " "
-                          (group (repeat 1 2 digit) ":"
-                                 (repeat 1 2 digit)
-                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
-                          (* nonl)
-                          (: (any ?s ?S) "unset") " "
-                          (group (repeat 1 2 digit) ":"
-                                 (repeat 1 2 digit)
-                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
-                          (* nonl)))
-         (ss (acdw/supress-messages #'sunrise-sunset))
-         (_m (string-match times-regex ss))
-         (sunrise-time (match-string 1 ss))
-         (sunset-time (match-string 2 ss)))
-    (run-at-time sunrise-time (* 60 60 24) sunrise-command)
-    (run-at-time sunset-time (* 60 60 24) sunset-command)
-    (run-at-time "12:00am" (* 60 60 24) sunset-command)))
-
-(defun acdw/supress-messages (oldfn &rest args) ; from pkal
-  "Advice wrapper for suppressing `message'.
-OLDFN is the wrapped function, that is passed the arguments
-ARGS."
-  (let ((msg (current-message)))
-    (prog1
-        (let ((inhibit-message t))
-          (apply oldfn args))
-      (when msg
-        (message "%s" msg)))))
-
-(defun acdw/setup-fringes ()
-  "Set up fringes how I likes 'em."
-  (define-fringe-bitmap 'left-curly-arrow
-    [#b01100000
-     #b00110000
-     #b00011000
-     #b00001100]
-    4 8 'center)
-  (define-fringe-bitmap 'right-curly-arrow
-    [#b00000011
-     #b00000110
-     #b00001100
-     #b00011000]
-    4 8 'center)
-  (define-fringe-bitmap 'left-arrow
-    [#b01100000
-     #b01010000]
-    2 8 '(top t))
-  (define-fringe-bitmap 'right-arrow
-    [#b00000011
-     #b00000101]
-    2 8 '(top t))
-  (setq-local indicate-empty-lines nil
-              indicate-buffer-boundaries '((top . right)
-                                           (bottom . right)))
-  (custom-set-faces '(fringe
-                      ((t (:foreground "dim gray"))))))
-
-
-;;; Recentf renaming with dired
-;; from ... somewhere.  'rjs', apparently?
-;; I'm throwing these here because they look better here than in init.el.
-;; Comments are "rjs"'s.
-
-;; Magic advice to rename entries in recentf when moving files in
-;; dired.
-(defun rjs/recentf-rename-notify (oldname newname &rest _args)
-  "Magically rename files from OLDNAME to NEWNAME when moved in `dired'."
-  (if (file-directory-p newname)
-      (rjs/recentf-rename-directory oldname newname)
-    (rjs/recentf-rename-file oldname newname)))
-
-(defun rjs/recentf-rename-file (oldname newname)
-  "Rename a file from OLDNAME to NEWNAME in `recentf-list'."
-  (setq recentf-list
-        (mapcar (lambda (name)
-                  (if (string-equal name oldname)
-                      newname
-                    oldname))
-                recentf-list)))
-
-(defun rjs/recentf-rename-directory (oldname newname)
-  "Rename directory from OLDNAME to NEWNAME in `recentf-list'."
-  ;; oldname, newname and all entries of recentf-list should already
-  ;; be absolute and normalised so I think this can just test whether
-  ;; oldname is a prefix of the element.
-  (setq recentf-list
-        (mapcar (lambda (name)
-                  (if (string-prefix-p oldname name)
-                      (concat newname (substring name (length oldname)))
-                    name))
-                recentf-list)))
-
-
-;;; Sort setq...
-;; https://emacs.stackexchange.com/questions/33039/
-
-(defun sort-setq ()
-  "Sort a setq.  Must be a defun."
-  (interactive)
-  (save-excursion
-    (save-restriction
-      (let ((sort-end (progn (end-of-defun)
-                             (backward-char)
-                             (point-marker)))
-            (sort-beg (progn (beginning-of-defun)
-                             (re-search-forward "[ \\t]*(" (point-at-eol))
-                             (forward-sexp)
-                             (re-search-forward "\\_<" (point-at-eol))
-                             (point-marker))))
-        (narrow-to-region (1- sort-beg) (1+ sort-end))
-        (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record)))))
-
-(defun sort-setq-next-record ()
-  "Sort the next record of a `setq' form."
-  (condition-case nil
-      (progn
-        (forward-sexp 1)
-        (backward-sexp))
-    ('scan-error (goto-char (point-max)))))
-
-(defun sort-setq-end-record ()
-  "Sort the end of a `setq' record."
-  (condition-case nil
-      (forward-sexp 2)
-    ('scan-error (goto-char (point-max)))))
-
-
-;;; Crux tweaks
-
-;; `crux-other-window-or-switch-buffer' doesn't take an argument.
-(defun acdw/other-window-or-switch-buffer (&optional arg)
-  "Call `other-window' with ARG or switch buffers, depending on window count."
-  (interactive "P")
-  (if (one-window-p)
-      (switch-to-buffer nil)
-    (other-window (or arg 1))))
-
-(defun acdw/other-window-or-switch-buffer-backward ()
-  "Do `acdw/other-window-or-switch-buffer', but backward."
-  (interactive)
-  (acdw/other-window-or-switch-buffer -1))
-
-
-;;; Auth-sources
-;; https://github.com/emacs-circe/circe/wiki/Configuration
-(defun acdw/fetch-password (&rest params)
-  "Fetch a password from `auth-source' using PARAMS.
-This function is internal.  Use `acdw/make-password-fetcher' instead."
-  (let ((match (car (apply #'auth-source-search params))))
-    (if match
-        (let ((secret (plist-get match :secret)))
-          (if (functionp secret)
-              (funcall secret)
-            secret))
-      (message "Password not found for %S" params))))
-
-(defun acdw/make-password-fetcher (&rest params)
-  "Make a function that will call `acdw/fetch-password' with PARAMS."
-  (lambda (&rest _)
-    (apply #'acdw/fetch-password params)))
-
-
-;;; Paren annoyances
-(defun acdw/stop-paren-annoyances (&optional buffer)
-  "Locally turn off paren-checking functions in BUFFER."
-  (with-current-buffer (or buffer (current-buffer))
-    (setq-local blink-matching-paren nil
-                show-paren-mode nil)))
-
-
-;;; 💩
-(defun 💩 (&optional n)
-  "💩 x N."
-  (interactive "p")
-  (let ((n (or n 1)))
-    (while (> n 0)
-      (insert "💩")
-      (setq n (1- n)))))
-
-
-;;; Fat finger solutions
-(defun acdw/fat-finger-exit (&optional prefix)
-  "Delete a frame, or kill Emacs with confirmation.
-When called with PREFIX, just kill Emacs without confirmation."
-  (interactive "P")
-  (if (or prefix
-          (and (= 1 (length (frame-list)))
-               (yes-or-no-p "This is the last frame!  Wanna quit?")))
-      (kill-emacs)
-    (ignore-errors
-      (delete-frame))))
-
-(defun acdw/disabled-command-function (&optional cmd keys)
-  (let ((cmd (or cmd this-command))
-        (keys (or keys (this-command-keys))))
-    ;; this logic stolen from original `disabled-command-function'
-    (if (or (eq (aref keys 0) (if (stringp keys)
-                                  (aref "\M-x" 0)
-                                ?\M-x))
-            (and (>= (length keys) 2)
-                 (eq (aref keys 0) meta-prefix-char)
-                 (eq (aref keys 1) ?x)))
-        ;; it's been run as an M-x command, we want to do it
-        (call-interactively cmd)
-      ;; else, tell the user it's disabled.
-      (message (substitute-command-keys
-                (concat "Command `%s' has been disabled.  "
-                        "Run with \\[execute-extended-command]."))
-               cmd))))
-
-
-;;; cribbed
-
-;; https://jao.io/blog/2021-09-08-high-signal-to-noise-emacs-command.html
-(defun jao-buffer-same-mode (&rest modes)
-  "Pop to a buffer with a mode among MODES, or the current one if not given."
-  (interactive)
-  (let* ((modes (or modes (list major-mode)))
-         (pred (lambda (b)
-                 (let ((b (get-buffer (if (consp b) (car b) b))))
-                   (member (buffer-local-value 'major-mode b) modes)))))
-    (pop-to-buffer (read-buffer "Buffer: " nil t pred))))
-
-;;; BLAH
-
-(defun open-paragraph ()
-  "Open a paragraph after point.
-A paragraph is defined as continguous non-empty lines of text
-surrounded by empty lines, so opening a paragraph means to make
-three blank lines, then place the point on the second one."
-  (interactive)
-  ;; Go to next blank line.  This /isn't/ `end-of-paragraph-text' because
-  ;; that's weird with org, and I'm guessing other modes too.
-  (while (not (looking-at "^$"))
-    (forward-line 1))
-  (newline)
-  (delete-blank-lines)
-  (newline 2)
-  (forward-line -1))
+;;; Code:
 
-(defun require/ (feature &optional filename noerror)
-  "If FEATURE is not loaded, load it from FILENAME.
-This function works just like `require', with one crucial
-difference: if the FEATURE name contains a slash, the FILENAME
-will as well -- unless, of course, FILENAME is set.  This allows
-for `require/' to require files within subdirectories of
-directories of `load-path'.  Of course, NOERROR isn't affected by
-the change."
-  (let* ((feature-name (if (symbolp feature)
-                           (symbol-name feature)
-                         feature))
-         (filename (or filename
-                       (and (string-match-p "/" feature-name)
-                            feature-name))))
-    (require (intern feature-name) filename noerror)))
+;;; Define a directory and an expanding function
+
+(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
+  "Define a variable and function NAME expanding to DIRECTORY.
+DOCSTRING is applied to the variable.  Ensure DIRECTORY exists in
+the filesystem, unless INHIBIT-MKDIR is non-nil."
+  (declare (indent 2))
+  (unless inhibit-mkdir
+    (make-directory (eval directory) :parents))
+  `(progn
+     (defvar ,name ,directory
+       ,(concat docstring (when docstring "\n")
+                "Defined by `/define-dir'."))
+     (defun ,name (file &optional mkdir)
+       ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
+                "If MKDIR is non-nil, the directory is created.\n"
+                "Defined by `/define-dir'.")
+       (let ((file-name (expand-file-name (convert-standard-filename file)
+                                          ,name)))
+         (when mkdir
+           (make-directory (file-name-directory file-name) :parents))
+         file-name))))
 
 (provide 'acdw)
 ;;; acdw.el ends here