summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-01-03 23:03:03 -0600
committerCase Duckworth2023-01-03 23:03:03 -0600
commit59a1f58695d09ab29ddf992b2c0711c94a4039ea (patch)
tree1de8114d3b60d11b9a3b92422d178f17e1841ea0
parentbleh (diff)
downloademacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.tar.gz
emacs-59a1f58695d09ab29ddf992b2c0711c94a4039ea.zip
Switch to use-package
-rw-r--r--early-init.el121
-rw-r--r--init.el2336
-rw-r--r--lisp/+browse-url.el189
-rw-r--r--lisp/+cape.el25
-rw-r--r--lisp/+custom.el52
-rw-r--r--lisp/+emacs.el422
-rw-r--r--lisp/+emms.el38
-rw-r--r--lisp/+hungry-delete.el53
-rw-r--r--lisp/+isearch.el24
-rw-r--r--lisp/+notmuch.el52
-rw-r--r--lisp/+org-capture.el197
-rw-r--r--lisp/+org.el268
-rw-r--r--lisp/+ox.el29
-rw-r--r--lisp/+paredit.el26
-rw-r--r--lisp/+tempo.el45
-rw-r--r--lisp/+titlecase.el6
-rw-r--r--lisp/+window.el130
-rw-r--r--lisp/acdw-defaults.el292
-rw-r--r--lisp/acdw-funs.el262
-rw-r--r--lisp/acdw-macs.el293
-rw-r--r--lisp/acdw.el345
-rw-r--r--lisp/browse-url-transform.el45
-rw-r--r--lisp/dawn.el109
-rw-r--r--lisp/def.el142
-rw-r--r--lisp/graveyard.el50
-rw-r--r--lisp/init-org.el144
-rw-r--r--lisp/org-word-count.el297
-rw-r--r--lisp/pita.el69
-rw-r--r--lisp/private.el23
-rw-r--r--lisp/scule.el61
-rw-r--r--lisp/upload-junk.el47
-rw-r--r--lisp/yoke.el664
32 files changed, 3083 insertions, 3773 deletions
diff --git a/early-init.el b/early-init.el index 8004342..b841ea5 100644 --- a/early-init.el +++ b/early-init.el
@@ -1,98 +1,95 @@
1;;; early-init.el --- Emacs early init -*- lexical-binding: t; -*- 1;;; early-init.el --- Emacs early init -*- lexical-binding: t -*-
2
2;; by C. Duckworth <acdw@acdw.net> 3;; by C. Duckworth <acdw@acdw.net>
3;; Bankruptcy: 9
4 4
5;;; Speed up init 5;; Bankruptcy: 9.3
6
7;;; Debugging --- delete this when done bankrupting
8(setf debug-on-error t
9 use-package-verbose t)
10
11;;; Speedy startup
6 12
7;; Restore things after init
8(defvar +emacs--startup-restore-alist nil 13(defvar +emacs--startup-restore-alist nil
9 "Variables and values to restore after init.") 14 "Variables to restore after startup.")
10 15
11(add-hook 'emacs-startup-hook 16(defun +emacs-startup@restore-variables ()
12 (defun emacs-startup@restore-values () 17 "Restore variables set temporarily during startup."
13 "Restore values set during init. 18 (dolist (v +emacs--startup-restore-alist)
14This applies values in `+emacs--startup-restore-alist'." 19 (set-default (car v) (cdr v))))
15 (dolist (a +emacs--startup-restore-alist) 20(add-hook 'after-init-hook #'+emacs-startup@restore-variables)
16 (set (car a) (cdr a)))))
17 21
18(defun +set-during-startup (variable value &optional restore) 22(defun +set-during-startup (variable value &optional restore)
19 "Set VARIABLE to VALUE during startup, but restore to RESTORE. 23 "Set VARIABLE to VALUE during startup.
20If RESTORE is nil or not passed, save the original value and 24If RESTORE is non-nil, restore the variable's value to it.
21restore that." 25Otherwise, save its original value and restore to that."
22 (unless after-init-time 26 (unless after-init-time
23 (setf (alist-get variable +emacs--startup-restore-alist) 27 (setf (alist-get variable +emacs--startup-restore-alist)
24 (or restore (symbol-value variable))) 28 (or restore (symbol-value variable)))
25 (set-default variable value))) 29 (set-default variable value)))
26 30
27;; Garbage collection
28(+set-during-startup 'gc-cons-threshold most-positive-fixnum) 31(+set-during-startup 'gc-cons-threshold most-positive-fixnum)
29 32
30(add-hook 'minibuffer-setup-hook (defun garbage-collect@minibuffer-enter () 33;;; Distraction-free startup
31 (setf gc-cons-threshold most-positive-fixnum)))
32(add-hook 'minibuffer-exit-hook (defun garbage-collect@minibuffer-exit ()
33 (setf gc-cons-threshold 800000)))
34 34
35;; Don't prematurely re-display
36(unless debug-on-error 35(unless debug-on-error
37 (+set-during-startup 'inhibit-redisplay t) 36 (+set-during-startup 'inhibit-redisplay t)
38 (+set-during-startup 'inhibit-message t)) 37 (+set-during-startup 'inhibit-message t))
39 38
40;; Debug during init 39(setf warning-minimum-level :emergency)
41(unless (eq debug-on-error 'startup) 40(add-hook 'emacs-startup-hook
42 (+set-during-startup 'debug-on-error 'init)) 41 (defun +message-about-warnings ()
43 42 (when-let ((warnings (get-buffer "*Warnings*")))
44;;; Default frame settings 43 (message "%s. %s." "There were init-time warnings"
44 "See the `*Warnings*' buffer."))))
45 45
46(setf default-frame-alist '((tool-bar-lines . 0) 46(setf default-frame-alist '((tool-bar-lines . 0)
47 (menu-bar-lines . 0) 47 (menu-bar-lines . 0)
48 (vertical-scroll-bars) 48 (vertical-scroll-bars . nil)
49 (horizontal-scroll-bars)) 49 (horizontal-scroll-bars . nil))
50 frame-inhibit-implied-resize t 50 frame-inhibit-implied-resize t
51 frame-resize-pixelwise t 51 frame-resize-pixelwise t
52 window-resize-pixelwise t 52 window-resize-pixelwise t
53 inhibit-x-resources t 53 inhibit-x-resources t
54 indicate-empty-lines nil 54 indicate-empty-lines nil
55 indicate-buffer-boundaries nil 55 indicate-buffer-boundaries nil)
56 ;; '((top . right) 56
57 ;; (bottom . right)) 57;;; Packages
58 )
59 58
60;;; Set up extra load paths and functionality 59(require 'package)
61 60
62(push (expand-file-name (locate-user-emacs-file "lisp")) load-path) 61(dolist (archive
63(require 'acdw) 62 '(("gnu-devel" . "https://elpa.gnu.org/devel/")
63 ("nongnu-devel" . "https://elpa.gnu.org/nongnu-devel/")
64 ("melpa" . "https://melpa.org/packages/")))
65 (add-to-list 'package-archives archive :append))
64 66
65(+define-dir .etc (locate-user-emacs-file "etc") 67(setf package-archive-priorities
66 "Directory for all of Emacs's various files. 68 '(("gnu-devel" . 2)
67See `no-littering' for examples.") 69 ("nongnu-devel" . 1)
70 ("melpa" . 0)
71 ("gnu" . 0)
72 ("nongnu" . 0)))
68 73
69(+define-dir sync/ (expand-file-name "~/Sync") 74(package-initialize)
70 "My Syncthing directory.")
71 75
72(+define-dir private/ (sync/ "emacs/private")) 76(unless package-archive-contents
73(add-to-list 'load-path private/) 77 (package-refresh-contents))
74 78
75;;; Packages 79;; https://melpa.org/packages/archive-contents
76 80
77(setf package-enable-at-startup nil 81;;; Use-package
78 package-quickstart nil)
79 82
80(require 'yoke) 83(setf use-package-enable-imenu-support t
81(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) 84 use-package-hook-name-suffix nil)
82 85
83(yoke (compat "https://git.sr.ht/~pkal/compat")) 86(require 'use-package)
84 87
85(yoke (no-littering "https://github.com/emacscollective/no-littering") 88(setf use-package-compute-statistics debug-on-error)
86 (setf no-littering-etc-directory .etc
87 no-littering-var-directory .etc
88 custom-file (.etc "custom.el"))
89 (require 'no-littering)
90 (when (boundp 'native-comp-eln-load-path)
91 (setcar native-comp-eln-load-path (expand-file-name (.etc "eln-cache" t))))
92 (when (boundp 'comp-eln-load-path)
93 (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t))))
94 (when (fboundp 'startup-redirect-eln-cache)
95 (startup-redirect-eln-cache (convert-standard-filename (.etc "eln-cache/")))))
96 89
97(provide 'early-init) 90(use-package use-package-vc
98;;; early-init.el ends here 91 :load-path "~/src/emacs/use-package-vc.el"
92 :config
93 (define-advice package-vc-install (:around (orig &rest args) wtf)
94 (let ((package-archives nil))
95 (apply orig args))))
diff --git a/init.el b/init.el index ffe7f81..3fcf374 100644 --- a/init.el +++ b/init.el
@@ -1,1228 +1,977 @@
1;;; emacs init --- an init for emacs -*- lexical-binding: t; -*- 1;;; init.el --- a config of one's own -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; by C. Duckworth <acdw@acdw.net>
3;; URL: https://git.acdw.net/emacs 3;; Bankruptcy: 9.3
4;; Bankruptcy: 9 4
5;; 5;;; Code:
6;; Everyone is permitted to do whatever they like with this software 6
7;; without limitation. This software comes without any warranty 7;;; Remove when done bankrupting
8;; whatsoever, but with two pieces of advice: 8
9;; - Be kind to yourself. 9(defkeys t "C-x C-c" #'restart-emacs)
10;; - Make good choices. 10
11 11;;; My extras
12(yoke +emacs 12
13 (require* '+emacs '+window '+lisp) 13(push (expand-file-name (locate-user-emacs-file "lisp")) load-path)
14 ;; Settings 14(require 'acdw) ; Omnibus fun stuff
15 (setc truncate-string-ellipsis "…" 15
16 ring-bell-function #'ignore 16;;; Basic defaults
17 read-file-name-completion-ignore-case t 17
18 comment-auto-fill-only-comments t 18(use-package no-littering
19 password-cache t 19 :ensure t
20 password-cache-expiry (* 60 60) 20 :demand t
21 switch-to-buffer-in-dedicated-window 'pop 21 :custom
22 switch-to-buffer-obey-display-actions t 22 (no-littering-etc-directory etc/)
23 initial-buffer-choice (defun +initial-buffer-choose () 23 (no-littering-var-directory var/)
24 (cond 24 (custom-file (etc/ "custom.el"))
25 ((equal (get-buffer "*Messages*") 25 (auto-save-file-name-transforms `(("." ,(var/ "auto-save/") t)))
26 (other-buffer)) 26 (auto-save-list-file-prefix (var/ "auto-save/.saves-" t))
27 (get-buffer "*scratch*")) 27 (backup-directory-alist `(("." . ,(var/ "backup/" t)))))
28 (:else (other-buffer))))) 28
29 ;; "Safe" variables 29(use-package custom-allowed
30 (dolist (var+pred 30 :load-path "~/src/emacs/custom-allowed/"
31 '((browse-url-browser-function 31 :custom
32 ;; All types defined by custom are safe. 32 (custom-file (private/ "custom.el"))
33 . (lambda (f) 33 :config
34 ;; Whooooo boy 34 (dolist (var '(safe-local-variable-values
35 (memq f (mapcar (lambda (i) 35 warning-suppress-types
36 (plist-get (cdr i) :value)) 36 ispell-buffer-session-localwords
37 (seq-filter 37 calendar-latitude
38 (lambda (i) 38 calendar-longitude
39 (eq (car i) 'function-item)) 39 user-full-name
40 (cdr (get 'browse-url-browser-function 40 user-mail-address))
41 'custom-type))))))))) 41 (add-to-list 'custom-allowed-variables var))
42 (put (car var+pred) 'safe-local-variable (cdr var+pred))) 42 :hook
43 ;; Keys 43 (after-init-hook . custom-allowed-load-custom-file))
44 (defkeys t 44
45 "C-x C-k" #'kill-current-buffer 45(use-package modus-themes
46 "C-/" #'undo-only 46 :load-path "~/usr/share/emacs/30.0.50/etc/themes/"
47 "C-?" #'undo-redo 47 :custom
48 "C-x C-c" (defun delete-frame-or-quit (arg) 48 (modus-themes-bold-constructs t)
49 (interactive "P") 49 (modus-themes-italic-constructs t)
50 (cond (arg (delete-frame nil :force)) 50 (modus-themes-variable-pitch-ui nil))
51 ((= 1 (length (frame-list))) 51
52 (and (yes-or-no-p "Kill emacs? ") 52(use-package dawn
53 (save-buffers-kill-emacs t))) 53 :load-path "~/src/emacs/dawn/"
54 (:else (delete-frame)))) 54 :after modus-themes
55 "C-x r q" (defun really-quit-emacs (arg) 55 :config
56 (interactive "P") 56 (load-theme 'modus-operandi :noconfirm :noenable)
57 (cond (arg (save-buffers-kill-emacs t)) 57 (load-theme 'modus-vivendi :noconfirm :noenable)
58 (:else (save-buffers-kill-terminal t)))) 58 (defhook custom-allowed-after-load-hook
59 "M-SPC" #'+cycle-spacing 59 (dawn-schedule-themes 'modus-operandi
60 ;; "M-/" #'hippie-expand ; `hippie-completing-read' 60 'modus-vivendi)
61 "M-=" #'count-words 61 (set-face-attribute 'default nil
62 "C-x C-b" #'ibuffer 62 :family "IBM Plex Mono"
63 "C-x 4 n" #'clone-buffer 63 :height 100)
64 "S-<down-mouse-1>" #'mouse-set-mark 64 (set-face-attribute 'variable-pitch nil
65 "C-x 0" #'+delete-window-or-bury-buffer 65 :family "Georgia"
66 ;; "M-j" nil ; `avy' 66 :height 1.2)))
67 "<Scroll_Lock>" nil 67
68 "C-z" nil 68(use-package midnight
69 "M-o" #'other-window|switch-buffer 69 :config
70 "C-M-;" #'+lisp-comment-or-uncomment-sexp 70 (add-hook 'midnight-mode-hook #'recentf-cleanup)
71 "C-x 5 z" #'suspend-frame 71 (midnight-mode))
72 "C-x f" #'find-file 72
73 "C-c t" (defmap toggle-map 73(use-package sophomore
74 "A map for toggling various settings." 74 :load-path "~/src/emacs/sophomore/"
75 "d" (defmap toggle-debug-map 75 :config
76 "Easily toggle debug flavors." 76 (sophomore-enable-all)
77 "e" #'toggle-debug-on-error 77 (sophomore-disable 'view-hello-file
78 "q" #'toggle-debug-on-quit) 78 'describe-gnu-project
79 "w" #'toggle-word-wrap 79 'suspend-frame)
80 "t" #'toggle-truncate-lines 80 (sophomore-mode))
81 "c" #'column-number-mode 81
82 "l" #'line-number-mode 82;;; Completions
83 "v" (defmap toggle-view-map 83
84 "Easily toggle UI elements' views." 84(use-package vertico
85 "c" #'display-fill-column-indicator-mode 85 :ensure t
86 "l" #'display-line-numbers-mode 86 :custom
87 "m" #'menu-bar-mode 87 (resize-mini-windows 'grow-only)
88 "t" #'tool-bar-mode 88 (vertico-cycle t)
89 "s" #'scroll-bar-mode))) 89 :init
90 (defkeys text-mode-map 90 (use-package vertico-directory
91 "C-M-k" #'kill-paragraph 91 :after vertico
92 "C-o" (defun open-paragraph (&optional arg) 92 :config
93 "Open a paragraph after paragraph at point. 93 (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy))
94A paragraph is defined as continguous non-empty lines of text 94 (vertico-mode))
95surrounded by empty lines, so opening a paragraph means to make 95
96three blank lines, then place the point on the second one. 96(use-package marginalia
97 97 :ensure t
98Called with prefix ARG, open a paragraph before point." 98 :demand t
99 ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. 99 :config
100 (interactive "*P") 100 (add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode)
101 ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because 101 (marginalia-mode))
102 ;; that's weird with org, and I'm guessing other modes too.
103 (unless (looking-at "^$") (forward-line (if arg -1 +1)))
104 (while (and (not (looking-at "^$"))
105 (= 0 (forward-line (if arg -1 +1)))))
106 (newline)
107 (when arg (newline) (forward-line -2))
108 (delete-blank-lines)
109 (newline 2)
110 (previous-line)))
111 ;; Hooks
112 (add-hook 'after-save-hook
113 #'executable-make-buffer-file-executable-if-script-p)
114 (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
115 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs)
116 (add-hook 'text-mode-hook #'abbrev-mode)
117 (add-hook 'find-file-hook #'+vc-off-when-remote)
118 (add-hook 'prog-mode-hook #'auto-fill-mode)
119 ;; Advice
120 (add-function :after after-focus-change-function
121 #'+save-some-buffers-debounce)
122 (define-advice keyboard-escape-quit (:around (fn &rest r) keep-window-open)
123 "Don't close quits on `keyboard-escape-quit'."
124 (let ((buffer-quit-function #'ignore))
125 (apply fn r)))
126 ;; Faces
127 (set-face-attribute 'default nil :family "Comic Code" :height 100)
128 (set-face-attribute 'bold nil :family "Comic Code" :weight 'bold)
129 (set-face-attribute 'variable-pitch nil :family "Comic Code")
130 ;; Modes
131 (winner-mode))
132
133(yoke custom ; This is `cus-edit' but meh
134 (require '+custom)
135 (setf custom-file (private/ "custom.el"))
136 (add-to-list* '+custom-allowed-variables
137 'safe-local-variable-values
138 'warning-suppress-types
139 'ispell-buffer-session-localwords)
140 (eval-after init
141 (+custom-load-some-customizations :noerror)))
142
143;; (yoke modus-themes
144;; (setc modus-themes-bold-constructs t
145;; modus-themes-italic-constructs t
146;; modus-themes-headings '((1 monochrome bold italic)
147;; (2 monochrome bold)
148;; (3 monochrom italic)
149;; (t monochrome)))
150;; (defhook modus-themes-after-load-theme-hook
151;; :name modus-monochrome
152;; (modus-themes-with-colors
153;; (cl-loop for x being the symbols
154;; if (string-match-p "\\`font-lock-.*-face\\'"
155;; (symbol-name x))
156;; do
157;; (custom-set-faces
158;; `(,x ((,class :foreground
159;; ,(cond
160;; ((memq x '(font-lock-string-face
161;; font-lock-doc-face
162;; font-lock-doc-markup-face))
163;; fg-special-warm)
164;; ((memq x '(font-lock-warning-face))
165;; fg-lang-warning)
166;; ((memq x '(font-lock-comment-face))
167;; fg-alt)
168;; (:else 'unspecified))
169;; :background unspecified
170;; :weight
171;; ,(cond
172;; ((memq x '(font-lock-keyword-face))
173;; 'bold)
174;; (:else 'normal))
175;; :slant
176;; ,(cond
177;; ((memq x '(font-lock-doc-face
178;; font-lock-comment-face))
179;; 'italic)
180;; (:else 'normal))
181;; :underline
182;; ,(cond
183;; ((memq x '(font-lock-warning-face))
184;; t)
185;; (:else nil)))))))))
186;; (when (or (custom-theme-enabled-p 'modus-operandi)
187;; (custom-theme-enabled-p 'modus-vivendi))
188;; (modus-monochrome))
189;; (cond ((require 'dawn nil :noerrer)
190;; (defhook +custom-after-load-hook
191;; :name dawn@custom
192;; (load-theme 'modus-operandi :noconfirm :noenable)
193;; (load-theme 'modus-vivendi :noconfirm :noenable)
194;; (dawn-schedule #'modus-themes-load-operandi
195;; #'modus-themes-load-vivendi)))
196;; (:else (modus-themes-load-operandi))))
197
198(yoke time
199 (setc display-time-mail-function
200 (defun +notmuch-new-mail-p ()
201 (plist-get (cl-find "inbox+unread"
202 (ignore-errors
203 (notmuch-hello-query-counts notmuch-saved-searches))
204 :key (lambda (l) (plist-get l :name))
205 :test #'equal)
206 :count))
207 display-time-use-mail-icon nil
208 display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p))
209 read-mail-command #'+notmuch-goto
210 display-time-format " %a %-e, %H:%M"
211 ;; `display-time-format' makes these unnecessary, but I'll keep em
212 display-time-24hr-format t
213 display-time-day-and-date t
214 display-time-default-load-average nil)
215 (define-advice display-time-update (:after (&rest _) update-mail-count)
216 (setq display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p))))
217 (display-time-mode))
218
219(yoke pita
220 (require 'pita)
221 (advice-add 'indent-region :before #'with-region-or-buffer))
222
223(yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session")
224 (setc undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
225 "/git-rebase-todo\\'")
226 undo-fu-session-directory (.etc "undo/" t)
227 undo-fu-session-compression (cond
228 ((executable-find "gzip") 'gz)
229 ((executable-find "bzip2") 'bz2)
230 ((executable-find "xz") 'xz)
231 (t nil)))
232 (global-undo-fu-session-mode))
233
234(yoke whitespace
235 (setc whitespace-line-column nil
236 whitespace-style '( face trailing
237 tabs tab-mark
238 indentation
239 space-after-tab space-before-tab))
240 (defhook (text-mode-hook prog-mode-hook read-only-mode-hook)
241 :name +whitespace-mode-for-writable-buffers
242 :doc "Turn on `whitespace-mode' if the buffer is writable, off otherwise."
243 (whitespace-mode (if buffer-read-only -1 t)))
244 (defhook before-save-hook #'whitespace-cleanup)
245 (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point)
246 (let ((col (current-column)))
247 (apply fn r)
248 (move-to-column col t)
249 (set-buffer-modified-p nil))))
250
251(yoke elisp-mode
252 (setc eval-expression-print-length nil ; remove ellipses from `eval-expression'
253 eval-expression-print-level nil)
254 (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map)
255 "C-c C-c" #'eval-defun
256 "C-c C-k" (defun +elisp-eval-region-or-buffer ()
257 (interactive)
258 (cond
259 ((region-active-p)
260 (eval-region (region-beginning) (region-end))
261 (message "Region evaluated."))
262 (t
263 (eval-buffer)
264 (message "Buffer %s evaluated." (buffer-name)))))
265 "C-c C-z" #'ielm)
266 (define-advice eval-region (:around (fn beg end &rest args) pulse)
267 (apply fn beg end args)
268 (pulse-momentary-highlight-region beg end)))
269
270(yoke isearch
271 (defkeys t
272 "C-s" #'isearch-forward-regexp
273 "C-r" #'isearch-backward-regexp
274 "C-M-s" #'isearch-forward
275 "C-M-r" #'isearch-backward))
276 102
277(yoke ispell 103(use-package orderless
278 (require* '+ispell 'ispell) 104 :ensure t
279 (add-hook 'before-save-hook 105 :custom
280 #'+ispell-move-buffer-words-to-dir-locals-hook) 106 (completion-styles '(orderless basic))
281 (setc ispell-program-name (or (executable-find "ispell") 107 (completion-category-overrides
282 (executable-find "aspell"))) 108 '((file (styles basic partial-completion)))))
283 (put 'ispell-buffer-session-localwords 109
284 'safe-local-variable #'+ispell-safe-local-p)) 110(use-package consult
285 111 :ensure t
286 112 :custom
287(yoke mouse 113 (register-preview-delay 0.01)
288 ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html 114 (register-preview-function #'consult-register-format)
289 ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 115 (xref-show-xrefs-function #'consult-xref)
290 (when (fboundp 'context-menu-mode) 116 (tab-always-indent 'complete)
291 (setc context-menu-functions '(context-menu-ffap 117 (completion-in-region-function #'consult-completion-in-region)
292 context-menu-region 118 (consult-narrow-key "<")
293 context-menu-undo 119 (consult--regexp-compiler #'consult--default-regexp-compiler)
294 ;; context-menu-dictionary 120 :config
295 ))
296 (context-menu-mode +1))
297 (dolist (click '(;; Fix scrolling in the margin
298 wheel-down double-wheel-down triple-wheel-down
299 wheel-up double-wheel-up triple-wheel-up))
300 (global-set-key (vector 'right-margin click) 'mwheel-scroll)
301 (global-set-key (vector 'left-margin click) 'mwheel-scroll)))
302
303(yoke dired
304 (require 'dired-x)
305 (setc dired-recursive-copies 'always
306 dired-recursive-deletes 'always
307 dired-create-destination-dirs 'always
308 dired-do-revert-buffer t
309 dired-hide-details-hide-symlink-targets nil
310 dired-isearch-filenames 'dwim
311 delete-by-moving-to-trash t
312 dired-auto-revert-buffer t
313 dired-listing-switches "-AlF"
314 ls-lisp-dirs-first t
315 dired-ls-F-marks-symlinks t
316 dired-clean-confirm-killing-deleted-buffers nil
317 dired-no-confirm '(byte-compile
318 load chgrp chmod chown
319 copy move hardlink symlink
320 shell touch)
321 dired-dwim-target t)
322 (setq-local-hook dired-mode-hook
323 truncate-lines t)
324 (defkeys t
325 "C-x C-j" #'dired-jump
326 [remap list-directory] #'dired)
327 (defkeys ((dired-mode-map :after dired))
328 "<backspace>" #'dired-up-directory
329 "C-j" #'dired-up-directory)
330 (defhook dired-mode-hook
331 #'dired-hide-details-mode
332 #'hl-line-mode))
333
334(yoke (dired-hacks "https://github.com/Fuco1/dired-hacks")
335 (defkeys dired-mode-map
336 "TAB" #'dired-subtree-sycle
337 "i" #'dired-subtree-toggle)
338 (defhook 'dired-mode-hook
339 #'dired-collapse-mode))
340
341(yoke auth-source
342 (setc auth-sources `(default "secrets:passwords"))
343 (setq-local-hook authinfo-mode-hook
344 truncate-lines t))
345
346(yoke (consult "https://github.com/minad/consult")
347 (require 'consult)
348 (setf register-preview-delay 0
349 register-preview-function #'consult-register-format
350 xref-show-xrefs-function #'consult-xref
351 tab-always-indent 'complete
352 completion-in-region-function #'consult-completion-in-region
353 consult-narrow-key "<"
354 consult--regexp-compiler #'consult--default-regexp-compiler)
355 (advice-add #'register-preview :override #'consult-register-window) 121 (advice-add #'register-preview :override #'consult-register-window)
356 (define-key* (current-global-map) 122 (define-advice completing-read-multiple (:filter-args (args) indicator)
357 ;; Etc 123 (cons (format "[CRM%s] %s"
358 "M-S-x" #'consult-mode-command 124 (replace-regexp-in-string
359 ;; C-c bindings (mode-specific-map) 125 "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" ""
360 "C-c h" #'consult-history 126 crm-separator)
361 "C-c b" #'consult-bookmark 127 (car args))
362 "C-c k" #'consult-kmacro 128 (cdr args)))
363 ;; C-x bindings (ctl-x-map) 129 :bind
364 "C-x M-:" #'consult-complex-command 130 (([remap switch-to-buffer] . consult-buffer)
365 "C-x b" #'consult-buffer 131 ([remap switch-to-buffer-other-window] . consult-buffer-other-window)
366 "C-x 4 b" #'consult-buffer-other-window 132 ([remap switch-to-buffer-other-frame] . consult-buffer-other-frame)
367 "C-x 5 b" #'consult-buffer-other-frame 133 ([remap yank-pop] . consult-yank-pop)
368 ;; Custom M-# bindings for fast register access 134 ("M-g g" . consult-goto-line)
369 "M-#" #'consult-register-load 135 ("M-g M-g" . consult-goto-line)
370 "M-'" #'consult-register-store 136 ("M-g i" . consult-imenu)
371 "C-M-#" #'consult-register 137 ("M-g M-i" . consult-imenu)
372 ;; Other custom bindings 138 ("M-s l" . consult-line)
373 "M-y" #'consult-yank-pop 139 ("M-s f" . consult-find)
374 ;;("<f1> a" . consult-apropos) 140 ("M-s M-f" . consult-find)
375 ;; M-g bindings (goto-map) 141 ("M-s g" . consult-grep)
376 "M-g e" #'consult-compile-error 142 ("M-s M-g" . consult-grep)))
377 "M-g f" #'consult-flymake ; or consult-flycheck 143
378 "M-g g" #'consult-goto-line 144;;; General enhancements
379 "M-g M-g" #'consult-goto-line 145
380 "M-g o" #'consult-outline ; or consult-org-heading 146(use-package embark
381 "M-g m" #'consult-mark 147 :ensure t
382 "M-g k" #'consult-global-mark 148 :custom
383 "M-g i" #'consult-imenu 149 (prefix-help-command #'embark-prefix-help-command)
384 "M-g M-i" #'consult-imenu 150 :bind
385 "M-g I" #'consult-imenu-multi 151 (("C-." . embark-act)
386 ;; M-s bindings (search-map) 152 ("M-." . embark-dwim)
387 "M-s f" #'consult-find 153 ("C-h b" . embark-bindings))
388 "M-s F" #'consult-locate 154 :custom
389 "M-s g" #'consult-grep 155 (add-to-list 'display-buffer-alist
390 "M-s G" #'consult-git-grep 156 '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
391 "M-s r" #'consult-ripgrep 157 nil
392 "M-s l" #'consult-line 158 (window-parameters (mode-line-format . none)))))
393 "M-s L" #'consult-line-multi 159
394 "M-s m" #'consult-multi-occur 160(use-package embark-consult
395 "M-s k" #'consult-keep-lines 161 :ensure t
396 "M-s u" #'consult-focus-lines 162 :after (embark consult)
397 ;; Isearch integration 163 :hook (embark-collect-mode-hook . consult-preview-at-point-mode))
398 "M-s e" #'consult-isearch-history) 164
399 (eval-after isearch-mode 165(use-package undo-fu-session
400 (define-key* isearch-mode-map 166 :ensure t
401 "M-e" #'consult-isearch-history 167 :custom
402 "M-s e" #'consult-isearch-history 168 (undo-fu-session-directory (etc/ "undo/" t))
403 "M-s l" #'consult-line 169 (undo-fu-session-incompatible-files
404 "M-s L" #'consult-line-multi)) 170 '("/COMMIT_EDITMSG\\'"
405 (eval-after org 171 "/git-rebase-todo\\'"))
406 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) 172 (undo-fu-session-compression
407 (eval-after consult-imenu 173 (cl-loop for (exe . sym) in '(("gzip" . gz)
408 (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode 174 ("bzip2" . bz2)
409 consult-imenu-config) 175 ("xz" . xz))
410 :types)) 176 if (executable-find exe)
411 '("Yoke")))) 177 return sym))
412 178 :config
413(yoke (orderless "https://github.com/oantolin/orderless") 179 (global-undo-fu-session-mode))
414 (require 'orderless)
415 (setf completion-styles '(substring orderless basic)
416 completion-category-defaults nil
417 completion-category-overrides
418 '((file (styles basic partial-completion)))
419 orderless-component-separator #'orderless-escapable-split-on-space))
420
421(yoke (vertico "https://github.com/minad/vertico")
422 (require 'vertico)
423 (setf resize-mini-windows 'grow-only
424 vertico-count-format nil
425 vertico-cycle t)
426 (vertico-mode)
427 (add-to-list 'load-path (expand-file-name "vertico/extensions" yoke-dir))
428 (require 'vertico-directory)
429 (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy))
430
431(yoke (embark "https://github.com/oantolin/embark")
432 (require 'embark)
433 (setf prefix-help-command #'embark-prefix-help-command
434 embar-keymap-prompter-key ";")
435 (defkeys (t minibuffer-local-map)
436 "C-." #'embark-act
437 "M-." #'embark-dwim
438 "<f1> B" #'embark-bindings)
439 (define-key* embark-file-map
440 "l" #'vlf)
441 (eval-after (embark consult)
442 (require 'embark-consult)
443 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)))
444
445(yoke (marginalia "https://github.com/minad/marginalia/")
446 (marginalia-mode))
447 180
448(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") 181(use-package ws-butler
449 (require 'wgrep) 182 :ensure t
450 (define-key* grep-mode-map 183 :custom
451 "C-x C-q" #'wgrep-change-to-wgrep-mode)) 184 (ws-butler-trim-predicate (lambda (begin end)
185 (not (eq 'font-lock-string-face
186 (get-text-property end 'face)))))
187 :config
188 (ws-butler-global-mode))
189
190(use-package minions
191 :ensure t
192 :config
193 (minions-mode))
452 194
453(yoke (slime "https://github.com/slime/slime") 195(use-package mode-line-bell
454 :when (executable-find "sbcl") 196 :vc ( :url "https://github.com/duckwork/mode-line-bell"
455 (setc inferior-lisp-program (executable-find "sbcl")) 197 :rev "remap-face")
456 (defhook lisp-mode-hook 198 :custom
457 :name slime-mode-setup 199 (mode-line-bell-flash-time 0.25)
458 (load (expand-file-name "~/quicklisp/slime-helper.el") :noerror) 200 :config
459 (slime-mode)) 201 (mode-line-bell-mode))
460 (eval-after slime 202
461 (setc slime-completion-at-point-functions 203(use-package electric-cursor
462 (delq 'slime-c-p-c-completion-at-point 204 :load-path "~/src/emacs/electric-cursor/"
463 slime-completion-at-point-functions)))) 205 :custom
464 206 (electric-cursor-alist '((overwrite-mode . box)
465(yoke (puni "https://github.com/amaikinono/puni") 207 (t . bar)))
466 (electric-pair-mode) 208 (electric-cursor-mode))
467 (defkeys puni-mode-map
468 "C-)" #'puni-slurp-forward
469 "C-(" #'puni-slurp-backward
470 "C-}" #'puni-barf-forward
471 "C-{" #'puni-barf-backward
472 "M-(" (defun +puni-open-then-slurp-forward (&optional n)
473 (interactive "p")
474 (insert "()")
475 (backward-char)
476 (ignore-errors (puni-slurp-forward n))))
477 (defhook (prog-mode-hook
478 lisp-interaction-mode-hook emacs-lisp-mode-hook
479 lisp-mode-hook scheme-mode-hook
480 ielm-mode-hook eval-expression-minibuffer-setup-hook)
481 #'puni-mode))
482
483(yoke (hungry-delete "https://github.com/nflath/hungry-delete")
484 (setc hungry-delete-chars-to-skip " \t"
485 hungry-delete-join-reluctantly nil)
486 (eval-after hungry-delete
487 (add-to-list* 'hungry-delete-except-modes
488 #'eshell-mode
489 #'nim-mode
490 #'python-mode))
491 (defun +hungry-delete-or (hd-fn fn arg)
492 (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg)
493 hd-fn
494 fn)
495 arg))
496 (defkeys puni-mode-map
497 [remap puni-backward-delete-char]
498 (defun +puni|hungry-delete-backward (arg)
499 (interactive "p")
500 (+hungry-delete-or #'hungry-delete-backward
501 #'puni-backward-delete-char
502 arg))
503 [remap puni-forward-delete-char]
504 (defun +puni|hungry-delete-forward (arg)
505 (interactive "p")
506 (+hungry-delete-or #'hungry-delete-forward
507 #'puni-forward-delete-char
508 arg)))
509 (global-hungry-delete-mode))
510 209
511(yoke (cape "https://github.com/minad/cape") 210(use-package visual-fill-column
512 ;; Insinuate in a lot of modes 211 :ensure t
513 (defvar +capes '(cape-file cape-dabbrev)) 212 :custom
514 (defun +cape-insinuate (hook capf &optional capes) 213 (visual-fill-column-center-text t)
515 "Insinuate CAPES into a HOOK along with CAPF function. 214 :hook ((visual-fill-column-mode-hook . visual-line-mode)
516CAPES defaults to `+capes'. CAPF will be made un-exclusive." 215 (eww-mode-hook . visual-fill-column-mode))
517 (setq-local-hook hook 216 :config
518 completion-at-point-functions 217 (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust))
519 (apply #'list (cape-capf-properties capf :exclusive 'no)
520 (or capes +capes))))
521 (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point))
522
523(yoke (minions "https://github.com/tarsius/minions")
524 (minions-mode))
525 218
526(yoke (magit "https://github.com/magit/magit" 219(use-package cape
527 :load "lisp") 220 :ensure t
528 :depends ((transient "https://github.com/magit/transient" 221 :demand t
529 :load "lisp") 222 :init
530 (dash "https://github.com/magnars/dash.el") 223 (dolist (fn '(cape-file cape-dabbrev))
531 (with-editor "https://github.com/magit/with-editor" 224 (add-hook 'completion-at-point-functions fn 90))
532 :load "lisp")) 225 :config
533 (autoload #'transient--with-suspended-override "transient") 226 (require '+cape)
534 (autoload #'magit "magit" nil :interactive) 227 (advice-add 'emacs-completion-at-point :around #'cape-wrap-nonexclusive)
535 (defkeys t 228 (+cape-insinuate text-mode-hook ( cape-dict cape-ispell
536 "C-x g" #'magit)) 229 cape-file cape-dabbrev)))
230
231(use-package wgrep
232 :ensure t
233 :custom
234 (wgrep-enable-key (kbd "C-x C-q"))
235 :bind (:map grep-mode-map
236 ("C-x C-q" . wgrep-change-to-wgrep-mode)))
237
238(progn
239 (use-package-statistics-gather :use-package 'mlscroll nil)
240 (use-package-ensure-elpa 'mlscroll
241 '(t)
242 'nil)
243 (use-package-statistics-gather :preface 'mlscroll nil)
244 (eval-and-compile
245 (defhook modus-themes-after-load-theme-hook :name modus-themes-load@mlscroll
246 (mlscroll-mode -1)
247 (when
248 (or
249 (memq 'modus-vivendi custom-enabled-themes)
250 (memq 'modus-operandi custom-enabled-themes))
251 (modus-themes-with-colors
252 (setf mlscroll-in-color fg-dim mlscroll-out-color bg-inactive)))
253 (eval-after 1
254 (mlscroll-mode 1))))
255 (defvar use-package--warning99
256 (function
257 (lambda
258 (keyword err)
259 (let
260 ((msg
261 (format "%s/%s: %s" 'mlscroll keyword
262 (error-message-string err))))
263 (display-warning 'use-package msg :error)))))
264 (condition-case-unless-debug err
265 (progn
266 (use-package-statistics-gather :init 'mlscroll nil)
267 (condition-case-unless-debug err
268 (when
269 (daemonp)
270 (add-hook 'server-after-make-frame
271 (function modus-themes-load@ml-scroll)))
272 (error
273 (funcall use-package--warning99 :init err)))
274 (run-with-idle-timer 1 nil
275 (function require)
276 'mlscroll nil t)
277 (eval-after-load 'mlscroll
278 '(progn
279 (use-package-statistics-gather :config 'mlscroll nil)
280 (let
281 ((now
282 (current-time)))
283 (message "%s..." "Configuring package mlscroll")
284 (prog1
285 (condition-case-unless-debug err
286 (progn
287 (modus-themes-load@mlscroll)
288 t)
289 (error
290 (funcall use-package--warning99 :config err)))
291 (let
292 ((elapsed
293 (float-time
294 (time-subtract
295 (current-time)
296 now))))
297 (if
298 (> elapsed 0.1)
299 (message "%s...done (%.3fs)" "Configuring package mlscroll" elapsed)
300 (message "%s...done" "Configuring package mlscroll")))))
301 (use-package-statistics-gather :config 'mlscroll t)))
302 (use-package-statistics-gather :init 'mlscroll t))
303 (error
304 (funcall use-package--warning99 :catch err)))
305 (use-package-statistics-gather :preface 'mlscroll t)
306 (use-package-statistics-gather :use-package 'mlscroll t))
307
308(use-package avy
309 :ensure t
310 :demand t
311 :custom
312 (avy-background t)
313 (avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm"))
314 :bind (("M-j" . avy-goto-char-timer)
315 :map isearch-mode-map
316 ("M-j" . avy-isearch)))
317
318(use-package zzz-to-char
319 :ensure t
320 :bind (("M-z" . zzz-to-char)))
321
322;;; Searching
323
324(use-package isearch-mb
325 :ensure t
326 :custom
327 (isearch-lazy-count t)
328 (isearch-regexp-lax-whitespace t)
329 ;; Space matches whitespace, newlines, punctuation
330 (search-whitespace-regexp "\\W+")
331 (search-default-mode t "Search using regexp by default.")
332 ;; Space matches any sequence of characters in a line
333 ;; search-whitespace-regexp ".*?"
334 (isearch-wrap-pause 'no)
335 :config
336 (require '+isearch)
337 (advice-add 'isearch-cancel :before
338 #'+isearch-cancel@add-search-to-history)
339 (advice-add 'perform-replace :around
340 #'+perform-replace-dont-exit-on-anykey)
341 (eval-after (isearch-mb consult)
342 (add-to-list 'isearch-mb--after-exit #'consult-line)
343 (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history)
344 (defkeys isearch-mb-minibuffer-map
345 "M-s l" #'consult-line
346 "M-r" #'consult-isearch-history))
347 (eval-after (isearch-mb anzu)
348 (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace)
349 (defkeys isearch-mb-minibuffer-map
350 "M-%" #'anzu-isearch-query-replace-regexp
351 "C-M-%" #'anzu-isearch-query-replace))
352 (isearch-mb-mode))
537 353
538(yoke (git-modes "https://github.com/magit/git-modes") 354(use-package anzu
539 (require 'git-modes)) 355 :ensure t
356 :bind
357 (("M-%" . anzu-query-replace-regexp)
358 ("C-M-%" . anzu-query-replace)))
540 359
541(yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") 360(use-package frowny
542 (setc visual-fill-column-center-text t) 361 :load-path "~/src/emacs/frowny/"
543 (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) 362 :config
544 (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) 363 (global-frowny-mode))
545 364
546(yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" 365(use-package transpose-frame
547 :load "lisp") 366 :ensure t
548 :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" 367 :bind
549 :load "lisp")) 368 (("C-x 5 t" . transpose-frame)))
550 ;; DON'T load system org 369
551 (setc load-path 370;;; Text editing
552 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) 371
553 load-path)) 372(use-package org
554 (setc org-adapt-indentation nil 373 :defer t
555 org-auto-align-tags t 374 :after derived
556 org-archive-mark-done t 375 :init
557 org-fold-catch-invisible-edits 'show-and-error 376 (require 'init-org)
558 org-clock-clocked-in-display 'mode-line 377 (require '_work))
559 org-clock-frame-title-format (cons 378
560 '(t org-mode-line-string) 379(use-package ispell
561 (cons " --- " frame-title-format)) 380 :custom
562 org-clock-string-limit 7 ; just the clock bit 381 (ispell-program-name (choose-executable "ispell" "aspell"))
563 ;; org-clock-string-limit 25 ; gives enough information 382 :config
564 org-clock-persist nil 383 (require '+ispell)
565 org-confirm-babel-evaluate nil 384 (add-hook 'before-save-hook
566 org-cycle-separator-lines 0 385 #'+ispell-move-buffer-words-to-dir-locals-hook)
567 org-directory (sync/ "org/" t) 386 (put 'ispell-buffer-session-localwords 'safe-local-variable
568 org-ellipsis (or truncate-string-ellipsis "…") 387 #'+ispell-safe-local-p))
569 org-fontify-done-headline t 388
570 org-fontify-quote-and-verse-blocks t 389(use-package flyspell
571 org-fontify-whole-heading-line t 390 :hook org-mode-hook)
572 org-hide-emphasis-markers t 391
573 org-html-coding-system 'utf-8-unix 392(use-package flyspell-correct
574 org-image-actual-width (list (* (window-font-width) 393 :ensure t
575 (- fill-column 8))) 394 :after flyspell
576 org-imenu-depth 3 395 :custom
577 org-indent-indentation-per-level 0 396 (flyspell-correct--cr-key ";")
578 org-indent-mode-turns-on-hiding-stars nil 397 :bind
579 org-insert-heading-respect-content t 398 (:map flyspell-mode-map
580 org-list-demote-modify-bullet '(("-" . "+") 399 (("C-;" . flyspell-correct-wrapper)
581 ("+" . "-")) 400 ("<f7>" . +flyspell-correct-buffer)))
582 org-log-done 'time 401 :config
583 org-log-into-drawer t 402 (require '+flyspell-correct)
584 org-num-skip-commented t 403 (defkeys flyspell-mode-map
585 org-num-skip-unnumbered t 404 "C-," nil
586 org-num-skip-footnotes t 405 "C-." nil))
587 org-outline-path-complete-in-steps nil 406
588 org-pretty-entities t 407(use-package text-mode
589 org-pretty-entities-include-sub-superscripts nil 408 :config
590 org-refile-targets '((nil . (:maxlevel . 2)) 409 (defhook text-mode-hook
591 (org-agenda-files . (:maxlevel . 1))) 410 #'abbrev-mode))
592 org-refile-use-outline-path 'file 411
593 org-special-ctrl-a/e t 412(use-package filldent
594 org-special-ctrl-k t 413 :load-path "~/src/emacs/filldent/"
595 org-src-fontify-natively t 414 :bind
596 org-src-tab-acts-natively t 415 ("M-q" . filldent-dwim))
597 org-src-window-setup 'current-window 416
598 org-startup-truncated nil 417(use-package scule
599 org-startup-with-inline-images t 418 :load-path "~/src/emacs/scule/"
600 org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis))) 419 :config
601 org-todo-keywords
602 '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
603 "|" "DONE(d!)" "ASSIGNED(a@/!)")
604 (sequence "|" "CANCELED(k@)")
605 (sequence "MEETING(m)"))
606 org-use-speed-commands t
607 org-emphasis-alist '(("*" org-bold)
608 ("/" org-italic)
609 ("_" org-underline)
610 ("=" org-verbatim)
611 ("~" org-code)
612 ("+" org-strikethrough)))
613 (defhook org-mode-hook
614 #'variable-pitch-mode
615 #'visual-fill-column-mode
616 #'turn-off-auto-fill
617 #'org-indent-mode
618 #'prettify-symbols-mode
619 #'abbrev-mode
620 (defhook ((before-save-hook nil :local))
621 :name before-save@org-mode
622 (+org-hide-drawers-except-point)
623 (org-align-tags 'all)))
624 (eval-after org
625 (require '+org)
626 (org-clock-persistence-insinuate)
627 (+org-agenda-inhibit-hooks-mode)
628 (defkeys org-mode-map
629 "C-M-k" #'kill-paragraph
630 "C-M-t" #'transpose-paragraphs
631 "RET" #'+org-return-dwim
632 "S-<return>" #'+org-table-copy-down|+org-return
633 "C-c C-o" #'+org-open-at-point-dwim))
634 (eval-after ol ; org-link
635 (defmacro define-org-link-type (type args &rest body)
636 "Define an org link TYPE with ARGS that does something.
637 If BODY is blank, message the user about the link."
638 (declare (indent 2) (doc-string 3) (debug (sexp sexp def-body)))
639 (let ((fn (intern (format "org-%s-open" type)))
640 (body (or body `((message ,(format "%s: %%S" type) ,(car args)))))
641 (type-string (format "%s" type)))
642 `(prog1
643 (defun ,fn ,args
644 ,@body)
645 (org-link-set-parameters ,type-string :follow #',fn))))
646 (define-org-link-type sms (number _))
647 (define-org-link-type tel (number _))))
648
649(yoke org-word-count ; in lisp/
650 (eval-after org
651 (require 'org-word-count)
652 (add-hook 'org-mode-hook #'org-word-count-mode)))
653
654(yoke org-agenda
655 (setq org-agenda-skip-deadline-if-done t
656 org-agenda-skip-scheduled-if-done t
657 org-agenda-span 10
658 org-agenda-block-separator ?─
659 org-agenda-time-grid
660 '((daily today require-timed)
661 (800 1000 1200 1400 1600 1800 2000)
662 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
663 org-agenda-current-time-string
664 "← now ─────────────────────────────────────────────────"
665 org-agenda-include-diary nil ; I use the org-diary features
666 org-agenda-todo-ignore-deadlines 'near
667 org-agenda-todo-ignore-scheduled 'future
668 org-agenda-include-deadlines t
669 org-deadline-warning-days 0
670 org-agenda-show-future-repeats 'next
671 org-agenda-window-setup 'current-window
672 org-agenda-file-skip-regexp "sync-conflict")
673 (defcustom org-agenda-file-skip-regexp nil
674 "Files matching this regexp are removed from `org-agenda-files'."
675 :group 'org-agenda)
676 (define-advice org-agenda-files (:filter-return (files) skip-regexp)
677 (when org-agenda-file-skip-regexp
678 (setq files (seq-remove (lambda (file)
679 (string-match-p org-agenda-file-skip-regexp
680 file))
681 files)))
682 files)
683 (setq-local-hook org-agenda-mode-hook
684 truncate-lines t)
685 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
686 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
687 (defkeys t 420 (defkeys t
688 "C-c c" #'org-capture 421 "M-c" (defmap scule-map
689 "C-c a" #'org-agenda) 422 "Keymap for twiddling scules."
690 (eval-after org-capture 423 "M-u" #'scule-upcase
691 (require '+org-capture))) 424 "M-l" #'scule-downcase
692 425 "M-c" #'scule-capitalize)))
693(yoke ox ; org-export 426
694 (eval-after org (require 'ox)) 427(use-package titlecase
695 (eval-after ox 428 :load-path "~/src/emacs/titlecase.el/"
696 (require* '+ox '(ox-md nil t)) 429 :after org
697 (+org-export-pre-hooks-insinuate)) 430 :bind (:map scule-map
698 (setq org-export-coding-system 'utf-8-unix 431 ("M-t" . titlecase-dwim))
699 org-export-headline-levels 8 432 :config
700 org-export-with-drawers nil 433 (require '+titlecase))
701 org-export-with-section-numbers nil 434
702 org-export-with-smart-quotes t 435;;; Programming
703 org-export-with-sub-superscripts t 436
704 org-export-with-toc nil)) 437(use-package prog-mode
705 438 :config
706(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el") 439 (defhook prog-mode-hook
707 (setq electric-cursor-alist '((overwrite-mode . hbar) 440 #'auto-fill-mode
708 (t . bar))) 441 ;; Use `indent-tabs-mode' unless one of the following modes
709 (electric-cursor-mode)) 442 (indent-tabs-mode (if (derived-mode-p 'emacs-lisp-mode
443 'python-mode
444 'haskell-mode)
445 -1 1))))
446
447(use-package paredit
448 :ensure t
449 :preface
450 (defun +paredit-newline ()
451 (interactive)
452 (call-interactively
453 (if (derived-mode-p 'lisp-interaction-mode)
454 #'eval-print-last-sexp
455 #'paredit-newline)))
456 :hook ((emacs-lisp-mode-hook
457 eval-expression-minibuffer-setup-hook
458 ielm-mode-hook lisp-interaction-mode-hook
459 lisp-mode-hook scheme-mode-hook
460 fennel-repl-mode-hook fennel-mode-hook
461 geiser-mode-hook geiser-repl-mode-hook
462 ielm-mode-hook)
463 . enable-paredit-mode)
464 :bind
465 (("C-j" . +paredit-newline))
466 :config
467 (defkeys paredit-mode-map
468 "RET" nil
469 "M-s" nil)
470 (require '+paredit)
471 (add-to-list 'paredit-space-for-delimiter-predicates
472 #'+paredit-space-for-delimiter)
473 (eval-after (paredit eldoc)
474 (eldoc-add-command #'paredit-backward-delete #'paredit-close-round)))
475
476(use-package hungry-delete
477 :ensure t
478 :custom
479 (hungry-delete-chars-to-skip " \t")
480 (hungry-delete-join-reluctantly nil)
481 :config
482 (dolist (m '(eshell-mode
483 nim-mode
484 python-mode))
485 (add-to-list 'hungry-delete-except-modes m))
486 (require '+hungry-delete)
487 (eval-after paredit
488 (defkeys paredit-mode-map
489 [remap paredit-backward-delete]
490 (+hungry-delete-define-alternative
491 paredit-backward-delete hungry-delete-backward)
492 [remap paredit-forward-delete]
493 (+hungry-delete-define-alternative
494 paredit-forward-delete hungry-delete-forward)))
495 (global-hungry-delete-mode))
710 496
711(yoke _work 497(use-package ediff
712 :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" 498 :custom
713 :load "lisp") 499 (ediff-keep-variants nil)
714 (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) 500 (ediff-split-window-function #'split-window-horizontally)
715 (setf bbdb-complete-mail-allow-cycling t 501 (ediff-window-setup-function #'ediff-setup-windows-plain))
716 bbdb-file (private/ "bbdb"))
717 (defhook +custom-after-load-hook
718 :name _work@after-custom
719 (require* 'private '_work)
720 (require* 'bbdb 'bbdb-message)
721 (bbdb-initialize 'gnus 'message)))
722
723(yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el"))
724
725(yoke scule
726 (require 'scule)
727 (defvar scule-map (let ((map (make-sparse-keymap)))
728 (define-key map (kbd "M-u") #'scule-upcase)
729 (define-key map (kbd "M-l") #'scule-downcase)
730 (define-key map (kbd "M-c") #'scule-capitalize)
731 map)
732 "Keymap for scule twiddling.")
733 (define-key* (current-global-map)
734 "M-c" scule-map
735 "M-u" #'universal-argument)
736 (define-key universal-argument-map (kbd "M-u") #'universal-argument-more))
737
738(yoke (titlecase "https://codeberg.org/acdw/titlecase.el")
739 (eval-after titlecase
740 (add-to-list* 'titlecase-skip-words-regexps
741 (rx word-boundary
742 (+ (any upper digit))
743 word-boundary)))
744 (eval-after scule
745 (define-key* scule-map
746 "M-t" #'titlecase-dwim)))
747
748(yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct")
749 (eval-after flyspell
750 (require* 'flyspell-correct
751 `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct")))
752 (define-key* flyspell-mode-map
753 "C-;" #'flyspell-correct-wrapper
754 "<f7>" #'+flyspell-correct-buffer
755 "C-," nil
756 "C-." nil))
757 (add-hook 'org-mode-hook #'flyspell-mode)
758 (setq flyspell-correct--cr-key ";"))
759
760(yoke (helpful "https://github.com/Wilfred/helpful")
761 :depends ((dash "https://github.com/magnars/dash.el")
762 (f "https://github.com/rejeep/f.el")
763 (s "https://github.com/magnars/s.el")
764 (elisp-refs "https://github.com/Wilfred/elisp-refs"))
765 (defkeys t
766 "<f1> f" #'helpful-callable
767 "<f1> v" #'helpful-variable
768 "<f1> k" #'helpful-key
769 "<f1> ." #'helpful-at-point
770 "<f1> o" #'helpful-symbol)
771 (unless (featurep 'info-look)
772 (run-with-idle-timer 5 nil (lambda ()
773 (require 'info-look)
774 (let ((inhibit-message t))
775 (info-lookup-setup-mode 'symbol
776 'emacs-lisp-mode)))))
777 (defhook window-configuration-change-hook
778 :name side-window-setup
779 (setf fit-window-to-buffer-horizontally t
780 (alist-get (rx (or "*helpful" "*Help" "*info"))
781 display-buffer-alist nil nil #'string=)
782 `(display-buffer-in-side-window
783 ,@(if (< (frame-text-width) (frame-text-height))
784 '((side . bottom) (window-height . 24))
785 '((side . right) (window-width . fit-window-to-buffer)))))))
786
787(yoke (hippie-completing-read
788 "https://codeberg.org/acdw/hippie-completing-read.el")
789 (define-key* (current-global-map)
790 "M-/" #'hippie-completing-read))
791
792(yoke dictionary ; Comes with Emacs 29!
793 (defkeys (t (org-mode-map :after org))
794 "C-c d" #'dictionary-search)
795 (defkeys ((embark-identifier-map :after embark))
796 "@" #'dictionary-search)
797 (setc dictionary-server (if (or (executable-find "dictd")
798 (file-exists-p "/usr/sbin/dictd")) ; oh debian
799 "localhost"
800 "dict.org"))
801 (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=)
802 '((display-buffer-in-side-window)
803 (side . bottom)
804 (window-height . 20))))
805
806(yoke (anzu "https://github.com/emacsorphanage/anzu")
807 (require 'anzu)
808 (global-anzu-mode)
809 (defkeys t
810 [remap query-replace] #'anzu-query-replace-regexp
811 [remap query-replace-regexp] #'anzu-query-replace)
812 (defkeys (isearch-mode-map (isearch-mb-minibuffer-map :after isearch-mb))
813 [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp
814 [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace)
815 (defun anzu-qr@window (fn &rest r)
816 "ADVICE to query-replace from the beginning of the window."
817 (let ((scroll-margin 0))
818 (cond ((region-active-p)
819 (apply fn r))
820 (:else (save-excursion
821 (goto-char (window-start))
822 (apply fn r))))))
823 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window)
824 (advice-add 'anzu-query-replace :around #'anzu-qr@window))
825
826(yoke tempo
827 (require '+tempo))
828
829(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0")
830 (setf 0x0-default-server 'ttm)
831 (define-advice 0x0-shorten-uri (:around (fn server uri) use-0x0)
832 (interactive (list (cdr (assq 'envs 0x0-servers))
833 (read-string "URI: ")))
834 (funcall fn server uri))
835 (eval-after embark
836 (define-key* embark-region-map
837 "U" #'0x0-dwim)))
838
839(yoke (filldent "https://codeberg.org/acdw/filldent.el")
840 (define-advice canonically-space-region (:around (orig &rest r) double-space)
841 (let ((sentence-end-double-space t))
842 (apply orig r)))
843 (defkeys t
844 "M-q" #'filldent-unfill-toggle))
845
846(yoke (avy "https://github.com/abo-abo/avy")
847 (require 'avy)
848 (setf avy-background t
849 (alist-get ?. avy-dispatch-alist)
850 (defun avy-action-embark (pt)
851 (unwind-protect
852 (save-excursion
853 (goto-char pt)
854 (embark-act))
855 (select-window
856 (cdr (ring-ref avy-ring 0))))
857 t))
858 (define-key* (current-global-map)
859 "M-j" #'avy-goto-char-timer)
860 (define-key* isearch-mode-map
861 "M-j" #'avy-isearch))
862
863(yoke (frowny "https://codeberg.org/acdw/frowny.el")
864 (setf frowny-eyes (rx (any ":=") (opt "'") (? "-")))
865 (global-frowny-mode))
866 502
867(yoke (isearch-mb "https://github.com/astoff/isearch-mb") 503;;; Lisps
868 (eval-after (consult anzu)
869 (require 'isearch-mb)
870 (dolist (spec '((isearch-mb--with-buffer
871 ("M-e" . consult-isearch)
872 ("C-o" . loccur-isearch))
873 (isearch-mb--after-exit
874 ("M-%" . anzu-isearch-query-replace)
875 ("M-s l" . consult-line))))
876 (let ((isearch-mb-list (car spec))
877 (isearch-mb-binds (cdr spec)))
878 (dolist (cell isearch-mb-binds)
879 (let ((key (car cell))
880 (command (cdr cell)))
881 (when (fboundp command)
882 (add-to-list isearch-mb-list command)
883 (define-key isearch-mb-minibuffer-map (kbd key) command)))))))
884 (isearch-mb-mode))
885 504
886(yoke (keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el") 505(use-package elisp-mode
506 :custom
507 (eval-expression-print-length nil)
508 (eval-expression-print-level nil)
509 :preface
510 (defun elisp-eval-region|eval-buffer ()
511 (interactive)
512 (if (region-active-p)
513 (let ((start (region-beginning))
514 (end (region-end)))
515 (eval-region start end)
516 (message "Region from %s to %s evaluated."
517 start end))
518 (eval-buffer)
519 (message "Buffer `%s' evaluated." (buffer-name))))
520 (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map)
521 "C-c C-c" #'eval-defun
522 "C-c C-k" #'elisp-eval-region|eval-buffer
523 "C-c C-z" #'ielm)
524 :config
525 (define-advice eval-region (:around (orig start end &rest args) pulse)
526 (apply orig start end args)
527 (pulse-momentary-highlight-region start end))
528 (defhook emacs-lisp-mode-hook
529 (setq-local page-delimiter "^\\( \\|;;;+\\).*")))
530
531(use-package macrostep
532 :ensure t
533 :after elisp-mode
534 :bind ( :map emacs-lisp-mode-map
535 ("C-c e" . macrostep-expand)
536 :map lisp-interaction-mode-map
537 ("C-c e" . macrostep-expand)))
538
539(use-package eros
540 :ensure t
541 :after elisp-mode
542 :custom (eros-eval-result-prefix "; ")
543 :hook emacs-lisp-mode-hook)
544
545(use-package package-lint
546 :ensure t)
547
548(use-package sly
549 :ensure t
550 :when (executable-find "sbcl")
551 :custom
552 (inferior-lisp-program (executable-find "sbcl"))
553 (sly-net-coding-system 'utf-8-unix)
554 :bind (:map sly-mode-map
555 (("C-c C-z" . sly-mrepl)))
556 :config
557 (sly-symbol-completion-mode -1))
558
559(use-package edebug
560 :preface
561 (defun turn-off-eldoc-mode ()
562 (eldoc-mode -1))
563 :config
564 (add-hook 'edebug-mode-hook #'turn-off-eldoc-mode))
565
566;;; Web languages
567
568(use-package web-mode
569 :ensure t
570 :mode ("\\.phtml\\'"
571 "\\.tpl\\.php\\'"
572 "\\.[agj]sp\\'"
573 "\\.as[cp]x\\'"
574 "\\.erb\\'"
575 "\\.mustache\\'"
576 "\\.djhtml\\'"
577 "\\.html?\\'"))
578
579;;; Applications
580
581(use-package dired
582 :init (require 'dired-x)
583 :custom
584 (dired-recursive-copies 'always)
585 (dired-recursive-deletes 'always)
586 (dired-create-destination-dirs 'always)
587 (dired-do-revert-buffer t)
588 (dired-hide-details-hide-symlink-targets nil)
589 (dired-isearch-filenames 'dwim)
590 (delete-by-moving-to-trash t)
591 (dired-auto-revert-buffer t)
592 (dired-listing-switches "-AlF")
593 (ls-lisp-dirs-first t)
594 (dired-ls-F-marks-symlinks t)
595 (dired-clean-confirm-killing-deleted-buffers nil)
596 (dired-no-confirm '(byte-compile
597 load chgrp chmod chown
598 copy move hardlink symlink
599 shell touch))
600 (dired-dwim-target t)
601 :bind
602 (("C-x C-j" . dired-jump)
603 ([remap list-directory] . dired)
604 :map dired-mode-map
605 ("C-j" . dired-up-directory)
606 ("<backspace>" . dired-up-directory))
607 :init
608 (defhook dired-mode-hook
609 #'dired-hide-details-mode
610 #'hl-line-mode
611 #'truncate-lines-local-mode))
612
613(use-package dired-subtree
614 :ensure t
615 :after dired
616 :bind (:map dired-mode-map
617 (("TAB" . dired-subtree-cycle)
618 ("i" . dired-subtree-toggle))))
619
620(use-package dired-collapse
621 :ensure t
622 :hook dired-mode-hook)
623
624(use-package dired-hide-dotfiles
625 :ensure t
626 :bind (:map dired-mode-map
627 ("." . dired-hide-dotfiles-mode)))
628
629(use-package magit
630 :ensure t
631 :bind
632 ("C-x g" . magit))
633
634(use-package auth-source
635 :custom
636 (auth-sources '(default "secrets:passwords"))
637 :config
638 (defhook authinfo-mode-hook
639 #'truncate-lines-local-mode))
640
641(use-package keychain-environment
642 :ensure t
643 :when (executable-find "keychain")
644 :hook (after-init-hook . keychain-refresh-environment))
645
646(use-package keepassxc-shim
647 :load-path "~/src/emacs/keepassxc-shim/"
648 :config
887 (keepassxc-shim-activate)) 649 (keepassxc-shim-activate))
888 650
889(yoke (keychain-environment "https://github.com/tarsius/keychain-environment") 651(use-package eat
890 :when (executable-find "keychain") 652 :ensure t
891 (keychain-refresh-environment)) 653 :commands eat-eshell-mode
892 654 :hook (eshell-load-hook . eat-eshell-mode))
893(yoke (exec-path-from-shell "https://github.com/purcell/exec-path-from-shell") 655
894 :when (eq system-type 'gnu/linux) 656(use-package dictionary
895 (require 'exec-path-from-shell) 657 :custom
896 (dolist (var '("SSH_AUTH_SOCK" 658 (dictionary-server (if (or (executable-find "dictd")
897 "SSH_AGENT_PID" 659 (file-exists-p "/usr/sbin/dictd")) ; debian
898 "GPG_AGENT_INFO" 660 "localhost"
899 "LANG" 661 "dict.org"))
900 "LC_CTYPE" 662 :bind
901 "XDG_CONFIG_HOME" 663 (("C-c d" . dictionary-search)))
902 "XDG_CONFIG_DIRS" 664
903 "XDG_DATA_HOME" 665(use-package pdf-tools
904 "XDG_DATA_DIRS" 666 :ensure t
905 "XDG_CACHE_HOME")) 667 :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode)
906 (add-to-list 'exec-path-from-shell-variables var)) 668 :magic ("%PDF" . pdf-view-mode)
907 (exec-path-from-shell-initialize)) 669 :config
908 670 (pdf-tools-install))
909(yoke (sophomore "https://codeberg.org/acdw/sophomore.el")
910 (sophomore-enable-all)
911 (sophomore-disable #'view-hello-file
912 #'describe-gnu-project)
913 (sophomore-disable-with 'confirm #'save-buffers-kill-terminal))
914
915(yoke (macrostep "https://github.com/joddie/macrostep")
916 (eval-after elisp-mode (require 'macrostep))
917 (define-key* '(emacs-lisp-mode-map
918 lisp-interaction-mode-map)
919 "C-c e" #'macrostep-expand))
920
921(yoke (expand-region "https://github.com/magnars/expand-region.el")
922 (define-advice er/clear-history (:after (&rest _) refold-org)
923 (when (derived-mode-p 'org-mode)
924 (+org-hide-drawers-except-point)
925 (org-link-descriptive-ensure)
926 (font-lock-update)))
927 (defkeys t
928 "C-=" #'er/expand-region))
929 671
930(yoke (embrace "https://github.com/cute-jumper/embrace.el") 672;;; Mail
931 :depends ((expand-region "https://github.com/magnars/expand-region.el")) 673
932 (defkeys t 674(use-package bbdb
933 "C-\"" #'embrace-commander) 675 :ensure t
934 (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) 676 :custom
935 (ruby-mode-hook embrace-ruby-mode-hook) 677 (bbdb-complete-mail-allow-cycling t)
936 (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) 678 (bbdb-file (private/ "bbdb"))
937 (latex-mode-hook embrace-LaTeX-mode-hook))) 679 :init
938 (apply #'add-hook fnhook)) 680 (defhook custom-allowed-after-load-hook
939 (eval-after org 681 :name bbdb@after-custom
940 (defkeys org-mode-map 682 (require 'bbdb)
941 "C-\"" #'embrace-commander) 683 (require 'bbdb-message)
942 (defmacro org-insert-or-embrace (char) 684 (bbdb-initialize 'message)))
943 "Define a function to insert CHAR, or `embrace' the region with it." 685
944 (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) 686(use-package bbdb-vcard
945 (char (cond ((characterp char) char) 687 :ensure t)
946 ((stringp char) (string-to-char char)) 688
947 (t (user-error "Bad format for char: %S" char))))) 689(use-package notmuch
948 `(defun ,fn-name (n) 690 :load-path "~/usr/share/emacs/site-lisp/"
949 ,(format "Insert N %ss, or surround the region with them." 691 :preface
950 (char-to-string char)) 692 (defdir notmuch/ (sync/ "emacs/notmuch"))
951 (interactive "p") 693 :init
952 (if (region-active-p) 694 (use-package +notmuch
953 (dotimes (_ n) 695 :after notmuch
954 (embrace--add-internal (region-beginning) (region-end) ,char) 696 :load-path "lisp/"
955 (forward-char 1)) 697 :bind (("C-c n" . +notmuch-goto)
956 (self-insert-command n ,char))))) 698 :map notmuch-search-mode-map
957 (define-key* org-mode-map 699 ("!" . +notmuch-search-mark-spam)
958 "*" (org-insert-or-embrace "*") 700 :map notmuch-tree-mode-map
959 "/" (org-insert-or-embrace "/") 701 ("!" . +notmuch-search-mark-spam-then-next)
960 "_" (org-insert-or-embrace "_") 702 ("M-<" . +notmuch-tree-beginning)
961 "=" (org-insert-or-embrace "=") 703 ("M->" . +notmuch-tree-end))
962 "~" (org-insert-or-embrace "~") 704 :hook (message-send-hook . +send-mail-dispatch)
963 "+" (org-insert-or-embrace "+")))) 705 :config
964 706 ;; Saved searches
965(yoke (notmuch "~/usr/share/emacs/site-lisp") 707 (+notmuch-make-saved-search "inbox+unread" "m" 'tree "tag:inbox" "tag:unread" "NOT tag:Spam")
966 (eval-after bbdb 708 (+notmuch-make-saved-search "inbox" "i" 'tree "tag:inbox" "NOT tag:Spam")
967 (require* 'notmuch '+notmuch '+message)) 709 (+notmuch-make-saved-search "lists+unread" "l" 'tree "tag:/List/" "tag:unread")
968 (+define-dir notmuch/ (sync/ "emacs/notmuch") 710 (+notmuch-make-saved-search "lists" "L" 'tree "tag:/List/")
969 "Notmuch configuration and data.") 711 (+notmuch-make-saved-search "unread" "u" 'tree "tag:unread" "NOT tag:Spam")
970 (setf notmuch-init-file (notmuch/ "notmuch-init.el" t) 712 (+notmuch-make-saved-search "flagged" "f" 'tree "tag:flagged")
971 notmuch-address-save-filename (notmuch/ "addresses" t) 713 (+notmuch-make-saved-search "sent" "t" 'tree "tag:sent")
972 notmuch-address-use-company (featurep 'company) 714 (+notmuch-make-saved-search "drafts" "d" 'tree "tag:draft")
973 notmuch-search-oldest-first nil 715 (+notmuch-make-saved-search "all mail" "a" 'tree "*"))
974 notmuch-archive-tags '("-inbox" "-unread") 716 (use-package message
975 notmuch-draft-tags '("+draft" "-inbox" "-unread") 717 :after notmuch
976 mail-user-agent 'notmuch-user-agent 718 :hook (message-setup-hook . message-signature-setup)
977 bbdb-mail-user-agent 'notmuch-user-agent 719 :config (require '+message))
978 message-mail-user-agent t) 720 (defhook (notmuch-show-mode-hook notmuch-message-mode-hook)
979 (define-key* (current-global-map)
980 "C-c m" #'notmuch-mua-new-mail
981 "C-c n" #'+notmuch-goto)
982 ;; Reading mail
983 (setf notmuch-show-indent-content nil)
984 (add-hook* '(notmuch-show-mode-hook
985 notmuch-message-mode-hook)
986 #'visual-fill-column-mode) 721 #'visual-fill-column-mode)
987 (eval-after notmuch 722 :custom
988 (define-key* notmuch-search-mode-map 723 (notmuch-init-file (notmuch/ "notmuch-init.el" t))
989 "RET" #'notmuch-search-show-thread 724 (notmuch-address-save-filename (notmuch/ "addresses" t))
990 "M-RET" #'notmuch-tree-from-search-thread 725 (notmuch-address-use-company (featurep 'company))
991 "!" #'+notmuch-search-mark-spam) 726 (notmuch-search-oldest-first nil)
992 (define-key* notmuch-tree-mode-map 727 (notmuch-archive-tags '("-inbox" "-unread"))
993 "!" #'+notmuch-search-mark-spam-then-next 728 (notmuch-draft-tags '("+draft" "-inbox" "-unread"))
994 "M-<" (notmuch-tree--define-do-in-message-window 729 (mail-user-agent 'notmuch-user-agent)
995 notmuch-tree-beginning-of-message beginning-of-buffer) 730 (bbdb-mail-user-agent 'notmuch-user-agent)
996 "M->" (notmuch-tree--define-do-in-message-window 731 (message-mail-user-agent t)
997 notmuch-tree-end-of-message end-of-buffer))) 732 (notmuch-show-indent-content nil)
998 ;; Writing mail 733 (message-kill-buffer-on-exit t)
999 (setf message-kill-buffer-on-exit t 734 (message-auto-save-directory nil)
1000 message-auto-save-directory nil) 735 (send-mail-function #'sendmail-send-it)
1001 ;; Sending mail 736 (mail-specify-envelope-from t)
1002 (setf send-mail-function #'sendmail-send-it 737 (message-sendmail-envelope-from 'header)
1003 mail-specify-envelope-from t 738 (message-envelope-from 'header)
1004 message-sendmail-envelope-from 'header 739 (notmuch-saved-searches nil)
1005 message-envelope-from 'header) 740 :bind
1006 ;; Extras 741 (("C-c m" . notmuch-mua-new-mail)
1007 (define-advice mm-save-part-to-file (:before (_handle file) create-directory) 742 :map notmuch-search-mode-map
1008 (let ((directory (file-name-directory file))) 743 ("RET" . notmuch-search-show-thread)
1009 (when (yes-or-no-p (format "Directory %s doesn't exist. Create?" directory)) 744 ("M-RET" . notmuch-tree-from-search-thread))
1010 (make-directory directory :parents)))) 745 :config
1011 (eval-after notmuch 746 (load notmuch-init-file :noerror)
1012 (require '+notmuch) 747 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags)
1013 (load notmuch-init-file :noerror) 748 ;; Mailing lists
1014 (add-hook 'message-setup-hook #'+message-signature-setup) 749 (add-to-list 'notmuch-message-headers "List-Post" :append)
1015 (add-hook 'message-send-hook #'+send-mail-dispatch) 750 (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware)
1016 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags) 751 "Make `notmuch-mua-new-reply' list-aware."
1017 (advice-add 'notmuch-bury-or-kill-this-buffer :after 752 (let ((ml (notmuch-show-get-header :List-Post)))
1018 (defun +display-time@notmuch (&rest _) 753 (apply orig r)
1019 ;; (display-time-event-handler) 754 (when ml
1020 (setq display-time-mail-string 755 (with-buffer-modified-unmodified
1021 (replace-regexp-in-string "(.*)" 756 (message-remove-header "To")
1022 (format "(%s)" (+notmuch-new-mail-p)) 757 (message-add-header
1023 display-time-mail-string)) 758 (format "To: %s"
1024 (display-time-update) 759 (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml)))
1025 (force-mode-line-update))) 760 (message-goto-body))))))
1026 (add-to-list 'notmuch-message-headers "List-Post" :append) 761
1027 (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) 762;;; The INTERNET
1028 "Make `notmuch-mua-new-reply' list-aware." 763
1029 (let ((ml (notmuch-show-get-header :List-Post))) 764(use-package link-hint
1030 (apply orig r) 765 :ensure t
1031 (when ml 766 :demand t
1032 (with-buffer-modified-unmodified 767 :preface
1033 (message-remove-header "To") 768 (global-set-key (kbd "M-l") nil)
1034 (message-add-header 769 :custom
1035 (format "To: %s" 770 (link-hint-avy-style 'at-full)
1036 (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml))) 771 (link-hint-avy-all-windows t)
1037 (message-goto-body))))) 772 :config
1038 (setf notmuch-saved-searches (list 773 (require '+link-hint)
1039 (list :name "inbox+unread" 774 (+link-hint-open-secondary-setup)
1040 :query (+notmuch-query-concat 775 (+link-hint-open-chrome-setup)
1041 "tag:inbox" 776 :bind
1042 "tag:unread" 777 (("M-l M-l" . +link-hint-open-link)
1043 "NOT tag:Spam") 778 ("M-l l" . +link-hint-open-link)
1044 :key "m" 779 ("M-l M-o" . +link-hint-open-secondary)
1045 :search-type 'tree) 780 ("M-l o" . +link-hint-open-secondary)
1046 (list :name "inbox" 781 ("M-l M-m" . +link-hint-open-multiple-links)
1047 :query (+notmuch-query-concat 782 ("M-l m" . +link-hint-open-multiple-links)
1048 "tag:inbox" 783 ("M-l M-w" . link-hint-copy-link)
1049 "NOT tag:Spam") 784 ("M-l w" . link-hint-copy-link)
1050 :key "i" 785 ("M-l M-c" . +link-hint-open-chrome)
1051 :search-type 'tree) 786 ("M-l c" . +link-hint-open-chrome)))
1052 (list :name "lists+unread" 787
1053 :query (+notmuch-query-concat 788(use-package browse-url
1054 "tag:/List/" 789 :demand t
1055 "tag:unread") 790 :preface
1056 :key "l" 791 (require '+browse-url)
1057 :search-type 'tree) 792 :config
1058 (list :name "lists" 793 (eval-after chd
1059 :query "tag:/List/" 794 (add-to-list 'browse-url-handlers (cons chd/url-regexps
1060 :key "L" 795 #'browse-url-chrome))
1061 :search-type 'tree) 796 (add-to-list '+browse-url-other-safe-browser-functions
1062 (list :name "unread" 797 #'chd/browse-url))
1063 :query (+notmuch-query-concat 798 (put 'browse-url-browser-function 'safe-local-variable
1064 "tag:unread" 799 #'+browse-url-browser-function-safe-p)
1065 "NOT tag:Spam") 800 :custom
1066 :key "u" 801 (browse-url-browser-function #'eww-browse-url)
1067 :search-type 'tree) 802 (browse-url-chromium-program (choose-executable "chromium"))
1068 (list :name "flagged" 803 (browse-url-chrome-program (choose-executable "chrome" "google-chrome-stable"))
1069 :query "tag:flagged" 804 (browse-url-firefox-program (choose-executable "firefox" "firefox-esr"))
1070 :key "f" 805 (browse-url-firefox-new-window-is-tab t)
1071 :search-type 'tree) 806 (browse-url-firefox-arguments '("--new-tab"))
1072 (list :name "sent" 807 (browse-url-generic-program (or browse-url-firefox-program
1073 :query "tag:sent" 808 browse-url
1074 :key "t" 809 browse-url-chrome-program))
1075 :search-type 'tree) 810 (browse-url-generic-args
1076 (list :name "drafts" 811 (cl-loop for prog in '(firefox chromium chrome)
1077 :query "tag:draft" 812 for progfn = (intern (format "browse-url-%s-program"
1078 :key "d" 813 prog))
1079 :search-type 'tree) 814 for progargs = (intern (format "browse-url-%s-arguments"
1080 (list :name "all mail" 815 prog))
1081 :query "*" 816 if (equal browse-url-generic-program
1082 :key "a" 817 (symbol-value progfn))
1083 :search-type 'tree))))) 818 return (symbol-value progargs)
1084 819 finally return nil))
1085(yoke (cider "https://github.com/clojure-emacs/cider") 820 (browse-url-handlers
1086 :depends ((clojure-mode "http://github.com/clojure-emacs/clojure-mode") 821 `(;; Videos
1087 (parseedn "https://github.com/clojure-emacs/parseedn/") 822 (,(+browse-url-matches "youtube\\.com" "youtu\\.be"
1088 (parseclj "https://github.com/clojure-emacs/parseclj/") ; parseedn 823 "invidious" "yewtu\\.be"
1089 (queue "https://elpa.gnu.org/packages/queue-0.2.el" :type 'http) 824 (rx "." (or "mp4" "gif" "mov" "MOV" "webm")
1090 (spinner "https://github.com/Malabarba/spinner.el") 825 eos))
1091 (sesman "https://github.com/vspinu/sesman")) 826 . +browse-url-with-mpv)
1092 :when (executable-find "clojure")) 827 ;; Music
1093 828 (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com"
1094(yoke (web-mode "https://github.com/fxbois/web-mode") 829 (rx "." (or "ogg" "mp3" "opus" "m4a") eos))
1095 (setf (alist-get (rx "." (or "htm" "html" "phtml" "tpl.php" 830 . +browse-url-with-mpv)
1096 "asp" "gsp" "jsp" "ascx" "aspx" 831 ;; Images
1097 "erb" "mustache" "djhtml") 832 (,(+browse-url-matches "pbs\\.twimg\\.com"
1098 eos) 833 (rx "." (or "jpeg" "jpg" "png" "bmp" "webp")
1099 auto-mode-alist nil nil #'string=) 834 eos))
1100 'web-mode)) 835 . +browse-url-with-mpv-image)
1101 836 ;; Blobs (binary files)
1102(yoke (chicken-geiser "https://gitlab.com/emacs-geiser/chicken") 837 (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos))
1103 :depends ((geiser "https://gitlab.com/emacs-geiser/geiser" 838 . +browse-url-download)
1104 :load "elisp")) 839 ;; External URLs --- these are URLs that don't open in EWW very well,
1105 :when (executable-find "csi") 840 ;; so I want to open them in the external browser.
1106 :pre ((autoload 'geiser-activate-implementation "geiser-impl")) 841 (+browse-url-external-url-p . ,(if (featurep 'xwidget-internal)
1107 (autoload 'geiser "geiser" nil :interactive) 842 #'xwidget-webkit-browse-url
1108 (add-hook 'scheme-mode-hook 'geiser-mode)) 843 browse-url-secondary-browser-function))))
1109 844 (+browse-url-external-domains '("github.com" "gitlab.com" "codeberg.org"
1110(yoke (zoom-frm "https://github.com/emacsmirror/zoom-frm") 845 "tildegit.org" "git.tilde.town"
1111 :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds") 846 "google.com" "imgur.com" "twitch.tv"
1112 (frame-fns "https://github.com/emacsmirror/frame-fns")) 847 "pixelfed" "instagram.com"
1113 (define-key* (current-global-map) 848 "bibliogram.art" "reddit.com"
1114 "M-+" #'zoom-frm-in 849 "teddit.net" "libreddit.de"
1115 "M-_" #'zoom-frm-out)) 850 "streamable.com" "spotify.com"
1116 851 "hetzner.cloud" "melpa.org"
1117(yoke (jabber "https://codeberg.org/acdw/emacs-jabber") 852 "twitter.com" ("^t\\.co$")
1118 :depends ((srv "https://github.com/legoscia/srv.el") 853 "nitter.snopyta.org" "nitter.net")))
1119 (fsm "https://elpa.gnu.org/packages/fsm-0.2.1.el" :type 'http)) 854
1120 (setf jabber-account-list '(("acdw@hmm.st")) 855(use-package browse-url-transform
1121 jabber-auto-reconnect t 856 :after browse-url
1122 jabber-chat-buffer-format "xmpp:%n" 857 :load-path "~/src/emacs/browse-url-transform/"
1123 jabber-browse-buffer-format "xmpp-browse:%n" 858 :custom
1124 jabber-groupchat-buffer-format "xmpp-muc:%n" 859 (browse-url-transform-alist
1125 jabber-muc-private-buffer-format "xmpp-muc-private:%n" 860 `(;; Privacy-respecting alternatives
1126 jabber-groupchat-prompt-format "%>10n │ " 861 ("twitter\\.com" . "nitter.snopyta.org")
1127 jabber-chat-local-prompt-format "%>10n │ " 862 ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de")
1128 jabber-chat-system-prompt-format " * * * * * *" 863 ("medium\\.com" . "scribe.rip")
1129 jabber-chat-foreign-prompt-format "%>10n │ " 864 (".*substack\\.com.*" . ,substack-proxy)
1130 jabber-muc-private-foreign-prompt-format "%g/%n " 865 ;; Text-mode of non-text-mode sites
1131 jabber-last-read-marker "----------------------------------------" 866 ("www\\.npr\\.org" . "text.npr.org")
1132 jabber-muc-header-line-format '("" jabber-muc-topic) 867 ;; Ask for raw versions of paste sites
1133 jabber-muc-decorate-presence-patterns 868 ("^.*dpaste\\.com.*$" . "\\&.txt")
1134 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$") 869 ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1")
1135 ("." . jabber-muc-presence-dim)) 870 ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2")
1136 jabber-activity-make-strings 871 ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2")
1137 #'jabber-activity-make-strings-shorten 872 ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2")))
1138 ;; (defun +jabber-activity-make-strings (jids) 873 :config
1139 ;; (mapcar (lambda (jid) 874 (browse-url-transform-mode))
1140 ;; (cons jid 875
1141 ;; (let ((s (jabber-activity-make-string-default jid))) 876(use-package eww
1142 ;; (cond 877 :custom
1143 ;; ((string-match-p "%" s) 878 (eww-use-browse-url ".")
1144 ;; (replace-regexp-in-string "%.*" "" s)) 879 :config
1145 ;; (:else s))))) 880 (defhook eww-mode-hook
1146 ;; jids)) 881 (defhook ((visual-fill-column-mode nil :local))
1147 jabber-rare-time-format " - - - - - - %H:%M %F") 882 :name visual-fill-column@eww-mode-refresh
883 (eww-reload t)))
884 (defkeys eww-mode-map
885 "&" (+browse-url-switch-external-browser eww-mode
886 (plist-get eww-data :url))))
887
888(use-package xwidget
889 :when (featurep 'xwidget-internal)
890 :preface
891 (setenv "WEBKIT_FORCE_SANDBOX" "0") ; This is probably a bad idea
892 :custom
893 (xwidget-webkit-cookie-file (cache/ "xwidget-cookies"))
894 (xwidget-webkit-download-dir (expand-file-name "~/var/download"))
895 :config
896 (defkeys xwidget-webkit-mode-map
897 "&" (+browse-url-switch-external-browser xwidget-webkit-mode
898 (xwidget-webkit-uri (xwidget-webkit-current-session)))))
899
900(use-package xwwp
901 :load-path "~/src/emacs/xwwp/"
902 :when (featurep 'xwidget-internal)
903 :custom
904 (xwwp-search-prefix "https://duckduckgo.com/?q=")
905 :bind (:map xwidget-webkit-mode-map
906 ("f" . xwwp-follow-link)))
907
908(use-package jabber
909 :load-path "~/src/emacs/emacs-jabber"
910 :custom
911 (jabber-account-list '(("acdw@hmm.st")))
912 (jabber-auto-reconnect t)
913 (jabber-chat-buffer-format "xmpp:%n")
914 (jabber-browse-buffer-format "xmpp-browse:%n")
915 (jabber-groupchat-buffer-format "xmpp-muc:%n")
916 (jabber-muc-private-buffer-format "xmpp-muc-private:%n")
917 (jabber-groupchat-prompt-format "%>10n │ ")
918 (jabber-chat-local-prompt-format "%>10n │ ")
919 (jabber-chat-system-prompt-format " * * * * * *")
920 (jabber-chat-foreign-prompt-format "%>10n │ ")
921 (jabber-muc-private-foreign-prompt-format "%g/%n ")
922 (jabber-last-read-marker "----------------------------------------")
923 (jabber-muc-header-line-format '("" jabber-muc-topic))
924 (jabber-muc-decorate-presence-patterns
925 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
926 ("." . jabber-muc-presence-dim)))
927 (jabber-activity-make-strings
928 #'jabber-activity-make-strings-shorten)
929 (jabber-rare-time-format " - - - - - - %H:%M %F")
930 :custom-face
931 (jabber-chat-prompt-local ((t :inherit font-lock-keyword-face
932 :foreground unspecified)))
933 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
934 :foreground unspecified
935 :weight normal)))
936 (jabber-activity-personal-face ((t :inherit font-lock-warning-face
937 :foreground unspecified
938 :weight bold)))
939 (jabber-chat-prompt-foreign ((t :inherit font-lock-constant-face
940 :foreground unspecified)))
941 (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
942 :foreground unspecified)))
943 (jabber-rare-time-face ((t :inherit font-lock-comment-face
944 :foreground unspecified
945 :underline nil)))
946 :init
1148 (defhook (jabber-chat-mode-hook 947 (defhook (jabber-chat-mode-hook
1149 jabber-browse-mode-hook 948 jabber-browse-mode-hook
1150 jabber-roster-mode-hook 949 jabber-roster-mode-hook
1151 jabber-console-mode-hook) 950 jabber-console-mode-hook)
1152 :name jabber-ui-setup 951 :name jabber-ui-setup
952 (visual-fill-column-mode)
1153 (electric-pair-local-mode -1) 953 (electric-pair-local-mode -1)
1154 (auto-fill-mode -1) 954 (auto-fill-mode -1)
1155 #'visual-fill-column-mode) 955 (setq-local wrap-prefix (format "%13s" " ")))
1156 (setq-local-hook jabber-chat-mode-hook 956 :bind-keymap ("C-c j" . jabber-global-keymap)
1157 wrap-prefix (format "%13s" " ")) 957 :bind (("C-c C-SPC" . jabber-activity-switch-to))
1158 (defun +jabber-fix-keybinds-dammit () 958 :config
1159 "Jabber autoloads keybinds which is really annoying." 959 (global-set-key (kbd "C-x C-j") #'dired-jump) ; Extremely annoying fix
1160 (define-key* (current-global-map) 960 (require 'jabber-httpupload nil :noerror)
1161 "C-x C-j" #'dired-jump 961 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
1162 "C-c j" jabber-global-keymap 962 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
1163 "C-c C-SPC" #'jabber-activity-switch-to)) 963 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
1164 (eval-after init (+jabber-fix-keybinds-dammit)) 964 (add-hook 'jabber-alert-muc-hooks
1165 (eval-after jabber 965 (defun jabber@highlight-acdw (&optional _nick _group buf _text _title)
1166 (require 'jabber-httpupload nil :noerror) 966 (when buf
1167 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons) 967 (with-current-buffer buf
1168 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo) 968 (let ((regexp (rx word-boundary
1169 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo) 969 "acdw" ; maybe get from the config?
1170 (add-hook 'jabber-alert-muc-hooks 970 word-boundary)))
1171 (defun jabber@highlight-acdw (&optional _nick _group buf _text _title) 971 (hi-lock-unface-buffer regexp)
1172 (when buf 972 (highlight-regexp regexp 'hi-blue))))))
1173 (with-current-buffer buf 973 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)
1174 (let ((regexp (rx word-boundary 974 (eval-after consult
1175 "acdw" ; maybe get from the config?
1176 word-boundary)))
1177 (hi-lock-unface-buffer regexp)
1178 (highlight-regexp regexp 'hi-blue))))))
1179 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)
1180 (+jabber-fix-keybinds-dammit)
1181 (defkeys jabber-chat-mode-map
1182 "C-l" (defun +jabber-recenter-last-read ()
1183 (interactive)
1184 (cond
1185 ((eq last-command '+jabber-recenter-last-read)
1186 (setq this-command #'recenter)
1187 (recenter -1))
1188 (:else
1189 (save-excursion
1190 (condition-case e
1191 (re-search-backward jabber-last-read-marker)
1192 (search-failed nil)
1193 (:success
1194 (recenter 3)))))))))
1195 (defun jabber-chat-kill-buffers ()
1196 "Kill all `jabber-chat-mode' buffers."
1197 (interactive)
1198 (mapc-buffers (lambda () (message "%S" (buffer-name))) '(jabber-chat-mode)))
1199 (defun jabber-chat@after-modus-themes-load ()
1200 (modus-themes-with-colors
1201 (custom-set-faces
1202 `(jabber-chat-prompt-foreign ((t :foreground unspecified
1203 :inherit modus-themes-bold))
1204 :now)
1205 `(jabber-chat-prompt-local ((t :foreground unspecified
1206 :inherit modus-themes-bold))
1207 :now)
1208 `(jabber-chat-prompt-system ((t :foreground unspecified
1209 :inherit modus-themes-bold))
1210 :now)
1211 `(jabber-activity-face ((t :slant italic)))
1212 `(jabber-activity-personal-face ((t :slant italic :weight bold)))
1213 `(jabber-rare-time-face ((t :inherit font-lock-comment-face)))))
1214 (setq jabber-muc-nick-value
1215 (pcase (frame--current-backround-mode (selected-frame))
1216 ('light 0.5)
1217 ('dark 1.0))))
1218 (eval-after modus-themes
1219 (add-hook 'modus-themes-after-load-theme-hook
1220 #'jabber-chat@after-modus-themes-load))
1221 (when (or (custom-theme-enabled-p 'modus-operandi)
1222 (custom-theme-enabled-p 'modus-vivendi))
1223 (jabber-chat@after-modus-themes-load))
1224 (eval-after (consult jabber)
1225 ;; Jabber.el chat buffers source for `consult-buffer'
1226 (defvar jabber-chat-buffer-source 975 (defvar jabber-chat-buffer-source
1227 `( :name "Jabber" 976 `( :name "Jabber"
1228 :hidden nil 977 :hidden nil
@@ -1238,190 +987,3 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
1238 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append) 987 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
1239 ;; Also hide xmpp buffers from regular buffer list 988 ;; Also hide xmpp buffers from regular buffer list
1240 (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal))) 989 (add-to-list 'consult-buffer-filter "\\`xmpp" nil #'string-equal)))
1241
1242(yoke (link-hint "https://github.com/noctuid/link-hint.el/")
1243 :depends ((avy "https://github.com/abo-abo/avy"))
1244 (require '+link-hint)
1245 (+link-hint-open-secondary-setup)
1246 (+link-hint-open-chrome-setup)
1247 (setf link-hint-avy-style 'at-full
1248 link-hint-avy-all-windows t)
1249 (global-set-key (kbd "M-l") +link-hint-map)
1250 (define-key* +link-hint-map
1251 "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link
1252 "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary
1253 "M-m" #'+link-hint-open-multiple-links "m" #'+link-hint-open-multiple-links
1254 "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link
1255 "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome))
1256
1257(yoke (elpher "git://thelambdalab.xyz/elpher.git")
1258 (eval-after elpher
1259 (define-key* elpher-mode-map
1260 "l" #'elpher-back)))
1261
1262(yoke (epithet "https://github.com/oantolin/epithet")
1263 (defhook (Info-selection-hook
1264 help-mode-hook
1265 occur-mode-hook
1266 shell-mode-hook)
1267 #'epithet-rename-buffer)
1268 (cond ((boundp 'eww-auto-rename-buffer)
1269 (setc eww-auto-rename-buffer 'title))
1270 (:else (defhook eww-after-render-hook #'epithet-rename-buffer))))
1271
1272(yoke browse-url
1273 (require '+browse-url)
1274 (setf browse-url-browser-function #'eww-browse-url
1275 browse-url-chrome-program (seq-some #'executable-find
1276 '("chromium" "chrome" "google-chrome-stable"))
1277 browse-url-firefox-program (seq-some #'executable-find
1278 '("firefox" "firefox-esr"))
1279 browse-url-generic-program (or browse-url-firefox-program
1280 browse-url-chrome-program)
1281 browse-url-firefox-new-window-is-tab t
1282 browse-url-firefox-arguments "-new-tab"
1283 browse-url-handlers `((video-url-p . +browse-url-with-mpv)
1284 (music-url-p . +browse-url-with-mpv)
1285 (image-url-p . +browse-image-with-mpv)
1286 (blobp . +browse-url-download)
1287 (external-url-p . ,browse-url-secondary-browser-function)
1288 ;; HERE FOR REFERENCE --- OPEN MASTO URLS SOME WAY
1289 (,(defun mastodon-url-p (url)
1290 "Try to determine whether URL is a mastodon URL."
1291 (string-match-p "/@[^/]+\\(/\\|/[[:digit:]]+\\)?$" url))
1292 . ,browse-url-secondary-browser-function)))
1293 (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30"
1294 "--cache-pause-initial=yes")
1295 "Video URL: "
1296 :fallback browse-url-secondary-browser-function)
1297 (+browse-url-make-external-viewer-handler "mpv" '("--image-display-duration=inf")
1298 "Image URL: "
1299 :name +browse-image-with-mpv)
1300 (defun video-url-p (url) "Is URL a video?"
1301 (string-match-p (rx (or "youtube.com" "youtu.be" "invidious" "yewtu.be"
1302 (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos)))
1303 url))
1304 (defun music-url-p (url) "Is URL music?"
1305 (string-match-p (rx "soundcloud.com" "bandcamp.com"
1306 (seq "." (or "ogg" "mp3" "opus" "m4a" "flac") eos))
1307 url))
1308 (defun image-url-p (url) "Is URL an image?"
1309 (string-match-p (rx
1310 (or (: "." (or "jpeg" "jpg" "png" "bmp" "webp") eos)
1311 "pbs.twimg.com"))
1312 url))
1313 (defun external-url-p (url) "Should URL open in an external browser?"
1314 (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org"
1315 "tildegit.org" "git.tilde.town" "google.com"
1316 "imgur.com" "twitch.tv" "pixelfed" "instagram.com"
1317 "bibliogram.art" "reddit.com" "teddit.net"
1318 ;; "twitter.com" "nitter" "t.co"
1319 "streamable.com" "spotify.com"
1320 "hetzner.cloud" "melpa.org"))
1321 url))
1322 (defun blobp (url) "Is URL some other blob that can't open in Emacs?"
1323 (string-match-p (rx (or (: (or ".tar.gz" ".pdf")
1324 eos)))
1325 url))
1326 (eval-after chd
1327 (add-to-list 'browse-url-handlers (cons chd/url-regexps #'chd/browse-url)))
1328 (require 'browse-url-transform)
1329 (setf browse-url-transform-alist `(;; Privacy-respecting alternatives
1330 ("twitter\\.com" . "nitter.snopyta.org")
1331 ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)"
1332 . "libreddit.de")
1333 ("medium\\.com" . "scribe.rip")
1334 ;; Text-mode of non-text-mode sites
1335 ("www\\.npr\\.org" . "text.npr.org")
1336 ;; Ask for raw versions of paste sites
1337 ("^.*dpaste\\.com.*$" . "\\&.txt")
1338 ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1")
1339 ("\\(paste\\.debian\\.net\\)/\\(.*\\)"
1340 . "\\1/plain/\\2")
1341 ("\\(pastebin\\.com\\)/\\\(.*\\)"
1342 . "\\1/raw/\\2")
1343 ("gist\\.github\\.com/\\(.*\\)"
1344 . "gist.githubusercontent.com/\\1/raw/")))
1345 (browse-url-transform-mode))
1346
1347(yoke eww
1348 (setc eww-use-browse-url ".")
1349 (eval-after eww
1350 (defhook eww-mode-hook
1351 #'visual-fill-column-mode
1352 (defhook ((visual-fill-column-mode-hook nil :local))
1353 :name eww-mode-refresh@visual-fill-column
1354 (eww-reload t)))
1355 (defkeys eww-mode-map
1356 "&"
1357 (defun +eww-browse-with-external-browser (&optional url)
1358 "Browse URL with an external browser and close eww."
1359 (interactive nil eww-mode)
1360 (condition-case e
1361 ;; This is wrapped in a `condition-case' so that the eww window
1362 ;; won't close if there's an error calling the browser.
1363 (funcall browse-url-secondary-browser-function
1364 (or url (plist-get eww-data :url)))
1365 (:success
1366 (when (null url) ; interactive
1367 (quit-window)))
1368 (t (signal (car e) (cdr e)))))))
1369 (eval-after (eww link-hint)
1370 (defkeys eww-mode-map
1371 "f" #'+link-hint-open-link)))
1372
1373(yoke tab-bar
1374 (setf tab-bar-show t
1375 global-mode-string
1376 '((jabber-activity-mode
1377 (:eval
1378 (let ((str (or (bound-and-true-p jabber-activity-mode-string)
1379 "")))
1380 (concat (truncate-string-to-width str 20 nil nil t)
1381 (if (< 0 (length str)) " ⋅" "")))))
1382 display-time-string
1383 "|"))
1384 (eval-after jabber
1385 (defhook jabber-activity-mode-hook
1386 (setf global-mode-string
1387 '((jabber-activity-mode
1388 (:eval
1389 (let ((str (or (bound-and-true-p jabber-activity-mode-string)
1390 "")))
1391 (concat (truncate-string-to-width str 20 nil nil t)
1392 (if (< 0 (length str)) " ⋅" "")))))
1393 display-time-string
1394 "|"))))
1395 (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
1396 (add-to-list 'tab-bar-format 'tab-bar-format-global :append)
1397 (tab-bar-mode))
1398
1399(yoke (pdf-tools "https://github.com/vedang/pdf-tools"
1400 :load "lisp")
1401 :depends ((tablist "https://github.com/politza/tablist/"))
1402 :when (executable-find "epdfinfo") ; installed from Debian repos
1403 (pdf-tools-install))
1404
1405(yoke which-function
1406 (setf (alist-get 'which-function-mode mode-line-misc-info)
1407 '((which-func-mode ; Only display if buffer supports it
1408 (:eval (when (which-function)
1409 (list "" which-func-format " "))))))
1410 (which-function-mode))
1411
1412(yoke (zzz-to-char "https://github.com/mrkkrp/zzz-to-char")
1413 :depends ((avy "https://github.com/abo-abo/avy"))
1414 (setf zzz-to-char-reach 120)
1415 (defkeys t
1416 [remap zap-to-char]
1417 (defun +zzz-to-char (&optional prefix)
1418 "Run `zzz-up-to-char', or `zzz-to-char' with PREFIX."
1419 (interactive "P")
1420 (call-interactively (cond (prefix #'zzz-to-char)
1421 (:else #'zzz-up-to-char))))))
1422
1423(yoke sh-mode
1424 (defhook sh-mode-hook
1425 :name turn-off-sh-electric-here-document-mode
1426 (sh-electric-here-document-mode -1)))
1427
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el index 12e433c..b65b6f9 100644 --- a/lisp/+browse-url.el +++ b/lisp/+browse-url.el
@@ -1,60 +1,101 @@
1;;; +browse-url.el -*- lexical-binding: t -*- 1;;; +browse-url.el -*- lexical-binding: t; -*-
2 2
3(require 'browse-url) 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
4 13
5(cl-defmacro +browse-url-make-external-viewer-handler 14(cl-defmacro +browse-url-make-external-viewer-handler
6 (viewer default-args 15 (viewer
7 &optional (prompt "URL: ") 16 &key
8 &key 17 args
9 (custom-group 'browse-url) 18 (prompt "URL: ")
10 (name (intern (format "+browse-url-with-%s" viewer))) 19 (program (executable-find (format "%s" viewer)))
11 doc vardoc 20 (name (intern (format "+browse-url-with-%s" viewer)))
12 (varname (intern (format "%s-args" name))) 21 doc
13 (fallback t)) 22 (var (intern (format "%s-args" name)))
14 "Create a `browse-url' handler function calling VIEWER on the url. 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.
15This macro also creates a `customize' setting in CUSTOM-GROUP for 27This macro also creates a `customize' setting in CUSTOM-GROUP for
16VIEWER's command-line arguments. DEFAULT-ARGS specifies the 28PROGRAM's command-line arguments. ARGS specifies the
17default arguments for that setting. 29default arguments for this user option.
30
31PROGRAM defaults to the result of calling `executable-find' on VIEWER.
18 32
19PROMPT is shown to the user in the function's `interactive' spec, 33PROMPT is shown to the user in the function's `interactive' spec, as an argument
20as an argument to `browse-url-interactive-arg'. 34to `browse-url-interactive-arg'.
21 35
22The resulting function is named NAME, which defaults to 36The resulting function is named NAME, which defaults to
23`+browse-url-wth-VIEWER'. The custom variable is named VARNAME, 37`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults
24which defaults to `NAME-args'. If DOC or VARDOC are provided, 38to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of
25they'll be the documentation of the function and variable 39the function and variable respectively; otherwise a basic default doc-string is
26respectively; otherwise, basic docstrings are used. 40used.
27 41
28Finally, if FALLBACK is non-nil (by default, it's 42If FALLBACK is non-nil (the default is `browse-url-generic'), the
29`browse-url-generic'), the function will call that if unable to 43generated function will call FALLBACK if unable to start PROGRAM
30start VIEWER." 44for some reason."
31 (declare (indent 1)) 45 (declare (indent 1))
32 `(progn 46 `(progn
33 (defcustom ,varname ,default-args 47 (defcustom ,var ,args
34 ,(or doc (format "Arguments to pass to %s in `%s'." viewer name)) 48 ,(or vardoc (format "Arguments to pass to %s in `%s'."
49 viewer name))
35 :type '(repeat :tag "Command-line argument" string) 50 :type '(repeat :tag "Command-line argument" string)
36 :group ',custom-group) 51 :group ',custom-group)
37 (defun ,name (url &optional new-window) 52 (defun ,name (url &optional new-window)
38 ,(or vardoc (format "Open URL in %s." viewer)) 53 ,(or doc (format "Open URL in %s." viewer))
39 (interactive (browse-url-interactive-arg ,prompt)) 54 (interactive (browse-url-interactive-arg ,prompt))
40 (let* ((url (browse-url-encode-url url)) 55 (let* ((url (browse-url-encode-url url))
41 (process-environment (browse-url-process-environment))) 56 (process-environment (browse-url-process-environment)))
42 (message ,(format "Opening %%s in %s..." viewer) url) 57 (message ,(format "Opening %%s in %s..." viewer) url)
43 (unless (ignore-errors (apply #'start-process 58 (unless (ignore-errors (apply #'start-process
44 (format "%s %s" ,viewer url) nil 59 (format "%s %s" ',viewer url)
45 ,viewer 60 nil
46 (append ,varname (list url)))) 61 ,program
62 (append ,var (list url))))
47 ,@(cond 63 ,@(cond
48 ((eq fallback t) '((browse-url-generic url new-window)))
49 (fallback `((funcall ,fallback url new-window))) 64 (fallback `((funcall ,fallback url new-window)))
50 (:else `((message "Can't find viewer: `%s'" ,viewer) 65 (:else `((message "Can't find viewer: %s" ,viewer)
51 nil)))))))) 66 nil))))))))
52 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
53(defcustom +browse-url-download-open t 82(defcustom +browse-url-download-open t
54 "Whether to open downloaded files afterward." 83 "Whether to open downloaded files after downloading."
55 :group 'browse-url
56 :type 'boolean) 84 :type 'boolean)
57 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
58(defun +browse-url-download-callback (status url dir) 99(defun +browse-url-download-callback (status url dir)
59 ;; A slight change to `eww-download-callback' that returns the downloaded 100 ;; A slight change to `eww-download-callback' that returns the downloaded
60 ;; filename. 101 ;; filename.
@@ -71,18 +112,78 @@ start VIEWER."
71 (message "Saved %s" file) 112 (message "Saved %s" file)
72 file))) 113 file)))
73 114
74(defun +browse-url-download (url &rest _) 115;;; URL matcher generators
75 "Download URL to `eww-download-directory'." 116
76 (interactive "sDownload URL: ") 117(defun +browse-url-matches (&rest regexps)
77 (let ((dir eww-download-directory)) 118 "Return a lambda that will determine if a url matches REGEXPS.
78 (when (functionp dir) (setq dir (funcall dir))) 119Each regexp will be tested in turn. The first one that matches
79 (make-directory dir :parents) 120is returned by the lambda.
80 (url-retrieve url 121
81 (lambda (s u d) 122This is a good function to use in key positions in `browse-url-handlers'."
82 (let ((file (+browse-url-download-callback s u d))) 123 `(lambda (url &optional new-window)
83 (when +browse-url-download-open 124 (cl-loop for regexp in ',regexps
84 (browse-url-xdg-open file)))) 125 if (string-match-p regexp url)
85 (list url dir)))) 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'.
134This is just a list of strings. They'll be regexp-escaped and
135passed to `+browse-url-external-url-p', which is a good function
136to put in `browse-url-handlers'.
137
138If an item in this list is a list itself, it should contain one string, a valid
139regexp 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'.
146This 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.
159URL-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'.
164This 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)))))))
86 187
87(provide '+browse-url) 188(provide '+browse-url)
88;;; +browse-url.el ends here 189;;; +browse-url.el ends here
diff --git a/lisp/+cape.el b/lisp/+cape.el new file mode 100644 index 0000000..37e88fe --- /dev/null +++ b/lisp/+cape.el
@@ -0,0 +1,25 @@
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.
9Add a function to HOOK that will add CAPES to the local
10`completion-at-point-functions' for that mode's buffer. If CAPFS
11are 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/+custom.el b/lisp/+custom.el deleted file mode 100644 index ba4c55d..0000000 --- a/lisp/+custom.el +++ /dev/null
@@ -1,52 +0,0 @@
1;;; +custom.el -*- lexical-binding: t -*-
2
3(require 'cl-lib)
4(require 'seq)
5
6(defgroup +custom nil
7 "Group for extra `customize' customizations."
8 :group 'customize)
9
10(defcustom +custom-allowed-variables nil
11 "Variables to load during `+custom-load-some-customizations'."
12 :type '(repeat symbol))
13
14(defcustom +custom-allowed-faces nil
15 "Faces to load during `+custom-load-some-customziations'."
16 :type '(repeat face))
17
18(defun +custom--filter-list (customlist allowlist)
19 "Filter CUSTOMLIST to only include those items in ALLOWLIST.
20Each item in ALLOWLIST will be compared using `eq' to the `car'
21of each item in CUSTOMLIST. Items in CUSTOMLIST not included in
22ALLOWLIST will be removed from the return value."
23 (seq-filter (lambda (el) (memq (car el) allowlist))
24 customlist))
25
26(defcustom +custom-after-load-hook nil
27 "Hook run after loading the custom file."
28 :type 'hook)
29
30(defun +custom-load-some-customizations (&optional noerror
31 nomessage
32 nosuffix
33 must-suffix)
34 "Load `custom-file', ignoring most customizations.
35Only faces included in `+custom-allowed-faces' and variables
36included in `+custom-allowed-variables' will be loaded.
37
38All optional arguments---NOERROR, NOMESSAGE, NOSUFFIX,
39MUST-SUFFIX---are passed to `load', which see."
40 (cl-letf (((symbol-function 'custom-set-faces)
41 (lambda (&rest args)
42 (apply #'custom-theme-set-faces 'user
43 (+custom--filter-list args +custom-allowed-faces))))
44 ((symbol-function 'custom-set-variables)
45 (lambda (&rest args)
46 (apply #'custom-theme-set-variables 'user
47 (+custom--filter-list args +custom-allowed-variables)))))
48 (load custom-file noerror nomessage nosuffix must-suffix))
49 (run-hooks '+custom-after-load-hook))
50
51(provide '+custom)
52;;; +custom.el ends here
diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 97377a3..0000000 --- a/lisp/+emacs.el +++ /dev/null
@@ -1,422 +0,0 @@
1;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; I find myself copy-pasting a lot of "boilerplate" type code when
6;; bankrupting my Emacs config and starting afresh. Instead of doing
7;; that, I'm putting it here, where it'll be easier to include in my
8;; config.
9
10;; Of course, some might say I could just ... stop bankrupting my
11;; Emacs. But like, why would I want to?
12
13;; Other notable packages include
14;; - https://git.sr.ht/~technomancy/better-defaults/
15;; - https://github.com/susam/emfy
16
17;;; Code:
18
19(require 'early-init (locate-user-emacs-file "early-init.el"))
20
21(defun +set-major-mode-from-buffer-name (&optional buf)
22 "Set the major mode for BUF from the buffer's name.
23Do this only if the buffer is not visiting a file."
24 (unless buffer-file-name
25 (let ((buffer-file-name (buffer-name buf)))
26 (set-auto-mode))))
27
28
29;;; General settings
30
31(setq-default
32 apropos-do-all t
33 async-shell-command-buffer 'new-buffer
34 async-shell-command-display-buffer nil
35 auto-hscroll-mode 'current-line
36 auto-revert-verbose t
37 auto-save-default nil
38 auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms)))
39 (".*" ,(.etc "auto-save/") t))
40 auto-save-interval 30
41 auto-save-list-file-prefix (.etc "auto-save/.saves-" t)
42 auto-save-timeout 30
43 auto-save-visited-interval 5
44 auto-window-vscroll nil
45 backup-by-copying t
46 backup-directory-alist `((".*" . ,(.etc "backup/" t)))
47 blink-cursor-blinks 1
48 comp-deferred-compilation nil
49 completion-category-defaults nil
50 completion-category-overrides '((file (styles . (partial-completion))))
51 completion-ignore-case t
52 completion-styles '(substring partial-completion)
53 create-lockfiles nil
54 cursor-in-non-selected-windows 'hollow
55 cursor-type 'bar
56 custom-file (.etc "custom.el")
57 delete-old-versions t
58 echo-keystrokces 0.1
59 ediff-window-setup-function 'ediff-setup-windows-plain
60 eldoc-echo-area-use-multiline-p nil
61 eldoc-idle-delay 0.1
62 enable-recursive-minibuffers t
63 executable-prefix-env t
64 fast-but-imprecise-scrolling t
65 file-name-shadow-properties '(invisible t intangible t)
66 fill-column 80
67 find-file-visit-truename t
68 frame-resize-pixelwise t
69 global-auto-revert-non-file-buffers t
70 global-mark-ring-max 100
71 hscroll-margin 1
72 hscroll-step 1
73 imenu-auto-rescan t
74 image-use-external-converter (or (executable-find "convert")
75 (executable-find "gm")
76 (executable-find "ffmpeg"))
77 indent-tabs-mode nil
78 inhibit-startup-screen t
79 initial-buffer-choice t
80 kept-new-versions 6
81 kept-old-versions 2
82 kill-do-not-save-duplicates t
83 kill-read-only-ok t
84 kill-ring-max 500
85 kmacro-ring-max 20
86 load-prefer-newer noninteractive
87 major-mode '+set-major-mode-from-buffer-name
88 mark-ring-max 50
89 minibuffer-eldef-shorten-default t
90 minibuffer-prompt-properties (list 'read-only t
91 'cursor-intangible t
92 'face 'minibuffer-prompt)
93 mode-require-final-newline 'visit-save
94 mouse-drag-copy-region t
95 mouse-wheel-progressive-speed nil
96 mouse-yank-at-point t
97 native-comp-async-report-warnings-errors 'silent
98 native-comp-deferred-compilation nil
99 read-answer-short t
100 read-buffer-completion-ignore-case t
101 ;; read-extended-command-predicate
102 ;; (when (fboundp
103 ;; 'command-completion-default-include-p)
104 ;; 'command-completion-default-include-p)
105 read-process-output-max 1048576 ; We’re in the future man. Set that to at least a megabyte
106 recenter-positions '(top 2 middle bottom)
107 regexp-search-ring-max 100
108 regexp-search-ring-max 200
109 save-interprogram-paste-before-kill t
110 save-some-buffers-default-predicate #'+save-some-buffers-p
111 scroll-conservatively 25
112 scroll-margin 0
113 scroll-preserve-screen-position 1
114 scroll-step 1
115 search-ring-max 200
116 search-ring-max 200
117 sentence-end-double-space t
118 set-mark-command-repeat-pop t
119 show-paren-delay 0
120 show-paren-style 'parenthesis
121 show-paren-when-point-in-periphery t
122 show-paren-when-point-inside-paren t
123 ;;show-trailing-whitespace t
124 tab-bar-show 1
125 tab-width 8 ; so alignment expecting the default looks right
126 tramp-backup-directory-alist backup-directory-alist
127 undo-limit 100000000 ; 10 MB
128 use-dialog-box nil
129 use-file-dialog nil
130 use-short-answers t
131 vc-follow-symlinks t
132 vc-make-backup-files t
133 version-control t
134 view-read-only t
135 visible-bell nil
136 window-resize-pixelwise t
137 x-select-enable-clipboard t
138 x-select-enable-primary t
139 yank-pop-change-selection t
140 )
141
142;; Programming language offsets.
143;; Set these after the initial block so I can use `tab-width'
144(setq-default
145 c-basic-offset tab-width)
146
147;; Emacs 28 ships with an option, `use-short-answers', that makes this form
148;; obsolete, but I still use 27 at work.
149(when (version< emacs-version "28")
150 (fset 'yes-or-no-p 'y-or-n-p))
151
152
153;;; Encodings
154
155;; Allegedly, this is the only one you need...
156(set-language-environment "UTF-8")
157;; But I still set all of these, for fun.
158(setq-default locale-coding-system 'utf-8-unix
159 coding-system-for-read 'utf-8-unix
160 coding-system-for-write 'utf-8-unix
161 buffer-file-coding-system 'utf-8-unix
162 default-process-coding-system '(utf-8-unix . utf-8-unix)
163 x-select-request-type '(UTF8_STRING
164 COMPOUND_TEXT
165 TEXT
166 STRING))
167
168(set-charset-priority 'unicode)
169(prefer-coding-system 'utf-8-unix)
170(set-default-coding-systems 'utf-8-unix)
171(set-terminal-coding-system 'utf-8-unix)
172(set-keyboard-coding-system 'utf-8-unix)
173
174(pcase system-type
175 ((or 'ms-dos 'windows-nt)
176 (set-clipboard-coding-system 'utf-16-le)
177 (set-selection-coding-system 'utf-16-le))
178 (_
179 (set-selection-coding-system 'utf-8)
180 (set-clipboard-coding-system 'utf-8)))
181
182
183;;; Modes
184
185(dolist (enable-mode '(global-auto-revert-mode
186 blink-cursor-mode
187 electric-pair-mode
188 show-paren-mode
189 global-so-long-mode
190 minibuffer-depth-indicate-mode
191 file-name-shadow-mode
192 minibuffer-electric-default-mode
193 delete-selection-mode
194 auto-save-visited-mode
195 ;; column-number-mode
196 ))
197 (when (fboundp enable-mode)
198 (funcall enable-mode +1)))
199
200(dolist (disable-mode '(tooltip-mode
201 tool-bar-mode
202 menu-bar-mode
203 scroll-bar-mode
204 horizontal-scroll-bar-mode))
205 (when (fboundp disable-mode)
206 (funcall disable-mode -1)))
207
208
209;;; Hooks
210
211(defun +auto-create-missing-dirs ()
212 "Automatically create missing directories when finding a file."
213 ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/
214 (let ((target-dir (file-name-directory buffer-file-name)))
215 (unless (file-exists-p target-dir)
216 (make-directory target-dir t))))
217
218(defvar +save-some-buffers-debounce-time nil
219 "Last time `+save-some-buffers-debounce' was run.")
220
221(defcustom +save-some-buffers-debounce-timeout 5
222 "Number of seconds to wait before saving buffers again.")
223
224(defun +save-some-buffers-debounce (&rest _)
225 "Run `save-some-buffers', but only if it's been a while."
226 (unless (and +save-some-buffers-debounce-time
227 (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
228 +save-some-buffers-debounce-timeout))
229 (save-some-buffers t)
230 (setf +save-some-buffers-debounce-time (time-convert nil 'integer))))
231
232
233;;; Better-default functions ...
234
235(defun +cycle-spacing (&optional n preserve-nl-back mode)
236 "Negate N argument on `cycle-spacing'.
237That is, with a positive N, deletes newlines as well, leaving -N
238spaces. If N is negative, it will not delete newlines and leave
239N spaces. See docstring of `cycle-spacing' for the meaning of
240PRESERVE-NL-BACK and MODE."
241 (interactive "*p")
242 (cycle-spacing (- n)))
243
244(defun +save-buffers-quit (&optional arg)
245 "Silently save each buffer, then kill the current connection.
246If the current frame has no client, kill Emacs itself using
247`save-buffers-kill-emacs' after confirming with the user.
248
249With prefix ARG, silently save all file-visiting buffers, then
250kill without asking."
251 (interactive "P")
252 (save-some-buffers t)
253 (if (and (not (frame-parameter nil 'client))
254 (and (not arg)))
255 (when (yes-or-no-p "Sure you want to quit? ")
256 (save-buffers-kill-emacs))
257 (delete-frame nil :force)))
258
259(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn)
260 "Kill active region or ARG words backward.
261BACKWARD-KILL-WORD-FN is the function to call to kill a word
262backward. It defaults to `backward-kill-word'."
263 (interactive "P")
264 (call-interactively (if (region-active-p)
265 #'kill-region
266 (or backward-kill-word-fn #'backward-kill-word))))
267
268(defun +backward-kill-word-wrapper (fn &optional arg)
269 "Kill backward using FN until the beginning of a word, smartly.
270If point is on at the beginning of a line, kill the previous new
271line. If the only thing before point on the current line is
272whitespace, kill that whitespace.
273
274With argument ARG: if ARG is a number, just call FN
275ARG times. Otherwise, just call FN."
276 ;; I want this to be a wrapper so that I can call other word-killing functions
277 ;; with it. It's *NOT* advice because those functions probably use
278 ;; `backward-kill-word' under the hood (looking at you, paredit), so advice
279 ;; will make things weird.
280 (if (null arg)
281 (cond
282 ((looking-back "^" 1)
283 (let ((delete-active-region nil))
284 (delete-backward-char 1)))
285 ((looking-back "^[ ]*")
286 (delete-horizontal-space :backward-only))
287 (t (call-interactively fn)))
288 (funcall fn (if (listp arg) 1 arg))))
289
290(defun +backward-kill-word (&optional arg)
291 "Kill word backward using `backward-kill-word'.
292ARG is passed to `backward-kill-word'."
293 (interactive "P")
294 (+backward-kill-word-wrapper #'backward-kill-word arg))
295
296;;; ... and advice
297
298;; Indent the region after a yank.
299(defun +yank@indent (&rest _)
300 "Indent the current region."
301 (indent-region (min (point) (mark)) (max (point) (mark))))
302;; (advice-add #'yank :after #'+yank@indent)
303;; (advice-add #'yank-pop :after #'+yank@indent)
304
305;; https://old.reddit.com/r/emacs/comments/y92y4b/tramp_users_slowness_got_you_down_check/it3a35r/
306(defun +vc-off-when-remote ()
307 (when (file-remote-p (buffer-file-name))
308 (setq-local vc-handled-backends nil)))
309
310
311;;; Extra functions
312
313(defun +save-some-buffers-p ()
314 "Predicate for `save-some-buffers-default-predicate'.
315It returns nil with remote files and those without attached files."
316 (and (buffer-file-name)
317 (not (file-remote-p (buffer-file-name)))))
318
319;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block
320(defun +goto-matching-paren (&optional arg)
321 "Go to the matching paren, similar to vi's %."
322 (interactive "p")
323 (or arg (setf arg 1))
324 (cond
325 ;; Check for "outside of bracket" positions
326 ((looking-at "[\[\(\{]") (forward-sexp arg))
327 ((looking-back "[\]\)\}]" 1) (backward-sexp arg))
328 ;; Otherwise, move from inside the bracket
329 ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg))
330 ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg))
331 (t (up-list arg t t))))
332
333(defun +delete-window-or-bury-buffer ()
334 "Delete the current window, or bury the current buffer.
335If the current window is the only window, bury the buffer."
336 (interactive)
337 (condition-case e
338 (delete-window)
339 (t (bury-buffer))))
340
341
342;;; Required libraries
343
344(when (require 'abbrev nil :noerror)
345 (setq-default abbrev-file-name (sync/ "abbrev.el")
346 save-abbrevs 'silent))
347
348(when (require 'autorevert nil :noerror)
349 (setq-default global-auto-revert-non-file-buffers t
350 auto-revert-verbose nil)
351 (global-auto-revert-mode +1))
352
353(when (require 'uniquify nil :noerror)
354 (setq-default uniquify-buffer-name-style 'forward
355 uniquify-separator path-separator
356 uniquify-after-kill-buffer-p t
357 uniquify-ignore-buffers-re "^\\*"))
358
359(when (require 'goto-addr)
360 (if (fboundp 'global-goto-address-mode)
361 (global-goto-address-mode +1)
362 (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
363
364(when (require 'recentf nil :noerror)
365 (setq-default recentf-save-file (.etc "recentf.el")
366 recentf-max-menu-items 100
367 recentf-max-saved-items nil
368 recentf-auto-cleanup 'mode)
369 (add-to-list 'recentf-exclude .etc)
370 (recentf-mode +1))
371
372(when (require 'savehist nil :noerror)
373 (setq-default history-length t
374 history-delete-duplicates t
375 history-autosave-interval 60
376 savehist-file (.etc "savehist.el")
377 ;; Other variables --- don't truncate any of these.
378 ;; `add-to-history' uses the values of these variables unless
379 ;; they're nil, in which case it falls back to `history-length'.
380 kill-ring-max 100
381 mark-ring-max 100
382 global-mark-ring-max 100
383 regexp-search-ring-max 100
384 search-ring-max 100
385 kmacro-ring-max 100
386 eww-history-limit 100)
387 (dolist (var '(extended-command-history
388 global-mark-ring
389 mark-ring
390 kill-ring
391 kmacro-ring
392 regexp-search-ring
393 search-ring))
394 (add-to-list 'savehist-additional-variables var))
395 (savehist-mode +1))
396
397(when (require 'saveplace nil :noerror)
398 (setq-default save-place-file (.etc "places.el")
399 save-place-forget-unreadable-files (eq system-type 'gnu/linux))
400 (save-place-mode +1))
401
402;; (when (require 'tramp)
403;; ;; thanks Irreal! https://irreal.org/blog/?p=895
404;; (add-to-list 'tramp-default-proxies-alist
405;; '(nil "\\`root\\'" "/ssh:%h:"))
406;; (add-to-list 'tramp-default-proxies-alist
407;; '((regexp-quote (system-name)) nil nil)))
408
409
410;;; Newer features
411;; These aren't in older version of Emacs, but they're so nice.
412
413(when (fboundp 'repeat-mode)
414 (setq-default repeat-exit-key "g"
415 repeat-exit-timeout 5)
416 (repeat-mode +1))
417
418(when (fboundp 'pixel-scroll-precision-mode)
419 (pixel-scroll-precision-mode +1))
420
421(provide '+emacs)
422;;; +emacs.el ends here
diff --git a/lisp/+emms.el b/lisp/+emms.el new file mode 100644 index 0000000..a43daea --- /dev/null +++ b/lisp/+emms.el
@@ -0,0 +1,38 @@
1;;; +emms.el -*- lexical-binding: t; -*-
2
3(defun +emms-streams (&optional file)
4 "Better interface for `emms-streams'.
5If FILE is non-nil, use it. Otherwise use `emms-streams-file'.
6If `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/+hungry-delete.el b/lisp/+hungry-delete.el new file mode 100644 index 0000000..601aecf --- /dev/null +++ b/lisp/+hungry-delete.el
@@ -0,0 +1,53 @@
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.
11If the adjacent characters in DIRECTION are one of
12`hungry-delete-chars-to-skip', call HD-FUNC. Otherwise, call
13FUNC.
14
15If DIRECTION is a positive integer or `forward', look forward.
16If it's negative or `backward', look backward. If it's absent,
17this macro will try to guess based on the names of FUNC and
18HD-FUNC.
19
20This macro creates a function taking a prefix argument that's
21passed 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 new file mode 100644 index 0000000..3516ec4 --- /dev/null +++ b/lisp/+isearch.el
@@ -0,0 +1,24 @@
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.
7This 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'.
13This 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/+notmuch.el b/lisp/+notmuch.el index 74b9b77..5df6e5b 100644 --- a/lisp/+notmuch.el +++ b/lisp/+notmuch.el
@@ -60,11 +60,11 @@ for search."
60 'notmuch-address-history))) 60 'notmuch-address-history)))
61 (:else 61 (:else
62 (defun notmuch-address-selection-function (prompt collection initial-input) 62 (defun notmuch-address-selection-function (prompt collection initial-input)
63 "Call (`completing-read' 63 "Call (`completing-read'
64 PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)" 64 PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
65 (completing-read 65 (completing-read
66 prompt collection nil nil nil 66 prompt collection nil nil nil
67 'notmuch-address-history))))) 67 'notmuch-address-history)))))
68 68
69(defcustom +notmuch-spam-tags '("+spam" "+Spam") 69(defcustom +notmuch-spam-tags '("+spam" "+Spam")
70 "A list of tag changes to apply when marking a thread as spam." 70 "A list of tag changes to apply when marking a thread as spam."
@@ -101,5 +101,49 @@ This function advances the next thread when finished."
101 (when (eq beg end) 101 (when (eq beg end)
102 (notmuch-search-next-thread))) 102 (notmuch-search-next-thread)))
103 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.
126NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
127`notmuch-saved-searches', which see. QUERIES are all concatenated together with
128AND. If QUERIES is prepended with more keyword arguments, those are added to
129the 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
104(provide '+notmuch) 148(provide '+notmuch)
105;;; +notmuch.el ends here 149;;; +notmuch.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el index 06dfcfd..2f7bf6a 100644 --- a/lisp/+org-capture.el +++ b/lisp/+org-capture.el
@@ -1,164 +1,49 @@
1;;; +org-capture.el -*- lexical-binding: t; -*- 1;;; +org-capture.el -*- lexical-binding: t; -*-
2 2
3;;; Code: 3;;; Code:
4 4
5(require 'cl-lib) 5(require 'cl-lib)
6(require 'acdw) 6;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll
7;; We don't require `org-capture' here because I'll have to require this library 7;; take a minute. Just let the compiler know that this variable exists.
8;; to init.el /before/ org-capture is fully needed. But I do need to declare
9;; `org-capture-templates'.
10(defvar org-capture-templates nil) 8(defvar org-capture-templates nil)
11 9
12(defun +org-capture--get (key &optional list) 10;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573
13 "Find KEY in LIST, or return nil. 11(defun +org-capture-template-define (description &rest args)
14LIST defaults to `org-capture-templates'." 12 "Define a capture template.
15 (alist-get key (or list org-capture-templates) nil nil #'equal)) 13Creates a list and adds it to `org-capture-templates', if it's
16 14not already there. ARGS is a plist, which in addition to the
17;; Set it up as a generic value. Based on the one for `alist-get'. 15additional options `org-capture-templates' accepts (which see),
18(gv-define-expander +org-capture--get 16takes the following and puts them in the right spot: `:keys',
19 (lambda (do key &optional alist) 17`:description', `:type', `:target', and `:template'."
20 (setf alist (or alist org-capture-templates)) 18 (declare (indent 1))
21 (macroexp-let2 macroexp-copyable-p k key 19 (let* ((keys (plist-get args :keys))
22 (gv-letplace (getter setter) alist 20 (type (plist-get args :type))
23 (macroexp-let2 nil p `(assoc ,k ,getter 'equal) 21 (target (plist-get args :target))
24 (funcall do `(cdr ,p) 22 (template (plist-get args :template))
25 (lambda (v) 23 (template-value (append
26 (macroexp-let2 nil v v 24 (list description)
27 (let ((set-exp 25 (when (or type target template)
28 `(if ,p (setcdr ,p ,v) 26 (list (or type 'entry) target template))
29 ,(funcall setter 27 (cl-loop for i from 0 below (length args) by 2
30 `(cons (setf ,p (cons ,k ,v)) 28 unless (member (nth i args)
31 ,getter))))) 29 '(:keys :description :type
32 `(progn 30 :target :template))
33 ,set-exp 31 append (list (nth i args)
34 ,v)))))))))) 32 (plist-get args (nth i
35 33 args)))))))
36(defun +org-capture-sort (&optional list) 34 ;; The only way I know how to do this properly (add a value to the end of
37 "Sort LIST by string keys. 35 ;; the list, if it exists; otherwise update it) is to do this weird if-setf
38LIST is a symbol and defaults to `org-capture-templates'." 36 ;; dance.
39 (setf list (or list 'org-capture-templates)) 37 (if (seq-find (lambda (el) (equal (car el) keys))
40 (set list (sort (symbol-value list) (lambda (a b) 38 org-capture-templates)
41 (string< (car a) (car b)))))) 39 (setf (alist-get keys org-capture-templates nil nil #'equal)
42 40 template-value)
43(defun +org-capture-sort-after-init (&optional list) 41 (setf org-capture-templates
44 "Sort LIST with `+org-capture-sort' after Emacs init." 42 (append org-capture-templates
45 (+ensure-after-init #'+org-capture-sort)) 43 (list (cons keys template-value)))))
46 44 ;; Regardless of what we do, return the new value of
47;;;###autoload 45 ;; `org-capture-templates'.
48(defun +org-capture-templates-setf (key value &optional list sort-after) 46 org-capture-templates))
49 "Add KEY to LIST, using `setf'.
50LIST is a symbol and defaults to `org-capture-templates' -- so
51this function sets values on a list that's structured as such.
52
53Thus, KEY is a string key. If it's longer than one character,
54this function will search LIST for each successive run of
55characters before the final, ensuring sub-lists exist of the
56form (CHARS DESCRIPTION).
57
58For example, if KEY is \"abc\", first a LIST item of the form (a
59DESCRIPTION), if non-existant, will be added to the list (with a
60default description), then an item of the
61form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST.
62
63VALUE is the template or group header required for
64`org-capture-templates', which see.
65
66SORT-AFTER, when set to t, will call
67`+org-capture-templates-sort' after setting, to ensure org can
68properly process the variable."
69 ;; LIST defaults to `org-capture-templates'
70 (declare (indent 2))
71 (unless list (setf list 'org-capture-templates))
72 ;; Ensure VALUE is a list to cons properly
73 (unless (listp value) (setf value (list value)))
74 (when (> (length key) 1)
75 ;; Check for existence of groups.
76 (let ((expected (cl-loop for i from 1 to (1- (length key))
77 collect (substring key 0 i) into keys
78 finally return keys)))
79 (cl-loop for ek in expected
80 if (not (+org-capture--get ek (symbol-value list))) do
81 (setf (+org-capture--get ek (symbol-value list))
82 (list (format "(Group %s)" ek))))))
83 (prog1 ;; Set KEY to VALUE
84 (setf (+org-capture--get key (symbol-value list)) value)
85 ;; Sort after, maybe
86 (when sort-after (+org-capture-sort list))))
87
88(defun +org-template--ensure-path (keys &optional list)
89 "Ensure path of keys exists in `org-capture-templates'."
90 (unless list (setf list 'org-capture-templates))
91 (when (> (length key) 1)
92 ;; Check for existence of groups.
93 (let ((expected (cl-loop for i from 1 to (1- (length key))
94 collect (substring key 0 i) into keys
95 finally return keys)))
96 (cl-loop for ek in expected
97 if (not (+org-capture--get ek (symbol-value list))) do
98 (setf (+org-capture--get ek (symbol-value list))
99 (list (format "(Group %s)" ek)))))))
100
101(defcustom +org-capture-default-type 'entry
102 "Default template for `org-capture-templates'."
103 :type '(choice (const :tag "Entry" entry)
104 (const :tag "Item" item)
105 (const :tag "Check Item" checkitem)
106 (const :tag "Table Line" table-line)
107 (const :tag "Plain Text" plain)))
108
109(defcustom +org-capture-default-target ""
110 "Default target for `org-capture-templates'."
111 ;; TODO: type
112 )
113
114(defcustom +org-capture-default-template nil
115 "Default template for `org-capture-templates'."
116 ;; TODO: type
117 )
118
119(defun +org-define-capture-templates-group (keys description)
120 "Add a group title to `org-capture-templates'."
121 (setf (+org-capture--get keys org-capture-templates)
122 (list description)))
123
124;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]]
125(defun +org-define-capture-template (keys description &rest args)
126 "Define a capture template and necessary antecedents.
127ARGS is a plist, which in addition to the additional options
128`org-capture-templates' accepts, takes the following and places
129them accordingly: :type, :target, and :template. Each of these
130corresponds to the same field in `org-capture-templates's
131docstring, which see. Likewise with KEYS and DESCRIPTION, which
132are passed separately to the function.
133
134This function will also create all the necessary intermediate
135capture keys needed for `org-capture'; that is, if KEYS is
136\"wcp\", entries for \"w\" and \"wc\" will both be ensured in
137`org-capture-templates'."
138 (declare (indent 2))
139 ;; Check for existence of parent groups
140 (when (> (length keys) 1)
141 (let ((expected (cl-loop for i from 1 to (1- (length keys))
142 collect (substring 0 i) into keys
143 finally return keys)))
144 (cl-loop
145 for ek in expected
146 if (not (+org-capture--get ek org-capture-templates))
147 do (+org-define-capture-templates-group ek (format "(Group %s)" ek)))))
148 (if (null args)
149 ;; Add the title
150 (+org-define-capture-templates-group keys description)
151 ;; Add the capture template.
152 (setf (+org-capture--get keys org-capture-templates)
153 (append (list (or (plist-get args :type)
154 +org-capture-default-type)
155 (or ( plist-get args :target)
156 +org-capture-default-target)
157 (or (plist-get args :template)
158 +org-capture-default-template))
159 (cl-loop for (key val) on args by #'cddr
160 unless (member key '(:type :target :template))
161 append (list key val))))))
162 47
163(provide '+org-capture) 48(provide '+org-capture)
164;;; +org-capture.el ends here 49;;; +org-capture.el
diff --git a/lisp/+org.el b/lisp/+org.el index 7698ec9..a148bd8 100644 --- a/lisp/+org.el +++ b/lisp/+org.el
@@ -1,7 +1,13 @@
1;;; +org.el --- -*- lexical-binding: t -*- 1;;; +org.el -*- lexical-binding: t; -*-
2 2
3;;; Org Return DWIM 3;;; Code:
4;; [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]] 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/
5 11
6(defun +org-element-descendant-of (type element) 12(defun +org-element-descendant-of (type element)
7 "Return non-nil if ELEMENT is a descendant of TYPE. 13 "Return non-nil if ELEMENT is a descendant of TYPE.
@@ -94,53 +100,13 @@ With PREFIX, call `org-return'."
94 (t ; Otherwise---just call `org-return'. 100 (t ; Otherwise---just call `org-return'.
95 (org-return)))) 101 (org-return))))
96 102
97(defun +org-table-copy-down|+org-return (&optional n) 103(defun +org-table-copy-down|+org-return-dwim (&optional n)
98 "Call `org-table-copy-down' or `+org-return' depending on context." 104 "Call `org-table-copy-down' or `+org-return' depending on context."
99 (interactive "P") 105 (interactive "P")
100 (if (org-table-check-inside-data-field 'noerror) 106 (if (org-table-check-inside-data-field 'noerror)
101 (org-table-copy-down (or n 1)) 107 (org-table-copy-down (or n 1))
102 (+org-return-dwim n))) 108 (+org-return-dwim n)))
103 109
104;;; Copy org trees as HTML
105
106;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
107(defun +org-export-clip-to-html
108 (&optional async subtreep visible-only body-only ext-plist post-process)
109 "Export region to HTML, and copy it to the clipboard.
110Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
111and POST-PROCESS are passed to `org-export-to-file'."
112 (interactive) ; XXX: hould this be interactive?
113 (message "Exporting Org to HTML...")
114 (let ((org-tmp-file "/tmp/org.html"))
115 (org-export-to-file 'html org-tmp-file
116 async subtreep visible-only body-only ext-plist post-process)
117 (start-process "xclip" "*xclip*"
118 "xclip" "-verbose"
119 "-i" org-tmp-file
120 "-t" "text/html"
121 "-selection" "clipboard"))
122 (message "Exporting Org to HTML...done."))
123
124;; Specialized functions
125(defun +org-export-clip-subtree-to-html ()
126 "Export current subtree to HTML."
127 (interactive)
128 (+org-export-clip-to-html nil :subtree))
129
130;;; Unsmartify quotes and dashes and stuff.
131
132(defun +org-unsmartify ()
133 "Replace \"smart\" punctuation with their \"dumb\" counterparts."
134 (interactive)
135 (save-excursion
136 (goto-char (point-min))
137 (while (re-search-forward "[“”‘’–—]" nil t)
138 (let ((replace (pcase (match-string 0)
139 ((or "“" "”") "\"")
140 ((or "‘" "’") "'")
141 ("–" "--")
142 ("—" "---"))))
143 (replace-match replace nil nil)))))
144 110
145;;; A ... different ... `org-open-at-point-dwim' 111;;; A ... different ... `org-open-at-point-dwim'
146;; I honestly don't remember what the difference is between this and the 112;; I honestly don't remember what the difference is between this and the
@@ -177,20 +143,7 @@ and POST-PROCESS are passed to `org-export-to-file'."
177 (org-up-heading-all 1)) 143 (org-up-heading-all 1))
178 (org-open-at-point arg))))) 144 (org-open-at-point arg)))))
179 145
180;;; Skip invisible shit when moving around
181(defun +org-ignore-invisible (fn &rest r)
182 ":around ADVICE to ignore invisible text in `org-mode' buffers."
183 ;; TODO: generalize to all modes
184 (cond ((and (derived-mode-p #'org-mode)
185 (org-invisible-p))
186 (while (org-invisible-p)
187 (forward-char))
188 (apply fn r))
189 (t (apply fn r))))
190
191;;; Faces 146;;; Faces
192
193;;; Better org faces
194;; see `org-emphasis-alist' 147;; see `org-emphasis-alist'
195 148
196(defface org-bold '((t (:weight bold))) 149(defface org-bold '((t (:weight bold)))
@@ -205,63 +158,152 @@ and POST-PROCESS are passed to `org-export-to-file'."
205(defface org-strikethrough '((t (:strike-through t))) 158(defface org-strikethrough '((t (:strike-through t)))
206 "Strike-through face for `org-mode' documents.") 159 "Strike-through face for `org-mode' documents.")
207 160
208;; `org-verbatim' and `org-code' are apparently already things, so we skip them 161;;; Unsmartify
209;; here. 162
210 163(defun +org-unsmartify ()
211;;; Inhibit hooks on `org-agenda' 164 "Replace \"smart\" punctuation with their \"dumb\" counterparts."
212;; It's really annoying when I call `org-agenda' and five hundred Ispell 165 (interactive)
213;; processes are created because I have `flyspell-mode' in the hook. This mode 166 (save-excursion
214;; inhibits those hooks when entering the agenda, but runs them when opening the 167 (goto-char (point-min))
215;; actual buffer. 168 (while (re-search-forward "[“”‘’–—]" nil t)
216 169 (let ((replace (pcase (match-string 0)
217(defun +org-agenda-inhibit-hooks (fn &rest r) 170 ((or "“" "”") "\"")
218 "Advice to inhibit hooks when entering `org-agenda'." 171 ((or "‘" "’") "'")
219 (let ((org-mode-hook nil)) 172 ("–" "--")
220 (apply fn r))) 173 ("—" "---"))))
221 174 (replace-match replace nil nil)))))
222(defvar-local +org-hook-has-run-p nil 175
223 "Whether `org-mode-hook' has run in the current buffer.") 176;;; Copy org trees as HTML
224 177;; Thanks to Oleh Krehel:
225(defun +org-agenda-switch-run-hooks (&rest _) 178;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
226 "Advice to run `org-mode-hook' when entering org-mode. 179
227This should only fire when switching to a buffer from `org-agenda'." 180(defun +org-export-clip-to-html
228 (unless +org-hook-has-run-p 181 (&optional async subtreep visible-only body-only ext-plist post-process)
229 (run-hooks 'org-mode-hook) 182 "Export region to HTML, and copy it to the clipboard.
230 (setq +org-hook-has-run-p t))) 183Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
231 184and POST-PROCESS are passed to `org-export-to-file'."
232(define-minor-mode +org-agenda-inhibit-hooks-mode 185 (interactive) ; XXX: hould this be interactive?
233 "Inhibit `org-mode-hook' when opening `org-agenda'." 186 (message "Exporting Org to HTML...")
234 :lighter " A/h" 187 (let ((org-tmp-file "/tmp/org.html"))
235 :global t 188 (org-export-to-file 'html org-tmp-file
236 (cond (+org-agenda-inhibit-hooks-mode 189 async subtreep visible-only body-only ext-plist post-process)
237 (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) 190 ;; XXX: figure out which clipboard to use, or use something in Emacs
238 (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) 191 (start-process "xclip" "*xclip*"
239 (:else 192 "xclip" "-verbose"
240 (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) 193 "-i" org-tmp-file
241 (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) 194 "-t" "text/html"
242 195 "-selection" "clipboard"))
243;;; Drawers 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
244(defun +org-hide-drawers-except-point () 206(defun +org-hide-drawers-except-point ()
245 "Hide all drawers except for the one point is in." 207 "Hide all drawers except for the one point is in."
246 ;; Most of this bit is taken from `org-fold--hide-drawers'. 208 ;; Most of this bit is taken from `org-fold--hide-drawers'.
247 (let ((pt (point)) 209 (let ((pt (point))
248 (begin (point-min)) 210 (begin (point-min))
249 (end (point-max))) 211 (end (point-max)))
250 (save-excursion 212 (save-excursion
251 (goto-char begin) 213 (goto-char begin)
252 (while (and (< (point) end) 214 (while (and (< (point) end)
253 (re-search-forward org-drawer-regexp end t)) 215 (re-search-forward org-drawer-regexp end t))
254 (if (org-fold-folded-p nil 'drawer) 216 (if (org-fold-folded-p nil 'drawer)
255 (goto-char (org-fold-next-folding-state-change 'drawer nil end)) 217 (goto-char (org-fold-next-folding-state-change 'drawer nil end))
256 (let* ((drawer (org-element-at-point)) 218 (let* ((drawer (org-element-at-point))
257 (type (org-element-type drawer)) 219 (type (org-element-type drawer))
258 (el-begin (org-element-property :begin drawer)) 220 (el-begin (org-element-property :begin drawer))
259 (el-end (org-element-property :end drawer))) 221 (el-end (org-element-property :end drawer)))
260 (when (memq type '(drawer property-drawer)) 222 (when (memq type '(drawer property-drawer))
261 (org-fold-hide-drawer-toggle 223 (org-fold-hide-drawer-toggle
262 (if (< el-begin pt el-end) 'off 'on) 224 (if (< el-begin pt el-end) 'off 'on)
263 nil drawer) 225 nil drawer)
264 (goto-char el-end)))))))) 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.
232A function named `+org-link-TYPE-open' will be created, with ARGS
233as its arguments and BODY as its body. BODY can be blank, in
234which case the user will be messaged (This is a good do-nothing
235effect 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.
267Pre-fill the input with clipboard contents if they match CLIPBOARDP. If
268CLIPBOARDP is nil or missing, don't pre-fill.
269
270If INSERT is non-nil, insert the property into the property
271drawer of the current org tree.
272
273If 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))))
265 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))))))
266 307
267(provide '+org) 308(provide '+org)
309;;; +org.el ends here
diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null
@@ -1,29 +0,0 @@
1;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'ox)
8
9;;; Run hooks before doing any exporting at all
10
11(defcustom +org-export-pre-hook nil
12 "Functions to run /before/ `org-export-as' does anything.
13These will run on the buffer about to be exported, NOT a copy."
14 :type 'hook)
15
16(defun +org-export-pre-run-hooks (&rest _)
17 "Run hooks in `+org-export-pre-hook'."
18 (run-hooks '+org-export-pre-hook))
19
20(defun +org-export-pre-hooks-insinuate ()
21 "Advise `org-export-as' to run `+org-export-pre-hook'."
22 (advice-add 'org-export-as :before #'+org-export-pre-run-hooks))
23
24(defun +org-export-pre-hooks-remove ()
25 "Remove pre-hook advice on `org-export-as'."
26 (advice-remove 'org-export-as #'+org-export-pre-run-hooks))
27
28(provide '+ox)
29;;; +ox.el ends here
diff --git a/lisp/+paredit.el b/lisp/+paredit.el new file mode 100644 index 0000000..ab176b8 --- /dev/null +++ b/lisp/+paredit.el
@@ -0,0 +1,26 @@
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/+tempo.el b/lisp/+tempo.el deleted file mode 100644 index 2c81e54..0000000 --- a/lisp/+tempo.el +++ /dev/null
@@ -1,45 +0,0 @@
1;;; +tempo.el --- easier tempo definition -*- lexical-binding: t -*-
2
3(require 'tempo)
4(declare-function derived-mode-abbrev-table-name "tempo")
5
6;; TODO: I need to figure out where this function goes.
7(defun delete2 (list &rest elems)
8 "Delete each element of ELEMS, and the next item, from LIST."
9 (let ((r nil))
10 (while (consp list)
11 (if (member (car list) elems)
12 (setf list (cdr list))
13 (setf r (cons (car list) r)))
14 (setf list (cdr list)))
15 (reverse r)))
16
17(defmacro define-tempo (tag doc &rest elements)
18 "Define a template and add its tag to MODE's abbrev-table.
19TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see.
20ABBREV, if given, is the abbrev string to use for template expansion
21under MODE's abbrev-table. If ABBREV isn't given, TAG will be used."
22 (declare (indent 1))
23 (let* ((template (gensym))
24 (tag (cond ((stringp tag) tag)
25 ((symbolp tag) (symbol-name tag))
26 (t (user-error "TAG must be a string or symbol: %S" tag))))
27 (mode (or (plist-get elements :mode) nil))
28 (abbrev (or (plist-get elements :abbrev) tag))
29 (taglist (or (plist-get elements :taglist) nil))
30 (table (let ((tname (and mode (derived-mode-abbrev-table-name mode))))
31 (while (and tname (not (memq tname abbrev-table-name-list)))
32 (setq tname (and (get mode 'derived-mode-parent)
33 (derived-mode-abbrev-table-name
34 (get mode 'derived-mode-parent)))))
35 (or tname 'global-abbrev-table)))
36 (elements (delete2 elements :mode :abbrev :taglist)))
37 `(let ((,template (tempo-define-template ,tag
38 ',elements
39 ,(or abbrev tag)
40 ,doc
41 ,taglist)))
42 (define-abbrev ,table ,tag "" ,template :system t)
43 (put ,template 'no-self-insert t))))
44
45(provide '+tempo)
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el index 9266807..6defda7 100644 --- a/lisp/+titlecase.el +++ b/lisp/+titlecase.el
@@ -22,11 +22,13 @@ With prefix ARG, toggle the value of
22 ;; See also `org-map-tree'. I'm not using that function because I want to 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 23 ;; skip the first headline. A better solution would be to patch
24 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc). 24 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
25 (let ((level (funcall outline-level))) 25 (let ((level (funcall outline-level))
26 (org-special-ctrl-a/e t))
26 (while (and (progn (outline-next-heading) 27 (while (and (progn (outline-next-heading)
27 (> (funcall outline-level) level)) 28 (> (funcall outline-level) level))
28 (not (eobp))) 29 (not (eobp)))
29 (titlecase-line))))) 30 (titlecase-region (org-beginning-of-line)
31 (org-end-of-line))))))
30 32
31(provide '+titlecase) 33(provide '+titlecase)
32;;; +titlecase.el ends here 34;;; +titlecase.el ends here
diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null
@@ -1,130 +0,0 @@
1;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Do I want to propose this change in the Emacs ML?
6
7;;; Code:
8
9(require 'window)
10
11;;; Split windows based on `window-total-width', not `window-width'
12;; I have to just redefine these functions because the check is really deep in
13;; there.
14
15(defun window-splittable-p (window &optional horizontal)
16 "Return non-nil if `split-window-sensibly' may split WINDOW.
17Optional argument HORIZONTAL nil or omitted means check whether
18`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
19non-nil means check whether WINDOW may be split horizontally.
20
21WINDOW may be split vertically when the following conditions
22hold:
23- `window-size-fixed' is either nil or equals `width' for the
24 buffer of WINDOW.
25- `split-height-threshold' is an integer and WINDOW is at least as
26 high as `split-height-threshold'.
27- When WINDOW is split evenly, the emanating windows are at least
28 `window-min-height' lines tall and can accommodate at least one
29 line plus - if WINDOW has one - a mode line.
30
31WINDOW may be split horizontally when the following conditions
32hold:
33- `window-size-fixed' is either nil or equals `height' for the
34 buffer of WINDOW.
35- `split-width-threshold' is an integer and WINDOW is at least as
36 wide as `split-width-threshold'.
37- When WINDOW is split evenly, the emanating windows are at least
38 `window-min-width' or two (whichever is larger) columns wide."
39 (when (and (window-live-p window)
40 (not (window-parameter window 'window-side)))
41 (with-current-buffer (window-buffer window)
42 (if horizontal
43 ;; A window can be split horizontally when its width is not
44 ;; fixed, it is at least `split-width-threshold' columns wide
45 ;; and at least twice as wide as `window-min-width' and 2 (the
46 ;; latter value is hardcoded).
47 (and (memq window-size-fixed '(nil height))
48 ;; Testing `window-full-width-p' here hardly makes any
49 ;; sense nowadays. This can be done more intuitively by
50 ;; setting up `split-width-threshold' appropriately.
51 (numberp split-width-threshold)
52 (>= (window-total-width window)
53 (max split-width-threshold
54 (* 2 (max window-min-width 2)))))
55 ;; A window can be split vertically when its height is not
56 ;; fixed, it is at least `split-height-threshold' lines high,
57 ;; and it is at least twice as high as `window-min-height' and 2
58 ;; if it has a mode line or 1.
59 (and (memq window-size-fixed '(nil width))
60 (numberp split-height-threshold)
61 (>= (window-height window)
62 (max split-height-threshold
63 (* 2 (max window-min-height
64 (if mode-line-format 2 1))))))))))
65
66(defun split-window-sensibly (&optional window)
67 "Split WINDOW in a way suitable for `display-buffer'.
68WINDOW defaults to the currently selected window.
69If `split-height-threshold' specifies an integer, WINDOW is at
70least `split-height-threshold' lines tall and can be split
71vertically, split WINDOW into two windows one above the other and
72return the lower window. Otherwise, if `split-width-threshold'
73specifies an integer, WINDOW is at least `split-width-threshold'
74columns wide and can be split horizontally, split WINDOW into two
75windows side by side and return the window on the right. If this
76can't be done either and WINDOW is the only window on its frame,
77try to split WINDOW vertically disregarding any value specified
78by `split-height-threshold'. If that succeeds, return the lower
79window. Return nil otherwise.
80
81By default `display-buffer' routines call this function to split
82the largest or least recently used window. To change the default
83customize the option `split-window-preferred-function'.
84
85You can enforce this function to not split WINDOW horizontally,
86by setting (or binding) the variable `split-width-threshold' to
87nil. If, in addition, you set `split-height-threshold' to zero,
88chances increase that this function does split WINDOW vertically.
89
90In order to not split WINDOW vertically, set (or bind) the
91variable `split-height-threshold' to nil. Additionally, you can
92set `split-width-threshold' to zero to make a horizontal split
93more likely to occur.
94
95Have a look at the function `window-splittable-p' if you want to
96know how `split-window-sensibly' determines whether WINDOW can be
97split."
98 (let ((window (or window (selected-window))))
99 (or (and (window-splittable-p window)
100 ;; Split window vertically.
101 (with-selected-window window
102 (split-window-below)))
103 (and (window-splittable-p window t)
104 ;; Split window horizontally.
105 (with-selected-window window
106 (split-window-right)))
107 (and
108 ;; If WINDOW is the only usable window on its frame (it is
109 ;; the only one or, not being the only one, all the other
110 ;; ones are dedicated) and is not the minibuffer window, try
111 ;; to split it vertically disregarding the value of
112 ;; `split-height-threshold'.
113 (let ((frame (window-frame window)))
114 (or
115 (eq window (frame-root-window frame))
116 (catch 'done
117 (walk-window-tree (lambda (w)
118 (unless (or (eq w window)
119 (window-dedicated-p w))
120 (throw 'done nil)))
121 frame nil 'nomini)
122 t)))
123 (not (window-minibuffer-p window))
124 (let ((split-height-threshold 0))
125 (when (window-splittable-p window)
126 (with-selected-window window
127 (split-window-below))))))))
128
129(provide '+window)
130;;; +window.el ends here
diff --git a/lisp/acdw-defaults.el b/lisp/acdw-defaults.el new file mode 100644 index 0000000..80b2bcc --- /dev/null +++ b/lisp/acdw-defaults.el
@@ -0,0 +1,292 @@
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;;; Internal packages
108
109(when (require 'abbrev nil t)
110 (custom-set-variables
111 '(abbrev-file-name (sync/ "abbrev.el"))
112 '(save-abbrevs 'silently)))
113
114(when (require 'autorevert nil t)
115 (custom-set-variables
116 '(auto-revert-verbose nil)
117 '(global-auto-revert-non-file-buffers t))
118 (global-auto-revert-mode +1))
119
120(when (require 'comp nil t)
121 (custom-set-variables
122 '(native-comp-async-report-warnings-errors 'silent)
123 '(native-comp-deferred-compilation t)))
124
125(when (require 'custom nil t)
126 (custom-set-variables
127 '(custom-file (etc/ "custom.el"))))
128
129(when (require 'ediff nil t)
130 (custom-set-variables
131 '(ediff-window-setup-function #'ediff-setup-windows-plain)))
132
133(when (require 'eldoc nil t)
134 (custom-set-variables
135 '(eldoc-echo-area-use-multiline-p nil)
136 '(eldoc-idle-delay 0.1)))
137
138(when (require 'executable nil t)
139 (custom-set-variables
140 '(executable-prefix-env t)))
141
142(when (require 'files nil t)
143 (custom-set-variables
144 '(auto-save-default nil)
145 '(auto-save-interval 1)
146 '(auto-save-no-message t)
147 '(auto-save-timeout 1)
148 '(auto-save-visited-interval 1)
149 '(backup-by-copying t)
150 '(create-lockfiles nil)
151 '(delete-old-versions t)
152 '(find-file-visit-truename t)
153 '(kept-new-versions 8)
154 '(kept-old-versions 8)
155 '(mode-require-final-newline t)
156 '(version-control t)
157 '(view-read-only t))
158 (dolist (h/f
159 '((after-save-hook . executable-make-buffer-file-executable-if-script-p)
160 (find-file-not-found-functions . create-missing-directories)
161 (find-file-hook . +vc-off@remote)))
162 (add-hook (car h/f) (cdr h/f)))
163 (auto-save-visited-mode))
164
165(when (require 'frame nil t)
166 (custom-set-variables
167 '(blink-cursor-blinks 1)
168 '(blink-cursor-interval 0.25)
169 '(blink-cursor-delay 0.25))
170 (blink-cursor-mode))
171
172(when (require 'goto-addr nil t)
173 (if (fboundp 'global-goto-address-mode)
174 (global-goto-address-mode +1)
175 (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
176
177(when (require 'ibuffer nil t)
178 (global-set-key (kbd "C-x C-b") #'ibuffer)
179 (add-hook 'ibuffer-mode-hook #'hl-line-mode))
180
181(when (require 'image nil t)
182 (custom-set-variables
183 '(image-use-external-converter
184 (seq-some #'executable-find '("convert" "gm" "ffmpeg")))))
185
186(when (require 'imenu nil t)
187 (custom-set-variables
188 '(imenu-auto-rescan t)))
189
190(when (require 'isearch nil t)
191 (custom-set-variables
192 '(regexp-search-ring-max default-ring-max)
193 '(search-ring-max default-ring-max)))
194
195(when (require 'minibuffer nil t)
196 (custom-set-variables
197 '(completion-category-defaults nil)
198 '(completion-category-overrides '((file (styles partial-completion))))
199 '(completion-ignore-case t)
200 '(completion-styles '(substring partial-completion))
201 '(enable-recursive-minibuffers t)
202 '(file-name-shadow-properties '(invisible t intangible t))
203 '(minibuffer-eldef-shorten-default t)
204 '(minibuffer-prompt-properties '( read-only t
205 cursor-intangible t
206 face minibuffer-prompt))
207 '(read-buffer-completion-ignore-case t))
208 (file-name-shadow-mode)
209 (minibuffer-electric-default-mode))
210
211(when (require 'mouse nil t)
212 (custom-set-variables
213 '(mouse-drag-copy-region t)
214 '(mouse-wheel-progressive-speed nil)
215 '(mouse-yank-at-point t)))
216
217(when (require 'paren nil t)
218 (custom-set-variables
219 '(show-paren-delay 0.01)
220 '(show-paren-style 'parenthesis)
221 '(show-paren-when-point-in-periphery t)
222 '(show-paren-when-point-inside-paren t))
223 (show-paren-mode)
224 (electric-pair-mode))
225
226(when (require 'recentf nil t)
227 (custom-set-variables
228 '(recentf-save-file (var/ "recentf.el"))
229 '(recentf-max-menu-items default-ring-max)
230 '(recentf-max-saved-items nil)
231 '(recentf-auto-cleanup 'mode))
232 (add-to-list 'recentf-exclude etc/)
233 (add-to-list 'recentf-exclude var/)
234 (add-to-list 'recentf-exclude cache/)
235 (add-to-list 'recentf-exclude "-autoloads.el\\'")
236 (recentf-mode +1))
237
238(when (require 'savehist nil t)
239 (custom-set-variables
240 '(history-length 1024)
241 '(history-delete-duplicates t)
242 '(savehist-file (var/ "savehist.el"))
243 '(savehist-save-minibuffer-history t)
244 '(savehist-autosave-interval 30)
245 ;; Other variables --- don't truncate any of these.
246 ;; `add-to-history' uses the values of these variables unless
247 ;; they're nil, in which case it falls back to `history-length'.
248 '(kill-ring-max default-ring-max)
249 '(mark-ring-max default-ring-max)
250 '(global-mark-ring-max default-ring-max)
251 '(regexp-search-ring-max default-ring-max)
252 '(search-ring-max default-ring-max)
253 '(kmacro-ring-max default-ring-max)
254 '(eww-history-limit default-ring-max))
255 (dolist (var '(global-mark-ring
256 mark-ring
257 kill-ring
258 kmacro-ring
259 regexp-search-ring
260 search-ring))
261 (add-to-list 'savehist-additional-variables var))
262 (savehist-mode +1))
263
264(when (require 'saveplace nil t)
265 (custom-set-variables
266 '(save-place-file (var/ "places.el"))
267 '(save-place-forget-unreadable-files (eq system-type 'gnu/linux)))
268 (save-place-mode 1))
269
270(when (require 'uniquify nil t)
271 (custom-set-variables
272 '(uniquify-after-kill-buffer-p t)
273 '(uniquify-buffer-name-style 'forward)
274 '(uniquify-ignore-buffers-re "^\\*")
275 '(uniquify-separator path-separator)))
276
277(when (require 'vc nil t)
278 (custom-set-variables
279 '(vc-follow-symlinks t)
280 '(vc-make-backup-files t)))
281
282(when (require 'window nil t)
283 (custom-set-variables
284 '(recenter-positions '(top 2 middle bottom))))
285
286;;; New features
287
288(when (fboundp 'pixel-scroll-precision-mode)
289 (pixel-scroll-precision-mode))
290
291(provide 'acdw-defaults)
292;;; acdw-defaults.el ends here
diff --git a/lisp/acdw-funs.el b/lisp/acdw-funs.el new file mode 100644 index 0000000..ed41a61 --- /dev/null +++ b/lisp/acdw-funs.el
@@ -0,0 +1,262 @@
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.
10See 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.
17See 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.
24See 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.
45If OBJECT is already a list, return OBJECT itself. If it's
46not 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.
53Each 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
56function will `require' them too---but not error if they don't
57exist."
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.
66This 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'.
83That is, with a positive N, deletes newlines as well, leaving -N
84spaces. If N is negative, it will not delete newlines and leave
85N 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.
91If 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.
99When 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.
107A paragraph is defined as continguous non-empty lines of text
108surrounded by empty lines, so opening a paragraph means to make
109three blank lines, then place the point on the second one.
110
111Called 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.
133A paragraph is defined as continguous non-empty lines of text
134surrounded by empty lines, so opening a paragraph means to make
135three blank lines, then place the point on the second one.
136
137Called 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.
170Returns the new, commented, string.
171
172If 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.
191Both FUNC and PREDICATE will be executed with no arguments and in
192the context of each buffer.
193
194If 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.
203FUNC will be executed with no arguments and in the context of
204each 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.
211Each of STRINGS can be a bare string or a list. Strings are
212passed through as-is, but lists are passed to FUNC first as
213arguments. Finally, all the resulting strings are `mapconcat'-ed
214together.
215
216As a special case, if `:separator' is the first of STRINGS, the
217string following will be used as a separator. Otherwise, a
218newline 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.
233If `:separator' is the first of STRINGS, the next string will be used to
234separate the rest of STRINGS."
235 (++concat #'concat strings))
236
237(defun format-concat (&rest strings)
238 "Concatenate formatted STRINGS.
239Each of STRINGS can be a bare string or a list. Bare strings are passed as-is
240to `mapconcat' for concatenation and separation. Lists, however, are passed to
241`format' first.
242
243If `:separator' is the first of STRINGS, the next string will be
244used 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 new file mode 100644 index 0000000..e2258fa --- /dev/null +++ b/lisp/acdw-macs.el
@@ -0,0 +1,293 @@
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.
18PREREQS can be a feature, a number, `t', or a list of those.
19
20Features are used as arguments to `eval-after-load'. Numbers are
21used as arguments to `run-with-idle-timer'. `t' will ensure BODY
22runs after Emacs's init time.
23
24When given a list of PREREQS, `eval-after' will nest each one
25from 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.
73DOCSTRING is applied to the variable; its default is DIRECTORY's
74path."
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.
92If MAPS is nil or t, bind to `current-global-map'. Otherwise,
93bind each of BINDINGS to the map or list of maps provided.
94
95BINDINGS is a `setq'-style list of pairs of keys and definitions.
96The key part of each binding can be a string, in which case it's
97passed to `kbd', or a vector or anything else `define-key'
98accepts in the KEY position. The definition part, likewise, can
99be any form `define-key' accepts in that position, with this
100addition: if the form is a `defun' form, it will be defined
101before 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.
151NAME and ARGS are passed to the generated `defun' form.
152Each 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.
194Each of FNS can be an atom (function name) or a list of the
195form (FUNCTION ARGS), where ARGS is a plist. ARGS's possible
196keys are `:doc' (docstring), `:interactive', and `:type', which are
197used as the optional arguments to `autoload'.
198
199You can also pass `:interactive' and `:type' as keyword arguments
200just after FILE, and they'll serve as the default for the
201autoloaded 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.
223If 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.
266TAG, DOC, and ELEMENTS are passed to `tempo-define-template', which see.
267ABBREV, if given, is the abbrev string to use for template expansion
268under 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 index a9ef893..30c4f44 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -1,272 +1,79 @@
1;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- 1;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*-
2;; by C. Duckworth <acdw@acdw.net> 2
3(require 'cl-lib) 3;;; Code:
4;; def.el is here 4
5(require 'def) 5(require 'acdw-funs) ; Extra functions
6 6(require 'acdw-macs) ; Extra macros
7;;; Define both a directory and a function expanding to a file in that directory 7
8 8(defdir etc/ (locate-user-emacs-file "etc")
9(defmacro +define-dir (name directory &optional docstring inhibit-mkdir) 9 "Directory for package configuration files.
10 "Define a variable and function NAME expanding to DIRECTORY. 10See `no-littering' for examples.")
11DOCSTRING is applied to the variable. Ensure DIRECTORY exists in 11
12the filesystem, unless INHIBIT-MKDIR is non-nil." 12(defdir var/ etc/
13 (declare (indent 2) 13 "Directory for package data file.
14 (doc-string 3)) 14See `no-littering' for examples.")
15 (unless inhibit-mkdir 15
16 (make-directory (eval directory) :parents)) 16(defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME")))
17 `(progn 17 (expand-file-name "emacs/" xdg-cache)
18 (defvar ,name ,directory 18 etc/)
19 ,(concat docstring (when docstring "\n") 19 "Directory for cache files.")
20 "Defined by `/define-dir'.")) 20
21 (defun ,name (file &optional mkdir) 21(setq native-compile-target-directory (cache/ "eln" t))
22 ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" 22(when (fboundp 'startup-redirect-eln-cache)
23 "If MKDIR is non-nil, the directory is created.\n" 23 (startup-redirect-eln-cache (cache/ "eln" t)))
24 "Defined by `/define-dir'.") 24
25 (let ((file-name (expand-file-name (convert-standard-filename file) 25(defdir sync/ (expand-file-name "/home/case/Sync")
26 ,name))) 26 "My Syncthing directory.")
27 (when mkdir 27
28 (make-directory (file-name-directory file-name) :parents)) 28(defdir private/ (sync/ "emacs/private"))
29 file-name)))) 29(add-to-list 'load-path private/)
30 30
31;;; Evaluating things after other things 31(require 'acdw-defaults) ; Sane defaults
32 32(require '_acdw) ; Private stuff
33(defun eval-after-init (fn) 33(require '+lisp) ; Lispy goodness
34 "Evaluate FN after inititation, or now if Emacs is initialized. 34
35FN is called with no arguments." 35(setc enable-recursive-minibuffers t
36 (if after-init-time 36 completions-detailed t
37 (funcall fn) 37 completion-ignore-case t
38 (add-hook 'after-init-hook fn))) 38 read-buffer-completion-ignore-case t
39 39 read-file-name-completion-ignore-case t
40(defmacro eval-after (features &rest body) 40 initial-buffer-choice #'+initial-buffer
41 "Evaluate BODY, but only after loading FEATURES. 41 initial-scratch-message
42FEATURES can be an atom or a list; as an atom it works like 42 (format "%s\n\n"
43`with-eval-after-load'. The special feature `init' will evaluate 43 (comment-lines
44BODY after Emacs is finished initializing." 44 (shell-command-to-string "fortune")
45 (declare (indent 1) 45 ";; "))
46 (debug (form def-body))) 46 sentence-end-double-space nil
47 (unless (listp features) 47 save-silently t)
48 (setf features (list features))) 48
49 (if (null features) 49(defkeys t
50 (macroexp-progn body) 50 "M-o" #'other-window|switch-buffer
51 (let* ((this (car features)) 51 "C-x 0" #'delete-window|bury-buffer
52 (rest (cdr features))) 52 "C-M-;" #'+lisp-comment-or-uncomment-sexp
53 (cond ((eq this 'init) 53 "M-SPC" #'+cycle-spacing
54 `(eval-after-init 54 "C-x C-k" #'kill-this-buffer)
55 (lambda () (eval-after ,rest ,@body)))) 55
56 (:else 56(defkeys t
57 `(with-eval-after-load ',this 57 "M-u" #'universal-argument)
58 (eval-after ,rest ,@body))))))) 58
59 59(defkeys universal-argument-map
60;;; Convenience functions 60 "M-u" #'universal-argument-more)
61 61
62(defun define-key* (maps &rest keydefs) 62(define-advice switch-to-buffer (:after (&rest _) normal-mode)
63 "Define KEYDEFS in MAPS. 63 "Automatically determine the mode for created non-file buffers."
64Convenience wrapper around `define-key'." 64 (when-let ((_ (and (eq major-mode 'fundamental-mode)))
65 (unless (zerop (mod (length keydefs) 2)) 65 (buffer-file-name (buffer-name)))
66 (user-error "Wrong number of arguments: %S" (length keydefs))) 66 (normal-mode)))
67 (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) 67
68 (list maps) 68(define-advice canonically-space-region
69 maps)) 69 (:around (orig &rest args) double-space-sentences)
70 (cl-loop for (key def) on keydefs by #'cddr 70 (let ((sentence-end-double-space t))
71 do (let ((key (if (stringp key) (kbd key) key))) 71 (apply orig args)))
72 (define-key (if (symbolp map) 72
73 (symbol-value map) 73(with-region-or-buffer indent-region)
74 map) 74
75 key def))))) 75(winner-mode)
76
77(unless (fboundp 'ensure-list)
78 ;; Just in case we're using an old version of Emacs.
79 (defun ensure-list (object)
80 "Return OBJECT as a list.
81If OBJECT is already a list, return OBJECT itself. If it's
82not a list, return a one-element list containing OBJECT."
83 (if (listp object)
84 object
85 (list object))))
86
87(defun add-to-list* (lists &rest things)
88 "Add THINGS to LISTS.
89LISTS can be one list variable or a list. Each thing of THINGS
90can be either a variable (the thing), or a list of the form
91(ELEMENT &optional APPEND COMPARE-FN), which is passed to
92`add-to-list'."
93 (declare (indent 1))
94 (dolist (l (ensure-list lists))
95 (dolist (thing things)
96 (apply #'add-to-list l (ensure-list thing)))))
97
98(defun add-hook* (hooks &rest functions)
99 "Add FUNCTIONS to HOOKS.
100Each function in FUNCTIONS can be a singleton or a list of the
101form (FUNCTION &optional DEPTH LOCAL)."
102 (declare (indent 1))
103 (dolist (hook (ensure-list hooks))
104 (dolist (fn functions)
105 (apply #'add-hook hook (ensure-list fn)))))
106
107(defun +concat (&rest strings)
108 "Concat STRINGS separated by SEPARATOR.
109SEPARATOR is \"\\n\" unless the keyword argument `:separator' is
110given, followed by the separator to use. Each item in STRINGS is
111either a string or a list or strings, which is concatenated
112without any separator."
113 (let (ret
114 ;; I don't know why a `cl-defun' with
115 ;; (&rest strings &key (separator "\n")) doesn't work
116 (separator (or (cl-loop for i from 0 upto (length strings)
117 if (eq (nth i strings) :separator)
118 return (nth (1+ i) strings))
119 "\n")))
120 (while strings
121 (let ((string (pop strings)))
122 (cond ((eq string :separator) (pop strings))
123 ((listp string) (push (apply #'concat string) ret))
124 ((stringp string) (push string ret)))))
125 (mapconcat #'identity (nreverse ret) separator)))
126
127(defun require* (&rest features)
128 "Require FEATURES in order.
129Each feature of FEATURES can also be a list of the arguments to
130pass to `require', which see."
131 (condition-case e
132 (dolist (feature features)
133 (apply #'require (ensure-list feature)))
134 (:success (mapcar (lambda (f) (car (ensure-list f))) features))
135 (t (signal (car e) (cdr e)))))
136
137;;; Convenience macros
138
139(defmacro define-local-before-save-hook (mode-or-hook &rest body)
140 "Add a local `before-save-hook' to MODE-OR-HOOK."
141 (declare (indent 1))
142 (let* ((name (format "%s" mode-or-hook))
143 (external-name (intern (format "%s@before-save" name)))
144 (internal-name (intern (format "before-save@%s" name)))
145 (hook (if (string-suffix-p "-hook" name)
146 mode-or-hook
147 (intern (format "%s-hook" name)))))
148 `(progn
149 (defun ,internal-name ()
150 ,@body)
151 (defun ,external-name ()
152 (add-hook 'before-save-hook #',internal-name nil :local))
153 (add-hook ',hook #',external-name))))
154
155(defmacro setq-local-hook (hooks &rest args)
156 "Run `setq-local' on ARGS when running HOOKs."
157 ;; FIXME: this is pretty messy, i think...
158 ;; The settings should be stored in an alist so that they can be deduplicated
159 (declare (indent 1))
160 `(progn
161 ,@(cl-loop for hook in (ensure-list hooks)
162 collect
163 (let ((fn (intern (format "%s-setq-local" hook))))
164 (when (and (fboundp fn)
165 (functionp fn))
166 (setf args (append (function-get fn 'setq-local-hook-settings) args)))
167 (unless (and (< 0 (length args))
168 (zerop (mod (length args) 2)))
169 (user-error "Wrong number of arguments: %S" (length args)))
170 `(progn
171 (defun ,fn ()
172 ,(format "Set local variables after `%s'." hook)
173 (setq-local ,@args))
174 (function-put ',fn 'setq-local-hook-settings ',args)
175 (dolist (buf (buffer-list))
176 (with-current-buffer buf
177 (when (derived-mode-p
178 ',(intern (replace-regexp-in-string
179 "-hook" "" (format "%s" hook))))
180 (,fn))))
181 (add-hook ',hook #',fn))))))
182
183(defmacro with-message (message &rest body)
184 "Execute BODY, with MESSAGE.
185If body executes without errors, MESSAGE...Done will be displayed."
186 (declare (indent 1))
187 (let ((msg (gensym)))
188 `(let ((,msg ,message))
189 (condition-case e
190 (progn (message "%s..." ,msg)
191 ,@body)
192 (:success (message "%s...done" ,msg))
193 (t (signal (car e) (cdr e)))))))
194
195(defmacro either (&rest clauses)
196 "Return the first of CLAUSES that returns non-nil."
197 (let* ((this (gensym "either")))
198 (unless (null clauses)
199 `(let* ((,this ,(car clauses)))
200 (if ,this ,this (either ,@(cdr clauses)))))))
201
202(defun mapc-buffers (fn &optional pred)
203 "Perform FN on buffers matching PRED.
204If PRED is nil or absent, perform FN on all buffers. Both FN and
205PRED are called within a `with-current-buffer' form and without
206arguments."
207 (let ((pred (cond
208 ((listp pred)
209 (lambda () (apply #'derived-mode-p pred)))
210 ((functionp pred) pred)
211 ((null pred) (lambda () t))
212 (:else (user-error "Bad predicate")))))
213 (dolist (buf (buffer-list))
214 (with-current-buffer buf
215 (when (funcall pred)
216 (funcall fn))))))
217
218;; https://emacs.stackexchange.com/a/39324/37239
219;; XXX: This shit don't work rn
220(defun ignore-invisible-overlays (fn)
221 "Execute FN, ignoring invisible overlays.
222FN should return a point."
223 (let ((overlay nil)
224 (point nil))
225 (setq point (and (funcall fn) (point)))
226 (setq overlay (car (overlays-at (point))))
227 (while (and overlay (member 'invisible (overlay-properties overlay)))
228 (goto-char (overlay-end overlay))
229 (setq point (and (funcall fn) (point)))
230 (setq overlay (car (overlays-at (point)))))
231 point))
232
233;;; Extras
234;; Trying to avoid a whole install of crux ...
235
236(defun kill-and-join-forward (&optional arg)
237 "Kill the line or, if at the end of a line, join with the next.
238This command is `visual-line-mode'-aware. If ARG is provided,
239it's passed on to kill a line, but not to delete indentation.
240When joining, this command deletes whitespace."
241 (interactive "P")
242 (if (and (eolp) (not (bolp)))
243 (delete-indentation 1)
244 (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
245
246(defun other-window|switch-buffer (arg)
247 "Call `other-window' or `switch-buffer' depending on windows.
248When called with prefix ARG, unconditionally switch buffer."
249 (interactive "P")
250 (if (or arg (one-window-p))
251 (switch-to-buffer (other-buffer) nil t)
252 (other-window 1)))
253
254;;; Set variables more better-er
255;; Now this doesn't do `setf'-style stuff.
256
257(defmacro setc (&rest args)
258 "Customize user options using ARGS like `setq'."
259 (declare (debug setq))
260 (unless (zerop (mod (length args) 2))
261 (user-error "Dangling argument: %S" var))
262 (let (form)
263 (while args
264 (push `(customize-set-variable
265 ',(pop args)
266 ,(pop args)
267 "Set by `setc'.")
268 form))
269 `(progn ,@(nreverse form))))
270 76
271(provide 'acdw) 77(provide 'acdw)
78
272;;; acdw.el ends here 79;;; acdw.el ends here
diff --git a/lisp/browse-url-transform.el b/lisp/browse-url-transform.el deleted file mode 100644 index c290a1f..0000000 --- a/lisp/browse-url-transform.el +++ /dev/null
@@ -1,45 +0,0 @@
1;;; browse-url-transform --- transform URLs
2
3(defgroup browse-url-transform nil
4 "Transformations for urls passed to `browse-url'."
5 :group 'browse-url)
6
7(defcustom browse-url-transform-alist nil
8 "Transformation rules for URLs.
9The keys are regexps matching URLs, and the values are how to
10transform them. The replacements will use match capture data."
11 :type '(alist :key-type (string :tag "URL regexp match")
12 :value-type (string :tag "URL regexp transformation")))
13
14(defun browse-url-transform-url (url)
15 "Transform URL before passing it to `browse-url'."
16 (cl-loop with url = (substring-no-properties
17 (if (consp url) (car url) url))
18 for (regex . transformation) in browse-url-transform-alist
19 if (string-match regex url)
20 return (replace-match transformation nil nil url)
21 finally return url))
22
23(defun browse-url-transform-advice (url &rest args)
24 "Advice to `browse-url' for URL transformations.
25ARGS are passed on for further processing."
26 (apply #'list (and url (browse-url-transform-url url)) args))
27
28(define-minor-mode browse-url-transform-mode
29 "Minor mode to transform a URL before passing it to `browse-url'.
30This can be used to \"redirect\" URLs, for example from an
31information silo to a more privacy-respecting one (e.g.,
32\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.
33
34When using this mode, ensure that the transformed URL is also in
35`browse-url-handlers', since that's what `browse-url' will see."
36 :lighter " Turl"
37 :keymap nil
38 :global t
39 (cond (browse-url-transform-mode
40 (advice-add 'browse-url :filter-args #'browse-url-transform-advice))
41 (:else
42 (advice-remove 'browse-url #'browse-url-transform-advice))))
43
44(provide 'browse-url-transform)
45;;; browse-url-transform.el ends here
diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index 30aab7c..0000000 --- a/lisp/dawn.el +++ /dev/null
@@ -1,109 +0,0 @@
1;;; dawn.el --- Lightweight dawn/dusk task scheduling -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2022 Case Duckworth
4
5;; Author: Case Duckworth
6;; Maintainer: Case Duckworth <acdw@acdw.net>
7;; URL: https://codeberg.org/acdw/dusk.el
8;; Version: 0.3.0
9;; Keywords: calendar, themes, convenience
10;; Package-Requires: ((emacs "24.3"))
11
12;;; Commentary:
13
14;; There is also circadian.el, but it doesn't quite work for me.
15;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
16;; somewhere else (which I've forgotten) and my own brain :)
17
18;;; Code:
19
20(require 'calendar)
21(require 'cl-lib)
22(require 'solar)
23
24;;; Timers
25
26(defvar dawn--dawn-timer nil
27 "Timer for dawn-command.")
28
29(defvar dawn--dusk-timer nil
30 "Timer for dusk-command.")
31
32(defvar dawn--reset-timer nil
33 "Timer to reset dawn at midnight.")
34
35;;; Functions
36
37(defun dawn-encode-time (f)
38 "Encode fractional time F.
39If F is nil, return nil."
40 (when f
41 (let ((hhmm (cl-floor f))
42 (date (cdddr (decode-time))))
43 (encode-time
44 (append (list 0
45 (round (* 60 (cadr hhmm)))
46 (car hhmm))
47 date)))))
48
49(defun dawn-midnight ()
50 "Return the time of the /next/ midnight."
51 (let ((date (cdddr (decode-time))))
52 (encode-time
53 (append (list 0 0 0 (1+ (car date))) (cdr date)))))
54
55(defun dawn-sunrise ()
56 "Return the time of today's sunrise."
57 (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
58
59(defun dawn-sunset ()
60 "Return the time of today's sunset."
61 (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
62
63;;; Interface
64
65;;;###autoload
66(defun dawn-schedule (dawn-command dusk-command)
67 "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
68Requires `calendar-longitude' and `calendar-latitude' to be set;
69if they're not, it will prompt the user for them or error."
70 (when (or (null calendar-longitude)
71 (null calendar-latitude))
72 (or (solar-setup)
73 (user-error "`dawn' won't work without setting %s!"
74 (cond ((and (null calendar-longitude)
75 (null calendar-latitude))
76 "`calendar-longitude' and `calendar-latitude'")
77 ((null calendar-longitude)
78 "`calendar-longitude'")
79 ((null calendar-latitude)
80 "`calendar-latitude'")))))
81 (let ((dawn (dawn-sunrise))
82 (dusk (dawn-sunset)))
83 (cond
84 ((or (null dawn) (null dusk))
85 ;; There is no sunrise or sunset, due to how close we are to the poles.
86 ;; In this case, we must figure out whether it's day or night.
87 (pcase (caddr (solar-sunrise-sunset (calendar-current-date)))
88 ("0:00" (funcall dusk-command)) ; 0 hours of daylight
89 ("24:00" (funcall dawn-command)) ; 24 hours of daylight
90 ))
91 ((time-less-p nil dawn)
92 ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
93 ;; DAWN-COMMAND and DUSK-COMMAND for later.
94 (funcall dusk-command)
95 (run-at-time dawn nil dawn-command)
96 (run-at-time dusk nil dusk-command))
97 ((time-less-p nil dusk)
98 ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
99 ;; DUSK-COMMAND.
100 (funcall dawn-command)
101 (run-at-time dusk nil dusk-command))
102 (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
103 (funcall dusk-command)))
104 ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
105 (run-at-time (dawn-midnight) nil
106 #'dawn-schedule dawn-command dusk-command)))
107
108(provide 'dawn)
109;;; dawn.el ends here
diff --git a/lisp/def.el b/lisp/def.el deleted file mode 100644 index 0bf91b2..0000000 --- a/lisp/def.el +++ /dev/null
@@ -1,142 +0,0 @@
1;;; def.el --- defining macros -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Utility
8
9(defun def--assert-args (pred args &optional error-type &rest error-args)
10 "Assert that ARGS follows PRED.
11If it doesn't, raise an error. ERROR-TYPE will be the type of
12that error (defaults to `user-error'), and it and ERROR-ARGS are
13passed in a list to `signal'."
14 (unless (funcall pred args)
15 (funcall #'signal
16 (or error-type 'user-error)
17 (or error-args
18 (list "Wrong arguments" args)))))
19
20(defmacro o (&rest fns)
21 "Compose FNS into a new function for one argument."
22 (if (null fns)
23 `(lambda (&rest args) args)
24 `(lambda (&rest args)
25 (apply
26 #',(car fns)
27 (ensure-list (apply (o ,@(cdr fns)) args))))))
28
29;; TODO: I need to figure out where this function goes.
30(defun def--delete2 (list &rest elems)
31 "Delete each element of ELEMS, and the next item, from LIST."
32 (let ((r nil))
33 (while (consp list)
34 (if (member (car list) elems)
35 (setf list (cdr list))
36 (setf r (cons (car list) r)))
37 (setf list (cdr list)))
38 (reverse r)))
39
40;;; Keybindings
41
42(defmacro defkeys (maps &rest bindings)
43 "Define key BINDINGS in MAPS.
44If MAPS is nil or t, bind to `current-global-map'. Otherwise,
45bind each of BINDINGS to the map or list of maps provided.
46
47BINDINGS is a `setq'-style list of pairs of keys and definitions.
48The key part of each binding can be a string, in which case it's
49passed to `kbd', or a vector or anything else `define-key'
50accepts in the KEY position. The definition part, likewise, can
51be any form `define-key' accepts in that position, with this
52addition: if the form is a `defun' form, it will be defined
53before any keys are bound."
54 (declare (indent 1))
55 (def--assert-args (o cl-evenp length) bindings
56 'wrong-number-of-arguments 'defkeys 'evenp (length bindings))
57 `(progn
58 ,@(cl-loop
59 for map in (ensure-list maps)
60 for first-map-p = t then nil
61 append
62 (cl-loop
63 for (keys def) on bindings by #'cddr
64 for defp = (memq (car-safe def) '(defmap defun defmacro))
65 if (and defp first-map-p) collect def into defuns
66 append
67 (cl-loop
68 for key in (ensure-list keys)
69 collect (list 'define-key
70 (if (memq map '(t nil))
71 '(current-global-map)
72 (or (car-safe map) map))
73 (if (stringp key)
74 `(kbd ,key)
75 key)
76 (if defp
77 (cl-case (car def)
78 ((defmap) (cadr def))
79 ((defun defmacro) `#',(cadr def))
80 (otherwise (error "Bad def type: %S"
81 (car def))))
82 def)))
83 into keydefs
84 finally return
85 (let ((all (append defuns keydefs)))
86 (if-let ((after (plist-get (cdr-safe map) :after)))
87 `((eval-after ,after
88 ,@all))
89 all))))))
90
91(defmacro defmap (name docstring &rest bindings)
92 "Define a keymap named NAME, with BINDINGS."
93 (declare (indent 1) (doc-string 2))
94 `(,(if (boundp name) 'setq 'defvar) ,name
95 ;;; ^ probably a terrible hack
96 (let ((map (make-sparse-keymap)))
97 (defkeys map ,@bindings)
98 map)
99 ,@(unless (boundp name) (list docstring))))
100
101;;; Hooks
102
103(defmacro defhook (hooks &rest body)
104 "Define a function to hook into HOOKS.
105NAME and ARGS are passed to the generated `defun' form.
106Each hook in HOOKS can be the name of a hook or a list of the form
107(HOOK DEPTH LOCAL), where each argument is the same as in
108`add-hook'."
109 (declare (indent 1))
110 (let* ((name (or (plist-get body :name)
111 (intern (format "%s/h"
112 (mapconcat
113 (lambda (h)
114 (string-remove-suffix
115 "-hook" (symbol-name (or (car-safe h)
116 h))))
117 (ensure-list hooks)
118 "|")))))
119 (args (or (plist-get body :args) nil))
120 (doc (or (plist-get body :doc) nil))
121 (forms ; (DEFUN . FUNCS)
122 (cl-loop for form in (def--delete2 body :name :args :doc)
123 if (eq (car form) 'function)
124 collect form into funcs
125 else collect form into defuns
126 finally return (cons defuns funcs)))
127 (defun-forms (car forms))
128 (func-forms (cdr forms)))
129 `(progn
130 ,@(when defun-forms
131 `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms)))
132 ,@(cl-loop for hook in (ensure-list hooks)
133 for h = (or (car-safe hook) hook)
134 for ha = (cdr-safe hook)
135 if defun-forms
136 collect `(add-hook ',h #',name ,@ha)
137 append
138 (cl-loop for fn in func-forms
139 collect `(add-hook ',h ,fn ,@ha))))))
140
141(provide 'def)
142;;; def.el ends here
diff --git a/lisp/graveyard.el b/lisp/graveyard.el new file mode 100644 index 0000000..89a776d --- /dev/null +++ b/lisp/graveyard.el
@@ -0,0 +1,50 @@
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 new file mode 100644 index 0000000..d2d5e77 --- /dev/null +++ b/lisp/init-org.el
@@ -0,0 +1,144 @@
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/org-word-count.el b/lisp/org-word-count.el deleted file mode 100644 index d6d2598..0000000 --- a/lisp/org-word-count.el +++ /dev/null
@@ -1,297 +0,0 @@
1;;; org-word-count.el --- org-word-count in the modeline -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'org)
8(require 'cl-lib)
9
10(defgroup org-word-count nil
11 "Extra fast word-counting in `org-mode'."
12 :group 'org)
13
14(defvar-local org-word-count-word-count nil
15 "Running total of words in this buffer.")
16
17(defvar-local org-word-count-string nil
18 "String for the modeline.")
19
20(defcustom org-word-count-format "%sw "
21 "Format for org word count in modeline."
22 :type 'string)
23
24(defcustom org-word-count-huge-string "huge"
25 "String to display with a huge buffer."
26 :type 'string)
27
28(defcustom org-word-count-update-after-funcs '(org-narrow-to-subtree
29 org-narrow-to-block
30 org-narrow-to-element
31 org-capture-narrow)
32 "Functions after which to update the word count."
33 :type '(repeat function))
34
35(defcustom org-word-count-deletion-idle-timer 0.25
36 "Length of time, in seconds, to wait before updating word-count."
37 :type 'number)
38
39(defcustom org-word-count-huge-change 5000
40 "Number of characters that constitute a \"huge\" insertion."
41 :type 'number)
42
43(defcustom org-word-count-huge-buffer 10000
44 "Number of words past which we're not going to try to count."
45 :type 'number)
46
47(defvar org-word-count-correction -5
48 "Number to add to `org-word-count-word-count', for some reason?
49`org-word-count-word-count' seems to consistently be off by 5. Thus
50this correction. (At some point I should correct the underlying
51code... probably).")
52
53(defvar-local org-word-count-update-timer nil)
54
55;;; Variables from org-wc
56
57(defun org-word-count-list-of-strings-p (arg)
58 (cl-every #'stringp arg))
59
60(defun org-word-count--downcase-list-of-strings-set-default (var val)
61 (set-default var (mapcar #'downcase val)))
62
63(defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE")
64 "List of tags for which subtrees will be ignored in word counts"
65 :type '(repeat string)
66 :safe #'org-word-count-list-of-strings-p)
67
68(defcustom org-word-count-ignore-commented-trees t
69 "Ignore trees with COMMENT-prefix if non-nil."
70 :type 'boolean
71 :safe #'booleanp)
72
73(defcustom org-word-count-default-link-count 'description-or-path
74 "Default way of counting words in links.
75This is applied to any link type not specified in any of
76‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or
77‘org-word-count-only-description-link-types’ "
78 :type '(choice
79 (const :tag "Count words in description or else path part of links" description-or-path)
80 (const :tag "Count words only in description part of links" description)
81 (const :tag "Count links as 0 words" ignore)
82 (const :tag "Count links as 1 word" oneword)
83 (const :tag "Count words only in path part of links" path))
84 :safe 'symbolp)
85
86(defcustom org-word-count-ignored-link-types nil
87 "Link types which won't be counted as a word"
88 :type '(repeat string)
89 :safe #'org-word-count-list-of-strings-p)
90
91(defcustom org-word-count-one-word-link-types '("zotero")
92 "Link types which will be counted as one word"
93 :type '(repeat string)
94 :safe #'org-word-count-list-of-strings-p)
95
96(defcustom org-word-count-description-or-path-link-types '()
97 "Link types for which the description or the path should be counted"
98 :type '(repeat string)
99 :safe #'org-word-count-list-of-strings-p)
100
101(defcustom org-word-count-only-description-link-types '("note")
102 "Link types for which only the description should be counted"
103 :type '(repeat string)
104 :safe #'org-word-count-list-of-strings-p)
105
106(defcustom org-word-count-only-path-link-types '()
107 "Link types for which only the path should be counted"
108 :type '(repeat string)
109 :safe #'org-word-count-list-of-strings-p)
110
111(defcustom org-word-count-blocks-to-count '("quote" "verse")
112 "List of blocks which should be included in word count.
113
114Use lower case block names"
115 :type '(repeat string)
116 :safe #'org-word-count-list-of-strings-p
117 :set #'org-word-count--downcase-list-of-strings-set-default)
118
119(defun org-word-count-delayed-update (&rest _)
120 (if org-word-count-update-timer
121 (setq org-word-count-update-timer nil)
122 (setq org-word-count-update-timer
123 (run-with-idle-timer org-word-count-deletion-idle-timer nil
124 #'org-word-count-update))))
125
126(defun org-word-count-force-update ()
127 (interactive)
128 (message "Counting words...")
129 (when (timerp org-word-count-update-timer)
130 (cancel-timer org-word-count-update-timer))
131 (org-word-count-update)
132 (message "Counting words...done"))
133
134(defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice
135 (dlet ((org-word-count-counting t))
136 (org-word-count-buffer)
137 (org-word-count-modeline)
138 (setq org-word-count-update-timer nil)))
139
140(defun org-word-count-changed (start end length)
141 (org-word-count-delayed-update))
142
143(defun org-word-count-buffer ()
144 "Count the words in the buffer."
145 (when (and (derived-mode-p 'org-mode)
146 (not (eq org-word-count-word-count 'huge)))
147 (setq org-word-count-word-count
148 (cond
149 ((> (count-words (point-min) (point-max))
150 org-word-count-huge-buffer)
151 'huge)
152 (t (org-word-count-aux (point-min) (point-max)))))))
153
154;;; From org-wc.el:
155;; https://github.com/tesujimath/org-wc/
156(defun org-word-count-aux (beg end)
157 "Return the number of words between BEG and END."
158 (let ((wc 0)
159 subtreecount
160 (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
161 (save-excursion
162 (goto-char beg)
163 ;; Handle the case where we start in a drawer
164 (when (org-at-drawer-p)
165 (org-end-of-meta-data t))
166 (while (< (point) end)
167 (cond
168 ;; Handle headlines and subtrees
169 ((org-at-heading-p)
170 (cond
171 ;; Ignore commented and org-wc-ignored-tags trees
172 ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p))
173 (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=))
174 (org-end-of-subtree t t))
175 ;; Re-use count for subtrees already counted
176 ((setq subtreecount (get-text-property (point) :org-wc))
177 (cl-incf wc subtreecount)
178 (org-end-of-subtree t t))
179 ;; Skip counting words in headline
180 (t (org-word-count--goto-char (point-at-eol) end))))
181 ;; Ignore most blocks.
182 ((when (save-excursion
183 (beginning-of-line 1)
184 (looking-at org-block-regexp))
185 (if (member (downcase (match-string 1)) org-word-count-blocks-to-count)
186 (progn ;; go inside block and subtract count of end line
187 (org-word-count--goto-char (match-beginning 4) end)
188 (cl-decf wc))
189 (org-word-count--goto-char (match-end 0) end))))
190 ;; Ignore comments.
191 ((org-at-comment-p)
192 (org-word-count--goto-char (point-at-eol) end))
193 ;; Ignore drawers.
194 ((org-at-drawer-p)
195 (org-end-of-meta-data t))
196 ;; Ignore all other #+ lines
197 ((looking-at "#+")
198 (org-word-count--goto-char (point-at-eol) end))
199 ;; Handle links
200 ((save-excursion
201 (when (< (1+ (point-min)) (point)) (backward-char 2))
202 (looking-at org-link-bracket-re))
203 (let* ((type (car (save-match-data (split-string (match-string 1) ":"))))
204 (pathstart (+ 1 (length type) (match-beginning 1))))
205 (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore)
206 ((member type org-word-count-one-word-link-types) 'oneword)
207 ((member type org-word-count-only-description-link-types)
208 'description)
209 ((member type org-word-count-only-path-link-types) 'path)
210 ((member type org-word-count-description-or-path-link-types)
211 'description-or-path)
212 (t org-word-count-default-link-count))
213 (ignore (org-word-count--goto-char (match-end 0) end))
214 (oneword (org-word-count--goto-char (match-end 0) end)
215 (cl-incf wc))
216 (description (if (match-beginning 2)
217 (goto-char (match-beginning 2))
218 (org-word-count--goto-char
219 (match-end 0) end)))
220 (path (cl-incf wc (count-words-region pathstart
221 (match-end 1)))
222 (org-word-count--goto-char (match-end 0) end))
223 (description-or-path
224 (if (match-beginning 2)
225 (goto-char (match-beginning 2))
226 (cl-incf wc (count-words-region pathstart
227 (match-end 1)))
228 (org-word-count--goto-char (match-end 0) end)))
229 (t (user-error "Error in org-word-count link configuration")))))
230 ;; Count latex macros as 1 word, ignoring their arguments.
231 ((save-excursion
232 (when (< (point-min) (point)) (backward-char))
233 (looking-at latex-macro-regexp))
234 (org-word-count--goto-char (match-end 0) end)
235 (cl-incf wc))
236 (t
237 (and (re-search-forward "\\w+\\W*" end 'skip)
238 (cl-incf wc))))))
239 wc))
240
241(defun org-word-count--goto-char (char end)
242 "Moves point to CHAR and from there passes 0+ non-word characters.
243Searchers to end as a maximum.
244
245This ensures that we are in an expected state (at the first word
246character after some non-word characters) after moving beyond
247headlines, links etc."
248 (goto-char char)
249 (re-search-forward "\\W*" end 'skip))
250
251(defvar org-word-count-counting nil
252 "Are we currently counting?")
253
254(defun org-word-count-recount-widen (&rest _)
255 (when (and (not org-word-count-counting))
256 (org-word-count-update)))
257
258(defun org-word-count-modeline ()
259 (setq org-word-count-string
260 (cond
261 ((eq org-word-count-word-count 'huge)
262 org-word-count-huge-string)
263 (org-word-count-word-count
264 (format org-word-count-format
265 (max 0 (+ org-word-count-word-count
266 org-word-count-correction))))))
267 (force-mode-line-update))
268
269(define-minor-mode org-word-count-mode
270 "Count words in `org-mode' buffers in the mode-line."
271 :lighter ""
272 :keymap (let ((map (make-sparse-keymap)))
273 (define-key map (kbd "C-c C-.") #'org-word-count-force-update)
274 map)
275 (cond (org-word-count-mode
276 (org-word-count-buffer)
277 (add-hook 'after-change-functions
278 #'org-word-count-delayed-update nil t)
279 (unless (member '(org-word-count-mode org-word-count-string)
280 mode-line-misc-info)
281 (add-to-list 'mode-line-misc-info
282 '(org-word-count-mode org-word-count-string)
283 nil
284 #'equal))
285 (dolist (fn org-word-count-update-after-funcs)
286 (advice-add fn :after #'org-word-count-update)))
287 (:else
288 (remove-hook 'after-change-functions
289 #'org-word-count-delayed-update t)
290 (setf mode-line-misc-info
291 (delete '(org-word-count-mode org-word-count-string)
292 mode-line-misc-info))
293 (dolist (fn org-word-count-update-after-funcs)
294 (advice-remove fn #'org-word-count-update)))))
295
296(provide 'org-word-count)
297;;; org-word-count.el ends here
diff --git a/lisp/pita.el b/lisp/pita.el deleted file mode 100644 index ed67c92..0000000 --- a/lisp/pita.el +++ /dev/null
@@ -1,69 +0,0 @@
1;;; pita.el --- wrappers making emacs less of a PITA -*- lexical-binding: t -*-
2;; 🥙
3
4;;; utils
5
6(defun walk-tree-replace (tree find replace)
7 (let ((r nil))
8 (dolist (form tree)
9 (push (cond ((eq find form) replace)
10 ((listp form)
11 (walk-tree-replace form find replace))
12 (t form))
13 r))
14 (reverse r)))
15
16;;; crux advices
17;; these should all go :before the function they're advising.
18
19(defun with-region-or-buffer (&rest _)
20 (interactive (if mark-active
21 (list (region-beginning) (region-end))
22 (list (point-min) (point-max)))))
23
24(defun with-region-or-line (&rest _)
25 (interactive (if mark-active
26 (list (region-beginning) (region-end))
27 (list (line-beginning-position) (line-end-position)))))
28
29(defun with-region-or-to-eol (&rest _)
30 (interactive (if mark-active
31 (list (region-beginning) (region-end))
32 (list (point) (line-end-position)))))
33
34;;; wrappers
35
36(defmacro with-message (msg &rest body)
37 (declare (indent 1))
38 (when (listp msg)
39 (setq msg (apply #'format (car msg) (cdr msg))))
40 (when (string-match "[[:alnum:]]\\'" msg)
41 (setq msg (concat msg "...")))
42 (let ((m (gensym))
43 (r (gensym)))
44 `(let ((,m ,msg)
45 (,r nil))
46 (condition-case e
47 (setq r (progn (message ,m) ,@body))
48 (:success (message "%s done" ,m) r)
49 (t (signal (car e) (cdr e)))))))
50
51(defmacro with-pr (msg &rest body)
52 (declare (indent 1))
53 (when (listp msg)
54 (setq msg (apply #'format (car msg) (cdr msg))))
55 (when (string-match "[[:alnum:]]\\'" msg)
56 (setq msg (concat msg "...")))
57 (let ((pr (gensym))
58 (m (gensym)))
59 `(let* ((,m ,msg)
60 (,pr (unless (minibufferp)
61 (make-progress-reporter ,m))))
62 ,@(or (and pr (walk-tree-replace body '@ `(progress-reporter-update ,pr)))
63 body)
64 (and ,pr (progress-reporter-done ,pr)))))
65
66;;; wrapper advice
67
68(provide 'pita)
69;;; pita.el ends here
diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null
@@ -1,23 +0,0 @@
1;;; private.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'acdw)
8
9(defgroup private nil
10 "Private things are private. Shhhhh....")
11
12;; Private directory
13
14(+define-dir private/ (sync/ "emacs/private")
15 "Private secretive secrets inside.")
16(add-to-list 'load-path private/)
17
18;; Load random private stuff
19
20(require '_acdw)
21
22(provide 'private)
23;;; private.el ends here
diff --git a/lisp/scule.el b/lisp/scule.el deleted file mode 100644 index 3ed58bb..0000000 --- a/lisp/scule.el +++ /dev/null
@@ -1,61 +0,0 @@
1;;; scule.el --- -scule twiddling -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2022 Case Duckworth
4
5;; Author: Case Duckworth <case@bob>
6;; Keywords: convenience
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;; DWIM functions for twiddling "scule", or text case (a fancy word for "upper
24;; case" is "magiscule", for example, and "lower case" is "miniscule").
25
26;;; Code:
27
28(require 'thingatpt)
29
30;;; Utility macro
31;;;###autoload
32(defmacro defscule (name &optional region-fn word-fn)
33 (let ((fn-name (intern (format "scule-%s" name)))
34 (region-fn (or region-fn (intern (format "%s-region" name))))
35 (word-fn (or word-fn (intern (format "%s-word" name)))))
36 `(defun ,fn-name (arg)
37 ,(concat (capitalize (symbol-name name)) " words in the region if active, or word at point.\n"
38 "If the region is active, call `" (symbol-name region-fn) "'.\n"
39 "Otherwise, it calls `" (symbol-name word-fn) "' on the word at point and\n"
40 "the following ARG - 1 words.")
41 (interactive "*p")
42 (if (use-region-p)
43 (,region-fn (region-beginning) (region-end) (region-noncontiguous-p))
44 (let ((word-bound (save-excursion
45 (skip-chars-forward "^[:word:]")
46 (bounds-of-thing-at-point 'word))))
47 (when (and (car word-bound) (cdr word-bound))
48 (,region-fn (car word-bound) (cdr word-bound))
49 (goto-char (cdr word-bound))
50 (,word-fn (1- arg))))))))
51
52;;;###autoload
53(progn (defscule upcase)
54 (autoload 'scule-upcase "scule" nil t)
55 (defscule downcase)
56 (autoload 'scule-downcase "scule" nil t)
57 (defscule capitalize)
58 (autoload 'scule-capitalize "scule" nil t))
59
60(provide 'scule)
61;;; scule.el ends here
diff --git a/lisp/upload-junk.el b/lisp/upload-junk.el new file mode 100644 index 0000000..5a9da84 --- /dev/null +++ b/lisp/upload-junk.el
@@ -0,0 +1,47 @@
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 index 8ca94fd..ec84f56 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -1,271 +1,360 @@
1;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*- 1;;; yoke.el --- Yoke configuration into your config -*- lexical-binding: t; -*-
2;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net> 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/>.
3 23
4;;; Commentary: 24;;; Commentary:
5 25
6;; What's the most basic functionality of a package manager? In my view, all a 26;; THIS IS A WORK IN PROGRESS. DON'T USE IT.
7;; package manager should do is fetch packages from wherever they are, and
8;; provide the system with a method of accessing those packages' functionality.
9;; In Emacs, this means downloading packages from the Internet and adding their
10;; directories to `load-path'. That's what `yoke' tries to do.
11;;
12;; In fact, that's /all/ `yoke' tries to do, on the package front. It doesn't
13;; automatically fetch dependencies. It doesnt' do much else of anything
14;; --- hell, it doesn't have to generate autoloads or build the dang source
15;; files if you don't want it to. /I/ have it do those things because I like a
16;; few creature comforts, but you can turn 'em off.
17;;
18;; Instead of focusing too much on installing packages, `yoke' works harder to
19;; group---to "yoke together," if you will---related configurations together, à
20;; la `use-package' or `setup'. I used both of those packages before and found
21;; each somewhat lacking, and what I really wanted was a fancy `progn' that I
22;; could put whatever I want inside. So that's basically what `yoke' is. It's
23;; a configuration macro that automatically fetches packages from their repos
24;; and tells Emacs where they are, then executes its body in a `cl-block' for
25;; ... reasons. That's it.
26 27
27;;; Code: 28;;; Code:
28 29
29(require 'cl-lib) 30(require 'cl-lib)
31(require 'package-vc)
30 32
31;;; Customization options 33;;; User options
32 34
33(defgroup yoke nil 35(defgroup yoke nil
34 "Customizations for `yoke'." 36 "Customizations for `yoke'."
35 :group 'applications 37 :group 'convenience
36 :prefix "yoke-") 38 :prefix "yoke-")
37 39
38(defcustom yoke-dir (locate-user-emacs-file "yoke") 40(defcustom yoke-directory package-user-dir
39 "Where to put yoked packages." 41 "Where to put yoked packages."
40 :type 'file) 42 :type 'file)
41 43
42(defcustom yoke-get-default-fn #'yoke-get-git 44(defcustom yoke-cache-directory (locate-user-emacs-file "yoke-cache"
43 "Default function to get packages with." 45 "~/.yoke-cache")
44 :type 'function) 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.
51If 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.
68PACKAGE is either a symbol, in which case `yoke' expands to
69basically a named `progn' (good for grouping configuration), or a
70list of the form (NAME . ARGS), where ARGS can be one of the
71following:
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.
45 88
46(defvar yoke-buffer "*yoke*" 89 Other pairs may be valid for a given backend; see that
47 "Buffer to use for yoke process output.") 90 backend's `yoke-install' function for more details.
48 91
49(defvar yoke-dirs nil 92BODY is executed in a `condition-case' so that errors won't keep
50 "List of directories managed by `yoke'.") 93the rest of Emacs from initializing. BODY can also be prepended
94by the following keyword arguments:
51 95
52;;; GET YOKED 96 `:after' (FEATURE...)
53 97
54(defmacro yoke (package 98 `:require' (FEATURE...)
55 &rest body)
56 "Yoke PACKAGE to work with your Emacs.
57Execute BODY afterward.
58 99
59\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)" 100 `:depends' (PACKAGE-SPEC...)
101
102 `:build' (ACTION...)
103
104 `:unless' (PREDICATE)
105
106 `:when' (PREDICATE)
107
108Other keywords are ignored.
109
110\(fn (PACKAGE [SPEC]) [BODY-ARGS] BODY...)"
60 (declare (indent 1)) 111 (declare (indent 1))
61 (let* (;; State 112 (let* ((name (or (car-safe package) package))
62 (pkg (cond ((consp package) (car package)) 113 (backend (yoke--pget package :backend))
63 (:else package))) 114 ;; Body keyword arguments
64 (url (cond ((consp package) (cdr package))
65 (:else nil)))
66 (pname (intern (format "yoke:%s" pkg)))
67 (dirvar '$yoke-dir)
68 ;; Keyword args --- TODO: Naming could probably be better.
69 (after (plist-get body :after)) 115 (after (plist-get body :after))
70 (depends (plist-get body :depends)) 116 (depends (plist-get body :depends))
117 (req (plist-get body :require))
118 (buildp (plist-member body :build))
119 (build (plist-get body :build))
71 (whenp (plist-member body :when)) 120 (whenp (plist-member body :when))
121 (when (if whenp (plist-get body :when) t))
72 (unlessp (plist-member body :unless)) 122 (unlessp (plist-member body :unless))
73 (when (cond (whenp (plist-get body :when)) 123 (unless (if unlessp (plist-get body :unless) nil))
74 (:else t)))
75 (unless (cond (unlessp (plist-get body :unless))
76 (:else nil)))
77 (autoload (cond ((plist-member body :autoload)
78 (plist-get body :autoload))
79 (:else t)))
80 (pre (plist-get body :pre))
81 ;; Body 124 ;; Body
82 (body (cl-loop for (this next) on body by #'cddr 125 (body (let ((b body) r)
83 unless (keywordp this) 126 (while (consp b)
84 append (list this next) into ret 127 (if (keywordp (car b))
85 finally return (cond ((eq (car (last ret)) nil) 128 (setf b (cdr b))
86 (butlast ret)) 129 (setf r (cons (car b) r)))
87 (:else ret)))) 130 (setf b (cdr b)))
88 (r (gensym))) 131 (reverse r)))
89 `(let ((,r (cl-block ,pname 132 (esym (make-symbol "yoke-error")))
90(condition-case err 133 ;; Body modifiers. These are applied in reverse order (that is, the last
91 (progn 134 ;; one will be on the outside).
92 ;; Pass `:when' or `:unless' clauses 135 ;; --- Require the current package
93 ,@(cond 136 (when req
94 ((and whenp unlessp) 137 (setf body
95 `((when (or (not ,when) ,unless) 138 (append (let (reqs)
96 (cl-return-from ,pname 139 (dolist (r (ensure-list req) reqs)
97 (format "%s (abort) :when %S :unless %S" 140 (let* ((feat (if (eq r t) name r))
98 ',pname ',when ',unless))))) 141 (+feat (intern (format "+%s" feat))))
99 (whenp 142 (push `(require ',feat) reqs)
100 `((unless ,when (cl-return-from ,pname 143 (push `(require ',+feat nil :noerror) reqs)))
101 (format "%s (abort) :when %S" 144 (reverse reqs))
102 ',pname ',when))))) 145 body)))
103 (unlessp 146 ;; --- Install the package
104 `((when ,unless (cl-return-from ,pname 147 (when (consp package)
105 (format "%s (abort) :unless %S" 148 (push `(yoke-install ',(car package) ,@(cdr package))
106 ',pname ',unless)))))) 149 body))
107 ;; Evaluate `:pre' forms 150 ;; --- Dependencies
108 ,@pre 151 (when depends
109 ;; Get prerequisite packages 152 (setf body
110 ,@(cl-loop 153 (append (cl-loop for dep in (ensure-list depends)
111 for (pkg* . yoke-get-args) in depends 154 collect `(or (yoke-install ',@(ensure-list dep))
112 collect `(or 155 (error "Dependency (%s): %S"
113 (let* ((pkg-spec (yoke-get ,@yoke-get-args 156 ',dep ',package)))
114 :dir ,(format "%s" pkg*))) 157 body)))
115 (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) 158 ;; --- Load after
116 "") 159 (when after
117 (car pkg-spec)))) 160 (setf body `((yoke--eval-after ,(cl-subst name t after) ,@body))))
118 (and dir 161 ;; --- Conditional expansion
119 ,@(if autoload 162 (when (or whenp unlessp)
120 `((yoke-generate-autoloads ',pkg* dir)) 163 (setf body
121 '(t)) 164 (append (cond
122 (add-to-list 'yoke-dirs dir nil #'string=))) 165 ((and whenp unlessp)
123 (cl-return-from ,pname 166 `((when (or (not ,when) ,unless)
124 (format "Error fetching prerequiste: %s" 167 (signal 'yoke-predicate
125 ',pkg*)))) 168 '(:when ,when :unless ,unless)))))
126 ;; Download the package, generate autoloads 169 (whenp
127 ,@(when url 170 `((unless ,when (signal 'yoke-predicate
128 `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) 171 '(:when ,when)))))
129 (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) 172 (unlessp
130 "") 173 `((when ,unless (signal 'yoke-predicate
131 (car pkg-spec)))) 174 '(:unless ,unless))))))
132 ,@(when autoload 175 body)))
133 `((yoke-generate-autoloads ',pkg ,dirvar))) 176 ;; Expansion
134 (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) 177 `(condition-case ,esym
135 ;; Evaluate the body, optionally after the features in `:after' 178 (cl-letf (((symbol-function 'package--save-selected-packages)
136 ,@(cond (after 179 #'ignore))
137 `((yoke-eval-after ,after ,@body))) 180 ;; Body
138 (:else body))) 181 ,@body)
139 (:success ',package) 182 (:success
140 (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) 183 ,(unless (atom package)
141 nil))))) 184 `(setf (alist-get ',name yoke-selected-packages)
142 (when (stringp ,r) (message "%S" ,r)) 185 (list ,@(cdr-safe package))))
143 ,r))) 186 ',package)
144 187 (t ,(if yoke-debug-on-error
145(defun yoke-get (url &rest args) 188 `(signal (car ,esym) (cdr ,esym))
146 "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. 189 `(message "(yoke) %s: %s" (car ,esym) (cdr ,esym)))))))
147URL can be a string or a list of the form (TYPE URL). The 190
148download will be dispatched to the TYPE, or to 191;;; Installing packages
149`yoke-get-default-fn' if only a string is given. 192
150ARGS is a plist with the following possible keys: 193(defun yoke-install (name &rest args)
151 194 "Install package NAME, with ARGS."
152:dir DIRECTORY --- the directory to put the URL. 195 (let ((custom-file null-device)
153:load DIRECTORY --- the directory (relative to the download path) 196 (inhibit-message (and (not (plist-member args :update))
154 to add to `load-path'. 197 (not debug-on-error)))
155:type TYPE --- one of `http', `git', or `file' --- how to 198 (messages-buffer-name yoke-message-buffer))
156 download URL." 199 (funcall
157 (let* ((dir (plist-get args :dir)) 200 (intern
158 (load (plist-get args :load)) 201 (format "yoke-install-%s"
159 (type (or (plist-get args :type))) 202 (or (plist-get args :backend)
160 (path (cond 203 (yoke--guess-backend (plist-get args :url))
161 ((eq type 'http) (yoke-get-http url dir)) 204 'package)))
162 ((or (eq type 'git) 205 name args))
163 (string-match-p (rx bos "git:") url)) 206 (yoke--clean-load-path)
164 (yoke-get-git url dir)) 207 ;; Don't return nil
165 ((or (eq type 'file) 208 t)
166 (string-match-p (rx bos (or "file:" "~" "/")) url)) 209
167 (yoke-get-file url dir)) 210(defun yoke-install-package (name args &optional tries)
168 ((stringp url) 211 "Install package NAME with ARGS using `package' machinery.
169 (funcall yoke-get-default-fn url dir)) 212TRIES is an internal variable."
170 (:else (error "Uknown URL type: %S" url))))) 213 (let ((package-user-dir yoke-directory)
171 (cond 214 (url (plist-get args :url))
172 ((file-exists-p path) 215 (update (plist-get args :update))
173 (add-to-list 'load-path (expand-file-name (or load "") path)) 216 (dirname (expand-file-name (format "%s" name)
174 (cons path args)) 217 yoke-directory))
175 (:else (error "Directory \"%s\" doesn't exist." path) 218 (tries (or tries 0))
176 nil)))) 219 load-dir autoloads-file-name)
177 220 (unless (file-exists-p dirname)
178(defun yoke-get--guess-directory (path &optional dir) 221 (setq dirname (or (car-safe (file-expand-wildcards
179 "Guess directory from PATH and DIR, and return it. 222 (concat dirname "*")))
180If DIR is present and relative, resolve it relative to 223 dirname)))
181`yoke-dir', or if it's absolute, leave it as-is. If DIR is 224 (setq load-dir
182absent, return the final component of PATH resolved relative to 225 (expand-file-name (or (plist-get args :lisp-dir) "") dirname)
183`yoke-dir'." 226 generated-autoload-file
184 (expand-file-name (or dir (file-name-nondirectory path)) 227 (expand-file-name (format "%s-autoloads.el" name) load-dir))
185 yoke-dir)) 228 (prog1
186 229 (condition-case error
187(defun yoke-get-http (url &optional dir) 230 (cond
188 "Download URL to DIR and return its directory. 231 ;; -- Commented on 2022-12-21
189If DIR isn't given, it's guessed from the final component of the 232 ;; ((and (file-exists-p dirname)
190URL's path and placed under `yoke-dir'." 233 ;; (not update))
191 (let* ((dir (yoke-get--guess-directory url dir)) 234 ;; (add-to-list 'load-path
192 (basename (file-name-nondirectory url)) 235 ;; (expand-file-name
193 ;; XXX: Is this the best idea?? PROBABLY NOT!!! Ideally I'd have 236 ;; (or (plist-get args :lisp-dir) "")
194 ;; a parameter (either dynamic var or passed in) that would give the 237 ;; dirname)
195 ;; name of the downloaded file. But that would take a bit of 238 ;; nil #'equal)
196 ;; re-engineering, I think. So for now, it stays thus. 239 ;; (require (intern (format "%s-autoloads" name))))
197 (filename (expand-file-name 240 ((and url update)
198 (replace-regexp-in-string 241 (package-vc-update (cadr (assoc name package-alist))))
199 (rx "-" (+ digit) ; major version 242 (update
200 (+ (group "." (+ digit))) ; following version numbers 243 (package-update name))
201 (group "." (+ (not space)))) ; extension 244 (url
202 "\\2" 245 ;; I'm going to be honest here, this is extremely cursed. But I
203 basename) 246 ;; don't want to get asked about installing the packages, and when
204 dir))) 247 ;; the user answers 'no', the function errors. So.. this.
205 (cond ((file-exists-p filename) 248 (cl-letf (((symbol-function 'yes-or-no-p) #'ignore))
206 dir) 249 (ignore-errors (package-vc-install (cons name args)))))
207 (:else 250 (:else
208 (message "Downloading %s..." url) 251 (package-install name)))
209 (with-current-buffer (let ((url-debug t)) 252 (file-error (if (> tries 1)
210 (url-retrieve-synchronously url)) 253 (error "(yoke) Can't install `%s'" name)
211 (condition-case e 254 (package-refresh-contents)
212 (progn 255 (yoke-install-package name args (1+ tries)))))
213 (goto-char (point-min)) 256 (add-to-list 'load-path load-dir nil #'equal)
214 (delete-region (point) (+ 1 (re-search-forward "^$"))) 257 (loaddefs-generate load-dir generated-autoload-file)
215 (make-directory dir :parents) 258 ;; Do it again, if it doesn't actually /generate/ anything
216 (write-file filename 1) 259 (when (eq 'provide
217 (message "Downloading %s... Done" url)) 260 (with-current-buffer (find-file-noselect generated-autoload-file)
218 (:success dir) 261 (read (buffer-substring (point-min) (point-max)))))
219 (t (signal (car e) (cdr e))))))))) 262 (loaddefs-generate load-dir generated-autoload-file nil nil nil
220 263 :generate-full))
221(defun yoke-get-git (repo &optional dir) 264 (load generated-autoload-file :noerror)
222 "Clone REPO to DIR and return its directory. 265 (kill-buffer (get-file-buffer generated-autoload-file))
223If DIR isn't given, it's guessed from the repo's name and put 266 (package-activate name))))
224under `yoke-dir'. Return the cloned directory's name on success, 267
225or nil on failure." 268(defun yoke-install-http (name args)
226 (let ((dir (yoke-get--guess-directory repo dir))) 269 "Install a package NAME using ARGS from an http source."
227 (cond ((file-exists-p dir) 270 (let* ((url (plist-get args :url))
228 dir) 271 (cached (expand-file-name (file-name-nondirectory url)
229 (:else 272 yoke-cache-directory))
230 (message "Cloning %s..." repo) 273 (update (plist-get args :update)))
231 (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil 274 (unless url
232 "clone" repo dir) 275 (error "No URL for HTTP download: %S" (cons name args)))
233 (0 (message "Cloning %s... Done" repo) 276 (when (or (not (file-exists-p cached))
234 dir) 277 update)
235 (_ (message "Cloning %s... Error! See buffer %s for output." 278 (make-directory yoke-cache-directory :parents)
236 repo yoke-buffer) 279 (message "Downloading `%s'..." url)
237 nil)))))) 280 (let* ((url-debug t)
238 281 (buf (url-retrieve-synchronously url)))
239(defun yoke-get-file (file &optional _dir) 282 (with-current-buffer buf
240 "Add FILE's directory to `load-dir'. 283 (goto-char (point-min))
241_DIR is ignored." 284 (delete-region (point) (1+ (re-search-forward "^$")))
242 (file-name-directory file)) 285 (write-file cached 1)
243 286 (message "Downloading `%s'...Done." url))))
244(defun yoke-generate-autoloads (package dir) 287 (package-install-file cached)))
245 "Generate autoloads for PACKAGE in DIR." 288
246 ;; Shamelessly stolen from `straight'. 289(defun yoke-install-file (name args)
247 (eval-and-compile (require 'autoload)) 290 "Install package NAME using ARGS from a file on-disk."
248 (let ((generated-autoload-file 291 (let ((url (plist-get args :url))
249 (expand-file-name (format "%s-autoloads.el" package) dir)) 292 (update (plist-get args :update))
250 (backup-inhibited t) 293 (dirname (expand-file-name (format "%s" name) yoke-directory)))
251 (version-control 'never) 294 (if (file-exists-p url)
252 (message-log-max nil) 295 ;; This takes care of updating too.
253 (inhibit-message t)) 296 (package-install-file url)
254 (unless (file-exists-p generated-autoload-file) 297 (error "(yoke) No such file: `%s'" url))))
255 (let ((find-file-hook nil) 298
256 (write-file-functions nil) 299;;; Other package transactions
257 (debug-on-error nil) 300
258 (left-margin 0)) 301(defun yoke--choose-package ()
259 (if (fboundp 'make-directory-autoloads) 302 "Choose a package from `yoke-selected-packages'."
260 (make-directory-autoloads dir generated-autoload-file) 303 (assoc (intern (completing-read "Package: " yoke-selected-packages))
261 (and (fboundp 'update-directory-autoloads) 304 yoke-selected-packages))
262 (update-directory-autoloads dir))))) 305
263 (when-let ((buf (find-buffer-visiting generated-autoload-file))) 306(defun yoke-update (name &rest args)
264 (kill-buffer buf)) 307 (interactive (yoke--choose-package))
265 (load generated-autoload-file :noerror :nomessage) 308 (save-window-excursion
266 t)) 309 (apply #'yoke-install name (append '(:update t)
267 310 args))))
268;;; Evaluating forms after features 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.
335If 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.
344If 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)))
269 358
270(defun yoke--eval-after-init (fn) 359(defun yoke--eval-after-init (fn)
271 "Evaluate FN after inititation, or now if Emacs is initialized. 360 "Evaluate FN after inititation, or now if Emacs is initialized.
@@ -274,79 +363,30 @@ FN is called with no arguments."
274 (funcall fn) 363 (funcall fn)
275 (add-hook 'after-init-hook fn))) 364 (add-hook 'after-init-hook fn)))
276 365
277(defmacro yoke-eval-after (features &rest body) 366(defmacro yoke--eval-after (prereqs &rest body)
278 "Evaluate BODY, but only after loading FEATURES. 367 "Evaluate body after PREREQS.
279FEATURES can be an atom or a list; as an atom it works like 368PREREQS can be a feature, a number, `:init', or a list of those.
280`with-eval-after-load'. The special feature `init' will evaluate
281BODY after Emacs is finished initializing."
282 (declare (indent 1)
283 (debug (form def-body)))
284 (unless (listp features)
285 (setf features (list features)))
286 (if (null features)
287 (macroexp-progn body)
288 (let* ((this (car features))
289 (rest (cdr features)))
290 (cond ((eq this 'init)
291 `(yoke--eval-after-init
292 (lambda () (yoke-eval-after ,rest ,@body))))
293 (:else
294 `(with-eval-after-load ',this
295 (yoke-eval-after ,rest ,@body)))))))
296 369
297;;; Integration 370Features are used as arguments to `eval-after-load'. Numbers are
371used as arguments to `run-with-idle-timer'. `:init' will ensure BODY
372runs after Emacs's init time.
298 373
299(defun yoke-imenu-insinuate () 374When given a list of PREREQS, `eval-after' will nest each one
300 "Insinuate `yoke' forms for `imenu'." 375from left to right."
301 (require 'imenu) 376 (declare (indent 1) (debug (form def-body)))
302 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) 377 (setf prereqs (ensure-list prereqs))
303 (list (rx (: "(yoke" (+ space) (? "(") 378 (if (null prereqs)
304 (group (+ (not (or "(" " " "\t" "\n")))) 379 (macroexp-progn body)
305 (* any))) 380 (let* ((this (car prereqs))
306 1))) 381 (form `((lambda () (yoke--eval-after ,(cdr prereqs) ,@body)))))
307 382 (cond
308;;; Package maintenance 383 ((eq this :init)
309 384 (append '(yoke--eval-after-init) form))
310(defvar yoke--all "*all*" 385 ((numberp this)
311 "Value that `yoke--prompt-for-package' uses for all packages.") 386 (append `(run-with-idle-timer ,this nil) form))
312 387 ((symbolp this)
313(defun yoke--choose-packages (prompt &optional onep) 388 (append `(eval-after-load ',this) form))
314 "Choose from all of yoke's installed packages." 389 (:else (user-error "Eval-after: Bad prereq: %S" this))))))
315 (funcall (if onep #'completing-read #'completing-read-multiple)
316 prompt
317 (cons yoke--all yoke-dirs)
318 nil :require-match nil nil
319 (unless onep yoke--all)))
320
321(defun yoke--choices (&optional selections)
322 "Either the SELECTIONS given, or all of `yoke-dirs'.
323If `yoke--all' is part of SELECTIONS, or if it's not given,
324return the full list of `yoke-dirs'."
325 (cond ((or (null selections)
326 (member yoke--all selections))
327 yoke-dirs)
328 (:else selections)))
329
330(defun yoke-compile (&rest packages)
331 "Compile all elisp files in `yoke-dirs'."
332 (interactive (yoke--choose-packages "Compile packages: "))
333 (dolist (dir (yoke--choices packages))
334 (byte-recompile-directory dir 0)))
335
336(defun yoke-update-autoloads (&rest packages)
337 "Update the autoloads in PACKAGES' directories."
338 (interactive (yoke--choose-packages "Generate autoloads for packages: "))
339 (dolist (dir (yoke--choices packages))
340 (message "Generating autoloads for %s..." dir)
341 (yoke-generate-autoloads (file-name-nondirectory dir) dir)
342 (message "Generating autoloads for %s... Done" dir)))
343
344(defun yoke-remove (dir)
345 "Remove DIR from `yoke-dir'."
346 (interactive
347 (list (completing-read "Remove: " yoke-dirs
348 nil :require-match)))
349 (delete-directory dir :recursive :trash))
350 390
351(provide 'yoke) 391(provide 'yoke)
352;;; yoke.el ends here 392;;; yoke.el ends here