diff options
author | Case Duckworth | 2023-01-03 23:02:26 -0600 |
---|---|---|
committer | Case Duckworth | 2023-01-03 23:02:26 -0600 |
commit | 259363fd4f21d796c3c6a35be6398aed3f493a73 (patch) | |
tree | f2b782a37fa93b4b5be918bbe97c2c62aefd00d0 | |
parent | meh (diff) | |
download | emacs-259363fd4f21d796c3c6a35be6398aed3f493a73.tar.gz emacs-259363fd4f21d796c3c6a35be6398aed3f493a73.zip |
bleh
-rw-r--r-- | early-init.el | 2 | ||||
-rw-r--r-- | init.el | 756 | ||||
-rw-r--r-- | lisp/+emacs.el | 6 | ||||
-rw-r--r-- | lisp/+org.el | 56 | ||||
-rw-r--r-- | lisp/acdw.el | 35 | ||||
-rw-r--r-- | lisp/dawn.el | 67 | ||||
-rw-r--r-- | lisp/def.el | 142 | ||||
-rw-r--r-- | lisp/org-word-count.el | 297 | ||||
-rw-r--r-- | lisp/yoke.el | 111 |
9 files changed, 1099 insertions, 373 deletions
diff --git a/early-init.el b/early-init.el index c75d963..8004342 100644 --- a/early-init.el +++ b/early-init.el | |||
@@ -59,7 +59,7 @@ restore that." | |||
59 | 59 | ||
60 | ;;; Set up extra load paths and functionality | 60 | ;;; Set up extra load paths and functionality |
61 | 61 | ||
62 | (push (locate-user-emacs-file "lisp") load-path) | 62 | (push (expand-file-name (locate-user-emacs-file "lisp")) load-path) |
63 | (require 'acdw) | 63 | (require 'acdw) |
64 | 64 | ||
65 | (+define-dir .etc (locate-user-emacs-file "etc") | 65 | (+define-dir .etc (locate-user-emacs-file "etc") |
diff --git a/init.el b/init.el index c73e169..ffe7f81 100644 --- a/init.el +++ b/init.el | |||
@@ -12,13 +12,14 @@ | |||
12 | (yoke +emacs | 12 | (yoke +emacs |
13 | (require* '+emacs '+window '+lisp) | 13 | (require* '+emacs '+window '+lisp) |
14 | ;; Settings | 14 | ;; Settings |
15 | (setf truncate-string-ellipsis "…" | 15 | (setc 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 | eww-use-browse-url "." ; use `browse-url' in every link | ||
21 | password-cache-expiry (* 60 60) | 20 | password-cache-expiry (* 60 60) |
21 | switch-to-buffer-in-dedicated-window 'pop | ||
22 | switch-to-buffer-obey-display-actions t | ||
22 | initial-buffer-choice (defun +initial-buffer-choose () | 23 | initial-buffer-choice (defun +initial-buffer-choose () |
23 | (cond | 24 | (cond |
24 | ((equal (get-buffer "*Messages*") | 25 | ((equal (get-buffer "*Messages*") |
@@ -40,7 +41,7 @@ | |||
40 | 'custom-type))))))))) | 41 | 'custom-type))))))))) |
41 | (put (car var+pred) 'safe-local-variable (cdr var+pred))) | 42 | (put (car var+pred) 'safe-local-variable (cdr var+pred))) |
42 | ;; Keys | 43 | ;; Keys |
43 | (define-key* (current-global-map) | 44 | (defkeys t |
44 | "C-x C-k" #'kill-current-buffer | 45 | "C-x C-k" #'kill-current-buffer |
45 | "C-/" #'undo-only | 46 | "C-/" #'undo-only |
46 | "C-?" #'undo-redo | 47 | "C-?" #'undo-redo |
@@ -68,9 +69,25 @@ | |||
68 | "M-o" #'other-window|switch-buffer | 69 | "M-o" #'other-window|switch-buffer |
69 | "C-M-;" #'+lisp-comment-or-uncomment-sexp | 70 | "C-M-;" #'+lisp-comment-or-uncomment-sexp |
70 | "C-x 5 z" #'suspend-frame | 71 | "C-x 5 z" #'suspend-frame |
71 | "M-@" #'dictionary-search | 72 | "C-x f" #'find-file |
72 | "C-x f" #'find-file) | 73 | "C-c t" (defmap toggle-map |
73 | (define-key* text-mode-map | 74 | "A map for toggling various settings." |
75 | "d" (defmap toggle-debug-map | ||
76 | "Easily toggle debug flavors." | ||
77 | "e" #'toggle-debug-on-error | ||
78 | "q" #'toggle-debug-on-quit) | ||
79 | "w" #'toggle-word-wrap | ||
80 | "t" #'toggle-truncate-lines | ||
81 | "c" #'column-number-mode | ||
82 | "l" #'line-number-mode | ||
83 | "v" (defmap toggle-view-map | ||
84 | "Easily toggle UI elements' views." | ||
85 | "c" #'display-fill-column-indicator-mode | ||
86 | "l" #'display-line-numbers-mode | ||
87 | "m" #'menu-bar-mode | ||
88 | "t" #'tool-bar-mode | ||
89 | "s" #'scroll-bar-mode))) | ||
90 | (defkeys text-mode-map | ||
74 | "C-M-k" #'kill-paragraph | 91 | "C-M-k" #'kill-paragraph |
75 | "C-o" (defun open-paragraph (&optional arg) | 92 | "C-o" (defun open-paragraph (&optional arg) |
76 | "Open a paragraph after paragraph at point. | 93 | "Open a paragraph after paragraph at point. |
@@ -123,24 +140,63 @@ Called with prefix ARG, open a paragraph before point." | |||
123 | (eval-after init | 140 | (eval-after init |
124 | (+custom-load-some-customizations :noerror))) | 141 | (+custom-load-some-customizations :noerror))) |
125 | 142 | ||
126 | (yoke modus-themes | 143 | ;; (yoke modus-themes |
127 | (setf modus-themes-bold-constructs t | 144 | ;; (setc modus-themes-bold-constructs t |
128 | modus-themes-italic-constructs t | 145 | ;; modus-themes-italic-constructs t |
129 | modus-themes-headings '((1 monochrome bold italic) | 146 | ;; modus-themes-headings '((1 monochrome bold italic) |
130 | (2 monochrome bold) | 147 | ;; (2 monochrome bold) |
131 | (3 monochrom italic) | 148 | ;; (3 monochrom italic) |
132 | (t monochrome))) | 149 | ;; (t monochrome))) |
133 | (cond ((require 'dawn nil :noerrer) | 150 | ;; (defhook modus-themes-after-load-theme-hook |
134 | (add-hook* '+custom-after-load-hook | 151 | ;; :name modus-monochrome |
135 | (defun dawn@custom () | 152 | ;; (modus-themes-with-colors |
136 | (load-theme 'modus-operandi :noconfirm :noenable) | 153 | ;; (cl-loop for x being the symbols |
137 | (load-theme 'modus-vivendi :noconfirm :noenable) | 154 | ;; if (string-match-p "\\`font-lock-.*-face\\'" |
138 | (dawn-schedule #'modus-themes-load-operandi | 155 | ;; (symbol-name x)) |
139 | #'modus-themes-load-vivendi)))) | 156 | ;; do |
140 | (:else (load-theme 'modus-operandi)))) | 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)))) | ||
141 | 197 | ||
142 | (yoke time | 198 | (yoke time |
143 | (setf display-time-mail-function | 199 | (setc display-time-mail-function |
144 | (defun +notmuch-new-mail-p () | 200 | (defun +notmuch-new-mail-p () |
145 | (plist-get (cl-find "inbox+unread" | 201 | (plist-get (cl-find "inbox+unread" |
146 | (ignore-errors | 202 | (ignore-errors |
@@ -148,13 +204,16 @@ Called with prefix ARG, open a paragraph before point." | |||
148 | :key (lambda (l) (plist-get l :name)) | 204 | :key (lambda (l) (plist-get l :name)) |
149 | :test #'equal) | 205 | :test #'equal) |
150 | :count)) | 206 | :count)) |
151 | display-time-use-mail-icon t | 207 | display-time-use-mail-icon nil |
208 | display-time-mail-string (format "⋅ Mail (%s)" (+notmuch-new-mail-p)) | ||
152 | read-mail-command #'+notmuch-goto | 209 | read-mail-command #'+notmuch-goto |
153 | display-time-format " %a %-e, %H:%M" | 210 | display-time-format " %a %-e, %H:%M" |
154 | ;; `display-time-format' makes these unnecessary, but I'll keep em | 211 | ;; `display-time-format' makes these unnecessary, but I'll keep em |
155 | display-time-24hr-format t | 212 | display-time-24hr-format t |
156 | display-time-day-and-date t | 213 | display-time-day-and-date t |
157 | display-time-default-load-average nil) | 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)))) | ||
158 | (display-time-mode)) | 217 | (display-time-mode)) |
159 | 218 | ||
160 | (yoke pita | 219 | (yoke pita |
@@ -162,7 +221,7 @@ Called with prefix ARG, open a paragraph before point." | |||
162 | (advice-add 'indent-region :before #'with-region-or-buffer)) | 221 | (advice-add 'indent-region :before #'with-region-or-buffer)) |
163 | 222 | ||
164 | (yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session") | 223 | (yoke (undo-fu-session "https://codeberg.org/ideasman42/emacs-undo-fu-session") |
165 | (setf undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" | 224 | (setc undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" |
166 | "/git-rebase-todo\\'") | 225 | "/git-rebase-todo\\'") |
167 | undo-fu-session-directory (.etc "undo/" t) | 226 | undo-fu-session-directory (.etc "undo/" t) |
168 | undo-fu-session-compression (cond | 227 | undo-fu-session-compression (cond |
@@ -173,19 +232,16 @@ Called with prefix ARG, open a paragraph before point." | |||
173 | (global-undo-fu-session-mode)) | 232 | (global-undo-fu-session-mode)) |
174 | 233 | ||
175 | (yoke whitespace | 234 | (yoke whitespace |
176 | (setf whitespace-line-column nil | 235 | (setc whitespace-line-column nil |
177 | whitespace-style '( face trailing | 236 | whitespace-style '( face trailing |
178 | tabs tab-mark | 237 | tabs tab-mark |
179 | indentation | 238 | indentation |
180 | space-after-tab space-before-tab)) | 239 | space-after-tab space-before-tab)) |
181 | (defun +whitespace-mode-for-writable-buffers () | 240 | (defhook (text-mode-hook prog-mode-hook read-only-mode-hook) |
182 | "Turn on `whitespace-mode' if the buffer is writable, off otherwise." | 241 | :name +whitespace-mode-for-writable-buffers |
242 | :doc "Turn on `whitespace-mode' if the buffer is writable, off otherwise." | ||
183 | (whitespace-mode (if buffer-read-only -1 t))) | 243 | (whitespace-mode (if buffer-read-only -1 t))) |
184 | (add-hook* '(text-mode-hook | 244 | (defhook before-save-hook #'whitespace-cleanup) |
185 | prog-mode-hook | ||
186 | read-only-mode-hook) | ||
187 | #'+whitespace-mode-for-writable-buffers) | ||
188 | (add-hook 'before-save-hook #'whitespace-cleanup) | ||
189 | (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point) | 245 | (define-advice whitespace-cleanup (:around (fn &rest r) preserve-point) |
190 | (let ((col (current-column))) | 246 | (let ((col (current-column))) |
191 | (apply fn r) | 247 | (apply fn r) |
@@ -193,9 +249,9 @@ Called with prefix ARG, open a paragraph before point." | |||
193 | (set-buffer-modified-p nil)))) | 249 | (set-buffer-modified-p nil)))) |
194 | 250 | ||
195 | (yoke elisp-mode | 251 | (yoke elisp-mode |
196 | (setf eval-expression-print-length nil ; remove ellipses from `eval-expression' | 252 | (setc eval-expression-print-length nil ; remove ellipses from `eval-expression' |
197 | eval-expression-print-level nil) | 253 | eval-expression-print-level nil) |
198 | (define-key* '(emacs-lisp-mode-map lisp-interaction-mode-map) | 254 | (defkeys (emacs-lisp-mode-map lisp-interaction-mode-map) |
199 | "C-c C-c" #'eval-defun | 255 | "C-c C-c" #'eval-defun |
200 | "C-c C-k" (defun +elisp-eval-region-or-buffer () | 256 | "C-c C-k" (defun +elisp-eval-region-or-buffer () |
201 | (interactive) | 257 | (interactive) |
@@ -209,10 +265,10 @@ Called with prefix ARG, open a paragraph before point." | |||
209 | "C-c C-z" #'ielm) | 265 | "C-c C-z" #'ielm) |
210 | (define-advice eval-region (:around (fn beg end &rest args) pulse) | 266 | (define-advice eval-region (:around (fn beg end &rest args) pulse) |
211 | (apply fn beg end args) | 267 | (apply fn beg end args) |
212 | (pulse-momentary-highlight-region beg end))) | 268 | (pulse-momentary-highlight-region beg end))) |
213 | 269 | ||
214 | (yoke isearch | 270 | (yoke isearch |
215 | (define-key* (current-global-map) | 271 | (defkeys t |
216 | "C-s" #'isearch-forward-regexp | 272 | "C-s" #'isearch-forward-regexp |
217 | "C-r" #'isearch-backward-regexp | 273 | "C-r" #'isearch-backward-regexp |
218 | "C-M-s" #'isearch-forward | 274 | "C-M-s" #'isearch-forward |
@@ -222,7 +278,7 @@ Called with prefix ARG, open a paragraph before point." | |||
222 | (require* '+ispell 'ispell) | 278 | (require* '+ispell 'ispell) |
223 | (add-hook 'before-save-hook | 279 | (add-hook 'before-save-hook |
224 | #'+ispell-move-buffer-words-to-dir-locals-hook) | 280 | #'+ispell-move-buffer-words-to-dir-locals-hook) |
225 | (setf ispell-program-name (or (executable-find "ispell") | 281 | (setc ispell-program-name (or (executable-find "ispell") |
226 | (executable-find "aspell"))) | 282 | (executable-find "aspell"))) |
227 | (put 'ispell-buffer-session-localwords | 283 | (put 'ispell-buffer-session-localwords |
228 | 'safe-local-variable #'+ispell-safe-local-p)) | 284 | 'safe-local-variable #'+ispell-safe-local-p)) |
@@ -232,7 +288,7 @@ Called with prefix ARG, open a paragraph before point." | |||
232 | ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html | 288 | ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html |
233 | ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 | 289 | ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3 |
234 | (when (fboundp 'context-menu-mode) | 290 | (when (fboundp 'context-menu-mode) |
235 | (setf context-menu-functions '(context-menu-ffap | 291 | (setc context-menu-functions '(context-menu-ffap |
236 | context-menu-region | 292 | context-menu-region |
237 | context-menu-undo | 293 | context-menu-undo |
238 | ;; context-menu-dictionary | 294 | ;; context-menu-dictionary |
@@ -246,7 +302,7 @@ Called with prefix ARG, open a paragraph before point." | |||
246 | 302 | ||
247 | (yoke dired | 303 | (yoke dired |
248 | (require 'dired-x) | 304 | (require 'dired-x) |
249 | (setf dired-recursive-copies 'always | 305 | (setc dired-recursive-copies 'always |
250 | dired-recursive-deletes 'always | 306 | dired-recursive-deletes 'always |
251 | dired-create-destination-dirs 'always | 307 | dired-create-destination-dirs 'always |
252 | dired-do-revert-buffer t | 308 | dired-do-revert-buffer t |
@@ -265,26 +321,25 @@ Called with prefix ARG, open a paragraph before point." | |||
265 | dired-dwim-target t) | 321 | dired-dwim-target t) |
266 | (setq-local-hook dired-mode-hook | 322 | (setq-local-hook dired-mode-hook |
267 | truncate-lines t) | 323 | truncate-lines t) |
268 | (define-key* (current-global-map) | 324 | (defkeys t |
269 | "C-x C-j" #'dired-jump | 325 | "C-x C-j" #'dired-jump |
270 | [remap list-directory] #'dired) | 326 | [remap list-directory] #'dired) |
271 | (eval-after dired | 327 | (defkeys ((dired-mode-map :after dired)) |
272 | (define-key* dired-mode-map | 328 | "<backspace>" #'dired-up-directory |
273 | "<backspace>" #'dired-up-directory | 329 | "C-j" #'dired-up-directory) |
274 | "C-j" #'dired-up-directory)) | 330 | (defhook dired-mode-hook |
275 | (add-hook* 'dired-mode-hook | ||
276 | #'dired-hide-details-mode | 331 | #'dired-hide-details-mode |
277 | #'hl-line-mode)) | 332 | #'hl-line-mode)) |
278 | 333 | ||
279 | (yoke (dired-hacks "https://github.com/Fuco1/dired-hacks") | 334 | (yoke (dired-hacks "https://github.com/Fuco1/dired-hacks") |
280 | (define-key* dired-mode-map | 335 | (defkeys dired-mode-map |
281 | "TAB" #'dired-subtree-sycle | 336 | "TAB" #'dired-subtree-sycle |
282 | "i" #'dired-subtree-toggle) | 337 | "i" #'dired-subtree-toggle) |
283 | (add-hook* 'dired-mode-hook | 338 | (defhook 'dired-mode-hook |
284 | #'dired-collapse-mode)) | 339 | #'dired-collapse-mode)) |
285 | 340 | ||
286 | (yoke auth-source | 341 | (yoke auth-source |
287 | (setf auth-sources `(default "secrets:passwords")) | 342 | (setc auth-sources `(default "secrets:passwords")) |
288 | (setq-local-hook authinfo-mode-hook | 343 | (setq-local-hook authinfo-mode-hook |
289 | truncate-lines t)) | 344 | truncate-lines t)) |
290 | 345 | ||
@@ -299,54 +354,54 @@ Called with prefix ARG, open a paragraph before point." | |||
299 | consult--regexp-compiler #'consult--default-regexp-compiler) | 354 | consult--regexp-compiler #'consult--default-regexp-compiler) |
300 | (advice-add #'register-preview :override #'consult-register-window) | 355 | (advice-add #'register-preview :override #'consult-register-window) |
301 | (define-key* (current-global-map) | 356 | (define-key* (current-global-map) |
302 | ;; Etc | 357 | ;; Etc |
303 | "M-S-x" #'consult-mode-command | 358 | "M-S-x" #'consult-mode-command |
304 | ;; C-c bindings (mode-specific-map) | 359 | ;; C-c bindings (mode-specific-map) |
305 | "C-c h" #'consult-history | 360 | "C-c h" #'consult-history |
306 | "C-c b" #'consult-bookmark | 361 | "C-c b" #'consult-bookmark |
307 | "C-c k" #'consult-kmacro | 362 | "C-c k" #'consult-kmacro |
308 | ;; C-x bindings (ctl-x-map) | 363 | ;; C-x bindings (ctl-x-map) |
309 | "C-x M-:" #'consult-complex-command | 364 | "C-x M-:" #'consult-complex-command |
310 | "C-x b" #'consult-buffer | 365 | "C-x b" #'consult-buffer |
311 | "C-x 4 b" #'consult-buffer-other-window | 366 | "C-x 4 b" #'consult-buffer-other-window |
312 | "C-x 5 b" #'consult-buffer-other-frame | 367 | "C-x 5 b" #'consult-buffer-other-frame |
313 | ;; Custom M-# bindings for fast register access | 368 | ;; Custom M-# bindings for fast register access |
314 | "M-#" #'consult-register-load | 369 | "M-#" #'consult-register-load |
315 | "M-'" #'consult-register-store | 370 | "M-'" #'consult-register-store |
316 | "C-M-#" #'consult-register | 371 | "C-M-#" #'consult-register |
317 | ;; Other custom bindings | 372 | ;; Other custom bindings |
318 | "M-y" #'consult-yank-pop | 373 | "M-y" #'consult-yank-pop |
319 | ;;("<f1> a" . consult-apropos) | 374 | ;;("<f1> a" . consult-apropos) |
320 | ;; M-g bindings (goto-map) | 375 | ;; M-g bindings (goto-map) |
321 | "M-g e" #'consult-compile-error | 376 | "M-g e" #'consult-compile-error |
322 | "M-g f" #'consult-flymake ; or consult-flycheck | 377 | "M-g f" #'consult-flymake ; or consult-flycheck |
323 | "M-g g" #'consult-goto-line | 378 | "M-g g" #'consult-goto-line |
324 | "M-g M-g" #'consult-goto-line | 379 | "M-g M-g" #'consult-goto-line |
325 | "M-g o" #'consult-outline ; or consult-org-heading | 380 | "M-g o" #'consult-outline ; or consult-org-heading |
326 | "M-g m" #'consult-mark | 381 | "M-g m" #'consult-mark |
327 | "M-g k" #'consult-global-mark | 382 | "M-g k" #'consult-global-mark |
328 | "M-g i" #'consult-imenu | 383 | "M-g i" #'consult-imenu |
329 | "M-g M-i" #'consult-imenu | 384 | "M-g M-i" #'consult-imenu |
330 | "M-g I" #'consult-imenu-multi | 385 | "M-g I" #'consult-imenu-multi |
331 | ;; M-s bindings (search-map) | 386 | ;; M-s bindings (search-map) |
332 | "M-s f" #'consult-find | 387 | "M-s f" #'consult-find |
333 | "M-s F" #'consult-locate | 388 | "M-s F" #'consult-locate |
334 | "M-s g" #'consult-grep | 389 | "M-s g" #'consult-grep |
335 | "M-s G" #'consult-git-grep | 390 | "M-s G" #'consult-git-grep |
336 | "M-s r" #'consult-ripgrep | 391 | "M-s r" #'consult-ripgrep |
337 | "M-s l" #'consult-line | 392 | "M-s l" #'consult-line |
338 | "M-s L" #'consult-line-multi | 393 | "M-s L" #'consult-line-multi |
339 | "M-s m" #'consult-multi-occur | 394 | "M-s m" #'consult-multi-occur |
340 | "M-s k" #'consult-keep-lines | 395 | "M-s k" #'consult-keep-lines |
341 | "M-s u" #'consult-focus-lines | 396 | "M-s u" #'consult-focus-lines |
342 | ;; Isearch integration | 397 | ;; Isearch integration |
343 | "M-s e" #'consult-isearch-history) | 398 | "M-s e" #'consult-isearch-history) |
344 | (eval-after isearch-mode | 399 | (eval-after isearch-mode |
345 | (define-key* isearch-mode-map | 400 | (define-key* isearch-mode-map |
346 | "M-e" #'consult-isearch-history | 401 | "M-e" #'consult-isearch-history |
347 | "M-s e" #'consult-isearch-history | 402 | "M-s e" #'consult-isearch-history |
348 | "M-s l" #'consult-line | 403 | "M-s l" #'consult-line |
349 | "M-s L" #'consult-line-multi)) | 404 | "M-s L" #'consult-line-multi)) |
350 | (eval-after org | 405 | (eval-after org |
351 | (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) | 406 | (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)) |
352 | (eval-after consult-imenu | 407 | (eval-after consult-imenu |
@@ -368,19 +423,21 @@ Called with prefix ARG, open a paragraph before point." | |||
368 | (setf resize-mini-windows 'grow-only | 423 | (setf resize-mini-windows 'grow-only |
369 | vertico-count-format nil | 424 | vertico-count-format nil |
370 | vertico-cycle t) | 425 | vertico-cycle t) |
371 | (vertico-mode)) | 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)) | ||
372 | 430 | ||
373 | (yoke (embark "https://github.com/oantolin/embark") | 431 | (yoke (embark "https://github.com/oantolin/embark") |
374 | (require 'embark) | 432 | (require 'embark) |
375 | (setf prefix-help-command #'embark-prefix-help-command | 433 | (setf prefix-help-command #'embark-prefix-help-command |
376 | embar-keymap-prompter-key ";") | 434 | embar-keymap-prompter-key ";") |
377 | (define-key* (list (current-global-map) | 435 | (defkeys (t minibuffer-local-map) |
378 | 'minibuffer-local-map) | ||
379 | "C-." #'embark-act | 436 | "C-." #'embark-act |
380 | "M-." #'embark-dwim | 437 | "M-." #'embark-dwim |
381 | "<f1> B" #'embark-bindings) | 438 | "<f1> B" #'embark-bindings) |
382 | (define-key* embark-file-map | 439 | (define-key* embark-file-map |
383 | "l" #'vlf) | 440 | "l" #'vlf) |
384 | (eval-after (embark consult) | 441 | (eval-after (embark consult) |
385 | (require 'embark-consult) | 442 | (require 'embark-consult) |
386 | (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) | 443 | (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))) |
@@ -391,18 +448,23 @@ Called with prefix ARG, open a paragraph before point." | |||
391 | (yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") | 448 | (yoke (wgrep "https://github.com/mhayashi1120/Emacs-wgrep") |
392 | (require 'wgrep) | 449 | (require 'wgrep) |
393 | (define-key* grep-mode-map | 450 | (define-key* grep-mode-map |
394 | "C-x C-q" #'wgrep-change-to-wgrep-mode)) | 451 | "C-x C-q" #'wgrep-change-to-wgrep-mode)) |
395 | 452 | ||
396 | (yoke (slime "https://github.com/slime/slime") | 453 | (yoke (slime "https://github.com/slime/slime") |
397 | :when (executable-find "sbcl") | 454 | :when (executable-find "sbcl") |
398 | (setf inferior-lisp-program (executable-find "sbcl")) | 455 | (setc inferior-lisp-program (executable-find "sbcl")) |
456 | (defhook lisp-mode-hook | ||
457 | :name slime-mode-setup | ||
458 | (load (expand-file-name "~/quicklisp/slime-helper.el") :noerror) | ||
459 | (slime-mode)) | ||
399 | (eval-after slime | 460 | (eval-after slime |
400 | (setf slime-completion-at-point-functions | 461 | (setc slime-completion-at-point-functions |
401 | (delq 'slime-c-p-c-completion-at-point | 462 | (delq 'slime-c-p-c-completion-at-point |
402 | slime-completion-at-point-functions)))) | 463 | slime-completion-at-point-functions)))) |
403 | 464 | ||
404 | (yoke (puni "https://github.com/amaikinono/puni") | 465 | (yoke (puni "https://github.com/amaikinono/puni") |
405 | (define-key* puni-mode-map | 466 | (electric-pair-mode) |
467 | (defkeys puni-mode-map | ||
406 | "C-)" #'puni-slurp-forward | 468 | "C-)" #'puni-slurp-forward |
407 | "C-(" #'puni-slurp-backward | 469 | "C-(" #'puni-slurp-backward |
408 | "C-}" #'puni-barf-forward | 470 | "C-}" #'puni-barf-forward |
@@ -411,16 +473,15 @@ Called with prefix ARG, open a paragraph before point." | |||
411 | (interactive "p") | 473 | (interactive "p") |
412 | (insert "()") | 474 | (insert "()") |
413 | (backward-char) | 475 | (backward-char) |
414 | (puni-slurp-forward n))) | 476 | (ignore-errors (puni-slurp-forward n)))) |
415 | (electric-pair-mode) | 477 | (defhook (prog-mode-hook |
416 | (add-hook* '(prog-mode-hook | 478 | lisp-interaction-mode-hook emacs-lisp-mode-hook |
417 | ielm-mode-hook | 479 | lisp-mode-hook scheme-mode-hook |
418 | lisp-interaction-mode-hook | 480 | ielm-mode-hook eval-expression-minibuffer-setup-hook) |
419 | lisp-mode-hook scheme-mode-hook) | ||
420 | #'puni-mode)) | 481 | #'puni-mode)) |
421 | 482 | ||
422 | (yoke (hungry-delete "https://github.com/nflath/hungry-delete") | 483 | (yoke (hungry-delete "https://github.com/nflath/hungry-delete") |
423 | (setq hungry-delete-chars-to-skip " \t" | 484 | (setc hungry-delete-chars-to-skip " \t" |
424 | hungry-delete-join-reluctantly nil) | 485 | hungry-delete-join-reluctantly nil) |
425 | (eval-after hungry-delete | 486 | (eval-after hungry-delete |
426 | (add-to-list* 'hungry-delete-except-modes | 487 | (add-to-list* 'hungry-delete-except-modes |
@@ -432,15 +493,15 @@ Called with prefix ARG, open a paragraph before point." | |||
432 | hd-fn | 493 | hd-fn |
433 | fn) | 494 | fn) |
434 | arg)) | 495 | arg)) |
435 | (define-key* puni-mode-map | 496 | (defkeys puni-mode-map |
436 | [remap puni-backward-delete-char] | 497 | [remap puni-backward-delete-char] |
437 | (defun puni@hungry-delete-backward (arg) | 498 | (defun +puni|hungry-delete-backward (arg) |
438 | (interactive "p") | 499 | (interactive "p") |
439 | (+hungry-delete-or #'hungry-delete-backward | 500 | (+hungry-delete-or #'hungry-delete-backward |
440 | #'puni-backward-delete-char | 501 | #'puni-backward-delete-char |
441 | arg)) | 502 | arg)) |
442 | [remap puni-forward-delete-char] | 503 | [remap puni-forward-delete-char] |
443 | (defun puni@hungry-delete-forward (arg) | 504 | (defun +puni|hungry-delete-forward (arg) |
444 | (interactive "p") | 505 | (interactive "p") |
445 | (+hungry-delete-or #'hungry-delete-forward | 506 | (+hungry-delete-or #'hungry-delete-forward |
446 | #'puni-forward-delete-char | 507 | #'puni-forward-delete-char |
@@ -468,18 +529,18 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
468 | :load "lisp") | 529 | :load "lisp") |
469 | (dash "https://github.com/magnars/dash.el") | 530 | (dash "https://github.com/magnars/dash.el") |
470 | (with-editor "https://github.com/magit/with-editor" | 531 | (with-editor "https://github.com/magit/with-editor" |
471 | :load "lisp")) | 532 | :load "lisp")) |
472 | (autoload #'transient--with-suspended-override "transient") | 533 | (autoload #'transient--with-suspended-override "transient") |
473 | (autoload #'magit "magit" nil :interactive) | 534 | (autoload #'magit "magit" nil :interactive) |
474 | (define-key* (current-global-map) | 535 | (defkeys t |
475 | "C-x g" #'magit)) | 536 | "C-x g" #'magit)) |
476 | 537 | ||
477 | (yoke (git-modes "https://github.com/magit/git-modes") | 538 | (yoke (git-modes "https://github.com/magit/git-modes") |
478 | (require 'git-modes)) | 539 | (require 'git-modes)) |
479 | 540 | ||
480 | (yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") | 541 | (yoke (visual-fill-column "https://codeberg.org/joostkremers/visual-fill-column") |
481 | (setq visual-fill-column-center-text t) | 542 | (setc visual-fill-column-center-text t) |
482 | (add-hook* 'visual-fill-column-mode-hook #'visual-line-mode) | 543 | (add-hook 'visual-fill-column-mode-hook #'visual-line-mode) |
483 | (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) | 544 | (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)) |
484 | 545 | ||
485 | (yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" | 546 | (yoke (org "https://git.savannah.gnu.org/git/emacs/org-mode.git" |
@@ -487,10 +548,10 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
487 | :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" | 548 | :depends ((org-contrib "https://git.sr.ht/~bzg/org-contrib" |
488 | :load "lisp")) | 549 | :load "lisp")) |
489 | ;; DON'T load system org | 550 | ;; DON'T load system org |
490 | (setq load-path | 551 | (setc load-path |
491 | (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) | 552 | (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) |
492 | load-path)) | 553 | load-path)) |
493 | (setq org-adapt-indentation nil | 554 | (setc org-adapt-indentation nil |
494 | org-auto-align-tags t | 555 | org-auto-align-tags t |
495 | org-archive-mark-done t | 556 | org-archive-mark-done t |
496 | org-fold-catch-invisible-edits 'show-and-error | 557 | org-fold-catch-invisible-edits 'show-and-error |
@@ -549,25 +610,27 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
549 | ("=" org-verbatim) | 610 | ("=" org-verbatim) |
550 | ("~" org-code) | 611 | ("~" org-code) |
551 | ("+" org-strikethrough))) | 612 | ("+" org-strikethrough))) |
552 | (add-hook* 'org-mode-hook | 613 | (defhook org-mode-hook |
553 | #'variable-pitch-mode | 614 | #'variable-pitch-mode |
554 | #'visual-fill-column-mode | 615 | #'visual-fill-column-mode |
555 | #'turn-off-auto-fill | 616 | #'turn-off-auto-fill |
556 | #'org-indent-mode | 617 | #'org-indent-mode |
557 | #'prettify-symbols-mode | 618 | #'prettify-symbols-mode |
558 | #'abbrev-mode) | 619 | #'abbrev-mode |
559 | (define-local-before-save-hook org-mode | 620 | (defhook ((before-save-hook nil :local)) |
560 | (org-hide-drawer-all) | 621 | :name before-save@org-mode |
561 | (org-align-tags 'all)) | 622 | (+org-hide-drawers-except-point) |
623 | (org-align-tags 'all))) | ||
562 | (eval-after org | 624 | (eval-after org |
563 | (require '+org) | 625 | (require '+org) |
564 | (define-key* org-mode-map | 626 | (org-clock-persistence-insinuate) |
627 | (+org-agenda-inhibit-hooks-mode) | ||
628 | (defkeys org-mode-map | ||
565 | "C-M-k" #'kill-paragraph | 629 | "C-M-k" #'kill-paragraph |
566 | "C-M-t" #'transpose-paragraphs | 630 | "C-M-t" #'transpose-paragraphs |
567 | "RET" #'+org-return-dwim | 631 | "RET" #'+org-return-dwim |
568 | "S-<return>" #'+org-table-copy-down|+org-return | 632 | "S-<return>" #'+org-table-copy-down|+org-return |
569 | "C-c C-o" #'+org-open-at-point-dwim) | 633 | "C-c C-o" #'+org-open-at-point-dwim)) |
570 | (org-clock-persistence-insinuate)) | ||
571 | (eval-after ol ; org-link | 634 | (eval-after ol ; org-link |
572 | (defmacro define-org-link-type (type args &rest body) | 635 | (defmacro define-org-link-type (type args &rest body) |
573 | "Define an org link TYPE with ARGS that does something. | 636 | "Define an org link TYPE with ARGS that does something. |
@@ -583,50 +646,49 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
583 | (define-org-link-type sms (number _)) | 646 | (define-org-link-type sms (number _)) |
584 | (define-org-link-type tel (number _)))) | 647 | (define-org-link-type tel (number _)))) |
585 | 648 | ||
586 | (yoke org-agenda nil | 649 | (yoke org-word-count ; in lisp/ |
587 | (setq org-agenda-skip-deadline-if-done t | 650 | (eval-after org |
588 | org-agenda-skip-scheduled-if-done t | 651 | (require 'org-word-count) |
589 | org-agenda-span 10 | 652 | (add-hook 'org-mode-hook #'org-word-count-mode))) |
590 | org-agenda-block-separator ?─ | 653 | |
591 | org-agenda-time-grid | 654 | (yoke org-agenda |
592 | '((daily today require-timed) | 655 | (setq org-agenda-skip-deadline-if-done t |
593 | (800 1000 1200 1400 1600 1800 2000) | 656 | org-agenda-skip-scheduled-if-done t |
594 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") | 657 | org-agenda-span 10 |
595 | org-agenda-current-time-string | 658 | org-agenda-block-separator ?─ |
596 | "← now ─────────────────────────────────────────────────" | 659 | org-agenda-time-grid |
597 | org-agenda-include-diary nil ; I use the org-diary features | 660 | '((daily today require-timed) |
598 | org-agenda-todo-ignore-deadlines 'near | 661 | (800 1000 1200 1400 1600 1800 2000) |
599 | org-agenda-todo-ignore-scheduled 'future | 662 | " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄") |
600 | org-agenda-include-deadlines t | 663 | org-agenda-current-time-string |
601 | org-deadline-warning-days 0 | 664 | "← now ─────────────────────────────────────────────────" |
602 | org-agenda-show-future-repeats 'next | 665 | org-agenda-include-diary nil ; I use the org-diary features |
603 | org-agenda-window-setup 'current-window | 666 | org-agenda-todo-ignore-deadlines 'near |
604 | org-agenda-file-skip-regexp "sync-conflict") | 667 | org-agenda-todo-ignore-scheduled 'future |
605 | (defcustom org-agenda-file-skip-regexp nil | 668 | org-agenda-include-deadlines t |
606 | "Files matching this regexp are removed from `org-agenda-files'." | 669 | org-deadline-warning-days 0 |
607 | :group 'org-agenda) | 670 | org-agenda-show-future-repeats 'next |
608 | (define-advice org-agenda-files (:filter-return (files) skip-regexp) | 671 | org-agenda-window-setup 'current-window |
609 | (when org-agenda-file-skip-regexp | 672 | org-agenda-file-skip-regexp "sync-conflict") |
610 | (setq files (seq-remove (lambda (file) | 673 | (defcustom org-agenda-file-skip-regexp nil |
611 | (string-match-p org-agenda-file-skip-regexp | 674 | "Files matching this regexp are removed from `org-agenda-files'." |
612 | file)) | 675 | :group 'org-agenda) |
613 | files))) | 676 | (define-advice org-agenda-files (:filter-return (files) skip-regexp) |
614 | files) | 677 | (when org-agenda-file-skip-regexp |
615 | (setq-local-hook org-agenda-mode-hook | 678 | (setq files (seq-remove (lambda (file) |
616 | truncate-lines t | 679 | (string-match-p org-agenda-file-skip-regexp |
617 | electric-pair-pairs (append electric-pair-pairs | 680 | file)) |
618 | (mapcar (lambda (e) | 681 | files))) |
619 | (let ((ch (string-to-char (car e)))) | 682 | files) |
620 | (cons ch ch))) | 683 | (setq-local-hook org-agenda-mode-hook |
621 | org-emphasis-alist))) | 684 | truncate-lines t) |
622 | (add-hook* 'org-agenda-mode-hook | 685 | (add-hook 'org-agenda-mode-hook #'hl-line-mode) |
623 | #'hl-line-mode) | 686 | (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) |
624 | (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree) | 687 | (defkeys t |
625 | (define-key* (current-global-map) | 688 | "C-c c" #'org-capture |
626 | "C-c c" #'org-capture | 689 | "C-c a" #'org-agenda) |
627 | "C-c a" #'org-agenda) | 690 | (eval-after org-capture |
628 | (eval-after org-capture | 691 | (require '+org-capture))) |
629 | '+org-capture)) | ||
630 | 692 | ||
631 | (yoke ox ; org-export | 693 | (yoke ox ; org-export |
632 | (eval-after org (require 'ox)) | 694 | (eval-after org (require 'ox)) |
@@ -650,12 +712,13 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
650 | :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" | 712 | :depends ((bbdb "https://git.savannah.nongnu.org/git/bbdb.git" |
651 | :load "lisp") | 713 | :load "lisp") |
652 | (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) | 714 | (bbdb-vcard "https://github.com/tohojo/bbdb-vcard/")) |
653 | (setf bbdb-complete-mail-allow-cycling t) | 715 | (setf bbdb-complete-mail-allow-cycling t |
654 | (add-hook* '+custom-after-load-hook | 716 | bbdb-file (private/ "bbdb")) |
655 | (defun _work@after-custom () | 717 | (defhook +custom-after-load-hook |
656 | (require* 'private '_work) | 718 | :name _work@after-custom |
657 | (require* 'bbdb 'bbdb-message) | 719 | (require* 'private '_work) |
658 | (bbdb-initialize 'gnus 'message)))) | 720 | (require* 'bbdb 'bbdb-message) |
721 | (bbdb-initialize 'gnus 'message))) | ||
659 | 722 | ||
660 | (yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el")) | 723 | (yoke (org-taskwise "https://codeberg.org/acdw/org-taskwise.el")) |
661 | 724 | ||
@@ -668,8 +731,8 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
668 | map) | 731 | map) |
669 | "Keymap for scule twiddling.") | 732 | "Keymap for scule twiddling.") |
670 | (define-key* (current-global-map) | 733 | (define-key* (current-global-map) |
671 | "M-c" scule-map | 734 | "M-c" scule-map |
672 | "M-u" #'universal-argument) | 735 | "M-u" #'universal-argument) |
673 | (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) | 736 | (define-key universal-argument-map (kbd "M-u") #'universal-argument-more)) |
674 | 737 | ||
675 | (yoke (titlecase "https://codeberg.org/acdw/titlecase.el") | 738 | (yoke (titlecase "https://codeberg.org/acdw/titlecase.el") |
@@ -680,17 +743,17 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
680 | word-boundary))) | 743 | word-boundary))) |
681 | (eval-after scule | 744 | (eval-after scule |
682 | (define-key* scule-map | 745 | (define-key* scule-map |
683 | "M-t" #'titlecase-dwim))) | 746 | "M-t" #'titlecase-dwim))) |
684 | 747 | ||
685 | (yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct") | 748 | (yoke (flyspell-correct "https://github.com/duckwork/flyspell-correct") |
686 | (eval-after flyspell | 749 | (eval-after flyspell |
687 | (require* 'flyspell-correct | 750 | (require* 'flyspell-correct |
688 | `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) | 751 | `(+flyspell-correct ,(locate-user-emacs-file "lisp/+flyspell-correct"))) |
689 | (define-key* flyspell-mode-map | 752 | (define-key* flyspell-mode-map |
690 | "C-;" #'flyspell-correct-wrapper | 753 | "C-;" #'flyspell-correct-wrapper |
691 | "<f7>" #'+flyspell-correct-buffer | 754 | "<f7>" #'+flyspell-correct-buffer |
692 | "C-," nil | 755 | "C-," nil |
693 | "C-." nil)) | 756 | "C-." nil)) |
694 | (add-hook 'org-mode-hook #'flyspell-mode) | 757 | (add-hook 'org-mode-hook #'flyspell-mode) |
695 | (setq flyspell-correct--cr-key ";")) | 758 | (setq flyspell-correct--cr-key ";")) |
696 | 759 | ||
@@ -699,51 +762,54 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
699 | (f "https://github.com/rejeep/f.el") | 762 | (f "https://github.com/rejeep/f.el") |
700 | (s "https://github.com/magnars/s.el") | 763 | (s "https://github.com/magnars/s.el") |
701 | (elisp-refs "https://github.com/Wilfred/elisp-refs")) | 764 | (elisp-refs "https://github.com/Wilfred/elisp-refs")) |
702 | (define-key* (current-global-map) | 765 | (defkeys t |
703 | "<f1> f" #'helpful-callable | 766 | "<f1> f" #'helpful-callable |
704 | "<f1> v" #'helpful-variable | 767 | "<f1> v" #'helpful-variable |
705 | "<f1> k" #'helpful-key | 768 | "<f1> k" #'helpful-key |
706 | "<f1> ." #'helpful-at-point | 769 | "<f1> ." #'helpful-at-point |
707 | "<f1> o" #'helpful-symbol) | 770 | "<f1> o" #'helpful-symbol) |
708 | (unless (featurep 'info-look) | 771 | (unless (featurep 'info-look) |
709 | (run-with-idle-timer 1 nil (lambda () | 772 | (run-with-idle-timer 5 nil (lambda () |
710 | (require 'info-look) | 773 | (require 'info-look) |
711 | (let ((inhibit-message t)) | 774 | (let ((inhibit-message t)) |
712 | (info-lookup-setup-mode 'symbol | 775 | (info-lookup-setup-mode 'symbol |
713 | 'emacs-lisp-mode))))) | 776 | 'emacs-lisp-mode))))) |
714 | (setf (alist-get "\\*helpful" display-buffer-alist nil nil #'string=) | 777 | (defhook window-configuration-change-hook |
715 | '((display-buffer-in-side-window) | 778 | :name side-window-setup |
716 | (side . bottom) | 779 | (setf fit-window-to-buffer-horizontally t |
717 | (window-height . 20)))) | 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))))))) | ||
718 | 786 | ||
719 | (yoke (hippie-completing-read | 787 | (yoke (hippie-completing-read |
720 | "https://codeberg.org/acdw/hippie-completing-read.el") | 788 | "https://codeberg.org/acdw/hippie-completing-read.el") |
721 | (define-key* (current-global-map) | 789 | (define-key* (current-global-map) |
722 | "M-/" #'hippie-completing-read)) | 790 | "M-/" #'hippie-completing-read)) |
723 | 791 | ||
724 | (yoke dictionary ; Comes with Emacs 29! | 792 | (yoke dictionary ; Comes with Emacs 29! |
725 | (setq dictionary-server (if (or (executable-find "dictd") | 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") | ||
726 | (file-exists-p "/usr/sbin/dictd")) ; oh debian | 798 | (file-exists-p "/usr/sbin/dictd")) ; oh debian |
727 | "localhost" | 799 | "localhost" |
728 | "dict.org")) | 800 | "dict.org")) |
729 | (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) | 801 | (setf (alist-get "^\\*Dictionary\\*" display-buffer-alist nil nil #'string=) |
730 | '((display-buffer-in-side-window) | 802 | '((display-buffer-in-side-window) |
731 | (side . bottom) | 803 | (side . bottom) |
732 | (window-height . 20))) | 804 | (window-height . 20)))) |
733 | (eval-after org | ||
734 | (define-key* org-mode-map | ||
735 | "M-@" #'dictionary-search)) | ||
736 | (eval-after embark | ||
737 | (define-key* embark-identifier-map | ||
738 | "@" #'dictionary-search))) | ||
739 | 805 | ||
740 | (yoke (anzu "https://github.com/emacsorphanage/anzu") | 806 | (yoke (anzu "https://github.com/emacsorphanage/anzu") |
741 | (require 'anzu) | 807 | (require 'anzu) |
742 | (global-anzu-mode) | 808 | (global-anzu-mode) |
743 | (define-key* (current-global-map) | 809 | (defkeys t |
744 | [remap query-replace] #'anzu-query-replace-regexp | 810 | [remap query-replace] #'anzu-query-replace-regexp |
745 | [remap query-replace-regexp] #'anzu-query-replace) | 811 | [remap query-replace-regexp] #'anzu-query-replace) |
746 | (define-key* isearch-mode-map | 812 | (defkeys (isearch-mode-map (isearch-mb-minibuffer-map :after isearch-mb)) |
747 | [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp | 813 | [remap isearch-query-replace] #'anzu-isearch-query-replace-regexp |
748 | [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace) | 814 | [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace) |
749 | (defun anzu-qr@window (fn &rest r) | 815 | (defun anzu-qr@window (fn &rest r) |
@@ -768,10 +834,13 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
768 | (funcall fn server uri)) | 834 | (funcall fn server uri)) |
769 | (eval-after embark | 835 | (eval-after embark |
770 | (define-key* embark-region-map | 836 | (define-key* embark-region-map |
771 | "U" #'0x0-dwim))) | 837 | "U" #'0x0-dwim))) |
772 | 838 | ||
773 | (yoke (filldent "https://codeberg.org/acdw/filldent.el") | 839 | (yoke (filldent "https://codeberg.org/acdw/filldent.el") |
774 | (define-key* (current-global-map) | 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 | ||
775 | "M-q" #'filldent-unfill-toggle)) | 844 | "M-q" #'filldent-unfill-toggle)) |
776 | 845 | ||
777 | (yoke (avy "https://github.com/abo-abo/avy") | 846 | (yoke (avy "https://github.com/abo-abo/avy") |
@@ -787,9 +856,9 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
787 | (cdr (ring-ref avy-ring 0)))) | 856 | (cdr (ring-ref avy-ring 0)))) |
788 | t)) | 857 | t)) |
789 | (define-key* (current-global-map) | 858 | (define-key* (current-global-map) |
790 | "M-j" #'avy-goto-char-timer) | 859 | "M-j" #'avy-goto-char-timer) |
791 | (define-key* isearch-mode-map | 860 | (define-key* isearch-mode-map |
792 | "M-j" #'avy-isearch)) | 861 | "M-j" #'avy-isearch)) |
793 | 862 | ||
794 | (yoke (frowny "https://codeberg.org/acdw/frowny.el") | 863 | (yoke (frowny "https://codeberg.org/acdw/frowny.el") |
795 | (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) | 864 | (setf frowny-eyes (rx (any ":=") (opt "'") (? "-"))) |
@@ -847,23 +916,29 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
847 | (eval-after elisp-mode (require 'macrostep)) | 916 | (eval-after elisp-mode (require 'macrostep)) |
848 | (define-key* '(emacs-lisp-mode-map | 917 | (define-key* '(emacs-lisp-mode-map |
849 | lisp-interaction-mode-map) | 918 | lisp-interaction-mode-map) |
850 | "C-c e" #'macrostep-expand)) | 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)) | ||
851 | 929 | ||
852 | (yoke (embrace "https://github.com/cute-jumper/embrace.el") | 930 | (yoke (embrace "https://github.com/cute-jumper/embrace.el") |
853 | :depends ((expand-region "https://github.com/magnars/expand-region.el")) | 931 | :depends ((expand-region "https://github.com/magnars/expand-region.el")) |
854 | (define-key* (current-global-map) | 932 | (defkeys t |
855 | "C-=" #'er/expand-region | 933 | "C-\"" #'embrace-commander) |
856 | "C-," #'embrace-commander) | ||
857 | (eval-after org | ||
858 | (define-key* org-mode-map | ||
859 | "C-=" #'er/expand-region | ||
860 | "C-," #'embrace-commander)) | ||
861 | (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) | 934 | (dolist (fnhook '((org-mode-hook embrace-org-mode-hook) |
862 | (ruby-mode-hook embrace-ruby-mode-hook) | 935 | (ruby-mode-hook embrace-ruby-mode-hook) |
863 | (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) | 936 | (emacs-lisp-mode-hook embrace-emacs-lisp-mode-hook) |
864 | (latex-mode-hook embrace-LaTeX-mode-hook))) | 937 | (latex-mode-hook embrace-LaTeX-mode-hook))) |
865 | (apply #'add-hook fnhook)) | 938 | (apply #'add-hook fnhook)) |
866 | (eval-after org | 939 | (eval-after org |
940 | (defkeys org-mode-map | ||
941 | "C-\"" #'embrace-commander) | ||
867 | (defmacro org-insert-or-embrace (char) | 942 | (defmacro org-insert-or-embrace (char) |
868 | "Define a function to insert CHAR, or `embrace' the region with it." | 943 | "Define a function to insert CHAR, or `embrace' the region with it." |
869 | (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) | 944 | (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char))) |
@@ -880,12 +955,12 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
880 | (forward-char 1)) | 955 | (forward-char 1)) |
881 | (self-insert-command n ,char))))) | 956 | (self-insert-command n ,char))))) |
882 | (define-key* org-mode-map | 957 | (define-key* org-mode-map |
883 | "*" (org-insert-or-embrace "*") | 958 | "*" (org-insert-or-embrace "*") |
884 | "/" (org-insert-or-embrace "/") | 959 | "/" (org-insert-or-embrace "/") |
885 | "_" (org-insert-or-embrace "_") | 960 | "_" (org-insert-or-embrace "_") |
886 | "=" (org-insert-or-embrace "=") | 961 | "=" (org-insert-or-embrace "=") |
887 | "~" (org-insert-or-embrace "~") | 962 | "~" (org-insert-or-embrace "~") |
888 | "+" (org-insert-or-embrace "+")))) | 963 | "+" (org-insert-or-embrace "+")))) |
889 | 964 | ||
890 | (yoke (notmuch "~/usr/share/emacs/site-lisp") | 965 | (yoke (notmuch "~/usr/share/emacs/site-lisp") |
891 | (eval-after bbdb | 966 | (eval-after bbdb |
@@ -897,10 +972,13 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
897 | notmuch-address-use-company (featurep 'company) | 972 | notmuch-address-use-company (featurep 'company) |
898 | notmuch-search-oldest-first nil | 973 | notmuch-search-oldest-first nil |
899 | notmuch-archive-tags '("-inbox" "-unread") | 974 | notmuch-archive-tags '("-inbox" "-unread") |
900 | notmuch-draft-tags '("+draft" "-inbox" "-unread")) | 975 | notmuch-draft-tags '("+draft" "-inbox" "-unread") |
976 | mail-user-agent 'notmuch-user-agent | ||
977 | bbdb-mail-user-agent 'notmuch-user-agent | ||
978 | message-mail-user-agent t) | ||
901 | (define-key* (current-global-map) | 979 | (define-key* (current-global-map) |
902 | "C-c m" #'notmuch-mua-new-mail | 980 | "C-c m" #'notmuch-mua-new-mail |
903 | "C-c n" #'+notmuch-goto) | 981 | "C-c n" #'+notmuch-goto) |
904 | ;; Reading mail | 982 | ;; Reading mail |
905 | (setf notmuch-show-indent-content nil) | 983 | (setf notmuch-show-indent-content nil) |
906 | (add-hook* '(notmuch-show-mode-hook | 984 | (add-hook* '(notmuch-show-mode-hook |
@@ -908,11 +986,15 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
908 | #'visual-fill-column-mode) | 986 | #'visual-fill-column-mode) |
909 | (eval-after notmuch | 987 | (eval-after notmuch |
910 | (define-key* notmuch-search-mode-map | 988 | (define-key* notmuch-search-mode-map |
911 | "RET" #'notmuch-search-show-thread | 989 | "RET" #'notmuch-search-show-thread |
912 | "M-RET" #'notmuch-tree-from-search-thread | 990 | "M-RET" #'notmuch-tree-from-search-thread |
913 | "!" #'+notmuch-search-mark-spam) | 991 | "!" #'+notmuch-search-mark-spam) |
914 | (define-key* notmuch-tree-mode-map | 992 | (define-key* notmuch-tree-mode-map |
915 | "!" #'+notmuch-search-mark-spam-then-next)) | 993 | "!" #'+notmuch-search-mark-spam-then-next |
994 | "M-<" (notmuch-tree--define-do-in-message-window | ||
995 | notmuch-tree-beginning-of-message beginning-of-buffer) | ||
996 | "M->" (notmuch-tree--define-do-in-message-window | ||
997 | notmuch-tree-end-of-message end-of-buffer))) | ||
916 | ;; Writing mail | 998 | ;; Writing mail |
917 | (setf message-kill-buffer-on-exit t | 999 | (setf message-kill-buffer-on-exit t |
918 | message-auto-save-directory nil) | 1000 | message-auto-save-directory nil) |
@@ -935,7 +1017,24 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
935 | (advice-add 'notmuch-bury-or-kill-this-buffer :after | 1017 | (advice-add 'notmuch-bury-or-kill-this-buffer :after |
936 | (defun +display-time@notmuch (&rest _) | 1018 | (defun +display-time@notmuch (&rest _) |
937 | ;; (display-time-event-handler) | 1019 | ;; (display-time-event-handler) |
938 | (display-time-update))) | 1020 | (setq display-time-mail-string |
1021 | (replace-regexp-in-string "(.*)" | ||
1022 | (format "(%s)" (+notmuch-new-mail-p)) | ||
1023 | display-time-mail-string)) | ||
1024 | (display-time-update) | ||
1025 | (force-mode-line-update))) | ||
1026 | (add-to-list 'notmuch-message-headers "List-Post" :append) | ||
1027 | (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware) | ||
1028 | "Make `notmuch-mua-new-reply' list-aware." | ||
1029 | (let ((ml (notmuch-show-get-header :List-Post))) | ||
1030 | (apply orig r) | ||
1031 | (when ml | ||
1032 | (with-buffer-modified-unmodified | ||
1033 | (message-remove-header "To") | ||
1034 | (message-add-header | ||
1035 | (format "To: %s" | ||
1036 | (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1" ml))) | ||
1037 | (message-goto-body))))) | ||
939 | (setf notmuch-saved-searches (list | 1038 | (setf notmuch-saved-searches (list |
940 | (list :name "inbox+unread" | 1039 | (list :name "inbox+unread" |
941 | :query (+notmuch-query-concat | 1040 | :query (+notmuch-query-concat |
@@ -1012,8 +1111,8 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1012 | :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds") | 1111 | :depends ((frame-cmds "https://github.com/emacsmirror/frame-cmds") |
1013 | (frame-fns "https://github.com/emacsmirror/frame-fns")) | 1112 | (frame-fns "https://github.com/emacsmirror/frame-fns")) |
1014 | (define-key* (current-global-map) | 1113 | (define-key* (current-global-map) |
1015 | "M-+" #'zoom-frm-in | 1114 | "M-+" #'zoom-frm-in |
1016 | "M-_" #'zoom-frm-out)) | 1115 | "M-_" #'zoom-frm-out)) |
1017 | 1116 | ||
1018 | (yoke (jabber "https://codeberg.org/acdw/emacs-jabber") | 1117 | (yoke (jabber "https://codeberg.org/acdw/emacs-jabber") |
1019 | :depends ((srv "https://github.com/legoscia/srv.el") | 1118 | :depends ((srv "https://github.com/legoscia/srv.el") |
@@ -1045,21 +1144,23 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1045 | ;; (replace-regexp-in-string "%.*" "" s)) | 1144 | ;; (replace-regexp-in-string "%.*" "" s)) |
1046 | ;; (:else s))))) | 1145 | ;; (:else s))))) |
1047 | ;; jids)) | 1146 | ;; jids)) |
1048 | jabber-rare-time-format " - - - - - - %H:00 %F") | 1147 | jabber-rare-time-format " - - - - - - %H:%M %F") |
1049 | (defun +electric-pair-disable-local-mode () | 1148 | (defhook (jabber-chat-mode-hook |
1050 | (electric-pair-local-mode -1)) | 1149 | jabber-browse-mode-hook |
1051 | (add-hook* '(jabber-chat-mode-hook | 1150 | jabber-roster-mode-hook |
1052 | jabber-browse-mode-hook | 1151 | jabber-console-mode-hook) |
1053 | jabber-roster-mode-hook | 1152 | :name jabber-ui-setup |
1054 | jabber-console-mode-hook) | 1153 | (electric-pair-local-mode -1) |
1055 | #'visual-fill-column-mode | 1154 | (auto-fill-mode -1) |
1056 | #'+electric-pair-disable-local-mode) | 1155 | #'visual-fill-column-mode) |
1156 | (setq-local-hook jabber-chat-mode-hook | ||
1157 | wrap-prefix (format "%13s" " ")) | ||
1057 | (defun +jabber-fix-keybinds-dammit () | 1158 | (defun +jabber-fix-keybinds-dammit () |
1058 | "Jabber autoloads keybinds which is really annoying." | 1159 | "Jabber autoloads keybinds which is really annoying." |
1059 | (define-key* (current-global-map) | 1160 | (define-key* (current-global-map) |
1060 | "C-x C-j" #'dired-jump | 1161 | "C-x C-j" #'dired-jump |
1061 | "C-c j" jabber-global-keymap | 1162 | "C-c j" jabber-global-keymap |
1062 | "C-c C-SPC" #'jabber-activity-switch-to)) | 1163 | "C-c C-SPC" #'jabber-activity-switch-to)) |
1063 | (eval-after init (+jabber-fix-keybinds-dammit)) | 1164 | (eval-after init (+jabber-fix-keybinds-dammit)) |
1064 | (eval-after jabber | 1165 | (eval-after jabber |
1065 | (require 'jabber-httpupload nil :noerror) | 1166 | (require 'jabber-httpupload nil :noerror) |
@@ -1076,25 +1177,25 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1076 | (hi-lock-unface-buffer regexp) | 1177 | (hi-lock-unface-buffer regexp) |
1077 | (highlight-regexp regexp 'hi-blue)))))) | 1178 | (highlight-regexp regexp 'hi-blue)))))) |
1078 | (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) | 1179 | (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus) |
1079 | (+jabber-fix-keybinds-dammit)) | 1180 | (+jabber-fix-keybinds-dammit) |
1080 | ;; (add-hook* 'jabber-activity-mode-hook | 1181 | (defkeys jabber-chat-mode-map |
1081 | ;; (defun +jabber-activity-mode@move-to-end-of-mode-line () | 1182 | "C-l" (defun +jabber-recenter-last-read () |
1082 | ;; (setf global-mode-string | 1183 | (interactive) |
1083 | ;; (append (delete '(t jabber-activity-mode-string) | 1184 | (cond |
1084 | ;; global-mode-string) | 1185 | ((eq last-command '+jabber-recenter-last-read) |
1085 | ;; '((t jabber-activity-mode-string)))))) | 1186 | (setq this-command #'recenter) |
1086 | (setq-local-hook jabber-chat-mode-hook | 1187 | (recenter -1)) |
1087 | wrap-prefix (format "%10s " " ") | 1188 | (:else |
1088 | mode-line-buffer-identification | 1189 | (save-excursion |
1089 | (pcase (buffer-name) | 1190 | (condition-case e |
1090 | ((rx "%") ; biboumi irc channel | 1191 | (re-search-backward jabber-last-read-marker) |
1091 | ;; xmpp-muc:#scheme%irc.libera.chat@irc.hmm.st | 1192 | (search-failed nil) |
1092 | (propertized-buffer-identification | 1193 | (:success |
1093 | (replace-regexp-in-string "xmpp-muc:\\([^%]*\\)%\\([^@]*\\)@.*" | 1194 | (recenter 3))))))))) |
1094 | "\\1@\\2" | 1195 | (defun jabber-chat-kill-buffers () |
1095 | (buffer-name)))) | 1196 | "Kill all `jabber-chat-mode' buffers." |
1096 | (_ ; xmpp channel | 1197 | (interactive) |
1097 | (propertized-buffer-identification "%12b")))) | 1198 | (mapc-buffers (lambda () (message "%S" (buffer-name))) '(jabber-chat-mode))) |
1098 | (defun jabber-chat@after-modus-themes-load () | 1199 | (defun jabber-chat@after-modus-themes-load () |
1099 | (modus-themes-with-colors | 1200 | (modus-themes-with-colors |
1100 | (custom-set-faces | 1201 | (custom-set-faces |
@@ -1147,26 +1248,26 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1147 | link-hint-avy-all-windows t) | 1248 | link-hint-avy-all-windows t) |
1148 | (global-set-key (kbd "M-l") +link-hint-map) | 1249 | (global-set-key (kbd "M-l") +link-hint-map) |
1149 | (define-key* +link-hint-map | 1250 | (define-key* +link-hint-map |
1150 | "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link | 1251 | "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link |
1151 | "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary | 1252 | "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary |
1152 | "M-m" #'+link-hint-open-multiple-links "m" #'+link-hint-open-multiple-links | 1253 | "M-m" #'+link-hint-open-multiple-links "m" #'+link-hint-open-multiple-links |
1153 | "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link | 1254 | "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link |
1154 | "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)) | 1255 | "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)) |
1155 | 1256 | ||
1156 | (yoke (elpher "git://thelambdalab.xyz/elpher.git") | 1257 | (yoke (elpher "git://thelambdalab.xyz/elpher.git") |
1157 | (eval-after elpher | 1258 | (eval-after elpher |
1158 | (define-key* elpher-mode-map | 1259 | (define-key* elpher-mode-map |
1159 | "l" #'elpher-back))) | 1260 | "l" #'elpher-back))) |
1160 | 1261 | ||
1161 | (yoke (epithet "https://github.com/oantolin/epithet") | 1262 | (yoke (epithet "https://github.com/oantolin/epithet") |
1162 | (add-hook* '(Info-selection-hook | 1263 | (defhook (Info-selection-hook |
1163 | help-mode-hook | 1264 | help-mode-hook |
1164 | occur-mode-hook | 1265 | occur-mode-hook |
1165 | shell-mode-hook) | 1266 | shell-mode-hook) |
1166 | #'epithet-rename-buffer) | 1267 | #'epithet-rename-buffer) |
1167 | (cond ((boundp 'eww-auto-rename-buffer) | 1268 | (cond ((boundp 'eww-auto-rename-buffer) |
1168 | (setf eww-auto-rename-buffer 'title)) | 1269 | (setc eww-auto-rename-buffer 'title)) |
1169 | (:else (add-hook 'eww-after-render-hook #'epithet-rename-buffer)))) | 1270 | (:else (defhook eww-after-render-hook #'epithet-rename-buffer)))) |
1170 | 1271 | ||
1171 | (yoke browse-url | 1272 | (yoke browse-url |
1172 | (require '+browse-url) | 1273 | (require '+browse-url) |
@@ -1183,7 +1284,12 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1183 | (music-url-p . +browse-url-with-mpv) | 1284 | (music-url-p . +browse-url-with-mpv) |
1184 | (image-url-p . +browse-image-with-mpv) | 1285 | (image-url-p . +browse-image-with-mpv) |
1185 | (blobp . +browse-url-download) | 1286 | (blobp . +browse-url-download) |
1186 | (external-url-p . ,browse-url-secondary-browser-function))) | 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))) | ||
1187 | (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" | 1293 | (+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30" |
1188 | "--cache-pause-initial=yes") | 1294 | "--cache-pause-initial=yes") |
1189 | "Video URL: " | 1295 | "Video URL: " |
@@ -1197,17 +1303,19 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1197 | url)) | 1303 | url)) |
1198 | (defun music-url-p (url) "Is URL music?" | 1304 | (defun music-url-p (url) "Is URL music?" |
1199 | (string-match-p (rx "soundcloud.com" "bandcamp.com" | 1305 | (string-match-p (rx "soundcloud.com" "bandcamp.com" |
1200 | (seq "." (or "ogg" "mp3" "opus" "m4a") eos)) | 1306 | (seq "." (or "ogg" "mp3" "opus" "m4a" "flac") eos)) |
1201 | url)) | 1307 | url)) |
1202 | (defun image-url-p (url) "Is URL an image?" | 1308 | (defun image-url-p (url) "Is URL an image?" |
1203 | (string-match-p (rx "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) | 1309 | (string-match-p (rx |
1310 | (or (: "." (or "jpeg" "jpg" "png" "bmp" "webp") eos) | ||
1311 | "pbs.twimg.com")) | ||
1204 | url)) | 1312 | url)) |
1205 | (defun external-url-p (url) "Should URL open in an external browser?" | 1313 | (defun external-url-p (url) "Should URL open in an external browser?" |
1206 | (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org" | 1314 | (string-match-p (rx (or "github.com" "gitlab.com" "codeberg.org" |
1207 | "tildegit.org" "git.tilde.town" "google.com" | 1315 | "tildegit.org" "git.tilde.town" "google.com" |
1208 | "imgur.com" "twitch.tv" "pixelfed" "instagram.com" | 1316 | "imgur.com" "twitch.tv" "pixelfed" "instagram.com" |
1209 | "bibliogram.art" "reddit.com" "teddit.net" | 1317 | "bibliogram.art" "reddit.com" "teddit.net" |
1210 | "twitter.com" "nitter" "t.co" | 1318 | ;; "twitter.com" "nitter" "t.co" |
1211 | "streamable.com" "spotify.com" | 1319 | "streamable.com" "spotify.com" |
1212 | "hetzner.cloud" "melpa.org")) | 1320 | "hetzner.cloud" "melpa.org")) |
1213 | url)) | 1321 | url)) |
@@ -1216,38 +1324,74 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1216 | eos))) | 1324 | eos))) |
1217 | url)) | 1325 | url)) |
1218 | (eval-after chd | 1326 | (eval-after chd |
1219 | (add-to-list 'browse-url-handlers (cons chd/url-regexps #'browse-url-chrome))) | 1327 | (add-to-list 'browse-url-handlers (cons chd/url-regexps #'chd/browse-url))) |
1220 | (require 'browse-url-transform) | 1328 | (require 'browse-url-transform) |
1221 | (setf browse-url-transform-alist `(("twitter\\.com" . "nitter.net") | 1329 | (setf browse-url-transform-alist `(;; Privacy-respecting alternatives |
1330 | ("twitter\\.com" . "nitter.snopyta.org") | ||
1222 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" | 1331 | ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" |
1223 | . "libreddit.de") | 1332 | . "libreddit.de") |
1224 | ("medium\\.com" . "scribe.rip") | 1333 | ("medium\\.com" . "scribe.rip") |
1225 | ("www\\.npr\\.org" . "text.npr.org"))) | 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/"))) | ||
1226 | (browse-url-transform-mode)) | 1345 | (browse-url-transform-mode)) |
1227 | 1346 | ||
1228 | (yoke eww | 1347 | (yoke eww |
1229 | (defun +eww-browse-with-external-browser (&optional url) | 1348 | (setc eww-use-browse-url ".") |
1230 | "Browse URL with an external browser and close eww." | 1349 | (eval-after eww |
1231 | (interactive nil eww-mode) | 1350 | (defhook eww-mode-hook |
1232 | (condition-case e | 1351 | #'visual-fill-column-mode |
1233 | ;; This is wrapped in a `condition-case' so that the eww window won't | 1352 | (defhook ((visual-fill-column-mode-hook nil :local)) |
1234 | ;; close if there's an error calling the browser. | 1353 | :name eww-mode-refresh@visual-fill-column |
1235 | (funcall browse-url-secondary-browser-function | 1354 | (eww-reload t))) |
1236 | (or url (plist-get eww-data :url))) | 1355 | (defkeys eww-mode-map |
1237 | (:success | 1356 | "&" |
1238 | (when (null url) ; interactive | 1357 | (defun +eww-browse-with-external-browser (&optional url) |
1239 | (quit-window))) | 1358 | "Browse URL with an external browser and close eww." |
1240 | (t (signal (car e) (cdr e))))) | 1359 | (interactive nil eww-mode) |
1241 | (define-key* eww-mode-map | 1360 | (condition-case e |
1242 | "&" #'+eww-browse-with-external-browser)) | 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))) | ||
1243 | 1372 | ||
1244 | (yoke tab-bar | 1373 | (yoke tab-bar |
1245 | (setf tab-bar-show t | 1374 | (setf tab-bar-show t |
1246 | global-mode-string | 1375 | global-mode-string |
1247 | '((jabber-activity-mode jabber-activity-mode-string) | 1376 | '((jabber-activity-mode |
1248 | " ⋅" | 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)) " ⋅" ""))))) | ||
1249 | display-time-string | 1382 | display-time-string |
1250 | "|")) | 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 | "|")))) | ||
1251 | (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) | 1395 | (add-to-list 'tab-bar-format 'tab-bar-format-align-right :append) |
1252 | (add-to-list 'tab-bar-format 'tab-bar-format-global :append) | 1396 | (add-to-list 'tab-bar-format 'tab-bar-format-global :append) |
1253 | (tab-bar-mode)) | 1397 | (tab-bar-mode)) |
@@ -1257,3 +1401,27 @@ CAPES defaults to `+capes'. CAPF will be made un-exclusive." | |||
1257 | :depends ((tablist "https://github.com/politza/tablist/")) | 1401 | :depends ((tablist "https://github.com/politza/tablist/")) |
1258 | :when (executable-find "epdfinfo") ; installed from Debian repos | 1402 | :when (executable-find "epdfinfo") ; installed from Debian repos |
1259 | (pdf-tools-install)) | 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/+emacs.el b/lisp/+emacs.el index 870e4e2..97377a3 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el | |||
@@ -55,7 +55,7 @@ Do this only if the buffer is not visiting a file." | |||
55 | cursor-type 'bar | 55 | cursor-type 'bar |
56 | custom-file (.etc "custom.el") | 56 | custom-file (.etc "custom.el") |
57 | delete-old-versions t | 57 | delete-old-versions t |
58 | echo-keystrokes 0.1 | 58 | echo-keystrokces 0.1 |
59 | ediff-window-setup-function 'ediff-setup-windows-plain | 59 | ediff-window-setup-function 'ediff-setup-windows-plain |
60 | eldoc-echo-area-use-multiline-p nil | 60 | eldoc-echo-area-use-multiline-p nil |
61 | eldoc-idle-delay 0.1 | 61 | eldoc-idle-delay 0.1 |
@@ -103,7 +103,7 @@ Do this only if the buffer is not visiting a file." | |||
103 | ;; 'command-completion-default-include-p) | 103 | ;; 'command-completion-default-include-p) |
104 | ;; '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 | 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) | 106 | recenter-positions '(top 2 middle bottom) |
107 | regexp-search-ring-max 100 | 107 | regexp-search-ring-max 100 |
108 | regexp-search-ring-max 200 | 108 | regexp-search-ring-max 200 |
109 | save-interprogram-paste-before-kill t | 109 | save-interprogram-paste-before-kill t |
@@ -239,7 +239,7 @@ spaces. If N is negative, it will not delete newlines and leave | |||
239 | N spaces. See docstring of `cycle-spacing' for the meaning of | 239 | N spaces. See docstring of `cycle-spacing' for the meaning of |
240 | PRESERVE-NL-BACK and MODE." | 240 | PRESERVE-NL-BACK and MODE." |
241 | (interactive "*p") | 241 | (interactive "*p") |
242 | (cycle-spacing (- n) preserve-nl-back mode)) | 242 | (cycle-spacing (- n))) |
243 | 243 | ||
244 | (defun +save-buffers-quit (&optional arg) | 244 | (defun +save-buffers-quit (&optional arg) |
245 | "Silently save each buffer, then kill the current connection. | 245 | "Silently save each buffer, then kill the current connection. |
diff --git a/lisp/+org.el b/lisp/+org.el index 70962d6..7698ec9 100644 --- a/lisp/+org.el +++ b/lisp/+org.el | |||
@@ -208,4 +208,60 @@ and POST-PROCESS are passed to `org-export-to-file'." | |||
208 | ;; `org-verbatim' and `org-code' are apparently already things, so we skip them | 208 | ;; `org-verbatim' and `org-code' are apparently already things, so we skip them |
209 | ;; here. | 209 | ;; here. |
210 | 210 | ||
211 | ;;; Inhibit hooks on `org-agenda' | ||
212 | ;; It's really annoying when I call `org-agenda' and five hundred Ispell | ||
213 | ;; processes are created because I have `flyspell-mode' in the hook. This mode | ||
214 | ;; inhibits those hooks when entering the agenda, but runs them when opening the | ||
215 | ;; actual buffer. | ||
216 | |||
217 | (defun +org-agenda-inhibit-hooks (fn &rest r) | ||
218 | "Advice to inhibit hooks when entering `org-agenda'." | ||
219 | (let ((org-mode-hook nil)) | ||
220 | (apply fn r))) | ||
221 | |||
222 | (defvar-local +org-hook-has-run-p nil | ||
223 | "Whether `org-mode-hook' has run in the current buffer.") | ||
224 | |||
225 | (defun +org-agenda-switch-run-hooks (&rest _) | ||
226 | "Advice to run `org-mode-hook' when entering org-mode. | ||
227 | This should only fire when switching to a buffer from `org-agenda'." | ||
228 | (unless +org-hook-has-run-p | ||
229 | (run-hooks 'org-mode-hook) | ||
230 | (setq +org-hook-has-run-p t))) | ||
231 | |||
232 | (define-minor-mode +org-agenda-inhibit-hooks-mode | ||
233 | "Inhibit `org-mode-hook' when opening `org-agenda'." | ||
234 | :lighter " A/h" | ||
235 | :global t | ||
236 | (cond (+org-agenda-inhibit-hooks-mode | ||
237 | (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) | ||
238 | (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) | ||
239 | (:else | ||
240 | (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) | ||
241 | (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) | ||
242 | |||
243 | ;;; Drawers | ||
244 | (defun +org-hide-drawers-except-point () | ||
245 | "Hide all drawers except for the one point is in." | ||
246 | ;; Most of this bit is taken from `org-fold--hide-drawers'. | ||
247 | (let ((pt (point)) | ||
248 | (begin (point-min)) | ||
249 | (end (point-max))) | ||
250 | (save-excursion | ||
251 | (goto-char begin) | ||
252 | (while (and (< (point) end) | ||
253 | (re-search-forward org-drawer-regexp end t)) | ||
254 | (if (org-fold-folded-p nil 'drawer) | ||
255 | (goto-char (org-fold-next-folding-state-change 'drawer nil end)) | ||
256 | (let* ((drawer (org-element-at-point)) | ||
257 | (type (org-element-type drawer)) | ||
258 | (el-begin (org-element-property :begin drawer)) | ||
259 | (el-end (org-element-property :end drawer))) | ||
260 | (when (memq type '(drawer property-drawer)) | ||
261 | (org-fold-hide-drawer-toggle | ||
262 | (if (< el-begin pt el-end) 'off 'on) | ||
263 | nil drawer) | ||
264 | (goto-char el-end)))))))) | ||
265 | |||
266 | |||
211 | (provide '+org) | 267 | (provide '+org) |
diff --git a/lisp/acdw.el b/lisp/acdw.el index 75e1755..a9ef893 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,6 +1,8 @@ | |||
1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- | 1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- |
2 | ;; by C. Duckworth <acdw@acdw.net> | 2 | ;; by C. Duckworth <acdw@acdw.net> |
3 | (require 'cl-lib) | 3 | (require 'cl-lib) |
4 | ;; def.el is here | ||
5 | (require 'def) | ||
4 | 6 | ||
5 | ;;; Define both a directory and a function expanding to a file in that directory | 7 | ;;; Define both a directory and a function expanding to a file in that directory |
6 | 8 | ||
@@ -197,6 +199,22 @@ If body executes without errors, MESSAGE...Done will be displayed." | |||
197 | `(let* ((,this ,(car clauses))) | 199 | `(let* ((,this ,(car clauses))) |
198 | (if ,this ,this (either ,@(cdr clauses))))))) | 200 | (if ,this ,this (either ,@(cdr clauses))))))) |
199 | 201 | ||
202 | (defun mapc-buffers (fn &optional pred) | ||
203 | "Perform FN on buffers matching PRED. | ||
204 | If PRED is nil or absent, perform FN on all buffers. Both FN and | ||
205 | PRED are called within a `with-current-buffer' form and without | ||
206 | arguments." | ||
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 | |||
200 | ;; https://emacs.stackexchange.com/a/39324/37239 | 218 | ;; https://emacs.stackexchange.com/a/39324/37239 |
201 | ;; XXX: This shit don't work rn | 219 | ;; XXX: This shit don't work rn |
202 | (defun ignore-invisible-overlays (fn) | 220 | (defun ignore-invisible-overlays (fn) |
@@ -233,5 +251,22 @@ When called with prefix ARG, unconditionally switch buffer." | |||
233 | (switch-to-buffer (other-buffer) nil t) | 251 | (switch-to-buffer (other-buffer) nil t) |
234 | (other-window 1))) | 252 | (other-window 1))) |
235 | 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 | |||
236 | (provide 'acdw) | 271 | (provide 'acdw) |
237 | ;;; acdw.el ends here | 272 | ;;; acdw.el ends here |
diff --git a/lisp/dawn.el b/lisp/dawn.el index 806c422..30aab7c 100644 --- a/lisp/dawn.el +++ b/lisp/dawn.el | |||
@@ -1,4 +1,13 @@ | |||
1 | ;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- | 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")) | ||
2 | 11 | ||
3 | ;;; Commentary: | 12 | ;;; Commentary: |
4 | 13 | ||
@@ -12,6 +21,8 @@ | |||
12 | (require 'cl-lib) | 21 | (require 'cl-lib) |
13 | (require 'solar) | 22 | (require 'solar) |
14 | 23 | ||
24 | ;;; Timers | ||
25 | |||
15 | (defvar dawn--dawn-timer nil | 26 | (defvar dawn--dawn-timer nil |
16 | "Timer for dawn-command.") | 27 | "Timer for dawn-command.") |
17 | 28 | ||
@@ -21,16 +32,19 @@ | |||
21 | (defvar dawn--reset-timer nil | 32 | (defvar dawn--reset-timer nil |
22 | "Timer to reset dawn at midnight.") | 33 | "Timer to reset dawn at midnight.") |
23 | 34 | ||
35 | ;;; Functions | ||
36 | |||
24 | (defun dawn-encode-time (f) | 37 | (defun dawn-encode-time (f) |
25 | "Encode fractional time F." | 38 | "Encode fractional time F. |
26 | (let ((hhmm (cl-floor f)) | 39 | If F is nil, return nil." |
27 | (date (cdddr (decode-time)))) | 40 | (when f |
28 | (encode-time | 41 | (let ((hhmm (cl-floor f)) |
29 | (append (list 0 | 42 | (date (cdddr (decode-time)))) |
30 | (round (* 60 (cadr hhmm))) | 43 | (encode-time |
31 | (car hhmm) | 44 | (append (list 0 |
32 | ) | 45 | (round (* 60 (cadr hhmm))) |
33 | date)))) | 46 | (car hhmm)) |
47 | date))))) | ||
34 | 48 | ||
35 | (defun dawn-midnight () | 49 | (defun dawn-midnight () |
36 | "Return the time of the /next/ midnight." | 50 | "Return the time of the /next/ midnight." |
@@ -46,22 +60,34 @@ | |||
46 | "Return the time of today's sunset." | 60 | "Return the time of today's sunset." |
47 | (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) | 61 | (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) |
48 | 62 | ||
63 | ;;; Interface | ||
64 | |||
65 | ;;;###autoload | ||
49 | (defun dawn-schedule (dawn-command dusk-command) | 66 | (defun dawn-schedule (dawn-command dusk-command) |
50 | "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. | 67 | "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. |
51 | RESET is an argument for internal use." | 68 | Requires `calendar-longitude' and `calendar-latitude' to be set; |
69 | if they're not, it will prompt the user for them or error." | ||
52 | (when (or (null calendar-longitude) | 70 | (when (or (null calendar-longitude) |
53 | (null calendar-latitude)) | 71 | (null calendar-latitude)) |
54 | (user-error "`dawn' won't work without setting %s!" | 72 | (or (solar-setup) |
55 | (cond ((and (null calendar-longitude) | 73 | (user-error "`dawn' won't work without setting %s!" |
56 | (null calendar-latitude)) | 74 | (cond ((and (null calendar-longitude) |
57 | "`calendar-longitude' and `calendar-latitude'") | 75 | (null calendar-latitude)) |
58 | ((null calendar-longitude) | 76 | "`calendar-longitude' and `calendar-latitude'") |
59 | "`calendar-longitude'") | 77 | ((null calendar-longitude) |
60 | ((null calendar-latitude) | 78 | "`calendar-longitude'") |
61 | "`calendar-latitude'")))) | 79 | ((null calendar-latitude) |
80 | "`calendar-latitude'"))))) | ||
62 | (let ((dawn (dawn-sunrise)) | 81 | (let ((dawn (dawn-sunrise)) |
63 | (dusk (dawn-sunset))) | 82 | (dusk (dawn-sunset))) |
64 | (cond | 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 | )) | ||
65 | ((time-less-p nil dawn) | 91 | ((time-less-p nil dawn) |
66 | ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule | 92 | ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule |
67 | ;; DAWN-COMMAND and DUSK-COMMAND for later. | 93 | ;; DAWN-COMMAND and DUSK-COMMAND for later. |
@@ -76,7 +102,6 @@ RESET is an argument for internal use." | |||
76 | (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. | 102 | (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND. |
77 | (funcall dusk-command))) | 103 | (funcall dusk-command))) |
78 | ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. | 104 | ;; Schedule a reset at midnight, to re-calculate dawn/dusk times. |
79 | ;(unless reset) | ||
80 | (run-at-time (dawn-midnight) nil | 105 | (run-at-time (dawn-midnight) nil |
81 | #'dawn-schedule dawn-command dusk-command))) | 106 | #'dawn-schedule dawn-command dusk-command))) |
82 | 107 | ||
diff --git a/lisp/def.el b/lisp/def.el new file mode 100644 index 0000000..0bf91b2 --- /dev/null +++ b/lisp/def.el | |||
@@ -0,0 +1,142 @@ | |||
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. | ||
11 | If it doesn't, raise an error. ERROR-TYPE will be the type of | ||
12 | that error (defaults to `user-error'), and it and ERROR-ARGS are | ||
13 | passed 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. | ||
44 | If MAPS is nil or t, bind to `current-global-map'. Otherwise, | ||
45 | bind each of BINDINGS to the map or list of maps provided. | ||
46 | |||
47 | BINDINGS is a `setq'-style list of pairs of keys and definitions. | ||
48 | The key part of each binding can be a string, in which case it's | ||
49 | passed to `kbd', or a vector or anything else `define-key' | ||
50 | accepts in the KEY position. The definition part, likewise, can | ||
51 | be any form `define-key' accepts in that position, with this | ||
52 | addition: if the form is a `defun' form, it will be defined | ||
53 | before 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. | ||
105 | NAME and ARGS are passed to the generated `defun' form. | ||
106 | Each 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/org-word-count.el b/lisp/org-word-count.el new file mode 100644 index 0000000..d6d2598 --- /dev/null +++ b/lisp/org-word-count.el | |||
@@ -0,0 +1,297 @@ | |||
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 | ||
50 | this correction. (At some point I should correct the underlying | ||
51 | code... 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. | ||
75 | This 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 | |||
114 | Use 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. | ||
243 | Searchers to end as a maximum. | ||
244 | |||
245 | This ensures that we are in an expected state (at the first word | ||
246 | character after some non-word characters) after moving beyond | ||
247 | headlines, 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/yoke.el b/lisp/yoke.el index f9c4d49..8ca94fd 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el | |||
@@ -84,60 +84,63 @@ Execute BODY afterward. | |||
84 | append (list this next) into ret | 84 | append (list this next) into ret |
85 | finally return (cond ((eq (car (last ret)) nil) | 85 | finally return (cond ((eq (car (last ret)) nil) |
86 | (butlast ret)) | 86 | (butlast ret)) |
87 | (:else ret))))) | 87 | (:else ret)))) |
88 | `(cl-block ,pname | 88 | (r (gensym))) |
89 | (condition-case err | 89 | `(let ((,r (cl-block ,pname |
90 | (progn | 90 | (condition-case err |
91 | ;; Pass `:when' or `:unless' clauses | 91 | (progn |
92 | ,@(cond | 92 | ;; Pass `:when' or `:unless' clauses |
93 | ((and whenp unlessp) | 93 | ,@(cond |
94 | `((when (or (not ,when) ,unless) | 94 | ((and whenp unlessp) |
95 | (cl-return-from ,pname | 95 | `((when (or (not ,when) ,unless) |
96 | (format "%s (abort) :when %S :unless %S" | 96 | (cl-return-from ,pname |
97 | ',pname ',when ',unless))))) | 97 | (format "%s (abort) :when %S :unless %S" |
98 | (whenp | 98 | ',pname ',when ',unless))))) |
99 | `((unless ,when (cl-return-from ,pname | 99 | (whenp |
100 | (format "%s (abort) :when %S" | 100 | `((unless ,when (cl-return-from ,pname |
101 | ',pname ',when))))) | 101 | (format "%s (abort) :when %S" |
102 | (unlessp | 102 | ',pname ',when))))) |
103 | `((when ,unless (cl-return-from ,pname | 103 | (unlessp |
104 | (format "%s (abort) :unless %S" | 104 | `((when ,unless (cl-return-from ,pname |
105 | ',pname ',unless)))))) | 105 | (format "%s (abort) :unless %S" |
106 | ;; Evaluate `:pre' forms | 106 | ',pname ',unless)))))) |
107 | ,@pre | 107 | ;; Evaluate `:pre' forms |
108 | ;; Get prerequisite packages | 108 | ,@pre |
109 | ,@(cl-loop | 109 | ;; Get prerequisite packages |
110 | for (pkg* . yoke-get-args) in depends | 110 | ,@(cl-loop |
111 | collect `(or | 111 | for (pkg* . yoke-get-args) in depends |
112 | (let* ((pkg-spec (yoke-get ,@yoke-get-args | 112 | collect `(or |
113 | :dir ,(format "%s" pkg*))) | 113 | (let* ((pkg-spec (yoke-get ,@yoke-get-args |
114 | (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 114 | :dir ,(format "%s" pkg*))) |
115 | "") | 115 | (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load) |
116 | (car pkg-spec)))) | 116 | "") |
117 | (and dir | 117 | (car pkg-spec)))) |
118 | ,@(if autoload | 118 | (and dir |
119 | `((yoke-generate-autoloads ',pkg* dir)) | 119 | ,@(if autoload |
120 | '(t)) | 120 | `((yoke-generate-autoloads ',pkg* dir)) |
121 | (add-to-list 'yoke-dirs dir nil #'string=))) | 121 | '(t)) |
122 | (cl-return-from ,pname | 122 | (add-to-list 'yoke-dirs dir nil #'string=))) |
123 | (format "Error fetching prerequiste: %s" | 123 | (cl-return-from ,pname |
124 | ',pkg*)))) | 124 | (format "Error fetching prerequiste: %s" |
125 | ;; Download the package, generate autoloads | 125 | ',pkg*)))) |
126 | ,@(when url | 126 | ;; Download the package, generate autoloads |
127 | `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) | 127 | ,@(when url |
128 | (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) | 128 | `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg))) |
129 | "") | 129 | (,dirvar (expand-file-name (or (plist-get (cdr pkg-spec) :load) |
130 | (car pkg-spec)))) | 130 | "") |
131 | ,@(when autoload | 131 | (car pkg-spec)))) |
132 | `((yoke-generate-autoloads ',pkg ,dirvar))) | 132 | ,@(when autoload |
133 | (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) | 133 | `((yoke-generate-autoloads ',pkg ,dirvar))) |
134 | ;; Evaluate the body, optionally after the features in `:after' | 134 | (add-to-list 'yoke-dirs ,dirvar nil #'string=)))) |
135 | ,@(cond (after | 135 | ;; Evaluate the body, optionally after the features in `:after' |
136 | `((yoke-eval-after ,after ,@body))) | 136 | ,@(cond (after |
137 | (:else body))) | 137 | `((yoke-eval-after ,after ,@body))) |
138 | (:success ',package) | 138 | (:else body))) |
139 | (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) | 139 | (:success ',package) |
140 | nil))))) | 140 | (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) |
141 | nil))))) | ||
142 | (when (stringp ,r) (message "%S" ,r)) | ||
143 | ,r))) | ||
141 | 144 | ||
142 | (defun yoke-get (url &rest args) | 145 | (defun yoke-get (url &rest args) |
143 | "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. | 146 | "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. |