11 files changed, 727 insertions, 55 deletions

@@ -229,7 +229,7 @@ Do this only if the buffer is not visiting a file."
                (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
                   +save-some-buffers-debounce-timeout))
     (save-some-buffers t)
-    (setq +save-some-buffers-debounce-time (time-convert nil 'integer))))
+    (setf +save-some-buffers-debounce-time (time-convert nil 'integer))))
 
 
 ;;; Better-default functions ...
@@ -304,6 +304,11 @@ ARG is passed to `backward-kill-word'."
 ;; (advice-add #'yank :after #'+yank@indent)
 ;; (advice-add #'yank-pop :after #'+yank@indent)
 
+;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/
+(defun +vc-off-when-remote ()
+  (when (file-remote-p (buffer-file-name))
+    (setq-local vc-handled-backends nil)))
+
 
 ;;; Extra functions
 
@@ -317,7 +322,7 @@ It returns nil with remote files and those without attached files."
 (defun +goto-matching-paren (&optional arg)
   "Go to the matching paren, similar to vi's %."
   (interactive "p")
-  (or arg (setq arg 1))
+  (or arg (setf arg 1))
   (cond
    ;; Check for "outside of bracket" positions
    ((looking-at "[\[\(\{]") (forward-sexp arg))
@@ -338,6 +343,15 @@ If the current window is the only window, bury the buffer."
 
 ;;; Required libraries
 
+(when (require 'abbrev nil :noerror)
+  (setq-default abbrev-file-name (sync/ "abbrev.el")
+                save-abbrevs 'silent))
+
+(when (require 'autorevert nil :noerror)
+  (setq-default global-auto-revert-non-file-buffers t
+                auto-revert-verbose nil)
+  (global-auto-revert-mode +1))
+
 (when (require 'uniquify nil :noerror)
   (setq-default uniquify-buffer-name-style 'forward
                 uniquify-separator path-separator
@@ -12,8 +12,8 @@ With PREFIX, prompt to change the current dictionary."
   (when prefix
     (let ((current-prefix-arg nil))
       (call-interactively #'ispell-change-dictionary)))
-  (+with-message "Checking spelling"
-                 (flyspell-correct-move (point-min) :forward :rapid)))
+  (with-message "Checking spelling"
+    (flyspell-correct-move (point-min) :forward :rapid)))
 
 (defun +flyspell-correct-buffer-h (&rest _)
   "Run `+flyspell-correct-buffer'.
@@ -0,0 +1,97 @@
+;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'seq)
+
+;; Utility function TODO: move elsewhere
+(defun +ispell-append-removing-duplicates (&rest lists)
+  "Append LISTS, removing duplicates from the result.
+Any keyword arguments to `cl-remove-duplicates' should come
+before the LISTS."
+  (let (cl-remove-duplicates-args)
+    (while (keywordp (car lists))
+      (push (pop lists) cl-remove-duplicates-args)
+      (push (pop lists) cl-remove-duplicates-args))
+    (apply #'cl-remove-duplicates (apply #'append lists)
+           (nreverse cl-remove-duplicates-args))))
+
+;;; Ispell in .dir-locals
+
+;; Let Emacs know a list of strings is safe
+(defun +ispell-safe-local-p (list)
+  (and (listp list)
+       (seq-every-p #'stringp list)))
+
+;; Can I instruct ispell to insert LocalWords in a different file?
+;; https://emacs.stackexchange.com/q/31396/2264
+
+;; How can I move all my file-local LocalWords to .dir-locals.el?
+;; https://emacs.stackexchange.com/q/31419
+
+;; Adapted from ispell.el:ispell-buffer-local-words
+(defun +ispell-buffer-local-words-list ()
+  (let (words)
+    (or ispell-buffer-local-name
+        (setf ispell-buffer-local-name (buffer-name)))
+    (save-excursion
+      (goto-char (point-min))
+      (while (search-forward ispell-words-keyword nil t)
+        (let ((end (point-at-eol))
+              (ispell-casechars (ispell-get-casechars))
+              string)
+          (while (re-search-forward " *\\([^ ]+\\)" end t)
+            (setf string (match-string-no-properties 1))
+            (if (and (< 1 (length string))
+                     (equal 0 (string-match ispell-casechars string)))
+                (push string words))))))
+    words))
+
+;;;###autoload
+(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
+  "Move the current buffer-local words to .dir-locals.el.
+This function prompts the user to save .dir-locals.el, unless
+prefix ARG is non-nil; then it just saves them."
+  (interactive "P")
+  (unless (buffer-file-name)
+    (user-error "Buffer not attached to file"))
+  (hack-dir-local-variables)
+  (let ((print-level nil)
+        (print-length nil))
+    (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
+                                        ; where this came from
+                                        (+ispell-append-removing-duplicates
+                                         :test #'string=
+                                         ispell-buffer-session-localwords
+                                         (alist-get 'ispell-buffer-session-localwords
+                                                    dir-local-variables-alist)
+                                         (alist-get 'ispell-buffer-session-localwords
+                                                    file-local-variables-alist)
+                                         (+ispell-buffer-local-words-list)))))
+      (save-excursion
+        (add-dir-local-variable
+         major-mode
+         'ispell-buffer-session-localwords
+         (setf ispell-buffer-session-localwords
+               new-words))
+        (when (or arg
+                  (y-or-n-p "Save .dir-locals.el?"))
+          (save-buffer))
+        (bury-buffer))
+      (or ispell-buffer-local-name
+          (setf ispell-buffer-local-name (buffer-name)))
+      (save-excursion
+        (goto-char (point-min))
+        (while (search-forward ispell-words-keyword nil t)
+          (delete-region (point-at-bol) (1+ (point-at-eol))))))))
+
+;;;###autoload
+(defun +ispell-move-buffer-words-to-dir-locals-hook ()
+  "Convenience function for binding to a hook."
+  (+ispell-move-buffer-words-to-dir-locals t))
+
+(provide '+ispell)
+;;; +ispell.el ends here
@@ -17,7 +17,7 @@ LIST defaults to `org-capture-templates'."
 ;; Set it up as a generic value.  Based on the one for `alist-get'.
 (gv-define-expander +org-capture--get
   (lambda (do key &optional alist)
-    (setq alist (or alist org-capture-templates))
+    (setf alist (or alist org-capture-templates))
     (macroexp-let2 macroexp-copyable-p k key
       (gv-letplace (getter setter) alist
         (macroexp-let2 nil p `(assoc ,k ,getter 'equal)
@@ -27,7 +27,7 @@ LIST defaults to `org-capture-templates'."
                        (let ((set-exp
                               `(if ,p (setcdr ,p ,v)
                                  ,(funcall setter
-                                           `(cons (setq ,p (cons ,k ,v))
+                                           `(cons (setf ,p (cons ,k ,v))
                                                   ,getter)))))
                          `(progn
                             ,set-exp
@@ -36,7 +36,7 @@ LIST defaults to `org-capture-templates'."
 (defun +org-capture-sort (&optional list)
   "Sort LIST by string keys.
 LIST is a symbol and defaults to `org-capture-templates'."
-  (setq list (or list 'org-capture-templates))
+  (setf list (or list 'org-capture-templates))
   (set list (sort (symbol-value list) (lambda (a b)
                                         (string< (car a) (car b))))))
 
@@ -68,9 +68,9 @@ SORT-AFTER, when set to t, will call
 properly process the variable."
   ;; LIST defaults to `org-capture-templates'
   (declare (indent 2))
-  (unless list (setq list 'org-capture-templates))
+  (unless list (setf list 'org-capture-templates))
   ;; Ensure VALUE is a list to cons properly
-  (unless (listp value) (setq value (list value)))
+  (unless (listp value) (setf value (list value)))
   (when (> (length key) 1)
     ;; Check for existence of groups.
     (let ((expected (cl-loop for i from 1 to (1- (length key))
@@ -87,7 +87,7 @@ properly process the variable."
 
 (defun +org-template--ensure-path (keys &optional list)
   "Ensure path of keys exists in `org-capture-templates'."
-  (unless list (setq list 'org-capture-templates))
+  (unless list (setf list 'org-capture-templates))
   (when (> (length key) 1)
     ;; Check for existence of groups.
     (let ((expected (cl-loop for i from 1 to (1- (length key))
@@ -1,5 +1,106 @@
 ;;; +org.el --- -*- lexical-binding: t -*-
 
+;;; Org Return DWIM
+;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]]
+
+(defun +org-element-descendant-of (type element)
+  "Return non-nil if ELEMENT is a descendant of TYPE.
+TYPE should be an element type, like `item' or `paragraph'.
+ELEMENT should be a list like that returned by `org-element-context'."
+  ;; MAYBE: Use `org-element-lineage'.
+  (when-let* ((parent (org-element-property :parent element)))
+    (or (eq type (car parent))
+        (+org-element-descendant-of type parent))))
+
+(defun +org-return-dwim (&optional prefix)
+  "A helpful replacement for `org-return'.
+With PREFIX, call `org-return'."
+  (interactive "P")
+  ;; Auto-fill if enabled
+  (when auto-fill-function
+    (dolist (func (ensure-list auto-fill-function))
+      (funcall func)))
+  (cond
+   (prefix                              ; Handle prefix
+    (pcase prefix
+      ('(4) (newline))
+      ('(16) (newline 2))
+      (_ (newline prefix))))
+   ((and org-return-follows-link        ; Open link
+         (eq 'link (car (org-element-context))))
+    (org-open-at-point-global))
+   ((org-at-heading-p)                  ; Open a line after a heading
+    (let ((heading-start (org-entry-beginning-position)))
+      (goto-char (org-entry-end-position))
+      (cond ((and (org-at-heading-p)
+                  (= heading-start (org-entry-beginning-position)))
+             ;; Entry ends on its heading, so add 2 newlines
+             (end-of-line)
+             (newline 2))
+            (t
+             ;; Entry ends after its heading, so back up
+             (forward-line -1)
+             (end-of-line)
+             (when (org-at-heading-p)
+               (forward-line)
+               (newline)
+               (forward-line -1))
+             (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n")))
+                                       nil))
+               (newline))
+             (forward-line -1)))))
+   ((org-at-item-checkbox-p)            ; Insert a new checkbox item
+    (end-of-line)
+    (org-insert-todo-heading nil))
+   ((org-in-item-p)                     ; Insert a new list item
+    (let* ((context (org-element-context))
+           (first-item-p (eq 'plain-list (car context)))
+           (itemp (eq 'item (car context)))
+           (emptyp (or
+                    ;; This (regular) list item is empty
+                    (eq (org-element-property :contents-begin context)
+                        (org-element-property :contents-end context))
+                    ;; This (definition) list item is empty
+                    (looking-at " *::")))
+           (item-child-p (+org-element-descendant-of 'item context)))
+      (cond ((and itemp emptyp)
+             (delete-region (line-beginning-position) (line-end-position))
+             (newline))
+            ((or first-item-p
+                 (and itemp (not emptyp))
+                 item-child-p)
+             (org-end-of-item)
+             (org-insert-item))
+            (t
+             (delete-region (line-beginning-position) (line-end-position))
+             (newline)))))
+   ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with
+         (org-inlinetask-in-task-p))         ; inline tasks
+    (org-return))
+   ((org-at-table-p)                    ; Insert a new org-table row
+    (cond ((save-excursion
+             (beginning-of-line)
+             (cl-loop with end = (line-end-position)
+                      for cell = (org-element-table-cell-parser)
+                      always (equal (org-element-property :contents-begin cell)
+                                    (org-element-property :contents-end cell))
+                      while (re-search-forward "|" end t)))
+           ;; Empty row: end the table
+           (delete-region (line-beginning-position) (line-end-position))
+           (org-return))
+          (t
+           ;; Non-empty row
+           (org-return))))
+   (t                                   ; Otherwise---just call `org-return'.
+    (org-return))))
+
+(defun +org-table-copy-down|+org-return (&optional n)
+  "Call `org-table-copy-down' or `+org-return' depending on context."
+  (interactive "P")
+  (if (org-table-check-inside-data-field 'noerror)
+      (org-table-copy-down (or n 1))
+    (+org-return-dwim n)))
+
 ;;; Copy org trees as HTML
 
 ;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
@@ -41,4 +142,70 @@ and POST-PROCESS are passed to `org-export-to-file'."
                        ("—" "---"))))
         (replace-match replace nil nil)))))
 
+;;; A ... different ... `org-open-at-point-dwim'
+;; I honestly don't remember what the difference is between this and the
+;; O.G. one is.. hopefully this one fixes annoying stupid problems.
+
+(defun +org-open-at-point-dwim (&optional arg)
+  "Open thing at point, or if there isn't something, list things."
+  (interactive "P")
+  (save-excursion
+    (let* ((this-char-type (org-element-type (org-element-context)))
+           (prev-char-type (ignore-errors
+                             (save-excursion
+                               (backward-char)
+                               (org-element-type (org-element-context)))))
+           (types '(citation citation-reference clock comment comment-block
+                             footnote-definition footnote-reference headline
+                             inline-src-block inlinetask keyword link
+                             node-property planning src-block timestamp))
+           (type this-char-type))
+      (when (and (memq this-char-type types) (memq prev-char-type types))
+        (backward-char)
+        (setq type prev-char-type))                  ; what the fuckckckckck
+      ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
+      ;; especially on DEADLINE (and probably SCHEDULED) lines.  However, since
+      ;; I really just want to open the list of URLs /most of the time/, I'm
+      ;; fixing it like this instead.
+      (unless (and (memq type types)
+                   (ignore-errors (org-open-at-point arg)
+                                  t))
+        (while (not
+                (progn
+                  (org-back-to-heading)
+                  (car (org-offer-links-in-entry (current-buffer) (point) 1))))
+          (org-up-heading-all 1))
+        (org-open-at-point arg)))))
+
+;;; Skip invisible shit when moving around
+(defun +org-ignore-invisible (fn &rest r)
+  ":around ADVICE to ignore invisible text in `org-mode' buffers."
+  ;; TODO: generalize to all modes
+  (cond ((and (derived-mode-p #'org-mode)
+              (org-invisible-p))
+         (while (org-invisible-p)
+           (forward-char))
+         (apply fn r))
+        (t (apply fn r))))
+
+;;; Faces
+
+;;; Better org faces
+;; see `org-emphasis-alist'
+
+(defface org-bold '((t (:weight bold)))
+  "Bold face in `org-mode' documents.")
+
+(defface org-italic '((t (:slant italic)))
+  "Italic face in `org-mode' documents.")
+
+(defface org-underline '((t (:underline t)))
+  "Underline face in `org-mode' documents.")
+
+(defface org-strikethrough '((t (:strike-through t)))
+  "Strike-through face for `org-mode' documents.")
+
+;; `org-verbatim' and `org-code' are apparently already things, so we skip them
+;; here.
+
 (provide '+org)
@@ -0,0 +1,44 @@
+;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*-
+
+(require 'tempo)
+
+;; TODO: I need to figure out where this function goes.
+(defun delete2 (list &rest elems)
+  "Delete each element of ELEMS, and the next item, from LIST."
+  (let ((r nil))
+    (while (consp list)
+      (if (member (car list) elems)
+          (setf list (cdr list))
+        (setf r (cons (car list) r)))
+      (setf list (cdr list)))
+    (reverse r)))
+
+(defmacro define-tempo (tag doc &rest elements)
+  "Define a template and add its tag to MODE's abbrev-table.
+TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see.
+ABBREV, if given, is the abbrev string to use for template expansion
+under MODE's abbrev-table.  If ABBREV isn't given, TAG will be used."
+  (declare (indent 1))
+  (let* ((template (gensym))
+         (tag (cond ((stringp tag) tag)
+                    ((symbolp tag) (symbol-name tag))
+                    (t (user-error "TAG must be a string or symbol: %S" tag))))
+         (mode (or (plist-get elements :mode) nil))
+         (abbrev (or (plist-get elements :abbrev) tag))
+         (taglist (or (plist-get elements :taglist) nil))
+         (table (let ((tname (and mode (derived-mode-abbrev-table-name mode))))
+                  (while (and tname (not (memq tname abbrev-table-name-list)))
+                    (setq tname (and (get mode 'derived-mode-parent)
+                                     (derived-mode-abbrev-table-name
+                                      (get mode 'derived-mode-parent)))))
+                  (or tname 'global-abbrev-table)))
+         (elements (delete2 elements :mode :abbrev :taglist)))
+    `(let ((,template (tempo-define-template ,tag
+                                             ',elements
+                                             ,tag
+                                             ,doc
+                                             ,taglist)))
+       (define-abbrev ,table ,tag "" ,template :system t)
+       (put ,template 'no-self-insert t))))
+
+(provide '+tempo)
@@ -0,0 +1,130 @@
+;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; Do I want to propose this change in the Emacs ML?
+
+;;; Code:
+
+(require 'window)
+
+;;; Split windows based on `window-total-width', not `window-width'
+;; I have to just redefine these functions because the check is really deep in
+;; there.
+
+(defun window-splittable-p (window &optional horizontal)
+  "Return non-nil if `split-window-sensibly' may split WINDOW.
+Optional argument HORIZONTAL nil or omitted means check whether
+`split-window-sensibly' may split WINDOW vertically.  HORIZONTAL
+non-nil means check whether WINDOW may be split horizontally.
+
+WINDOW may be split vertically when the following conditions
+hold:
+- `window-size-fixed' is either nil or equals `width' for the
+  buffer of WINDOW.
+- `split-height-threshold' is an integer and WINDOW is at least as
+  high as `split-height-threshold'.
+- When WINDOW is split evenly, the emanating windows are at least
+  `window-min-height' lines tall and can accommodate at least one
+  line plus - if WINDOW has one - a mode line.
+
+WINDOW may be split horizontally when the following conditions
+hold:
+- `window-size-fixed' is either nil or equals `height' for the
+  buffer of WINDOW.
+- `split-width-threshold' is an integer and WINDOW is at least as
+  wide as `split-width-threshold'.
+- When WINDOW is split evenly, the emanating windows are at least
+  `window-min-width' or two (whichever is larger) columns wide."
+  (when (and (window-live-p window)
+             (not (window-parameter window 'window-side)))
+    (with-current-buffer (window-buffer window)
+      (if horizontal
+          ;; A window can be split horizontally when its width is not
+          ;; fixed, it is at least `split-width-threshold' columns wide
+          ;; and at least twice as wide as `window-min-width' and 2 (the
+          ;; latter value is hardcoded).
+          (and (memq window-size-fixed '(nil height))
+               ;; Testing `window-full-width-p' here hardly makes any
+               ;; sense nowadays.  This can be done more intuitively by
+               ;; setting up `split-width-threshold' appropriately.
+               (numberp split-width-threshold)
+               (>= (window-total-width window)
+                   (max split-width-threshold
+                        (* 2 (max window-min-width 2)))))
+        ;; A window can be split vertically when its height is not
+        ;; fixed, it is at least `split-height-threshold' lines high,
+        ;; and it is at least twice as high as `window-min-height' and 2
+        ;; if it has a mode line or 1.
+        (and (memq window-size-fixed '(nil width))
+             (numberp split-height-threshold)
+             (>= (window-height window)
+                 (max split-height-threshold
+                      (* 2 (max window-min-height
+                                (if mode-line-format 2 1))))))))))
+
+(defun split-window-sensibly (&optional window)
+  "Split WINDOW in a way suitable for `display-buffer'.
+WINDOW defaults to the currently selected window.
+If `split-height-threshold' specifies an integer, WINDOW is at
+least `split-height-threshold' lines tall and can be split
+vertically, split WINDOW into two windows one above the other and
+return the lower window.  Otherwise, if `split-width-threshold'
+specifies an integer, WINDOW is at least `split-width-threshold'
+columns wide and can be split horizontally, split WINDOW into two
+windows side by side and return the window on the right.  If this
+can't be done either and WINDOW is the only window on its frame,
+try to split WINDOW vertically disregarding any value specified
+by `split-height-threshold'.  If that succeeds, return the lower
+window.  Return nil otherwise.
+
+By default `display-buffer' routines call this function to split
+the largest or least recently used window.  To change the default
+customize the option `split-window-preferred-function'.
+
+You can enforce this function to not split WINDOW horizontally,
+by setting (or binding) the variable `split-width-threshold' to
+nil.  If, in addition, you set `split-height-threshold' to zero,
+chances increase that this function does split WINDOW vertically.
+
+In order to not split WINDOW vertically, set (or bind) the
+variable `split-height-threshold' to nil.  Additionally, you can
+set `split-width-threshold' to zero to make a horizontal split
+more likely to occur.
+
+Have a look at the function `window-splittable-p' if you want to
+know how `split-window-sensibly' determines whether WINDOW can be
+split."
+  (let ((window (or window (selected-window))))
+    (or (and (window-splittable-p window)
+             ;; Split window vertically.
+             (with-selected-window window
+               (split-window-below)))
+        (and (window-splittable-p window t)
+             ;; Split window horizontally.
+             (with-selected-window window
+               (split-window-right)))
+        (and
+         ;; If WINDOW is the only usable window on its frame (it is
+         ;; the only one or, not being the only one, all the other
+         ;; ones are dedicated) and is not the minibuffer window, try
+         ;; to split it vertically disregarding the value of
+         ;; `split-height-threshold'.
+         (let ((frame (window-frame window)))
+           (or
+            (eq window (frame-root-window frame))
+            (catch 'done
+              (walk-window-tree (lambda (w)
+                                  (unless (or (eq w window)
+                                              (window-dedicated-p w))
+                                    (throw 'done nil)))
+                                frame nil 'nomini)
+              t)))
+         (not (window-minibuffer-p window))
+         (let ((split-height-threshold 0))
+           (when (window-splittable-p window)
+             (with-selected-window window
+               (split-window-below))))))))
+
+(provide '+window)
+;;; +window.el ends here
@@ -30,20 +30,20 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
 
 ;;; Convenience functions
 
-(defun define-keys (maps &rest keydefs)
+(defun define-key* (maps &rest keydefs)
   "Define KEYDEFS in MAPS.
 Convenience wrapper around `define-key'."
   (unless (zerop (mod (length keydefs) 2))
     (user-error "Wrong number of arguments: %S" (length keydefs)))
   (dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
-                   (list maps)
-                 maps))
+                   (list maps)
+                 maps))
     (cl-loop for (key def) on keydefs by #'cddr
-             do (let ((key (if (stringp key) (kbd key) key)))
-                  (define-key (if (symbolp map)
-                                  (symbol-value map)
-                                map)
-                    key def)))))
+             do (let ((key (if (stringp key) (kbd key) key)))
+                  (define-key (if (symbolp map)
+                                  (symbol-value map)
+                                map)
+                    key def)))))
 
 (unless (fboundp 'ensure-list)
   ;; Just in case we're using an old version of Emacs.
@@ -57,10 +57,11 @@ not a list, return a one-element list containing OBJECT."
 
 (defun add-to-list* (lists &rest things)
   "Add THINGS to LISTS.
-LISTS can be one list variable or a list.
-Each thing of THINGS can be either a variablel (the thing), or a list of the form
+LISTS can be one list variable or a list.  Each thing of THINGS
+can be either a variablel (the thing), or a list of the form
 (ELEMENT &optional APPEND COMPARE-FN), which is passed to
 `add-to-list'."
+  (declare (indent 1))
   (dolist (l (ensure-list lists))
     (dolist (thing things)
       (apply #'add-to-list l (ensure-list thing)))))
@@ -69,26 +70,73 @@ Each thing of THINGS can be either a variablel (the thing), or a list of the for
   "Add FUNCTIONS to HOOKS.
 Each function in FUNCTIONS can be a singleton or a list of the
 form (FUNCTION &optional DEPTH LOCAL)."
+  (declare (indent 1))
   (dolist (hook (ensure-list hooks))
     (dolist (fn functions)
       (apply #'add-hook hook (ensure-list fn)))))
 
+(defun +concat (&rest strings)
+  "Concat STRINGS separated by SEPARATOR.
+SEPARATOR is \"\\n\" unless the keyword argument `:separator' is
+given, followed by the separator to use.  Each item in STRINGS is
+either a string or a list or strings, which is concatenated
+without any separator."
+  (let (ret
+        ;; I don't know why a `cl-defun' with
+        ;; (&rest strings &key (separator "\n")) doesn't work
+        (separator (or (cl-loop for i from 0 upto (length strings)
+                                if (eq (nth i strings) :separator)
+                                return (nth (1+ i) strings))
+                       "\n")))
+    (while strings
+      (let ((string (pop strings)))
+        (cond ((eq string :separator) (pop strings))
+              ((listp string) (push (apply #'concat string) ret))
+              ((stringp string) (push string ret)))))
+    (mapconcat #'identity (nreverse ret) separator)))
+
+(defun require* (&rest features)
+  "Require FEATURES in order.
+Each feature of FEATURES can also be a list of the arguments to
+pass to `require', which see."
+  (condition-case e
+    (dolist (feature features)
+      (apply #'require (ensure-list feature)))
+    (:success (mapcar (lambda (f) (car (ensure-list f))) features))
+    (t (signal (car e) (cdr e)))))
+
 ;;; Convenience macros
 
+(defmacro define-local-before-save-hook (mode-or-hook &rest body)
+  "Add a local `before-save-hook' to MODE-OR-HOOK."
+  (declare (indent 1))
+  (let* ((name (format "%s" mode-or-hook))
+         (external-name (intern (format "%s@before-save" name)))
+         (internal-name (intern (format "before-save@%s" name)))
+         (hook (if (string-suffix-p "-hook" name)
+                   mode-or-hook
+                 (intern (format "%s-hook" name)))))
+    `(progn
+       (defun ,internal-name ()
+         ,@body)
+       (defun ,external-name ()
+         (add-hook 'before-save-hook #',internal-name nil :local))
+       (add-hook ',hook #',external-name))))
+
 (defmacro setq-local-hook (hook &rest args)
   "Run `setq-local' on ARGS when running HOOK."
   (declare (indent 1))
   (let ((fn (intern (format "%s-setq-local" hook))))
     (when (and (fboundp fn)
-               (functionp fn))
-      (setq args (append (function-get fn 'setq-local-hook-settings) args)))
+               (functionp fn))
+      (setf args (append (function-get fn 'setq-local-hook-settings) args)))
     (unless (and (< 0 (length args))
-                 (zerop (mod (length args) 2)))
+                 (zerop (mod (length args) 2)))
       (user-error "Wrong number of arguments: %S" (length args)))
     `(progn
        (defun ,fn ()
-         ,(format "Set local variables after `%s'." hook)
-         (setq-local ,@args))
+         ,(format "Set local variables after `%s'." hook)
+         (setq-local ,@args))
        (function-put ',fn 'setq-local-hook-settings ',args)
        (add-hook ',hook #',fn))))
 
@@ -103,3 +151,38 @@ If body executes without errors, MESSAGE...Done will be displayed."
                   ,@body)
          (:success (message "%s...done" ,msg))
          (t (signal (car e) (cdr e)))))))
+
+;; https://emacs.stackexchange.com/a/39324/37239
+;; XXX: This shit don't work rn
+(defun ignore-invisible-overlays (fn)
+  "Execute FN, ignoring invisible overlays.
+FN should return a point."
+  (let ((overlay nil)
+        (point nil))
+   (setq point (and (funcall fn) (point)))
+   (setq overlay (car (overlays-at (point))))
+   (while (and overlay (member 'invisible (overlay-properties overlay)))
+     (goto-char (overlay-end overlay))
+     (setq point (and (funcall fn) (point)))
+     (setq overlay (car (overlays-at (point)))))
+   point))
+
+;;; Extras
+;; Trying to avoid a whole install of crux ...
+
+(defun kill-and-join-forward (&optional arg)
+  "Kill the line or, if at the end of a line, join with the next.
+This command is `visual-line-mode'-aware.  If ARG is provided,
+it's passed on to kill a line, but not to delete indentation.
+When joining, this command deletes whitespace."
+  (interactive "P")
+  (if (and (eolp) (not (bolp)))
+      (delete-indentation 1)
+    (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
+
+(defun other-window|switch-buffer ()
+  "Call `other-window' or `switch-buffer' depending on windows."
+  (interactive)
+  (if (one-window-p)
+      (switch-to-buffer nil)
+    (other-window 1)))
@@ -0,0 +1,64 @@
+;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*-
+;; 🥙
+
+(defmacro with-message (msg &rest body)
+  (declare (indent 1))
+  (when (listp msg)
+    (setq msg (apply #'format (car msg) (cdr msg))))
+  (when (string-match "[[:alnum:]]\\'" msg)
+    (setq msg (concat msg "...")))
+  (let ((m (gensym))
+        (r (gensym)))
+    `(let ((,m ,msg)
+           (,r nil))
+       (condition-case e
+           (setq r (progn (message ,m) ,@body))
+         (:success (message "%s done" ,m) r)
+         (t (signal (car e) (cdr e)))))))
+
+(defun walk-tree-replace (tree find replace)
+  (let ((r nil))
+    (dolist (form tree)
+      (push (cond ((eq find form) replace)
+                  ((listp form)
+                   (walk-tree-replace form find replace))
+                  (t form))
+            r))
+    (reverse r)))
+
+(defmacro with-pr (msg &rest body)
+  (declare (indent 1))
+  (when (listp msg)
+    (setq msg (apply #'format (car msg) (cdr msg))))
+  (when (string-match "[[:alnum:]]\\'" msg)
+    (setq msg (concat msg "...")))
+  (let ((pr (gensym))
+        (m (gensym)))
+    `(let* ((,m ,msg)
+            (,pr (unless (minibufferp)
+                  (make-progress-reporter ,m))))
+       ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr)))
+             body)
+       (and ,pr (progress-reporter-done ,pr)))))
+
+
+;;; crux advices
+;; these should all go :before the function they're advising.
+
+(defun with-region-or-buffer (&rest _)
+  (interactive (if mark-active
+                   (list (region-beginning) (region-end))
+                 (list (point-min) (point-max)))))
+
+(defun with-region-or-line (&rest _)
+    (interactive (if mark-active
+                     (list (region-beginning) (region-end))
+                   (list (line-beginning-position) (line-end-position)))))
+
+(defun with-region-or-to-eol (&rest _)
+  (interactive (if mark-active
+                   (list (region-beginning) (region-end))
+                 (list (point) (line-end-position)))))
+
+(provide 'pita)
+;;; pita.el ends here
@@ -0,0 +1,61 @@
+;;; scule.el --- -scule twiddling                    -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Case Duckworth
+
+;; Author: Case Duckworth <case@bob>
+;; Keywords: convenience
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; DWIM functions for twiddling "scule", or text case (a fancy word for "upper
+;; case" is "magiscule", for example, and "lower case" is "miniscule").
+
+;;; Code:
+
+(require 'thingatpt)
+
+;;; Utility macro
+;;;###autoload
+(defmacro defscule (name &optional region-fn word-fn)
+  (let ((fn-name (intern (format "scule-%s" name)))
+        (region-fn (or region-fn (intern (format "%s-region" name))))
+        (word-fn (or word-fn (intern (format "%s-word" name)))))
+    `(defun ,fn-name (arg)
+       ,(concat (capitalize (symbol-name name)) " words in the region if active, or word at point.\n"
+                "If the region is active, call `" (symbol-name region-fn) "'.\n"
+                "Otherwise, it calls `" (symbol-name word-fn) "' on the word at point and\n"
+                "the following ARG - 1 words.")
+       (interactive "*p")
+       (if (use-region-p)
+           (,region-fn (region-beginning) (region-end) (region-noncontiguous-p))
+         (let ((word-bound (save-excursion
+                             (skip-chars-forward "^[:word:]")
+                             (bounds-of-thing-at-point 'word))))
+           (when (and (car word-bound) (cdr word-bound))
+             (,region-fn (car word-bound) (cdr word-bound))
+             (goto-char (cdr word-bound))
+             (,word-fn (1- arg))))))))
+
+;;;###autoload
+(progn (defscule upcase)
+       (autoload 'scule-upcase "scule" nil t)
+       (defscule downcase)
+       (autoload 'scule-downcase "scule" nil t)
+       (defscule capitalize)
+       (autoload 'scule-capitalize "scule" nil t))
+
+(provide 'scule)
+;;; scule.el ends here
@@ -47,20 +47,20 @@ installed to `yoke-dir'."
       (let ((generated-autoload-file
              (expand-file-name (format "%s-autoloads.el" pkg) dir))
             (backup-inhibited t)
-            (version-control 'never)
-            (message-log-max nil)
-            (inhibit-message t))
-        (unless (file-exists-p generated-autoload-file)
-          (let ((find-file-hook nil)
-                (write-file-functions nil)
-                (debug-on-error nil)
-                (left-margin 0))
-            (if (fboundp 'make-directory-autoloads)
-                (make-directory-autoloads dir generated-autoload-file)
-              (and (fboundp 'update-directory-autoloads)
-                   (update-directory-autoloads dir)))))
-        (when-let ((buf (find-buffer-visiting generated-autoload-file)))
-          (kill-buffer buf))
+            (version-control 'never)
+            (message-log-max nil)
+            (inhibit-message t))
+        (unless (file-exists-p generated-autoload-file)
+          (let ((find-file-hook nil)
+                (write-file-functions nil)
+                (debug-on-error nil)
+                (left-margin 0))
+            (if (fboundp 'make-directory-autoloads)
+                (make-directory-autoloads dir generated-autoload-file)
+              (and (fboundp 'update-directory-autoloads)
+                   (update-directory-autoloads dir)))))
+        (when-let ((buf (find-buffer-visiting generated-autoload-file)))
+          (kill-buffer buf))
         (load generated-autoload-file :noerror :nomessage)))
      (t (user-error "Directory \"%s\" doesn't exist." dir)))
     dir))
@@ -83,13 +83,13 @@ Similar-ish to `plist-get', but works on non-proper plists."
          ,g))))
 
 (defun delete2 (list &rest elems)
-  "Delete ELEM and the next item from LIST."
+  "Delete each element of ELEMS, and the next item, from LIST."
   (let ((r nil))
     (while (consp list)
       (if (member (car list) elems)
-          (setq list (cdr list))
-        (setq r (cons (car list) r)))
-      (setq list (cdr list)))
+          (setf list (cdr list))
+        (setf r (cons (car list) r)))
+      (setf list (cdr list)))
     (reverse r)))
 
 (defun eval-after-init (fn)
@@ -105,17 +105,17 @@ FEATURES can be an atom or a list; as an atom it works like
 `with-eval-after-load'.  The special feature `init' will evaluate
 BODY after Emacs is finished initializing."
   (declare (indent 1)
-           (debug (form def-body)))
+           (debug (form def-body)))
   (if (eq features 'init)
       `(eval-after-init (lambda () ,@body))
     (unless (listp features)
-      (setq features (list features)))
+      (setf features (list features)))
     (if (null features)
-        (macroexp-progn body)
+        (macroexp-progn body)
       (let* ((this (car features))
-             (rest (cdr features)))
-        `(with-eval-after-load ',this
-           (eval-after ,rest ,@body))))))
+             (rest (cdr features)))
+        `(with-eval-after-load ',this
+           (eval-after ,rest ,@body))))))
 
 (defun yoke-pkg-name (pkg)
   (intern (format "yoke:%s" pkg)))
@@ -131,7 +131,7 @@ BODY after Emacs is finished initializing."
                    (unless nil unlessp) ; :unless PREDICATE
                    &allow-other-keys)
   "Yoke a PKG into your Emacs session."
-  (declare (indent defun))
+  (declare (indent 2))
   (let ((name (yoke-pkg-name pkg))
         (body (delete2 body
                        :depends :when :unless :after :load)))
@@ -141,11 +141,11 @@ BODY after Emacs is finished initializing."
                  (*yoke-repo* ,repo)
                  (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
              ,@(cond
-                ((and whenp unlessp)
-                 `((when (or (not ,when) ,unless)
-                     (cl-return-from ,name nil))))
-                (whenp `((unless ,when (cl-return-from ,name nil))))
-                (unlessp `((when ,unless (cl-return-from ,name nil)))))
+                ((and whenp unlessp)
+                 `((when (or (not ,when) ,unless)
+                     (cl-return-from ,name nil))))
+                (whenp `((unless ,when (cl-return-from ,name nil))))
+                (unlessp `((when ,unless (cl-return-from ,name nil)))))
              ,@(cl-loop for (pkg* repo* load-path*) in depends
                         collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
                                      (cl-return-from ,name nil)))
@@ -157,3 +157,15 @@ BODY after Emacs is finished initializing."
                  body))
          (:success ',pkg)
          (t (message "%s: %s" ',name e))))))
+
+;;; Extras
+
+(defun yoke-imenu-insinuate ()
+  "Insinuate `yoke' forms for `imenu'."
+  (require 'imenu)
+  (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
+        (list (rx (: "(yoke" (+ space)
+                     (group (+ (not space)))
+                     (+ space)
+                     (group (+ (not space)))))
+              1)))