From 59a1f58695d09ab29ddf992b2c0711c94a4039ea Mon Sep 17 00:00:00 2001
From: Case Duckworth
Date: Tue, 3 Jan 2023 23:03:03 -0600
Subject: Switch to use-package
---
lisp/+browse-url.el | 189 +++++++++---
lisp/+cape.el | 25 ++
lisp/+custom.el | 52 ----
lisp/+emacs.el | 422 ---------------------------
lisp/+emms.el | 38 +++
lisp/+hungry-delete.el | 53 ++++
lisp/+isearch.el | 24 ++
lisp/+notmuch.el | 52 +++-
lisp/+org-capture.el | 197 +++----------
lisp/+org.el | 268 +++++++++--------
lisp/+ox.el | 29 --
lisp/+paredit.el | 26 ++
lisp/+tempo.el | 45 ---
lisp/+titlecase.el | 6 +-
lisp/+window.el | 130 ---------
lisp/acdw-defaults.el | 292 +++++++++++++++++++
lisp/acdw-funs.el | 262 +++++++++++++++++
lisp/acdw-macs.el | 293 +++++++++++++++++++
lisp/acdw.el | 345 +++++-----------------
lisp/browse-url-transform.el | 45 ---
lisp/dawn.el | 109 -------
lisp/def.el | 142 ---------
lisp/graveyard.el | 50 ++++
lisp/init-org.el | 144 ++++++++++
lisp/org-word-count.el | 297 -------------------
lisp/pita.el | 69 -----
lisp/private.el | 23 --
lisp/scule.el | 61 ----
lisp/upload-junk.el | 47 +++
lisp/yoke.el | 664 +++++++++++++++++++++++--------------------
30 files changed, 2075 insertions(+), 2324 deletions(-)
create mode 100644 lisp/+cape.el
delete mode 100644 lisp/+custom.el
delete mode 100644 lisp/+emacs.el
create mode 100644 lisp/+emms.el
create mode 100644 lisp/+hungry-delete.el
create mode 100644 lisp/+isearch.el
delete mode 100644 lisp/+ox.el
create mode 100644 lisp/+paredit.el
delete mode 100644 lisp/+tempo.el
delete mode 100644 lisp/+window.el
create mode 100644 lisp/acdw-defaults.el
create mode 100644 lisp/acdw-funs.el
create mode 100644 lisp/acdw-macs.el
delete mode 100644 lisp/browse-url-transform.el
delete mode 100644 lisp/dawn.el
delete mode 100644 lisp/def.el
create mode 100644 lisp/graveyard.el
create mode 100644 lisp/init-org.el
delete mode 100644 lisp/org-word-count.el
delete mode 100644 lisp/pita.el
delete mode 100644 lisp/private.el
delete mode 100644 lisp/scule.el
create mode 100644 lisp/upload-junk.el
(limited to 'lisp')
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el
index 12e433c..b65b6f9 100644
--- a/lisp/+browse-url.el
+++ b/lisp/+browse-url.el
@@ -1,60 +1,101 @@
-;;; +browse-url.el -*- lexical-binding: t -*-
+;;; +browse-url.el -*- lexical-binding: t; -*-
(require 'browse-url)
+(require 'cl-lib)
+(require 'seq)
+(require 'url-util)
+
+(defgroup +browse-url nil
+ "My `browse-url' extras."
+ :group 'browse-url)
+
+;;; External URL handlers
(cl-defmacro +browse-url-make-external-viewer-handler
- (viewer default-args
- &optional (prompt "URL: ")
- &key
- (custom-group 'browse-url)
- (name (intern (format "+browse-url-with-%s" viewer)))
- doc vardoc
- (varname (intern (format "%s-args" name)))
- (fallback t))
- "Create a `browse-url' handler function calling VIEWER on the url.
+ (viewer
+ &key
+ args
+ (prompt "URL: ")
+ (program (executable-find (format "%s" viewer)))
+ (name (intern (format "+browse-url-with-%s" viewer)))
+ doc
+ (var (intern (format "%s-args" name)))
+ vardoc
+ (custom-group '+browse-url)
+ (fallback '(function browse-url-generic)))
+ "Create a `browse-url' handler function calling PROGRAM on the URL.
This macro also creates a `customize' setting in CUSTOM-GROUP for
-VIEWER's command-line arguments. DEFAULT-ARGS specifies the
-default arguments for that setting.
+PROGRAM's command-line arguments. ARGS specifies the
+default arguments for this user option.
+
+PROGRAM defaults to the result of calling `executable-find' on VIEWER.
-PROMPT is shown to the user in the function's `interactive' spec,
-as an argument to `browse-url-interactive-arg'.
+PROMPT is shown to the user in the function's `interactive' spec, as an argument
+to `browse-url-interactive-arg'.
The resulting function is named NAME, which defaults to
-`+browse-url-wth-VIEWER'. The custom variable is named VARNAME,
-which defaults to `NAME-args'. If DOC or VARDOC are provided,
-they'll be the documentation of the function and variable
-respectively; otherwise, basic docstrings are used.
-
-Finally, if FALLBACK is non-nil (by default, it's
-`browse-url-generic'), the function will call that if unable to
-start VIEWER."
+`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults
+to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of
+the function and variable respectively; otherwise a basic default doc-string is
+used.
+
+If FALLBACK is non-nil (the default is `browse-url-generic'), the
+generated function will call FALLBACK if unable to start PROGRAM
+for some reason."
(declare (indent 1))
`(progn
- (defcustom ,varname ,default-args
- ,(or doc (format "Arguments to pass to %s in `%s'." viewer name))
+ (defcustom ,var ,args
+ ,(or vardoc (format "Arguments to pass to %s in `%s'."
+ viewer name))
:type '(repeat :tag "Command-line argument" string)
:group ',custom-group)
(defun ,name (url &optional new-window)
- ,(or vardoc (format "Open URL in %s." viewer))
+ ,(or doc (format "Open URL in %s." viewer))
(interactive (browse-url-interactive-arg ,prompt))
(let* ((url (browse-url-encode-url url))
(process-environment (browse-url-process-environment)))
(message ,(format "Opening %%s in %s..." viewer) url)
(unless (ignore-errors (apply #'start-process
- (format "%s %s" ,viewer url) nil
- ,viewer
- (append ,varname (list url))))
+ (format "%s %s" ',viewer url)
+ nil
+ ,program
+ (append ,var (list url))))
,@(cond
- ((eq fallback t) '((browse-url-generic url new-window)))
(fallback `((funcall ,fallback url new-window)))
- (:else `((message "Can't find viewer: `%s'" ,viewer)
+ (:else `((message "Can't find viewer: %s" ,viewer)
nil))))))))
+;; Some default handlers
+
+(+browse-url-make-external-viewer-handler mpv
+ :args '("--cache-pause-wait=15"
+ "--cache-pause-initial=yes")
+ :prompt "Video URL: ")
+
+(+browse-url-make-external-viewer-handler mpv-image
+ :program (executable-find "mpv")
+ :args '("--image-display-duration=inf")
+ :prompt "Image URL: ")
+
+;;; Downloading
+
(defcustom +browse-url-download-open t
- "Whether to open downloaded files afterward."
- :group 'browse-url
+ "Whether to open downloaded files after downloading."
:type 'boolean)
+(defun +browse-url-download (url &rest _)
+ "Download URL to `eww-download-directory'."
+ (interactive "sDownload URL: ")
+ (let ((dir eww-download-directory))
+ (when (functionp dir) (setq dir (funcall dir)))
+ (make-directory dir :parents)
+ (url-retrieve url
+ (lambda (s u d)
+ (let ((file (+browse-url-download-callback s u d)))
+ (when +browse-url-download-open
+ (browse-url-xdg-open file))))
+ (list url dir))))
+
(defun +browse-url-download-callback (status url dir)
;; A slight change to `eww-download-callback' that returns the downloaded
;; filename.
@@ -71,18 +112,78 @@ start VIEWER."
(message "Saved %s" file)
file)))
-(defun +browse-url-download (url &rest _)
- "Download URL to `eww-download-directory'."
- (interactive "sDownload URL: ")
- (let ((dir eww-download-directory))
- (when (functionp dir) (setq dir (funcall dir)))
- (make-directory dir :parents)
- (url-retrieve url
- (lambda (s u d)
- (let ((file (+browse-url-download-callback s u d)))
- (when +browse-url-download-open
- (browse-url-xdg-open file))))
- (list url dir))))
+;;; URL matcher generators
+
+(defun +browse-url-matches (&rest regexps)
+ "Return a lambda that will determine if a url matches REGEXPS.
+Each regexp will be tested in turn. The first one that matches
+is returned by the lambda.
+
+This is a good function to use in key positions in `browse-url-handlers'."
+ `(lambda (url &optional new-window)
+ (cl-loop for regexp in ',regexps
+ if (string-match-p regexp url)
+ return regexp)))
+
+;;; External domains
+;; Some domains just don't open well in `eww'. The following function and user
+;; option define an easy way to automatically open those.
+
+(defcustom +browse-url-external-domains nil
+ "Domains to open in `browse-url-secondary-browser-function'.
+This is just a list of strings. They'll be regexp-escaped and
+passed to `+browse-url-external-url-p', which is a good function
+to put in `browse-url-handlers'.
+
+If an item in this list is a list itself, it should contain one string, a valid
+regexp that will not be regexp-quoted when matching against a url."
+ :type '(repeat (choice
+ (list :tag "Regexp" regexp)
+ (string :tag "Literal string"))))
+
+(defun +browse-url-external-url-p (url)
+ "Return t if URL is a member of `+browse-url-external-domains'.
+This function only tests URL's domain."
+ (let ((host (url-host (url-generic-parse-url url))))
+ (cl-loop for domain in +browse-url-external-domains
+ if (string-match-p (if (stringp domain)
+ (regexp-quote domain)
+ (car domain))
+ host)
+ return t)))
+
+;;; Switch to an external browser from an Emacs browser
+
+(defmacro +browse-url-switch-external-browser (mode url-fetcher-form)
+ "Create a function for MODE to open an external browser.
+URL-FETCHER-FORM will be used to get the URL of the current visited page."
+ (declare (indent 1))
+ `(defun ,(intern (format "+browse-url-external-from-%s" mode))
+ (&optional url)
+ "Browse URL with `browse-url-secondary-browser-function'.
+This will close the current buffer."
+ (interactive nil ,mode)
+ (condition-case e
+ (funcall browse-url-secondary-browser-function
+ (or url ,url-fetcher-form))
+ (:success (when (null url) (quit-window))) ; Interactive use
+ (t (signal (car e) (cdr e))))))
+
+;;; Mark `browse-url-browser-function' as safe
+
+(defcustom +browse-url-other-safe-browser-functions nil
+ "Other safe browser functions."
+ :type '(repeat function))
+
+(defun +browse-url-browser-function-safe-p (f)
+ "Return t if F is a safe browser function."
+ (memq f (append +browse-url-other-safe-browser-functions
+ (mapcar (lambda (i)
+ (plist-get (cdr i) :value))
+ (seq-filter (lambda (i)
+ (eq (car i) 'function-item))
+ (cdr (get 'browse-url-browser-function
+ 'custom-type)))))))
(provide '+browse-url)
;;; +browse-url.el ends here
diff --git a/lisp/+cape.el b/lisp/+cape.el
new file mode 100644
index 0000000..37e88fe
--- /dev/null
+++ b/lisp/+cape.el
@@ -0,0 +1,25 @@
+;;; cape.el -*- lexical-binding: t; -*-
+
+;;; Code:
+
+(require 'cape)
+
+(defmacro +cape-insinuate (hook capes &rest capfs)
+ "Insinuate CAPES for a mode.
+Add a function to HOOK that will add CAPES to the local
+`completion-at-point-functions' for that mode's buffer. If CAPFS
+are given, mark them all as non-exclusive."
+ (let ((fn (intern (format "+cape-insinuate@%s" hook))))
+ `(prog1
+ ,@(when capes
+ `((defun ,fn ()
+ ,@(cl-loop for cape in capes
+ collect `(add-hook 'completion-at-point-functions
+ #',cape 90 :local)))
+ (add-hook ',hook #',fn)))
+ ,@(cl-loop for capf in capfs
+ collect `(advice-add ',capf :around
+ #'cape-wrap-nonexclusive)))))
+
+(provide '+cape)
+;;; +cape.el ends here
diff --git a/lisp/+custom.el b/lisp/+custom.el
deleted file mode 100644
index ba4c55d..0000000
--- a/lisp/+custom.el
+++ /dev/null
@@ -1,52 +0,0 @@
-;;; +custom.el -*- lexical-binding: t -*-
-
-(require 'cl-lib)
-(require 'seq)
-
-(defgroup +custom nil
- "Group for extra `customize' customizations."
- :group 'customize)
-
-(defcustom +custom-allowed-variables nil
- "Variables to load during `+custom-load-some-customizations'."
- :type '(repeat symbol))
-
-(defcustom +custom-allowed-faces nil
- "Faces to load during `+custom-load-some-customziations'."
- :type '(repeat face))
-
-(defun +custom--filter-list (customlist allowlist)
- "Filter CUSTOMLIST to only include those items in ALLOWLIST.
-Each item in ALLOWLIST will be compared using `eq' to the `car'
-of each item in CUSTOMLIST. Items in CUSTOMLIST not included in
-ALLOWLIST will be removed from the return value."
- (seq-filter (lambda (el) (memq (car el) allowlist))
- customlist))
-
-(defcustom +custom-after-load-hook nil
- "Hook run after loading the custom file."
- :type 'hook)
-
-(defun +custom-load-some-customizations (&optional noerror
- nomessage
- nosuffix
- must-suffix)
- "Load `custom-file', ignoring most customizations.
-Only faces included in `+custom-allowed-faces' and variables
-included in `+custom-allowed-variables' will be loaded.
-
-All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX,
-MUST-SUFFIX---are passed to `load', which see."
- (cl-letf (((symbol-function 'custom-set-faces)
- (lambda (&rest args)
- (apply #'custom-theme-set-faces 'user
- (+custom--filter-list args +custom-allowed-faces))))
- ((symbol-function 'custom-set-variables)
- (lambda (&rest args)
- (apply #'custom-theme-set-variables 'user
- (+custom--filter-list args +custom-allowed-variables)))))
- (load custom-file noerror nomessage nosuffix must-suffix))
- (run-hooks '+custom-after-load-hook))
-
-(provide '+custom)
-;;; +custom.el ends here
diff --git a/lisp/+emacs.el b/lisp/+emacs.el
deleted file mode 100644
index 97377a3..0000000
--- a/lisp/+emacs.el
+++ /dev/null
@@ -1,422 +0,0 @@
-;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*-
-
-;;; Commentary:
-
-;; I find myself copy-pasting a lot of "boilerplate" type code when
-;; bankrupting my Emacs config and starting afresh. Instead of doing
-;; that, I'm putting it here, where it'll be easier to include in my
-;; config.
-
-;; Of course, some might say I could just ... stop bankrupting my
-;; Emacs. But like, why would I want to?
-
-;; Other notable packages include
-;; - https://git.sr.ht/~technomancy/better-defaults/
-;; - https://github.com/susam/emfy
-
-;;; Code:
-
-(require 'early-init (locate-user-emacs-file "early-init.el"))
-
-(defun +set-major-mode-from-buffer-name (&optional buf)
- "Set the major mode for BUF from the buffer's name.
-Do this only if the buffer is not visiting a file."
- (unless buffer-file-name
- (let ((buffer-file-name (buffer-name buf)))
- (set-auto-mode))))
-
-
-;;; General settings
-
-(setq-default
- apropos-do-all t
- async-shell-command-buffer 'new-buffer
- async-shell-command-display-buffer nil
- auto-hscroll-mode 'current-line
- auto-revert-verbose t
- auto-save-default nil
- auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms)))
- (".*" ,(.etc "auto-save/") t))
- auto-save-interval 30
- auto-save-list-file-prefix (.etc "auto-save/.saves-" t)
- auto-save-timeout 30
- auto-save-visited-interval 5
- auto-window-vscroll nil
- backup-by-copying t
- backup-directory-alist `((".*" . ,(.etc "backup/" t)))
- blink-cursor-blinks 1
- comp-deferred-compilation nil
- completion-category-defaults nil
- completion-category-overrides '((file (styles . (partial-completion))))
- completion-ignore-case t
- completion-styles '(substring partial-completion)
- create-lockfiles nil
- cursor-in-non-selected-windows 'hollow
- cursor-type 'bar
- custom-file (.etc "custom.el")
- delete-old-versions t
- echo-keystrokces 0.1
- ediff-window-setup-function 'ediff-setup-windows-plain
- eldoc-echo-area-use-multiline-p nil
- eldoc-idle-delay 0.1
- enable-recursive-minibuffers t
- executable-prefix-env t
- fast-but-imprecise-scrolling t
- file-name-shadow-properties '(invisible t intangible t)
- fill-column 80
- find-file-visit-truename t
- frame-resize-pixelwise t
- global-auto-revert-non-file-buffers t
- global-mark-ring-max 100
- hscroll-margin 1
- hscroll-step 1
- imenu-auto-rescan t
- image-use-external-converter (or (executable-find "convert")
- (executable-find "gm")
- (executable-find "ffmpeg"))
- indent-tabs-mode nil
- inhibit-startup-screen t
- initial-buffer-choice t
- kept-new-versions 6
- kept-old-versions 2
- kill-do-not-save-duplicates t
- kill-read-only-ok t
- kill-ring-max 500
- kmacro-ring-max 20
- load-prefer-newer noninteractive
- major-mode '+set-major-mode-from-buffer-name
- mark-ring-max 50
- minibuffer-eldef-shorten-default t
- minibuffer-prompt-properties (list 'read-only t
- 'cursor-intangible t
- 'face 'minibuffer-prompt)
- mode-require-final-newline 'visit-save
- mouse-drag-copy-region t
- mouse-wheel-progressive-speed nil
- mouse-yank-at-point t
- native-comp-async-report-warnings-errors 'silent
- native-comp-deferred-compilation nil
- read-answer-short t
- read-buffer-completion-ignore-case t
- ;; read-extended-command-predicate
- ;; (when (fboundp
- ;; 'command-completion-default-include-p)
- ;; 'command-completion-default-include-p)
- read-process-output-max 1048576 ; We’re in the future man. Set that to at least a megabyte
- recenter-positions '(top 2 middle bottom)
- regexp-search-ring-max 100
- regexp-search-ring-max 200
- save-interprogram-paste-before-kill t
- save-some-buffers-default-predicate #'+save-some-buffers-p
- scroll-conservatively 25
- scroll-margin 0
- scroll-preserve-screen-position 1
- scroll-step 1
- search-ring-max 200
- search-ring-max 200
- sentence-end-double-space t
- set-mark-command-repeat-pop t
- show-paren-delay 0
- show-paren-style 'parenthesis
- show-paren-when-point-in-periphery t
- show-paren-when-point-inside-paren t
- ;;show-trailing-whitespace t
- tab-bar-show 1
- tab-width 8 ; so alignment expecting the default looks right
- tramp-backup-directory-alist backup-directory-alist
- undo-limit 100000000 ; 10 MB
- use-dialog-box nil
- use-file-dialog nil
- use-short-answers t
- vc-follow-symlinks t
- vc-make-backup-files t
- version-control t
- view-read-only t
- visible-bell nil
- window-resize-pixelwise t
- x-select-enable-clipboard t
- x-select-enable-primary t
- yank-pop-change-selection t
- )
-
-;; Programming language offsets.
-;; Set these after the initial block so I can use `tab-width'
-(setq-default
- c-basic-offset tab-width)
-
-;; Emacs 28 ships with an option, `use-short-answers', that makes this form
-;; obsolete, but I still use 27 at work.
-(when (version< emacs-version "28")
- (fset 'yes-or-no-p 'y-or-n-p))
-
-
-;;; Encodings
-
-;; Allegedly, this is the only one you need...
-(set-language-environment "UTF-8")
-;; But I still set all of these, for fun.
-(setq-default locale-coding-system 'utf-8-unix
- coding-system-for-read 'utf-8-unix
- coding-system-for-write 'utf-8-unix
- buffer-file-coding-system 'utf-8-unix
- default-process-coding-system '(utf-8-unix . utf-8-unix)
- x-select-request-type '(UTF8_STRING
- COMPOUND_TEXT
- TEXT
- STRING))
-
-(set-charset-priority 'unicode)
-(prefer-coding-system 'utf-8-unix)
-(set-default-coding-systems 'utf-8-unix)
-(set-terminal-coding-system 'utf-8-unix)
-(set-keyboard-coding-system 'utf-8-unix)
-
-(pcase system-type
- ((or 'ms-dos 'windows-nt)
- (set-clipboard-coding-system 'utf-16-le)
- (set-selection-coding-system 'utf-16-le))
- (_
- (set-selection-coding-system 'utf-8)
- (set-clipboard-coding-system 'utf-8)))
-
-
-;;; Modes
-
-(dolist (enable-mode '(global-auto-revert-mode
- blink-cursor-mode
- electric-pair-mode
- show-paren-mode
- global-so-long-mode
- minibuffer-depth-indicate-mode
- file-name-shadow-mode
- minibuffer-electric-default-mode
- delete-selection-mode
- auto-save-visited-mode
- ;; column-number-mode
- ))
- (when (fboundp enable-mode)
- (funcall enable-mode +1)))
-
-(dolist (disable-mode '(tooltip-mode
- tool-bar-mode
- menu-bar-mode
- scroll-bar-mode
- horizontal-scroll-bar-mode))
- (when (fboundp disable-mode)
- (funcall disable-mode -1)))
-
-
-;;; Hooks
-
-(defun +auto-create-missing-dirs ()
- "Automatically create missing directories when finding a file."
- ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/
- (let ((target-dir (file-name-directory buffer-file-name)))
- (unless (file-exists-p target-dir)
- (make-directory target-dir t))))
-
-(defvar +save-some-buffers-debounce-time nil
- "Last time `+save-some-buffers-debounce' was run.")
-
-(defcustom +save-some-buffers-debounce-timeout 5
- "Number of seconds to wait before saving buffers again.")
-
-(defun +save-some-buffers-debounce (&rest _)
- "Run `save-some-buffers', but only if it's been a while."
- (unless (and +save-some-buffers-debounce-time
- (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
- +save-some-buffers-debounce-timeout))
- (save-some-buffers t)
- (setf +save-some-buffers-debounce-time (time-convert nil 'integer))))
-
-
-;;; Better-default functions ...
-
-(defun +cycle-spacing (&optional n preserve-nl-back mode)
- "Negate N argument on `cycle-spacing'.
-That is, with a positive N, deletes newlines as well, leaving -N
-spaces. If N is negative, it will not delete newlines and leave
-N spaces. See docstring of `cycle-spacing' for the meaning of
-PRESERVE-NL-BACK and MODE."
- (interactive "*p")
- (cycle-spacing (- n)))
-
-(defun +save-buffers-quit (&optional arg)
- "Silently save each buffer, then kill the current connection.
-If the current frame has no client, kill Emacs itself using
-`save-buffers-kill-emacs' after confirming with the user.
-
-With prefix ARG, silently save all file-visiting buffers, then
-kill without asking."
- (interactive "P")
- (save-some-buffers t)
- (if (and (not (frame-parameter nil 'client))
- (and (not arg)))
- (when (yes-or-no-p "Sure you want to quit? ")
- (save-buffers-kill-emacs))
- (delete-frame nil :force)))
-
-(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn)
- "Kill active region or ARG words backward.
-BACKWARD-KILL-WORD-FN is the function to call to kill a word
-backward. It defaults to `backward-kill-word'."
- (interactive "P")
- (call-interactively (if (region-active-p)
- #'kill-region
- (or backward-kill-word-fn #'backward-kill-word))))
-
-(defun +backward-kill-word-wrapper (fn &optional arg)
- "Kill backward using FN until the beginning of a word, smartly.
-If point is on at the beginning of a line, kill the previous new
-line. If the only thing before point on the current line is
-whitespace, kill that whitespace.
-
-With argument ARG: if ARG is a number, just call FN
-ARG times. Otherwise, just call FN."
- ;; I want this to be a wrapper so that I can call other word-killing functions
- ;; with it. It's *NOT* advice because those functions probably use
- ;; `backward-kill-word' under the hood (looking at you, paredit), so advice
- ;; will make things weird.
- (if (null arg)
- (cond
- ((looking-back "^" 1)
- (let ((delete-active-region nil))
- (delete-backward-char 1)))
- ((looking-back "^[ ]*")
- (delete-horizontal-space :backward-only))
- (t (call-interactively fn)))
- (funcall fn (if (listp arg) 1 arg))))
-
-(defun +backward-kill-word (&optional arg)
- "Kill word backward using `backward-kill-word'.
-ARG is passed to `backward-kill-word'."
- (interactive "P")
- (+backward-kill-word-wrapper #'backward-kill-word arg))
-
-;;; ... and advice
-
-;; Indent the region after a yank.
-(defun +yank@indent (&rest _)
- "Indent the current region."
- (indent-region (min (point) (mark)) (max (point) (mark))))
-;; (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
-
-(defun +save-some-buffers-p ()
- "Predicate for `save-some-buffers-default-predicate'.
-It returns nil with remote files and those without attached files."
- (and (buffer-file-name)
- (not (file-remote-p (buffer-file-name)))))
-
-;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block
-(defun +goto-matching-paren (&optional arg)
- "Go to the matching paren, similar to vi's %."
- (interactive "p")
- (or arg (setf arg 1))
- (cond
- ;; Check for "outside of bracket" positions
- ((looking-at "[\[\(\{]") (forward-sexp arg))
- ((looking-back "[\]\)\}]" 1) (backward-sexp arg))
- ;; Otherwise, move from inside the bracket
- ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg))
- ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg))
- (t (up-list arg t t))))
-
-(defun +delete-window-or-bury-buffer ()
- "Delete the current window, or bury the current buffer.
-If the current window is the only window, bury the buffer."
- (interactive)
- (condition-case e
- (delete-window)
- (t (bury-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
- uniquify-after-kill-buffer-p t
- uniquify-ignore-buffers-re "^\\*"))
-
-(when (require 'goto-addr)
- (if (fboundp 'global-goto-address-mode)
- (global-goto-address-mode +1)
- (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
-
-(when (require 'recentf nil :noerror)
- (setq-default recentf-save-file (.etc "recentf.el")
- recentf-max-menu-items 100
- recentf-max-saved-items nil
- recentf-auto-cleanup 'mode)
- (add-to-list 'recentf-exclude .etc)
- (recentf-mode +1))
-
-(when (require 'savehist nil :noerror)
- (setq-default history-length t
- history-delete-duplicates t
- history-autosave-interval 60
- savehist-file (.etc "savehist.el")
- ;; Other variables --- don't truncate any of these.
- ;; `add-to-history' uses the values of these variables unless
- ;; they're nil, in which case it falls back to `history-length'.
- kill-ring-max 100
- mark-ring-max 100
- global-mark-ring-max 100
- regexp-search-ring-max 100
- search-ring-max 100
- kmacro-ring-max 100
- eww-history-limit 100)
- (dolist (var '(extended-command-history
- global-mark-ring
- mark-ring
- kill-ring
- kmacro-ring
- regexp-search-ring
- search-ring))
- (add-to-list 'savehist-additional-variables var))
- (savehist-mode +1))
-
-(when (require 'saveplace nil :noerror)
- (setq-default save-place-file (.etc "places.el")
- save-place-forget-unreadable-files (eq system-type 'gnu/linux))
- (save-place-mode +1))
-
-;; (when (require 'tramp)
-;; ;; thanks Irreal! https://irreal.org/blog/?p=895
-;; (add-to-list 'tramp-default-proxies-alist
-;; '(nil "\\`root\\'" "/ssh:%h:"))
-;; (add-to-list 'tramp-default-proxies-alist
-;; '((regexp-quote (system-name)) nil nil)))
-
-
-;;; Newer features
-;; These aren't in older version of Emacs, but they're so nice.
-
-(when (fboundp 'repeat-mode)
- (setq-default repeat-exit-key "g"
- repeat-exit-timeout 5)
- (repeat-mode +1))
-
-(when (fboundp 'pixel-scroll-precision-mode)
- (pixel-scroll-precision-mode +1))
-
-(provide '+emacs)
-;;; +emacs.el ends here
diff --git a/lisp/+emms.el b/lisp/+emms.el
new file mode 100644
index 0000000..a43daea
--- /dev/null
+++ b/lisp/+emms.el
@@ -0,0 +1,38 @@
+;;; +emms.el -*- lexical-binding: t; -*-
+
+(defun +emms-streams (&optional file)
+ "Better interface for `emms-streams'.
+If FILE is non-nil, use it. Otherwise use `emms-streams-file'.
+If `emms-streams-file' is nil or this function is called with
+\\[universal-argument], prompt the user."
+ (interactive
+ (list (cond
+ ((or emms-streams-file
+ (not current-prefix-arg))
+ emms-streams-file)
+ (:else (read-file-name "Stream file: "
+ emms-source-file-default-directory)))))
+ (when (and (not (file-exists-p emms-streams-file))
+ (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?"))
+ (emms-streams-install))
+ (let ((buf (get-buffer emms-streams-buffer-name)))
+ (when (not buf)
+ (with-current-buffer (get-buffer-create emms-streams-buffer-name)
+ (setq buf (current-buffer))
+ (emms-playlist-mode)
+ (setq emms-playlist-buffer-p t)
+ (emms-playlist-set-playlist-buffer (current-buffer))
+ (with-current-buffer (find-file-noselect emms-streams-file)
+ (cond
+ ((emms-source-playlist-native-p)
+ (emms-add-native-playlist emms-streams-file))
+ ((emms-source-playlist-m3u-p)
+ (emms-add-m3u-playlist emms-streams-file))
+ ((emms-source-playlist-pls-p)
+ (emms-add-pls-playlist emms-streams-file))
+ (:else (error "Streams file `%s' isn't in a known format."
+ emms-streams-file))))))
+ (switch-to-buffer buf)))
+
+(provide '+emms)
+;;; +emms.el ends here
diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el
new file mode 100644
index 0000000..601aecf
--- /dev/null
+++ b/lisp/+hungry-delete.el
@@ -0,0 +1,53 @@
+;;; +hungry-delete.el -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Case Duckworth
+
+;;; Code:
+
+(require 'hungry-delete)
+
+(defmacro +hungry-delete-define-alternative (func hd-func &optional direction)
+ "Define a `hungry-delete' alternative for FUNC.
+If the adjacent characters in DIRECTION are one of
+`hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call
+FUNC.
+
+If DIRECTION is a positive integer or `forward', look forward.
+If it's negative or `backward', look backward. If it's absent,
+this macro will try to guess based on the names of FUNC and
+HD-FUNC.
+
+This macro creates a function taking a prefix argument that's
+passed to both of FUNC and HD-FUNC."
+ (let ((name (intern (format "%s|%s" func hd-func)))
+ (lookfn (cond
+ ((or (and (string-match-p "forward" (symbol-name func))
+ (string-match-p "forward" (symbol-name hd-func))
+ (not direction))
+ (and (integerp direction)
+ (< 0 direction))
+ (eq direction 'forward))
+ 'looking-at)
+ ((or (and (string-match-p "backward" (symbol-name func))
+ (string-match-p "backward" (symbol-name hd-func))
+ (not direction))
+ (and (integerp direction)
+ (> 0 direction))
+ (eq direction 'backward))
+ 'looking-back)
+ (:else (error "Bad direction: %S" direction))))
+ (arg (gensym)))
+ `(defun ,name (,arg)
+ ,(concat (format "Do `%s' or `%s', depending on whitespace.\n"
+ func hd-func)
+ (format "Pass prefix argument %s to the underlying functions.\n"
+ (upcase (symbol-name arg)))
+ "This function was defined by `define-hungry-delete-alternative'.")
+ (interactive "*p") ; This is brittle
+ (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip))
+ (,hd-func (or ,arg 1))
+ (,func ,arg)))))
+
+(provide '+hungry-delete)
+;;; +hungry-delete.el ends here
+
diff --git a/lisp/+isearch.el b/lisp/+isearch.el
new file mode 100644
index 0000000..3516ec4
--- /dev/null
+++ b/lisp/+isearch.el
@@ -0,0 +1,24 @@
+;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*-
+
+;;; From https://github.com/astoff/isearch-mb/wiki
+
+(defun +isearch-cancel@add-search-to-history ()
+ "Add search string to history also when canceling.
+This should be used as `:before' advice on `isearch-cancel'."
+ (unless (string-equal "" isearch-string)
+ (isearch-update-ring isearch-string isearch-regexp)))
+
+(defun +perform-replace-dont-exit-on-anykey (orig &rest args)
+ "Don't exit replace for anykey that's not in `query-replace-map'.
+This should be used as `:around' advice for `perform-replace'."
+ (save-window-excursion
+ (cl-letf* ((lookup-key-orig
+ (symbol-function 'lookup-key))
+ ((symbol-function 'lookup-key)
+ (lambda (map key &optional accept-default)
+ (or (apply lookup-key-orig map key accept-default)
+ (when (eq map query-replace-map) 'help)))))
+ (apply orig args))))
+
+(provide '+isearch)
+;;; +isearch.el ends here
diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el
index 74b9b77..5df6e5b 100644
--- a/lisp/+notmuch.el
+++ b/lisp/+notmuch.el
@@ -60,11 +60,11 @@ for search."
'notmuch-address-history)))
(:else
(defun notmuch-address-selection-function (prompt collection initial-input)
- "Call (`completing-read'
+ "Call (`completing-read'
PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
- (completing-read
- prompt collection nil nil nil
- 'notmuch-address-history)))))
+ (completing-read
+ prompt collection nil nil nil
+ 'notmuch-address-history)))))
(defcustom +notmuch-spam-tags '("+spam" "+Spam")
"A list of tag changes to apply when marking a thread as spam."
@@ -101,5 +101,49 @@ This function advances the next thread when finished."
(when (eq beg end)
(notmuch-search-next-thread)))
+(defun +notmuch-tree-beginning (&optional arg)
+ "Move point to beginning of message or tree, depending on ARG."
+ (interactive "P")
+ (cond
+ ((and (window-live-p notmuch-tree-message-window)
+ (not arg))
+ (with-selected-window notmuch-tree-message-window
+ (beginning-of-buffer)))
+ (:else (beginning-of-buffer))))
+
+(defun +notmuch-tree-end (&optional arg)
+ "Move point to end of message or tree, depending on ARG."
+ (interactive "P")
+ (cond
+ ((and (window-live-p notmuch-tree-message-window)
+ (not arg))
+ (with-selected-window notmuch-tree-message-window
+ (end-of-buffer)))
+ (:else (end-of-buffer))))
+
+(defun +notmuch-make-saved-search (name key search-type &rest queries)
+ "Wrapper to ease `notmuch-saved-searches' defining.
+NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
+`notmuch-saved-searches', which see. QUERIES are all concatenated together with
+AND. If QUERIES is prepended with more keyword arguments, those are added to
+the saved search as well."
+ (declare (indent 3))
+ (let (extra-keywords)
+ (while (keywordp (car queries))
+ (push (cadr queries) extra-keywords)
+ (push (car queries) extra-keywords)
+ (setf queries (cddr queries)))
+ (add-to-list 'notmuch-saved-searches
+ (append
+ (list :name name
+ :key key
+ :search-type search-type
+ :query (apply #'+notmuch-query-concat queries))
+ (reverse extra-keywords))
+ :append
+ (lambda (a b)
+ (equal (plist-get a :name)
+ (plist-get b :name))))))
+
(provide '+notmuch)
;;; +notmuch.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el
index 06dfcfd..2f7bf6a 100644
--- a/lisp/+org-capture.el
+++ b/lisp/+org-capture.el
@@ -1,164 +1,49 @@
-;;; +org-capture.el -*- lexical-binding: t; -*-
+;;; +org-capture.el -*- lexical-binding: t; -*-
;;; Code:
(require 'cl-lib)
-(require 'acdw)
-;; We don't require `org-capture' here because I'll have to require this library
-;; to init.el /before/ org-capture is fully needed. But I do need to declare
-;; `org-capture-templates'.
+;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll
+;; take a minute. Just let the compiler know that this variable exists.
(defvar org-capture-templates nil)
-(defun +org-capture--get (key &optional list)
- "Find KEY in LIST, or return nil.
-LIST defaults to `org-capture-templates'."
- (alist-get key (or list org-capture-templates) nil nil #'equal))
-
-;; 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)
- (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)
- (funcall do `(cdr ,p)
- (lambda (v)
- (macroexp-let2 nil v v
- (let ((set-exp
- `(if ,p (setcdr ,p ,v)
- ,(funcall setter
- `(cons (setf ,p (cons ,k ,v))
- ,getter)))))
- `(progn
- ,set-exp
- ,v))))))))))
-
-(defun +org-capture-sort (&optional list)
- "Sort LIST by string keys.
-LIST is a symbol and defaults to `org-capture-templates'."
- (setf list (or list 'org-capture-templates))
- (set list (sort (symbol-value list) (lambda (a b)
- (string< (car a) (car b))))))
-
-(defun +org-capture-sort-after-init (&optional list)
- "Sort LIST with `+org-capture-sort' after Emacs init."
- (+ensure-after-init #'+org-capture-sort))
-
-;;;###autoload
-(defun +org-capture-templates-setf (key value &optional list sort-after)
- "Add KEY to LIST, using `setf'.
-LIST is a symbol and defaults to `org-capture-templates' -- so
-this function sets values on a list that's structured as such.
-
-Thus, KEY is a string key. If it's longer than one character,
-this function will search LIST for each successive run of
-characters before the final, ensuring sub-lists exist of the
-form (CHARS DESCRIPTION).
-
-For example, if KEY is \"abc\", first a LIST item of the form (a
-DESCRIPTION), if non-existant, will be added to the list (with a
-default description), then an item of the
-form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST.
-
-VALUE is the template or group header required for
-`org-capture-templates', which see.
-
-SORT-AFTER, when set to t, will call
-`+org-capture-templates-sort' after setting, to ensure org can
-properly process the variable."
- ;; LIST defaults to `org-capture-templates'
- (declare (indent 2))
- (unless list (setf list 'org-capture-templates))
- ;; Ensure VALUE is a list to cons properly
- (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))
- collect (substring key 0 i) into keys
- finally return keys)))
- (cl-loop for ek in expected
- if (not (+org-capture--get ek (symbol-value list))) do
- (setf (+org-capture--get ek (symbol-value list))
- (list (format "(Group %s)" ek))))))
- (prog1 ;; Set KEY to VALUE
- (setf (+org-capture--get key (symbol-value list)) value)
- ;; Sort after, maybe
- (when sort-after (+org-capture-sort list))))
-
-(defun +org-template--ensure-path (keys &optional list)
- "Ensure path of keys exists in `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))
- collect (substring key 0 i) into keys
- finally return keys)))
- (cl-loop for ek in expected
- if (not (+org-capture--get ek (symbol-value list))) do
- (setf (+org-capture--get ek (symbol-value list))
- (list (format "(Group %s)" ek)))))))
-
-(defcustom +org-capture-default-type 'entry
- "Default template for `org-capture-templates'."
- :type '(choice (const :tag "Entry" entry)
- (const :tag "Item" item)
- (const :tag "Check Item" checkitem)
- (const :tag "Table Line" table-line)
- (const :tag "Plain Text" plain)))
-
-(defcustom +org-capture-default-target ""
- "Default target for `org-capture-templates'."
- ;; TODO: type
- )
-
-(defcustom +org-capture-default-template nil
- "Default template for `org-capture-templates'."
- ;; TODO: type
- )
-
-(defun +org-define-capture-templates-group (keys description)
- "Add a group title to `org-capture-templates'."
- (setf (+org-capture--get keys org-capture-templates)
- (list description)))
-
-;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]]
-(defun +org-define-capture-template (keys description &rest args)
- "Define a capture template and necessary antecedents.
-ARGS is a plist, which in addition to the additional options
-`org-capture-templates' accepts, takes the following and places
-them accordingly: :type, :target, and :template. Each of these
-corresponds to the same field in `org-capture-templates's
-docstring, which see. Likewise with KEYS and DESCRIPTION, which
-are passed separately to the function.
-
-This function will also create all the necessary intermediate
-capture keys needed for `org-capture'; that is, if KEYS is
-\"wcp\", entries for \"w\" and \"wc\" will both be ensured in
-`org-capture-templates'."
- (declare (indent 2))
- ;; Check for existence of parent groups
- (when (> (length keys) 1)
- (let ((expected (cl-loop for i from 1 to (1- (length keys))
- collect (substring 0 i) into keys
- finally return keys)))
- (cl-loop
- for ek in expected
- if (not (+org-capture--get ek org-capture-templates))
- do (+org-define-capture-templates-group ek (format "(Group %s)" ek)))))
- (if (null args)
- ;; Add the title
- (+org-define-capture-templates-group keys description)
- ;; Add the capture template.
- (setf (+org-capture--get keys org-capture-templates)
- (append (list (or (plist-get args :type)
- +org-capture-default-type)
- (or ( plist-get args :target)
- +org-capture-default-target)
- (or (plist-get args :template)
- +org-capture-default-template))
- (cl-loop for (key val) on args by #'cddr
- unless (member key '(:type :target :template))
- append (list key val))))))
+;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573
+(defun +org-capture-template-define (description &rest args)
+ "Define a capture template.
+Creates a list and adds it to `org-capture-templates', if it's
+not already there. ARGS is a plist, which in addition to the
+additional options `org-capture-templates' accepts (which see),
+takes the following and puts them in the right spot: `:keys',
+`:description', `:type', `:target', and `:template'."
+ (declare (indent 1))
+ (let* ((keys (plist-get args :keys))
+ (type (plist-get args :type))
+ (target (plist-get args :target))
+ (template (plist-get args :template))
+ (template-value (append
+ (list description)
+ (when (or type target template)
+ (list (or type 'entry) target template))
+ (cl-loop for i from 0 below (length args) by 2
+ unless (member (nth i args)
+ '(:keys :description :type
+ :target :template))
+ append (list (nth i args)
+ (plist-get args (nth i
+ args)))))))
+ ;; The only way I know how to do this properly (add a value to the end of
+ ;; the list, if it exists; otherwise update it) is to do this weird if-setf
+ ;; dance.
+ (if (seq-find (lambda (el) (equal (car el) keys))
+ org-capture-templates)
+ (setf (alist-get keys org-capture-templates nil nil #'equal)
+ template-value)
+ (setf org-capture-templates
+ (append org-capture-templates
+ (list (cons keys template-value)))))
+ ;; Regardless of what we do, return the new value of
+ ;; `org-capture-templates'.
+ org-capture-templates))
(provide '+org-capture)
-;;; +org-capture.el ends here
+;;; +org-capture.el
diff --git a/lisp/+org.el b/lisp/+org.el
index 7698ec9..a148bd8 100644
--- a/lisp/+org.el
+++ b/lisp/+org.el
@@ -1,7 +1,13 @@
-;;; +org.el --- -*- lexical-binding: t -*-
+;;; +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]]
+;;; Code:
+
+(require 'cl-lib)
+(require 'seq)
+
+;;; Org-return DWIM
+;; https://github.com/alphapapa/unpackaged.el,
+;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
(defun +org-element-descendant-of (type element)
"Return non-nil if ELEMENT is a descendant of TYPE.
@@ -94,53 +100,13 @@ With PREFIX, call `org-return'."
(t ; Otherwise---just call `org-return'.
(org-return))))
-(defun +org-table-copy-down|+org-return (&optional n)
+(defun +org-table-copy-down|+org-return-dwim (&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]].
-(defun +org-export-clip-to-html
- (&optional async subtreep visible-only body-only ext-plist post-process)
- "Export region to HTML, and copy it to the clipboard.
-Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
-and POST-PROCESS are passed to `org-export-to-file'."
- (interactive) ; XXX: hould this be interactive?
- (message "Exporting Org to HTML...")
- (let ((org-tmp-file "/tmp/org.html"))
- (org-export-to-file 'html org-tmp-file
- async subtreep visible-only body-only ext-plist post-process)
- (start-process "xclip" "*xclip*"
- "xclip" "-verbose"
- "-i" org-tmp-file
- "-t" "text/html"
- "-selection" "clipboard"))
- (message "Exporting Org to HTML...done."))
-
-;; Specialized functions
-(defun +org-export-clip-subtree-to-html ()
- "Export current subtree to HTML."
- (interactive)
- (+org-export-clip-to-html nil :subtree))
-
-;;; Unsmartify quotes and dashes and stuff.
-
-(defun +org-unsmartify ()
- "Replace \"smart\" punctuation with their \"dumb\" counterparts."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "[“”‘’–—]" nil t)
- (let ((replace (pcase (match-string 0)
- ((or "“" "”") "\"")
- ((or "‘" "’") "'")
- ("–" "--")
- ("—" "---"))))
- (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
@@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'."
(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)))
@@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'."
(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.
-
-;;; Inhibit hooks on `org-agenda'
-;; It's really annoying when I call `org-agenda' and five hundred Ispell
-;; processes are created because I have `flyspell-mode' in the hook. This mode
-;; inhibits those hooks when entering the agenda, but runs them when opening the
-;; actual buffer.
-
-(defun +org-agenda-inhibit-hooks (fn &rest r)
- "Advice to inhibit hooks when entering `org-agenda'."
- (let ((org-mode-hook nil))
- (apply fn r)))
-
-(defvar-local +org-hook-has-run-p nil
- "Whether `org-mode-hook' has run in the current buffer.")
-
-(defun +org-agenda-switch-run-hooks (&rest _)
- "Advice to run `org-mode-hook' when entering org-mode.
-This should only fire when switching to a buffer from `org-agenda'."
- (unless +org-hook-has-run-p
- (run-hooks 'org-mode-hook)
- (setq +org-hook-has-run-p t)))
-
-(define-minor-mode +org-agenda-inhibit-hooks-mode
- "Inhibit `org-mode-hook' when opening `org-agenda'."
- :lighter " A/h"
- :global t
- (cond (+org-agenda-inhibit-hooks-mode
- (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks)
- (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks))
- (:else
- (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks)
- (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks))))
-
-;;; Drawers
+;;; Unsmartify
+
+(defun +org-unsmartify ()
+ "Replace \"smart\" punctuation with their \"dumb\" counterparts."
+ (interactive)
+ (save-excursion
+ (goto-char (point-min))
+ (while (re-search-forward "[“”‘’–—]" nil t)
+ (let ((replace (pcase (match-string 0)
+ ((or "“" "”") "\"")
+ ((or "‘" "’") "'")
+ ("–" "--")
+ ("—" "---"))))
+ (replace-match replace nil nil)))))
+
+;;; Copy org trees as HTML
+;; Thanks to Oleh Krehel:
+;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
+
+(defun +org-export-clip-to-html
+ (&optional async subtreep visible-only body-only ext-plist post-process)
+ "Export region to HTML, and copy it to the clipboard.
+Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
+and POST-PROCESS are passed to `org-export-to-file'."
+ (interactive) ; XXX: hould this be interactive?
+ (message "Exporting Org to HTML...")
+ (let ((org-tmp-file "/tmp/org.html"))
+ (org-export-to-file 'html org-tmp-file
+ async subtreep visible-only body-only ext-plist post-process)
+ ;; XXX: figure out which clipboard to use, or use something in Emacs
+ (start-process "xclip" "*xclip*"
+ "xclip" "-verbose"
+ "-i" org-tmp-file
+ "-t" "text/html"
+ "-selection" "clipboard"))
+ (message "Exporting Org to HTML...done."))
+
+;; Specialized functions
+(defun +org-export-clip-subtree-to-html ()
+ "Export current subtree to HTML."
+ (interactive)
+ (+org-export-clip-to-html nil :subtree))
+
+;;; Hide drawers on save, except the currently-expanded one
+
(defun +org-hide-drawers-except-point ()
- "Hide all drawers except for the one point is in."
- ;; Most of this bit is taken from `org-fold--hide-drawers'.
- (let ((pt (point))
- (begin (point-min))
- (end (point-max)))
- (save-excursion
- (goto-char begin)
- (while (and (< (point) end)
- (re-search-forward org-drawer-regexp end t))
- (if (org-fold-folded-p nil 'drawer)
- (goto-char (org-fold-next-folding-state-change 'drawer nil end))
- (let* ((drawer (org-element-at-point))
- (type (org-element-type drawer))
- (el-begin (org-element-property :begin drawer))
- (el-end (org-element-property :end drawer)))
- (when (memq type '(drawer property-drawer))
- (org-fold-hide-drawer-toggle
- (if (< el-begin pt el-end) 'off 'on)
- nil drawer)
- (goto-char el-end))))))))
+ "Hide all drawers except for the one point is in."
+ ;; Most of this bit is taken from `org-fold--hide-drawers'.
+ (let ((pt (point))
+ (begin (point-min))
+ (end (point-max)))
+ (save-excursion
+ (goto-char begin)
+ (while (and (< (point) end)
+ (re-search-forward org-drawer-regexp end t))
+ (if (org-fold-folded-p nil 'drawer)
+ (goto-char (org-fold-next-folding-state-change 'drawer nil end))
+ (let* ((drawer (org-element-at-point))
+ (type (org-element-type drawer))
+ (el-begin (org-element-property :begin drawer))
+ (el-end (org-element-property :end drawer)))
+ (when (memq type '(drawer property-drawer))
+ (org-fold-hide-drawer-toggle
+ (if (< el-begin pt el-end) 'off 'on)
+ nil drawer)
+ (goto-char el-end))))))))
+
+;;; Define `ol' link types
+
+(defmacro +org-link-define-type (type args &rest body)
+ "Define an org link TYPE.
+A function named `+org-link-TYPE-open' will be created, with ARGS
+as its arguments and BODY as its body. BODY can be blank, in
+which case the user will be messaged (This is a good do-nothing
+effect for exporting link types)."
+ (declare (indent 2)
+ (doc-string 3)
+ (debug (sexp sexp def-body)))
+ (let ((fn (intern (format "+org-link-%s-open" type)))
+ (body (or body `((message ,(format "%S: %%S" type)
+ ,(car args)))))
+ (type-string (format "%S" type)))
+ `(prog1
+ (defun ,fn ,args ,@body)
+ (org-link-set-parameters ,type-string :follow #',fn))))
+
+;;; Skip some files in `org-agenda'
+
+(defcustom org-agenda-file-skip-regexp nil
+ "Files matching this regexp are removed from `org-agenda-files'."
+ :group 'org-agenda)
+
+(defun org-agenda-files@skip-regexp (files)
+ "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'."
+ (when org-agenda-file-skip-regexp
+ (setq files
+ (seq-remove (lambda (file)
+ (string-match-p
+ org-agenda-file-skip-regexp file))
+ files)))
+ files)
+
+;;; Prompt for stuff
+
+(defun +org-prompt-for-property (property &optional clipboardp insert list)
+ "Prompt for PROPERTY and return a properly-formatted string.
+Pre-fill the input with clipboard contents if they match CLIPBOARDP. If
+CLIPBOARDP is nil or missing, don't pre-fill.
+
+If INSERT is non-nil, insert the property into the property
+drawer of the current org tree.
+
+If LIST is non-nil, return the result as a list instead of a string."
+ (let* ((kill (current-kill 0))
+ (value (read-string (concat property ": ")
+ (when (and clipboardp
+ (or (eq clipboardp t)
+ (funcall clipboardp kill)))
+ kill))))
+ (when insert
+ (org-set-property property value))
+ (if list
+ (list property value)
+ (format ":%s: %s" property value))))
+(defun +org-prompt-tags (&optional prompt global)
+ (let* ((buffer (org-capture-get :buffer))
+ (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
+ (org-last-tags-completion-table
+ (org-global-tags-completion-table
+ (if global (org-agenda-files) (list file))))
+ (org-add-colon-after-tag-completion t)
+ (ins (mapconcat
+ #'identity
+ (let ((crm-separator "[ \t]*:[ \t]*"))
+ (completing-read-multiple
+ (or prompt "Tags: ")
+ org-last-tags-completion-table nil nil nil
+ 'org-tags-history))
+ ":")))
+ (when (org-string-nw-p ins)
+ (prog1 (concat
+ (unless (eq (char-before) ?:) ":")
+ ins
+ (unless (eq (char-after) ?:) ":"))
+ (when (org-at-heading-p) (org-align-tags))))))
(provide '+org)
+;;; +org.el ends here
diff --git a/lisp/+ox.el b/lisp/+ox.el
deleted file mode 100644
index 8748a55..0000000
--- a/lisp/+ox.el
+++ /dev/null
@@ -1,29 +0,0 @@
-;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*-
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'ox)
-
-;;; Run hooks before doing any exporting at all
-
-(defcustom +org-export-pre-hook nil
- "Functions to run /before/ `org-export-as' does anything.
-These will run on the buffer about to be exported, NOT a copy."
- :type 'hook)
-
-(defun +org-export-pre-run-hooks (&rest _)
- "Run hooks in `+org-export-pre-hook'."
- (run-hooks '+org-export-pre-hook))
-
-(defun +org-export-pre-hooks-insinuate ()
- "Advise `org-export-as' to run `+org-export-pre-hook'."
- (advice-add 'org-export-as :before #'+org-export-pre-run-hooks))
-
-(defun +org-export-pre-hooks-remove ()
- "Remove pre-hook advice on `org-export-as'."
- (advice-remove 'org-export-as #'+org-export-pre-run-hooks))
-
-(provide '+ox)
-;;; +ox.el ends here
diff --git a/lisp/+paredit.el b/lisp/+paredit.el
new file mode 100644
index 0000000..ab176b8
--- /dev/null
+++ b/lisp/+paredit.el
@@ -0,0 +1,26 @@
+;;; +paredit.el -*- lexical-binding: t -*-
+
+;;; Fixing unquote-splicing behaviour with Paredit
+;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/
+
+(require 'paredit)
+(require 'seq)
+
+(defcustom +paredit-no-space-prefixes '(",@")
+ "Prefix strings to not insert a space after in `paredit'."
+ :group 'paredit
+ :type '(repeat string))
+
+(defun +paredit-space-for-delimiter (endp delimiter)
+ (let ((point (point)))
+ (or endp
+ (seq-every-p
+ (lambda (prefix)
+ (and (> point (length prefix))
+ (let ((start (- point (length prefix)))
+ (end point))
+ (not (string= (buffer-substring start end) prefix)))))
+ +paredit-no-space-prefixes))))
+
+(provide '+paredit)
+;;; +paredit.el ends here
diff --git a/lisp/+tempo.el b/lisp/+tempo.el
deleted file mode 100644
index 2c81e54..0000000
--- a/lisp/+tempo.el
+++ /dev/null
@@ -1,45 +0,0 @@
-;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*-
-
-(require 'tempo)
-(declare-function derived-mode-abbrev-table-name "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
- ,(or abbrev tag)
- ,doc
- ,taglist)))
- (define-abbrev ,table ,tag "" ,template :system t)
- (put ,template 'no-self-insert t))))
-
-(provide '+tempo)
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el
index 9266807..6defda7 100644
--- a/lisp/+titlecase.el
+++ b/lisp/+titlecase.el
@@ -22,11 +22,13 @@ With prefix ARG, toggle the value of
;; See also `org-map-tree'. I'm not using that function because I want to
;; skip the first headline. A better solution would be to patch
;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
- (let ((level (funcall outline-level)))
+ (let ((level (funcall outline-level))
+ (org-special-ctrl-a/e t))
(while (and (progn (outline-next-heading)
(> (funcall outline-level) level))
(not (eobp)))
- (titlecase-line)))))
+ (titlecase-region (org-beginning-of-line)
+ (org-end-of-line))))))
(provide '+titlecase)
;;; +titlecase.el ends here
diff --git a/lisp/+window.el b/lisp/+window.el
deleted file mode 100644
index 52b3712..0000000
--- a/lisp/+window.el
+++ /dev/null
@@ -1,130 +0,0 @@
-;;; +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
diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el
new file mode 100644
index 0000000..80b2bcc
--- /dev/null
+++ b/lisp/acdw-defaults.el
@@ -0,0 +1,292 @@
+;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*-
+;; by C. Duckworth <acdw@acdw.net>
+
+;;; Commentary:
+
+;; I find myself copy-pasting a lot of "boilerplate" type code when
+;; bankrupting my Emacs config and starting afresh. Instead of doing
+;; that, I'm putting it here, where it'll be easier to include in my
+;; config.
+
+;; Of course, some might say I could just ... stop bankrupting my
+;; Emacs. But like, why would I want to?
+
+;;; Code:
+
+(require 'seq)
+
+(defvar default-ring-max 256
+ "Default maximum for ring variables.")
+
+(unless (boundp 'use-short-answers)
+ (fset 'yes-or-no-p 'y-or-n-p))
+
+(setc async-shell-command-buffer 'new-buffer
+ async-shell-command-display-buffer nil
+ auto-hscroll-mode t
+ auto-window-vscroll nil
+ cursor-in-non-selected-windows 'hollow
+ cursor-type 'bar
+ echo-keystrokes 0.01
+ fast-but-imprecise-scrolling t
+ fill-column 80
+ global-mark-ring-max default-ring-max
+ hscroll-margin 1
+ hscroll-step 1
+ inhibit-startup-screen t
+ initial-buffer-choice t
+ kill-do-not-save-duplicates t
+ kill-read-only-ok t
+ kill-ring-max default-ring-max
+ kmacro-ring-max default-ring-max
+ mark-ring-max default-ring-max
+ read-answer-short t
+ read-process-output-max (* 10 1024 1024)
+ ring-bell-function #'ignore
+ save-interprogram-paste-before-kill t
+ scroll-conservatively 25
+ scroll-margin 0
+ scroll-preserve-screen-position 1
+ scroll-step 1
+ sentence-end-double-space t
+ set-mark-command-repeat-pop t
+ tab-width 8
+ undo-limit (* 10 1024 1024)
+ use-dialog-box nil
+ use-file-dialog nil
+ use-short-answers t
+ window-resize-pixelwise t
+ yank-pop-change-selection t)
+
+;;; Encodings
+
+;; Allegedly, this is the only one you need...
+(set-language-environment "UTF-8")
+;; But I still set all of these, for fun.
+(setq-default buffer-file-coding-system 'utf-8-unix
+ coding-system-for-read 'utf-8-unix
+ coding-system-for-write 'utf-8-unix
+ default-process-coding-system '(utf-8-unix . utf-8-unix)
+ locale-coding-system 'utf-8-unix
+ x-select-request-type '(UTF8_STRING
+ COMPOUND_TEXT
+ TEXT
+ STRING))
+
+(set-charset-priority 'unicode)
+(prefer-coding-system 'utf-8-unix)
+(set-default-coding-systems 'utf-8-unix)
+(set-terminal-coding-system 'utf-8-unix)
+(set-keyboard-coding-system 'utf-8-unix)
+
+(pcase system-type
+ ((or 'ms-dos 'windows-nt)
+ (set-clipboard-coding-system 'utf-16-le)
+ (set-selection-coding-system 'utf-16-le))
+ (_
+ (set-selection-coding-system 'utf-8)
+ (set-clipboard-coding-system 'utf-8)))
+
+;;; Modes
+
+(dolist (enable-mode '(;; Enable these modes on startup
+ delete-selection-mode
+ global-so-long-mode
+ ))
+ (funcall enable-mode +1))
+
+(dolist (disable-mode '(;; Disable these modes on startup
+ horizontal-scroll-bar-mode
+ menu-bar-mode
+ scroll-bar-mode
+ tool-bar-mode
+ tooltip-mode
+ ))
+ (funcall disable-mode -1))
+
+;;; Internal packages
+
+(when (require 'abbrev nil t)
+ (custom-set-variables
+ '(abbrev-file-name (sync/ "abbrev.el"))
+ '(save-abbrevs 'silently)))
+
+(when (require 'autorevert nil t)
+ (custom-set-variables
+ '(auto-revert-verbose nil)
+ '(global-auto-revert-non-file-buffers t))
+ (global-auto-revert-mode +1))
+
+(when (require 'comp nil t)
+ (custom-set-variables
+ '(native-comp-async-report-warnings-errors 'silent)
+ '(native-comp-deferred-compilation t)))
+
+(when (require 'custom nil t)
+ (custom-set-variables
+ '(custom-file (etc/ "custom.el"))))
+
+(when (require 'ediff nil t)
+ (custom-set-variables
+ '(ediff-window-setup-function #'ediff-setup-windows-plain)))
+
+(when (require 'eldoc nil t)
+ (custom-set-variables
+ '(eldoc-echo-area-use-multiline-p nil)
+ '(eldoc-idle-delay 0.1)))
+
+(when (require 'executable nil t)
+ (custom-set-variables
+ '(executable-prefix-env t)))
+
+(when (require 'files nil t)
+ (custom-set-variables
+ '(auto-save-default nil)
+ '(auto-save-interval 1)
+ '(auto-save-no-message t)
+ '(auto-save-timeout 1)
+ '(auto-save-visited-interval 1)
+ '(backup-by-copying t)
+ '(create-lockfiles nil)
+ '(delete-old-versions t)
+ '(find-file-visit-truename t)
+ '(kept-new-versions 8)
+ '(kept-old-versions 8)
+ '(mode-require-final-newline t)
+ '(version-control t)
+ '(view-read-only t))
+ (dolist (h/f
+ '((after-save-hook . executable-make-buffer-file-executable-if-script-p)
+ (find-file-not-found-functions . create-missing-directories)
+ (find-file-hook . +vc-off@remote)))
+ (add-hook (car h/f) (cdr h/f)))
+ (auto-save-visited-mode))
+
+(when (require 'frame nil t)
+ (custom-set-variables
+ '(blink-cursor-blinks 1)
+ '(blink-cursor-interval 0.25)
+ '(blink-cursor-delay 0.25))
+ (blink-cursor-mode))
+
+(when (require 'goto-addr nil t)
+ (if (fboundp 'global-goto-address-mode)
+ (global-goto-address-mode +1)
+ (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
+
+(when (require 'ibuffer nil t)
+ (global-set-key (kbd "C-x C-b") #'ibuffer)
+ (add-hook 'ibuffer-mode-hook #'hl-line-mode))
+
+(when (require 'image nil t)
+ (custom-set-variables
+ '(image-use-external-converter
+ (seq-some #'executable-find '("convert" "gm" "ffmpeg")))))
+
+(when (require 'imenu nil t)
+ (custom-set-variables
+ '(imenu-auto-rescan t)))
+
+(when (require 'isearch nil t)
+ (custom-set-variables
+ '(regexp-search-ring-max default-ring-max)
+ '(search-ring-max default-ring-max)))
+
+(when (require 'minibuffer nil t)
+ (custom-set-variables
+ '(completion-category-defaults nil)
+ '(completion-category-overrides '((file (styles partial-completion))))
+ '(completion-ignore-case t)
+ '(completion-styles '(substring partial-completion))
+ '(enable-recursive-minibuffers t)
+ '(file-name-shadow-properties '(invisible t intangible t))
+ '(minibuffer-eldef-shorten-default t)
+ '(minibuffer-prompt-properties '( read-only t
+ cursor-intangible t
+ face minibuffer-prompt))
+ '(read-buffer-completion-ignore-case t))
+ (file-name-shadow-mode)
+ (minibuffer-electric-default-mode))
+
+(when (require 'mouse nil t)
+ (custom-set-variables
+ '(mouse-drag-copy-region t)
+ '(mouse-wheel-progressive-speed nil)
+ '(mouse-yank-at-point t)))
+
+(when (require 'paren nil t)
+ (custom-set-variables
+ '(show-paren-delay 0.01)
+ '(show-paren-style 'parenthesis)
+ '(show-paren-when-point-in-periphery t)
+ '(show-paren-when-point-inside-paren t))
+ (show-paren-mode)
+ (electric-pair-mode))
+
+(when (require 'recentf nil t)
+ (custom-set-variables
+ '(recentf-save-file (var/ "recentf.el"))
+ '(recentf-max-menu-items default-ring-max)
+ '(recentf-max-saved-items nil)
+ '(recentf-auto-cleanup 'mode))
+ (add-to-list 'recentf-exclude etc/)
+ (add-to-list 'recentf-exclude var/)
+ (add-to-list 'recentf-exclude cache/)
+ (add-to-list 'recentf-exclude "-autoloads.el\\'")
+ (recentf-mode +1))
+
+(when (require 'savehist nil t)
+ (custom-set-variables
+ '(history-length 1024)
+ '(history-delete-duplicates t)
+ '(savehist-file (var/ "savehist.el"))
+ '(savehist-save-minibuffer-history t)
+ '(savehist-autosave-interval 30)
+ ;; Other variables --- don't truncate any of these.
+ ;; `add-to-history' uses the values of these variables unless
+ ;; they're nil, in which case it falls back to `history-length'.
+ '(kill-ring-max default-ring-max)
+ '(mark-ring-max default-ring-max)
+ '(global-mark-ring-max default-ring-max)
+ '(regexp-search-ring-max default-ring-max)
+ '(search-ring-max default-ring-max)
+ '(kmacro-ring-max default-ring-max)
+ '(eww-history-limit default-ring-max))
+ (dolist (var '(global-mark-ring
+ mark-ring
+ kill-ring
+ kmacro-ring
+ regexp-search-ring
+ search-ring))
+ (add-to-list 'savehist-additional-variables var))
+ (savehist-mode +1))
+
+(when (require 'saveplace nil t)
+ (custom-set-variables
+ '(save-place-file (var/ "places.el"))
+ '(save-place-forget-unreadable-files (eq system-type 'gnu/linux)))
+ (save-place-mode 1))
+
+(when (require 'uniquify nil t)
+ (custom-set-variables
+ '(uniquify-after-kill-buffer-p t)
+ '(uniquify-buffer-name-style 'forward)
+ '(uniquify-ignore-buffers-re "^\\*")
+ '(uniquify-separator path-separator)))
+
+(when (require 'vc nil t)
+ (custom-set-variables
+ '(vc-follow-symlinks t)
+ '(vc-make-backup-files t)))
+
+(when (require 'window nil t)
+ (custom-set-variables
+ '(recenter-positions '(top 2 middle bottom))))
+
+;;; New features
+
+(when (fboundp 'pixel-scroll-precision-mode)
+ (pixel-scroll-precision-mode))
+
+(provide 'acdw-defaults)
+;;; acdw-defaults.el ends here
diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el
new file mode 100644
index 0000000..ed41a61
--- /dev/null
+++ b/lisp/acdw-funs.el
@@ -0,0 +1,262 @@
+;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*-
+
+
+;;; Cribs from CRUX --- Advice
+;; https://github.com/bbatsov/crux
+
+;; All of these should go `:before' the function they're advising
+(defun advise-region-or-buffer (&rest _)
+ "`:before' advice to work on the active region or whole buffer.
+See also `with-region-or-buffer'."
+ (interactive (if mark-active
+ (list (region-beginning) (region-end))
+ (list (point-min) (point-max)))))
+
+(defun advise-region-or-line (&rest _)
+ "`:before' advice to work on the active region or whole line.
+See also `with-region-or-line'."
+ (interactive (if mark-active
+ (list (region-beginning) (region-end))
+ (list (line-beginning-position) (line-end-position)))))
+
+(defun advise-region-or-to-eol (&rest _)
+ "`:before' advice to work on the active region or to end of line.
+See also `with-region-or-to-eol'."
+ (INTERACTIVE (if mark-active
+ (list (region-beginning) (region-end))
+ (list (point) (line-end-position)))))
+
+
+;;; Other functions and whatnot
+
+(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)))
+
+(unless (fboundp 'ensure-list)
+ (defun ensure-list (object)
+ "Return OBJECT as a list.
+If OBJECT is already a list, return OBJECT itself. If it's
+not a list, return a one-element list containing OBJECT."
+ (if (listp object)
+ object
+ (list object))))
+
+(defun +require (&rest features)
+ "Require FEATURES, plus my extras.
+Each feature can be an atom (the feature name) or a list of the form
+(FEATURE &optional FILENAME NOERROR), which is passed directly to
+`require'. My extras are in lisp/ and named +FEATURE, so this
+function will `require' them too---but not error if they don't
+exist."
+ (dolist (feat features)
+ (apply #'require (ensure-list feat))
+ (require (intern (format "+%s" feat)) nil :noerror)))
+
+;;; Improvements to default functions
+
+(defun +save-buffers-kill-terminal (arg)
+ "Delete the current frame, or quit Emacs.
+This function is my customization of `save-buffers-kill-terminal'."
+ (interactive "P")
+ (cond (arg (delete-frame nil :force))
+ ((= 1 (length (frame-list)))
+ (and (yes-or-no-p "Kill emacs? ")
+ (save-buffers-kill-emacs t)))
+ (:else (delete-frame))))
+
+(defun really-quit-emacs (arg)
+ "Really, actually quit Emacs."
+ (interactive "P")
+ (cond (arg (save-buffers-kill-emacs t))
+ (:else (save-buffers-kill-terminal t))))
+
+(defun +cycle-spacing (&optional n)
+ ;; `cycle-spacing' is wildly different in 29.1 over 28.
+ "Negate N argument on `cycle-spacing'.
+That is, with a positive N, deletes newlines as well, leaving -N
+spaces. If N is negative, it will not delete newlines and leave
+N spaces."
+ (interactive "*p")
+ (cycle-spacing (- n)))
+
+(defun delete-window|bury-buffer ()
+ "Delete the current window, or bury the current buffer.
+If the current window is the only window, bury the buffer."
+ (interactive)
+ (condition-case e
+ (delete-window)
+ (t (bury-buffer))))
+
+(defun other-window|switch-buffer (arg)
+ "Call `other-window' or `switch-buffer' depending on windows.
+When called with prefix ARG, unconditionally switch buffer."
+ (interactive "P")
+ (if (or arg (one-window-p))
+ (switch-to-buffer (other-buffer) nil t)
+ (other-window 1)))
+
+(defun open-paragraph (&optional arg)
+ "Open a paragraph after paragraph at 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.
+
+Called with prefix ARG, open a paragraph before point."
+ ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
+ (interactive "*P")
+ ;; 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.
+ (unless (looking-at "^$") (forward-line (if arg -1 +1)))
+ (while (and (not (looking-at "^$"))
+ (= 0 (forward-line (if arg -1 +1)))))
+ (newline)
+ (when arg (newline) (forward-line -2))
+ (delete-blank-lines)
+ (newline 2)
+ (previous-line))
+
+(defun +initial-buffer ()
+ (if (equal (get-buffer "*Messages*")
+ (other-buffer))
+ (get-buffer "*scratch*")
+ (other-buffer)))
+
+(defun open-paragraph (&optional arg)
+ "Open a paragraph after paragraph at 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.
+
+Called with prefix ARG, open a paragraph before point."
+ ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
+ (interactive "*P")
+ ;; 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.
+ (unless (looking-at "^$") (forward-line (if arg -1 +1)))
+ (while (and (not (looking-at "^$"))
+ (= 0 (forward-line (if arg -1 +1)))))
+ (newline)
+ (when arg (newline) (forward-line -2))
+ (delete-blank-lines)
+ (newline 2)
+ (previous-line))
+
+(defun create-missing-directories ()
+ "Automatically create missing directories when finding a file."
+ ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/
+ (let ((target-dir (file-name-directory buffer-file-name)))
+ (unless (file-exists-p target-dir)
+ (make-directory target-dir t))))
+
+(defun +vc-off@remote ()
+ (when (file-remote-p (buffer-file-name))
+ (setq-local vc-handled-backends nil)))
+
+(defun +auto-save-some-buffers (&rest _)
+ "Quietly run `save-some-buffers'."
+ (let ((inhibit-message t))
+ (with-temp-message ""
+ (save-some-buffers t))))
+
+(defun comment-lines (str &optional comment-char)
+ "Comment each line of STR.
+Returns the new, commented, string.
+
+If COMMENT-CHAR is missing or nil, use `comment-start'."
+ (mapconcat (lambda (ln)
+ (concat (or comment-char comment-start)
+ ln))
+ (string-lines str)
+ "\n"))
+
+(defun clamp (value min max)
+ "Clamp VALUE between MIN and MAX."
+ (min max (max min value)))
+
+(define-minor-mode truncate-lines-local-mode
+ "Truncate lines locally in a buffer."
+ :lighter " ..."
+ :group 'display
+ (setq-local truncate-lines truncate-lines-local-mode))
+
+(defun mapc-buffers (func &optional predicate)
+ "Map FUNC over buffers matching PREDICATE.
+Both FUNC and PREDICATE will be executed with no arguments and in
+the context of each buffer.
+
+If PREDICATE is nil or not given, map FUNC over all buffers."
+ (cl-loop for buf being the buffers
+ do (with-current-buffer buf
+ (when (and predicate
+ (funcall predicate))
+ (funcall func)))))
+
+(defun mapc-buffers-modes (func &rest modes)
+ "Map FUNC over buffers derived from MODES.
+FUNC will be executed with no arguments and in the context of
+each buffer."
+ (mapc-buffers func
+ (lambda ()
+ (apply #'derived-mode-p modes))))
+
+(defun ++concat (func strings)
+ "Concat STRINGS processed by FUNC.
+Each of STRINGS can be a bare string or a list. Strings are
+passed through as-is, but lists are passed to FUNC first as
+arguments. Finally, all the resulting strings are `mapconcat'-ed
+together.
+
+As a special case, if `:separator' is the first of STRINGS, the
+string following will be used as a separator. Otherwise, a
+newline will be used."
+ (let (separator)
+ (when (eq (car strings) :separator)
+ (setq separator (cadr strings)
+ strings (cddr strings)))
+ (mapconcat (lambda (s)
+ (cond
+ ((listp s) (apply func s))
+ ((stringp s) s)
+ (t (user-error "Bad argument: %S" s))))
+ strings
+ (or separator "\n"))))
+
+(defun nconcat (&rest strings)
+ "Concat STRINGS separated by SEPARATOR.
+If `:separator' is the first of STRINGS, the next string will be used to
+separate the rest of STRINGS."
+ (++concat #'concat strings))
+
+(defun format-concat (&rest strings)
+ "Concatenate formatted STRINGS.
+Each of STRINGS can be a bare string or a list. Bare strings are passed as-is
+to `mapconcat' for concatenation and separation. Lists, however, are passed to
+`format' first.
+
+If `:separator' is the first of STRINGS, the next string will be
+used as a separator."
+ (++concat #'format strings))
+
+(defun choose-executable (&rest programs)
+ "Return the first of PROGRAMS that exists in the system's $PATH."
+ (seq-some #'executable-find programs))
+
+;;; Update packages more better-er
+
+(defun +package-update-all ()
+ "Update all packages and vc packages."
+ (interactive)
+ (package-update-all)
+ ;; WTF!
+ (let ((package-archives-nil))
+ (package-vc-update-all)))
+
+(provide 'acdw-funs)
+;;; acdw-funs.el ends here
diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el
new file mode 100644
index 0000000..e2258fa
--- /dev/null
+++ b/lisp/acdw-macs.el
@@ -0,0 +1,293 @@
+;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*-
+
+(eval-when-compile
+ (require 'cl-lib)
+ (require 'tempo)
+ (declare-function derived-mode-abbrev-table-name "tempo"))
+
+;;; Extra functionality for `eval-after-load'
+
+(defun eval-after-init (thunk)
+ "Evaluate THUNK after Emacs initiation, or now if already initialized."
+ (if after-init-time
+ (funcall thunk)
+ (add-hook 'after-init-hook thunk)))
+
+(defmacro eval-after (prereqs &rest body)
+ "Evaluate body after PREREQS.
+PREREQS can be a feature, a number, `t', or a list of those.
+
+Features are used as arguments to `eval-after-load'. Numbers are
+used as arguments to `run-with-idle-timer'. `t' will ensure BODY
+runs after Emacs's init time.
+
+When given a list of PREREQS, `eval-after' will nest each one
+from left to right."
+ (declare (indent 1) (debug (form def-body)))
+ (setf prereqs (ensure-list prereqs))
+ (if (null prereqs)
+ (macroexp-progn body)
+ (let* ((this (car prereqs))
+ (form `((lambda () (eval-after ,(cdr prereqs) ,@body)))))
+ (cond
+ ((eq this :init)
+ (append '(eval-after-init) form))
+ ((numberp this)
+ (append `(run-with-idle-timer ,this nil) form))
+ ((symbolp this)
+ (append `(eval-after-load ',this) form))
+ (:else (user-error "Eval-after: Bad prereq: %S" this))))))
+
+
+;;; Easier customization of options
+;; At some point it might be nice to include more forms in the VAR slots, like
+;; `setup's `:option' macro.
+
+(if (fboundp 'setopt)
+ ;; Emacs 29 introduces `setopt', which does basically the same thing as the
+ ;; macro below. Not exactly the same, of course---it uses `setopt--set'
+ ;; instead of `customize-set-variable'---but I'm going to trust the Emacs
+ ;; devs on this one.
+ (defalias 'setc 'setopt)
+ (defmacro setc (&rest args)
+ "Customize user options in a `setq'-like way."
+ (declare (debug setq))
+ (unless (zerop (mod (length args) 2))
+ (signal 'wrong-number-of-arguments `(evenp ,(length args))))
+ (let (form defuns)
+ (while args
+ (let* ((var (pop args))
+ (val (pop args)))
+ (when (memq (car-safe val) '(defun defmacro))
+ (push val defuns)
+ (setq val `(function ,(cadr val))))
+ (push `(customize-set-variable ',var ,val "Set by `setc'.")
+ form)))
+ `(progn ,@(append (nreverse defuns) (nreverse form))))))
+
+
+;;; Extra def- forms
+
+(defmacro defdir (name directory &optional docstring)
+ "Define a variable and a function NAME expanding to DIRECTORY.
+DOCSTRING is applied to the variable; its default is DIRECTORY's
+path."
+ (declare (indent 2) (doc-string 3))
+ `(progn
+ (defvar ,name ,directory
+ ,(concat (or docstring (format "%s" directory)) "\n"
+ "Defined by `defdir'."))
+ (defun ,name (file &optional mkdir)
+ ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
+ "If MKDIR is non-nil, parent directories are created.\n"
+ "Defined by `defdir'.")
+ (let ((file-name (expand-file-name
+ (convert-standard-filename file) ,name)))
+ (when mkdir
+ (make-directory (file-name-directory file-name) :parents))
+ file-name))))
+
+(defmacro defkeys (maps &rest bindings)
+ "Define key BINDINGS in MAPS.
+If MAPS is nil or t, bind to `current-global-map'. Otherwise,
+bind each of BINDINGS to the map or list of maps provided.
+
+BINDINGS is a `setq'-style list of pairs of keys and definitions.
+The key part of each binding can be a string, in which case it's
+passed to `kbd', or a vector or anything else `define-key'
+accepts in the KEY position. The definition part, likewise, can
+be any form `define-key' accepts in that position, with this
+addition: if the form is a `defun' form, it will be defined
+before any keys are bound."
+ (declare (indent 1))
+ (unless (cl-evenp (length bindings))
+ (signal 'wrong-number-of-arguments `(evenp ,(length bindings))))
+ `(progn
+ ,@(cl-loop
+ for map in (ensure-list maps)
+ for first-map-p = t then nil
+ append
+ (cl-loop
+ for (keys def) on bindings by #'cddr
+ for defp = (memq (car-safe def) '(defmap defun defmacro))
+ if (and defp first-map-p) collect def into defuns
+ append
+ (cl-loop
+ for key in (ensure-list keys)
+ collect (list 'define-key
+ (if (memq map '(t nil))
+ '(current-global-map)
+ (or (car-safe map) map))
+ (if (stringp key)
+ `(kbd ,key)
+ key)
+ (if defp
+ (cl-case (car def)
+ ((defmap) (cadr def))
+ ((defun defmacro) `#',(cadr def))
+ (otherwise (error "Bad def type: %S"
+ (car def))))
+ def)))
+ into keydefs
+ finally return
+ (let ((all (append defuns keydefs)))
+ (if-let ((after (plist-get (cdr-safe map) :after)))
+ `((eval-after ,after
+ ,@all))
+ all))))))
+
+(defmacro defmap (name docstring &rest bindings)
+ "Define a keymap named NAME, with BINDINGS."
+ (declare (indent 1) (doc-string 2))
+ `(,(if (boundp name) 'setq 'defvar) ,name
+ ;;; ^ probably a terrible hack
+ (let ((map (make-sparse-keymap)))
+ (defkeys map ,@bindings)
+ map)
+ ,@(unless (boundp name) (list docstring))))
+
+(defmacro defhook (hooks &rest body)
+ "Define a function to hook into HOOKS.
+NAME and ARGS are passed to the generated `defun' form.
+Each hook in HOOKS can be the name of a hook or a list of the form
+(HOOK DEPTH LOCAL), where each argument is the same as in
+`add-hook'."
+ (declare (indent 1))
+ (let* ((name (or (plist-get body :name)
+ (intern (format "%s/h"
+ (mapconcat
+ (lambda (h)
+ (string-remove-suffix
+ "-hook"
+ (if (and (consp h)
+ (caddr h))
+ (format "%s:local" (car h))
+ (format "%s" (or (car-safe h)
+ h)))))
+ (ensure-list hooks)
+ "|")))))
+ (args (or (plist-get body :args) nil))
+ (doc (or (plist-get body :doc) nil))
+ (forms ; (DEFUN . FUNCS)
+ (cl-loop for form in (delete2 body :name :args :doc)
+ if (eq (car form) 'function)
+ collect form into funcs
+ else collect form into defuns
+ finally return (cons defuns funcs)))
+ (defun-forms (car forms))
+ (func-forms (cdr forms)))
+ `(progn
+ ,@(when defun-forms
+ `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms)))
+ ,@(cl-loop for hook in (ensure-list hooks)
+ for h = (or (car-safe hook) hook)
+ for ha = (cdr-safe hook)
+ if defun-forms
+ collect `(add-hook ',h #',name ,@ha)
+ append
+ (cl-loop for fn in func-forms
+ collect `(add-hook ',h ,fn ,@ha))))))
+
+;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE)
+(defmacro defautoload (file &rest fns)
+ "Autoload FNS from FILE.
+Each of FNS can be an atom (function name) or a list of the
+form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible
+keys are `:doc' (docstring), `:interactive', and `:type', which are
+used as the optional arguments to `autoload'.
+
+You can also pass `:interactive' and `:type' as keyword arguments
+just after FILE, and they'll serve as the default for the
+autoloaded FNS."
+ (declare (indent 1))
+ (let ((interactive (plist-get fns :interactive))
+ (type (plist-get fns :type))
+ (fns (delete2 fns :interactive :type)))
+ `(progn
+ ,@(cl-loop for fn in fns
+ for name = (or (car-safe fn) fn)
+ for args = (cdr-safe fn)
+ collect
+ `(autoload ',name ,(format "%s" file)
+ ,(plist-get args :doc)
+ ,(or (plist-get args :interactive)
+ interactive)
+ ,(or (plist-get args :type)
+ type))))))
+
+
+;;; Miscellaneous
+
+(defmacro with-message (message &rest body)
+ "Display MESSAGE then execute BODY.
+If BODY executes without errors, display MESSAGE...done."
+ (declare (indent 1))
+ (let ((msym (gensym))
+ (esym (gensym)))
+ `(let ((,msym ,message))
+ (condition-case ,esym
+ (progn (message "%s..." ,msym)
+ ,@body)
+ (:success (message "%s...done" ,msym))
+ (t (signal (car ,esym) (cdr ,esym)))))))
+
+(defmacro o (&rest fns)
+ "Compose FNS into a new function for one argument."
+ (if (null fns)
+ `(lambda (&rest args) args)
+ `(lambda (&rest args)
+ (apply
+ #',(car fns)
+ (ensure-list (apply (o ,@(cdr fns)) args))))))
+
+(defmacro with-region-or-buffer (&rest funcs)
+ "Advise FUNCS with `advise-region-or-buffer'."
+ `(progn
+ ,@(cl-loop for fn in funcs
+ collect
+ `(advice-add ',fn :before #'advise-region-or-buffer))))
+
+(defmacro with-region-or-line (&rest funcs)
+ "Advise FUNCS with `advise-region-or-line'."
+ `(progn
+ ,@(cl-loop for fn in funcs
+ collect
+ `(advice-add ',fn :before #'advise-region-or-line))))
+
+(defmacro with-region-or-to-eol (&rest funcs)
+ "Advise FUNCS with `advise-region-or-to-eol'."
+ `(progn
+ ,@(cl-loop for fn in funcs
+ collect
+ `(advice-add ',fn :before #'advise-region-or-to-eol))))
+
+(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
+ ,(or abbrev tag)
+ ,doc
+ ,taglist)))
+ (define-abbrev ,table ,tag "" ,template :system t)
+ (put ,template 'no-self-insert t))))
+
+(provide 'acdw-macs)
+;;; acdw-macs.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el
index a9ef893..30c4f44 100644
--- a/lisp/acdw.el
+++ b/lisp/acdw.el
@@ -1,272 +1,79 @@
-;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*-
-;; by C. Duckworth <acdw@acdw.net>
-(require 'cl-lib)
-;; def.el is here
-(require 'def)
-
-;;; Define both a directory and a function expanding to a file in that directory
-
-(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)
- (doc-string 3))
- (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))))
-
-;;; Evaluating things after other things
-
-(defun eval-after-init (fn)
- "Evaluate FN after inititation, or now if Emacs is initialized.
-FN is called with no arguments."
- (if after-init-time
- (funcall fn)
- (add-hook 'after-init-hook fn)))
-
-(defmacro eval-after (features &rest body)
- "Evaluate BODY, but only after loading FEATURES.
-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)))
- (unless (listp features)
- (setf features (list features)))
- (if (null features)
- (macroexp-progn body)
- (let* ((this (car features))
- (rest (cdr features)))
- (cond ((eq this 'init)
- `(eval-after-init
- (lambda () (eval-after ,rest ,@body))))
- (:else
- `(with-eval-after-load ',this
- (eval-after ,rest ,@body)))))))
-
-;;; Convenience functions
-
-(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))
- (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)))))
-
-(unless (fboundp 'ensure-list)
- ;; Just in case we're using an old version of Emacs.
- (defun ensure-list (object)
- "Return OBJECT as a list.
-If OBJECT is already a list, return OBJECT itself. If it's
-not a list, return a one-element list containing OBJECT."
- (if (listp object)
- object
- (list 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 variable (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)))))
-
-(defun add-hook* (hooks &rest functions)
- "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 (hooks &rest args)
- "Run `setq-local' on ARGS when running HOOKs."
- ;; FIXME: this is pretty messy, i think...
- ;; The settings should be stored in an alist so that they can be deduplicated
- (declare (indent 1))
- `(progn
- ,@(cl-loop for hook in (ensure-list hooks)
- collect
- (let ((fn (intern (format "%s-setq-local" hook))))
- (when (and (fboundp fn)
- (functionp fn))
- (setf args (append (function-get fn 'setq-local-hook-settings) args)))
- (unless (and (< 0 (length args))
- (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))
- (function-put ',fn 'setq-local-hook-settings ',args)
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (derived-mode-p
- ',(intern (replace-regexp-in-string
- "-hook" "" (format "%s" hook))))
- (,fn))))
- (add-hook ',hook #',fn))))))
-
-(defmacro with-message (message &rest body)
- "Execute BODY, with MESSAGE.
-If body executes without errors, MESSAGE...Done will be displayed."
- (declare (indent 1))
- (let ((msg (gensym)))
- `(let ((,msg ,message))
- (condition-case e
- (progn (message "%s..." ,msg)
- ,@body)
- (:success (message "%s...done" ,msg))
- (t (signal (car e) (cdr e)))))))
-
-(defmacro either (&rest clauses)
- "Return the first of CLAUSES that returns non-nil."
- (let* ((this (gensym "either")))
- (unless (null clauses)
- `(let* ((,this ,(car clauses)))
- (if ,this ,this (either ,@(cdr clauses)))))))
-
-(defun mapc-buffers (fn &optional pred)
- "Perform FN on buffers matching PRED.
-If PRED is nil or absent, perform FN on all buffers. Both FN and
-PRED are called within a `with-current-buffer' form and without
-arguments."
- (let ((pred (cond
- ((listp pred)
- (lambda () (apply #'derived-mode-p pred)))
- ((functionp pred) pred)
- ((null pred) (lambda () t))
- (:else (user-error "Bad predicate")))))
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (funcall pred)
- (funcall fn))))))
-
-;; 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 (arg)
- "Call `other-window' or `switch-buffer' depending on windows.
-When called with prefix ARG, unconditionally switch buffer."
- (interactive "P")
- (if (or arg (one-window-p))
- (switch-to-buffer (other-buffer) nil t)
- (other-window 1)))
-
-;;; Set variables more better-er
-;; Now this doesn't do `setf'-style stuff.
-
-(defmacro setc (&rest args)
- "Customize user options using ARGS like `setq'."
- (declare (debug setq))
- (unless (zerop (mod (length args) 2))
- (user-error "Dangling argument: %S" var))
- (let (form)
- (while args
- (push `(customize-set-variable
- ',(pop args)
- ,(pop args)
- "Set by `setc'.")
- form))
- `(progn ,@(nreverse form))))
+;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*-
+
+;;; Code:
+
+(require 'acdw-funs) ; Extra functions
+(require 'acdw-macs) ; Extra macros
+
+(defdir etc/ (locate-user-emacs-file "etc")
+ "Directory for package configuration files.
+See `no-littering' for examples.")
+
+(defdir var/ etc/
+ "Directory for package data file.
+See `no-littering' for examples.")
+
+(defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME")))
+ (expand-file-name "emacs/" xdg-cache)
+ etc/)
+ "Directory for cache files.")
+
+(setq native-compile-target-directory (cache/ "eln" t))
+(when (fboundp 'startup-redirect-eln-cache)
+ (startup-redirect-eln-cache (cache/ "eln" t)))
+
+(defdir sync/ (expand-file-name "/home/case/Sync")
+ "My Syncthing directory.")
+
+(defdir private/ (sync/ "emacs/private"))
+(add-to-list 'load-path private/)
+
+(require 'acdw-defaults) ; Sane defaults
+(require '_acdw) ; Private stuff
+(require '+lisp) ; Lispy goodness
+
+(setc enable-recursive-minibuffers t
+ completions-detailed t
+ completion-ignore-case t
+ read-buffer-completion-ignore-case t
+ read-file-name-completion-ignore-case t
+ initial-buffer-choice #'+initial-buffer
+ initial-scratch-message
+ (format "%s\n\n"
+ (comment-lines
+ (shell-command-to-string "fortune")
+ ";; "))
+ sentence-end-double-space nil
+ save-silently t)
+
+(defkeys t
+ "M-o" #'other-window|switch-buffer
+ "C-x 0" #'delete-window|bury-buffer
+ "C-M-;" #'+lisp-comment-or-uncomment-sexp
+ "M-SPC" #'+cycle-spacing
+ "C-x C-k" #'kill-this-buffer)
+
+(defkeys t
+ "M-u" #'universal-argument)
+
+(defkeys universal-argument-map
+ "M-u" #'universal-argument-more)
+
+(define-advice switch-to-buffer (:after (&rest _) normal-mode)
+ "Automatically determine the mode for created non-file buffers."
+ (when-let ((_ (and (eq major-mode 'fundamental-mode)))
+ (buffer-file-name (buffer-name)))
+ (normal-mode)))
+
+(define-advice canonically-space-region
+ (:around (orig &rest args) double-space-sentences)
+ (let ((sentence-end-double-space t))
+ (apply orig args)))
+
+(with-region-or-buffer indent-region)
+
+(winner-mode)
(provide 'acdw)
+
;;; acdw.el ends here
diff --git a/lisp/browse-url-transform.el b/lisp/browse-url-transform.el
deleted file mode 100644
index c290a1f..0000000
--- a/lisp/browse-url-transform.el
+++ /dev/null
@@ -1,45 +0,0 @@
-;;; browse-url-transform --- transform URLs
-
-(defgroup browse-url-transform nil
- "Transformations for urls passed to `browse-url'."
- :group 'browse-url)
-
-(defcustom browse-url-transform-alist nil
- "Transformation rules for URLs.
-The keys are regexps matching URLs, and the values are how to
-transform them. The replacements will use match capture data."
- :type '(alist :key-type (string :tag "URL regexp match")
- :value-type (string :tag "URL regexp transformation")))
-
-(defun browse-url-transform-url (url)
- "Transform URL before passing it to `browse-url'."
- (cl-loop with url = (substring-no-properties
- (if (consp url) (car url) url))
- for (regex . transformation) in browse-url-transform-alist
- if (string-match regex url)
- return (replace-match transformation nil nil url)
- finally return url))
-
-(defun browse-url-transform-advice (url &rest args)
- "Advice to `browse-url' for URL transformations.
-ARGS are passed on for further processing."
- (apply #'list (and url (browse-url-transform-url url)) args))
-
-(define-minor-mode browse-url-transform-mode
- "Minor mode to transform a URL before passing it to `browse-url'.
-This can be used to \"redirect\" URLs, for example from an
-information silo to a more privacy-respecting one (e.g.,
-\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.
-
-When using this mode, ensure that the transformed URL is also in
-`browse-url-handlers', since that's what `browse-url' will see."
- :lighter " Turl"
- :keymap nil
- :global t
- (cond (browse-url-transform-mode
- (advice-add 'browse-url :filter-args #'browse-url-transform-advice))
- (:else
- (advice-remove 'browse-url #'browse-url-transform-advice))))
-
-(provide 'browse-url-transform)
-;;; browse-url-transform.el ends here
diff --git a/lisp/dawn.el b/lisp/dawn.el
deleted file mode 100644
index 30aab7c..0000000
--- a/lisp/dawn.el
+++ /dev/null
@@ -1,109 +0,0 @@
-;;; dawn.el --- Lightweight dawn/dusk task scheduling -*- lexical-binding: t; -*-
-
-;; Copyright (C) 2022 Case Duckworth
-
-;; Author: Case Duckworth
-;; Maintainer: Case Duckworth <acdw@acdw.net>
-;; URL: https://codeberg.org/acdw/dusk.el
-;; Version: 0.3.0
-;; Keywords: calendar, themes, convenience
-;; Package-Requires: ((emacs "24.3"))
-
-;;; Commentary:
-
-;; There is also circadian.el, but it doesn't quite work for me.
-;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
-;; somewhere else (which I've forgotten) and my own brain :)
-
-;;; Code:
-
-(require 'calendar)
-(require 'cl-lib)
-(require 'solar)
-
-;;; Timers
-
-(defvar dawn--dawn-timer nil
- "Timer for dawn-command.")
-
-(defvar dawn--dusk-timer nil
- "Timer for dusk-command.")
-
-(defvar dawn--reset-timer nil
- "Timer to reset dawn at midnight.")
-
-;;; Functions
-
-(defun dawn-encode-time (f)
- "Encode fractional time F.
-If F is nil, return nil."
- (when f
- (let ((hhmm (cl-floor f))
- (date (cdddr (decode-time))))
- (encode-time
- (append (list 0
- (round (* 60 (cadr hhmm)))
- (car hhmm))
- date)))))
-
-(defun dawn-midnight ()
- "Return the time of the /next/ midnight."
- (let ((date (cdddr (decode-time))))
- (encode-time
- (append (list 0 0 0 (1+ (car date))) (cdr date)))))
-
-(defun dawn-sunrise ()
- "Return the time of today's sunrise."
- (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
-
-(defun dawn-sunset ()
- "Return the time of today's sunset."
- (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
-
-;;; Interface
-
-;;;###autoload
-(defun dawn-schedule (dawn-command dusk-command)
- "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
-Requires `calendar-longitude' and `calendar-latitude' to be set;
-if they're not, it will prompt the user for them or error."
- (when (or (null calendar-longitude)
- (null calendar-latitude))
- (or (solar-setup)
- (user-error "`dawn' won't work without setting %s!"
- (cond ((and (null calendar-longitude)
- (null calendar-latitude))
- "`calendar-longitude' and `calendar-latitude'")
- ((null calendar-longitude)
- "`calendar-longitude'")
- ((null calendar-latitude)
- "`calendar-latitude'")))))
- (let ((dawn (dawn-sunrise))
- (dusk (dawn-sunset)))
- (cond
- ((or (null dawn) (null dusk))
- ;; There is no sunrise or sunset, due to how close we are to the poles.
- ;; In this case, we must figure out whether it's day or night.
- (pcase (caddr (solar-sunrise-sunset (calendar-current-date)))
- ("0:00" (funcall dusk-command)) ; 0 hours of daylight
- ("24:00" (funcall dawn-command)) ; 24 hours of daylight
- ))
- ((time-less-p nil dawn)
- ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
- ;; DAWN-COMMAND and DUSK-COMMAND for later.
- (funcall dusk-command)
- (run-at-time dawn nil dawn-command)
- (run-at-time dusk nil dusk-command))
- ((time-less-p nil dusk)
- ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
- ;; DUSK-COMMAND.
- (funcall dawn-command)
- (run-at-time dusk nil dusk-command))
- (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
- (funcall dusk-command)))
- ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
- (run-at-time (dawn-midnight) nil
- #'dawn-schedule dawn-command dusk-command)))
-
-(provide 'dawn)
-;;; dawn.el ends here
diff --git a/lisp/def.el b/lisp/def.el
deleted file mode 100644
index 0bf91b2..0000000
--- a/lisp/def.el
+++ /dev/null
@@ -1,142 +0,0 @@
-;;; def.el --- defining macros -*- lexical-binding: t; -*-
-
-;;; Code:
-
-(require 'cl-lib)
-
-;;; Utility
-
-(defun def--assert-args (pred args &optional error-type &rest error-args)
- "Assert that ARGS follows PRED.
-If it doesn't, raise an error. ERROR-TYPE will be the type of
-that error (defaults to `user-error'), and it and ERROR-ARGS are
-passed in a list to `signal'."
- (unless (funcall pred args)
- (funcall #'signal
- (or error-type 'user-error)
- (or error-args
- (list "Wrong arguments" args)))))
-
-(defmacro o (&rest fns)
- "Compose FNS into a new function for one argument."
- (if (null fns)
- `(lambda (&rest args) args)
- `(lambda (&rest args)
- (apply
- #',(car fns)
- (ensure-list (apply (o ,@(cdr fns)) args))))))
-
-;; TODO: I need to figure out where this function goes.
-(defun def--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)))
-
-;;; Keybindings
-
-(defmacro defkeys (maps &rest bindings)
- "Define key BINDINGS in MAPS.
-If MAPS is nil or t, bind to `current-global-map'. Otherwise,
-bind each of BINDINGS to the map or list of maps provided.
-
-BINDINGS is a `setq'-style list of pairs of keys and definitions.
-The key part of each binding can be a string, in which case it's
-passed to `kbd', or a vector or anything else `define-key'
-accepts in the KEY position. The definition part, likewise, can
-be any form `define-key' accepts in that position, with this
-addition: if the form is a `defun' form, it will be defined
-before any keys are bound."
- (declare (indent 1))
- (def--assert-args (o cl-evenp length) bindings
- 'wrong-number-of-arguments 'defkeys 'evenp (length bindings))
- `(progn
- ,@(cl-loop
- for map in (ensure-list maps)
- for first-map-p = t then nil
- append
- (cl-loop
- for (keys def) on bindings by #'cddr
- for defp = (memq (car-safe def) '(defmap defun defmacro))
- if (and defp first-map-p) collect def into defuns
- append
- (cl-loop
- for key in (ensure-list keys)
- collect (list 'define-key
- (if (memq map '(t nil))
- '(current-global-map)
- (or (car-safe map) map))
- (if (stringp key)
- `(kbd ,key)
- key)
- (if defp
- (cl-case (car def)
- ((defmap) (cadr def))
- ((defun defmacro) `#',(cadr def))
- (otherwise (error "Bad def type: %S"
- (car def))))
- def)))
- into keydefs
- finally return
- (let ((all (append defuns keydefs)))
- (if-let ((after (plist-get (cdr-safe map) :after)))
- `((eval-after ,after
- ,@all))
- all))))))
-
-(defmacro defmap (name docstring &rest bindings)
- "Define a keymap named NAME, with BINDINGS."
- (declare (indent 1) (doc-string 2))
- `(,(if (boundp name) 'setq 'defvar) ,name
- ;;; ^ probably a terrible hack
- (let ((map (make-sparse-keymap)))
- (defkeys map ,@bindings)
- map)
- ,@(unless (boundp name) (list docstring))))
-
-;;; Hooks
-
-(defmacro defhook (hooks &rest body)
- "Define a function to hook into HOOKS.
-NAME and ARGS are passed to the generated `defun' form.
-Each hook in HOOKS can be the name of a hook or a list of the form
-(HOOK DEPTH LOCAL), where each argument is the same as in
-`add-hook'."
- (declare (indent 1))
- (let* ((name (or (plist-get body :name)
- (intern (format "%s/h"
- (mapconcat
- (lambda (h)
- (string-remove-suffix
- "-hook" (symbol-name (or (car-safe h)
- h))))
- (ensure-list hooks)
- "|")))))
- (args (or (plist-get body :args) nil))
- (doc (or (plist-get body :doc) nil))
- (forms ; (DEFUN . FUNCS)
- (cl-loop for form in (def--delete2 body :name :args :doc)
- if (eq (car form) 'function)
- collect form into funcs
- else collect form into defuns
- finally return (cons defuns funcs)))
- (defun-forms (car forms))
- (func-forms (cdr forms)))
- `(progn
- ,@(when defun-forms
- `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms)))
- ,@(cl-loop for hook in (ensure-list hooks)
- for h = (or (car-safe hook) hook)
- for ha = (cdr-safe hook)
- if defun-forms
- collect `(add-hook ',h #',name ,@ha)
- append
- (cl-loop for fn in func-forms
- collect `(add-hook ',h ,fn ,@ha))))))
-
-(provide 'def)
-;;; def.el ends here
diff --git a/lisp/graveyard.el b/lisp/graveyard.el
new file mode 100644
index 0000000..89a776d
--- /dev/null
+++ b/lisp/graveyard.el
@@ -0,0 +1,50 @@
+;;; graveyard.el --- stuff i'm not currently using right now
+
+;;; Commentary:
+
+;; I spent a long time configuring these packages! And they're misbehaving,
+;; boo. So into the graveyard they go.
+
+;;; Code:
+
+(use-package emms
+ :ensure t
+ :init
+ (require 'emms-setup)
+ (autoload #'+emms-streams "+emms" nil t)
+ (defkeys t "C-c p s" #'+emms-streams)
+ (defhook (emms-playlist-mode-hook
+ emms-browser-mode-hook
+ emms-show-all-mode-hook)
+ #'hl-line-mode
+ #'show-paren-mode)
+ :config
+ (require '+emms)
+ (emms-all)
+ (emms-default-players)
+ (emms-browser-make-filter "all" #'ignore)
+ (emms-browser-make-filter "recent"
+ (lambda (track)
+ (< 30 (time-to-number-of-days
+ (time-subtract (current-time)
+ (emms-info-track-file-mtime
+ track))))))
+ (emms-browser-set-filter (assoc "all" emms-browser-filters))
+ (emms-history-load)
+ (emms-playing-time-mode -1)
+ :bind
+ (("C-c p p" . emms-pause)
+ ("C-c p b" . emms-browser)
+ ("C-c p l" . emms-playlist-mode-go))
+ :custom
+ (emms-source-file-default-directory (expand-file-name "~/var/music/"))
+ (emms-source-playlist-default-format 'm3u)
+ (emms-playlist-mode-center-when-go t)
+ (emms-playlist-default-major-mode 'emms-playlist-mode)
+ (emms-player-mpv-update-metadata t)
+ (emms-browser-covers #'emms-browser-cache-thumbnail-async)
+ (emms-browser-thumbnail-small-size 64)
+ (emms-browser-thumbnail-medium-size 128)
+ (emms-streams-file (expand-file-name "streams.emms"
+ emms-source-file-default-directory))
+ (emms-mode-line-mode-line-function nil))
diff --git a/lisp/init-org.el b/lisp/init-org.el
new file mode 100644
index 0000000..d2d5e77
--- /dev/null
+++ b/lisp/init-org.el
@@ -0,0 +1,144 @@
+;;; init-org.el -*- lexical-binding: t; -*-
+
+(use-package org
+ :defer t
+ :custom
+ (org-adapt-indentation nil)
+ (org-auto-align-tags t)
+ (org-archive-mark-done t)
+ (org-fold-catch-invisible-edits 'show-and-error)
+ (org-clock-clocked-in-display 'mode-line)
+ (org-clock-string-limit 7) ; just the clock bit
+
+ (org-clock-persist nil)
+ (org-confirm-babel-evaluate nil)
+ (org-cycle-separator-lines 0)
+ (org-directory (sync/ "org/" t))
+ (org-fontify-done-headline t)
+ (org-fontify-quote-and-verse-blocks t)
+ (org-fontify-whole-heading-line t)
+ (org-hide-emphasis-markers t)
+ (org-html-coding-system 'utf-8-unix)
+ (org-image-actual-width (list (* (window-font-width)
+ (- fill-column 8))))
+ (org-imenu-depth 3)
+ (org-indent-indentation-per-level 0)
+ (org-indent-mode-turns-on-hiding-stars nil)
+ (org-insert-heading-respect-content t)
+ (org-list-demote-modify-bullet '(("-" . "+")
+ ("+" . "-")))
+ (org-log-done 'time)
+ (org-log-into-drawer t)
+ (org-num-skip-commented t)
+ (org-num-skip-unnumbered t)
+ (org-num-skip-footnotes t)
+ (org-outline-path-complete-in-steps nil)
+ (org-pretty-entities t)
+ (org-pretty-entities-include-sub-superscripts nil)
+ (org-refile-targets '((nil . (:maxlevel . 2))
+ (org-agenda-files . (:maxlevel . 1))))
+ (org-refile-use-outline-path 'file)
+ (org-special-ctrl-a/e t)
+ (org-special-ctrl-k t)
+ (org-src-fontify-natively t)
+ (org-src-tab-acts-natively t)
+ (org-src-window-setup 'current-window)
+ (org-startup-truncated nil)
+ (org-startup-with-inline-images t)
+ (org-tags-column 0)
+ (org-todo-keywords
+ '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
+ "|" "DONE(d!)" "ASSIGNED(a@/!)")
+ (sequence "|" "CANCELED(k@)")
+ (sequence "MEETING(m)")))
+ (org-use-speed-commands t)
+ :config
+ (require '+org)
+ (defkeys org-mode-map
+ "C-M-k" #'kill-paragraph
+ "C-M-t" #'transpose-paragraphs
+ "RET" #'+org-return-dwim
+ "S-<return>" #'+org-table-copy-down|+org-return-dwim
+ "C-c C-o" #'+org-open-at-point-dwim)
+ (setc org-ellipsis
+ (or (bound-and-true-p truncate-string-ellipsis) "…")
+ org-emphasis-alist
+ '(("*" org-bold)
+ ("/" org-italic)
+ ("_" org-underline)
+ ("=" org-verbatim)
+ ("~" org-code)
+ ("+" org-strikethrough)))
+ (defhook org-mode-hook
+ #'variable-pitch-mode
+ #'visual-fill-column-mode
+ #'turn-off-auto-fill
+ #'org-indent-mode
+ #'prettify-symbols-mode
+ #'abbrev-mode
+ (defhook ((before-save-hook nil :local))
+ :name before-save@org-mode
+ (+org-hide-drawers-except-point)
+ (org-align-tags 'all))))
+
+(use-package org-agenda
+ :custom
+ (org-agenda-skip-deadline-if-done t)
+ (org-agenda-skip-scheduled-if-done t)
+ (org-agenda-span 10)
+ (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-include-diary nil) ; I use the org-diary features
+
+ (org-agenda-todo-ignore-deadlines 'near)
+ (org-agenda-todo-ignore-scheduled 'future)
+ (org-agenda-include-deadlines t)
+ (org-deadline-warning-days 0)
+ (org-agenda-show-future-repeats 'next)
+ (org-agenda-window-setup 'current-window)
+ (org-agenda-file-skip-regexp "sync-conflict")
+ :bind (("C-c a" . org-agenda))
+ :config
+ (require '+org)
+ (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp)
+ (defhook org-agenda-mode-hook
+ (setq-local truncate-lines t)
+ #'hl-line-mode)
+ (defhook org-agenda-after-show-hook
+ #'org-narrow-to-subtree))
+
+(use-package org-capture
+ :bind
+ (("C-c c" . org-capture)))
+
+(use-package ol ; org-link
+ :after org
+ :config
+ (require '+org)
+ (+org-link-define-type sms (number _))
+ (+org-link-define-type tel (number _)))
+
+(use-package ox ; org-export
+ :defer t
+ :custom
+ (org-export-coding-system 'utf-8-unix)
+ (org-export-headline-levels 8)
+ (org-export-with-drawers nil)
+ (org-export-with-section-numbers nil)
+ (org-export-with-smart-quotes t)
+ (org-export-with-sub-superscripts t)
+ (org-export-with-toc nil)
+ :config
+ (require 'ox-md))
+
+(use-package org-word-count
+ :load-path "~/src/emacs/org-word-count/"
+ :hook org-mode-hook)
+
+(provide 'init-org)
+;;; init-org.el ends here
diff --git a/lisp/org-word-count.el b/lisp/org-word-count.el
deleted file mode 100644
index d6d2598..0000000
--- a/lisp/org-word-count.el
+++ /dev/null
@@ -1,297 +0,0 @@
-;;; org-word-count.el --- org-word-count in the modeline -*- lexical-binding: t; -*-
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'org)
-(require 'cl-lib)
-
-(defgroup org-word-count nil
- "Extra fast word-counting in `org-mode'."
- :group 'org)
-
-(defvar-local org-word-count-word-count nil
- "Running total of words in this buffer.")
-
-(defvar-local org-word-count-string nil
- "String for the modeline.")
-
-(defcustom org-word-count-format "%sw "
- "Format for org word count in modeline."
- :type 'string)
-
-(defcustom org-word-count-huge-string "huge"
- "String to display with a huge buffer."
- :type 'string)
-
-(defcustom org-word-count-update-after-funcs '(org-narrow-to-subtree
- org-narrow-to-block
- org-narrow-to-element
- org-capture-narrow)
- "Functions after which to update the word count."
- :type '(repeat function))
-
-(defcustom org-word-count-deletion-idle-timer 0.25
- "Length of time, in seconds, to wait before updating word-count."
- :type 'number)
-
-(defcustom org-word-count-huge-change 5000
- "Number of characters that constitute a \"huge\" insertion."
- :type 'number)
-
-(defcustom org-word-count-huge-buffer 10000
- "Number of words past which we're not going to try to count."
- :type 'number)
-
-(defvar org-word-count-correction -5
- "Number to add to `org-word-count-word-count', for some reason?
-`org-word-count-word-count' seems to consistently be off by 5. Thus
-this correction. (At some point I should correct the underlying
-code... probably).")
-
-(defvar-local org-word-count-update-timer nil)
-
-;;; Variables from org-wc
-
-(defun org-word-count-list-of-strings-p (arg)
- (cl-every #'stringp arg))
-
-(defun org-word-count--downcase-list-of-strings-set-default (var val)
- (set-default var (mapcar #'downcase val)))
-
-(defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE")
- "List of tags for which subtrees will be ignored in word counts"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-ignore-commented-trees t
- "Ignore trees with COMMENT-prefix if non-nil."
- :type 'boolean
- :safe #'booleanp)
-
-(defcustom org-word-count-default-link-count 'description-or-path
- "Default way of counting words in links.
-This is applied to any link type not specified in any of
-‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or
-‘org-word-count-only-description-link-types’ "
- :type '(choice
- (const :tag "Count words in description or else path part of links" description-or-path)
- (const :tag "Count words only in description part of links" description)
- (const :tag "Count links as 0 words" ignore)
- (const :tag "Count links as 1 word" oneword)
- (const :tag "Count words only in path part of links" path))
- :safe 'symbolp)
-
-(defcustom org-word-count-ignored-link-types nil
- "Link types which won't be counted as a word"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-one-word-link-types '("zotero")
- "Link types which will be counted as one word"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-description-or-path-link-types '()
- "Link types for which the description or the path should be counted"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-only-description-link-types '("note")
- "Link types for which only the description should be counted"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-only-path-link-types '()
- "Link types for which only the path should be counted"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p)
-
-(defcustom org-word-count-blocks-to-count '("quote" "verse")
- "List of blocks which should be included in word count.
-
-Use lower case block names"
- :type '(repeat string)
- :safe #'org-word-count-list-of-strings-p
- :set #'org-word-count--downcase-list-of-strings-set-default)
-
-(defun org-word-count-delayed-update (&rest _)
- (if org-word-count-update-timer
- (setq org-word-count-update-timer nil)
- (setq org-word-count-update-timer
- (run-with-idle-timer org-word-count-deletion-idle-timer nil
- #'org-word-count-update))))
-
-(defun org-word-count-force-update ()
- (interactive)
- (message "Counting words...")
- (when (timerp org-word-count-update-timer)
- (cancel-timer org-word-count-update-timer))
- (org-word-count-update)
- (message "Counting words...done"))
-
-(defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice
- (dlet ((org-word-count-counting t))
- (org-word-count-buffer)
- (org-word-count-modeline)
- (setq org-word-count-update-timer nil)))
-
-(defun org-word-count-changed (start end length)
- (org-word-count-delayed-update))
-
-(defun org-word-count-buffer ()
- "Count the words in the buffer."
- (when (and (derived-mode-p 'org-mode)
- (not (eq org-word-count-word-count 'huge)))
- (setq org-word-count-word-count
- (cond
- ((> (count-words (point-min) (point-max))
- org-word-count-huge-buffer)
- 'huge)
- (t (org-word-count-aux (point-min) (point-max)))))))
-
-;;; From org-wc.el:
-;; https://github.com/tesujimath/org-wc/
-(defun org-word-count-aux (beg end)
- "Return the number of words between BEG and END."
- (let ((wc 0)
- subtreecount
- (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
- (save-excursion
- (goto-char beg)
- ;; Handle the case where we start in a drawer
- (when (org-at-drawer-p)
- (org-end-of-meta-data t))
- (while (< (point) end)
- (cond
- ;; Handle headlines and subtrees
- ((org-at-heading-p)
- (cond
- ;; Ignore commented and org-wc-ignored-tags trees
- ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p))
- (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=))
- (org-end-of-subtree t t))
- ;; Re-use count for subtrees already counted
- ((setq subtreecount (get-text-property (point) :org-wc))
- (cl-incf wc subtreecount)
- (org-end-of-subtree t t))
- ;; Skip counting words in headline
- (t (org-word-count--goto-char (point-at-eol) end))))
- ;; Ignore most blocks.
- ((when (save-excursion
- (beginning-of-line 1)
- (looking-at org-block-regexp))
- (if (member (downcase (match-string 1)) org-word-count-blocks-to-count)
- (progn ;; go inside block and subtract count of end line
- (org-word-count--goto-char (match-beginning 4) end)
- (cl-decf wc))
- (org-word-count--goto-char (match-end 0) end))))
- ;; Ignore comments.
- ((org-at-comment-p)
- (org-word-count--goto-char (point-at-eol) end))
- ;; Ignore drawers.
- ((org-at-drawer-p)
- (org-end-of-meta-data t))
- ;; Ignore all other #+ lines
- ((looking-at "#+")
- (org-word-count--goto-char (point-at-eol) end))
- ;; Handle links
- ((save-excursion
- (when (< (1+ (point-min)) (point)) (backward-char 2))
- (looking-at org-link-bracket-re))
- (let* ((type (car (save-match-data (split-string (match-string 1) ":"))))
- (pathstart (+ 1 (length type) (match-beginning 1))))
- (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore)
- ((member type org-word-count-one-word-link-types) 'oneword)
- ((member type org-word-count-only-description-link-types)
- 'description)
- ((member type org-word-count-only-path-link-types) 'path)
- ((member type org-word-count-description-or-path-link-types)
- 'description-or-path)
- (t org-word-count-default-link-count))
- (ignore (org-word-count--goto-char (match-end 0) end))
- (oneword (org-word-count--goto-char (match-end 0) end)
- (cl-incf wc))
- (description (if (match-beginning 2)
- (goto-char (match-beginning 2))
- (org-word-count--goto-char
- (match-end 0) end)))
- (path (cl-incf wc (count-words-region pathstart
- (match-end 1)))
- (org-word-count--goto-char (match-end 0) end))
- (description-or-path
- (if (match-beginning 2)
- (goto-char (match-beginning 2))
- (cl-incf wc (count-words-region pathstart
- (match-end 1)))
- (org-word-count--goto-char (match-end 0) end)))
- (t (user-error "Error in org-word-count link configuration")))))
- ;; Count latex macros as 1 word, ignoring their arguments.
- ((save-excursion
- (when (< (point-min) (point)) (backward-char))
- (looking-at latex-macro-regexp))
- (org-word-count--goto-char (match-end 0) end)
- (cl-incf wc))
- (t
- (and (re-search-forward "\\w+\\W*" end 'skip)
- (cl-incf wc))))))
- wc))
-
-(defun org-word-count--goto-char (char end)
- "Moves point to CHAR and from there passes 0+ non-word characters.
-Searchers to end as a maximum.
-
-This ensures that we are in an expected state (at the first word
-character after some non-word characters) after moving beyond
-headlines, links etc."
- (goto-char char)
- (re-search-forward "\\W*" end 'skip))
-
-(defvar org-word-count-counting nil
- "Are we currently counting?")
-
-(defun org-word-count-recount-widen (&rest _)
- (when (and (not org-word-count-counting))
- (org-word-count-update)))
-
-(defun org-word-count-modeline ()
- (setq org-word-count-string
- (cond
- ((eq org-word-count-word-count 'huge)
- org-word-count-huge-string)
- (org-word-count-word-count
- (format org-word-count-format
- (max 0 (+ org-word-count-word-count
- org-word-count-correction))))))
- (force-mode-line-update))
-
-(define-minor-mode org-word-count-mode
- "Count words in `org-mode' buffers in the mode-line."
- :lighter ""
- :keymap (let ((map (make-sparse-keymap)))
- (define-key map (kbd "C-c C-.") #'org-word-count-force-update)
- map)
- (cond (org-word-count-mode
- (org-word-count-buffer)
- (add-hook 'after-change-functions
- #'org-word-count-delayed-update nil t)
- (unless (member '(org-word-count-mode org-word-count-string)
- mode-line-misc-info)
- (add-to-list 'mode-line-misc-info
- '(org-word-count-mode org-word-count-string)
- nil
- #'equal))
- (dolist (fn org-word-count-update-after-funcs)
- (advice-add fn :after #'org-word-count-update)))
- (:else
- (remove-hook 'after-change-functions
- #'org-word-count-delayed-update t)
- (setf mode-line-misc-info
- (delete '(org-word-count-mode org-word-count-string)
- mode-line-misc-info))
- (dolist (fn org-word-count-update-after-funcs)
- (advice-remove fn #'org-word-count-update)))))
-
-(provide 'org-word-count)
-;;; org-word-count.el ends here
diff --git a/lisp/pita.el b/lisp/pita.el
deleted file mode 100644
index ed67c92..0000000
--- a/lisp/pita.el
+++ /dev/null
@@ -1,69 +0,0 @@
-;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*-
-;; 🥙
-
-;;; utils
-
-(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)))
-
-;;; 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)))))
-
-;;; wrappers
-
-(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)))))))
-
-(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)))))
-
-;;; wrapper advice
-
-(provide 'pita)
-;;; pita.el ends here
diff --git a/lisp/private.el b/lisp/private.el
deleted file mode 100644
index 4f6115e..0000000
--- a/lisp/private.el
+++ /dev/null
@@ -1,23 +0,0 @@
-;;; private.el -*- lexical-binding: t; -*-
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'acdw)
-
-(defgroup private nil
- "Private things are private. Shhhhh....")
-
-;; Private directory
-
-(+define-dir private/ (sync/ "emacs/private")
- "Private secretive secrets inside.")
-(add-to-list 'load-path private/)
-
-;; Load random private stuff
-
-(require '_acdw)
-
-(provide 'private)
-;;; private.el ends here
diff --git a/lisp/scule.el b/lisp/scule.el
deleted file mode 100644
index 3ed58bb..0000000
--- a/lisp/scule.el
+++ /dev/null
@@ -1,61 +0,0 @@
-;;; 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
diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el
new file mode 100644
index 0000000..5a9da84
--- /dev/null
+++ b/lisp/upload-junk.el
@@ -0,0 +1,47 @@
+;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*-
+
+;;; Code:
+
+(require 'tramp)
+
+(defvar upload-junk-ssh-host "hetzner"
+ "SSH host to upload to.")
+
+(defvar upload-junk-ssh-root "/junk"
+ "SSH root folder to upload to.")
+
+(defvar upload-junk-web-host "https://junk.acdw.net"
+ "Web host to link uploads to.")
+
+(defun upload-junk-file-name (&optional file)
+ "Return the uploaded filename for FILE."
+ (let ((file (or file "_.txt")))
+ (format "tmp_%s_%x%x.%s"
+ (file-name-nondirectory (file-name-sans-extension file))
+ (time-convert (current-time) 'integer)
+ (random (* 8 8 8 8))
+ (or (file-name-extension file) "txt"))))
+
+(defun upload-junk-region (start end)
+ "Upload region from START to END to my server."
+ (interactive "r")
+ (let* ((s (buffer-substring-no-properties start end))
+ (f (upload-junk-file-name (buffer-file-name)))
+ (w (format "%s/%s" upload-junk-web-host f)))
+ (with-temp-buffer
+ (insert s)
+ (write-file (format "/sshx:%s:%s/%s"
+ upload-junk-ssh-host
+ upload-junk-ssh-root
+ f)))
+ (kill-new w)
+ w))
+
+(defun upload-junk-region-or-buffer ()
+ (interactive)
+ (if (region-active-p)
+ (upload-junk-region (region-beginning) (region-end))
+ (upload-junk-region (point-min) (point-max))))
+
+(provide 'upload-junk)
+;;; upload-junk.el ends here
diff --git a/lisp/yoke.el b/lisp/yoke.el
index 8ca94fd..ec84f56 100644
--- a/lisp/yoke.el
+++ b/lisp/yoke.el
@@ -1,271 +1,360 @@
-;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*-
-;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net>
+;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2022 Case Duckworth
+
+;; Author: Case Duckworth <case@bob>
+;; Keywords: convenience
+;; Package-Version: 0.61803398875
+;; Homepage: https://junk.acdw.net/yoke.el
+;; Package-Requires: ((emacs "28.1"))
+
+;; 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:
-;; What's the most basic functionality of a package manager? In my view, all a
-;; package manager should do is fetch packages from wherever they are, and
-;; provide the system with a method of accessing those packages' functionality.
-;; In Emacs, this means downloading packages from the Internet and adding their
-;; directories to `load-path'. That's what `yoke' tries to do.
-;;
-;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't
-;; automatically fetch dependencies. It doesnt' do much else of anything
-;; --- hell, it doesn't have to generate autoloads or build the dang source
-;; files if you don't want it to. /I/ have it do those things because I like a
-;; few creature comforts, but you can turn 'em off.
-;;
-;; Instead of focusing too much on installing packages, `yoke' works harder to
-;; group---to "yoke together," if you will---related configurations together, à
-;; la `use-package' or `setup'. I used both of those packages before and found
-;; each somewhat lacking, and what I really wanted was a fancy `progn' that I
-;; could put whatever I want inside. So that's basically what `yoke' is. It's
-;; a configuration macro that automatically fetches packages from their repos
-;; and tells Emacs where they are, then executes its body in a `cl-block' for
-;; ... reasons. That's it.
+;; THIS IS A WORK IN PROGRESS. DON'T USE IT.
;;; Code:
(require 'cl-lib)
+(require 'package-vc)
-;;; Customization options
+;;; User options
(defgroup yoke nil
"Customizations for `yoke'."
- :group 'applications
+ :group 'convenience
:prefix "yoke-")
-(defcustom yoke-dir (locate-user-emacs-file "yoke")
+(defcustom yoke-directory package-user-dir
"Where to put yoked packages."
:type 'file)
-(defcustom yoke-get-default-fn #'yoke-get-git
- "Default function to get packages with."
- :type 'function)
+(defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache"
+ "~/.yoke-cache")
+ "Where to put cached yoke files, like downloaded HTTP packages."
+ :type 'file)
+
+(defcustom yoke-debug-on-error nil
+ "Whether to throw up the debugger on a yoke error.
+If nil, errors will be inserted in the `yoke-message-buffer'.")
+
+;;; Variables
+
+(defvar yoke-message-buffer " *yoke*"
+ "The buffer used for yoke messages.")
+
+(defvar yoke-selected-packages nil
+ "List of packages managed by `yoke'.")
+
+(defvar yoke-backends '(file http package)
+ "Backends handled by `yoke'.")
+
+;;; Main functionality
+
+(defmacro yoke (package &rest body)
+ "Yoke a package into your Emacs session.
+PACKAGE is either a symbol, in which case `yoke' expands to
+basically a named `progn' (good for grouping configuration), or a
+list of the form (NAME . ARGS), where ARGS can be one of the
+following:
+
+- nil: install NAME using `package'.
+- a property list describing a package specification. Valid
+ key/value pairs include
+
+ `:backend' (symbol)
+ A symbol of the yoke backend to use for installing the
+ package. See `yoke-backends' for allowed backends.
+
+ `:url' (string)
+ The URL of the package's repository or source.
+
+ `:lisp-dir' (string)
+ The repository-relative name of the directory to use for
+ loading lisp sources. If not given, it defaults to the
+ repo's root directory.
-(defvar yoke-buffer "*yoke*"
- "Buffer to use for yoke process output.")
+ Other pairs may be valid for a given backend; see that
+ backend's `yoke-install' function for more details.
-(defvar yoke-dirs nil
- "List of directories managed by `yoke'.")
+BODY is executed in a `condition-case' so that errors won't keep
+the rest of Emacs from initializing. BODY can also be prepended
+by the following keyword arguments:
-;;; GET YOKED
+ `:after' (FEATURE...)
-(defmacro yoke (package
- &rest body)
- "Yoke PACKAGE to work with your Emacs.
-Execute BODY afterward.
+ `:require' (FEATURE...)
-\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)"
+ `:depends' (PACKAGE-SPEC...)
+
+ `:build' (ACTION...)
+
+ `:unless' (PREDICATE)
+
+ `:when' (PREDICATE)
+
+Other keywords are ignored.
+
+\(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)"
(declare (indent 1))
- (let* (;; State
- (pkg (cond ((consp package) (car package))
- (:else package)))
- (url (cond ((consp package) (cdr package))
- (:else nil)))
- (pname (intern (format "yoke:%s" pkg)))
- (dirvar '$yoke-dir)
- ;; Keyword args --- TODO: Naming could probably be better.
+ (let* ((name (or (car-safe package) package))
+ (backend (yoke--pget package :backend))
+ ;; Body keyword arguments
(after (plist-get body :after))
(depends (plist-get body :depends))
+ (req (plist-get body :require))
+ (buildp (plist-member body :build))
+ (build (plist-get body :build))
(whenp (plist-member body :when))
+ (when (if whenp (plist-get body :when) t))
(unlessp (plist-member body :unless))
- (when (cond (whenp (plist-get body :when))
- (:else t)))
- (unless (cond (unlessp (plist-get body :unless))
- (:else nil)))
- (autoload (cond ((plist-member body :autoload)
- (plist-get body :autoload))
- (:else t)))
- (pre (plist-get body :pre))
+ (unless (if unlessp (plist-get body :unless) nil))
;; Body
- (body (cl-loop for (this next) on body by #'cddr
- unless (keywordp this)
- append (list this next) into ret
- finally return (cond ((eq (car (last ret)) nil)
- (butlast ret))
- (:else ret))))
- (r (gensym)))
- `(let ((,r (cl-block ,pname
-(condition-case err
- (progn
- ;; Pass `:when' or `:unless' clauses
- ,@(cond
- ((and whenp unlessp)
- `((when (or (not ,when) ,unless)
- (cl-return-from ,pname
- (format "%s (abort) :when %S :unless %S"
- ',pname ',when ',unless)))))
- (whenp
- `((unless ,when (cl-return-from ,pname
- (format "%s (abort) :when %S"
- ',pname ',when)))))
- (unlessp
- `((when ,unless (cl-return-from ,pname
- (format "%s (abort) :unless %S"
- ',pname ',unless))))))
- ;; Evaluate `:pre' forms
- ,@pre
- ;; Get prerequisite packages
- ,@(cl-loop
- for (pkg* . yoke-get-args) in depends
- collect `(or
- (let* ((pkg-spec (yoke-get ,@yoke-get-args
- :dir ,(format "%s" pkg*)))
- (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load)
- "")
- (car pkg-spec))))
- (and dir
- ,@(if autoload
- `((yoke-generate-autoloads ',pkg* dir))
- '(t))
- (add-to-list 'yoke-dirs dir nil #'string=)))
- (cl-return-from ,pname
- (format "Error fetching prerequiste: %s"
- ',pkg*))))
- ;; Download the package, generate autoloads
- ,@(when url
- `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg)))
- (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load)
- "")
- (car pkg-spec))))
- ,@(when autoload
- `((yoke-generate-autoloads ',pkg ,dirvar)))
- (add-to-list 'yoke-dirs ,dirvar nil #'string=))))
- ;; Evaluate the body, optionally after the features in `:after'
- ,@(cond (after
- `((yoke-eval-after ,after ,@body)))
- (:else body)))
- (:success ',package)
- (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
- nil)))))
- (when (stringp ,r) (message "%S" ,r))
- ,r)))
-
-(defun yoke-get (url &rest args)
- "\"Get\" URL and and put it in DIR, then add DIR to `load-path'.
-URL can be a string or a list of the form (TYPE URL). The
-download will be dispatched to the TYPE, or to
-`yoke-get-default-fn' if only a string is given.
-ARGS is a plist with the following possible keys:
-
-:dir DIRECTORY --- the directory to put the URL.
-:load DIRECTORY --- the directory (relative to the download path)
- to add to `load-path'.
-:type TYPE --- one of `http', `git', or `file' --- how to
- download URL."
- (let* ((dir (plist-get args :dir))
- (load (plist-get args :load))
- (type (or (plist-get args :type)))
- (path (cond
- ((eq type 'http) (yoke-get-http url dir))
- ((or (eq type 'git)
- (string-match-p (rx bos "git:") url))
- (yoke-get-git url dir))
- ((or (eq type 'file)
- (string-match-p (rx bos (or "file:" "~" "/")) url))
- (yoke-get-file url dir))
- ((stringp url)
- (funcall yoke-get-default-fn url dir))
- (:else (error "Uknown URL type: %S" url)))))
- (cond
- ((file-exists-p path)
- (add-to-list 'load-path (expand-file-name (or load "") path))
- (cons path args))
- (:else (error "Directory \"%s\" doesn't exist." path)
- nil))))
-
-(defun yoke-get--guess-directory (path &optional dir)
- "Guess directory from PATH and DIR, and return it.
-If DIR is present and relative, resolve it relative to
-`yoke-dir', or if it's absolute, leave it as-is. If DIR is
-absent, return the final component of PATH resolved relative to
-`yoke-dir'."
- (expand-file-name (or dir (file-name-nondirectory path))
- yoke-dir))
-
-(defun yoke-get-http (url &optional dir)
- "Download URL to DIR and return its directory.
-If DIR isn't given, it's guessed from the final component of the
-URL's path and placed under `yoke-dir'."
- (let* ((dir (yoke-get--guess-directory url dir))
- (basename (file-name-nondirectory url))
- ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have
- ;; a parameter (either dynamic var or passed in) that would give the
- ;; name of the downloaded file. But that would take a bit of
- ;; re-engineering, I think. So for now, it stays thus.
- (filename (expand-file-name
- (replace-regexp-in-string
- (rx "-" (+ digit) ; major version
- (+ (group "." (+ digit))) ; following version numbers
- (group "." (+ (not space)))) ; extension
- "\\2"
- basename)
- dir)))
- (cond ((file-exists-p filename)
- dir)
- (:else
- (message "Downloading %s..." url)
- (with-current-buffer (let ((url-debug t))
- (url-retrieve-synchronously url))
- (condition-case e
- (progn
- (goto-char (point-min))
- (delete-region (point) (+ 1 (re-search-forward "^$")))
- (make-directory dir :parents)
- (write-file filename 1)
- (message "Downloading %s... Done" url))
- (:success dir)
- (t (signal (car e) (cdr e)))))))))
-
-(defun yoke-get-git (repo &optional dir)
- "Clone REPO to DIR and return its directory.
-If DIR isn't given, it's guessed from the repo's name and put
-under `yoke-dir'. Return the cloned directory's name on success,
-or nil on failure."
- (let ((dir (yoke-get--guess-directory repo dir)))
- (cond ((file-exists-p dir)
- dir)
- (:else
- (message "Cloning %s..." repo)
- (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil
- "clone" repo dir)
- (0 (message "Cloning %s... Done" repo)
- dir)
- (_ (message "Cloning %s... Error! See buffer %s for output."
- repo yoke-buffer)
- nil))))))
-
-(defun yoke-get-file (file &optional _dir)
- "Add FILE's directory to `load-dir'.
-_DIR is ignored."
- (file-name-directory file))
-
-(defun yoke-generate-autoloads (package dir)
- "Generate autoloads for PACKAGE in DIR."
- ;; Shamelessly stolen from `straight'.
- (eval-and-compile (require 'autoload))
- (let ((generated-autoload-file
- (expand-file-name (format "%s-autoloads.el" package) 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))
- (load generated-autoload-file :noerror :nomessage)
- t))
-
-;;; Evaluating forms after features
+ (body (let ((b body) r)
+ (while (consp b)
+ (if (keywordp (car b))
+ (setf b (cdr b))
+ (setf r (cons (car b) r)))
+ (setf b (cdr b)))
+ (reverse r)))
+ (esym (make-symbol "yoke-error")))
+ ;; Body modifiers. These are applied in reverse order (that is, the last
+ ;; one will be on the outside).
+ ;; --- Require the current package
+ (when req
+ (setf body
+ (append (let (reqs)
+ (dolist (r (ensure-list req) reqs)
+ (let* ((feat (if (eq r t) name r))
+ (+feat (intern (format "+%s" feat))))
+ (push `(require ',feat) reqs)
+ (push `(require ',+feat nil :noerror) reqs)))
+ (reverse reqs))
+ body)))
+ ;; --- Install the package
+ (when (consp package)
+ (push `(yoke-install ',(car package) ,@(cdr package))
+ body))
+ ;; --- Dependencies
+ (when depends
+ (setf body
+ (append (cl-loop for dep in (ensure-list depends)
+ collect `(or (yoke-install ',@(ensure-list dep))
+ (error "Dependency (%s): %S"
+ ',dep ',package)))
+ body)))
+ ;; --- Load after
+ (when after
+ (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body))))
+ ;; --- Conditional expansion
+ (when (or whenp unlessp)
+ (setf body
+ (append (cond
+ ((and whenp unlessp)
+ `((when (or (not ,when) ,unless)
+ (signal 'yoke-predicate
+ '(:when ,when :unless ,unless)))))
+ (whenp
+ `((unless ,when (signal 'yoke-predicate
+ '(:when ,when)))))
+ (unlessp
+ `((when ,unless (signal 'yoke-predicate
+ '(:unless ,unless))))))
+ body)))
+ ;; Expansion
+ `(condition-case ,esym
+ (cl-letf (((symbol-function 'package--save-selected-packages)
+ #'ignore))
+ ;; Body
+ ,@body)
+ (:success
+ ,(unless (atom package)
+ `(setf (alist-get ',name yoke-selected-packages)
+ (list ,@(cdr-safe package))))
+ ',package)
+ (t ,(if yoke-debug-on-error
+ `(signal (car ,esym) (cdr ,esym))
+ `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym)))))))
+
+;;; Installing packages
+
+(defun yoke-install (name &rest args)
+ "Install package NAME, with ARGS."
+ (let ((custom-file null-device)
+ (inhibit-message (and (not (plist-member args :update))
+ (not debug-on-error)))
+ (messages-buffer-name yoke-message-buffer))
+ (funcall
+ (intern
+ (format "yoke-install-%s"
+ (or (plist-get args :backend)
+ (yoke--guess-backend (plist-get args :url))
+ 'package)))
+ name args))
+ (yoke--clean-load-path)
+ ;; Don't return nil
+ t)
+
+(defun yoke-install-package (name args &optional tries)
+ "Install package NAME with ARGS using `package' machinery.
+TRIES is an internal variable."
+ (let ((package-user-dir yoke-directory)
+ (url (plist-get args :url))
+ (update (plist-get args :update))
+ (dirname (expand-file-name (format "%s" name)
+ yoke-directory))
+ (tries (or tries 0))
+ load-dir autoloads-file-name)
+ (unless (file-exists-p dirname)
+ (setq dirname (or (car-safe (file-expand-wildcards
+ (concat dirname "*")))
+ dirname)))
+ (setq load-dir
+ (expand-file-name (or (plist-get args :lisp-dir) "") dirname)
+ generated-autoload-file
+ (expand-file-name (format "%s-autoloads.el" name) load-dir))
+ (prog1
+ (condition-case error
+ (cond
+ ;; -- Commented on 2022-12-21
+ ;; ((and (file-exists-p dirname)
+ ;; (not update))
+ ;; (add-to-list 'load-path
+ ;; (expand-file-name
+ ;; (or (plist-get args :lisp-dir) "")
+ ;; dirname)
+ ;; nil #'equal)
+ ;; (require (intern (format "%s-autoloads" name))))
+ ((and url update)
+ (package-vc-update (cadr (assoc name package-alist))))
+ (update
+ (package-update name))
+ (url
+ ;; I'm going to be honest here, this is extremely cursed. But I
+ ;; don't want to get asked about installing the packages, and when
+ ;; the user answers 'no', the function errors. So.. this.
+ (cl-letf (((symbol-function 'yes-or-no-p) #'ignore))
+ (ignore-errors (package-vc-install (cons name args)))))
+ (:else
+ (package-install name)))
+ (file-error (if (> tries 1)
+ (error "(yoke) Can't install `%s'" name)
+ (package-refresh-contents)
+ (yoke-install-package name args (1+ tries)))))
+ (add-to-list 'load-path load-dir nil #'equal)
+ (loaddefs-generate load-dir generated-autoload-file)
+ ;; Do it again, if it doesn't actually /generate/ anything
+ (when (eq 'provide
+ (with-current-buffer (find-file-noselect generated-autoload-file)
+ (read (buffer-substring (point-min) (point-max)))))
+ (loaddefs-generate load-dir generated-autoload-file nil nil nil
+ :generate-full))
+ (load generated-autoload-file :noerror)
+ (kill-buffer (get-file-buffer generated-autoload-file))
+ (package-activate name))))
+
+(defun yoke-install-http (name args)
+ "Install a package NAME using ARGS from an http source."
+ (let* ((url (plist-get args :url))
+ (cached (expand-file-name (file-name-nondirectory url)
+ yoke-cache-directory))
+ (update (plist-get args :update)))
+ (unless url
+ (error "No URL for HTTP download: %S" (cons name args)))
+ (when (or (not (file-exists-p cached))
+ update)
+ (make-directory yoke-cache-directory :parents)
+ (message "Downloading `%s'..." url)
+ (let* ((url-debug t)
+ (buf (url-retrieve-synchronously url)))
+ (with-current-buffer buf
+ (goto-char (point-min))
+ (delete-region (point) (1+ (re-search-forward "^$")))
+ (write-file cached 1)
+ (message "Downloading `%s'...Done." url))))
+ (package-install-file cached)))
+
+(defun yoke-install-file (name args)
+ "Install package NAME using ARGS from a file on-disk."
+ (let ((url (plist-get args :url))
+ (update (plist-get args :update))
+ (dirname (expand-file-name (format "%s" name) yoke-directory)))
+ (if (file-exists-p url)
+ ;; This takes care of updating too.
+ (package-install-file url)
+ (error "(yoke) No such file: `%s'" url))))
+
+;;; Other package transactions
+
+(defun yoke--choose-package ()
+ "Choose a package from `yoke-selected-packages'."
+ (assoc (intern (completing-read "Package: " yoke-selected-packages))
+ yoke-selected-packages))
+
+(defun yoke-update (name &rest args)
+ (interactive (yoke--choose-package))
+ (save-window-excursion
+ (apply #'yoke-install name (append '(:update t)
+ args))))
+
+(defun yoke-update-all ()
+ (interactive)
+ (dolist (pkg yoke-selected-packages)
+ (apply #'yoke-update pkg)))
+
+;;; Emacs integration
+
+(defun yoke-imenu-insinuate ()
+ "Insinuate `yoke' forms for `imenu'."
+ (require 'imenu)
+ (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
+ (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)"
+ 1))
+ (with-eval-after-load 'consult-imenu
+ (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode
+ consult-imenu-config)
+ :types))
+ '("Yoke"))))
+
+;;; Utility functions
+
+(defun yoke--pget (spec prop &optional default)
+ "Get PROP's value from SPEC, a yoke specification.
+If KEY doesn't exist, return DEFAULT."
+ (let ((pl (or (and (plistp spec) spec)
+ (cdr-safe spec))))
+ (if (plist-member pl prop)
+ (plist-get pl prop)
+ default)))
+
+(defun yoke--guess-backend (url)
+ "Guess the backend to use from URL.
+If inconclusive, return nil."
+ (cond
+ ((or (string-prefix-p "file:" url t)
+ (string-prefix-p "~" url)
+ (string-prefix-p "/" url))
+ 'file)
+ (:else nil)))
+
+(defun yoke--clean-load-path ()
+ (when-let ((first (string-remove-suffix "/" (car load-path)))
+ (second (string-remove-suffix "/" (cadr load-path)))
+ (_ (equal first second)))
+ (setf load-path (cdr load-path))
+ (setf (car load-path) second)))
(defun yoke--eval-after-init (fn)
"Evaluate FN after inititation, or now if Emacs is initialized.
@@ -274,79 +363,30 @@ FN is called with no arguments."
(funcall fn)
(add-hook 'after-init-hook fn)))
-(defmacro yoke-eval-after (features &rest body)
- "Evaluate BODY, but only after loading FEATURES.
-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)))
- (unless (listp features)
- (setf features (list features)))
- (if (null features)
- (macroexp-progn body)
- (let* ((this (car features))
- (rest (cdr features)))
- (cond ((eq this 'init)
- `(yoke--eval-after-init
- (lambda () (yoke-eval-after ,rest ,@body))))
- (:else
- `(with-eval-after-load ',this
- (yoke-eval-after ,rest ,@body)))))))
+(defmacro yoke--eval-after (prereqs &rest body)
+ "Evaluate body after PREREQS.
+PREREQS can be a feature, a number, `:init', or a list of those.
-;;; Integration
+Features are used as arguments to `eval-after-load'. Numbers are
+used as arguments to `run-with-idle-timer'. `:init' will ensure BODY
+runs after Emacs's init time.
-(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 (or "(" " " "\t" "\n"))))
- (* any)))
- 1)))
-
-;;; Package maintenance
-
-(defvar yoke--all "*all*"
- "Value that `yoke--prompt-for-package' uses for all packages.")
-
-(defun yoke--choose-packages (prompt &optional onep)
- "Choose from all of yoke's installed packages."
- (funcall (if onep #'completing-read #'completing-read-multiple)
- prompt
- (cons yoke--all yoke-dirs)
- nil :require-match nil nil
- (unless onep yoke--all)))
-
-(defun yoke--choices (&optional selections)
- "Either the SELECTIONS given, or all of `yoke-dirs'.
-If `yoke--all' is part of SELECTIONS, or if it's not given,
-return the full list of `yoke-dirs'."
- (cond ((or (null selections)
- (member yoke--all selections))
- yoke-dirs)
- (:else selections)))
-
-(defun yoke-compile (&rest packages)
- "Compile all elisp files in `yoke-dirs'."
- (interactive (yoke--choose-packages "Compile packages: "))
- (dolist (dir (yoke--choices packages))
- (byte-recompile-directory dir 0)))
-
-(defun yoke-update-autoloads (&rest packages)
- "Update the autoloads in PACKAGES' directories."
- (interactive (yoke--choose-packages "Generate autoloads for packages: "))
- (dolist (dir (yoke--choices packages))
- (message "Generating autoloads for %s..." dir)
- (yoke-generate-autoloads (file-name-nondirectory dir) dir)
- (message "Generating autoloads for %s... Done" dir)))
-
-(defun yoke-remove (dir)
- "Remove DIR from `yoke-dir'."
- (interactive
- (list (completing-read "Remove: " yoke-dirs
- nil :require-match)))
- (delete-directory dir :recursive :trash))
+When given a list of PREREQS, `eval-after' will nest each one
+from left to right."
+ (declare (indent 1) (debug (form def-body)))
+ (setf prereqs (ensure-list prereqs))
+ (if (null prereqs)
+ (macroexp-progn body)
+ (let* ((this (car prereqs))
+ (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body)))))
+ (cond
+ ((eq this :init)
+ (append '(yoke--eval-after-init) form))
+ ((numberp this)
+ (append `(run-with-idle-timer ,this nil) form))
+ ((symbolp this)
+ (append `(eval-after-load ',this) form))
+ (:else (user-error "Eval-after: Bad prereq: %S" this))))))
(provide 'yoke)
;;; yoke.el ends here
--
cgit 1.4.1-21-gabe81