about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--early-init.el14
-rw-r--r--init.el547
-rw-r--r--lisp/yoke.el395
3 files changed, 635 insertions, 321 deletions
diff --git a/early-init.el b/early-init.el index 6f6a848..c75d963 100644 --- a/early-init.el +++ b/early-init.el
@@ -1,9 +1,7 @@
1;;; emacs early init -*- lexical-binding: t; -*- 1;;; early-init.el --- Emacs early init -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; by C. Duckworth <acdw@acdw.net>
3;; Bankruptcy: 9 3;; Bankruptcy: 9
4 4
5(provide 'early-init)
6
7;;; Speed up init 5;;; Speed up init
8 6
9;; Restore things after init 7;; Restore things after init
@@ -71,6 +69,9 @@ See `no-littering' for examples.")
71(+define-dir sync/ (expand-file-name "~/Sync") 69(+define-dir sync/ (expand-file-name "~/Sync")
72 "My Syncthing directory.") 70 "My Syncthing directory.")
73 71
72(+define-dir private/ (sync/ "emacs/private"))
73(add-to-list 'load-path private/)
74
74;;; Packages 75;;; Packages
75 76
76(setf package-enable-at-startup nil 77(setf package-enable-at-startup nil
@@ -79,9 +80,9 @@ See `no-littering' for examples.")
79(require 'yoke) 80(require 'yoke)
80(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate) 81(add-hook 'emacs-lisp-mode-hook #'yoke-imenu-insinuate)
81 82
82(yoke compat "https://git.sr.ht/~pkal/compat") 83(yoke (compat "https://git.sr.ht/~pkal/compat"))
83 84
84(yoke no-littering "https://github.com/emacscollective/no-littering" 85(yoke (no-littering "https://github.com/emacscollective/no-littering")
85 (setf no-littering-etc-directory .etc 86 (setf no-littering-etc-directory .etc
86 no-littering-var-directory .etc 87 no-littering-var-directory .etc
87 custom-file (.etc "custom.el")) 88 custom-file (.etc "custom.el"))
@@ -92,3 +93,6 @@ See `no-littering' for examples.")
92 (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) 93 (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t))))
93 (when (fboundp 'startup-redirect-eln-cache) 94 (when (fboundp 'startup-redirect-eln-cache)
94 (startup-redirect-eln-cache (convert-standard-filename (.etc "eln-cache/"))))) 95 (startup-redirect-eln-cache (convert-standard-filename (.etc "eln-cache/")))))
96
97(provide 'early-init)
98;;; early-init.el ends here
diff --git a/init.el b/init.el index 101e220..d3071e2 100644 --- a/init.el +++ b/init.el
@@ -9,15 +9,22 @@
9;; - Be kind to yourself. 9;; - Be kind to yourself.
10;; - Make good choices. 10;; - Make good choices.
11 11
12(yoke +emacs (locate-user-emacs-file "lisp/") 12(yoke +emacs
13 (require* '+emacs '+window) 13 (require* '+emacs '+window '+lisp)
14 ;; Settings 14 ;; Settings
15 (setf truncate-string-ellipsis "…" 15 (setf truncate-string-ellipsis "…"
16 ring-bell-function #'ignore 16 ring-bell-function #'ignore
17 read-file-name-completion-ignore-case t 17 read-file-name-completion-ignore-case t
18 comment-auto-fill-only-comments t 18 comment-auto-fill-only-comments t
19 password-cache t 19 password-cache t
20 password-cache-expiry (* 60 60)) 20 password-cache-expiry (* 60 60)
21 initial-buffer-choice (defun +initial-buffer-choose ()
22 (cond
23 ((bound-and-true-p initial-buffer-chosen)
24 (other-buffer))
25 (:else
26 (defvar initial-buffer-chosen t)
27 (get-buffer "*scratch*")))))
21 ;; "Safe" variables 28 ;; "Safe" variables
22 (dolist (var+pred 29 (dolist (var+pred
23 '((browse-url-browser-function 30 '((browse-url-browser-function
@@ -37,7 +44,17 @@
37 "C-x C-k" #'kill-current-buffer 44 "C-x C-k" #'kill-current-buffer
38 "C-/" #'undo-only 45 "C-/" #'undo-only
39 "C-?" #'undo-redo 46 "C-?" #'undo-redo
40 "C-x C-c" #'+save-buffers-quit 47 "C-x C-c" (defun delete-frame-or-quit (arg)
48 (interactive "P")
49 (cond (arg (delete-frame nil :force))
50 ((= 1 (length (frame-list)))
51 (and (yes-or-no-p "Kill emacs? ")
52 (save-buffers-kill-emacs t)))
53 (:else (delete-frame))))
54 "C-x r q" (defun really-quit-emacs (arg)
55 (interactive "P")
56 (cond (arg (save-buffers-kill-emacs t))
57 (:else (save-buffers-kill-terminal t))))
41 "M-SPC" #'+cycle-spacing 58 "M-SPC" #'+cycle-spacing
42 ;; "M-/" #'hippie-expand ; `hippie-completing-read' 59 ;; "M-/" #'hippie-expand ; `hippie-completing-read'
43 "M-=" #'count-words 60 "M-=" #'count-words
@@ -45,9 +62,13 @@
45 "C-x 4 n" #'clone-buffer 62 "C-x 4 n" #'clone-buffer
46 "S-<down-mouse-1>" #'mouse-set-mark 63 "S-<down-mouse-1>" #'mouse-set-mark
47 "C-x 0" #'+delete-window-or-bury-buffer 64 "C-x 0" #'+delete-window-or-bury-buffer
48 "M-j" nil 65 ;; "M-j" nil ; `avy'
49 "<Scroll_Lock>" nil 66 "<Scroll_Lock>" nil
50 "M-o" #'other-window|switch-buffer) 67 "C-z" nil
68 "M-o" #'other-window|switch-buffer
69 "C-M-;" #'+lisp-comment-or-uncomment-sexp
70 "C-x 5 z" #'suspend-frame
71 "M-@" #'dictionary-search)
51 (define-key* text-mode-map 72 (define-key* text-mode-map
52 "C-M-k" #'kill-paragraph) 73 "C-M-k" #'kill-paragraph)
53 ;; Hooks 74 ;; Hooks
@@ -57,16 +78,14 @@
57 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs) 78 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs)
58 (add-hook 'text-mode-hook #'abbrev-mode) 79 (add-hook 'text-mode-hook #'abbrev-mode)
59 (add-hook 'find-file-hook #'+vc-off-when-remote) 80 (add-hook 'find-file-hook #'+vc-off-when-remote)
81 (add-hook 'prog-mode-hook #'auto-fill-mode)
60 ;; Advice 82 ;; Advice
61 (add-function :after after-focus-change-function 83 (add-function :after after-focus-change-function
62 #'+save-some-buffers-debounce) 84 #'+save-some-buffers-debounce)
63 (advice-add 'keyboard-escape-quit :around 85 (define-advice keyboard-escape-quit (:around (fn &rest r) keep-window-open)
64 #'keyboard-escape-quit-keep-window-open)
65 (define-advice keyboard-escape-quit (:around (fn &rest r))
66 "Don't close quits on `keyboard-escape-quit'." 86 "Don't close quits on `keyboard-escape-quit'."
67 (let ((buffer-quit-function #'ignore)) 87 (let ((buffer-quit-function #'ignore))
68 (apply fn r))) 88 (apply fn r)))
69 (advice-add 'indent-region :before #'with-region-or-buffer)
70 ;; Themes 89 ;; Themes
71 (load-theme 'modus-operandi) 90 (load-theme 'modus-operandi)
72 (set-face-attribute 'default nil :family "Comic Code" :height 100) 91 (set-face-attribute 'default nil :family "Comic Code" :height 100)
@@ -75,7 +94,48 @@
75 ;; Modes 94 ;; Modes
76 (winner-mode)) 95 (winner-mode))
77 96
78(yoke whitespace nil 97(yoke custom ; This is `cus-edit' but meh
98 (require '+custom)
99 (setf custom-file (private/ "custom.el"))
100 (add-to-list* '+custom-allowed-variables
101 'safe-local-variable-values
102 'warning-suppress-types
103 'ispell-buffer-session-localwords)
104 (eval-after init
105 (+custom-load-some-customizations :noerror)))
106
107(yoke time
108 (setf display-time-mail-function
109 (defun +notmuch-new-mail-p ()
110 (plist-get (cl-find "inbox+unread"
111 (ignore-errors
112 (notmuch-hello-query-counts notmuch-saved-searches))
113 :key (lambda (l) (plist-get l :name))
114 :test #'equal)
115 :count))
116 display-time-use-mail-icon t
117 read-mail-command #'+notmuch-goto
118 display-time-24hr-format t
119 display-time-day-and-date t
120 display-time-default-load-average nil)
121 (display-time-mode))
122
123(yoke pita
124 (require 'pita)
125 (advice-add 'indent-region :before #'with-region-or-buffer))
126
127(yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session")
128 (setf undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
129 "/git-rebase-todo\\'")
130 undo-fu-session-directory (.etc "undo/" t)
131 undo-fu-session-compression (cond
132 ((executable-find "gzip") 'gz)
133 ((executable-find "bzip2") 'bz2)
134 ((executable-find "xz") 'xz)
135 (t nil)))
136 (global-undo-fu-session-mode))
137
138(yoke whitespace
79 (setf whitespace-line-column nil 139 (setf whitespace-line-column nil
80 whitespace-style '( face trailing 140 whitespace-style '( face trailing
81 tabs tab-mark 141 tabs tab-mark
@@ -95,8 +155,8 @@
95 (move-to-column col t) 155 (move-to-column col t)
96 (set-buffer-modified-p nil)))) 156 (set-buffer-modified-p nil))))
97 157
98(yoke elisp-mode nil 158(yoke elisp-mode
99 (setf eval-expression-print-length nil 159 (setf eval-expression-print-length nil ; remove ellipses from `eval-expression'
100 eval-expression-print-level nil) 160 eval-expression-print-level nil)
101 (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map) 161 (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map)
102 "C-c C-c" #'eval-defun 162 "C-c C-c" #'eval-defun
@@ -114,24 +174,24 @@
114 (apply fn beg end args) 174 (apply fn beg end args)
115 (pulse-momentary-highlight-region beg end))) 175 (pulse-momentary-highlight-region beg end)))
116 176
117(yoke isearch nil 177(yoke isearch
118 (define-key* (current-global-map) 178 (define-key* (current-global-map)
119 "C-s" #'isearch-forward-regexp 179 "C-s" #'isearch-forward-regexp
120 "C-r" #'isearch-backward-regexp 180 "C-r" #'isearch-backward-regexp
121 "C-M-s" #'isearch-forward 181 "C-M-s" #'isearch-forward
122 "C-M-r" #'isearch-backward)) 182 "C-M-r" #'isearch-backward))
123 183
124(yoke ispell nil 184(yoke ispell
125 (eval-after ispell 185 (require* '+ispell 'ispell)
126 (require '+ispell) 186 (add-hook 'before-save-hook
127 (add-hook 'before-save-hook #'+ispell-move-buffer-words-to-dir-locals-hook)) 187 #'+ispell-move-buffer-words-to-dir-locals-hook)
128 (setf ispell-program-name (or (executable-find "ispell") 188 (setf ispell-program-name (or (executable-find "ispell")
129 (executable-find "aspell"))) 189 (executable-find "aspell")))
130 (put 'ispell-buffer-session-localwords 190 (put 'ispell-buffer-session-localwords
131 'safe-local-variable #'+ispell-safe-local-p)) 191 'safe-local-variable #'+ispell-safe-local-p))
132 192
133 193
134(yoke mouse nil 194(yoke mouse
135 ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html 195 ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html
136 ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 196 ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3
137 (when (fboundp 'context-menu-mode) 197 (when (fboundp 'context-menu-mode)
@@ -147,7 +207,7 @@
147 (global-set-key (vector 'right-margin click) 'mwheel-scroll) 207 (global-set-key (vector 'right-margin click) 'mwheel-scroll)
148 (global-set-key (vector 'left-margin click) 'mwheel-scroll))) 208 (global-set-key (vector 'left-margin click) 'mwheel-scroll)))
149 209
150(yoke dired nil 210(yoke dired
151 (require 'dired-x) 211 (require 'dired-x)
152 (setf dired-recursive-copies 'always 212 (setf dired-recursive-copies 'always
153 dired-recursive-deletes 'always 213 dired-recursive-deletes 'always
@@ -178,19 +238,19 @@
178 #'dired-hide-details-mode 238 #'dired-hide-details-mode
179 #'hl-line-mode)) 239 #'hl-line-mode))
180 240
181(yoke dired-hacks "https://github.com/Fuco1/dired-hacks" 241(yoke (dired-hacks "https://github.com/Fuco1/dired-hacks")
182 (define-key* dired-mode-map 242 (define-key* dired-mode-map
183 "TAB" #'dired-subtree-sycle 243 "TAB" #'dired-subtree-sycle
184 "i" #'dired-subtree-toggle) 244 "i" #'dired-subtree-toggle)
185 (add-hook* 'dired-mode-hook 245 (add-hook* 'dired-mode-hook
186 #'dired-collapse-mode)) 246 #'dired-collapse-mode))
187 247
188(yoke auth-source nil 248(yoke auth-source
189 (setf auth-sources `(default "secrets:passwords")) 249 (setf auth-sources `(default "secrets:passwords"))
190 (setq-local-hook authinfo-mode-hook 250 (setq-local-hook authinfo-mode-hook
191 truncate-lines t)) 251 truncate-lines t))
192 252
193(yoke consult "https://github.com/minad/consult" 253(yoke (consult "https://github.com/minad/consult")
194 (require 'consult) 254 (require 'consult)
195 (setf register-preview-delay 0 255 (setf register-preview-delay 0
196 register-preview-function #'consult-register-format 256 register-preview-function #'consult-register-format
@@ -201,9 +261,10 @@
201 consult--regexp-compiler #'consult--default-regexp-compiler) 261 consult--regexp-compiler #'consult--default-regexp-compiler)
202 (advice-add #'register-preview :override #'consult-register-window) 262 (advice-add #'register-preview :override #'consult-register-window)
203 (define-key* (current-global-map) 263 (define-key* (current-global-map)
264 ;; Etc
265 "C-x m" #'consult-mode-command
204 ;; C-c bindings (mode-specific-map) 266 ;; C-c bindings (mode-specific-map)
205 "C-c h" #'consult-history 267 "C-c h" #'consult-history
206 "C-c m" #'consult-mode-command
207 "C-c b" #'consult-bookmark 268 "C-c b" #'consult-bookmark
208 "C-c k" #'consult-kmacro 269 "C-c k" #'consult-kmacro
209 ;; C-x bindings (ctl-x-map) 270 ;; C-x bindings (ctl-x-map)
@@ -250,12 +311,13 @@
250 "M-s L" #'consult-line-multi)) 311 "M-s L" #'consult-line-multi))
251 (eval-after org 312 (eval-after org
252 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) 313 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))
253 (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode 314 (eval-after consult-imenu
254 consult-imenu-config) 315 (setf (alist-get ?y (plist-get (alist-get 'emacs-lisp-mode
255 :types)) 316 consult-imenu-config)
256 '("Yoke"))) 317 :types))
318 '("Yoke"))))
257 319
258(yoke orderless "https://github.com/oantolin/orderless" 320(yoke (orderless "https://github.com/oantolin/orderless")
259 (require 'orderless) 321 (require 'orderless)
260 (setf completion-styles '(substring orderless basic) 322 (setf completion-styles '(substring orderless basic)
261 completion-category-defaults nil 323 completion-category-defaults nil
@@ -263,14 +325,14 @@
263 '((file (styles basic partial-completion))) 325 '((file (styles basic partial-completion)))
264 orderless-component-separator #'orderless-escapable-split-on-space)) 326 orderless-component-separator #'orderless-escapable-split-on-space))
265 327
266(yoke vertico "https://github.com/minad/vertico" 328(yoke (vertico "https://github.com/minad/vertico")
267 (require 'vertico) 329 (require 'vertico)
268 (setf resize-mini-windows 'grow-only 330 (setf resize-mini-windows 'grow-only
269 vertico-count-format nil 331 vertico-count-format nil
270 vertico-cycle t) 332 vertico-cycle t)
271 (vertico-mode)) 333 (vertico-mode))
272 334
273(yoke embark "https://github.com/oantolin/embark" 335(yoke (embark "https://github.com/oantolin/embark")
274 (require 'embark) 336 (require 'embark)
275 (setf prefix-help-command #'embark-prefix-help-command 337 (setf prefix-help-command #'embark-prefix-help-command
276 embar-keymap-prompter-key ";") 338 embar-keymap-prompter-key ";")
@@ -285,27 +347,31 @@
285 (require 'embark-consult) 347 (require 'embark-consult)
286 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) 348 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode)))
287 349
288(yoke marginalia "https://github.com/minad/marginalia/" 350(yoke (marginalia "https://github.com/minad/marginalia/")
289 (marginalia-mode)) 351 (marginalia-mode))
290 352
291(yoke wgrep "https://github.com/mhayashi1120/Emacs-wgrep" 353(yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep")
292 (require 'wgrep)) 354 (require 'wgrep))
293 355
294(yoke slime "https://github.com/slime/slime" 356;; (yoke (slime "https://github.com/slime/slime")
295 ;; r7rs-swank 357;; ;; r7rs-swank
296 (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank"))) 358;; (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank")))
297 (cond 359;; (cond
298 ((executable-find "chibi-scheme") 360;; ((executable-find "chibi-scheme")
299 (defun chibi-scheme-start-swank (file encoding) 361;; (defun chibi-scheme-start-swank (file encoding)
300 (format "%S\n\n" `(start-swank ,file))) 362;; (format "%S\n\n" `(start-swank ,file)))
301 (setq slime-lisp-implementations 363;; (setq slime-lisp-implementations
302 (cons `(chibi-scheme 364;; (cons `(chibi-scheme
303 ("chibi-scheme" ,(format "-A%s" r7rsloc) 365;; ("chibi-scheme" ,(format "-A%s" r7rsloc)
304 "-m" "(chibi-swank)") 366;; "-m" "(chibi-swank)")
305 :init chibi-scheme-start-swank) 367;; :init chibi-scheme-start-swank)
306 (bound-and-true-p slime-lisp-implementations))))))) 368;; (bound-and-true-p slime-lisp-implementations)))
307 369;; ;; (add-hook* 'scheme-mode-hook #'slime-mode)
308(yoke puni "https://github.com/amaikinono/puni" 370;; (setf slime-completion-at-point-functions
371;; (delq 'slime-c-p-c-completion-at-point
372;; slime-completion-at-point-functions))))))
373
374(yoke (puni "https://github.com/amaikinono/puni")
309 (define-key* puni-mode-map 375 (define-key* puni-mode-map
310 "C-)" #'puni-slurp-forward 376 "C-)" #'puni-slurp-forward
311 "C-(" #'puni-slurp-backward 377 "C-(" #'puni-slurp-backward
@@ -318,10 +384,12 @@
318 (puni-slurp-forward n))) 384 (puni-slurp-forward n)))
319 (electric-pair-mode) 385 (electric-pair-mode)
320 (add-hook* '(prog-mode-hook 386 (add-hook* '(prog-mode-hook
321 ielm-mode-hook) 387 ielm-mode-hook
388 lisp-interaction-mode-hook
389 lisp-mode-hook scheme-mode-hook)
322 #'puni-mode)) 390 #'puni-mode))
323 391
324(yoke hungry-delete "https://github.com/nflath/hungry-delete" 392(yoke (hungry-delete "https://github.com/nflath/hungry-delete")
325 (setq hungry-delete-chars-to-skip " \t" 393 (setq hungry-delete-chars-to-skip " \t"
326 hungry-delete-join-reluctantly nil) 394 hungry-delete-join-reluctantly nil)
327 (eval-after hungry-delete 395 (eval-after hungry-delete
@@ -349,7 +417,7 @@
349 arg))) 417 arg)))
350 (global-hungry-delete-mode)) 418 (global-hungry-delete-mode))
351 419
352(yoke cape "https://github.com/minad/cape" 420(yoke (cape "https://github.com/minad/cape")
353 ;; Insinuate in a lot of modes 421 ;; Insinuate in a lot of modes
354 (defvar +capes '(cape-file cape-dabbrev)) 422 (defvar +capes '(cape-file cape-dabbrev))
355 (defun +cape-insinuate (hook capf &optional capes) 423 (defun +cape-insinuate (hook capf &optional capes)
@@ -361,31 +429,33 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
361 (or capes +capes)))) 429 (or capes +capes))))
362 (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point)) 430 (+cape-insinuate 'emacs-lisp-mode-hook #'elisp-completion-at-point))
363 431
364(yoke minions "https://github.com/tarsius/minions" 432(yoke (minions "https://github.com/tarsius/minions")
365 (minions-mode)) 433 (minions-mode))
366 434
367(yoke magit "https://github.com/magit/magit" 435(yoke (magit "https://github.com/magit/magit"
368 :load (locate-user-emacs-file "yoke/magit/lisp") 436 :load "lisp")
369 :depends ((transient "https://github.com/magit/transient" 437 :depends ((transient "https://github.com/magit/transient"
370 (locate-user-emacs-file "yoke/transient/lisp")) 438 :load "lisp")
371 (dash "https://github.com/magnars/dash.el") 439 (dash "https://github.com/magnars/dash.el")
372 (with-editor "https://github.com/magit/with-editor" 440 (with-editor "https://github.com/magit/with-editor"
373 (locate-user-emacs-file "yoke/with-editor/lisp"))) 441 :load "lisp"))
374 (autoload #'transient--with-suspended-override "transient") 442 (autoload #'transient--with-suspended-override "transient")
375 (autoload #'magit "magit" nil :interactive)) 443 (autoload #'magit "magit" nil :interactive)
444 (define-key* (current-global-map)
445 "C-x g" #'magit))
376 446
377(yoke git-modes "https://github.com/magit/git-modes" 447(yoke (git-modes "https://github.com/magit/git-modes")
378 (require 'git-modes)) 448 (require 'git-modes))
379 449
380(yoke visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column" 450(yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column")
381 (setq visual-fill-column-center-text t) 451 (setq visual-fill-column-center-text t)
382 (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode) 452 (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode)
383 (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) 453 (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust))
384 454
385(yoke org "https://git.savannah.gnu.org/git/emacs/org-mode.git" 455(yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git"
386 :load (locate-user-emacs-file "yoke/org/lisp/") 456 :load "lisp")
387 :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" 457 :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib"
388 (locate-user-emacs-file "yoke/org-contrib/lisp"))) 458 :load "lisp"))
389 ;; DON'T load system org 459 ;; DON'T load system org
390 (setq load-path 460 (setq load-path
391 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) 461 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path))
@@ -470,86 +540,106 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
470 (org-clock-persistence-insinuate))) 540 (org-clock-persistence-insinuate)))
471 541
472(yoke org-agenda nil 542(yoke org-agenda nil
473 (setq org-agenda-skip-deadline-if-done t 543 (setq org-agenda-skip-deadline-if-done t
474 org-agenda-skip-scheduled-if-done t 544 org-agenda-skip-scheduled-if-done t
475 org-agenda-span 10 545 org-agenda-span 10
476 org-agenda-block-separator ?─ 546 org-agenda-block-separator ?─
477 org-agenda-time-grid 547 org-agenda-time-grid
478 '((daily today require-timed) 548 '((daily today require-timed)
479 (800 1000 1200 1400 1600 1800 2000) 549 (800 1000 1200 1400 1600 1800 2000)
480 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") 550 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
481 org-agenda-current-time-string 551 org-agenda-current-time-string
482 "← now ─────────────────────────────────────────────────" 552 "← now ─────────────────────────────────────────────────"
483 org-agenda-include-diary nil ; I use the org-diary features 553 org-agenda-include-diary nil ; I use the org-diary features
484 org-agenda-todo-ignore-deadlines 'near 554 org-agenda-todo-ignore-deadlines 'near
485 org-agenda-todo-ignore-scheduled 'future 555 org-agenda-todo-ignore-scheduled 'future
486 org-agenda-include-deadlines t 556 org-agenda-include-deadlines t
487 org-deadline-warning-days 0 557 org-deadline-warning-days 0
488 org-agenda-show-future-repeats 'next 558 org-agenda-show-future-repeats 'next
489 org-agenda-window-setup 'current-window) 559 org-agenda-window-setup 'current-window)
490 (setq-local-hook org-agenda-mode-hook 560 (setq-local-hook org-agenda-mode-hook
491 truncate-lines t 561 truncate-lines t
492 electric-pair-pairs (append electric-pair-pairs 562 electric-pair-pairs (append electric-pair-pairs
493 (mapcar (lambda (e) 563 (mapcar (lambda (e)
494 (let ((ch (string-to-char (car e)))) 564 (let ((ch (string-to-char (car e))))
495 (cons ch ch))) 565 (cons ch ch)))
496 org-emphasis-alist))) 566 org-emphasis-alist)))
497 (add-hook* 'org-agenda-mode-hook 567 (add-hook* 'org-agenda-mode-hook
498 #'hl-line-mode) 568 #'hl-line-mode)
499 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) 569 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
500 (define-key* (current-global-map) 570 (define-key* (current-global-map)
501 "C-c c" #'org-capture 571 "C-c c" #'org-capture
502 "C-c a" #'org-agenda)) 572 "C-c a" #'org-agenda)
503 573 (eval-after org-capture
504(yoke ox nil ; org-export 574 '+org-capture))
505 (eval-after org (require 'ox)) 575
506 (eval-after ox 576(yoke ox ; org-export
507 (require* '+ox '(ox-md nil t)) 577 (eval-after org (require 'ox))
508 (+org-export-pre-hooks-insinuate)) 578 (eval-after ox
509 (setq org-export-coding-system 'utf-8-unix 579 (require* '+ox '(ox-md nil t))
510 org-export-headline-levels 8 580 (+org-export-pre-hooks-insinuate))
511 org-export-with-drawers nil 581 (setq org-export-coding-system 'utf-8-unix
512 org-export-with-section-numbers nil 582 org-export-headline-levels 8
513 org-export-with-smart-quotes t 583 org-export-with-drawers nil
514 org-export-with-sub-superscripts t 584 org-export-with-section-numbers nil
515 org-export-with-toc nil)) 585 org-export-with-smart-quotes t
516 586 org-export-with-sub-superscripts t
517(yoke electric-cursor "https://codeberg.org/acdw/electric-cursor.el" 587 org-export-with-toc nil))
588
589(yoke (electric-cursor "https://codeberg.org/acdw/electric-cursor.el")
518 (setq electric-cursor-alist '((overwrite-mode . hbar) 590 (setq electric-cursor-alist '((overwrite-mode . hbar)
519 (t . bar))) 591 (t . bar)))
520 (electric-cursor-mode)) 592 (electric-cursor-mode))
521 593
522(yoke _work (sync/ "emacs/private") 594(yoke _work
523 :depends ((+org-capture (locate-user-emacs-file "lisp")) 595 :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git"
524 (private (locate-user-emacs-file "lisp")) 596 :load "lisp")
525 (bbdb "https://git.savannah.nongnu.org/git/bbdb.git"
526 (locate-user-emacs-file "yoke/bbdb/lisp"))
527 (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) 597 (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/"))
528 (require 'bbdb) 598 (setf bbdb-complete-mail-allow-cycling t)
529 (require* 'private 'work) 599 (add-hook* '+custom-after-load-hook
530 (bbdb-initialize 'gnus 'message) 600 (defun _work@after-custom ()
531 (setq bbdb-complete-mail-allow-cycling t)) 601 (require* 'private '_work)
602 (require* 'bbdb 'bbdb-message)
603 (bbdb-initialize 'gnus 'message))))
532 604
533(yoke org-taskwise "https://codeberg.org/acdw/org-taskwise.el") 605(yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el"))
534 606
535(yoke titlecase "https://codeberg.org/acdw/titlecase.el" 607(yoke scule
536 (eval-after org (require* 'titlecase '+titlecase)) 608 (require 'scule)
537 (eval-after titlecase 609 (defvar scule-map (let ((map (make-sparse-keymap)))
538 (add-to-list* 'titlecase-skip-words-regexps (rx word-boundary 610 (define-key map (kbd "M-u") #'scule-upcase)
539 (+ (any upper digit)) 611 (define-key map (kbd "M-l") #'scule-downcase)
540 word-boundary)))) 612 (define-key map (kbd "M-c") #'scule-capitalize)
613 map)
614 "Keymap for scule twiddling.")
615 (define-key* (current-global-map)
616 "M-c" scule-map
617 "M-u" #'universal-argument)
618 (define-key universal-argument-map (kbd "M-u") #'universal-argument-more))
541 619
542(yoke flyspell-correct "https://github.com/duckwork/flyspell-correct" 620(yoke (titlecase "https://codeberg.org/acdw/titlecase.el")
621 (eval-after titlecase
622 (add-to-list* 'titlecase-skip-words-regexps
623 (rx word-boundary
624 (+ (any upper digit))
625 word-boundary)))
626 (eval-after scule
627 (define-key* scule-map
628 "M-t" #'titlecase-dwim)))
629
630(yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct")
543 (eval-after flyspell 631 (eval-after flyspell
544 (require* 'flyspell-correct 632 (require* 'flyspell-correct
545 `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) 633 `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct")))
546 (define-key* flyspell-mode-map 634 (define-key* flyspell-mode-map
547 "C-;" #'flyspell-correct-wrapper 635 "C-;" #'flyspell-correct-wrapper
548 "<f7>" #'+flyspell-correct-buffer)) 636 "<f7>" #'+flyspell-correct-buffer
637 "C-," nil
638 "C-." nil))
549 (add-hook 'org-mode-hook #'flyspell-mode) 639 (add-hook 'org-mode-hook #'flyspell-mode)
550 (setq flyspell-correct--cr-key ";")) 640 (setq flyspell-correct--cr-key ";"))
551 641
552(yoke helpful "https://github.com/Wilfred/helpful" 642(yoke (helpful "https://github.com/Wilfred/helpful")
553 :depends ((dash "https://github.com/magnars/dash.el") 643 :depends ((dash "https://github.com/magnars/dash.el")
554 (f "https://github.com/rejeep/f.el") 644 (f "https://github.com/rejeep/f.el")
555 (s "https://github.com/magnars/s.el") 645 (s "https://github.com/magnars/s.el")
@@ -571,19 +661,28 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
571 (side . bottom) 661 (side . bottom)
572 (window-height . 20)))) 662 (window-height . 20))))
573 663
574(yoke hippie-completing-read 664(yoke (hippie-completing-read
575 "https://codeberg.org/acdw/hippie-completing-read.el" 665 "https://codeberg.org/acdw/hippie-completing-read.el")
576 (define-key* (current-global-map) 666 (define-key* (current-global-map)
577 "M-/" #'hippie-completing-read)) 667 "M-/" #'hippie-completing-read))
578 668
579(yoke dictionary nil ; Comes with Emacs 29! 669(yoke dictionary ; Comes with Emacs 29!
580 (setq dictionary-server "localhost") ; Needs local dictd 670 (setq dictionary-server (if (or (executable-find "dictd")
671 (file-exists-p "/usr/sbin/dictd")) ; oh debian
672 "localhost"
673 "dict.org"))
581 (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) 674 (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=)
582 '((display-buffer-in-side-window) 675 '((display-buffer-in-side-window)
583 (side . bottom) 676 (side . bottom)
584 (window-height . 20)))) 677 (window-height . 20)))
678 (eval-after org
679 (define-key* org-mode-map
680 "M-@" #'dictionary-search))
681 (eval-after embark
682 (define-key* embark-identifier-map
683 "@" #'dictionary-search)))
585 684
586(yoke anzu "https://github.com/emacsorphanage/anzu" 685(yoke (anzu "https://github.com/emacsorphanage/anzu")
587 (global-anzu-mode) 686 (global-anzu-mode)
588 (define-key* (current-global-map) 687 (define-key* (current-global-map)
589 [remap query-replace] #'anzu-query-replace-regexp 688 [remap query-replace] #'anzu-query-replace-regexp
@@ -600,45 +699,20 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
600 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window) 699 (advice-add 'anzu-query-replace-regexp :around #'anzu-qr@window)
601 (advice-add 'anzu-query-replace :around #'anzu-qr@window)) 700 (advice-add 'anzu-query-replace :around #'anzu-qr@window))
602 701
603(yoke tempo nil 702(yoke tempo
604 (require '+tempo)) 703 (require '+tempo))
605 704
606;; (yoke tempel "https://github.com/minad/tempel" 705(yoke (0x0 "https://gitlab.com/willvaughn/emacs-0x0")
607;; ;; I would use `tempo' but it's clunkier .. :(
608;; (define-key* (current-global-map)
609;; "M-+" #'tempel-complete
610;; "M-_" #'tempel-insert)
611;; (defun tempel-capf-insinuate ()
612;; (setq-local completion-at-point-functions
613;; (cons #'tempel-expand
614;; completion-at-point-functions)))
615;; (add-hook* '(prog-mode-hook
616;; text-mode-hook)
617;; #'tempel-capf-insinuate))
618
619(yoke scule (locate-user-emacs-file "lisp")
620 (defvar scule-map (let ((map (make-sparse-keymap)))
621 (define-key map (kbd "M-u") #'scule-upcase)
622 (define-key map (kbd "M-l") #'scule-downcase)
623 (define-key map (kbd "M-c") #'scule-capitalize)
624 map)
625 "Keymap for scule twiddling.")
626 (define-key* (current-global-map)
627 "M-c" scule-map
628 "M-u" #'universal-argument)
629 (define-key universal-argument-map (kbd "M-u") #'universal-argument-more))
630
631(yoke 0x0 "https://gitlab.com/willvaughn/emacs-0x0"
632 (setf 0x0-default-server 'ttm) 706 (setf 0x0-default-server 'ttm)
633 (eval-after embark 707 (eval-after embark
634 (define-key* embark-region-map 708 (define-key* embark-region-map
635 "U" #'0x0-dwim))) 709 "U" #'0x0-dwim)))
636 710
637(yoke filldent "https://codeberg.org/acdw/filldent.el" 711(yoke (filldent "https://codeberg.org/acdw/filldent.el")
638 (define-key* (current-global-map) 712 (define-key* (current-global-map)
639 "M-q" #'filldent-unfill-toggle)) 713 "M-q" #'filldent-unfill-toggle))
640 714
641(yoke avy "https://github.com/abo-abo/avy" 715(yoke (avy "https://github.com/abo-abo/avy")
642 (require 'avy) 716 (require 'avy)
643 (setf avy-background t 717 (setf avy-background t
644 (alist-get ?. avy-dispatch-alist) 718 (alist-get ?. avy-dispatch-alist)
@@ -655,11 +729,11 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
655 (define-key* isearch-mode-map 729 (define-key* isearch-mode-map
656 "M-j" #'avy-isearch)) 730 "M-j" #'avy-isearch))
657 731
658(yoke frowny "https://codeberg.org/acdw/frowny.el" 732(yoke (frowny "https://codeberg.org/acdw/frowny.el")
659 (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) 733 (setf frowny-eyes (rx (any ":=") (opt "'") (? "-")))
660 (global-frowny-mode)) 734 (global-frowny-mode))
661 735
662(yoke isearch-mb "https://github.com/astoff/isearch-mb" 736(yoke (isearch-mb "https://github.com/astoff/isearch-mb")
663 (eval-after (consult anzu) 737 (eval-after (consult anzu)
664 (require 'isearch-mb) 738 (require 'isearch-mb)
665 (dolist (spec '((isearch-mb--with-buffer 739 (dolist (spec '((isearch-mb--with-buffer
@@ -678,15 +752,156 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive."
678 (define-key isearch-mb-minibuffer-map (kbd key) command))))))) 752 (define-key isearch-mb-minibuffer-map (kbd key) command)))))))
679 (isearch-mb-mode)) 753 (isearch-mb-mode))
680 754
681(yoke keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el" 755(yoke (keepassxc-shim "https://codeberg.org/acdw/keepassxc-shim.el")
682 (keepassxc-shim-activate)) 756 (keepassxc-shim-activate))
683 757
684(yoke keychain-environment "https://github.com/tarsius/keychain-environment" 758(yoke (keychain-environment "https://github.com/tarsius/keychain-environment")
685 :when (executable-find "keychain") 759 :when (executable-find "keychain")
686 (keychain-refresh-environment)) 760 (keychain-refresh-environment))
687 761
688(yoke macrostep "https://github.com/joddie/macrostep" 762(yoke (sophomore "https://codeberg.org/acdw/sophomore.el")
763 (sophomore-enable #'narrow-to-region)
764 (sophomore-disable #'view-hello-file
765 #'describe-gnu-project)
766 (sophomore-disable-with 'confirm #'save-buffers-kill-terminal))
767
768(yoke (macrostep "https://github.com/joddie/macrostep")
689 (eval-after elisp-mode (require 'macrostep)) 769 (eval-after elisp-mode (require 'macrostep))
690 (define-key* '(emacs-lisp-mode-map 770 (define-key* '(emacs-lisp-mode-map
691 lisp-interaction-mode-map) 771 lisp-interaction-mode-map)
692 "C-c e" #'macrostep-expand)) 772 "C-c e" #'macrostep-expand))
773
774(yoke (embrace "https://github.com/cute-jumper/embrace.el")
775 :depends ((expand-region "https://github.com/magnars/expand-region.el"))
776 (define-key* (current-global-map)
777 "C-=" #'er/expand-region
778 "C-," #'embrace-commander)
779 (eval-after org
780 (define-key* org-mode-map
781 "C-=" #'er/expand-region
782 "C-," #'embrace-commander))
783 (dolist (fnhook '((org-mode-hook embrace-org-mode-hook)
784 (ruby-mode-hook embrace-ruby-mode-hook)
785 (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook)
786 (latex-mode-hook embrace-LaTeX-mode-hook)))
787 (apply #'add-hook fnhook))
788 (eval-after org
789 (defmacro org-insert-or-embrace (char)
790 "Define a function to insert CHAR, or `embrace' the region with it."
791 (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char)))
792 (char (cond ((characterp char) char)
793 ((stringp char) (string-to-char char))
794 (t (user-error "Bad format for char: %S" char)))))
795 `(defun ,fn-name (n)
796 ,(format "Insert N %ss, or surround the region with them."
797 (char-to-string char))
798 (interactive "p")
799 (if (region-active-p)
800 (dotimes (_ n)
801 (embrace--add-internal (region-beginning) (region-end) ,char)
802 (forward-char 1))
803 (self-insert-command n ,char)))))
804 (define-key* org-mode-map
805 "*" (org-insert-or-embrace "*")
806 "/" (org-insert-or-embrace "/")
807 "_" (org-insert-or-embrace "_")
808 "=" (org-insert-or-embrace "=")
809 "~" (org-insert-or-embrace "~")
810 "+" (org-insert-or-embrace "+"))))
811
812(yoke (notmuch "~/usr/share/emacs/site-lisp")
813 (eval-after bbdb
814 (require* 'notmuch '+notmuch '+message))
815 (+define-dir notmuch/ (sync/ "emacs/notmuch")
816 "Notmuch configuration and data.")
817 (setf notmuch-init-file (notmuch/ "notmuch-init.el" t)
818 notmuch-address-save-filename (notmuch/ "addresses" t)
819 notmuch-address-use-company (featurep 'company)
820 notmuch-search-oldest-first nil
821 notmuch-archive-tags '("-inbox" "-unread")
822 notmuch-draft-tags '("+draft" "-inbox" "-unread"))
823 (define-key* (current-global-map)
824 "C-c m" #'notmuch-mua-new-mail
825 "C-c n" #'+notmuch-goto)
826 ;; Reading mail
827 (setf notmuch-show-indent-content nil)
828 (add-hook* '(notmuch-show-mode-hook
829 notmuch-message-mode-hook)
830 #'visual-fill-column-mode)
831 (eval-after notmuch
832 (define-key* notmuch-search-mode-map
833 "RET" #'notmuch-search-show-thread
834 "M-RET" #'notmuch-tree-from-search-thread
835 "!" #'+notmuch-search-mark-spam)
836 (define-key* notmuch-tree-mode-map
837 "!" #'+notmuch-search-mark-spam-then-next))
838 ;; Writing mail
839 (setf message-kill-buffer-on-exit t
840 message-auto-save-directory nil)
841 ;; Sending mail
842 (setf send-mail-function #'sendmail-send-it
843 mail-specify-envelope-from t
844 message-sendmail-envelope-from 'header
845 message-envelope-from 'header)
846 ;; Extras
847 (eval-after notmuch
848 (require '+notmuch)
849 (load notmuch-init-file :noerror)
850 (add-hook 'message-setup-hook #'+message-signature-setup)
851 (add-hook 'message-send-hook #'+send-mail-dispatch)
852 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags)
853 (setf notmuch-saved-searches (list
854 (list :name "inbox+unread"
855 :query (+notmuch-query-concat
856 "tag:inbox"
857 "tag:unread"
858 "NOT tag:Spam")
859 :key "m"
860 :search-type 'tree)
861 (list :name "inbox"
862 :query (+notmuch-query-concat
863 "tag:inbox"
864 "NOT tag:Spam")
865 :key "i"
866 :search-type 'tree)
867 (list :name "lists+unread"
868 :query (+notmuch-query-concat
869 "tag:/List/"
870 "tag:unread")
871 :key "l"
872 :search-type 'tree)
873 (list :name "lists"
874 :query "tag:/List/"
875 :key "L"
876 :search-type 'tree)
877 (list :name "unread"
878 :query (+notmuch-query-concat
879 "tag:unread"
880 "NOT tag:Spam")
881 :key "u"
882 :search-type 'tree)
883 (list :name "flagged"
884 :query "tag:flagged"
885 :key "f"
886 :search-type 'tree)
887 (list :name "sent"
888 :query "tag:sent"
889 :key "t"
890 :search-type 'tree)
891 (list :name "drafts"
892 :query "tag:draft"
893 :key "d"
894 :search-type 'tree)
895 (list :name "all mail"
896 :query "*"
897 :key "a"
898 :search-type 'tree)))))
899
900(yoke (cider "https://github.com/clojure-emacs/cider")
901 :depends ((clojure-mode "http://github.com/clojure-emacs/clojure-mode")
902 (parseedn "https://github.com/clojure-emacs/parseedn/")
903 (parseclj "https://github.com/clojure-emacs/parseclj/") ; parseedn
904 (queue "https://elpa.gnu.org/packages/queue-0.2.el" :type 'http)
905 (spinner "https://github.com/Malabarba/spinner.el")
906 (sesman "https://github.com/vspinu/sesman"))
907 :when (executable-find "clojure"))
diff --git a/lisp/yoke.el b/lisp/yoke.el index e7a6fe9..46d30d5 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -1,184 +1,279 @@
1;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*- 1;;; yoke.el --- make your editor work for YOU -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; Copyright (C) 2022 C. Duckworth <acdw@acdw.net>
3(provide 'yoke) 3
4;;; Commentary:
5
6;; What's the most basic functionality of a package manager? In my view, all a
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;;; Code:
28
4(require 'cl-lib) 29(require 'cl-lib)
5 30
31;;; Customization options
32
6(defgroup yoke nil 33(defgroup yoke nil
7 "Customizations for yoke, a package manager thing." 34 "Customizations for `yoke'."
8 :group 'applications 35 :group 'applications
9 :prefix "yoke-") 36 :prefix "yoke-")
10 37
11(defcustom yoke-dir (locate-user-emacs-file "yoke") 38(defcustom yoke-dir (locate-user-emacs-file "yoke")
12 "Where yoke packages live." 39 "Where to put yoked packages."
13 :type 'file) 40 :type 'file)
14 41
15(defun yoke-repo-local-p (repo) 42(defcustom yoke-get-default-fn #'yoke-get-git
16 (string-match-p (rx bos (or "." "~" "/")) repo)) 43 "Default function to get packages with."
17 44 :type 'function)
18(defun yoke-repo-dir (pkg repo) 45
19 (if (yoke-repo-local-p repo) 46(defvar yoke-buffer "*yoke*"
20 (expand-file-name repo) 47 "Buffer to use for yoke process output.")
21 (expand-file-name (format "%s" pkg) yoke-dir))) 48
22 49;;; GET YOKED
23(defun yoke-git (repo &optional dir) 50
24 "Git REPO from the internet and put it into `yoke-dir'. 51(defmacro yoke (package
25If DIR is passed, clone there; otherwise just clone. Return the 52 &rest body)
26directory created." 53 "Yoke PACKAGE to work with your Emacs.
27 (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo)))) 54Execute BODY afterward.
28 (unless (or (yoke-repo-local-p repo) (file-exists-p dir)) 55
29 (message "Downloading %S..." repo) 56\(fn (PACKAGE [REPO REPO-KEYWORDS]) [BODY-KEYWORDS] BODY...)"
30 (call-process "git" nil (get-buffer-create "*yoke*") nil
31 "clone" repo dir)
32 (message "Downloading %S... done" repo))
33 dir))
34
35(defun yoke-lasso (pkg repo &optional load-path)
36 "Add PKG to `load-path' so it can be used.
37If PKG is not installed, install it from REPO. Packages will be
38installed to `yoke-dir'."
39 (let* ((dir (yoke-repo-dir pkg repo)))
40 (yoke-git repo dir)
41 (cond
42 ((file-exists-p dir)
43 (when (or load-path dir)
44 (add-to-list 'load-path (expand-file-name (or load-path dir))))
45 ;; This bit is stolen from `straight'.
46 (eval-and-compile (require 'autoload))
47 (let ((generated-autoload-file
48 (expand-file-name (format "%s-autoloads.el" pkg) dir))
49 (backup-inhibited t)
50 (version-control 'never)
51 (message-log-max nil)
52 (inhibit-message t))
53 (unless (file-exists-p generated-autoload-file)
54 (let ((find-file-hook nil)
55 (write-file-functions nil)
56 (debug-on-error nil)
57 (left-margin 0))
58 (if (fboundp 'make-directory-autoloads)
59 (make-directory-autoloads dir generated-autoload-file)
60 (and (fboundp 'update-directory-autoloads)
61 (update-directory-autoloads dir)))))
62 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
63 (kill-buffer buf))
64 (load generated-autoload-file :noerror :nomessage)))
65 (t (user-error "Directory \"%s\" doesn't exist." dir)))
66 dir))
67
68(defun yoke-get (key args)
69 "Get KEY's value from ARGS, or return nil.
70Similar-ish to `plist-get', but works on non-proper plists."
71 (cond
72 ((null args) nil)
73 ((eq key (car args)) (cadr args))
74 (t (yoke-get key (cdr args)))))
75
76(defmacro when1 (test &rest body)
77 "Like `when', but return the value of the test."
78 (declare (indent 1)) 57 (declare (indent 1))
79 (let ((g (gensym))) 58 (let* (;; State
80 `(let ((,g ,test)) 59 (pkg (cond ((consp package) (car package))
81 (when ,g 60 (:else package)))
82 ,@body 61 (url (cond ((consp package) (cdr package))
83 ,g)))) 62 (:else nil)))
84 63 (pname (intern (format "yoke:%s" pkg)))
85(defun delete2 (list &rest elems) 64 (dirvar (gensym "yoke-dir-"))
86 "Delete each element of ELEMS, and the next item, from LIST." 65 ;; Keyword args
87 (let ((r nil)) 66 (after (plist-get body :after))
88 (while (consp list) 67 (depends (plist-get body :depends))
89 (if (member (car list) elems) 68 (whenp (plist-member body :when))
90 (setf list (cdr list)) 69 (unlessp (plist-member body :unless))
91 (setf r (cons (car list) r))) 70 (when (cond (whenp (plist-get body :when))
92 (setf list (cdr list))) 71 (:else t)))
93 (reverse r))) 72 (unless (cond (unlessp (plist-get body :unless))
94 73 (:else nil)))
95(defun eval-after-init (fn) 74 (autoload (cond ((plist-member body :autoload)
75 (plist-get body :autoload))
76 (:else t)))
77 ;; Body
78 (body (cl-loop for (this next) on body by #'cddr
79 unless (keywordp this)
80 append (list this next) into ret
81 finally return (cond ((eq (car (last ret)) nil)
82 (butlast ret))
83 (:else ret)))))
84 `(cl-block ,pname
85 (condition-case err
86 (progn
87 ;; Pass `:when' or `:unless' clauses
88 ,@(cond
89 ((and whenp unlessp)
90 `((when (or (not ,when) ,unless)
91 (cl-return-from ,pname
92 (format "%s (abort) :when %S :unless %S"
93 ',pname ',when ',unless)))))
94 (whenp
95 `((unless ,when (cl-return-from ,pname
96 (format "%s (abort) :when %S"
97 ',pname ',when)))))
98 (unlessp
99 `((when ,unless (cl-return-from ,pname
100 (format "%s (abort) :unless %S"
101 ',pname ',unless))))))
102 ;; Get prerequisite packages
103 ,@(cl-loop
104 for (pkg* . yoke-get-args) in depends
105 collect `(or (let ((dir (yoke-get ,@yoke-get-args
106 :dir ,(format "%s" pkg*))))
107 (and dir
108 ,@(if autoload
109 `((yoke-generate-autoloads ',pkg* dir))
110 '(t))))
111 (cl-return-from ,pname
112 (format "Error fetching prerequiste: %s"
113 ',pkg*))))
114 ;; Download the package, generate autoloads
115 ,@(when url
116 `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg))))
117 ,@(when autoload
118 `((yoke-generate-autoloads ',pkg ,dirvar))))))
119 ;; Evaluate the body, optionally after the features in `:after'
120 ,@(cond (after
121 `((eval-after ,after ,@body)))
122 (:else body)))
123 (:success ',package)
124 (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
125 nil)))))
126
127(defun yoke-get (url &rest args)
128 "\"Get\" URL and and put it in DIR, then add DIR to `load-path'.
129URL can be a string or a list of the form (TYPE URL). The
130download will be dispatched to the TYPE, or to
131`yoke-get-default-fn' if only a string is given.
132ARGS is a plist with the following possible keys:
133
134:dir DIRECTORY --- the directory to put the URL.
135:load DIRECTORY --- the directory (relative to the download path)
136 to add to `load-path'.
137:type TYPE --- one of `http', `git', or `file' --- how to
138 download URL."
139 (let* ((dir (plist-get args :dir))
140 (load (plist-get args :load))
141 (type (plist-get args :type))
142 (path (cond
143 ((eq type 'http) (yoke-get-http url dir))
144 ((or (eq type 'git)
145 (string-match-p (rx bos "git:") url))
146 (yoke-get-git url dir))
147 ((or (eq type 'file)
148 (string-match-p (rx bos (or "file:" "~" "/")) url))
149 (yoke-get-file url dir))
150 ((stringp url)
151 (funcall yoke-get-default-fn url dir))
152 (:else (error "Uknown URL type: %S" url)))))
153 (cond
154 ((file-exists-p path)
155 (add-to-list 'load-path (expand-file-name (or load "") path))
156 path)
157 (:else (error "Directory \"%s\" doesn't exist." path)
158 nil))))
159
160(defun yoke-get--guess-directory (path &optional dir)
161 "Guess directory from PATH and DIR, and return it.
162If DIR is present and relative, resolve it relative to
163`yoke-dir', or if it's absolute, leave it as-is. If DIR is
164absent, return the final component of PATH resolved relative to
165`yoke-dir'."
166 (expand-file-name (or dir (file-name-nondirectory path))
167 yoke-dir))
168
169(defun yoke-get-http (url &optional dir)
170 "Download URL to DIR and return its directory.
171If DIR isn't given, it's guessed from the final component of the
172URL's path and placed under `yoke-dir'."
173 (let* ((dir (yoke-get--guess-directory url dir))
174 (basename (file-name-nondirectory url))
175 (filename (expand-file-name basename dir)))
176 (cond ((file-exists-p filename)
177 dir)
178 (:else
179 (message "Downloading %s..." url)
180 (with-current-buffer (let ((url-debug t))
181 (url-retrieve-synchronously url))
182 (condition-case e
183 (progn
184 (make-directory dir :parents)
185 (write-file filename 1)
186 (message "Downloading %s... Done" url))
187 (:success dir)
188 (t (signal (car e) (cdr e)))))))))
189
190(defun yoke-get-git (repo &optional dir)
191 "Clone REPO to DIR and return its directory.
192If DIR isn't given, it's guessed from the repo's name and put
193under `yoke-dir'. Return the cloned directory's name on success,
194or nil on failure."
195 (let ((dir (yoke-get--guess-directory repo dir)))
196 (cond ((file-exists-p dir)
197 dir)
198 (:else
199 (message "Cloning %s..." repo)
200 (pcase (call-process "git" nil (get-buffer-create yoke-buffer) nil
201 "clone" repo dir)
202 (0 (message "Cloning %s... Done" repo)
203 dir)
204 (_ (message "Cloning %s... Error! See buffer %s for output."
205 repo yoke-buffer)
206 nil))))))
207
208(defun yoke-get-file (file &optional _dir)
209 "Add FILE's directory to `load-dir'.
210_DIR is ignored."
211 (file-name-directory file))
212
213(defun yoke-generate-autoloads (package dir)
214 "Generate autoloads for PACKAGE in DIR."
215 ;; Shamelessly stolen from `straight'.
216 (eval-and-compile (require 'autoload))
217 (let ((generated-autoload-file
218 (expand-file-name (format "%s-autoloads.el" package) dir))
219 (backup-inhibited t)
220 (version-control 'never)
221 (message-log-max nil)
222 (inhibit-message t))
223 (unless (file-exists-p generated-autoload-file)
224 (let ((find-file-hook nil)
225 (write-file-functions nil)
226 (debug-on-error nil)
227 (left-margin 0))
228 (if (fboundp 'make-directory-autoloads)
229 (make-directory-autoloads dir generated-autoload-file)
230 (and (fboundp 'update-directory-autoloads)
231 (update-directory-autoloads dir)))))
232 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
233 (kill-buffer buf))
234 (load generated-autoload-file :noerror :nomessage)
235 t))
236
237;;; Evaluating forms after features
238
239(defun yoke--eval-after-init (fn)
96 "Evaluate FN after inititation, or now if Emacs is initialized. 240 "Evaluate FN after inititation, or now if Emacs is initialized.
97FN is called with no arguments." 241FN is called with no arguments."
98 (if after-init-time 242 (if after-init-time
99 (funcall fn) 243 (funcall fn)
100 (add-hook 'after-init-hook fn))) 244 (add-hook 'after-init-hook fn)))
101 245
102(defmacro eval-after (features &rest body) 246(defmacro yoke-eval-after (features &rest body)
103 "Evaluate BODY, but only after loading FEATURES. 247 "Evaluate BODY, but only after loading FEATURES.
104FEATURES can be an atom or a list; as an atom it works like 248FEATURES can be an atom or a list; as an atom it works like
105`with-eval-after-load'. The special feature `init' will evaluate 249`with-eval-after-load'. The special feature `init' will evaluate
106BODY after Emacs is finished initializing." 250BODY after Emacs is finished initializing."
107 (declare (indent 1) 251 (declare (indent 1)
108 (debug (form def-body))) 252 (debug (form def-body)))
109 (if (eq features 'init) 253 (unless (listp features)
110 `(eval-after-init (lambda () ,@body)) 254 (setf features (list features)))
111 (unless (listp features) 255 (if (null features)
112 (setf features (list features))) 256 (macroexp-progn body)
113 (if (null features) 257 (let* ((this (car features))
114 (macroexp-progn body) 258 (rest (cdr features)))
115 (let* ((this (car features)) 259 (cond ((eq this 'init)
116 (rest (cdr features))) 260 `(yoke--eval-after-init
117 `(with-eval-after-load ',this 261 (lambda () (eval-after ,rest ,@body))))
118 (eval-after ,rest ,@body)))))) 262 (:else
119 263 `(with-eval-after-load ',this
120(defun yoke-pkg-name (pkg) 264 (yoke-eval-after ,rest ,@body)))))))
121 (intern (format "yoke:%s" pkg)))
122
123(cl-defmacro yoke (pkg
124 &optional repo
125 &body body
126 &key
127 after ; :after (FEATURE...)
128 depends ; :depends ((PKG REPO)...)
129 load ; :load DIRECTORY
130 (when t whenp) ; :when PREDICATE
131 (unless nil unlessp) ; :unless PREDICATE
132 &allow-other-keys)
133 "Yoke a PKG into your Emacs session."
134 (declare (indent 2))
135 (let ((name (yoke-pkg-name pkg))
136 (body (delete2 body
137 :depends :when :unless :after :load)))
138 `(cl-block ,name
139 (condition-case e
140 (progn
141 ,@(cond
142 ((and whenp unlessp)
143 `((when (or (not ,when) ,unless)
144 (cl-return-from ,name nil))))
145 (whenp `((unless ,when (cl-return-from ,name nil))))
146 (unlessp `((when ,unless (cl-return-from ,name nil)))))
147 ,@(cl-loop for (pkg* repo* load-path*) in depends
148 collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
149 (cl-return-from ,name nil)))
150 ,@(cond
151 (repo `((yoke-lasso ',pkg ,repo ,load)))
152 (load `((add-to-list 'load-path ,load))))
153 ,@(if after
154 `((eval-after ,after ,@body))
155 body))
156 (:success ',pkg)
157 (t (message "%s: %s" ',name e))))))
158 265
159;;; Extras 266;;; Integration
160 267
161(defun yoke-imenu-insinuate () 268(defun yoke-imenu-insinuate ()
162 "Insinuate `yoke' forms for `imenu'." 269 "Insinuate `yoke' forms for `imenu'."
163 (require 'imenu) 270 (require 'imenu)
164 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal) 271 (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
165 (list (rx (: "(yoke" (+ space) 272 (list (rx (: "(yoke" (+ space) (? "(")
166 (group (+ (not space))) 273 (group (+ (not (or "(" " " "\t" "\n"))))
167 (+ space) 274 (+ space)
168 (group (+ (not space))))) 275 (group (+ (not space)))))
169 1))) 276 1)))
170 277
171(defun yoke-remove (pkg)
172 "Remove package PKG from `yoke-dir'."
173 (interactive (list (completing-read "Package: "
174 (directory-files yoke-dir)
175 (lambda (f)
176 (not (or (string= f ".")
177 (string= f ".."))))
178 :require-match)))
179 (let ((dir (expand-file-name pkg yoke-dir)))
180 (move-file-to-trash dir)
181 (message "Package `%s' removed." pkg)))
182
183(provide 'yoke) 278(provide 'yoke)
184;;; yoke.el ends here 279;;; yoke.el ends here