summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2022-10-17 23:28:38 -0500
committerCase Duckworth2022-10-17 23:28:38 -0500
commit0920c1b361e50d99c943d30255fed95f7bc0da23 (patch)
tree87635f8a34fbc6cd638990831380d2903e21b1ad
parentignore autoloads (diff)
downloademacs-0920c1b361e50d99c943d30255fed95f7bc0da23.tar.gz
emacs-0920c1b361e50d99c943d30255fed95f7bc0da23.zip
meh
-rw-r--r--early-init.el2
-rw-r--r--init.el36
-rw-r--r--lisp/+emacs.el410
-rw-r--r--lisp/acdw.el27
-rw-r--r--lisp/yoke.el66
5 files changed, 495 insertions, 46 deletions
diff --git a/early-init.el b/early-init.el index 173625f..340cbf7 100644 --- a/early-init.el +++ b/early-init.el
@@ -1,5 +1,7 @@
1;;; emacs early init -*- lexical-binding: t; -*- 1;;; emacs early init -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net> 2;; by C. Duckworth <acdw@acdw.net>
3;; Bankruptcy: 9
4
3(provide 'early-init) 5(provide 'early-init)
4 6
5;;; Speed up init 7;;; Speed up init
diff --git a/init.el b/init.el index d7a55d4..6889957 100644 --- a/init.el +++ b/init.el
@@ -9,7 +9,8 @@
9;; - Be kind to yourself. 9;; - Be kind to yourself.
10;; - Make good choices. 10;; - Make good choices.
11 11
12(progn 12(yoke +emacs (locate-user-emacs-file "lisp/")
13 (require '+emacs)
13 ;; Settings 14 ;; Settings
14 (setq truncate-string-ellipsis "…" 15 (setq truncate-string-ellipsis "…"
15 ring-bell-function #'ignore 16 ring-bell-function #'ignore
@@ -19,9 +20,23 @@
19 "C-x C-k" #'kill-current-buffer 20 "C-x C-k" #'kill-current-buffer
20 "C-/" #'undo-only 21 "C-/" #'undo-only
21 "C-?" #'undo-redo 22 "C-?" #'undo-redo
23 "C-x C-c" #'+save-buffers-quit
24 "M-SPC" #'+cycle-spacing
25 "M-/" #'hippie-expand
26 "M-=" #'count-words
27 "C-x C-b" #'ibuffer
28"C-x 4 n" #'clone-buffer
29 "S-<down-mouse-1>" #'mouse-set-mark
30 "C-x 0" #'+delete-window-or-bury-buffer
22 "M-j" nil 31 "M-j" nil
23 "<Scroll_Lock>" nil) 32 "<Scroll_Lock>" nil)
33 ;; Hooks
34 (add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
35 (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
36 (add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs)
24 ;; Advice 37 ;; Advice
38 (add-function :after after-focus-change-function #'+save-some-buffers-debounce)
39 (advice-add 'keyboard-escape-quit :around #'keyboard-escape-quit-keep-window-open)
25 (define-advice keyboard-escape-quit (:around (fn &rest r)) 40 (define-advice keyboard-escape-quit (:around (fn &rest r))
26 "Don't close quits on `keyboard-escape-quit'." 41 "Don't close quits on `keyboard-escape-quit'."
27 (let ((buffer-quit-function #'ignore)) 42 (let ((buffer-quit-function #'ignore))
@@ -29,6 +44,13 @@
29 ;; Themes 44 ;; Themes
30 (load-theme 'modus-operandi)) 45 (load-theme 'modus-operandi))
31 46
47(yoke isearch nil
48 (define-keys (current-global-map)
49 "C-s" #'isearch-forward-regexp
50 "C-r" #'isearch-backward-regexp
51 "C-M-s" #'isearch-forward
52 "C-M-r" #'isearch-backward))
53
32(yoke auth-source nil 54(yoke auth-source nil
33 (setq auth-sources `(default "secrets:passwords")) 55 (setq auth-sources `(default "secrets:passwords"))
34 (setq-local-hook authinfo-mode-hook 56 (setq-local-hook authinfo-mode-hook
@@ -52,7 +74,6 @@
52 "C-c k" #'consult-kmacro 74 "C-c k" #'consult-kmacro
53 ;; C-x bindings (ctl-x-map) 75 ;; C-x bindings (ctl-x-map)
54 "C-x M-:" #'consult-complex-command 76 "C-x M-:" #'consult-complex-command
55 "<f2>" #'consult-buffer
56 "C-x b" #'consult-buffer 77 "C-x b" #'consult-buffer
57 "C-x 4 b" #'consult-buffer-other-window 78 "C-x 4 b" #'consult-buffer-other-window
58 "C-x 5 b" #'consult-buffer-other-frame 79 "C-x 5 b" #'consult-buffer-other-frame
@@ -97,7 +118,7 @@
97 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading))) 118 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)))
98 119
99(yoke orderless "https://github.com/oantolin/orderless" 120(yoke orderless "https://github.com/oantolin/orderless"
100 (require 'orderless) 121(require 'orderless)
101 (setq completion-styles '(substring orderless basic) 122 (setq completion-styles '(substring orderless basic)
102 completion-category-defaults nil 123 completion-category-defaults nil
103 completion-category-overrides '((file (styles basic partial-completion))) 124 completion-category-overrides '((file (styles basic partial-completion)))
@@ -174,3 +195,12 @@
174 195
175(yoke minions "https://github.com/tarsius/minions" 196(yoke minions "https://github.com/tarsius/minions"
176 (minions-mode)) 197 (minions-mode))
198
199(yoke magit "https://github.com/magit/magit"
200 :load (locate-user-emacs-file "yoke/magit/lisp")
201 :depends ((transient "https://github.com/magit/transient"
202 (locate-user-emacs-file "yoke/transient/lisp"))
203 (dash "https://github.com/magnars/dash.el")
204 (with-editor "https://github.com/magit/with-editor"
205 (locate-user-emacs-file "yoke/with-editor/lisp")))
206 (autoload #'transient--with-suspended-override "transient"))
diff --git a/lisp/+emacs.el b/lisp/+emacs.el new file mode 100644 index 0000000..6f37b83 --- /dev/null +++ b/lisp/+emacs.el
@@ -0,0 +1,410 @@
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-keystrokes 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 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 101
112 scroll-down-aggressively 0.01
113 scroll-margin 2
114 scroll-preserve-screen-position 1
115 scroll-step 1
116 scroll-up-aggressively 0.01
117 search-ring-max 200
118 search-ring-max 200
119 sentence-end-double-space t
120 set-mark-command-repeat-pop t
121 show-paren-delay 0
122 show-paren-style 'parenthesis
123 show-paren-when-point-in-periphery t
124 show-paren-when-point-inside-paren t
125 ;;show-trailing-whitespace t
126 tab-bar-show 1
127 tab-width 8 ; so alignment expecting the default looks right
128 tramp-backup-directory-alist backup-directory-alist
129 undo-limit 100000000 ; 10 MB
130 use-dialog-box nil
131 use-file-dialog nil
132 use-short-answers t
133 vc-follow-symlinks t
134 vc-make-backup-files t
135 version-control t
136 view-read-only t
137 visible-bell nil
138 window-resize-pixelwise t
139 x-select-enable-clipboard t
140 x-select-enable-primary t
141 yank-pop-change-selection t
142 )
143
144;; Programming language offsets.
145;; Set these after the initial block so I can use `tab-width'
146(setq-default
147 c-basic-offset tab-width)
148
149;; Emacs 28 ships with an option, `use-short-answers', that makes this form
150;; obsolete, but I still use 27 at work.
151(when (version< emacs-version "28")
152 (fset 'yes-or-no-p 'y-or-n-p))
153
154
155;;; Encodings
156
157;; Allegedly, this is the only one you need...
158(set-language-environment "UTF-8")
159;; But I still set all of these, for fun.
160(setq-default locale-coding-system 'utf-8-unix
161 coding-system-for-read 'utf-8-unix
162 coding-system-for-write 'utf-8-unix
163 buffer-file-coding-system 'utf-8-unix
164 default-process-coding-system '(utf-8-unix . utf-8-unix)
165 x-select-request-type '(UTF8_STRING
166 COMPOUND_TEXT
167 TEXT
168 STRING))
169
170(set-charset-priority 'unicode)
171(prefer-coding-system 'utf-8-unix)
172(set-default-coding-systems 'utf-8-unix)
173(set-terminal-coding-system 'utf-8-unix)
174(set-keyboard-coding-system 'utf-8-unix)
175
176(pcase system-type
177 ((or 'ms-dos 'windows-nt)
178 (set-clipboard-coding-system 'utf-16-le)
179 (set-selection-coding-system 'utf-16-le))
180 (_
181 (set-selection-coding-system 'utf-8)
182 (set-clipboard-coding-system 'utf-8)))
183
184
185;;; Modes
186
187(dolist (enable-mode '(global-auto-revert-mode
188 blink-cursor-mode
189 electric-pair-mode
190 show-paren-mode
191 global-so-long-mode
192 minibuffer-depth-indicate-mode
193 file-name-shadow-mode
194 minibuffer-electric-default-mode
195 delete-selection-mode
196 auto-save-visited-mode
197 ;; column-number-mode
198 ))
199 (when (fboundp enable-mode)
200 (funcall enable-mode +1)))
201
202(dolist (disable-mode '(tooltip-mode
203 tool-bar-mode
204 menu-bar-mode
205 scroll-bar-mode
206 horizontal-scroll-bar-mode))
207 (when (fboundp disable-mode)
208 (funcall disable-mode -1)))
209
210
211;;; Hooks
212
213(defun +auto-create-missing-dirs ()
214 "Automatically create missing directories when finding a file."
215 ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/
216 (let ((target-dir (file-name-directory buffer-file-name)))
217 (unless (file-exists-p target-dir)
218 (make-directory target-dir t))))
219
220(defvar +save-some-buffers-debounce-time nil
221 "Last time `+save-some-buffers-debounce' was run.")
222
223(defcustom +save-some-buffers-debounce-timeout 5
224 "Number of seconds to wait before saving buffers again.")
225
226(defun +save-some-buffers-debounce (&rest _)
227 "Run `save-some-buffers', but only if it's been a while."
228 (unless (and +save-some-buffers-debounce-time
229 (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
230 +save-some-buffers-debounce-timeout))
231 (save-some-buffers t)
232 (setq +save-some-buffers-debounce-time (time-convert nil 'integer))))
233
234
235;;; Better-default functions ...
236
237(defun +cycle-spacing (&optional n preserve-nl-back mode)
238 "Negate N argument on `cycle-spacing'.
239That is, with a positive N, deletes newlines as well, leaving -N
240spaces. If N is negative, it will not delete newlines and leave
241N spaces. See docstring of `cycle-spacing' for the meaning of
242PRESERVE-NL-BACK and MODE."
243 (interactive "*p")
244 (cycle-spacing (- n) preserve-nl-back mode))
245
246(defun +save-buffers-quit (&optional arg)
247 "Silently save each buffer, then kill the current connection.
248If the current frame has no client, kill Emacs itself using
249`save-buffers-kill-emacs' after confirming with the user.
250
251With prefix ARG, silently save all file-visiting buffers, then
252kill without asking."
253 (interactive "P")
254 (save-some-buffers t)
255 (if (and (not (frame-parameter nil 'client))
256 (and (not arg)))
257 (when (yes-or-no-p "Sure you want to quit? ")
258 (save-buffers-kill-emacs))
259 (delete-frame nil :force)))
260
261(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn)
262 "Kill active region or ARG words backward.
263BACKWARD-KILL-WORD-FN is the function to call to kill a word
264backward. It defaults to `backward-kill-word'."
265 (interactive "P")
266 (call-interactively (if (region-active-p)
267 #'kill-region
268 (or backward-kill-word-fn #'backward-kill-word))))
269
270(defun +backward-kill-word-wrapper (fn &optional arg)
271 "Kill backward using FN until the beginning of a word, smartly.
272If point is on at the beginning of a line, kill the previous new
273line. If the only thing before point on the current line is
274whitespace, kill that whitespace.
275
276With argument ARG: if ARG is a number, just call FN
277ARG times. Otherwise, just call FN."
278 ;; I want this to be a wrapper so that I can call other word-killing functions
279 ;; with it. It's *NOT* advice because those functions probably use
280 ;; `backward-kill-word' under the hood (looking at you, paredit), so advice
281 ;; will make things weird.
282 (if (null arg)
283 (cond
284 ((looking-back "^" 1)
285 (let ((delete-active-region nil))
286 (delete-backward-char 1)))
287 ((looking-back "^[ ]*")
288 (delete-horizontal-space :backward-only))
289 (t (call-interactively fn)))
290 (funcall fn (if (listp arg) 1 arg))))
291
292(defun +backward-kill-word (&optional arg)
293 "Kill word backward using `backward-kill-word'.
294ARG is passed to `backward-kill-word'."
295 (interactive "P")
296 (+backward-kill-word-wrapper #'backward-kill-word arg))
297
298;;; ... and advice
299
300;; Indent the region after a yank.
301(defun +yank@indent (&rest _)
302 "Indent the current region."
303 (indent-region (min (point) (mark)) (max (point) (mark))))
304(advice-add #'yank :after #'+yank@indent)
305(advice-add #'yank-pop :after #'+yank@indent)
306
307
308;;; Extra functions
309
310(defun +save-some-buffers-p ()
311 "Predicate for `save-some-buffers-default-predicate'.
312It returns nil with remote files and those without attached files."
313 (and (buffer-file-name)
314 (not (file-remote-p (buffer-file-name)))))
315
316;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block
317(defun +goto-matching-paren (&optional arg)
318 "Go to the matching paren, similar to vi's %."
319 (interactive "p")
320 (or arg (setq arg 1))
321 (cond
322 ;; Check for "outside of bracket" positions
323 ((looking-at "[\[\(\{]") (forward-sexp arg))
324 ((looking-back "[\]\)\}]" 1) (backward-sexp arg))
325 ;; Otherwise, move from inside the bracket
326 ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg))
327 ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg))
328 (t (up-list arg t t))))
329
330(defun +delete-window-or-bury-buffer ()
331 "Delete the current window, or bury the current buffer.
332If the current window is the only window, bury the buffer."
333 (interactive)
334 (condition-case e
335 (delete-window)
336 (t (bury-buffer))))
337
338
339;;; Required libraries
340
341(when (require 'uniquify nil :noerror)
342 (setq-default uniquify-buffer-name-style 'forward
343 uniquify-separator path-separator
344 uniquify-after-kill-buffer-p t
345 uniquify-ignore-buffers-re "^\\*"))
346
347(when (require 'goto-addr)
348 (if (fboundp 'global-goto-address-mode)
349 (global-goto-address-mode +1)
350 (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
351
352(when (require 'recentf nil :noerror)
353 (setq-default recentf-save-file (.etc "recentf.el")
354 recentf-max-menu-items 100
355 recentf-max-saved-items nil
356 recentf-auto-cleanup 'mode)
357 (add-to-list 'recentf-exclude .etc)
358 (recentf-mode +1))
359
360(when (require 'savehist nil :noerror)
361 (setq-default history-length t
362 history-delete-duplicates t
363 history-autosave-interval 60
364 savehist-file (.etc "savehist.el")
365 ;; Other variables --- don't truncate any of these.
366 ;; `add-to-history' uses the values of these variables unless
367 ;; they're nil, in which case it falls back to `history-length'.
368 kill-ring-max 100
369 mark-ring-max 100
370 global-mark-ring-max 100
371 regexp-search-ring-max 100
372 search-ring-max 100
373 kmacro-ring-max 100
374 eww-history-limit 100)
375 (dolist (var '(extended-command-history
376 global-mark-ring
377 mark-ring
378 kill-ring
379 kmacro-ring
380 regexp-search-ring
381 search-ring))
382 (add-to-list 'savehist-additional-variables var))
383 (savehist-mode +1))
384
385(when (require 'saveplace nil :noerror)
386 (setq-default save-place-file (.etc "places.el")
387 save-place-forget-unreadable-files (eq system-type 'gnu/linux))
388 (save-place-mode +1))
389
390;; (when (require 'tramp)
391;; ;; thanks Irreal! https://irreal.org/blog/?p=895
392;; (add-to-list 'tramp-default-proxies-alist
393;; '(nil "\\`root\\'" "/ssh:%h:"))
394;; (add-to-list 'tramp-default-proxies-alist
395;; '((regexp-quote (system-name)) nil nil)))
396
397
398;;; Newer features
399;; These aren't in older version of Emacs, but they're so nice.
400
401(when (fboundp 'repeat-mode)
402 (setq-default repeat-exit-key "g"
403 repeat-exit-timeout 5)
404 (repeat-mode +1))
405
406(when (fboundp 'pixel-scroll-precision-mode)
407 (pixel-scroll-precision-mode +1))
408
409(provide '+emacs)
410;;; +emacs.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 1c6f826..f972d08 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -28,33 +28,6 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
28 (make-directory (file-name-directory file-name) :parents)) 28 (make-directory (file-name-directory file-name) :parents))
29 file-name)))) 29 file-name))))
30 30
31;;; Convenience macros
32
33(defun eval-after-init (fn)
34 "Evaluate FN after inititation, or now if Emacs is initialized.
35FN is called with no arguments."
36 (if after-init-time
37 (funcall fn)
38 (add-hook 'after-init-hook fn)))
39
40(defmacro eval-after (features &rest body)
41 "Evaluate BODY, but only after loading FEATURES.
42FEATURES can be an atom or a list; as an atom it works like
43`with-eval-after-load'. The special feature `init' will evaluate
44BODY after Emacs is finished initializing."
45 (declare (indent 1)
46 (debug (form def-body)))
47 (if (eq features 'init)
48 `(eval-after-init (lambda () ,@body))
49 (unless (listp features)
50 (setq features (list features)))
51 (if (null features)
52 (macroexp-progn body)
53 (let* ((this (car features))
54 (rest (cdr features)))
55 `(with-eval-after-load ',this
56 (eval-after ,rest ,@body))))))
57
58;;; Convenience functions 31;;; Convenience functions
59 32
60(defun define-keys (maps &rest keydefs) 33(defun define-keys (maps &rest keydefs)
diff --git a/lisp/yoke.el b/lisp/yoke.el index 2673e5e..4f40869 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el
@@ -32,7 +32,7 @@ directory created."
32 (message "Downloading %S... done" repo)) 32 (message "Downloading %S... done" repo))
33 dir)) 33 dir))
34 34
35(defun yoke-lasso (pkg repo) 35(defun yoke-lasso (pkg repo &optional load-path)
36 "Add PKG to `load-path' so it can be used. 36 "Add PKG to `load-path' so it can be used.
37If PKG is not installed, install it from REPO. Packages will be 37If PKG is not installed, install it from REPO. Packages will be
38installed to `yoke-dir'." 38installed to `yoke-dir'."
@@ -40,7 +40,8 @@ installed to `yoke-dir'."
40 (yoke-git repo dir) 40 (yoke-git repo dir)
41 (cond 41 (cond
42 ((file-exists-p dir) 42 ((file-exists-p dir)
43 (add-to-list 'load-path dir) 43 (when (or load-path dir)
44 (add-to-list 'load-path (expand-file-name (or load-path dir))))
44 ;; This bit is stolen from `straight'. 45 ;; This bit is stolen from `straight'.
45 (eval-and-compile (require 'autoload)) 46 (eval-and-compile (require 'autoload))
46 (let ((generated-autoload-file 47 (let ((generated-autoload-file
@@ -91,6 +92,31 @@ Similar-ish to `plist-get', but works on non-proper plists."
91 (setq list (cdr list))) 92 (setq list (cdr list)))
92 (reverse r))) 93 (reverse r)))
93 94
95(defun eval-after-init (fn)
96 "Evaluate FN after inititation, or now if Emacs is initialized.
97FN is called with no arguments."
98 (if after-init-time
99 (funcall fn)
100 (add-hook 'after-init-hook fn)))
101
102(defmacro eval-after (features &rest body)
103 "Evaluate BODY, but only after loading FEATURES.
104FEATURES can be an atom or a list; as an atom it works like
105`with-eval-after-load'. The special feature `init' will evaluate
106BODY after Emacs is finished initializing."
107 (declare (indent 1)
108 (debug (form def-body)))
109 (if (eq features 'init)
110 `(eval-after-init (lambda () ,@body))
111 (unless (listp features)
112 (setq features (list features)))
113 (if (null features)
114 (macroexp-progn body)
115 (let* ((this (car features))
116 (rest (cdr features)))
117 `(with-eval-after-load ',this
118 (eval-after ,rest ,@body))))))
119
94(defun yoke-pkg-name (pkg) 120(defun yoke-pkg-name (pkg)
95 (intern (format "yoke:%s" pkg))) 121 (intern (format "yoke:%s" pkg)))
96 122
@@ -98,28 +124,36 @@ Similar-ish to `plist-get', but works on non-proper plists."
98 &optional repo 124 &optional repo
99 &body body 125 &body body
100 &key 126 &key
101 requires ; :requires ((PKG REPO)...) 127 after ; :after (FEATURE...)
102 dest ; :dest DESTINATION 128 depends ; :depends ((PKG REPO)...)
129 load ; :load DIRECTORY
103 (when t whenp) ; :when PREDICATE 130 (when t whenp) ; :when PREDICATE
104 (unless nil unlessp) ; :unless PREDICATE 131 (unless nil unlessp) ; :unless PREDICATE
105 &allow-other-keys) 132 &allow-other-keys)
106 "Yoke a PKG into your Emacs session." 133 "Yoke a PKG into your Emacs session."
107 (declare (indent defun)) 134 (declare (indent defun))
108 (let ((name (yoke-pkg-name pkg))) 135 (let ((name (yoke-pkg-name pkg))
136 (body (delete2 body
137 :depends :when :unless :after :load)))
109 `(cl-block ,name 138 `(cl-block ,name
110 (condition-case e 139 (condition-case e
111 (let ((*yoke-name* ',name) 140 (let ((*yoke-name* ',name)
112 (*yoke-repo* ,repo) 141 (*yoke-repo* ,repo)
113 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo)))) 142 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
114 ,@(list (cond 143 ,@(cond
115 ((and whenp unlessp) 144 ((and whenp unlessp)
116 `(when (or (not ,when) ,unless) 145 `((when (or (not ,when) ,unless)
117 (cl-return-from ,name nil))) 146 (cl-return-from ,name nil))))
118 (whenp `(unless ,when (cl-return-from ,name nil))) 147 (whenp `((unless ,when (cl-return-from ,name nil))))
119 (unlessp `(when ,unless (cl-return-from ,name nil))))) 148 (unlessp `((when ,unless (cl-return-from ,name nil)))))
120 ,@(cl-loop for (pkg repo) in requires 149 ,@(cl-loop for (pkg* repo* load-path*) in depends
121 collect `(or (yoke-lasso ',pkg ,repo) 150 collect `(or (yoke-lasso ',pkg* ,repo* ,load-path*)
122 (cl-return-from ,name nil))) 151 (cl-return-from ,name nil)))
123 ,@(when repo `((yoke-lasso ',pkg ,repo))) 152 ,@(cond
124 ,@(delete2 body :requires :when :unless)) 153 (repo `((yoke-lasso ',pkg ,repo ,load)))
125 (t (message "%s: %S" ',name e)))))) 154 (load `((add-to-list 'load-path ,load))))
155 ,@(if after
156 `((eval-after ,after ,@body))
157 body))
158 (:success ',pkg)
159 (t (message "%s: %s" ',name e))))))