diff options
-rw-r--r-- | basics.el | 376 | ||||
-rw-r--r-- | early-init.el | 86 | ||||
-rw-r--r-- | init.el | 933 | ||||
-rw-r--r-- | lisp/+browse-url.el | 189 | ||||
-rw-r--r-- | lisp/+cape.el | 25 | ||||
-rw-r--r-- | lisp/+emms.el | 38 | ||||
-rw-r--r-- | lisp/+flyspell-correct.el | 24 | ||||
-rw-r--r-- | lisp/+hungry-delete.el | 53 | ||||
-rw-r--r-- | lisp/+isearch.el | 24 | ||||
-rw-r--r-- | lisp/+ispell.el | 97 | ||||
-rw-r--r-- | lisp/+link-hint.el | 144 | ||||
-rw-r--r-- | lisp/+lisp.el | 93 | ||||
-rw-r--r-- | lisp/+message.el | 26 | ||||
-rw-r--r-- | lisp/+notmuch.el | 149 | ||||
-rw-r--r-- | lisp/+org-capture.el | 49 | ||||
-rw-r--r-- | lisp/+org.el | 309 | ||||
-rw-r--r-- | lisp/+paredit.el | 26 | ||||
-rw-r--r-- | lisp/+titlecase.el | 34 | ||||
-rw-r--r-- | lisp/acdw-defaults.el | 295 | ||||
-rw-r--r-- | lisp/acdw-funs.el | 262 | ||||
-rw-r--r-- | lisp/acdw-macs.el | 293 | ||||
-rw-r--r-- | lisp/acdw.el | 79 | ||||
-rw-r--r-- | lisp/graveyard.el | 50 | ||||
-rw-r--r-- | lisp/init-org.el | 144 | ||||
-rw-r--r-- | lisp/upload-junk.el | 47 | ||||
-rw-r--r-- | lisp/yoke.el | 392 |
26 files changed, 398 insertions, 3839 deletions
diff --git a/basics.el b/basics.el new file mode 100644 index 0000000..06f5ece --- /dev/null +++ b/basics.el | |||
@@ -0,0 +1,376 @@ | |||
1 | ;;; basics.el --- Super basic Emacs settings -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; These are the settings that I literally cannot live without. Basic | ||
6 | ;; settings, built-in packages, that kind of stuff. Everything else | ||
7 | ;; goes in init.el. | ||
8 | |||
9 | ;;; Code: | ||
10 | |||
11 | ;;; Directories | ||
12 | |||
13 | (defmacro defdir (name directory &optional docstring makedir) | ||
14 | "Define a variable and a function NAME expanding to DIRECTORY. | ||
15 | DOCSTRING is applied to the variable; its default is DIRECTORY's | ||
16 | path. If MAKEDIR is non-nil, the directory and its parents will | ||
17 | be created." | ||
18 | (declare (indent 2) (doc-string 3)) | ||
19 | `(progn | ||
20 | (defvar ,name (expand-file-name ,directory) | ||
21 | ,(concat (or docstring (format "%s" directory)) "\n" | ||
22 | "Defined by `defdir'.")) | ||
23 | (defun ,name (file &optional mkdir) | ||
24 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | ||
25 | "If MKDIR is non-nil, parent directories are created.\n" | ||
26 | "Defined by `defdir'.") | ||
27 | (let ((file-name (expand-file-name | ||
28 | (convert-standard-filename file) ,name))) | ||
29 | (when mkdir | ||
30 | (make-directory (file-name-directory file-name) :parents)) | ||
31 | file-name)) | ||
32 | ,(if makedir | ||
33 | `(make-directory ,directory :parents) | ||
34 | `(unless (file-exists-p ,directory) | ||
35 | (warn "Directory `%s' doesn't exist." ,directory))))) | ||
36 | |||
37 | (defdir etc/ (locate-user-emacs-file "etc/") | ||
38 | "Where various Emacs files are placed." | ||
39 | :makedir) | ||
40 | |||
41 | (defdir lisp/ (locate-user-emacs-file "lisp/") | ||
42 | "My bespoke elisp files." | ||
43 | :makedir) | ||
44 | (push lisp/ load-path) | ||
45 | |||
46 | (defdir sync/ "~/Sync/" | ||
47 | "My Syncthing directory." | ||
48 | :makedir) | ||
49 | |||
50 | (defdir private/ (sync/ "emacs/private/") | ||
51 | "Private files and stuff." | ||
52 | :makedir) | ||
53 | (push private/ load-path) | ||
54 | |||
55 | (use-package no-littering | ||
56 | :ensure t :demand t | ||
57 | :preface | ||
58 | (setq-default no-littering-etc-directory etc/ | ||
59 | no-littering-var-directory etc/)) | ||
60 | |||
61 | ;;; Settings | ||
62 | |||
63 | ;; Async | ||
64 | (setq-default async-shell-command-buffer 'new-buffer | ||
65 | async-shell-command-display-buffer nil) | ||
66 | |||
67 | ;; Scrolling | ||
68 | (setq-default auto-hscroll-mode t | ||
69 | auto-window-vscroll nil | ||
70 | fast-but-imprecise-scrolling t | ||
71 | hscroll-margin 1 | ||
72 | hscroll-step 1 | ||
73 | scroll-conservatively 25 | ||
74 | scroll-margin 0 | ||
75 | scroll-preserve-screen-position 1 | ||
76 | scroll-step 1) | ||
77 | (scroll-bar-mode -1) | ||
78 | (horizontal-scroll-bar-mode -1) | ||
79 | (pixel-scroll-precision-mode) | ||
80 | |||
81 | ;; Cursor | ||
82 | (setq-default cursor-in-non-selected-windows 'hollow | ||
83 | cursor-type 'bar | ||
84 | blink-cursor-blinks 1 | ||
85 | blink-cursor-interval 0.25 | ||
86 | blink-cursor-delay 0.25) | ||
87 | (blink-cursor-mode) | ||
88 | |||
89 | ;; Mouse | ||
90 | (setq-default mouse-drag-copy-region t | ||
91 | mouse-wheel-progressive-speed nil | ||
92 | mouse-yank-at-point t) | ||
93 | |||
94 | ;; Dialogs | ||
95 | (unless (boundp 'use-short-answers) | ||
96 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
97 | |||
98 | (setq-default read-answer-short t | ||
99 | use-dialog-box nil | ||
100 | use-file-dialog nil | ||
101 | use-short-answers t) | ||
102 | |||
103 | ;; Minibuffer | ||
104 | (setq-default completion-ignore-case t | ||
105 | read-buffer-completion-ignore-case t | ||
106 | read-file-name-completion-ignore-case t | ||
107 | completions-detailed t | ||
108 | enable-recursive-minibuffers t | ||
109 | file-name-shadow-properties '(invisible t intangible t) | ||
110 | minibuffer-eldef-shorten-default t | ||
111 | minibuffer-prompt-properties '( read-only t | ||
112 | cursor-intangible t | ||
113 | face minibuffer-prompt)) | ||
114 | (file-name-shadow-mode) | ||
115 | (minibuffer-electric-default-mode) | ||
116 | |||
117 | (require 'savehist) | ||
118 | (setq-default history-length 1024 | ||
119 | history-delete-duplicates t | ||
120 | ;; savehist-file (etc/ "savehist.el") | ||
121 | savehist-save-minibuffer-history t | ||
122 | savehist-autosave-interval 30) | ||
123 | (savehist-mode) | ||
124 | |||
125 | ;; Undo | ||
126 | (setq-default undo-limit (* 10 1024 1024)) | ||
127 | |||
128 | ;; Killing and yanking | ||
129 | (setq-default kill-do-not-save-duplicates t | ||
130 | kill-read-only-ok t | ||
131 | save-interprogram-paste-before-kill t | ||
132 | yank-pop-change-selection t) | ||
133 | (delete-selection-mode) | ||
134 | |||
135 | ;; Notifying the user | ||
136 | (setq-default echo-keystrokes 0.01 | ||
137 | ring-bell-function #'ignore) | ||
138 | |||
139 | ;; Point and mark | ||
140 | (setq-default set-mark-command-repeat-pop t) | ||
141 | |||
142 | ;; The system | ||
143 | (setq-default read-process-output-max (* 10 1024 1024)) | ||
144 | |||
145 | ;; Startup | ||
146 | (setq-default inhibit-startup-screen t | ||
147 | initial-buffer-choice t | ||
148 | initial-scratch-message nil) | ||
149 | |||
150 | ;; (menu-bar-mode -1) | ||
151 | (tool-bar-mode -1) | ||
152 | (tooltip-mode -1) | ||
153 | |||
154 | ;; Text editing | ||
155 | (setq-default fill-column 80 | ||
156 | sentence-end-double-space t | ||
157 | tab-width 8) | ||
158 | (global-so-long-mode) | ||
159 | |||
160 | (setq-default show-paren-delay 0.01 | ||
161 | show-paren-style 'parenthesis | ||
162 | show-paren-when-point-in-periphery t | ||
163 | show-paren-when-point-inside-paren t) | ||
164 | (show-paren-mode) | ||
165 | (electric-pair-mode) | ||
166 | |||
167 | ;; Encodings | ||
168 | (set-language-environment "UTF-8") | ||
169 | (setq-default buffer-file-coding-system 'utf-8-unix | ||
170 | coding-system-for-read 'utf-8-unix | ||
171 | coding-system-for-write 'utf-8-unix | ||
172 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
173 | locale-coding-system 'utf-8-unix) | ||
174 | (set-charset-priority 'unicode) | ||
175 | (prefer-coding-system 'utf-8-unix) | ||
176 | (set-default-coding-systems 'utf-8-unix) | ||
177 | (set-terminal-coding-system 'utf-8-unix) | ||
178 | (set-keyboard-coding-system 'utf-8-unix) | ||
179 | (pcase system-type | ||
180 | ((or 'ms-dos 'windows-nt) | ||
181 | (set-clipboard-coding-system 'utf-16-le) | ||
182 | (set-selection-coding-system 'utf-16-le)) | ||
183 | (_ | ||
184 | (set-selection-coding-system 'utf-8) | ||
185 | (set-clipboard-coding-system 'utf-8))) | ||
186 | |||
187 | ;; Abbrev | ||
188 | (setq-default abbrev-file-name (sync/ "abbrev.el") | ||
189 | save-abbrevs 'silently) | ||
190 | |||
191 | ;; Files | ||
192 | (setq-default auto-revert-verbose nil | ||
193 | global-auto-revert-non-file-buffers t | ||
194 | create-lockfiles nil | ||
195 | find-file-visit-truename t | ||
196 | mode-require-final-newline t | ||
197 | view-read-only t | ||
198 | save-silently t) | ||
199 | (global-auto-revert-mode) | ||
200 | |||
201 | (setq-default auto-save-default nil | ||
202 | auto-save-interval 1 | ||
203 | auto-save-no-message t | ||
204 | auto-save-timeout 1 | ||
205 | auto-save-visited-interval 1) | ||
206 | (add-to-list 'auto-save-file-name-transforms | ||
207 | `(".*" ,(etc/ "auto-save/" t) t)) | ||
208 | (auto-save-visited-mode) | ||
209 | |||
210 | (setq-default backup-by-copying t | ||
211 | version-control t | ||
212 | kept-new-versions 8 | ||
213 | kept-old-versions 8 | ||
214 | delete-old-versions t) | ||
215 | |||
216 | (require 'recentf) | ||
217 | (setq-default ;; recentf-save-file (etc/ "recentf" t) | ||
218 | recentf-max-menu-items 500 | ||
219 | recentf-max-saved-items nil ; Save the whole list | ||
220 | recentf-auto-cleanup 'mode) | ||
221 | (add-to-list 'recentf-exclude etc/) | ||
222 | (add-to-list 'recentf-exclude "-autoloads.el\\'") | ||
223 | (add-hook 'buffer-list-update-hook #'recentf-track-opened-file) | ||
224 | (recentf-mode) | ||
225 | |||
226 | (require 'saveplace) | ||
227 | (setq-default ;; save-place-file (etc/ "places.el") | ||
228 | save-place-forget-unreadable-files (eq system-type | ||
229 | 'gnu/linux)) | ||
230 | (save-place-mode) | ||
231 | |||
232 | (require 'uniquify) | ||
233 | (setq uniquify-after-kill-buffer-p t | ||
234 | uniquify-buffer-name-style 'forward | ||
235 | uniquify-ignore-buffers-re "^\\*" | ||
236 | uniquify-separator path-separator) | ||
237 | |||
238 | (setq-local vc-follow-symlinks t | ||
239 | vc-make-backup-files t) | ||
240 | |||
241 | ;; Native compilation | ||
242 | (setq-default native-comp-async-report-warnings-errors 'silent | ||
243 | native-comp-deferred-compilation t | ||
244 | native-compile-target-directory (etc/ "eln" t)) | ||
245 | (add-to-list 'native-comp-eln-load-path native-compile-target-directory) | ||
246 | (when (fboundp 'startup-redirect-eln-cache) | ||
247 | (startup-redirect-eln-cache native-compile-target-directory)) | ||
248 | |||
249 | ;; Custom file | ||
250 | (setq-default custom-file (sync/ "emacs/custom.el")) | ||
251 | (define-advice package--save-selected-packages (:around (orig &rest args) no-custom) | ||
252 | "Don't save `package-selected-packages' to `custom-file'." | ||
253 | (let ((custom-file null-device)) | ||
254 | (apply orig args))) | ||
255 | |||
256 | ;; Goto Address | ||
257 | (if (fboundp 'global-goto-address-mode) | ||
258 | (global-goto-address-mode) | ||
259 | (add-hook 'after-change-major-mode-hook #'goto-address-mode)) | ||
260 | |||
261 | ;; Winner | ||
262 | (winner-mode) | ||
263 | |||
264 | ;;; Keybindings | ||
265 | |||
266 | (defun other-window|switch-buffer (arg) | ||
267 | "Call `other-window' or `switch-buffer' depending on windows. | ||
268 | When called with prefix ARG, unconditionally switch buffer." | ||
269 | (interactive "P") | ||
270 | (if (or arg (one-window-p)) | ||
271 | (switch-to-buffer (other-buffer) nil t) | ||
272 | (other-window 1))) | ||
273 | |||
274 | (defun delete-window|bury-buffer () | ||
275 | "Delete the current window, or bury the current buffer. | ||
276 | If the current window is the only window, bury the buffer." | ||
277 | (interactive) | ||
278 | (condition-case e | ||
279 | (delete-window) | ||
280 | (t (bury-buffer)))) | ||
281 | |||
282 | (defun +cycle-spacing (&optional n) | ||
283 | ;; `cycle-spacing' is wildly different in 29.1 over 28. | ||
284 | "Negate N argument on `cycle-spacing'. | ||
285 | That is, with a positive N, deletes newlines as well, leaving -N | ||
286 | spaces. If N is negative, it will not delete newlines and leave | ||
287 | N spaces." | ||
288 | (interactive "*p") | ||
289 | (cycle-spacing (- n))) | ||
290 | |||
291 | (global-set-key [remap eval-expression] #'pp-eval-expression) | ||
292 | (global-set-key (kbd "M-o") #'other-window|switch-buffer) | ||
293 | (global-set-key (kbd "C-x 0") #'delete-window|bury-buffer) | ||
294 | (global-set-key (kbd "M-SPC") #'+cycle-spacing) | ||
295 | (global-set-key (kbd "C-x C-k") #'kill-this-buffer) | ||
296 | |||
297 | ;;; Hooks | ||
298 | |||
299 | (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p) | ||
300 | (add-hook 'find-file-not-found-functions | ||
301 | (defun create-missing-directories () | ||
302 | "Automatically create missing directories." | ||
303 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
304 | (unless (file-exists-p target-dir) | ||
305 | (make-directory target-dir :parents))))) | ||
306 | (add-hook 'find-file-hook | ||
307 | (defun vc-remote-off () | ||
308 | "Turn VC off when remote." | ||
309 | (when (file-remote-p (buffer-file-name)) | ||
310 | (setq-local vc-handled-backends nil)))) | ||
311 | |||
312 | ;;; Advice | ||
313 | |||
314 | (define-advice switch-to-buffer (:after (&rest _) normal-mode) | ||
315 | "Automatically determine the mode for non-file buffers." | ||
316 | (when-let ((_ (and (eq major-mode 'fundamental-mode))) | ||
317 | (buffer-file-name (buffer-name))) | ||
318 | (normal-mode))) | ||
319 | |||
320 | (define-advice canonically-space-region | ||
321 | (:around (orig &rest args) double-space-sentences) | ||
322 | "Always double-space sentences canonically." | ||
323 | (let ((sentence-end-double-space t)) | ||
324 | (apply orig args))) | ||
325 | |||
326 | ;; With region or ... | ||
327 | (defun advise-region-or-buffer (&rest _) | ||
328 | "`:before' advice to work on the active region or whole buffer. | ||
329 | See also `with-region-or-buffer'." | ||
330 | (interactive (if mark-active | ||
331 | (list (region-beginning) (region-end)) | ||
332 | (list (point-min) (point-max))))) | ||
333 | |||
334 | (defun advise-region-or-line (&rest _) | ||
335 | "`:before' advice to work on the active region or whole line. | ||
336 | See also `with-region-or-line'." | ||
337 | (interactive (if mark-active | ||
338 | (list (region-beginning) (region-end)) | ||
339 | (list (line-beginning-position) (line-end-position))))) | ||
340 | |||
341 | (defun advise-region-or-to-eol (&rest _) | ||
342 | "`:before' advice to work on the active region or to end of line. | ||
343 | See also `with-region-or-to-eol'." | ||
344 | (INTERACTIVE (if mark-active | ||
345 | (list (region-beginning) (region-end)) | ||
346 | (list (point) (line-end-position))))) | ||
347 | |||
348 | (defmacro with-region-or-buffer (&rest funcs) | ||
349 | "Advise FUNCS with `advise-region-or-buffer'." | ||
350 | `(progn | ||
351 | ,@(cl-loop for fn in funcs | ||
352 | collect | ||
353 | `(advice-add ',fn :before #'advise-region-or-buffer)))) | ||
354 | |||
355 | (defmacro with-region-or-line (&rest funcs) | ||
356 | "Advise FUNCS with `advise-region-or-line'." | ||
357 | `(progn | ||
358 | ,@(cl-loop for fn in funcs | ||
359 | collect | ||
360 | `(advice-add ',fn :before #'advise-region-or-line)))) | ||
361 | |||
362 | (defmacro with-region-or-to-eol (&rest funcs) | ||
363 | "Advise FUNCS with `advise-region-or-to-eol'." | ||
364 | `(progn | ||
365 | ,@(cl-loop for fn in funcs | ||
366 | collect | ||
367 | `(advice-add ',fn :before #'advise-region-or-to-eol)))) | ||
368 | |||
369 | (with-region-or-buffer indent-region) | ||
370 | |||
371 | ;;; Packages | ||
372 | |||
373 | (use-package _acdw | ||
374 | :load-path private/) | ||
375 | |||
376 | ;;; basics.el ends here | ||
diff --git a/early-init.el b/early-init.el index b841ea5..3dd74e0 100644 --- a/early-init.el +++ b/early-init.el | |||
@@ -1,50 +1,14 @@ | |||
1 | ;;; early-init.el --- Emacs early init -*- lexical-binding: t -*- | 1 | ;;; early-init.el -*- lexical-binding: t -*- |
2 | 2 | ||
3 | ;; by C. Duckworth <acdw@acdw.net> | 3 | ;; Bankruptcy: 9.4 |
4 | 4 | ||
5 | ;; Bankruptcy: 9.3 | 5 | ;; Debugging shit |
6 | 6 | (setq debug-on-error t | |
7 | ;;; Debugging --- delete this when done bankrupting | ||
8 | (setf debug-on-error t | ||
9 | use-package-verbose t) | 7 | use-package-verbose t) |
10 | 8 | ||
11 | ;;; Speedy startup | 9 | ;; Frames |
12 | 10 | (setq default-frame-alist '((tool-bar-lines . 0) | |
13 | (defvar +emacs--startup-restore-alist nil | 11 | ;; (menu-bar-lines . 0) |
14 | "Variables to restore after startup.") | ||
15 | |||
16 | (defun +emacs-startup@restore-variables () | ||
17 | "Restore variables set temporarily during startup." | ||
18 | (dolist (v +emacs--startup-restore-alist) | ||
19 | (set-default (car v) (cdr v)))) | ||
20 | (add-hook 'after-init-hook #'+emacs-startup@restore-variables) | ||
21 | |||
22 | (defun +set-during-startup (variable value &optional restore) | ||
23 | "Set VARIABLE to VALUE during startup. | ||
24 | If RESTORE is non-nil, restore the variable's value to it. | ||
25 | Otherwise, save its original value and restore to that." | ||
26 | (unless after-init-time | ||
27 | (setf (alist-get variable +emacs--startup-restore-alist) | ||
28 | (or restore (symbol-value variable))) | ||
29 | (set-default variable value))) | ||
30 | |||
31 | (+set-during-startup 'gc-cons-threshold most-positive-fixnum) | ||
32 | |||
33 | ;;; Distraction-free startup | ||
34 | |||
35 | (unless debug-on-error | ||
36 | (+set-during-startup 'inhibit-redisplay t) | ||
37 | (+set-during-startup 'inhibit-message t)) | ||
38 | |||
39 | (setf warning-minimum-level :emergency) | ||
40 | (add-hook 'emacs-startup-hook | ||
41 | (defun +message-about-warnings () | ||
42 | (when-let ((warnings (get-buffer "*Warnings*"))) | ||
43 | (message "%s. %s." "There were init-time warnings" | ||
44 | "See the `*Warnings*' buffer.")))) | ||
45 | |||
46 | (setf default-frame-alist '((tool-bar-lines . 0) | ||
47 | (menu-bar-lines . 0) | ||
48 | (vertical-scroll-bars . nil) | 12 | (vertical-scroll-bars . nil) |
49 | (horizontal-scroll-bars . nil)) | 13 | (horizontal-scroll-bars . nil)) |
50 | frame-inhibit-implied-resize t | 14 | frame-inhibit-implied-resize t |
@@ -54,42 +18,28 @@ Otherwise, save its original value and restore to that." | |||
54 | indicate-empty-lines nil | 18 | indicate-empty-lines nil |
55 | indicate-buffer-boundaries nil) | 19 | indicate-buffer-boundaries nil) |
56 | 20 | ||
57 | ;;; Packages | 21 | ;; Packages |
58 | |||
59 | (require 'package) | 22 | (require 'package) |
60 | 23 | (add-to-list 'package-archives | |
61 | (dolist (archive | 24 | '("melpa" . "https://melpa.org/packages/") |
62 | '(("gnu-devel" . "https://elpa.gnu.org/devel/") | 25 | :append) |
63 | ("nongnu-devel" . "https://elpa.gnu.org/nongnu-devel/") | 26 | (setq package-priorities '(("melpa" . 2) |
64 | ("melpa" . "https://melpa.org/packages/"))) | 27 | ("nongnu" . 1) |
65 | (add-to-list 'package-archives archive :append)) | 28 | ("gnu" . 0))) |
66 | |||
67 | (setf package-archive-priorities | ||
68 | '(("gnu-devel" . 2) | ||
69 | ("nongnu-devel" . 1) | ||
70 | ("melpa" . 0) | ||
71 | ("gnu" . 0) | ||
72 | ("nongnu" . 0))) | ||
73 | |||
74 | (package-initialize) | 29 | (package-initialize) |
75 | |||
76 | (unless package-archive-contents | 30 | (unless package-archive-contents |
77 | (package-refresh-contents)) | 31 | (package-refresh-contents)) |
78 | 32 | ||
79 | ;; https://melpa.org/packages/archive-contents | 33 | (setq use-package-enable-imenu-support t |
80 | |||
81 | ;;; Use-package | ||
82 | |||
83 | (setf use-package-enable-imenu-support t | ||
84 | use-package-hook-name-suffix nil) | 34 | use-package-hook-name-suffix nil) |
85 | 35 | ||
86 | (require 'use-package) | 36 | (require 'use-package) |
87 | 37 | (setq use-package-compute-statistics debug-on-error) | |
88 | (setf use-package-compute-statistics debug-on-error) | ||
89 | 38 | ||
90 | (use-package use-package-vc | 39 | (use-package use-package-vc |
91 | :load-path "~/src/emacs/use-package-vc.el" | 40 | :load-path "~/src/emacs/use-package-vc.el/" |
92 | :config | 41 | :config |
93 | (define-advice package-vc-install (:around (orig &rest args) wtf) | 42 | (define-advice package-vc-install (:around (orig &rest args) wtf) |
43 | "Don't freak out about `package-archives' shit." | ||
94 | (let ((package-archives nil)) | 44 | (let ((package-archives nil)) |
95 | (apply orig args)))) | 45 | (apply orig args)))) |
diff --git a/init.el b/init.el index 0ef669f..369641c 100644 --- a/init.el +++ b/init.el | |||
@@ -1,932 +1,7 @@ | |||
1 | ;;; init.el --- a config of one's own -*- lexical-binding: t; -*- | 1 | ;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*- |
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | ;; Bankruptcy: 9.3 | ||
4 | 2 | ||
5 | ;;; Code: | 3 | ;; Bankruptcy: 9.4 |
6 | |||
7 | ;;; My extras | ||
8 | |||
9 | (push (expand-file-name (locate-user-emacs-file "lisp")) load-path) | ||
10 | (require 'acdw) ; Omnibus fun stuff | ||
11 | |||
12 | ;;; Remove when done bankrupting | ||
13 | |||
14 | (defkeys t "C-x C-c" #'restart-emacs) | ||
15 | |||
16 | ;;; Basic defaults | ||
17 | |||
18 | (use-package no-littering | ||
19 | :ensure t :demand t | ||
20 | :preface | ||
21 | (setq no-littering-etc-directory etc/ | ||
22 | no-littering-var-directory var/) | ||
23 | :custom | ||
24 | (auto-save-file-name-transforms `(("." ,(var/ "auto-save/") t))) | ||
25 | (auto-save-list-file-prefix (var/ "auto-save/.saves-" t)) | ||
26 | (backup-directory-alist `(("." . ,(var/ "backup/" t))))) | ||
27 | |||
28 | (use-package custom-allowed | ||
29 | :load-path "~/src/emacs/custom-allowed/" | ||
30 | :custom | ||
31 | (custom-file (private/ "custom.el")) | ||
32 | :config | ||
33 | (dolist (var '(safe-local-variable-values | ||
34 | warning-suppress-types | ||
35 | ispell-buffer-session-localwords | ||
36 | calendar-latitude | ||
37 | calendar-longitude | ||
38 | user-full-name | ||
39 | user-mail-address)) | ||
40 | (add-to-list 'custom-allowed-variables var)) | ||
41 | :hook | ||
42 | (after-init-hook . custom-allowed-load-custom-file)) | ||
43 | |||
44 | (use-package modus-themes | ||
45 | :load-path "~/usr/share/emacs/30.0.50/etc/themes/" | ||
46 | :custom | ||
47 | (modus-themes-bold-constructs t) | ||
48 | (modus-themes-italic-constructs t) | ||
49 | (modus-themes-variable-pitch-ui nil)) | ||
50 | |||
51 | (use-package dawn | ||
52 | :load-path "~/src/emacs/dawn/" | ||
53 | :after modus-themes | ||
54 | :config | ||
55 | (load-theme 'modus-operandi :noconfirm :noenable) | ||
56 | (load-theme 'modus-vivendi :noconfirm :noenable) | ||
57 | (defhook custom-allowed-after-load-hook | ||
58 | (dawn-schedule-themes 'modus-operandi | ||
59 | 'modus-vivendi) | ||
60 | (set-face-attribute 'default nil | ||
61 | :family "IBM Plex Mono" | ||
62 | :height 100) | ||
63 | (set-face-attribute 'variable-pitch nil | ||
64 | :family "Georgia" | ||
65 | :height 1.2))) | ||
66 | |||
67 | (use-package midnight | ||
68 | :config | ||
69 | (add-hook 'midnight-mode-hook #'recentf-cleanup) | ||
70 | (midnight-mode)) | ||
71 | |||
72 | (use-package sophomore | ||
73 | :load-path "~/src/emacs/sophomore/" | ||
74 | :config | ||
75 | (sophomore-enable-all) | ||
76 | (sophomore-disable 'view-hello-file | ||
77 | 'describe-gnu-project | ||
78 | 'suspend-frame) | ||
79 | (sophomore-mode)) | ||
80 | |||
81 | ;;; Completions | ||
82 | |||
83 | (use-package vertico | ||
84 | :ensure t :demand t | ||
85 | :custom | ||
86 | (resize-mini-windows 'grow-only) | ||
87 | (vertico-cycle t) | ||
88 | :config | ||
89 | (use-package vertico-directory | ||
90 | :after vertico | ||
91 | :hook (rfn-eshadow-update-overlay-hook . vertico-directory-tidy)) | ||
92 | (vertico-mode)) | ||
93 | |||
94 | (use-package marginalia | ||
95 | :ensure t :demand t | ||
96 | :config | ||
97 | (add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode) | ||
98 | (marginalia-mode)) | ||
99 | |||
100 | (use-package orderless | ||
101 | :ensure t :demand t | ||
102 | :config | ||
103 | (setc completion-styles '(orderless basic) | ||
104 | completion-category-overrides | ||
105 | '((file (styles basic partial-completion))))) | ||
106 | |||
107 | (use-package consult | ||
108 | :ensure t | ||
109 | :custom | ||
110 | (register-preview-delay 0.01) | ||
111 | (register-preview-function #'consult-register-format) | ||
112 | (xref-show-xrefs-function #'consult-xref) | ||
113 | (tab-always-indent 'complete) | ||
114 | (completion-in-region-function #'consult-completion-in-region) | ||
115 | (consult-narrow-key "<") | ||
116 | (consult--regexp-compiler #'consult--default-regexp-compiler) | ||
117 | :config | ||
118 | (advice-add #'register-preview :override #'consult-register-window) | ||
119 | (define-advice completing-read-multiple (:filter-args (args) indicator) | ||
120 | (cons (format "[CRM%s] %s" | ||
121 | (replace-regexp-in-string | ||
122 | "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" | ||
123 | crm-separator) | ||
124 | (car args)) | ||
125 | (cdr args))) | ||
126 | :bind | ||
127 | (([remap switch-to-buffer] . consult-buffer) | ||
128 | ([remap switch-to-buffer-other-window] . consult-buffer-other-window) | ||
129 | ([remap switch-to-buffer-other-frame] . consult-buffer-other-frame) | ||
130 | ([remap yank-pop] . consult-yank-pop) | ||
131 | ("M-g g" . consult-goto-line) | ||
132 | ("M-g M-g" . consult-goto-line) | ||
133 | ("M-g i" . consult-imenu) | ||
134 | ("M-g M-i" . consult-imenu) | ||
135 | ("M-s l" . consult-line) | ||
136 | ("M-s f" . consult-find) | ||
137 | ("M-s M-f" . consult-find) | ||
138 | ("M-s g" . consult-grep) | ||
139 | ("M-s M-g" . consult-grep))) | ||
140 | |||
141 | ;;; General enhancements | ||
142 | |||
143 | (use-package embark | ||
144 | :ensure t | ||
145 | :custom | ||
146 | (prefix-help-command #'embark-prefix-help-command) | ||
147 | :bind | ||
148 | (("C-." . embark-act) | ||
149 | ("M-." . embark-dwim) | ||
150 | ("C-h b" . embark-bindings)) | ||
151 | :custom | ||
152 | (add-to-list 'display-buffer-alist | ||
153 | '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" | ||
154 | nil | ||
155 | (window-parameters (mode-line-format . none))))) | ||
156 | |||
157 | (use-package embark-consult | ||
158 | :ensure t :demand t | ||
159 | :after (embark consult) | ||
160 | :hook (embark-collect-mode-hook . consult-preview-at-point-mode)) | ||
161 | |||
162 | (use-package undo-fu-session | ||
163 | :ensure t | ||
164 | :custom | ||
165 | (undo-fu-session-directory (etc/ "undo/" t)) | ||
166 | (undo-fu-session-incompatible-files | ||
167 | '("/COMMIT_EDITMSG\\'" | ||
168 | "/git-rebase-todo\\'")) | ||
169 | (undo-fu-session-compression | ||
170 | (cl-loop for (exe . sym) in '(("gzip" . gz) | ||
171 | ("bzip2" . bz2) | ||
172 | ("xz" . xz)) | ||
173 | if (executable-find exe) | ||
174 | return sym)) | ||
175 | :config | ||
176 | (global-undo-fu-session-mode)) | ||
177 | |||
178 | (use-package ws-butler | ||
179 | :ensure t | ||
180 | :custom | ||
181 | (ws-butler-trim-predicate (lambda (begin end) | ||
182 | (not (eq 'font-lock-string-face | ||
183 | (get-text-property end 'face))))) | ||
184 | :config | ||
185 | (ws-butler-global-mode)) | ||
186 | |||
187 | (use-package minions | ||
188 | :ensure t | ||
189 | :config | ||
190 | (minions-mode)) | ||
191 | |||
192 | (use-package mode-line-bell | ||
193 | :vc ( :url "https://github.com/duckwork/mode-line-bell" | ||
194 | :rev "remap-face") | ||
195 | :custom | ||
196 | (mode-line-bell-flash-time 0.25) | ||
197 | :config | ||
198 | (mode-line-bell-mode)) | ||
199 | |||
200 | (use-package electric-cursor | ||
201 | :load-path "~/src/emacs/electric-cursor/" | ||
202 | :custom | ||
203 | (electric-cursor-alist '((overwrite-mode . box) | ||
204 | (t . bar))) | ||
205 | (electric-cursor-mode)) | ||
206 | |||
207 | (use-package visual-fill-column | ||
208 | :ensure t | ||
209 | :custom | ||
210 | (visual-fill-column-center-text t) | ||
211 | :hook ((visual-fill-column-mode-hook . visual-line-mode) | ||
212 | (eww-mode-hook . visual-fill-column-mode)) | ||
213 | :config | ||
214 | (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) | ||
215 | |||
216 | (use-package cape | ||
217 | :ensure t :demand t | ||
218 | :init | ||
219 | (dolist (fn '(cape-file cape-dabbrev)) | ||
220 | (add-hook 'completion-at-point-functions fn 90)) | ||
221 | :config | ||
222 | (require '+cape) | ||
223 | (advice-add 'emacs-completion-at-point :around #'cape-wrap-nonexclusive) | ||
224 | (+cape-insinuate text-mode-hook ( cape-dict cape-ispell | ||
225 | cape-file cape-dabbrev))) | ||
226 | |||
227 | (use-package wgrep | ||
228 | :ensure t | ||
229 | :custom | ||
230 | (wgrep-enable-key (kbd "C-x C-q")) | ||
231 | :bind (:map grep-mode-map | ||
232 | ("C-x C-q" . wgrep-change-to-wgrep-mode))) | ||
233 | |||
234 | (use-package mlscroll | ||
235 | :ensure t :defer 1 | ||
236 | :preface | ||
237 | (defhook modus-themes-after-load-theme-hook | ||
238 | :name modus-themes-load@mlscroll | ||
239 | (mlscroll-mode -1) | ||
240 | (when | ||
241 | (or | ||
242 | (memq 'modus-vivendi custom-enabled-themes) | ||
243 | (memq 'modus-operandi custom-enabled-themes)) | ||
244 | (modus-themes-with-colors | ||
245 | (setf mlscroll-in-color fg-dim mlscroll-out-color bg-inactive))) | ||
246 | (eval-after 1 | ||
247 | (mlscroll-mode 1))) | ||
248 | :init | ||
249 | (when (daemonp) | ||
250 | (add-hook 'server-after-make-frame #'modus-themes-load@mlscroll)) | ||
251 | :config (modus-themes-load@mlscroll)) | ||
252 | |||
253 | (use-package avy | ||
254 | :ensure t :demand t | ||
255 | :custom | ||
256 | (avy-background t) | ||
257 | (avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")) | ||
258 | :bind (("M-j" . avy-goto-char-timer) | ||
259 | :map isearch-mode-map | ||
260 | ("M-j" . avy-isearch))) | ||
261 | |||
262 | (use-package zzz-to-char | ||
263 | :ensure t | ||
264 | :bind (("M-z" . zzz-to-char))) | ||
265 | |||
266 | ;;; Searching | ||
267 | |||
268 | (use-package isearch-mb | ||
269 | :ensure t | ||
270 | :custom | ||
271 | (isearch-lazy-count t) | ||
272 | (isearch-regexp-lax-whitespace t) | ||
273 | ;; Space matches whitespace, newlines, punctuation | ||
274 | (search-whitespace-regexp "\\W+") | ||
275 | (search-default-mode t "Search using regexp by default.") | ||
276 | ;; Space matches any sequence of characters in a line | ||
277 | ;; search-whitespace-regexp ".*?" | ||
278 | (isearch-wrap-pause 'no) | ||
279 | :config | ||
280 | (require '+isearch) | ||
281 | (advice-add 'isearch-cancel :before | ||
282 | #'+isearch-cancel@add-search-to-history) | ||
283 | (advice-add 'perform-replace :around | ||
284 | #'+perform-replace-dont-exit-on-anykey) | ||
285 | (eval-after (isearch-mb consult) | ||
286 | (add-to-list 'isearch-mb--after-exit #'consult-line) | ||
287 | (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history) | ||
288 | (defkeys isearch-mb-minibuffer-map | ||
289 | "M-s l" #'consult-line | ||
290 | "M-r" #'consult-isearch-history)) | ||
291 | (eval-after (isearch-mb anzu) | ||
292 | (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace) | ||
293 | (defkeys isearch-mb-minibuffer-map | ||
294 | "M-%" #'anzu-isearch-query-replace-regexp | ||
295 | "C-M-%" #'anzu-isearch-query-replace)) | ||
296 | (isearch-mb-mode)) | ||
297 | |||
298 | (use-package anzu | ||
299 | :ensure t | ||
300 | :bind | ||
301 | (("M-%" . anzu-query-replace-regexp) | ||
302 | ("C-M-%" . anzu-query-replace))) | ||
303 | |||
304 | (use-package frowny | ||
305 | :load-path "~/src/emacs/frowny/" | ||
306 | :config | ||
307 | (global-frowny-mode)) | ||
308 | |||
309 | (use-package transpose-frame | ||
310 | :ensure t | ||
311 | :bind | ||
312 | (("C-x 5 t" . transpose-frame))) | ||
313 | |||
314 | ;;; Text editing | ||
315 | |||
316 | (use-package org | ||
317 | :defer t | ||
318 | :after derived | ||
319 | :init | ||
320 | (require 'init-org) | ||
321 | (require '_work)) | ||
322 | |||
323 | (use-package ispell | ||
324 | :custom | ||
325 | (ispell-program-name (choose-executable "ispell" "aspell")) | ||
326 | :config | ||
327 | (require '+ispell) | ||
328 | (add-hook 'before-save-hook | ||
329 | #'+ispell-move-buffer-words-to-dir-locals-hook) | ||
330 | (put 'ispell-buffer-session-localwords 'safe-local-variable | ||
331 | #'+ispell-safe-local-p)) | ||
332 | |||
333 | (use-package flyspell | ||
334 | :hook org-mode-hook) | ||
335 | |||
336 | (use-package flyspell-correct | ||
337 | :ensure t | ||
338 | :after flyspell | ||
339 | :custom | ||
340 | (flyspell-correct--cr-key ";") | ||
341 | :bind | ||
342 | (:map flyspell-mode-map | ||
343 | (("C-;" . flyspell-correct-wrapper) | ||
344 | ("<f7>" . +flyspell-correct-buffer))) | ||
345 | :config | ||
346 | (require '+flyspell-correct) | ||
347 | (defkeys flyspell-mode-map | ||
348 | "C-," nil | ||
349 | "C-." nil)) | ||
350 | 4 | ||
351 | (use-package text-mode | 5 | ;;; Code: |
352 | :config | ||
353 | (defhook text-mode-hook | ||
354 | #'abbrev-mode)) | ||
355 | |||
356 | (use-package filldent | ||
357 | :load-path "~/src/emacs/filldent/" | ||
358 | :bind | ||
359 | ("M-q" . filldent-dwim)) | ||
360 | |||
361 | (use-package scule | ||
362 | :load-path "~/src/emacs/scule/" | ||
363 | :config | ||
364 | (defkeys t | ||
365 | "M-c" (defmap scule-map | ||
366 | "Keymap for twiddling scules." | ||
367 | "M-u" #'scule-upcase | ||
368 | "M-l" #'scule-downcase | ||
369 | "M-c" #'scule-capitalize))) | ||
370 | |||
371 | (use-package titlecase | ||
372 | :load-path "~/src/emacs/titlecase.el/" | ||
373 | :after org | ||
374 | :bind (:map scule-map | ||
375 | ("M-t" . titlecase-dwim)) | ||
376 | :config | ||
377 | (require '+titlecase)) | ||
378 | |||
379 | ;;; Programming | ||
380 | |||
381 | (use-package prog-mode | ||
382 | :config | ||
383 | (defhook prog-mode-hook | ||
384 | #'auto-fill-mode | ||
385 | ;; Use `indent-tabs-mode' unless one of the following modes | ||
386 | (indent-tabs-mode (if (derived-mode-p 'emacs-lisp-mode | ||
387 | 'python-mode | ||
388 | 'haskell-mode) | ||
389 | -1 1)))) | ||
390 | |||
391 | (use-package paredit | ||
392 | :ensure t | ||
393 | :preface | ||
394 | (defun +paredit-newline () | ||
395 | (interactive) | ||
396 | (call-interactively | ||
397 | (if (derived-mode-p 'lisp-interaction-mode) | ||
398 | #'eval-print-last-sexp | ||
399 | #'paredit-newline))) | ||
400 | :hook ((emacs-lisp-mode-hook | ||
401 | eval-expression-minibuffer-setup-hook | ||
402 | ielm-mode-hook lisp-interaction-mode-hook | ||
403 | lisp-mode-hook scheme-mode-hook | ||
404 | fennel-repl-mode-hook fennel-mode-hook | ||
405 | geiser-mode-hook geiser-repl-mode-hook | ||
406 | ielm-mode-hook) | ||
407 | . enable-paredit-mode) | ||
408 | :bind | ||
409 | (("C-j" . +paredit-newline)) | ||
410 | :config | ||
411 | (defkeys paredit-mode-map | ||
412 | "RET" nil | ||
413 | "M-s" nil) | ||
414 | (require '+paredit) | ||
415 | (add-to-list 'paredit-space-for-delimiter-predicates | ||
416 | #'+paredit-space-for-delimiter) | ||
417 | (eval-after (paredit eldoc) | ||
418 | (eldoc-add-command #'paredit-backward-delete #'paredit-close-round))) | ||
419 | |||
420 | (use-package hungry-delete | ||
421 | :ensure t | ||
422 | :custom | ||
423 | (hungry-delete-chars-to-skip " \t") | ||
424 | (hungry-delete-join-reluctantly nil) | ||
425 | :config | ||
426 | (dolist (m '(eshell-mode | ||
427 | nim-mode | ||
428 | python-mode)) | ||
429 | (add-to-list 'hungry-delete-except-modes m)) | ||
430 | (require '+hungry-delete) | ||
431 | (eval-after paredit | ||
432 | (defkeys paredit-mode-map | ||
433 | [remap paredit-backward-delete] | ||
434 | (+hungry-delete-define-alternative | ||
435 | paredit-backward-delete hungry-delete-backward) | ||
436 | [remap paredit-forward-delete] | ||
437 | (+hungry-delete-define-alternative | ||
438 | paredit-forward-delete hungry-delete-forward))) | ||
439 | (global-hungry-delete-mode)) | ||
440 | |||
441 | (use-package ediff | ||
442 | :custom | ||
443 | (ediff-keep-variants nil) | ||
444 | (ediff-split-window-function #'split-window-horizontally) | ||
445 | (ediff-window-setup-function #'ediff-setup-windows-plain)) | ||
446 | |||
447 | ;;; Lisps | ||
448 | |||
449 | (use-package elisp-mode | ||
450 | :custom | ||
451 | (eval-expression-print-length nil) | ||
452 | (eval-expression-print-level nil) | ||
453 | :preface | ||
454 | (defun elisp-eval-region|eval-buffer () | ||
455 | (interactive) | ||
456 | (if (region-active-p) | ||
457 | (let ((start (region-beginning)) | ||
458 | (end (region-end))) | ||
459 | (eval-region start end) | ||
460 | (message "Region from %s to %s evaluated." | ||
461 | start end)) | ||
462 | (eval-buffer) | ||
463 | (message "Buffer `%s' evaluated." (buffer-name)))) | ||
464 | (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) | ||
465 | "C-c C-c" #'eval-defun | ||
466 | "C-c C-k" #'elisp-eval-region|eval-buffer | ||
467 | "C-c C-z" #'ielm) | ||
468 | :config | ||
469 | (define-advice eval-region (:around (orig start end &rest args) pulse) | ||
470 | (apply orig start end args) | ||
471 | (pulse-momentary-highlight-region start end)) | ||
472 | (defhook emacs-lisp-mode-hook | ||
473 | (setq-local page-delimiter "^\\(\\|;;;+\\).*"))) | ||
474 | |||
475 | (use-package macrostep | ||
476 | :ensure t | ||
477 | :after elisp-mode | ||
478 | :bind ( :map emacs-lisp-mode-map | ||
479 | ("C-c e" . macrostep-expand) | ||
480 | :map lisp-interaction-mode-map | ||
481 | ("C-c e" . macrostep-expand))) | ||
482 | |||
483 | (use-package eros | ||
484 | :ensure t | ||
485 | :after elisp-mode | ||
486 | :custom (eros-eval-result-prefix "; ") | ||
487 | :hook emacs-lisp-mode-hook) | ||
488 | |||
489 | (use-package package-lint | ||
490 | :ensure t) | ||
491 | |||
492 | (use-package sly | ||
493 | :ensure t | ||
494 | :when (executable-find "sbcl") | ||
495 | :custom | ||
496 | (inferior-lisp-program (executable-find "sbcl")) | ||
497 | (sly-net-coding-system 'utf-8-unix) | ||
498 | :bind (:map sly-mode-map | ||
499 | (("C-c C-z" . sly-mrepl))) | ||
500 | :config | ||
501 | (sly-symbol-completion-mode -1)) | ||
502 | |||
503 | (use-package edebug | ||
504 | :preface | ||
505 | (defun turn-off-eldoc-mode () | ||
506 | (eldoc-mode -1)) | ||
507 | :config | ||
508 | (add-hook 'edebug-mode-hook #'turn-off-eldoc-mode)) | ||
509 | |||
510 | ;;; Web languages | ||
511 | |||
512 | (use-package web-mode | ||
513 | :ensure t | ||
514 | :mode ("\\.phtml\\'" | ||
515 | "\\.tpl\\.php\\'" | ||
516 | "\\.[agj]sp\\'" | ||
517 | "\\.as[cp]x\\'" | ||
518 | "\\.erb\\'" | ||
519 | "\\.mustache\\'" | ||
520 | "\\.djhtml\\'" | ||
521 | "\\.html?\\'")) | ||
522 | |||
523 | ;;; Applications | ||
524 | |||
525 | (use-package dired | ||
526 | :init (require 'dired-x) | ||
527 | :custom | ||
528 | (dired-recursive-copies 'always) | ||
529 | (dired-recursive-deletes 'always) | ||
530 | (dired-create-destination-dirs 'always) | ||
531 | (dired-do-revert-buffer t) | ||
532 | (dired-hide-details-hide-symlink-targets nil) | ||
533 | (dired-isearch-filenames 'dwim) | ||
534 | (delete-by-moving-to-trash t) | ||
535 | (dired-auto-revert-buffer t) | ||
536 | (dired-listing-switches "-AlF") | ||
537 | (ls-lisp-dirs-first t) | ||
538 | (dired-ls-F-marks-symlinks t) | ||
539 | (dired-clean-confirm-killing-deleted-buffers nil) | ||
540 | (dired-no-confirm '(byte-compile | ||
541 | load chgrp chmod chown | ||
542 | copy move hardlink symlink | ||
543 | shell touch)) | ||
544 | (dired-dwim-target t) | ||
545 | :bind | ||
546 | (("C-x C-j" . dired-jump) | ||
547 | ([remap list-directory] . dired) | ||
548 | :map dired-mode-map | ||
549 | ("C-j" . dired-up-directory) | ||
550 | ("<backspace>" . dired-up-directory)) | ||
551 | :init | ||
552 | (defhook dired-mode-hook | ||
553 | #'dired-hide-details-mode | ||
554 | #'hl-line-mode | ||
555 | #'truncate-lines-local-mode)) | ||
556 | |||
557 | (use-package dired-subtree | ||
558 | :ensure t | ||
559 | :after dired | ||
560 | :bind (:map dired-mode-map | ||
561 | (("TAB" . dired-subtree-cycle) | ||
562 | ("i" . dired-subtree-toggle)))) | ||
563 | |||
564 | (use-package dired-collapse | ||
565 | :ensure t | ||
566 | :hook dired-mode-hook) | ||
567 | |||
568 | (use-package dired-hide-dotfiles | ||
569 | :ensure t | ||
570 | :bind (:map dired-mode-map | ||
571 | ("." . dired-hide-dotfiles-mode))) | ||
572 | |||
573 | (use-package magit | ||
574 | :ensure t | ||
575 | :bind | ||
576 | ("C-x g" . magit)) | ||
577 | |||
578 | (use-package auth-source | ||
579 | :custom | ||
580 | (auth-sources '(default "secrets:passwords")) | ||
581 | :config | ||
582 | (defhook authinfo-mode-hook | ||
583 | #'truncate-lines-local-mode)) | ||
584 | |||
585 | (use-package keychain-environment | ||
586 | :ensure t | ||
587 | :when (executable-find "keychain") | ||
588 | :hook (after-init-hook . keychain-refresh-environment)) | ||
589 | |||
590 | (use-package keepassxc-shim | ||
591 | :load-path "~/src/emacs/keepassxc-shim/" | ||
592 | :config | ||
593 | (keepassxc-shim-activate)) | ||
594 | |||
595 | (use-package eat | ||
596 | :ensure t | ||
597 | :commands eat-eshell-mode | ||
598 | :hook (eshell-load-hook . eat-eshell-mode)) | ||
599 | |||
600 | (use-package dictionary | ||
601 | :custom | ||
602 | (dictionary-server (if (or (executable-find "dictd") | ||
603 | (file-exists-p "/usr/sbin/dictd")) ; debian | ||
604 | "localhost" | ||
605 | "dict.org")) | ||
606 | :bind | ||
607 | (("C-c d" . dictionary-search))) | ||
608 | |||
609 | (use-package pdf-tools | ||
610 | :ensure t | ||
611 | :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode) | ||
612 | :magic ("%PDF" . pdf-view-mode) | ||
613 | :config | ||
614 | (pdf-tools-install)) | ||
615 | |||
616 | |||
617 | |||
618 | (use-package bbdb | ||
619 | :ensure t | ||
620 | :custom | ||
621 | (bbdb-complete-mail-allow-cycling t) | ||
622 | (bbdb-file (private/ "bbdb")) | ||
623 | :init | ||
624 | (defhook custom-allowed-after-load-hook | ||
625 | :name bbdb@after-custom | ||
626 | (require 'bbdb) | ||
627 | (require 'bbdb-message) | ||
628 | (bbdb-initialize 'message))) | ||
629 | |||
630 | (use-package bbdb-vcard | ||
631 | :ensure t) | ||
632 | |||
633 | (use-package notmuch | ||
634 | :load-path "~/usr/share/emacs/site-lisp/" | ||
635 | :preface | ||
636 | (defdir notmuch/ (sync/ "emacs/notmuch")) | ||
637 | :init | ||
638 | (use-package +notmuch | ||
639 | :after notmuch | ||
640 | :load-path "lisp/" | ||
641 | :bind (("C-c n" . +notmuch-goto) | ||
642 | :map notmuch-search-mode-map | ||
643 | ("!" . +notmuch-search-mark-spam) | ||
644 | :map notmuch-tree-mode-map | ||
645 | ("!" . +notmuch-search-mark-spam-then-next) | ||
646 | ("M-<" . +notmuch-tree-beginning) | ||
647 | ("M->" . +notmuch-tree-end)) | ||
648 | :hook (message-send-hook . +send-mail-dispatch) | ||
649 | :config | ||
650 | ;; Saved searches | ||
651 | (+notmuch-make-saved-search "inbox+unread" "m" 'tree "tag:inbox" "tag:unread" "NOT tag:Spam") | ||
652 | (+notmuch-make-saved-search "inbox" "i" 'tree "tag:inbox" "NOT tag:Spam") | ||
653 | (+notmuch-make-saved-search "lists+unread" "l" 'tree "tag:/List/" "tag:unread") | ||
654 | (+notmuch-make-saved-search "lists" "L" 'tree "tag:/List/") | ||
655 | (+notmuch-make-saved-search "unread" "u" 'tree "tag:unread" "NOT tag:Spam") | ||
656 | (+notmuch-make-saved-search "flagged" "f" 'tree "tag:flagged") | ||
657 | (+notmuch-make-saved-search "sent" "t" 'tree "tag:sent") | ||
658 | (+notmuch-make-saved-search "drafts" "d" 'tree "tag:draft") | ||
659 | (+notmuch-make-saved-search "all mail" "a" 'tree "*")) | ||
660 | (use-package message | ||
661 | :after notmuch | ||
662 | :hook (message-setup-hook . message-signature-setup) | ||
663 | :config (require '+message)) | ||
664 | (defhook (notmuch-show-mode-hook notmuch-message-mode-hook) | ||
665 | #'visual-fill-column-mode) | ||
666 | :custom | ||
667 | (notmuch-init-file (notmuch/ "notmuch-init.el" t)) | ||
668 | (notmuch-address-save-filename (notmuch/ "addresses" t)) | ||
669 | (notmuch-address-use-company (featurep 'company)) | ||
670 | (notmuch-search-oldest-first nil) | ||
671 | (notmuch-archive-tags '("-inbox" "-unread")) | ||
672 | (notmuch-draft-tags '("+draft" "-inbox" "-unread")) | ||
673 | (mail-user-agent 'notmuch-user-agent) | ||
674 | (bbdb-mail-user-agent 'notmuch-user-agent) | ||
675 | (message-mail-user-agent t) | ||
676 | (notmuch-show-indent-content nil) | ||
677 | (message-kill-buffer-on-exit t) | ||
678 | (message-auto-save-directory nil) | ||
679 | (send-mail-function #'sendmail-send-it) | ||
680 | (mail-specify-envelope-from t) | ||
681 | (message-sendmail-envelope-from 'header) | ||
682 | (message-envelope-from 'header) | ||
683 | (notmuch-saved-searches nil) | ||
684 | :bind | ||
685 | (("C-c m" . notmuch-mua-new-mail) | ||
686 | :map notmuch-search-mode-map | ||
687 | ("RET" . notmuch-search-show-thread) | ||
688 | ("M-RET" . notmuch-tree-from-search-thread)) | ||
689 | :config | ||
690 | (load notmuch-init-file :noerror) | ||
691 | (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) | ||
692 | ;; Mailing lists | ||
693 | (add-to-list 'notmuch-message-headers "List-Post" :append) | ||
694 | (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) | ||
695 | "Make `notmuch-mua-new-reply' list-aware." | ||
696 | (let ((ml (notmuch-show-get-header :List-Post))) | ||
697 | (apply orig r) | ||
698 | (when ml | ||
699 | (with-buffer-modified-unmodified | ||
700 | (message-remove-header "To") | ||
701 | (message-add-header | ||
702 | (format "To: %s" | ||
703 | (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml))) | ||
704 | (message-goto-body)))))) | ||
705 | |||
706 | ;;; The INTERNET | ||
707 | |||
708 | (use-package link-hint | ||
709 | :ensure t :demand t | ||
710 | :preface | ||
711 | (global-set-key (kbd "M-l") nil) | ||
712 | :custom | ||
713 | (link-hint-avy-style 'at-full) | ||
714 | (link-hint-avy-all-windows t) | ||
715 | :config | ||
716 | (require '+link-hint) | ||
717 | (+link-hint-open-secondary-setup) | ||
718 | (+link-hint-open-chrome-setup) | ||
719 | :bind | ||
720 | (("M-l M-l" . +link-hint-open-link) | ||
721 | ("M-l l" . +link-hint-open-link) | ||
722 | ("M-l M-o" . +link-hint-open-secondary) | ||
723 | ("M-l o" . +link-hint-open-secondary) | ||
724 | ("M-l M-m" . +link-hint-open-multiple-links) | ||
725 | ("M-l m" . +link-hint-open-multiple-links) | ||
726 | ("M-l M-w" . link-hint-copy-link) | ||
727 | ("M-l w" . link-hint-copy-link) | ||
728 | ("M-l M-c" . +link-hint-open-chrome) | ||
729 | ("M-l c" . +link-hint-open-chrome))) | ||
730 | |||
731 | (use-package browse-url | ||
732 | :demand t | ||
733 | :preface | ||
734 | (require '+browse-url) | ||
735 | :config | ||
736 | (eval-after chd | ||
737 | (add-to-list 'browse-url-handlers (cons chd/url-regexps | ||
738 | #'browse-url-chrome)) | ||
739 | (add-to-list '+browse-url-other-safe-browser-functions | ||
740 | #'chd/browse-url)) | ||
741 | (put 'browse-url-browser-function 'safe-local-variable | ||
742 | #'+browse-url-browser-function-safe-p) | ||
743 | :custom | ||
744 | (browse-url-browser-function #'eww-browse-url) | ||
745 | (browse-url-chromium-program (choose-executable "chromium")) | ||
746 | (browse-url-chrome-program (choose-executable "chrome" "google-chrome-stable")) | ||
747 | (browse-url-firefox-program (choose-executable "firefox" "firefox-esr")) | ||
748 | (browse-url-firefox-new-window-is-tab t) | ||
749 | (browse-url-firefox-arguments '("--new-tab")) | ||
750 | (browse-url-generic-program (or browse-url-firefox-program | ||
751 | browse-url | ||
752 | browse-url-chrome-program)) | ||
753 | (browse-url-generic-args | ||
754 | (cl-loop for prog in '(firefox chromium chrome) | ||
755 | for progfn = (intern (format "browse-url-%s-program" | ||
756 | prog)) | ||
757 | for progargs = (intern (format "browse-url-%s-arguments" | ||
758 | prog)) | ||
759 | if (equal browse-url-generic-program | ||
760 | (symbol-value progfn)) | ||
761 | return (symbol-value progargs) | ||
762 | finally return nil)) | ||
763 | (browse-url-handlers | ||
764 | `(;; Videos | ||
765 | (,(+browse-url-matches "youtube\\.com" "youtu\\.be" | ||
766 | "invidious" "yewtu\\.be" | ||
767 | (rx "." (or "mp4" "gif" "mov" "MOV" "webm") | ||
768 | eos)) | ||
769 | . +browse-url-with-mpv) | ||
770 | ;; Music | ||
771 | (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com" | ||
772 | (rx "." (or "ogg" "mp3" "opus" "m4a") eos)) | ||
773 | . +browse-url-with-mpv) | ||
774 | ;; Images | ||
775 | (,(+browse-url-matches "pbs\\.twimg\\.com" | ||
776 | (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") | ||
777 | eos)) | ||
778 | . +browse-url-with-mpv-image) | ||
779 | ;; Blobs (binary files) | ||
780 | (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos)) | ||
781 | . +browse-url-download) | ||
782 | ;; External URLs --- these are URLs that don't open in EWW very well, | ||
783 | ;; so I want to open them in the external browser. | ||
784 | (+browse-url-external-url-p . ,(if (featurep 'xwidget-internal) | ||
785 | #'xwidget-webkit-browse-url | ||
786 | browse-url-secondary-browser-function)))) | ||
787 | (+browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org" | ||
788 | "tildegit.org" "git.tilde.town" | ||
789 | "google.com" "imgur.com" "twitch.tv" | ||
790 | "pixelfed" "instagram.com" | ||
791 | "bibliogram.art" "reddit.com" | ||
792 | "teddit.net" "libreddit.de" | ||
793 | "streamable.com" "spotify.com" | ||
794 | "hetzner.cloud" "melpa.org" | ||
795 | "twitter.com" ("^t\\.co$") | ||
796 | "nitter.snopyta.org" "nitter.net"))) | ||
797 | |||
798 | (use-package browse-url-transform | ||
799 | :after browse-url | ||
800 | :load-path "~/src/emacs/browse-url-transform/" | ||
801 | :custom | ||
802 | (browse-url-transform-alist | ||
803 | `(;; Privacy-respecting alternatives | ||
804 | ("twitter\\.com" . "nitter.snopyta.org") | ||
805 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de") | ||
806 | ("medium\\.com" . "scribe.rip") | ||
807 | (".*substack\\.com.*" . ,substack-proxy) | ||
808 | ;; Text-mode of non-text-mode sites | ||
809 | ("www\\.npr\\.org" . "text.npr.org") | ||
810 | ;; Ask for raw versions of paste sites | ||
811 | ("^.*dpaste\\.com.*$" . "\\&.txt") | ||
812 | ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1") | ||
813 | ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2") | ||
814 | ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2") | ||
815 | ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2"))) | ||
816 | :config | ||
817 | (browse-url-transform-mode)) | ||
818 | |||
819 | (use-package eww | ||
820 | :custom | ||
821 | (eww-use-browse-url ".") | ||
822 | :config | ||
823 | (defhook eww-mode-hook | ||
824 | (defhook ((visual-fill-column-mode nil :local)) | ||
825 | :name visual-fill-column@eww-mode-refresh | ||
826 | (eww-reload t))) | ||
827 | (defkeys eww-mode-map | ||
828 | "&" (+browse-url-switch-external-browser eww-mode | ||
829 | (plist-get eww-data :url)))) | ||
830 | |||
831 | (use-package xwidget | ||
832 | :when (featurep 'xwidget-internal) | ||
833 | :preface | ||
834 | (setenv "WEBKIT_FORCE_SANDBOX" "0") ; This is probably a bad idea | ||
835 | :custom | ||
836 | (xwidget-webkit-cookie-file (cache/ "xwidget-cookies")) | ||
837 | (xwidget-webkit-download-dir (expand-file-name "~/var/download")) | ||
838 | :config | ||
839 | (defkeys xwidget-webkit-mode-map | ||
840 | "&" (+browse-url-switch-external-browser xwidget-webkit-mode | ||
841 | (xwidget-webkit-uri (xwidget-webkit-current-session))))) | ||
842 | |||
843 | (use-package xwwp | ||
844 | :load-path "~/src/emacs/xwwp/" | ||
845 | :when (featurep 'xwidget-internal) | ||
846 | :custom | ||
847 | (xwwp-search-prefix "https://duckduckgo.com/?q=") | ||
848 | :bind (:map xwidget-webkit-mode-map | ||
849 | ("f" . xwwp-follow-link))) | ||
850 | 6 | ||
851 | (use-package jabber | 7 | (load (locate-user-emacs-file "basics")) ; super basic stuff |
852 | :load-path "~/src/emacs/emacs-jabber" | ||
853 | :custom | ||
854 | (jabber-account-list '(("acdw@hmm.st"))) | ||
855 | (jabber-auto-reconnect t) | ||
856 | (jabber-chat-buffer-format "xmpp:%n") | ||
857 | (jabber-browse-buffer-format "xmpp-browse:%n") | ||
858 | (jabber-groupchat-buffer-format "xmpp-muc:%n") | ||
859 | (jabber-muc-private-buffer-format "xmpp-muc-private:%n") | ||
860 | (jabber-groupchat-prompt-format "%>10n │ ") | ||
861 | (jabber-chat-local-prompt-format "%>10n │ ") | ||
862 | (jabber-chat-system-prompt-format " * * * * * *") | ||
863 | (jabber-chat-foreign-prompt-format "%>10n │ ") | ||
864 | (jabber-muc-private-foreign-prompt-format "%g/%n ") | ||
865 | (jabber-last-read-marker "----------------------------------------") | ||
866 | (jabber-muc-header-line-format '("" jabber-muc-topic)) | ||
867 | (jabber-muc-decorate-presence-patterns | ||
868 | '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") | ||
869 | ("." . jabber-muc-presence-dim))) | ||
870 | (jabber-activity-make-strings | ||
871 | #'jabber-activity-make-strings-shorten) | ||
872 | (jabber-rare-time-format " - - - - - - %H:%M %F") | ||
873 | :custom-face | ||
874 | (jabber-chat-prompt-local ((t :inherit font-lock-keyword-face | ||
875 | :foreground unspecified))) | ||
876 | (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign | ||
877 | :foreground unspecified | ||
878 | :weight normal))) | ||
879 | (jabber-activity-personal-face ((t :inherit font-lock-warning-face | ||
880 | :foreground unspecified | ||
881 | :weight bold))) | ||
882 | (jabber-chat-prompt-foreign ((t :inherit font-lock-constant-face | ||
883 | :foreground unspecified))) | ||
884 | (jabber-chat-prompt-system ((t :inherit font-lock-doc-face | ||
885 | :foreground unspecified))) | ||
886 | (jabber-rare-time-face ((t :inherit font-lock-comment-face | ||
887 | :foreground unspecified | ||
888 | :underline nil))) | ||
889 | :init | ||
890 | (defhook (jabber-chat-mode-hook | ||
891 | jabber-browse-mode-hook | ||
892 | jabber-roster-mode-hook | ||
893 | jabber-console-mode-hook) | ||
894 | :name jabber-ui-setup | ||
895 | (visual-fill-column-mode) | ||
896 | (electric-pair-local-mode -1) | ||
897 | (auto-fill-mode -1) | ||
898 | (setq-local wrap-prefix (format "%13s" " "))) | ||
899 | :bind-keymap ("C-c j" . jabber-global-keymap) | ||
900 | :bind (("C-c C-SPC" . jabber-activity-switch-to)) | ||
901 | :config | ||
902 | (global-set-key (kbd "C-x C-j") #'dired-jump) ; Extremely annoying fix | ||
903 | (require 'jabber-httpupload nil :noerror) | ||
904 | (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) | ||
905 | (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) | ||
906 | (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) | ||
907 | (add-hook 'jabber-alert-muc-hooks | ||
908 | (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) | ||
909 | (when buf | ||
910 | (with-current-buffer buf | ||
911 | (let ((regexp (rx word-boundary | ||
912 | "acdw" ; maybe get from the config? | ||
913 | word-boundary))) | ||
914 | (hi-lock-unface-buffer regexp) | ||
915 | (highlight-regexp regexp 'hi-blue)))))) | ||
916 | (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) | ||
917 | (eval-after consult | ||
918 | (defvar jabber-chat-buffer-source | ||
919 | `( :name "Jabber" | ||
920 | :hidden nil | ||
921 | :narrow ?j | ||
922 | :category buffer | ||
923 | :state ,#'consult--buffer-state | ||
924 | :items ,(lambda () | ||
925 | (mapcar #'buffer-name | ||
926 | (seq-filter (lambda (buf) | ||
927 | (with-current-buffer buf | ||
928 | (eq major-mode 'jabber-chat-mode))) | ||
929 | (buffer-list)))))) | ||
930 | (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) | ||
931 | ;; Also hide xmpp buffers from regular buffer list | ||
932 | (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal))) | ||
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index b65b6f9..0000000 --- a/lisp/+browse-url.el +++ /dev/null | |||
@@ -1,189 +0,0 @@ | |||
1 | ;;; +browse-url.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (require 'browse-url) | ||
4 | (require 'cl-lib) | ||
5 | (require 'seq) | ||
6 | (require 'url-util) | ||
7 | |||
8 | (defgroup +browse-url nil | ||
9 | "My `browse-url' extras." | ||
10 | :group 'browse-url) | ||
11 | |||
12 | ;;; External URL handlers | ||
13 | |||
14 | (cl-defmacro +browse-url-make-external-viewer-handler | ||
15 | (viewer | ||
16 | &key | ||
17 | args | ||
18 | (prompt "URL: ") | ||
19 | (program (executable-find (format "%s" viewer))) | ||
20 | (name (intern (format "+browse-url-with-%s" viewer))) | ||
21 | doc | ||
22 | (var (intern (format "%s-args" name))) | ||
23 | vardoc | ||
24 | (custom-group '+browse-url) | ||
25 | (fallback '(function browse-url-generic))) | ||
26 | "Create a `browse-url' handler function calling PROGRAM on the URL. | ||
27 | This macro also creates a `customize' setting in CUSTOM-GROUP for | ||
28 | PROGRAM's command-line arguments. ARGS specifies the | ||
29 | default arguments for this user option. | ||
30 | |||
31 | PROGRAM defaults to the result of calling `executable-find' on VIEWER. | ||
32 | |||
33 | PROMPT is shown to the user in the function's `interactive' spec, as an argument | ||
34 | to `browse-url-interactive-arg'. | ||
35 | |||
36 | The resulting function is named NAME, which defaults to | ||
37 | `+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults | ||
38 | to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of | ||
39 | the function and variable respectively; otherwise a basic default doc-string is | ||
40 | used. | ||
41 | |||
42 | If FALLBACK is non-nil (the default is `browse-url-generic'), the | ||
43 | generated function will call FALLBACK if unable to start PROGRAM | ||
44 | for some reason." | ||
45 | (declare (indent 1)) | ||
46 | `(progn | ||
47 | (defcustom ,var ,args | ||
48 | ,(or vardoc (format "Arguments to pass to %s in `%s'." | ||
49 | viewer name)) | ||
50 | :type '(repeat :tag "Command-line argument" string) | ||
51 | :group ',custom-group) | ||
52 | (defun ,name (url &optional new-window) | ||
53 | ,(or doc (format "Open URL in %s." viewer)) | ||
54 | (interactive (browse-url-interactive-arg ,prompt)) | ||
55 | (let* ((url (browse-url-encode-url url)) | ||
56 | (process-environment (browse-url-process-environment))) | ||
57 | (message ,(format "Opening %%s in %s..." viewer) url) | ||
58 | (unless (ignore-errors (apply #'start-process | ||
59 | (format "%s %s" ',viewer url) | ||
60 | nil | ||
61 | ,program | ||
62 | (append ,var (list url)))) | ||
63 | ,@(cond | ||
64 | (fallback `((funcall ,fallback url new-window))) | ||
65 | (:else `((message "Can't find viewer: %s" ,viewer) | ||
66 | nil)))))))) | ||
67 | |||
68 | ;; Some default handlers | ||
69 | |||
70 | (+browse-url-make-external-viewer-handler mpv | ||
71 | :args '("--cache-pause-wait=15" | ||
72 | "--cache-pause-initial=yes") | ||
73 | :prompt "Video URL: ") | ||
74 | |||
75 | (+browse-url-make-external-viewer-handler mpv-image | ||
76 | :program (executable-find "mpv") | ||
77 | :args '("--image-display-duration=inf") | ||
78 | :prompt "Image URL: ") | ||
79 | |||
80 | ;;; Downloading | ||
81 | |||
82 | (defcustom +browse-url-download-open t | ||
83 | "Whether to open downloaded files after downloading." | ||
84 | :type 'boolean) | ||
85 | |||
86 | (defun +browse-url-download (url &rest _) | ||
87 | "Download URL to `eww-download-directory'." | ||
88 | (interactive "sDownload URL: ") | ||
89 | (let ((dir eww-download-directory)) | ||
90 | (when (functionp dir) (setq dir (funcall dir))) | ||
91 | (make-directory dir :parents) | ||
92 | (url-retrieve url | ||
93 | (lambda (s u d) | ||
94 | (let ((file (+browse-url-download-callback s u d))) | ||
95 | (when +browse-url-download-open | ||
96 | (browse-url-xdg-open file)))) | ||
97 | (list url dir)))) | ||
98 | |||
99 | (defun +browse-url-download-callback (status url dir) | ||
100 | ;; A slight change to `eww-download-callback' that returns the downloaded | ||
101 | ;; filename. | ||
102 | (unless (plist-get status :error) | ||
103 | (let* ((obj (url-generic-parse-url url)) | ||
104 | (path (directory-file-name (car (url-path-and-query obj)))) | ||
105 | (file (eww-make-unique-file-name | ||
106 | (eww-decode-url-file-name (file-name-nondirectory path)) | ||
107 | dir))) | ||
108 | (goto-char (point-min)) | ||
109 | (re-search-forward "\r?\n\r?\n") | ||
110 | (let ((coding-system-for-write 'no-conversion)) | ||
111 | (write-region (point) (point-max) file)) | ||
112 | (message "Saved %s" file) | ||
113 | file))) | ||
114 | |||
115 | ;;; URL matcher generators | ||
116 | |||
117 | (defun +browse-url-matches (&rest regexps) | ||
118 | "Return a lambda that will determine if a url matches REGEXPS. | ||
119 | Each regexp will be tested in turn. The first one that matches | ||
120 | is returned by the lambda. | ||
121 | |||
122 | This is a good function to use in key positions in `browse-url-handlers'." | ||
123 | `(lambda (url &optional new-window) | ||
124 | (cl-loop for regexp in ',regexps | ||
125 | if (string-match-p regexp url) | ||
126 | return regexp))) | ||
127 | |||
128 | ;;; External domains | ||
129 | ;; Some domains just don't open well in `eww'. The following function and user | ||
130 | ;; option define an easy way to automatically open those. | ||
131 | |||
132 | (defcustom +browse-url-external-domains nil | ||
133 | "Domains to open in `browse-url-secondary-browser-function'. | ||
134 | This is just a list of strings. They'll be regexp-escaped and | ||
135 | passed to `+browse-url-external-url-p', which is a good function | ||
136 | to put in `browse-url-handlers'. | ||
137 | |||
138 | If an item in this list is a list itself, it should contain one string, a valid | ||
139 | regexp that will not be regexp-quoted when matching against a url." | ||
140 | :type '(repeat (choice | ||
141 | (list :tag "Regexp" regexp) | ||
142 | (string :tag "Literal string")))) | ||
143 | |||
144 | (defun +browse-url-external-url-p (url) | ||
145 | "Return t if URL is a member of `+browse-url-external-domains'. | ||
146 | This function only tests URL's domain." | ||
147 | (let ((host (url-host (url-generic-parse-url url)))) | ||
148 | (cl-loop for domain in +browse-url-external-domains | ||
149 | if (string-match-p (if (stringp domain) | ||
150 | (regexp-quote domain) | ||
151 | (car domain)) | ||
152 | host) | ||
153 | return t))) | ||
154 | |||
155 | ;;; Switch to an external browser from an Emacs browser | ||
156 | |||
157 | (defmacro +browse-url-switch-external-browser (mode url-fetcher-form) | ||
158 | "Create a function for MODE to open an external browser. | ||
159 | URL-FETCHER-FORM will be used to get the URL of the current visited page." | ||
160 | (declare (indent 1)) | ||
161 | `(defun ,(intern (format "+browse-url-external-from-%s" mode)) | ||
162 | (&optional url) | ||
163 | "Browse URL with `browse-url-secondary-browser-function'. | ||
164 | This will close the current buffer." | ||
165 | (interactive nil ,mode) | ||
166 | (condition-case e | ||
167 | (funcall browse-url-secondary-browser-function | ||
168 | (or url ,url-fetcher-form)) | ||
169 | (:success (when (null url) (quit-window))) ; Interactive use | ||
170 | (t (signal (car e) (cdr e)))))) | ||
171 | |||
172 | ;;; Mark `browse-url-browser-function' as safe | ||
173 | |||
174 | (defcustom +browse-url-other-safe-browser-functions nil | ||
175 | "Other safe browser functions." | ||
176 | :type '(repeat function)) | ||
177 | |||
178 | (defun +browse-url-browser-function-safe-p (f) | ||
179 | "Return t if F is a safe browser function." | ||
180 | (memq f (append +browse-url-other-safe-browser-functions | ||
181 | (mapcar (lambda (i) | ||
182 | (plist-get (cdr i) :value)) | ||
183 | (seq-filter (lambda (i) | ||
184 | (eq (car i) 'function-item)) | ||
185 | (cdr (get 'browse-url-browser-function | ||
186 | 'custom-type))))))) | ||
187 | |||
188 | (provide '+browse-url) | ||
189 | ;;; +browse-url.el ends here | ||
diff --git a/lisp/+cape.el b/lisp/+cape.el deleted file mode 100644 index 37e88fe..0000000 --- a/lisp/+cape.el +++ /dev/null | |||
@@ -1,25 +0,0 @@ | |||
1 | ;;; cape.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cape) | ||
6 | |||
7 | (defmacro +cape-insinuate (hook capes &rest capfs) | ||
8 | "Insinuate CAPES for a mode. | ||
9 | Add a function to HOOK that will add CAPES to the local | ||
10 | `completion-at-point-functions' for that mode's buffer. If CAPFS | ||
11 | are given, mark them all as non-exclusive." | ||
12 | (let ((fn (intern (format "+cape-insinuate@%s" hook)))) | ||
13 | `(prog1 | ||
14 | ,@(when capes | ||
15 | `((defun ,fn () | ||
16 | ,@(cl-loop for cape in capes | ||
17 | collect `(add-hook 'completion-at-point-functions | ||
18 | #',cape 90 :local))) | ||
19 | (add-hook ',hook #',fn))) | ||
20 | ,@(cl-loop for capf in capfs | ||
21 | collect `(advice-add ',capf :around | ||
22 | #'cape-wrap-nonexclusive))))) | ||
23 | |||
24 | (provide '+cape) | ||
25 | ;;; +cape.el ends here | ||
diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index a43daea..0000000 --- a/lisp/+emms.el +++ /dev/null | |||
@@ -1,38 +0,0 @@ | |||
1 | ;;; +emms.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (defun +emms-streams (&optional file) | ||
4 | "Better interface for `emms-streams'. | ||
5 | If FILE is non-nil, use it. Otherwise use `emms-streams-file'. | ||
6 | If `emms-streams-file' is nil or this function is called with | ||
7 | \\[universal-argument], prompt the user." | ||
8 | (interactive | ||
9 | (list (cond | ||
10 | ((or emms-streams-file | ||
11 | (not current-prefix-arg)) | ||
12 | emms-streams-file) | ||
13 | (:else (read-file-name "Stream file: " | ||
14 | emms-source-file-default-directory))))) | ||
15 | (when (and (not (file-exists-p emms-streams-file)) | ||
16 | (y-or-n-p "Emms' bulit-in streams file hasn't been installed yet. Install it now?")) | ||
17 | (emms-streams-install)) | ||
18 | (let ((buf (get-buffer emms-streams-buffer-name))) | ||
19 | (when (not buf) | ||
20 | (with-current-buffer (get-buffer-create emms-streams-buffer-name) | ||
21 | (setq buf (current-buffer)) | ||
22 | (emms-playlist-mode) | ||
23 | (setq emms-playlist-buffer-p t) | ||
24 | (emms-playlist-set-playlist-buffer (current-buffer)) | ||
25 | (with-current-buffer (find-file-noselect emms-streams-file) | ||
26 | (cond | ||
27 | ((emms-source-playlist-native-p) | ||
28 | (emms-add-native-playlist emms-streams-file)) | ||
29 | ((emms-source-playlist-m3u-p) | ||
30 | (emms-add-m3u-playlist emms-streams-file)) | ||
31 | ((emms-source-playlist-pls-p) | ||
32 | (emms-add-pls-playlist emms-streams-file)) | ||
33 | (:else (error "Streams file `%s' isn't in a known format." | ||
34 | emms-streams-file)))))) | ||
35 | (switch-to-buffer buf))) | ||
36 | |||
37 | (provide '+emms) | ||
38 | ;;; +emms.el ends here | ||
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 9a33cc0..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +flyspell-correct.el --- -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'flyspell-correct) | ||
6 | |||
7 | (defun +flyspell-correct-buffer (&optional prefix) | ||
8 | "Run `flyspell-correct-wrapper' on all misspelled words in the buffer. | ||
9 | With PREFIX, prompt to change the current dictionary." | ||
10 | (interactive "P") | ||
11 | (flyspell-buffer) | ||
12 | (when prefix | ||
13 | (let ((current-prefix-arg nil)) | ||
14 | (call-interactively #'ispell-change-dictionary))) | ||
15 | (with-message "Checking spelling" | ||
16 | (flyspell-correct-move (point-min) :forward :rapid))) | ||
17 | |||
18 | (defun +flyspell-correct-buffer-h (&rest _) | ||
19 | "Run `+flyspell-correct-buffer'. | ||
20 | This is suitable for placement in a hook." | ||
21 | (+flyspell-correct-buffer)) | ||
22 | |||
23 | (provide '+flyspell-correct) | ||
24 | ;;; +flyspell-correct.el ends here | ||
diff --git a/lisp/+hungry-delete.el b/lisp/+hungry-delete.el deleted file mode 100644 index 601aecf..0000000 --- a/lisp/+hungry-delete.el +++ /dev/null | |||
@@ -1,53 +0,0 @@ | |||
1 | ;;; +hungry-delete.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'hungry-delete) | ||
8 | |||
9 | (defmacro +hungry-delete-define-alternative (func hd-func &optional direction) | ||
10 | "Define a `hungry-delete' alternative for FUNC. | ||
11 | If the adjacent characters in DIRECTION are one of | ||
12 | `hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call | ||
13 | FUNC. | ||
14 | |||
15 | If DIRECTION is a positive integer or `forward', look forward. | ||
16 | If it's negative or `backward', look backward. If it's absent, | ||
17 | this macro will try to guess based on the names of FUNC and | ||
18 | HD-FUNC. | ||
19 | |||
20 | This macro creates a function taking a prefix argument that's | ||
21 | passed to both of FUNC and HD-FUNC." | ||
22 | (let ((name (intern (format "%s|%s" func hd-func))) | ||
23 | (lookfn (cond | ||
24 | ((or (and (string-match-p "forward" (symbol-name func)) | ||
25 | (string-match-p "forward" (symbol-name hd-func)) | ||
26 | (not direction)) | ||
27 | (and (integerp direction) | ||
28 | (< 0 direction)) | ||
29 | (eq direction 'forward)) | ||
30 | 'looking-at) | ||
31 | ((or (and (string-match-p "backward" (symbol-name func)) | ||
32 | (string-match-p "backward" (symbol-name hd-func)) | ||
33 | (not direction)) | ||
34 | (and (integerp direction) | ||
35 | (> 0 direction)) | ||
36 | (eq direction 'backward)) | ||
37 | 'looking-back) | ||
38 | (:else (error "Bad direction: %S" direction)))) | ||
39 | (arg (gensym))) | ||
40 | `(defun ,name (,arg) | ||
41 | ,(concat (format "Do `%s' or `%s', depending on whitespace.\n" | ||
42 | func hd-func) | ||
43 | (format "Pass prefix argument %s to the underlying functions.\n" | ||
44 | (upcase (symbol-name arg))) | ||
45 | "This function was defined by `define-hungry-delete-alternative'.") | ||
46 | (interactive "*p") ; This is brittle | ||
47 | (if (,lookfn (format "[%s]" hungry-delete-chars-to-skip)) | ||
48 | (,hd-func (or ,arg 1)) | ||
49 | (,func ,arg))))) | ||
50 | |||
51 | (provide '+hungry-delete) | ||
52 | ;;; +hungry-delete.el ends here | ||
53 | |||
diff --git a/lisp/+isearch.el b/lisp/+isearch.el deleted file mode 100644 index 3516ec4..0000000 --- a/lisp/+isearch.el +++ /dev/null | |||
@@ -1,24 +0,0 @@ | |||
1 | ;;; +isearch.el --- iseach (and query-replace) extensions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; From https://github.com/astoff/isearch-mb/wiki | ||
4 | |||
5 | (defun +isearch-cancel@add-search-to-history () | ||
6 | "Add search string to history also when canceling. | ||
7 | This should be used as `:before' advice on `isearch-cancel'." | ||
8 | (unless (string-equal "" isearch-string) | ||
9 | (isearch-update-ring isearch-string isearch-regexp))) | ||
10 | |||
11 | (defun +perform-replace-dont-exit-on-anykey (orig &rest args) | ||
12 | "Don't exit replace for anykey that's not in `query-replace-map'. | ||
13 | This should be used as `:around' advice for `perform-replace'." | ||
14 | (save-window-excursion | ||
15 | (cl-letf* ((lookup-key-orig | ||
16 | (symbol-function 'lookup-key)) | ||
17 | ((symbol-function 'lookup-key) | ||
18 | (lambda (map key &optional accept-default) | ||
19 | (or (apply lookup-key-orig map key accept-default) | ||
20 | (when (eq map query-replace-map) 'help))))) | ||
21 | (apply orig args)))) | ||
22 | |||
23 | (provide '+isearch) | ||
24 | ;;; +isearch.el ends here | ||
diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index 10c31b8..0000000 --- a/lisp/+ispell.el +++ /dev/null | |||
@@ -1,97 +0,0 @@ | |||
1 | ;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'cl-lib) | ||
8 | (require 'seq) | ||
9 | |||
10 | ;; Utility function TODO: move elsewhere | ||
11 | (defun +ispell-append-removing-duplicates (&rest lists) | ||
12 | "Append LISTS, removing duplicates from the result. | ||
13 | Any keyword arguments to `cl-remove-duplicates' should come | ||
14 | before the LISTS." | ||
15 | (let (cl-remove-duplicates-args) | ||
16 | (while (keywordp (car lists)) | ||
17 | (push (pop lists) cl-remove-duplicates-args) | ||
18 | (push (pop lists) cl-remove-duplicates-args)) | ||
19 | (apply #'cl-remove-duplicates (apply #'append lists) | ||
20 | (nreverse cl-remove-duplicates-args)))) | ||
21 | |||
22 | ;;; Ispell in .dir-locals | ||
23 | |||
24 | ;; Let Emacs know a list of strings is safe | ||
25 | (defun +ispell-safe-local-p (list) | ||
26 | (and (listp list) | ||
27 | (seq-every-p #'stringp list))) | ||
28 | |||
29 | ;; Can I instruct ispell to insert LocalWords in a different file? | ||
30 | ;; https://emacs.stackexchange.com/q/31396/2264 | ||
31 | |||
32 | ;; How can I move all my file-local LocalWords to .dir-locals.el? | ||
33 | ;; https://emacs.stackexchange.com/q/31419 | ||
34 | |||
35 | ;; Adapted from ispell.el:ispell-buffer-local-words | ||
36 | (defun +ispell-buffer-local-words-list () | ||
37 | (let (words) | ||
38 | (or ispell-buffer-local-name | ||
39 | (setf ispell-buffer-local-name (buffer-name))) | ||
40 | (save-excursion | ||
41 | (goto-char (point-min)) | ||
42 | (while (search-forward ispell-words-keyword nil t) | ||
43 | (let ((end (point-at-eol)) | ||
44 | (ispell-casechars (ispell-get-casechars)) | ||
45 | string) | ||
46 | (while (re-search-forward " *\\([^ ]+\\)" end t) | ||
47 | (setf string (match-string-no-properties 1)) | ||
48 | (if (and (< 1 (length string)) | ||
49 | (equal 0 (string-match ispell-casechars string))) | ||
50 | (push string words)))))) | ||
51 | words)) | ||
52 | |||
53 | ;;;###autoload | ||
54 | (defun +ispell-move-buffer-words-to-dir-locals (&optional arg) | ||
55 | "Move the current buffer-local words to .dir-locals.el. | ||
56 | This function prompts the user to save .dir-locals.el, unless | ||
57 | prefix ARG is non-nil; then it just saves them." | ||
58 | (interactive "P") | ||
59 | (unless (buffer-file-name) | ||
60 | (user-error "Buffer not attached to file")) | ||
61 | (hack-dir-local-variables) | ||
62 | (let ((print-level nil) | ||
63 | (print-length nil)) | ||
64 | (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA | ||
65 | ; where this came from | ||
66 | (+ispell-append-removing-duplicates | ||
67 | :test #'string= | ||
68 | ispell-buffer-session-localwords | ||
69 | (alist-get 'ispell-buffer-session-localwords | ||
70 | dir-local-variables-alist) | ||
71 | (alist-get 'ispell-buffer-session-localwords | ||
72 | file-local-variables-alist) | ||
73 | (+ispell-buffer-local-words-list))))) | ||
74 | (save-excursion | ||
75 | (add-dir-local-variable | ||
76 | major-mode | ||
77 | 'ispell-buffer-session-localwords | ||
78 | (setf ispell-buffer-session-localwords | ||
79 | new-words)) | ||
80 | (when (or arg | ||
81 | (y-or-n-p "Save .dir-locals.el?")) | ||
82 | (save-buffer)) | ||
83 | (bury-buffer)) | ||
84 | (or ispell-buffer-local-name | ||
85 | (setf ispell-buffer-local-name (buffer-name))) | ||
86 | (save-excursion | ||
87 | (goto-char (point-min)) | ||
88 | (while (search-forward ispell-words-keyword nil t) | ||
89 | (delete-region (point-at-bol) (1+ (point-at-eol)))))))) | ||
90 | |||
91 | ;;;###autoload | ||
92 | (defun +ispell-move-buffer-words-to-dir-locals-hook () | ||
93 | "Convenience function for binding to a hook." | ||
94 | (+ispell-move-buffer-words-to-dir-locals t)) | ||
95 | |||
96 | (provide '+ispell) | ||
97 | ;;; +ispell.el ends here | ||
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 926a266..0000000 --- a/lisp/+link-hint.el +++ /dev/null | |||
@@ -1,144 +0,0 @@ | |||
1 | ;;; +link-hint.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'link-hint) | ||
7 | |||
8 | (defgroup +link-hint nil | ||
9 | "Extra customizations for `link-hint'." | ||
10 | :group 'link-hint) | ||
11 | |||
12 | (defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url | ||
13 | gnus-w3m-url | ||
14 | markdown-link | ||
15 | mu4e-attachment | ||
16 | mu4e-url | ||
17 | notmuch-hello | ||
18 | nov-link | ||
19 | org-link | ||
20 | shr-url | ||
21 | text-url | ||
22 | w3m-link | ||
23 | w3m-message-link) | ||
24 | "Link types to define `:open-secondary' for.") | ||
25 | |||
26 | (defvar +link-hint-map (make-sparse-keymap) | ||
27 | "Keymap for `link-hint' functionality.") | ||
28 | |||
29 | (cl-defmacro +link-hint-define-keyword (keyword handler docstring | ||
30 | &optional (types 'link-hint-types) | ||
31 | &rest rest | ||
32 | &key multiple &allow-other-keys) | ||
33 | "Set up a `link-hint' KEYWORD, with optional TYPES. | ||
34 | If TYPES is not present, use `link-hint-types'. | ||
35 | |||
36 | KEYWORD defines the link-hint type. It will be used to create a | ||
37 | function for opening links of the form \"link-hint-openKEYWORD\". | ||
38 | |||
39 | HANDLER is the function to open a link with. | ||
40 | |||
41 | DOCSTRING is the macro's documentation. | ||
42 | |||
43 | Keyword arguments are passed to `link-hint-define-type' prefixed | ||
44 | with the KEYWORD." | ||
45 | (declare (indent 2) | ||
46 | (doc-string 3)) | ||
47 | (let ((types (symbol-value types)) | ||
48 | (func-sym (intern (format "+link-hint-open%s" keyword))) | ||
49 | (mult-sym (intern (format "%s-multiple" keyword))) | ||
50 | (expr)) | ||
51 | ;; Define the type | ||
52 | (push `(dolist (type ',types) | ||
53 | (link-hint-define-type type | ||
54 | ,keyword ,handler | ||
55 | ,@(mapcar (lambda (el) | ||
56 | (if (eq el :multiple) | ||
57 | mult-sym | ||
58 | el)) | ||
59 | rest))) | ||
60 | expr) | ||
61 | ;; Define an opener | ||
62 | (push `(defun ,func-sym () | ||
63 | ,(format "%s\n\nDefined by `+link-hint-define'." docstring) | ||
64 | (interactive) | ||
65 | (avy-with link-hint-open-link | ||
66 | (link-hint--one ,keyword))) | ||
67 | expr) | ||
68 | ;; Handle `:multiple' | ||
69 | (when multiple | ||
70 | (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) () | ||
71 | ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'." | ||
72 | func-sym) | ||
73 | (avy-with link-hint-open-multiple-links | ||
74 | (link-hint--multiple ,keyword))) | ||
75 | expr) | ||
76 | (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) () | ||
77 | ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'." | ||
78 | func-sym) | ||
79 | (avy-with link-hint-open-all-links | ||
80 | (link-hint--all ,keyword))) | ||
81 | expr)) | ||
82 | ;; Return the built expression | ||
83 | `(progn ,@(nreverse expr)))) | ||
84 | |||
85 | (+link-hint-define-keyword :secondary browse-url-secondary-browser-function | ||
86 | "Open a link in the secondary browser." | ||
87 | +link-hint-open-secondary-types | ||
88 | :multiple t) | ||
89 | |||
90 | (defun +link-hint-open-secondary-setup (&optional types) | ||
91 | "Define the `:open-secondary' link-hint type for TYPES. | ||
92 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
93 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
94 | (link-hint-define-type type | ||
95 | :open-secondary browse-url-secondary-browser-function | ||
96 | :open-secondary-multiple t))) | ||
97 | |||
98 | (defun +link-hint-open-secondary () | ||
99 | "Open a link in the secondary browser." | ||
100 | (interactive) | ||
101 | (avy-with link-hint-open-link | ||
102 | (link-hint--one :open-secondary))) | ||
103 | |||
104 | (defun +link-hint-open-chrome-setup (&optional types) | ||
105 | "Define the `:open-chrome' link-hint type for TYPES. | ||
106 | If TYPES is nil, define it for `+link-hint-open-secondary-types'." | ||
107 | (dolist (type (or types +link-hint-open-secondary-types)) | ||
108 | (link-hint-define-type type | ||
109 | :open-chrome #'browse-url-chrome | ||
110 | :open-chrome-multiple t))) | ||
111 | |||
112 | (defun +link-hint-open-chrome () | ||
113 | "Open a link with chrome." | ||
114 | (interactive) | ||
115 | (avy-with link-hint-open-link | ||
116 | (link-hint--one :open-chrome))) | ||
117 | |||
118 | (defun +link-hint-open-link (prefix) | ||
119 | "Open a link. | ||
120 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
121 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
122 | (interactive "P") | ||
123 | (let ((current-prefix-arg nil)) | ||
124 | (avy-with link-hint-open-link | ||
125 | (link-hint--one (if prefix :open-secondary :open))))) | ||
126 | |||
127 | (defun +link-hint-open-multiple-links (prefix) | ||
128 | "Open multiple links. | ||
129 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
130 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
131 | (interactive "P") | ||
132 | (avy-with link-hint-open-multiple-links | ||
133 | (link-hint--one (if prefix :open-secondary :open)))) | ||
134 | |||
135 | (defun +link-hint-open-all-links (prefix) | ||
136 | "Open all visible links. | ||
137 | Without a PREFIX, open using `browse-url-browser-function'; with | ||
138 | a PREFIX, use `browse-url-secondary-browser-function'." | ||
139 | (interactive "P") | ||
140 | (avy-with link-hint-open-all-links | ||
141 | (link-hint--one (if prefix :open-secondary :open)))) | ||
142 | |||
143 | (provide '+link-hint) | ||
144 | ;;; +link-hint.el ends here | ||
diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index 22450f7..0000000 --- a/lisp/+lisp.el +++ /dev/null | |||
@@ -1,93 +0,0 @@ | |||
1 | ;;; +lisp.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Comment-or-uncomment-sexp | ||
4 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | ||
5 | |||
6 | (defun +lisp-uncomment-sexp (&optional n) | ||
7 | "Uncomment N sexps around point." | ||
8 | (interactive "P") | ||
9 | (let* ((initial-point (point-marker)) | ||
10 | (inhibit-field-text-motion t) | ||
11 | (p) | ||
12 | (end (save-excursion | ||
13 | (when (elt (syntax-ppss) 4) | ||
14 | (re-search-backward comment-start-skip | ||
15 | (line-beginning-position) | ||
16 | t)) | ||
17 | (setq p (point-marker)) | ||
18 | (comment-forward (point-max)) | ||
19 | (point-marker))) | ||
20 | (beg (save-excursion | ||
21 | (forward-line 0) | ||
22 | (while (and (not (bobp)) | ||
23 | (= end (save-excursion | ||
24 | (comment-forward (point-max)) | ||
25 | (point)))) | ||
26 | (forward-line -1)) | ||
27 | (goto-char (line-end-position)) | ||
28 | (re-search-backward comment-start-skip | ||
29 | (line-beginning-position) | ||
30 | t) | ||
31 | (ignore-errors | ||
32 | (while (looking-at-p comment-start-skip) | ||
33 | (forward-char -1))) | ||
34 | (point-marker)))) | ||
35 | (unless (= beg end) | ||
36 | (uncomment-region beg end) | ||
37 | (goto-char p) | ||
38 | ;; Indentify the "top-level" sexp inside the comment. | ||
39 | (while (and (ignore-errors (backward-up-list) t) | ||
40 | (>= (point) beg)) | ||
41 | (skip-chars-backward (rx (syntax expression-prefix))) | ||
42 | (setq p (point-marker))) | ||
43 | ;; Re-comment everything before it. | ||
44 | (ignore-errors | ||
45 | (comment-region beg p)) | ||
46 | ;; And everything after it. | ||
47 | (goto-char p) | ||
48 | (forward-sexp (or n 1)) | ||
49 | (skip-chars-forward "\r\n[:blank:]") | ||
50 | (if (< (point) end) | ||
51 | (ignore-errors | ||
52 | (comment-region (point) end)) | ||
53 | ;; If this is a closing delimiter, pull it up. | ||
54 | (goto-char end) | ||
55 | (skip-chars-forward "\r\n[:blank:]") | ||
56 | (when (eq 5 (car (syntax-after (point)))) | ||
57 | (delete-indentation)))) | ||
58 | ;; Without a prefix, it's more useful to leave point where | ||
59 | ;; it was. | ||
60 | (unless n | ||
61 | (goto-char initial-point)))) | ||
62 | |||
63 | (defun +lisp-comment-sexp--raw () | ||
64 | "Comment the sexp at point or ahead of point." | ||
65 | (pcase (or (bounds-of-thing-at-point 'sexp) | ||
66 | (save-excursion | ||
67 | (skip-chars-forward "\r\n[:blank:]") | ||
68 | (bounds-of-thing-at-point 'sexp))) | ||
69 | (`(,l . ,r) | ||
70 | (goto-char r) | ||
71 | (skip-chars-forward "\r\n[:blank:]") | ||
72 | (save-excursion | ||
73 | (comment-region l r)) | ||
74 | (skip-chars-forward "\r\n[:blank:]")))) | ||
75 | |||
76 | (defun +lisp-comment-or-uncomment-sexp (&optional n) | ||
77 | "Comment the sexp at point and move past it. | ||
78 | If already inside (or before) a comment, uncomment instead. | ||
79 | With a prefix argument N, (un)comment that many sexps." | ||
80 | (interactive "P") | ||
81 | (if (or (elt (syntax-ppss) 4) | ||
82 | (< (save-excursion | ||
83 | (skip-chars-forward "\r\n[:blank:]") | ||
84 | (point)) | ||
85 | (save-excursion | ||
86 | (comment-forward 1) | ||
87 | (point)))) | ||
88 | (+lisp-uncomment-sexp n) | ||
89 | (dotimes (_ (or n 1)) | ||
90 | (+lisp-comment-sexp--raw)))) | ||
91 | |||
92 | (provide '+lisp) | ||
93 | ;;; +lisp.el ends here | ||
diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
1 | ;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | ;; Thanks to Alex Schroeder for this! | ||
8 | ;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically | ||
9 | |||
10 | (defun +message-check-for-signature-change (&rest ignore) | ||
11 | "Check for a change in the To: or Cc: fields" | ||
12 | (when (and (message--in-tocc-p) | ||
13 | (not (buffer-narrowed-p))) | ||
14 | (save-excursion | ||
15 | (goto-char (point-max)) | ||
16 | (let ((end (point))) | ||
17 | (when (re-search-backward message-signature-separator nil t) | ||
18 | (delete-region (1- (match-beginning 0)) end))) | ||
19 | (message-insert-signature)))) | ||
20 | |||
21 | (defun +message-signature-setup () | ||
22 | (make-local-variable 'after-change-functions) | ||
23 | (push '+message-check-for-signature-change after-change-functions)) | ||
24 | |||
25 | (provide '+message) | ||
26 | ;;; +message.el ends here | ||
diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 5df6e5b..0000000 --- a/lisp/+notmuch.el +++ /dev/null | |||
@@ -1,149 +0,0 @@ | |||
1 | ;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't. | ||
6 | |||
7 | ;;; Code: | ||
8 | |||
9 | (require 'cl-lib) | ||
10 | (require 'notmuch) | ||
11 | |||
12 | (defvar +notmuch-send-dispatch-rules nil | ||
13 | "Alist of from addresses and variables to set when sending.") | ||
14 | |||
15 | (defun +notmuch-query-concat (&rest queries) | ||
16 | "Concatenate notmuch queries." | ||
17 | (mapconcat #'identity queries " AND ")) | ||
18 | |||
19 | (defun +send-mail-dispatch () | ||
20 | "Dispatch mail sender, depending on account." | ||
21 | (let ((from (message-fetch-field "from"))) | ||
22 | (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules | ||
23 | if (string-match-p addr from) return vars)) | ||
24 | (set (car vars) (cdr vars))))) | ||
25 | |||
26 | (defun +notmuch-correct-tags (args) | ||
27 | (list (car args) (mapcar #'string-trim (cadr args)))) | ||
28 | |||
29 | (defun +notmuch-goto (&optional prefix) | ||
30 | "Go straight to a `notmuch' search. | ||
31 | Without PREFIX argument, go to the first one in | ||
32 | `notmuch-saved-searches'; with a PREFIX argument, prompt the user | ||
33 | for which saved search to go to; with a double PREFIX | ||
34 | argument (\\[universal-argument] \\[universal-argument]), prompt | ||
35 | for search." | ||
36 | (interactive "P") | ||
37 | (pcase prefix | ||
38 | ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query))) | ||
39 | ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: " | ||
40 | (mapcar (lambda (el) | ||
41 | (plist-get el :name)) | ||
42 | notmuch-saved-searches)) | ||
43 | notmuch-saved-searches | ||
44 | :key (lambda (el) (plist-get el :name)) | ||
45 | :test #'equal) | ||
46 | :query))) | ||
47 | (_ (notmuch-search)))) | ||
48 | |||
49 | ;; Don't add an initial input when completing addresses | ||
50 | (eval-after notmuch | ||
51 | (cond ((featurep 'el-patch) | ||
52 | (el-patch-feature notmuch) | ||
53 | (el-patch-defun notmuch-address-selection-function (prompt collection initial-input) | ||
54 | "Call (`completing-read' | ||
55 | PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" | ||
56 | (completing-read | ||
57 | prompt collection nil nil | ||
58 | (el-patch-swap initial-input | ||
59 | nil) | ||
60 | 'notmuch-address-history))) | ||
61 | (:else | ||
62 | (defun notmuch-address-selection-function (prompt collection initial-input) | ||
63 | "Call (`completing-read' | ||
64 | PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" | ||
65 | (completing-read | ||
66 | prompt collection nil nil nil | ||
67 | 'notmuch-address-history))))) | ||
68 | |||
69 | (defcustom +notmuch-spam-tags '("+spam" "+Spam") | ||
70 | "A list of tag changes to apply when marking a thread as spam." | ||
71 | :type '(repeat string)) | ||
72 | |||
73 | (defun +notmuch-tree-mark-spam-then-next (&optional ham beg end) | ||
74 | "Mark the current message as spam and move to the next." | ||
75 | (interactive "P") | ||
76 | (+notmuch-tree-mark-spam ham) | ||
77 | (notmuch-tree-next-matching-message)) | ||
78 | |||
79 | (defun +notmuch-tree-mark-spam (&optional ham) | ||
80 | "Mark the current message as spam. | ||
81 | That is, apply the tag changes in `+notmuch-spam-tags' to it. If | ||
82 | an optional prefix HAM argument is given, the message will be | ||
83 | marked as not-spam (\"ham\"), i.e., the tag changes in | ||
84 | `+notmuch-spam-tags' will be reversed." | ||
85 | (interactive "P") | ||
86 | (when +notmuch-spam-tags | ||
87 | (notmuch-tree-tag | ||
88 | (notmuch-tag-change-list +notmuch-spam-tags ham)))) | ||
89 | |||
90 | (defun +notmuch-search-mark-spam (&optional ham beg end) | ||
91 | "Mark the current thread or region as spam. | ||
92 | This adds the tags in `+notmuch-spam-tags' to the message. With | ||
93 | an optional HAM prefix argument, mark the messages as | ||
94 | not-spam (\"ham\"). | ||
95 | |||
96 | This function advances the next thread when finished." | ||
97 | (interactive (cons current-prefix-arg (notmuch-interactive-region))) | ||
98 | (when +notmuch-spam-tags | ||
99 | (notmuch-search-tag | ||
100 | (notmuch-tag-change-list +notmuch-spam-tags ham) beg end)) | ||
101 | (when (eq beg end) | ||
102 | (notmuch-search-next-thread))) | ||
103 | |||
104 | (defun +notmuch-tree-beginning (&optional arg) | ||
105 | "Move point to beginning of message or tree, depending on ARG." | ||
106 | (interactive "P") | ||
107 | (cond | ||
108 | ((and (window-live-p notmuch-tree-message-window) | ||
109 | (not arg)) | ||
110 | (with-selected-window notmuch-tree-message-window | ||
111 | (beginning-of-buffer))) | ||
112 | (:else (beginning-of-buffer)))) | ||
113 | |||
114 | (defun +notmuch-tree-end (&optional arg) | ||
115 | "Move point to end of message or tree, depending on ARG." | ||
116 | (interactive "P") | ||
117 | (cond | ||
118 | ((and (window-live-p notmuch-tree-message-window) | ||
119 | (not arg)) | ||
120 | (with-selected-window notmuch-tree-message-window | ||
121 | (end-of-buffer))) | ||
122 | (:else (end-of-buffer)))) | ||
123 | |||
124 | (defun +notmuch-make-saved-search (name key search-type &rest queries) | ||
125 | "Wrapper to ease `notmuch-saved-searches' defining. | ||
126 | NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in | ||
127 | `notmuch-saved-searches', which see. QUERIES are all concatenated together with | ||
128 | AND. If QUERIES is prepended with more keyword arguments, those are added to | ||
129 | the saved search as well." | ||
130 | (declare (indent 3)) | ||
131 | (let (extra-keywords) | ||
132 | (while (keywordp (car queries)) | ||
133 | (push (cadr queries) extra-keywords) | ||
134 | (push (car queries) extra-keywords) | ||
135 | (setf queries (cddr queries))) | ||
136 | (add-to-list 'notmuch-saved-searches | ||
137 | (append | ||
138 | (list :name name | ||
139 | :key key | ||
140 | :search-type search-type | ||
141 | :query (apply #'+notmuch-query-concat queries)) | ||
142 | (reverse extra-keywords)) | ||
143 | :append | ||
144 | (lambda (a b) | ||
145 | (equal (plist-get a :name) | ||
146 | (plist-get b :name)))))) | ||
147 | |||
148 | (provide '+notmuch) | ||
149 | ;;; +notmuch.el ends here | ||
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null | |||
@@ -1,49 +0,0 @@ | |||
1 | ;;; +org-capture.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | ;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll | ||
7 | ;; take a minute. Just let the compiler know that this variable exists. | ||
8 | (defvar org-capture-templates nil) | ||
9 | |||
10 | ;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573 | ||
11 | (defun +org-capture-template-define (description &rest args) | ||
12 | "Define a capture template. | ||
13 | Creates a list and adds it to `org-capture-templates', if it's | ||
14 | not already there. ARGS is a plist, which in addition to the | ||
15 | additional options `org-capture-templates' accepts (which see), | ||
16 | takes the following and puts them in the right spot: `:keys', | ||
17 | `:description', `:type', `:target', and `:template'." | ||
18 | (declare (indent 1)) | ||
19 | (let* ((keys (plist-get args :keys)) | ||
20 | (type (plist-get args :type)) | ||
21 | (target (plist-get args :target)) | ||
22 | (template (plist-get args :template)) | ||
23 | (template-value (append | ||
24 | (list description) | ||
25 | (when (or type target template) | ||
26 | (list (or type 'entry) target template)) | ||
27 | (cl-loop for i from 0 below (length args) by 2 | ||
28 | unless (member (nth i args) | ||
29 | '(:keys :description :type | ||
30 | :target :template)) | ||
31 | append (list (nth i args) | ||
32 | (plist-get args (nth i | ||
33 | args))))))) | ||
34 | ;; The only way I know how to do this properly (add a value to the end of | ||
35 | ;; the list, if it exists; otherwise update it) is to do this weird if-setf | ||
36 | ;; dance. | ||
37 | (if (seq-find (lambda (el) (equal (car el) keys)) | ||
38 | org-capture-templates) | ||
39 | (setf (alist-get keys org-capture-templates nil nil #'equal) | ||
40 | template-value) | ||
41 | (setf org-capture-templates | ||
42 | (append org-capture-templates | ||
43 | (list (cons keys template-value))))) | ||
44 | ;; Regardless of what we do, return the new value of | ||
45 | ;; `org-capture-templates'. | ||
46 | org-capture-templates)) | ||
47 | |||
48 | (provide '+org-capture) | ||
49 | ;;; +org-capture.el | ||
diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index a148bd8..0000000 --- a/lisp/+org.el +++ /dev/null | |||
@@ -1,309 +0,0 @@ | |||
1 | ;;; +org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'cl-lib) | ||
6 | (require 'seq) | ||
7 | |||
8 | ;;; Org-return DWIM | ||
9 | ;; https://github.com/alphapapa/unpackaged.el, | ||
10 | ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/ | ||
11 | |||
12 | (defun +org-element-descendant-of (type element) | ||
13 | "Return non-nil if ELEMENT is a descendant of TYPE. | ||
14 | TYPE should be an element type, like `item' or `paragraph'. | ||
15 | ELEMENT should be a list like that returned by `org-element-context'." | ||
16 | ;; MAYBE: Use `org-element-lineage'. | ||
17 | (when-let* ((parent (org-element-property :parent element))) | ||
18 | (or (eq type (car parent)) | ||
19 | (+org-element-descendant-of type parent)))) | ||
20 | |||
21 | (defun +org-return-dwim (&optional prefix) | ||
22 | "A helpful replacement for `org-return'. | ||
23 | With PREFIX, call `org-return'." | ||
24 | (interactive "P") | ||
25 | ;; Auto-fill if enabled | ||
26 | (when auto-fill-function | ||
27 | (dolist (func (ensure-list auto-fill-function)) | ||
28 | (funcall func))) | ||
29 | (cond | ||
30 | (prefix ; Handle prefix | ||
31 | (pcase prefix | ||
32 | ('(4) (newline)) | ||
33 | ('(16) (newline 2)) | ||
34 | (_ (newline prefix)))) | ||
35 | ((and org-return-follows-link ; Open link | ||
36 | (eq 'link (car (org-element-context)))) | ||
37 | (org-open-at-point-global)) | ||
38 | ((org-at-heading-p) ; Open a line after a heading | ||
39 | (let ((heading-start (org-entry-beginning-position))) | ||
40 | (goto-char (org-entry-end-position)) | ||
41 | (cond ((and (org-at-heading-p) | ||
42 | (= heading-start (org-entry-beginning-position))) | ||
43 | ;; Entry ends on its heading, so add 2 newlines | ||
44 | (end-of-line) | ||
45 | (newline 2)) | ||
46 | (t | ||
47 | ;; Entry ends after its heading, so back up | ||
48 | (forward-line -1) | ||
49 | (end-of-line) | ||
50 | (when (org-at-heading-p) | ||
51 | (forward-line) | ||
52 | (newline) | ||
53 | (forward-line -1)) | ||
54 | (while (not (looking-back (rx (repeat 3 (seq (optional blank) "\n"))) | ||
55 | nil)) | ||
56 | (newline)) | ||
57 | (forward-line -1))))) | ||
58 | ((org-at-item-checkbox-p) ; Insert a new checkbox item | ||
59 | (end-of-line) | ||
60 | (org-insert-todo-heading nil)) | ||
61 | ((org-in-item-p) ; Insert a new list item | ||
62 | (let* ((context (org-element-context)) | ||
63 | (first-item-p (eq 'plain-list (car context))) | ||
64 | (itemp (eq 'item (car context))) | ||
65 | (emptyp (or | ||
66 | ;; This (regular) list item is empty | ||
67 | (eq (org-element-property :contents-begin context) | ||
68 | (org-element-property :contents-end context)) | ||
69 | ;; This (definition) list item is empty | ||
70 | (looking-at " *::"))) | ||
71 | (item-child-p (+org-element-descendant-of 'item context))) | ||
72 | (cond ((and itemp emptyp) | ||
73 | (delete-region (line-beginning-position) (line-end-position)) | ||
74 | (newline)) | ||
75 | ((or first-item-p | ||
76 | (and itemp (not emptyp)) | ||
77 | item-child-p) | ||
78 | (org-end-of-item) | ||
79 | (org-insert-item)) | ||
80 | (t | ||
81 | (delete-region (line-beginning-position) (line-end-position)) | ||
82 | (newline))))) | ||
83 | ((and (fboundp 'org-inlinetask-in-task-p) ; Don't insert a new heading with | ||
84 | (org-inlinetask-in-task-p)) ; inline tasks | ||
85 | (org-return)) | ||
86 | ((org-at-table-p) ; Insert a new org-table row | ||
87 | (cond ((save-excursion | ||
88 | (beginning-of-line) | ||
89 | (cl-loop with end = (line-end-position) | ||
90 | for cell = (org-element-table-cell-parser) | ||
91 | always (equal (org-element-property :contents-begin cell) | ||
92 | (org-element-property :contents-end cell)) | ||
93 | while (re-search-forward "|" end t))) | ||
94 | ;; Empty row: end the table | ||
95 | (delete-region (line-beginning-position) (line-end-position)) | ||
96 | (org-return)) | ||
97 | (t | ||
98 | ;; Non-empty row | ||
99 | (org-return)))) | ||
100 | (t ; Otherwise---just call `org-return'. | ||
101 | (org-return)))) | ||
102 | |||
103 | (defun +org-table-copy-down|+org-return-dwim (&optional n) | ||
104 | "Call `org-table-copy-down' or `+org-return' depending on context." | ||
105 | (interactive "P") | ||
106 | (if (org-table-check-inside-data-field 'noerror) | ||
107 | (org-table-copy-down (or n 1)) | ||
108 | (+org-return-dwim n))) | ||
109 | |||
110 | |||
111 | ;;; A ... different ... `org-open-at-point-dwim' | ||
112 | ;; I honestly don't remember what the difference is between this and the | ||
113 | ;; O.G. one is.. hopefully this one fixes annoying stupid problems. | ||
114 | |||
115 | (defun +org-open-at-point-dwim (&optional arg) | ||
116 | "Open thing at point, or if there isn't something, list things." | ||
117 | (interactive "P") | ||
118 | (save-excursion | ||
119 | (let* ((this-char-type (org-element-type (org-element-context))) | ||
120 | (prev-char-type (ignore-errors | ||
121 | (save-excursion | ||
122 | (backward-char) | ||
123 | (org-element-type (org-element-context))))) | ||
124 | (types '(citation citation-reference clock comment comment-block | ||
125 | footnote-definition footnote-reference headline | ||
126 | inline-src-block inlinetask keyword link | ||
127 | node-property planning src-block timestamp)) | ||
128 | (type this-char-type)) | ||
129 | (when (and (memq this-char-type types) (memq prev-char-type types)) | ||
130 | (backward-char) | ||
131 | (setq type prev-char-type)) ; what the fuckckckckck | ||
132 | ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well, | ||
133 | ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since | ||
134 | ;; I really just want to open the list of URLs /most of the time/, I'm | ||
135 | ;; fixing it like this instead. | ||
136 | (unless (and (memq type types) | ||
137 | (ignore-errors (org-open-at-point arg) | ||
138 | t)) | ||
139 | (while (not | ||
140 | (progn | ||
141 | (org-back-to-heading) | ||
142 | (car (org-offer-links-in-entry (current-buffer) (point) 1)))) | ||
143 | (org-up-heading-all 1)) | ||
144 | (org-open-at-point arg))))) | ||
145 | |||
146 | ;;; Faces | ||
147 | ;; see `org-emphasis-alist' | ||
148 | |||
149 | (defface org-bold '((t (:weight bold))) | ||
150 | "Bold face in `org-mode' documents.") | ||
151 | |||
152 | (defface org-italic '((t (:slant italic))) | ||
153 | "Italic face in `org-mode' documents.") | ||
154 | |||
155 | (defface org-underline '((t (:underline t))) | ||
156 | "Underline face in `org-mode' documents.") | ||
157 | |||
158 | (defface org-strikethrough '((t (:strike-through t))) | ||
159 | "Strike-through face for `org-mode' documents.") | ||
160 | |||
161 | ;;; Unsmartify | ||
162 | |||
163 | (defun +org-unsmartify () | ||
164 | "Replace \"smart\" punctuation with their \"dumb\" counterparts." | ||
165 | (interactive) | ||
166 | (save-excursion | ||
167 | (goto-char (point-min)) | ||
168 | (while (re-search-forward "[“”‘’–—]" nil t) | ||
169 | (let ((replace (pcase (match-string 0) | ||
170 | ((or "“" "”") "\"") | ||
171 | ((or "‘" "’") "'") | ||
172 | ("–" "--") | ||
173 | ("—" "---")))) | ||
174 | (replace-match replace nil nil))))) | ||
175 | |||
176 | ;;; Copy org trees as HTML | ||
177 | ;; Thanks to Oleh Krehel: | ||
178 | ;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard | ||
179 | |||
180 | (defun +org-export-clip-to-html | ||
181 | (&optional async subtreep visible-only body-only ext-plist post-process) | ||
182 | "Export region to HTML, and copy it to the clipboard. | ||
183 | Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST, | ||
184 | and POST-PROCESS are passed to `org-export-to-file'." | ||
185 | (interactive) ; XXX: hould this be interactive? | ||
186 | (message "Exporting Org to HTML...") | ||
187 | (let ((org-tmp-file "/tmp/org.html")) | ||
188 | (org-export-to-file 'html org-tmp-file | ||
189 | async subtreep visible-only body-only ext-plist post-process) | ||
190 | ;; XXX: figure out which clipboard to use, or use something in Emacs | ||
191 | (start-process "xclip" "*xclip*" | ||
192 | "xclip" "-verbose" | ||
193 | "-i" org-tmp-file | ||
194 | "-t" "text/html" | ||
195 | "-selection" "clipboard")) | ||
196 | (message "Exporting Org to HTML...done.")) | ||
197 | |||
198 | ;; Specialized functions | ||
199 | (defun +org-export-clip-subtree-to-html () | ||
200 | "Export current subtree to HTML." | ||
201 | (interactive) | ||
202 | (+org-export-clip-to-html nil :subtree)) | ||
203 | |||
204 | ;;; Hide drawers on save, except the currently-expanded one | ||
205 | |||
206 | (defun +org-hide-drawers-except-point () | ||
207 | "Hide all drawers except for the one point is in." | ||
208 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
209 | (let ((pt (point)) | ||
210 | (begin (point-min)) | ||
211 | (end (point-max))) | ||
212 | (save-excursion | ||
213 | (goto-char begin) | ||
214 | (while (and (< (point) end) | ||
215 | (re-search-forward org-drawer-regexp end t)) | ||
216 | (if (org-fold-folded-p nil 'drawer) | ||
217 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
218 | (let* ((drawer (org-element-at-point)) | ||
219 | (type (org-element-type drawer)) | ||
220 | (el-begin (org-element-property :begin drawer)) | ||
221 | (el-end (org-element-property :end drawer))) | ||
222 | (when (memq type '(drawer property-drawer)) | ||
223 | (org-fold-hide-drawer-toggle | ||
224 | (if (< el-begin pt el-end) 'off 'on) | ||
225 | nil drawer) | ||
226 | (goto-char el-end)))))))) | ||
227 | |||
228 | ;;; Define `ol' link types | ||
229 | |||
230 | (defmacro +org-link-define-type (type args &rest body) | ||
231 | "Define an org link TYPE. | ||
232 | A function named `+org-link-TYPE-open' will be created, with ARGS | ||
233 | as its arguments and BODY as its body. BODY can be blank, in | ||
234 | which case the user will be messaged (This is a good do-nothing | ||
235 | effect for exporting link types)." | ||
236 | (declare (indent 2) | ||
237 | (doc-string 3) | ||
238 | (debug (sexp sexp def-body))) | ||
239 | (let ((fn (intern (format "+org-link-%s-open" type))) | ||
240 | (body (or body `((message ,(format "%S: %%S" type) | ||
241 | ,(car args))))) | ||
242 | (type-string (format "%S" type))) | ||
243 | `(prog1 | ||
244 | (defun ,fn ,args ,@body) | ||
245 | (org-link-set-parameters ,type-string :follow #',fn)))) | ||
246 | |||
247 | ;;; Skip some files in `org-agenda' | ||
248 | |||
249 | (defcustom org-agenda-file-skip-regexp nil | ||
250 | "Files matching this regexp are removed from `org-agenda-files'." | ||
251 | :group 'org-agenda) | ||
252 | |||
253 | (defun org-agenda-files@skip-regexp (files) | ||
254 | "`:filter-return' advice to filter files in `org-agenda-file-skip-regexp'." | ||
255 | (when org-agenda-file-skip-regexp | ||
256 | (setq files | ||
257 | (seq-remove (lambda (file) | ||
258 | (string-match-p | ||
259 | org-agenda-file-skip-regexp file)) | ||
260 | files))) | ||
261 | files) | ||
262 | |||
263 | ;;; Prompt for stuff | ||
264 | |||
265 | (defun +org-prompt-for-property (property &optional clipboardp insert list) | ||
266 | "Prompt for PROPERTY and return a properly-formatted string. | ||
267 | Pre-fill the input with clipboard contents if they match CLIPBOARDP. If | ||
268 | CLIPBOARDP is nil or missing, don't pre-fill. | ||
269 | |||
270 | If INSERT is non-nil, insert the property into the property | ||
271 | drawer of the current org tree. | ||
272 | |||
273 | If LIST is non-nil, return the result as a list instead of a string." | ||
274 | (let* ((kill (current-kill 0)) | ||
275 | (value (read-string (concat property ": ") | ||
276 | (when (and clipboardp | ||
277 | (or (eq clipboardp t) | ||
278 | (funcall clipboardp kill))) | ||
279 | kill)))) | ||
280 | (when insert | ||
281 | (org-set-property property value)) | ||
282 | (if list | ||
283 | (list property value) | ||
284 | (format ":%s: %s" property value)))) | ||
285 | |||
286 | (defun +org-prompt-tags (&optional prompt global) | ||
287 | (let* ((buffer (org-capture-get :buffer)) | ||
288 | (file (buffer-file-name (or (buffer-base-buffer buffer) buffer))) | ||
289 | (org-last-tags-completion-table | ||
290 | (org-global-tags-completion-table | ||
291 | (if global (org-agenda-files) (list file)))) | ||
292 | (org-add-colon-after-tag-completion t) | ||
293 | (ins (mapconcat | ||
294 | #'identity | ||
295 | (let ((crm-separator "[ \t]*:[ \t]*")) | ||
296 | (completing-read-multiple | ||
297 | (or prompt "Tags: ") | ||
298 | org-last-tags-completion-table nil nil nil | ||
299 | 'org-tags-history)) | ||
300 | ":"))) | ||
301 | (when (org-string-nw-p ins) | ||
302 | (prog1 (concat | ||
303 | (unless (eq (char-before) ?:) ":") | ||
304 | ins | ||
305 | (unless (eq (char-after) ?:) ":")) | ||
306 | (when (org-at-heading-p) (org-align-tags)))))) | ||
307 | |||
308 | (provide '+org) | ||
309 | ;;; +org.el ends here | ||
diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index ab176b8..0000000 --- a/lisp/+paredit.el +++ /dev/null | |||
@@ -1,26 +0,0 @@ | |||
1 | ;;; +paredit.el -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Fixing unquote-splicing behaviour with Paredit | ||
4 | ;; https://www.n16f.net/blog/fixing-unquote-splicing-behaviour-with-paredit/ | ||
5 | |||
6 | (require 'paredit) | ||
7 | (require 'seq) | ||
8 | |||
9 | (defcustom +paredit-no-space-prefixes '(",@") | ||
10 | "Prefix strings to not insert a space after in `paredit'." | ||
11 | :group 'paredit | ||
12 | :type '(repeat string)) | ||
13 | |||
14 | (defun +paredit-space-for-delimiter (endp delimiter) | ||
15 | (let ((point (point))) | ||
16 | (or endp | ||
17 | (seq-every-p | ||
18 | (lambda (prefix) | ||
19 | (and (> point (length prefix)) | ||
20 | (let ((start (- point (length prefix))) | ||
21 | (end point)) | ||
22 | (not (string= (buffer-substring start end) prefix))))) | ||
23 | +paredit-no-space-prefixes)))) | ||
24 | |||
25 | (provide '+paredit) | ||
26 | ;;; +paredit.el ends here | ||
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 6defda7..0000000 --- a/lisp/+titlecase.el +++ /dev/null | |||
@@ -1,34 +0,0 @@ | |||
1 | ;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;;; Code: | ||
6 | |||
7 | (require 'titlecase) | ||
8 | |||
9 | (defun +titlecase-sentence-style-dwim (&optional arg) | ||
10 | "Titlecase a sentence. | ||
11 | With prefix ARG, toggle the value of | ||
12 | `titlecase-downcase-sentences' before sentence-casing." | ||
13 | (interactive "P") | ||
14 | (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences) | ||
15 | titlecase-downcase-sentences))) | ||
16 | (titlecase-dwim 'sentence))) | ||
17 | |||
18 | (defun +titlecase-org-headings () | ||
19 | (interactive) | ||
20 | (save-excursion | ||
21 | (goto-char (point-min)) | ||
22 | ;; See also `org-map-tree'. I'm not using that function because I want to | ||
23 | ;; skip the first headline. A better solution would be to patch | ||
24 | ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). | ||
25 | (let ((level (funcall outline-level)) | ||
26 | (org-special-ctrl-a/e t)) | ||
27 | (while (and (progn (outline-next-heading) | ||
28 | (> (funcall outline-level) level)) | ||
29 | (not (eobp))) | ||
30 | (titlecase-region (org-beginning-of-line) | ||
31 | (org-end-of-line)))))) | ||
32 | |||
33 | (provide '+titlecase) | ||
34 | ;;; +titlecase.el ends here | ||
diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el deleted file mode 100644 index e4c9e14..0000000 --- a/lisp/acdw-defaults.el +++ /dev/null | |||
@@ -1,295 +0,0 @@ | |||
1 | ;;; acdw-defaults.el --- measured defaults for Emacs -*- lexical-binding: t -*- | ||
2 | ;; by C. Duckworth <acdw@acdw.net> | ||
3 | |||
4 | ;;; Commentary: | ||
5 | |||
6 | ;; I find myself copy-pasting a lot of "boilerplate" type code when | ||
7 | ;; bankrupting my Emacs config and starting afresh. Instead of doing | ||
8 | ;; that, I'm putting it here, where it'll be easier to include in my | ||
9 | ;; config. | ||
10 | |||
11 | ;; Of course, some might say I could just ... stop bankrupting my | ||
12 | ;; Emacs. But like, why would I want to? | ||
13 | |||
14 | ;;; Code: | ||
15 | |||
16 | (require 'seq) | ||
17 | |||
18 | (defvar default-ring-max 256 | ||
19 | "Default maximum for ring variables.") | ||
20 | |||
21 | (unless (boundp 'use-short-answers) | ||
22 | (fset 'yes-or-no-p 'y-or-n-p)) | ||
23 | |||
24 | (setc async-shell-command-buffer 'new-buffer | ||
25 | async-shell-command-display-buffer nil | ||
26 | auto-hscroll-mode t | ||
27 | auto-window-vscroll nil | ||
28 | cursor-in-non-selected-windows 'hollow | ||
29 | cursor-type 'bar | ||
30 | echo-keystrokes 0.01 | ||
31 | fast-but-imprecise-scrolling t | ||
32 | fill-column 80 | ||
33 | global-mark-ring-max default-ring-max | ||
34 | hscroll-margin 1 | ||
35 | hscroll-step 1 | ||
36 | inhibit-startup-screen t | ||
37 | initial-buffer-choice t | ||
38 | kill-do-not-save-duplicates t | ||
39 | kill-read-only-ok t | ||
40 | kill-ring-max default-ring-max | ||
41 | kmacro-ring-max default-ring-max | ||
42 | mark-ring-max default-ring-max | ||
43 | read-answer-short t | ||
44 | read-process-output-max (* 10 1024 1024) | ||
45 | ring-bell-function #'ignore | ||
46 | save-interprogram-paste-before-kill t | ||
47 | scroll-conservatively 25 | ||
48 | scroll-margin 0 | ||
49 | scroll-preserve-screen-position 1 | ||
50 | scroll-step 1 | ||
51 | sentence-end-double-space t | ||
52 | set-mark-command-repeat-pop t | ||
53 | tab-width 8 | ||
54 | undo-limit (* 10 1024 1024) | ||
55 | use-dialog-box nil | ||
56 | use-file-dialog nil | ||
57 | use-short-answers t | ||
58 | window-resize-pixelwise t | ||
59 | yank-pop-change-selection t) | ||
60 | |||
61 | ;;; Encodings | ||
62 | |||
63 | ;; Allegedly, this is the only one you need... | ||
64 | (set-language-environment "UTF-8") | ||
65 | ;; But I still set all of these, for fun. | ||
66 | (setq-default buffer-file-coding-system 'utf-8-unix | ||
67 | coding-system-for-read 'utf-8-unix | ||
68 | coding-system-for-write 'utf-8-unix | ||
69 | default-process-coding-system '(utf-8-unix . utf-8-unix) | ||
70 | locale-coding-system 'utf-8-unix | ||
71 | x-select-request-type '(UTF8_STRING | ||
72 | COMPOUND_TEXT | ||
73 | TEXT | ||
74 | STRING)) | ||
75 | |||
76 | (set-charset-priority 'unicode) | ||
77 | (prefer-coding-system 'utf-8-unix) | ||
78 | (set-default-coding-systems 'utf-8-unix) | ||
79 | (set-terminal-coding-system 'utf-8-unix) | ||
80 | (set-keyboard-coding-system 'utf-8-unix) | ||
81 | |||
82 | (pcase system-type | ||
83 | ((or 'ms-dos 'windows-nt) | ||
84 | (set-clipboard-coding-system 'utf-16-le) | ||
85 | (set-selection-coding-system 'utf-16-le)) | ||
86 | (_ | ||
87 | (set-selection-coding-system 'utf-8) | ||
88 | (set-clipboard-coding-system 'utf-8))) | ||
89 | |||
90 | ;;; Modes | ||
91 | |||
92 | (dolist (enable-mode '(;; Enable these modes on startup | ||
93 | delete-selection-mode | ||
94 | global-so-long-mode | ||
95 | )) | ||
96 | (funcall enable-mode +1)) | ||
97 | |||
98 | (dolist (disable-mode '(;; Disable these modes on startup | ||
99 | horizontal-scroll-bar-mode | ||
100 | menu-bar-mode | ||
101 | scroll-bar-mode | ||
102 | tool-bar-mode | ||
103 | tooltip-mode | ||
104 | )) | ||
105 | (funcall disable-mode -1)) | ||
106 | |||
107 | (deftheme use-package) | ||
108 | (enable-theme 'use-package) | ||
109 | |||
110 | ;;; Internal packages | ||
111 | |||
112 | (when (require 'abbrev nil t) | ||
113 | (custom-theme-set-variables 'use-package | ||
114 | '(abbrev-file-name (sync/ "abbrev.el")) | ||
115 | '(save-abbrevs 'silently))) | ||
116 | |||
117 | (when (require 'autorevert nil t) | ||
118 | (custom-theme-set-variables 'use-package | ||
119 | '(auto-revert-verbose nil) | ||
120 | '(global-auto-revert-non-file-buffers t)) | ||
121 | (global-auto-revert-mode +1)) | ||
122 | |||
123 | (when (require 'comp nil t) | ||
124 | (custom-theme-set-variables 'use-package | ||
125 | '(native-comp-async-report-warnings-errors 'silent) | ||
126 | '(native-comp-deferred-compilation t))) | ||
127 | |||
128 | (when (require 'custom nil t) | ||
129 | (custom-theme-set-variables 'use-package | ||
130 | '(custom-file (etc/ "custom.el")))) | ||
131 | |||
132 | (when (require 'ediff nil t) | ||
133 | (custom-theme-set-variables 'use-package | ||
134 | '(ediff-window-setup-function #'ediff-setup-windows-plain))) | ||
135 | |||
136 | (when (require 'eldoc nil t) | ||
137 | (custom-theme-set-variables 'use-package | ||
138 | '(eldoc-echo-area-use-multiline-p nil) | ||
139 | '(eldoc-idle-delay 0.1))) | ||
140 | |||
141 | (when (require 'executable nil t) | ||
142 | (custom-theme-set-variables 'use-package | ||
143 | '(executable-prefix-env t))) | ||
144 | |||
145 | (when (require 'files nil t) | ||
146 | (custom-theme-set-variables 'use-package | ||
147 | '(auto-save-default nil) | ||
148 | '(auto-save-interval 1) | ||
149 | '(auto-save-no-message t) | ||
150 | '(auto-save-timeout 1) | ||
151 | '(auto-save-visited-interval 1) | ||
152 | '(backup-by-copying t) | ||
153 | '(create-lockfiles nil) | ||
154 | '(delete-old-versions t) | ||
155 | '(find-file-visit-truename t) | ||
156 | '(kept-new-versions 8) | ||
157 | '(kept-old-versions 8) | ||
158 | '(mode-require-final-newline t) | ||
159 | '(version-control t) | ||
160 | '(view-read-only t)) | ||
161 | (dolist (h/f | ||
162 | '((after-save-hook . executable-make-buffer-file-executable-if-script-p) | ||
163 | (find-file-not-found-functions . create-missing-directories) | ||
164 | (find-file-hook . +vc-off@remote))) | ||
165 | (add-hook (car h/f) (cdr h/f))) | ||
166 | (auto-save-visited-mode)) | ||
167 | |||
168 | (when (require 'frame nil t) | ||
169 | (custom-theme-set-variables 'use-package | ||
170 | '(blink-cursor-blinks 1) | ||
171 | '(blink-cursor-interval 0.25) | ||
172 | '(blink-cursor-delay 0.25)) | ||
173 | (blink-cursor-mode)) | ||
174 | |||
175 | (when (require 'goto-addr nil t) | ||
176 | (if (fboundp 'global-goto-address-mode) | ||
177 | (global-goto-address-mode +1) | ||
178 | (add-hook 'after-change-major-mode-hook 'goto-address-mode))) | ||
179 | |||
180 | (when (require 'ibuffer nil t) | ||
181 | (global-set-key (kbd "C-x C-b") #'ibuffer) | ||
182 | (add-hook 'ibuffer-mode-hook #'hl-line-mode)) | ||
183 | |||
184 | (when (require 'image nil t) | ||
185 | (custom-theme-set-variables 'use-package | ||
186 | '(image-use-external-converter | ||
187 | (seq-some #'executable-find '("convert" "gm" "ffmpeg"))))) | ||
188 | |||
189 | (when (require 'imenu nil t) | ||
190 | (custom-theme-set-variables 'use-package | ||
191 | '(imenu-auto-rescan t))) | ||
192 | |||
193 | (when (require 'isearch nil t) | ||
194 | (custom-theme-set-variables 'use-package | ||
195 | '(regexp-search-ring-max default-ring-max) | ||
196 | '(search-ring-max default-ring-max))) | ||
197 | |||
198 | (when (require 'minibuffer nil t) | ||
199 | (custom-theme-set-variables 'use-package | ||
200 | '(completion-category-defaults nil) | ||
201 | '(completion-category-overrides '((file (styles partial-completion)))) | ||
202 | '(completion-ignore-case t) | ||
203 | '(completion-styles '(substring partial-completion)) | ||
204 | '(enable-recursive-minibuffers t) | ||
205 | '(file-name-shadow-properties '(invisible t intangible t)) | ||
206 | '(minibuffer-eldef-shorten-default t) | ||
207 | '(minibuffer-prompt-properties '( read-only t | ||
208 | cursor-intangible t | ||
209 | face minibuffer-prompt)) | ||
210 | '(read-buffer-completion-ignore-case t)) | ||
211 | (file-name-shadow-mode) | ||
212 | (minibuffer-electric-default-mode)) | ||
213 | |||
214 | (when (require 'mouse nil t) | ||
215 | (custom-theme-set-variables 'use-package | ||
216 | '(mouse-drag-copy-region t) | ||
217 | '(mouse-wheel-progressive-speed nil) | ||
218 | '(mouse-yank-at-point t))) | ||
219 | |||
220 | (when (require 'paren nil t) | ||
221 | (custom-theme-set-variables 'use-package | ||
222 | '(show-paren-delay 0.01) | ||
223 | '(show-paren-style 'parenthesis) | ||
224 | '(show-paren-when-point-in-periphery t) | ||
225 | '(show-paren-when-point-inside-paren t)) | ||
226 | (show-paren-mode) | ||
227 | (electric-pair-mode)) | ||
228 | |||
229 | (when (require 'recentf nil t) | ||
230 | (custom-theme-set-variables 'use-package | ||
231 | '(recentf-save-file (var/ "recentf.el")) | ||
232 | '(recentf-max-menu-items default-ring-max) | ||
233 | '(recentf-max-saved-items nil) | ||
234 | '(recentf-auto-cleanup 'mode)) | ||
235 | (add-to-list 'recentf-exclude etc/) | ||
236 | (add-to-list 'recentf-exclude var/) | ||
237 | (add-to-list 'recentf-exclude cache/) | ||
238 | (add-to-list 'recentf-exclude "-autoloads.el\\'") | ||
239 | (recentf-mode +1)) | ||
240 | |||
241 | (when (require 'savehist nil t) | ||
242 | (custom-theme-set-variables 'use-package | ||
243 | '(history-length 1024) | ||
244 | '(history-delete-duplicates t) | ||
245 | '(savehist-file (var/ "savehist.el")) | ||
246 | '(savehist-save-minibuffer-history t) | ||
247 | '(savehist-autosave-interval 30) | ||
248 | ;; Other variables --- don't truncate any of these. | ||
249 | ;; `add-to-history' uses the values of these variables unless | ||
250 | ;; they're nil, in which case it falls back to `history-length'. | ||
251 | '(kill-ring-max default-ring-max) | ||
252 | '(mark-ring-max default-ring-max) | ||
253 | '(global-mark-ring-max default-ring-max) | ||
254 | '(regexp-search-ring-max default-ring-max) | ||
255 | '(search-ring-max default-ring-max) | ||
256 | '(kmacro-ring-max default-ring-max) | ||
257 | '(eww-history-limit default-ring-max)) | ||
258 | (dolist (var '(global-mark-ring | ||
259 | mark-ring | ||
260 | kill-ring | ||
261 | kmacro-ring | ||
262 | regexp-search-ring | ||
263 | search-ring)) | ||
264 | (add-to-list 'savehist-additional-variables var)) | ||
265 | (savehist-mode +1)) | ||
266 | |||
267 | (when (require 'saveplace nil t) | ||
268 | (custom-theme-set-variables 'use-package | ||
269 | '(save-place-file (var/ "places.el")) | ||
270 | '(save-place-forget-unreadable-files (eq system-type 'gnu/linux))) | ||
271 | (save-place-mode 1)) | ||
272 | |||
273 | (when (require 'uniquify nil t) | ||
274 | (custom-theme-set-variables 'use-package | ||
275 | '(uniquify-after-kill-buffer-p t) | ||
276 | '(uniquify-buffer-name-style 'forward) | ||
277 | '(uniquify-ignore-buffers-re "^\\*") | ||
278 | '(uniquify-separator path-separator))) | ||
279 | |||
280 | (when (require 'vc nil t) | ||
281 | (custom-theme-set-variables 'use-package | ||
282 | '(vc-follow-symlinks t) | ||
283 | '(vc-make-backup-files t))) | ||
284 | |||
285 | (when (require 'window nil t) | ||
286 | (custom-theme-set-variables 'use-package | ||
287 | '(recenter-positions '(top 2 middle bottom)))) | ||
288 | |||
289 | ;;; New features | ||
290 | |||
291 | (when (fboundp 'pixel-scroll-precision-mode) | ||
292 | (pixel-scroll-precision-mode)) | ||
293 | |||
294 | (provide 'acdw-defaults) | ||
295 | ;;; acdw-defaults.el ends here | ||
diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el deleted file mode 100644 index ed41a61..0000000 --- a/lisp/acdw-funs.el +++ /dev/null | |||
@@ -1,262 +0,0 @@ | |||
1 | ;;; acdw-funs.el --- extra functions -*- lexical-binding: t -*- | ||
2 | |||
3 | |||
4 | ;;; Cribs from CRUX --- Advice | ||
5 | ;; https://github.com/bbatsov/crux | ||
6 | |||
7 | ;; All of these should go `:before' the function they're advising | ||
8 | (defun advise-region-or-buffer (&rest _) | ||
9 | "`:before' advice to work on the active region or whole buffer. | ||
10 | See also `with-region-or-buffer'." | ||
11 | (interactive (if mark-active | ||
12 | (list (region-beginning) (region-end)) | ||
13 | (list (point-min) (point-max))))) | ||
14 | |||
15 | (defun advise-region-or-line (&rest _) | ||
16 | "`:before' advice to work on the active region or whole line. | ||
17 | See also `with-region-or-line'." | ||
18 | (interactive (if mark-active | ||
19 | (list (region-beginning) (region-end)) | ||
20 | (list (line-beginning-position) (line-end-position))))) | ||
21 | |||
22 | (defun advise-region-or-to-eol (&rest _) | ||
23 | "`:before' advice to work on the active region or to end of line. | ||
24 | See also `with-region-or-to-eol'." | ||
25 | (INTERACTIVE (if mark-active | ||
26 | (list (region-beginning) (region-end)) | ||
27 | (list (point) (line-end-position))))) | ||
28 | |||
29 | |||
30 | ;;; Other functions and whatnot | ||
31 | |||
32 | (defun delete2 (list &rest elems) | ||
33 | "Delete each element of ELEMS, and the next item, from LIST." | ||
34 | (let ((r nil)) | ||
35 | (while (consp list) | ||
36 | (if (member (car list) elems) | ||
37 | (setf list (cdr list)) | ||
38 | (setf r (cons (car list) r))) | ||
39 | (setf list (cdr list))) | ||
40 | (reverse r))) | ||
41 | |||
42 | (unless (fboundp 'ensure-list) | ||
43 | (defun ensure-list (object) | ||
44 | "Return OBJECT as a list. | ||
45 | If OBJECT is already a list, return OBJECT itself. If it's | ||
46 | not a list, return a one-element list containing OBJECT." | ||
47 | (if (listp object) | ||
48 | object | ||
49 | (list object)))) | ||
50 | |||
51 | (defun +require (&rest features) | ||
52 | "Require FEATURES, plus my extras. | ||
53 | Each feature can be an atom (the feature name) or a list of the form | ||
54 | (FEATURE &optional FILENAME NOERROR), which is passed directly to | ||
55 | `require'. My extras are in lisp/ and named +FEATURE, so this | ||
56 | function will `require' them too---but not error if they don't | ||
57 | exist." | ||
58 | (dolist (feat features) | ||
59 | (apply #'require (ensure-list feat)) | ||
60 | (require (intern (format "+%s" feat)) nil :noerror))) | ||
61 | |||
62 | ;;; Improvements to default functions | ||
63 | |||
64 | (defun +save-buffers-kill-terminal (arg) | ||
65 | "Delete the current frame, or quit Emacs. | ||
66 | This function is my customization of `save-buffers-kill-terminal'." | ||
67 | (interactive "P") | ||
68 | (cond (arg (delete-frame nil :force)) | ||
69 | ((= 1 (length (frame-list))) | ||
70 | (and (yes-or-no-p "Kill emacs? ") | ||
71 | (save-buffers-kill-emacs t))) | ||
72 | (:else (delete-frame)))) | ||
73 | |||
74 | (defun really-quit-emacs (arg) | ||
75 | "Really, actually quit Emacs." | ||
76 | (interactive "P") | ||
77 | (cond (arg (save-buffers-kill-emacs t)) | ||
78 | (:else (save-buffers-kill-terminal t)))) | ||
79 | |||
80 | (defun +cycle-spacing (&optional n) | ||
81 | ;; `cycle-spacing' is wildly different in 29.1 over 28. | ||
82 | "Negate N argument on `cycle-spacing'. | ||
83 | That is, with a positive N, deletes newlines as well, leaving -N | ||
84 | spaces. If N is negative, it will not delete newlines and leave | ||
85 | N spaces." | ||
86 | (interactive "*p") | ||
87 | (cycle-spacing (- n))) | ||
88 | |||
89 | (defun delete-window|bury-buffer () | ||
90 | "Delete the current window, or bury the current buffer. | ||
91 | If the current window is the only window, bury the buffer." | ||
92 | (interactive) | ||
93 | (condition-case e | ||
94 | (delete-window) | ||
95 | (t (bury-buffer)))) | ||
96 | |||
97 | (defun other-window|switch-buffer (arg) | ||
98 | "Call `other-window' or `switch-buffer' depending on windows. | ||
99 | When called with prefix ARG, unconditionally switch buffer." | ||
100 | (interactive "P") | ||
101 | (if (or arg (one-window-p)) | ||
102 | (switch-to-buffer (other-buffer) nil t) | ||
103 | (other-window 1))) | ||
104 | |||
105 | (defun open-paragraph (&optional arg) | ||
106 | "Open a paragraph after paragraph at point. | ||
107 | A paragraph is defined as continguous non-empty lines of text | ||
108 | surrounded by empty lines, so opening a paragraph means to make | ||
109 | three blank lines, then place the point on the second one. | ||
110 | |||
111 | Called with prefix ARG, open a paragraph before point." | ||
112 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
113 | (interactive "*P") | ||
114 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
115 | ;; that's weird with org, and I'm guessing other modes too. | ||
116 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
117 | (while (and (not (looking-at "^$")) | ||
118 | (= 0 (forward-line (if arg -1 +1))))) | ||
119 | (newline) | ||
120 | (when arg (newline) (forward-line -2)) | ||
121 | (delete-blank-lines) | ||
122 | (newline 2) | ||
123 | (previous-line)) | ||
124 | |||
125 | (defun +initial-buffer () | ||
126 | (if (equal (get-buffer "*Messages*") | ||
127 | (other-buffer)) | ||
128 | (get-buffer "*scratch*") | ||
129 | (other-buffer))) | ||
130 | |||
131 | (defun open-paragraph (&optional arg) | ||
132 | "Open a paragraph after paragraph at point. | ||
133 | A paragraph is defined as continguous non-empty lines of text | ||
134 | surrounded by empty lines, so opening a paragraph means to make | ||
135 | three blank lines, then place the point on the second one. | ||
136 | |||
137 | Called with prefix ARG, open a paragraph before point." | ||
138 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
139 | (interactive "*P") | ||
140 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
141 | ;; that's weird with org, and I'm guessing other modes too. | ||
142 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
143 | (while (and (not (looking-at "^$")) | ||
144 | (= 0 (forward-line (if arg -1 +1))))) | ||
145 | (newline) | ||
146 | (when arg (newline) (forward-line -2)) | ||
147 | (delete-blank-lines) | ||
148 | (newline 2) | ||
149 | (previous-line)) | ||
150 | |||
151 | (defun create-missing-directories () | ||
152 | "Automatically create missing directories when finding a file." | ||
153 | ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/ | ||
154 | (let ((target-dir (file-name-directory buffer-file-name))) | ||
155 | (unless (file-exists-p target-dir) | ||
156 | (make-directory target-dir t)))) | ||
157 | |||
158 | (defun +vc-off@remote () | ||
159 | (when (file-remote-p (buffer-file-name)) | ||
160 | (setq-local vc-handled-backends nil))) | ||
161 | |||
162 | (defun +auto-save-some-buffers (&rest _) | ||
163 | "Quietly run `save-some-buffers'." | ||
164 | (let ((inhibit-message t)) | ||
165 | (with-temp-message "" | ||
166 | (save-some-buffers t)))) | ||
167 | |||
168 | (defun comment-lines (str &optional comment-char) | ||
169 | "Comment each line of STR. | ||
170 | Returns the new, commented, string. | ||
171 | |||
172 | If COMMENT-CHAR is missing or nil, use `comment-start'." | ||
173 | (mapconcat (lambda (ln) | ||
174 | (concat (or comment-char comment-start) | ||
175 | ln)) | ||
176 | (string-lines str) | ||
177 | "\n")) | ||
178 | |||
179 | (defun clamp (value min max) | ||
180 | "Clamp VALUE between MIN and MAX." | ||
181 | (min max (max min value))) | ||
182 | |||
183 | (define-minor-mode truncate-lines-local-mode | ||
184 | "Truncate lines locally in a buffer." | ||
185 | :lighter " ..." | ||
186 | :group 'display | ||
187 | (setq-local truncate-lines truncate-lines-local-mode)) | ||
188 | |||
189 | (defun mapc-buffers (func &optional predicate) | ||
190 | "Map FUNC over buffers matching PREDICATE. | ||
191 | Both FUNC and PREDICATE will be executed with no arguments and in | ||
192 | the context of each buffer. | ||
193 | |||
194 | If PREDICATE is nil or not given, map FUNC over all buffers." | ||
195 | (cl-loop for buf being the buffers | ||
196 | do (with-current-buffer buf | ||
197 | (when (and predicate | ||
198 | (funcall predicate)) | ||
199 | (funcall func))))) | ||
200 | |||
201 | (defun mapc-buffers-modes (func &rest modes) | ||
202 | "Map FUNC over buffers derived from MODES. | ||
203 | FUNC will be executed with no arguments and in the context of | ||
204 | each buffer." | ||
205 | (mapc-buffers func | ||
206 | (lambda () | ||
207 | (apply #'derived-mode-p modes)))) | ||
208 | |||
209 | (defun ++concat (func strings) | ||
210 | "Concat STRINGS processed by FUNC. | ||
211 | Each of STRINGS can be a bare string or a list. Strings are | ||
212 | passed through as-is, but lists are passed to FUNC first as | ||
213 | arguments. Finally, all the resulting strings are `mapconcat'-ed | ||
214 | together. | ||
215 | |||
216 | As a special case, if `:separator' is the first of STRINGS, the | ||
217 | string following will be used as a separator. Otherwise, a | ||
218 | newline will be used." | ||
219 | (let (separator) | ||
220 | (when (eq (car strings) :separator) | ||
221 | (setq separator (cadr strings) | ||
222 | strings (cddr strings))) | ||
223 | (mapconcat (lambda (s) | ||
224 | (cond | ||
225 | ((listp s) (apply func s)) | ||
226 | ((stringp s) s) | ||
227 | (t (user-error "Bad argument: %S" s)))) | ||
228 | strings | ||
229 | (or separator "\n")))) | ||
230 | |||
231 | (defun nconcat (&rest strings) | ||
232 | "Concat STRINGS separated by SEPARATOR. | ||
233 | If `:separator' is the first of STRINGS, the next string will be used to | ||
234 | separate the rest of STRINGS." | ||
235 | (++concat #'concat strings)) | ||
236 | |||
237 | (defun format-concat (&rest strings) | ||
238 | "Concatenate formatted STRINGS. | ||
239 | Each of STRINGS can be a bare string or a list. Bare strings are passed as-is | ||
240 | to `mapconcat' for concatenation and separation. Lists, however, are passed to | ||
241 | `format' first. | ||
242 | |||
243 | If `:separator' is the first of STRINGS, the next string will be | ||
244 | used as a separator." | ||
245 | (++concat #'format strings)) | ||
246 | |||
247 | (defun choose-executable (&rest programs) | ||
248 | "Return the first of PROGRAMS that exists in the system's $PATH." | ||
249 | (seq-some #'executable-find programs)) | ||
250 | |||
251 | ;;; Update packages more better-er | ||
252 | |||
253 | (defun +package-update-all () | ||
254 | "Update all packages and vc packages." | ||
255 | (interactive) | ||
256 | (package-update-all) | ||
257 | ;; WTF! | ||
258 | (let ((package-archives-nil)) | ||
259 | (package-vc-update-all))) | ||
260 | |||
261 | (provide 'acdw-funs) | ||
262 | ;;; acdw-funs.el ends here | ||
diff --git a/lisp/acdw-macs.el b/lisp/acdw-macs.el deleted file mode 100644 index e2258fa..0000000 --- a/lisp/acdw-macs.el +++ /dev/null | |||
@@ -1,293 +0,0 @@ | |||
1 | ;;; acdw-macs.el --- extra macros -*- lexical-binding: t; -*- | ||
2 | |||
3 | (eval-when-compile | ||
4 | (require 'cl-lib) | ||
5 | (require 'tempo) | ||
6 | (declare-function derived-mode-abbrev-table-name "tempo")) | ||
7 | |||
8 | ;;; Extra functionality for `eval-after-load' | ||
9 | |||
10 | (defun eval-after-init (thunk) | ||
11 | "Evaluate THUNK after Emacs initiation, or now if already initialized." | ||
12 | (if after-init-time | ||
13 | (funcall thunk) | ||
14 | (add-hook 'after-init-hook thunk))) | ||
15 | |||
16 | (defmacro eval-after (prereqs &rest body) | ||
17 | "Evaluate body after PREREQS. | ||
18 | PREREQS can be a feature, a number, `t', or a list of those. | ||
19 | |||
20 | Features are used as arguments to `eval-after-load'. Numbers are | ||
21 | used as arguments to `run-with-idle-timer'. `t' will ensure BODY | ||
22 | runs after Emacs's init time. | ||
23 | |||
24 | When given a list of PREREQS, `eval-after' will nest each one | ||
25 | from left to right." | ||
26 | (declare (indent 1) (debug (form def-body))) | ||
27 | (setf prereqs (ensure-list prereqs)) | ||
28 | (if (null prereqs) | ||
29 | (macroexp-progn body) | ||
30 | (let* ((this (car prereqs)) | ||
31 | (form `((lambda () (eval-after ,(cdr prereqs) ,@body))))) | ||
32 | (cond | ||
33 | ((eq this :init) | ||
34 | (append '(eval-after-init) form)) | ||
35 | ((numberp this) | ||
36 | (append `(run-with-idle-timer ,this nil) form)) | ||
37 | ((symbolp this) | ||
38 | (append `(eval-after-load ',this) form)) | ||
39 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) | ||
40 | |||
41 | |||
42 | ;;; Easier customization of options | ||
43 | ;; At some point it might be nice to include more forms in the VAR slots, like | ||
44 | ;; `setup's `:option' macro. | ||
45 | |||
46 | (if (fboundp 'setopt) | ||
47 | ;; Emacs 29 introduces `setopt', which does basically the same thing as the | ||
48 | ;; macro below. Not exactly the same, of course---it uses `setopt--set' | ||
49 | ;; instead of `customize-set-variable'---but I'm going to trust the Emacs | ||
50 | ;; devs on this one. | ||
51 | (defalias 'setc 'setopt) | ||
52 | (defmacro setc (&rest args) | ||
53 | "Customize user options in a `setq'-like way." | ||
54 | (declare (debug setq)) | ||
55 | (unless (zerop (mod (length args) 2)) | ||
56 | (signal 'wrong-number-of-arguments `(evenp ,(length args)))) | ||
57 | (let (form defuns) | ||
58 | (while args | ||
59 | (let* ((var (pop args)) | ||
60 | (val (pop args))) | ||
61 | (when (memq (car-safe val) '(defun defmacro)) | ||
62 | (push val defuns) | ||
63 | (setq val `(function ,(cadr val)))) | ||
64 | (push `(customize-set-variable ',var ,val "Set by `setc'.") | ||
65 | form))) | ||
66 | `(progn ,@(append (nreverse defuns) (nreverse form)))))) | ||
67 | |||
68 | |||
69 | ;;; Extra def- forms | ||
70 | |||
71 | (defmacro defdir (name directory &optional docstring) | ||
72 | "Define a variable and a function NAME expanding to DIRECTORY. | ||
73 | DOCSTRING is applied to the variable; its default is DIRECTORY's | ||
74 | path." | ||
75 | (declare (indent 2) (doc-string 3)) | ||
76 | `(progn | ||
77 | (defvar ,name ,directory | ||
78 | ,(concat (or docstring (format "%s" directory)) "\n" | ||
79 | "Defined by `defdir'.")) | ||
80 | (defun ,name (file &optional mkdir) | ||
81 | ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" | ||
82 | "If MKDIR is non-nil, parent directories are created.\n" | ||
83 | "Defined by `defdir'.") | ||
84 | (let ((file-name (expand-file-name | ||
85 | (convert-standard-filename file) ,name))) | ||
86 | (when mkdir | ||
87 | (make-directory (file-name-directory file-name) :parents)) | ||
88 | file-name)))) | ||
89 | |||
90 | (defmacro defkeys (maps &rest bindings) | ||
91 | "Define key BINDINGS in MAPS. | ||
92 | If MAPS is nil or t, bind to `current-global-map'. Otherwise, | ||
93 | bind each of BINDINGS to the map or list of maps provided. | ||
94 | |||
95 | BINDINGS is a `setq'-style list of pairs of keys and definitions. | ||
96 | The key part of each binding can be a string, in which case it's | ||
97 | passed to `kbd', or a vector or anything else `define-key' | ||
98 | accepts in the KEY position. The definition part, likewise, can | ||
99 | be any form `define-key' accepts in that position, with this | ||
100 | addition: if the form is a `defun' form, it will be defined | ||
101 | before any keys are bound." | ||
102 | (declare (indent 1)) | ||
103 | (unless (cl-evenp (length bindings)) | ||
104 | (signal 'wrong-number-of-arguments `(evenp ,(length bindings)))) | ||
105 | `(progn | ||
106 | ,@(cl-loop | ||
107 | for map in (ensure-list maps) | ||
108 | for first-map-p = t then nil | ||
109 | append | ||
110 | (cl-loop | ||
111 | for (keys def) on bindings by #'cddr | ||
112 | for defp = (memq (car-safe def) '(defmap defun defmacro)) | ||
113 | if (and defp first-map-p) collect def into defuns | ||
114 | append | ||
115 | (cl-loop | ||
116 | for key in (ensure-list keys) | ||
117 | collect (list 'define-key | ||
118 | (if (memq map '(t nil)) | ||
119 | '(current-global-map) | ||
120 | (or (car-safe map) map)) | ||
121 | (if (stringp key) | ||
122 | `(kbd ,key) | ||
123 | key) | ||
124 | (if defp | ||
125 | (cl-case (car def) | ||
126 | ((defmap) (cadr def)) | ||
127 | ((defun defmacro) `#',(cadr def)) | ||
128 | (otherwise (error "Bad def type: %S" | ||
129 | (car def)))) | ||
130 | def))) | ||
131 | into keydefs | ||
132 | finally return | ||
133 | (let ((all (append defuns keydefs))) | ||
134 | (if-let ((after (plist-get (cdr-safe map) :after))) | ||
135 | `((eval-after ,after | ||
136 | ,@all)) | ||
137 | all)))))) | ||
138 | |||
139 | (defmacro defmap (name docstring &rest bindings) | ||
140 | "Define a keymap named NAME, with BINDINGS." | ||
141 | (declare (indent 1) (doc-string 2)) | ||
142 | `(,(if (boundp name) 'setq 'defvar) ,name | ||
143 | ;;; ^ probably a terrible hack | ||
144 | (let ((map (make-sparse-keymap))) | ||
145 | (defkeys map ,@bindings) | ||
146 | map) | ||
147 | ,@(unless (boundp name) (list docstring)))) | ||
148 | |||
149 | (defmacro defhook (hooks &rest body) | ||
150 | "Define a function to hook into HOOKS. | ||
151 | NAME and ARGS are passed to the generated `defun' form. | ||
152 | Each hook in HOOKS can be the name of a hook or a list of the form | ||
153 | (HOOK DEPTH LOCAL), where each argument is the same as in | ||
154 | `add-hook'." | ||
155 | (declare (indent 1)) | ||
156 | (let* ((name (or (plist-get body :name) | ||
157 | (intern (format "%s/h" | ||
158 | (mapconcat | ||
159 | (lambda (h) | ||
160 | (string-remove-suffix | ||
161 | "-hook" | ||
162 | (if (and (consp h) | ||
163 | (caddr h)) | ||
164 | (format "%s:local" (car h)) | ||
165 | (format "%s" (or (car-safe h) | ||
166 | h))))) | ||
167 | (ensure-list hooks) | ||
168 | "|"))))) | ||
169 | (args (or (plist-get body :args) nil)) | ||
170 | (doc (or (plist-get body :doc) nil)) | ||
171 | (forms ; (DEFUN . FUNCS) | ||
172 | (cl-loop for form in (delete2 body :name :args :doc) | ||
173 | if (eq (car form) 'function) | ||
174 | collect form into funcs | ||
175 | else collect form into defuns | ||
176 | finally return (cons defuns funcs))) | ||
177 | (defun-forms (car forms)) | ||
178 | (func-forms (cdr forms))) | ||
179 | `(progn | ||
180 | ,@(when defun-forms | ||
181 | `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) | ||
182 | ,@(cl-loop for hook in (ensure-list hooks) | ||
183 | for h = (or (car-safe hook) hook) | ||
184 | for ha = (cdr-safe hook) | ||
185 | if defun-forms | ||
186 | collect `(add-hook ',h #',name ,@ha) | ||
187 | append | ||
188 | (cl-loop for fn in func-forms | ||
189 | collect `(add-hook ',h ,fn ,@ha)))))) | ||
190 | |||
191 | ;; (autoload FUNCTION FILE &optional DOCSTRING INTERACTIVE TYPE) | ||
192 | (defmacro defautoload (file &rest fns) | ||
193 | "Autoload FNS from FILE. | ||
194 | Each of FNS can be an atom (function name) or a list of the | ||
195 | form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible | ||
196 | keys are `:doc' (docstring), `:interactive', and `:type', which are | ||
197 | used as the optional arguments to `autoload'. | ||
198 | |||
199 | You can also pass `:interactive' and `:type' as keyword arguments | ||
200 | just after FILE, and they'll serve as the default for the | ||
201 | autoloaded FNS." | ||
202 | (declare (indent 1)) | ||
203 | (let ((interactive (plist-get fns :interactive)) | ||
204 | (type (plist-get fns :type)) | ||
205 | (fns (delete2 fns :interactive :type))) | ||
206 | `(progn | ||
207 | ,@(cl-loop for fn in fns | ||
208 | for name = (or (car-safe fn) fn) | ||
209 | for args = (cdr-safe fn) | ||
210 | collect | ||
211 | `(autoload ',name ,(format "%s" file) | ||
212 | ,(plist-get args :doc) | ||
213 | ,(or (plist-get args :interactive) | ||
214 | interactive) | ||
215 | ,(or (plist-get args :type) | ||
216 | type)))))) | ||
217 | |||
218 | |||
219 | ;;; Miscellaneous | ||
220 | |||
221 | (defmacro with-message (message &rest body) | ||
222 | "Display MESSAGE then execute BODY. | ||
223 | If BODY executes without errors, display MESSAGE...done." | ||
224 | (declare (indent 1)) | ||
225 | (let ((msym (gensym)) | ||
226 | (esym (gensym))) | ||
227 | `(let ((,msym ,message)) | ||
228 | (condition-case ,esym | ||
229 | (progn (message "%s..." ,msym) | ||
230 | ,@body) | ||
231 | (:success (message "%s...done" ,msym)) | ||
232 | (t (signal (car ,esym) (cdr ,esym))))))) | ||
233 | |||
234 | (defmacro o (&rest fns) | ||
235 | "Compose FNS into a new function for one argument." | ||
236 | (if (null fns) | ||
237 | `(lambda (&rest args) args) | ||
238 | `(lambda (&rest args) | ||
239 | (apply | ||
240 | #',(car fns) | ||
241 | (ensure-list (apply (o ,@(cdr fns)) args)))))) | ||
242 | |||
243 | (defmacro with-region-or-buffer (&rest funcs) | ||
244 | "Advise FUNCS with `advise-region-or-buffer'." | ||
245 | `(progn | ||
246 | ,@(cl-loop for fn in funcs | ||
247 | collect | ||
248 | `(advice-add ',fn :before #'advise-region-or-buffer)))) | ||
249 | |||
250 | (defmacro with-region-or-line (&rest funcs) | ||
251 | "Advise FUNCS with `advise-region-or-line'." | ||
252 | `(progn | ||
253 | ,@(cl-loop for fn in funcs | ||
254 | collect | ||
255 | `(advice-add ',fn :before #'advise-region-or-line)))) | ||
256 | |||
257 | (defmacro with-region-or-to-eol (&rest funcs) | ||
258 | "Advise FUNCS with `advise-region-or-to-eol'." | ||
259 | `(progn | ||
260 | ,@(cl-loop for fn in funcs | ||
261 | collect | ||
262 | `(advice-add ',fn :before #'advise-region-or-to-eol)))) | ||
263 | |||
264 | (defmacro define-tempo (tag doc &rest elements) | ||
265 | "Define a template and add its tag to MODE's abbrev-table. | ||
266 | TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see. | ||
267 | ABBREV, if given, is the abbrev string to use for template expansion | ||
268 | under MODE's abbrev-table. If ABBREV isn't given, TAG will be used." | ||
269 | (declare (indent 1)) | ||
270 | (let* ((template (gensym)) | ||
271 | (tag (cond ((stringp tag) tag) | ||
272 | ((symbolp tag) (symbol-name tag)) | ||
273 | (t (user-error "TAG must be a string or symbol: %S" tag)))) | ||
274 | (mode (or (plist-get elements :mode) nil)) | ||
275 | (abbrev (or (plist-get elements :abbrev) tag)) | ||
276 | (taglist (or (plist-get elements :taglist) nil)) | ||
277 | (table (let ((tname (and mode (derived-mode-abbrev-table-name mode)))) | ||
278 | (while (and tname (not (memq tname abbrev-table-name-list))) | ||
279 | (setq tname (and (get mode 'derived-mode-parent) | ||
280 | (derived-mode-abbrev-table-name | ||
281 | (get mode 'derived-mode-parent))))) | ||
282 | (or tname 'global-abbrev-table))) | ||
283 | (elements (delete2 elements :mode :abbrev :taglist))) | ||
284 | `(let ((,template (tempo-define-template ,tag | ||
285 | ',elements | ||
286 | ,(or abbrev tag) | ||
287 | ,doc | ||
288 | ,taglist))) | ||
289 | (define-abbrev ,table ,tag "" ,template :system t) | ||
290 | (put ,template 'no-self-insert t)))) | ||
291 | |||
292 | (provide 'acdw-macs) | ||
293 | ;;; acdw-macs.el ends here | ||
diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index 30c4f44..0000000 --- a/lisp/acdw.el +++ /dev/null | |||
@@ -1,79 +0,0 @@ | |||
1 | ;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'acdw-funs) ; Extra functions | ||
6 | (require 'acdw-macs) ; Extra macros | ||
7 | |||
8 | (defdir etc/ (locate-user-emacs-file "etc") | ||
9 | "Directory for package configuration files. | ||
10 | See `no-littering' for examples.") | ||
11 | |||
12 | (defdir var/ etc/ | ||
13 | "Directory for package data file. | ||
14 | See `no-littering' for examples.") | ||
15 | |||
16 | (defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) | ||
17 | (expand-file-name "emacs/" xdg-cache) | ||
18 | etc/) | ||
19 | "Directory for cache files.") | ||
20 | |||
21 | (setq native-compile-target-directory (cache/ "eln" t)) | ||
22 | (when (fboundp 'startup-redirect-eln-cache) | ||
23 | (startup-redirect-eln-cache (cache/ "eln" t))) | ||
24 | |||
25 | (defdir sync/ (expand-file-name "/home/case/Sync") | ||
26 | "My Syncthing directory.") | ||
27 | |||
28 | (defdir private/ (sync/ "emacs/private")) | ||
29 | (add-to-list 'load-path private/) | ||
30 | |||
31 | (require 'acdw-defaults) ; Sane defaults | ||
32 | (require '_acdw) ; Private stuff | ||
33 | (require '+lisp) ; Lispy goodness | ||
34 | |||
35 | (setc enable-recursive-minibuffers t | ||
36 | completions-detailed t | ||
37 | completion-ignore-case t | ||
38 | read-buffer-completion-ignore-case t | ||
39 | read-file-name-completion-ignore-case t | ||
40 | initial-buffer-choice #'+initial-buffer | ||
41 | initial-scratch-message | ||
42 | (format "%s\n\n" | ||
43 | (comment-lines | ||
44 | (shell-command-to-string "fortune") | ||
45 | ";; ")) | ||
46 | sentence-end-double-space nil | ||
47 | save-silently t) | ||
48 | |||
49 | (defkeys t | ||
50 | "M-o" #'other-window|switch-buffer | ||
51 | "C-x 0" #'delete-window|bury-buffer | ||
52 | "C-M-;" #'+lisp-comment-or-uncomment-sexp | ||
53 | "M-SPC" #'+cycle-spacing | ||
54 | "C-x C-k" #'kill-this-buffer) | ||
55 | |||
56 | (defkeys t | ||
57 | "M-u" #'universal-argument) | ||
58 | |||
59 | (defkeys universal-argument-map | ||
60 | "M-u" #'universal-argument-more) | ||
61 | |||
62 | (define-advice switch-to-buffer (:after (&rest _) normal-mode) | ||
63 | "Automatically determine the mode for created non-file buffers." | ||
64 | (when-let ((_ (and (eq major-mode 'fundamental-mode))) | ||
65 | (buffer-file-name (buffer-name))) | ||
66 | (normal-mode))) | ||
67 | |||
68 | (define-advice canonically-space-region | ||
69 | (:around (orig &rest args) double-space-sentences) | ||
70 | (let ((sentence-end-double-space t)) | ||
71 | (apply orig args))) | ||
72 | |||
73 | (with-region-or-buffer indent-region) | ||
74 | |||
75 | (winner-mode) | ||
76 | |||
77 | (provide 'acdw) | ||
78 | |||
79 | ;;; acdw.el ends here | ||
diff --git a/lisp/graveyard.el b/lisp/graveyard.el deleted file mode 100644 index 89a776d..0000000 --- a/lisp/graveyard.el +++ /dev/null | |||
@@ -1,50 +0,0 @@ | |||
1 | ;;; graveyard.el --- stuff i'm not currently using right now | ||
2 | |||
3 | ;;; Commentary: | ||
4 | |||
5 | ;; I spent a long time configuring these packages! And they're misbehaving, | ||
6 | ;; boo. So into the graveyard they go. | ||
7 | |||
8 | ;;; Code: | ||
9 | |||
10 | (use-package emms | ||
11 | :ensure t | ||
12 | :init | ||
13 | (require 'emms-setup) | ||
14 | (autoload #'+emms-streams "+emms" nil t) | ||
15 | (defkeys t "C-c p s" #'+emms-streams) | ||
16 | (defhook (emms-playlist-mode-hook | ||
17 | emms-browser-mode-hook | ||
18 | emms-show-all-mode-hook) | ||
19 | #'hl-line-mode | ||
20 | #'show-paren-mode) | ||
21 | :config | ||
22 | (require '+emms) | ||
23 | (emms-all) | ||
24 | (emms-default-players) | ||
25 | (emms-browser-make-filter "all" #'ignore) | ||
26 | (emms-browser-make-filter "recent" | ||
27 | (lambda (track) | ||
28 | (< 30 (time-to-number-of-days | ||
29 | (time-subtract (current-time) | ||
30 | (emms-info-track-file-mtime | ||
31 | track)))))) | ||
32 | (emms-browser-set-filter (assoc "all" emms-browser-filters)) | ||
33 | (emms-history-load) | ||
34 | (emms-playing-time-mode -1) | ||
35 | :bind | ||
36 | (("C-c p p" . emms-pause) | ||
37 | ("C-c p b" . emms-browser) | ||
38 | ("C-c p l" . emms-playlist-mode-go)) | ||
39 | :custom | ||
40 | (emms-source-file-default-directory (expand-file-name "~/var/music/")) | ||
41 | (emms-source-playlist-default-format 'm3u) | ||
42 | (emms-playlist-mode-center-when-go t) | ||
43 | (emms-playlist-default-major-mode 'emms-playlist-mode) | ||
44 | (emms-player-mpv-update-metadata t) | ||
45 | (emms-browser-covers #'emms-browser-cache-thumbnail-async) | ||
46 | (emms-browser-thumbnail-small-size 64) | ||
47 | (emms-browser-thumbnail-medium-size 128) | ||
48 | (emms-streams-file (expand-file-name "streams.emms" | ||
49 | emms-source-file-default-directory)) | ||
50 | (emms-mode-line-mode-line-function nil)) | ||
diff --git a/lisp/init-org.el b/lisp/init-org.el deleted file mode 100644 index d2d5e77..0000000 --- a/lisp/init-org.el +++ /dev/null | |||
@@ -1,144 +0,0 @@ | |||
1 | ;;; init-org.el -*- lexical-binding: t; -*- | ||
2 | |||
3 | (use-package org | ||
4 | :defer t | ||
5 | :custom | ||
6 | (org-adapt-indentation nil) | ||
7 | (org-auto-align-tags t) | ||
8 | (org-archive-mark-done t) | ||
9 | (org-fold-catch-invisible-edits 'show-and-error) | ||
10 | (org-clock-clocked-in-display 'mode-line) | ||
11 | (org-clock-string-limit 7) ; just the clock bit | ||
12 | |||
13 | (org-clock-persist nil) | ||
14 | (org-confirm-babel-evaluate nil) | ||
15 | (org-cycle-separator-lines 0) | ||
16 | (org-directory (sync/ "org/" t)) | ||
17 | (org-fontify-done-headline t) | ||
18 | (org-fontify-quote-and-verse-blocks t) | ||
19 | (org-fontify-whole-heading-line t) | ||
20 | (org-hide-emphasis-markers t) | ||
21 | (org-html-coding-system 'utf-8-unix) | ||
22 | (org-image-actual-width (list (* (window-font-width) | ||
23 | (- fill-column 8)))) | ||
24 | (org-imenu-depth 3) | ||
25 | (org-indent-indentation-per-level 0) | ||
26 | (org-indent-mode-turns-on-hiding-stars nil) | ||
27 | (org-insert-heading-respect-content t) | ||
28 | (org-list-demote-modify-bullet '(("-" . "+") | ||
29 | ("+" . "-"))) | ||
30 | (org-log-done 'time) | ||
31 | (org-log-into-drawer t) | ||
32 | (org-num-skip-commented t) | ||
33 | (org-num-skip-unnumbered t) | ||
34 | (org-num-skip-footnotes t) | ||
35 | (org-outline-path-complete-in-steps nil) | ||
36 | (org-pretty-entities t) | ||
37 | (org-pretty-entities-include-sub-superscripts nil) | ||
38 | (org-refile-targets '((nil . (:maxlevel . 2)) | ||
39 | (org-agenda-files . (:maxlevel . 1)))) | ||
40 | (org-refile-use-outline-path 'file) | ||
41 | (org-special-ctrl-a/e t) | ||
42 | (org-special-ctrl-k t) | ||
43 | (org-src-fontify-natively t) | ||
44 | (org-src-tab-acts-natively t) | ||
45 | (org-src-window-setup 'current-window) | ||
46 | (org-startup-truncated nil) | ||
47 | (org-startup-with-inline-images t) | ||
48 | (org-tags-column 0) | ||
49 | (org-todo-keywords | ||
50 | '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)" | ||
51 | "|" "DONE(d!)" "ASSIGNED(a@/!)") | ||
52 | (sequence "|" "CANCELED(k@)") | ||
53 | (sequence "MEETING(m)"))) | ||
54 | (org-use-speed-commands t) | ||
55 | :config | ||
56 | (require '+org) | ||
57 | (defkeys org-mode-map | ||
58 | "C-M-k" #'kill-paragraph | ||
59 | "C-M-t" #'transpose-paragraphs | ||
60 | "RET" #'+org-return-dwim | ||
61 | "S-<return>" #'+org-table-copy-down|+org-return-dwim | ||
62 | "C-c C-o" #'+org-open-at-point-dwim) | ||
63 | (setc org-ellipsis | ||
64 | (or (bound-and-true-p truncate-string-ellipsis) "…") | ||
65 | org-emphasis-alist | ||
66 | '(("*" org-bold) | ||
67 | ("/" org-italic) | ||
68 | ("_" org-underline) | ||
69 | ("=" org-verbatim) | ||
70 | ("~" org-code) | ||
71 | ("+" org-strikethrough))) | ||
72 | (defhook org-mode-hook | ||
73 | #'variable-pitch-mode | ||
74 | #'visual-fill-column-mode | ||
75 | #'turn-off-auto-fill | ||
76 | #'org-indent-mode | ||
77 | #'prettify-symbols-mode | ||
78 | #'abbrev-mode | ||
79 | (defhook ((before-save-hook nil :local)) | ||
80 | :name before-save@org-mode | ||
81 | (+org-hide-drawers-except-point) | ||
82 | (org-align-tags 'all)))) | ||
83 | |||
84 | (use-package org-agenda | ||
85 | :custom | ||
86 | (org-agenda-skip-deadline-if-done t) | ||
87 | (org-agenda-skip-scheduled-if-done t) | ||
88 | (org-agenda-span 10) | ||
89 | (org-agenda-block-separator ?─) | ||
90 | (org-agenda-time-grid | ||
91 | '((daily today require-timed) | ||
92 | (800 1000 1200 1400 1600 1800 2000) | ||
93 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")) | ||
94 | (org-agenda-current-time-string | ||
95 | "← now ─────────────────────────────────────────────────") | ||
96 | (org-agenda-include-diary nil) ; I use the org-diary features | ||
97 | |||
98 | (org-agenda-todo-ignore-deadlines 'near) | ||
99 | (org-agenda-todo-ignore-scheduled 'future) | ||
100 | (org-agenda-include-deadlines t) | ||
101 | (org-deadline-warning-days 0) | ||
102 | (org-agenda-show-future-repeats 'next) | ||
103 | (org-agenda-window-setup 'current-window) | ||
104 | (org-agenda-file-skip-regexp "sync-conflict") | ||
105 | :bind (("C-c a" . org-agenda)) | ||
106 | :config | ||
107 | (require '+org) | ||
108 | (advice-add 'org-agenda-files :filter-return #'org-agenda-files@skip-regexp) | ||
109 | (defhook org-agenda-mode-hook | ||
110 | (setq-local truncate-lines t) | ||
111 | #'hl-line-mode) | ||
112 | (defhook org-agenda-after-show-hook | ||
113 | #'org-narrow-to-subtree)) | ||
114 | |||
115 | (use-package org-capture | ||
116 | :bind | ||
117 | (("C-c c" . org-capture))) | ||
118 | |||
119 | (use-package ol ; org-link | ||
120 | :after org | ||
121 | :config | ||
122 | (require '+org) | ||
123 | (+org-link-define-type sms (number _)) | ||
124 | (+org-link-define-type tel (number _))) | ||
125 | |||
126 | (use-package ox ; org-export | ||
127 | :defer t | ||
128 | :custom | ||
129 | (org-export-coding-system 'utf-8-unix) | ||
130 | (org-export-headline-levels 8) | ||
131 | (org-export-with-drawers nil) | ||
132 | (org-export-with-section-numbers nil) | ||
133 | (org-export-with-smart-quotes t) | ||
134 | (org-export-with-sub-superscripts t) | ||
135 | (org-export-with-toc nil) | ||
136 | :config | ||
137 | (require 'ox-md)) | ||
138 | |||
139 | (use-package org-word-count | ||
140 | :load-path "~/src/emacs/org-word-count/" | ||
141 | :hook org-mode-hook) | ||
142 | |||
143 | (provide 'init-org) | ||
144 | ;;; init-org.el ends here | ||
diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el deleted file mode 100644 index 5a9da84..0000000 --- a/lisp/upload-junk.el +++ /dev/null | |||
@@ -1,47 +0,0 @@ | |||
1 | ;;; upload-junk.el --- Upload junk -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;;; Code: | ||
4 | |||
5 | (require 'tramp) | ||
6 | |||
7 | (defvar upload-junk-ssh-host "hetzner" | ||
8 | "SSH host to upload to.") | ||
9 | |||
10 | (defvar upload-junk-ssh-root "/junk" | ||
11 | "SSH root folder to upload to.") | ||
12 | |||
13 | (defvar upload-junk-web-host "https://junk.acdw.net" | ||
14 | "Web host to link uploads to.") | ||
15 | |||
16 | (defun upload-junk-file-name (&optional file) | ||
17 | "Return the uploaded filename for FILE." | ||
18 | (let ((file (or file "_.txt"))) | ||
19 | (format "tmp_%s_%x%x.%s" | ||
20 | (file-name-nondirectory (file-name-sans-extension file)) | ||
21 | (time-convert (current-time) 'integer) | ||
22 | (random (* 8 8 8 8)) | ||
23 | (or (file-name-extension file) "txt")))) | ||
24 | |||
25 | (defun upload-junk-region (start end) | ||
26 | "Upload region from START to END to my server." | ||
27 | (interactive "r") | ||
28 | (let* ((s (buffer-substring-no-properties start end)) | ||
29 | (f (upload-junk-file-name (buffer-file-name))) | ||
30 | (w (format "%s/%s" upload-junk-web-host f))) | ||
31 | (with-temp-buffer | ||
32 | (insert s) | ||
33 | (write-file (format "/sshx:%s:%s/%s" | ||
34 | upload-junk-ssh-host | ||
35 | upload-junk-ssh-root | ||
36 | f))) | ||
37 | (kill-new w) | ||
38 | w)) | ||
39 | |||
40 | (defun upload-junk-region-or-buffer () | ||
41 | (interactive) | ||
42 | (if (region-active-p) | ||
43 | (upload-junk-region (region-beginning) (region-end)) | ||
44 | (upload-junk-region (point-min) (point-max)))) | ||
45 | |||
46 | (provide 'upload-junk) | ||
47 | ;;; upload-junk.el ends here | ||
diff --git a/lisp/yoke.el b/lisp/yoke.el deleted file mode 100644 index ec84f56..0000000 --- a/lisp/yoke.el +++ /dev/null | |||
@@ -1,392 +0,0 @@ | |||
1 | ;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*- | ||
2 | |||
3 | ;; Copyright (C) 2022 Case Duckworth | ||
4 | |||
5 | ;; Author: Case Duckworth <case@bob> | ||
6 | ;; Keywords: convenience | ||
7 | ;; Package-Version: 0.61803398875 | ||
8 | ;; Homepage: https://junk.acdw.net/yoke.el | ||
9 | ;; Package-Requires: ((emacs "28.1")) | ||
10 | |||
11 | ;; This program is free software; you can redistribute it and/or modify | ||
12 | ;; it under the terms of the GNU General Public License as published by | ||
13 | ;; the Free Software Foundation, either version 3 of the License, or | ||
14 | ;; (at your option) any later version. | ||
15 | |||
16 | ;; This program is distributed in the hope that it will be useful, | ||
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | ||
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||
19 | ;; GNU General Public License for more details. | ||
20 | |||
21 | ;; You should have received a copy of the GNU General Public License | ||
22 | ;; along with this program. If not, see <https://www.gnu.org/licenses/>. | ||
23 | |||
24 | ;;; Commentary: | ||
25 | |||
26 | ;; THIS IS A WORK IN PROGRESS. DON'T USE IT. | ||
27 | |||
28 | ;;; Code: | ||
29 | |||
30 | (require 'cl-lib) | ||
31 | (require 'package-vc) | ||
32 | |||
33 | ;;; User options | ||
34 | |||
35 | (defgroup yoke nil | ||
36 | "Customizations for `yoke'." | ||
37 | :group 'convenience | ||
38 | :prefix "yoke-") | ||
39 | |||
40 | (defcustom yoke-directory package-user-dir | ||
41 | "Where to put yoked packages." | ||
42 | :type 'file) | ||
43 | |||
44 | (defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache" | ||
45 | "~/.yoke-cache") | ||
46 | "Where to put cached yoke files, like downloaded HTTP packages." | ||
47 | :type 'file) | ||
48 | |||
49 | (defcustom yoke-debug-on-error nil | ||
50 | "Whether to throw up the debugger on a yoke error. | ||
51 | If nil, errors will be inserted in the `yoke-message-buffer'.") | ||
52 | |||
53 | ;;; Variables | ||
54 | |||
55 | (defvar yoke-message-buffer " *yoke*" | ||
56 | "The buffer used for yoke messages.") | ||
57 | |||
58 | (defvar yoke-selected-packages nil | ||
59 | "List of packages managed by `yoke'.") | ||
60 | |||
61 | (defvar yoke-backends '(file http package) | ||
62 | "Backends handled by `yoke'.") | ||
63 | |||
64 | ;;; Main functionality | ||
65 | |||
66 | (defmacro yoke (package &rest body) | ||
67 | "Yoke a package into your Emacs session. | ||
68 | PACKAGE is either a symbol, in which case `yoke' expands to | ||
69 | basically a named `progn' (good for grouping configuration), or a | ||
70 | list of the form (NAME . ARGS), where ARGS can be one of the | ||
71 | following: | ||
72 | |||
73 | - nil: install NAME using `package'. | ||
74 | - a property list describing a package specification. Valid | ||
75 | key/value pairs include | ||
76 | |||
77 | `:backend' (symbol) | ||
78 | A symbol of the yoke backend to use for installing the | ||
79 | package. See `yoke-backends' for allowed backends. | ||
80 | |||
81 | `:url' (string) | ||
82 | The URL of the package's repository or source. | ||
83 | |||
84 | `:lisp-dir' (string) | ||
85 | The repository-relative name of the directory to use for | ||
86 | loading lisp sources. If not given, it defaults to the | ||
87 | repo's root directory. | ||
88 | |||
89 | Other pairs may be valid for a given backend; see that | ||
90 | backend's `yoke-install' function for more details. | ||
91 | |||
92 | BODY is executed in a `condition-case' so that errors won't keep | ||
93 | the rest of Emacs from initializing. BODY can also be prepended | ||
94 | by the following keyword arguments: | ||
95 | |||
96 | `:after' (FEATURE...) | ||
97 | |||
98 | `:require' (FEATURE...) | ||
99 | |||
100 | `:depends' (PACKAGE-SPEC...) | ||
101 | |||
102 | `:build' (ACTION...) | ||
103 | |||
104 | `:unless' (PREDICATE) | ||
105 | |||
106 | `:when' (PREDICATE) | ||
107 | |||
108 | Other keywords are ignored. | ||
109 | |||
110 | \(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)" | ||
111 | (declare (indent 1)) | ||
112 | (let* ((name (or (car-safe package) package)) | ||
113 | (backend (yoke--pget package :backend)) | ||
114 | ;; Body keyword arguments | ||
115 | (after (plist-get body :after)) | ||
116 | (depends (plist-get body :depends)) | ||
117 | (req (plist-get body :require)) | ||
118 | (buildp (plist-member body :build)) | ||
119 | (build (plist-get body :build)) | ||
120 | (whenp (plist-member body :when)) | ||
121 | (when (if whenp (plist-get body :when) t)) | ||
122 | (unlessp (plist-member body :unless)) | ||
123 | (unless (if unlessp (plist-get body :unless) nil)) | ||
124 | ;; Body | ||
125 | (body (let ((b body) r) | ||
126 | (while (consp b) | ||
127 | (if (keywordp (car b)) | ||
128 | (setf b (cdr b)) | ||
129 | (setf r (cons (car b) r))) | ||
130 | (setf b (cdr b))) | ||
131 | (reverse r))) | ||
132 | (esym (make-symbol "yoke-error"))) | ||
133 | ;; Body modifiers. These are applied in reverse order (that is, the last | ||
134 | ;; one will be on the outside). | ||
135 | ;; --- Require the current package | ||
136 | (when req | ||
137 | (setf body | ||
138 | (append (let (reqs) | ||
139 | (dolist (r (ensure-list req) reqs) | ||
140 | (let* ((feat (if (eq r t) name r)) | ||
141 | (+feat (intern (format "+%s" feat)))) | ||
142 | (push `(require ',feat) reqs) | ||
143 | (push `(require ',+feat nil :noerror) reqs))) | ||
144 | (reverse reqs)) | ||
145 | body))) | ||
146 | ;; --- Install the package | ||
147 | (when (consp package) | ||
148 | (push `(yoke-install ',(car package) ,@(cdr package)) | ||
149 | body)) | ||
150 | ;; --- Dependencies | ||
151 | (when depends | ||
152 | (setf body | ||
153 | (append (cl-loop for dep in (ensure-list depends) | ||
154 | collect `(or (yoke-install ',@(ensure-list dep)) | ||
155 | (error "Dependency (%s): %S" | ||
156 | ',dep ',package))) | ||
157 | body))) | ||
158 | ;; --- Load after | ||
159 | (when after | ||
160 | (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body)))) | ||
161 | ;; --- Conditional expansion | ||
162 | (when (or whenp unlessp) | ||
163 | (setf body | ||
164 | (append (cond | ||
165 | ((and whenp unlessp) | ||
166 | `((when (or (not ,when) ,unless) | ||
167 | (signal 'yoke-predicate | ||
168 | '(:when ,when :unless ,unless))))) | ||
169 | (whenp | ||
170 | `((unless ,when (signal 'yoke-predicate | ||
171 | '(:when ,when))))) | ||
172 | (unlessp | ||
173 | `((when ,unless (signal 'yoke-predicate | ||
174 | '(:unless ,unless)))))) | ||
175 | body))) | ||
176 | ;; Expansion | ||
177 | `(condition-case ,esym | ||
178 | (cl-letf (((symbol-function 'package--save-selected-packages) | ||
179 | #'ignore)) | ||
180 | ;; Body | ||
181 | ,@body) | ||
182 | (:success | ||
183 | ,(unless (atom package) | ||
184 | `(setf (alist-get ',name yoke-selected-packages) | ||
185 | (list ,@(cdr-safe package)))) | ||
186 | ',package) | ||
187 | (t ,(if yoke-debug-on-error | ||
188 | `(signal (car ,esym) (cdr ,esym)) | ||
189 | `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym))))))) | ||
190 | |||
191 | ;;; Installing packages | ||
192 | |||
193 | (defun yoke-install (name &rest args) | ||
194 | "Install package NAME, with ARGS." | ||
195 | (let ((custom-file null-device) | ||
196 | (inhibit-message (and (not (plist-member args :update)) | ||
197 | (not debug-on-error))) | ||
198 | (messages-buffer-name yoke-message-buffer)) | ||
199 | (funcall | ||
200 | (intern | ||
201 | (format "yoke-install-%s" | ||
202 | (or (plist-get args :backend) | ||
203 | (yoke--guess-backend (plist-get args :url)) | ||
204 | 'package))) | ||
205 | name args)) | ||
206 | (yoke--clean-load-path) | ||
207 | ;; Don't return nil | ||
208 | t) | ||
209 | |||
210 | (defun yoke-install-package (name args &optional tries) | ||
211 | "Install package NAME with ARGS using `package' machinery. | ||
212 | TRIES is an internal variable." | ||
213 | (let ((package-user-dir yoke-directory) | ||
214 | (url (plist-get args :url)) | ||
215 | (update (plist-get args :update)) | ||
216 | (dirname (expand-file-name (format "%s" name) | ||
217 | yoke-directory)) | ||
218 | (tries (or tries 0)) | ||
219 | load-dir autoloads-file-name) | ||
220 | (unless (file-exists-p dirname) | ||
221 | (setq dirname (or (car-safe (file-expand-wildcards | ||
222 | (concat dirname "*"))) | ||
223 | dirname))) | ||
224 | (setq load-dir | ||
225 | (expand-file-name (or (plist-get args :lisp-dir) "") dirname) | ||
226 | generated-autoload-file | ||
227 | (expand-file-name (format "%s-autoloads.el" name) load-dir)) | ||
228 | (prog1 | ||
229 | (condition-case error | ||
230 | (cond | ||
231 | ;; -- Commented on 2022-12-21 | ||
232 | ;; ((and (file-exists-p dirname) | ||
233 | ;; (not update)) | ||
234 | ;; (add-to-list 'load-path | ||
235 | ;; (expand-file-name | ||
236 | ;; (or (plist-get args :lisp-dir) "") | ||
237 | ;; dirname) | ||
238 | ;; nil #'equal) | ||
239 | ;; (require (intern (format "%s-autoloads" name)))) | ||
240 | ((and url update) | ||
241 | (package-vc-update (cadr (assoc name package-alist)))) | ||
242 | (update | ||
243 | (package-update name)) | ||
244 | (url | ||
245 | ;; I'm going to be honest here, this is extremely cursed. But I | ||
246 | ;; don't want to get asked about installing the packages, and when | ||
247 | ;; the user answers 'no', the function errors. So.. this. | ||
248 | (cl-letf (((symbol-function 'yes-or-no-p) #'ignore)) | ||
249 | (ignore-errors (package-vc-install (cons name args))))) | ||
250 | (:else | ||
251 | (package-install name))) | ||
252 | (file-error (if (> tries 1) | ||
253 | (error "(yoke) Can't install `%s'" name) | ||
254 | (package-refresh-contents) | ||
255 | (yoke-install-package name args (1+ tries))))) | ||
256 | (add-to-list 'load-path load-dir nil #'equal) | ||
257 | (loaddefs-generate load-dir generated-autoload-file) | ||
258 | ;; Do it again, if it doesn't actually /generate/ anything | ||
259 | (when (eq 'provide | ||
260 | (with-current-buffer (find-file-noselect generated-autoload-file) | ||
261 | (read (buffer-substring (point-min) (point-max))))) | ||
262 | (loaddefs-generate load-dir generated-autoload-file nil nil nil | ||
263 | :generate-full)) | ||
264 | (load generated-autoload-file :noerror) | ||
265 | (kill-buffer (get-file-buffer generated-autoload-file)) | ||
266 | (package-activate name)))) | ||
267 | |||
268 | (defun yoke-install-http (name args) | ||
269 | "Install a package NAME using ARGS from an http source." | ||
270 | (let* ((url (plist-get args :url)) | ||
271 | (cached (expand-file-name (file-name-nondirectory url) | ||
272 | yoke-cache-directory)) | ||
273 | (update (plist-get args :update))) | ||
274 | (unless url | ||
275 | (error "No URL for HTTP download: %S" (cons name args))) | ||
276 | (when (or (not (file-exists-p cached)) | ||
277 | update) | ||
278 | (make-directory yoke-cache-directory :parents) | ||
279 | (message "Downloading `%s'..." url) | ||
280 | (let* ((url-debug t) | ||
281 | (buf (url-retrieve-synchronously url))) | ||
282 | (with-current-buffer buf | ||
283 | (goto-char (point-min)) | ||
284 | (delete-region (point) (1+ (re-search-forward "^$"))) | ||
285 | (write-file cached 1) | ||
286 | (message "Downloading `%s'...Done." url)))) | ||
287 | (package-install-file cached))) | ||
288 | |||
289 | (defun yoke-install-file (name args) | ||
290 | "Install package NAME using ARGS from a file on-disk." | ||
291 | (let ((url (plist-get args :url)) | ||
292 | (update (plist-get args :update)) | ||
293 | (dirname (expand-file-name (format "%s" name) yoke-directory))) | ||
294 | (if (file-exists-p url) | ||
295 | ;; This takes care of updating too. | ||
296 | (package-install-file url) | ||
297 | (error "(yoke) No such file: `%s'" url)))) | ||
298 | |||
299 | ;;; Other package transactions | ||
300 | |||
301 | (defun yoke--choose-package () | ||
302 | "Choose a package from `yoke-selected-packages'." | ||
303 | (assoc (intern (completing-read "Package: " yoke-selected-packages)) | ||
304 | yoke-selected-packages)) | ||
305 | |||
306 | (defun yoke-update (name &rest args) | ||
307 | (interactive (yoke--choose-package)) | ||
308 | (save-window-excursion | ||
309 | (apply #'yoke-install name (append '(:update t) | ||
310 | args)))) | ||
311 | |||
312 | (defun yoke-update-all () | ||
313 | (interactive) | ||
314 | (dolist (pkg yoke-selected-packages) | ||
315 | (apply #'yoke-update pkg))) | ||
316 | |||
317 | ;;; Emacs integration | ||
318 | |||
319 | (defun yoke-imenu-insinuate () | ||
320 | "Insinuate `yoke' forms for `imenu'." | ||
321 | (require 'imenu) | ||
322 | (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) | ||
323 | (list "(yoke[[:space:]]*(?\\([^\t\n )]*\\)" | ||
324 | 1)) | ||
325 | (with-eval-after-load 'consult-imenu | ||
326 | (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode | ||
327 | consult-imenu-config) | ||
328 | :types)) | ||
329 | '("Yoke")))) | ||
330 | |||
331 | ;;; Utility functions | ||
332 | |||
333 | (defun yoke--pget (spec prop &optional default) | ||
334 | "Get PROP's value from SPEC, a yoke specification. | ||
335 | If KEY doesn't exist, return DEFAULT." | ||
336 | (let ((pl (or (and (plistp spec) spec) | ||
337 | (cdr-safe spec)))) | ||
338 | (if (plist-member pl prop) | ||
339 | (plist-get pl prop) | ||
340 | default))) | ||
341 | |||
342 | (defun yoke--guess-backend (url) | ||
343 | "Guess the backend to use from URL. | ||
344 | If inconclusive, return nil." | ||
345 | (cond | ||
346 | ((or (string-prefix-p "file:" url t) | ||
347 | (string-prefix-p "~" url) | ||
348 | (string-prefix-p "/" url)) | ||
349 | 'file) | ||
350 | (:else nil))) | ||
351 | |||
352 | (defun yoke--clean-load-path () | ||
353 | (when-let ((first (string-remove-suffix "/" (car load-path))) | ||
354 | (second (string-remove-suffix "/" (cadr load-path))) | ||
355 | (_ (equal first second))) | ||
356 | (setf load-path (cdr load-path)) | ||
357 | (setf (car load-path) second))) | ||
358 | |||
359 | (defun yoke--eval-after-init (fn) | ||
360 | "Evaluate FN after inititation, or now if Emacs is initialized. | ||
361 | FN is called with no arguments." | ||
362 | (if after-init-time | ||
363 | (funcall fn) | ||
364 | (add-hook 'after-init-hook fn))) | ||
365 | |||
366 | (defmacro yoke--eval-after (prereqs &rest body) | ||
367 | "Evaluate body after PREREQS. | ||
368 | PREREQS can be a feature, a number, `:init', or a list of those. | ||
369 | |||
370 | Features are used as arguments to `eval-after-load'. Numbers are | ||
371 | used as arguments to `run-with-idle-timer'. `:init' will ensure BODY | ||
372 | runs after Emacs's init time. | ||
373 | |||
374 | When given a list of PREREQS, `eval-after' will nest each one | ||
375 | from left to right." | ||
376 | (declare (indent 1) (debug (form def-body))) | ||
377 | (setf prereqs (ensure-list prereqs)) | ||
378 | (if (null prereqs) | ||
379 | (macroexp-progn body) | ||
380 | (let* ((this (car prereqs)) | ||
381 | (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body))))) | ||
382 | (cond | ||
383 | ((eq this :init) | ||
384 | (append '(yoke--eval-after-init) form)) | ||
385 | ((numberp this) | ||
386 | (append `(run-with-idle-timer ,this nil) form)) | ||
387 | ((symbolp this) | ||
388 | (append `(eval-after-load ',this) form)) | ||
389 | (:else (user-error "Eval-after: Bad prereq: %S" this)))))) | ||
390 | |||
391 | (provide 'yoke) | ||
392 | ;;; yoke.el ends here | ||