about summary refs log tree commit diff stats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--early-init.el2
-rw-r--r--init.el756
-rw-r--r--lisp/+emacs.el6
-rw-r--r--lisp/+org.el56
-rw-r--r--lisp/acdw.el35
-rw-r--r--lisp/dawn.el67
-rw-r--r--lisp/def.el142
-rw-r--r--lisp/org-word-count.el297
-rw-r--r--lisp/yoke.el111
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
239N spaces. See docstring of `cycle-spacing' for the meaning of 239N spaces. See docstring of `cycle-spacing' for the meaning of
240PRESERVE-NL-BACK and MODE." 240PRESERVE-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.
227This 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.
204If PRED is nil or absent, perform FN on all buffers. Both FN and
205PRED are called within a `with-current-buffer' form and without
206arguments."
207 (let ((pred (cond
208 ((listp pred)
209 (lambda () (apply #'derived-mode-p pred)))
210 ((functionp pred) pred)
211 ((null pred) (lambda () t))
212 (:else (user-error "Bad predicate")))))
213 (dolist (buf (buffer-list))
214 (with-current-buffer buf
215 (when (funcall pred)
216 (funcall fn))))))
217
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)) 39If 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.
51RESET is an argument for internal use." 68Requires `calendar-longitude' and `calendar-latitude' to be set;
69if 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.
11If it doesn't, raise an error. ERROR-TYPE will be the type of
12that error (defaults to `user-error'), and it and ERROR-ARGS are
13passed in a list to `signal'."
14 (unless (funcall pred args)
15 (funcall #'signal
16 (or error-type 'user-error)
17 (or error-args
18 (list "Wrong arguments" args)))))
19
20(defmacro o (&rest fns)
21 "Compose FNS into a new function for one argument."
22 (if (null fns)
23 `(lambda (&rest args) args)
24 `(lambda (&rest args)
25 (apply
26 #',(car fns)
27 (ensure-list (apply (o ,@(cdr fns)) args))))))
28
29;; TODO: I need to figure out where this function goes.
30(defun def--delete2 (list &rest elems)
31 "Delete each element of ELEMS, and the next item, from LIST."
32 (let ((r nil))
33 (while (consp list)
34 (if (member (car list) elems)
35 (setf list (cdr list))
36 (setf r (cons (car list) r)))
37 (setf list (cdr list)))
38 (reverse r)))
39
40;;; Keybindings
41
42(defmacro defkeys (maps &rest bindings)
43 "Define key BINDINGS in MAPS.
44If MAPS is nil or t, bind to `current-global-map'. Otherwise,
45bind each of BINDINGS to the map or list of maps provided.
46
47BINDINGS is a `setq'-style list of pairs of keys and definitions.
48The key part of each binding can be a string, in which case it's
49passed to `kbd', or a vector or anything else `define-key'
50accepts in the KEY position. The definition part, likewise, can
51be any form `define-key' accepts in that position, with this
52addition: if the form is a `defun' form, it will be defined
53before any keys are bound."
54 (declare (indent 1))
55 (def--assert-args (o cl-evenp length) bindings
56 'wrong-number-of-arguments 'defkeys 'evenp (length bindings))
57 `(progn
58 ,@(cl-loop
59 for map in (ensure-list maps)
60 for first-map-p = t then nil
61 append
62 (cl-loop
63 for (keys def) on bindings by #'cddr
64 for defp = (memq (car-safe def) '(defmap defun defmacro))
65 if (and defp first-map-p) collect def into defuns
66 append
67 (cl-loop
68 for key in (ensure-list keys)
69 collect (list 'define-key
70 (if (memq map '(t nil))
71 '(current-global-map)
72 (or (car-safe map) map))
73 (if (stringp key)
74 `(kbd ,key)
75 key)
76 (if defp
77 (cl-case (car def)
78 ((defmap) (cadr def))
79 ((defun defmacro) `#',(cadr def))
80 (otherwise (error "Bad def type: %S"
81 (car def))))
82 def)))
83 into keydefs
84 finally return
85 (let ((all (append defuns keydefs)))
86 (if-let ((after (plist-get (cdr-safe map) :after)))
87 `((eval-after ,after
88 ,@all))
89 all))))))
90
91(defmacro defmap (name docstring &rest bindings)
92 "Define a keymap named NAME, with BINDINGS."
93 (declare (indent 1) (doc-string 2))
94 `(,(if (boundp name) 'setq 'defvar) ,name
95 ;;; ^ probably a terrible hack
96 (let ((map (make-sparse-keymap)))
97 (defkeys map ,@bindings)
98 map)
99 ,@(unless (boundp name) (list docstring))))
100
101;;; Hooks
102
103(defmacro defhook (hooks &rest body)
104 "Define a function to hook into HOOKS.
105NAME and ARGS are passed to the generated `defun' form.
106Each hook in HOOKS can be the name of a hook or a list of the form
107(HOOK DEPTH LOCAL), where each argument is the same as in
108`add-hook'."
109 (declare (indent 1))
110 (let* ((name (or (plist-get body :name)
111 (intern (format "%s/h"
112 (mapconcat
113 (lambda (h)
114 (string-remove-suffix
115 "-hook" (symbol-name (or (car-safe h)
116 h))))
117 (ensure-list hooks)
118 "|")))))
119 (args (or (plist-get body :args) nil))
120 (doc (or (plist-get body :doc) nil))
121 (forms ; (DEFUN . FUNCS)
122 (cl-loop for form in (def--delete2 body :name :args :doc)
123 if (eq (car form) 'function)
124 collect form into funcs
125 else collect form into defuns
126 finally return (cons defuns funcs)))
127 (defun-forms (car forms))
128 (func-forms (cdr forms)))
129 `(progn
130 ,@(when defun-forms
131 `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms)))
132 ,@(cl-loop for hook in (ensure-list hooks)
133 for h = (or (car-safe hook) hook)
134 for ha = (cdr-safe hook)
135 if defun-forms
136 collect `(add-hook ',h #',name ,@ha)
137 append
138 (cl-loop for fn in func-forms
139 collect `(add-hook ',h ,fn ,@ha))))))
140
141(provide 'def)
142;;; def.el ends here
diff --git a/lisp/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
50this correction. (At some point I should correct the underlying
51code... probably).")
52
53(defvar-local org-word-count-update-timer nil)
54
55;;; Variables from org-wc
56
57(defun org-word-count-list-of-strings-p (arg)
58 (cl-every #'stringp arg))
59
60(defun org-word-count--downcase-list-of-strings-set-default (var val)
61 (set-default var (mapcar #'downcase val)))
62
63(defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE")
64 "List of tags for which subtrees will be ignored in word counts"
65 :type '(repeat string)
66 :safe #'org-word-count-list-of-strings-p)
67
68(defcustom org-word-count-ignore-commented-trees t
69 "Ignore trees with COMMENT-prefix if non-nil."
70 :type 'boolean
71 :safe #'booleanp)
72
73(defcustom org-word-count-default-link-count 'description-or-path
74 "Default way of counting words in links.
75This is applied to any link type not specified in any of
76‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or
77‘org-word-count-only-description-link-types’ "
78 :type '(choice
79 (const :tag "Count words in description or else path part of links" description-or-path)
80 (const :tag "Count words only in description part of links" description)
81 (const :tag "Count links as 0 words" ignore)
82 (const :tag "Count links as 1 word" oneword)
83 (const :tag "Count words only in path part of links" path))
84 :safe 'symbolp)
85
86(defcustom org-word-count-ignored-link-types nil
87 "Link types which won't be counted as a word"
88 :type '(repeat string)
89 :safe #'org-word-count-list-of-strings-p)
90
91(defcustom org-word-count-one-word-link-types '("zotero")
92 "Link types which will be counted as one word"
93 :type '(repeat string)
94 :safe #'org-word-count-list-of-strings-p)
95
96(defcustom org-word-count-description-or-path-link-types '()
97 "Link types for which the description or the path should be counted"
98 :type '(repeat string)
99 :safe #'org-word-count-list-of-strings-p)
100
101(defcustom org-word-count-only-description-link-types '("note")
102 "Link types for which only the description should be counted"
103 :type '(repeat string)
104 :safe #'org-word-count-list-of-strings-p)
105
106(defcustom org-word-count-only-path-link-types '()
107 "Link types for which only the path should be counted"
108 :type '(repeat string)
109 :safe #'org-word-count-list-of-strings-p)
110
111(defcustom org-word-count-blocks-to-count '("quote" "verse")
112 "List of blocks which should be included in word count.
113
114Use lower case block names"
115 :type '(repeat string)
116 :safe #'org-word-count-list-of-strings-p
117 :set #'org-word-count--downcase-list-of-strings-set-default)
118
119(defun org-word-count-delayed-update (&rest _)
120 (if org-word-count-update-timer
121 (setq org-word-count-update-timer nil)
122 (setq org-word-count-update-timer
123 (run-with-idle-timer org-word-count-deletion-idle-timer nil
124 #'org-word-count-update))))
125
126(defun org-word-count-force-update ()
127 (interactive)
128 (message "Counting words...")
129 (when (timerp org-word-count-update-timer)
130 (cancel-timer org-word-count-update-timer))
131 (org-word-count-update)
132 (message "Counting words...done"))
133
134(defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice
135 (dlet ((org-word-count-counting t))
136 (org-word-count-buffer)
137 (org-word-count-modeline)
138 (setq org-word-count-update-timer nil)))
139
140(defun org-word-count-changed (start end length)
141 (org-word-count-delayed-update))
142
143(defun org-word-count-buffer ()
144 "Count the words in the buffer."
145 (when (and (derived-mode-p 'org-mode)
146 (not (eq org-word-count-word-count 'huge)))
147 (setq org-word-count-word-count
148 (cond
149 ((> (count-words (point-min) (point-max))
150 org-word-count-huge-buffer)
151 'huge)
152 (t (org-word-count-aux (point-min) (point-max)))))))
153
154;;; From org-wc.el:
155;; https://github.com/tesujimath/org-wc/
156(defun org-word-count-aux (beg end)
157 "Return the number of words between BEG and END."
158 (let ((wc 0)
159 subtreecount
160 (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}"))
161 (save-excursion
162 (goto-char beg)
163 ;; Handle the case where we start in a drawer
164 (when (org-at-drawer-p)
165 (org-end-of-meta-data t))
166 (while (< (point) end)
167 (cond
168 ;; Handle headlines and subtrees
169 ((org-at-heading-p)
170 (cond
171 ;; Ignore commented and org-wc-ignored-tags trees
172 ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p))
173 (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=))
174 (org-end-of-subtree t t))
175 ;; Re-use count for subtrees already counted
176 ((setq subtreecount (get-text-property (point) :org-wc))
177 (cl-incf wc subtreecount)
178 (org-end-of-subtree t t))
179 ;; Skip counting words in headline
180 (t (org-word-count--goto-char (point-at-eol) end))))
181 ;; Ignore most blocks.
182 ((when (save-excursion
183 (beginning-of-line 1)
184 (looking-at org-block-regexp))
185 (if (member (downcase (match-string 1)) org-word-count-blocks-to-count)
186 (progn ;; go inside block and subtract count of end line
187 (org-word-count--goto-char (match-beginning 4) end)
188 (cl-decf wc))
189 (org-word-count--goto-char (match-end 0) end))))
190 ;; Ignore comments.
191 ((org-at-comment-p)
192 (org-word-count--goto-char (point-at-eol) end))
193 ;; Ignore drawers.
194 ((org-at-drawer-p)
195 (org-end-of-meta-data t))
196 ;; Ignore all other #+ lines
197 ((looking-at "#+")
198 (org-word-count--goto-char (point-at-eol) end))
199 ;; Handle links
200 ((save-excursion
201 (when (< (1+ (point-min)) (point)) (backward-char 2))
202 (looking-at org-link-bracket-re))
203 (let* ((type (car (save-match-data (split-string (match-string 1) ":"))))
204 (pathstart (+ 1 (length type) (match-beginning 1))))
205 (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore)
206 ((member type org-word-count-one-word-link-types) 'oneword)
207 ((member type org-word-count-only-description-link-types)
208 'description)
209 ((member type org-word-count-only-path-link-types) 'path)
210 ((member type org-word-count-description-or-path-link-types)
211 'description-or-path)
212 (t org-word-count-default-link-count))
213 (ignore (org-word-count--goto-char (match-end 0) end))
214 (oneword (org-word-count--goto-char (match-end 0) end)
215 (cl-incf wc))
216 (description (if (match-beginning 2)
217 (goto-char (match-beginning 2))
218 (org-word-count--goto-char
219 (match-end 0) end)))
220 (path (cl-incf wc (count-words-region pathstart
221 (match-end 1)))
222 (org-word-count--goto-char (match-end 0) end))
223 (description-or-path
224 (if (match-beginning 2)
225 (goto-char (match-beginning 2))
226 (cl-incf wc (count-words-region pathstart
227 (match-end 1)))
228 (org-word-count--goto-char (match-end 0) end)))
229 (t (user-error "Error in org-word-count link configuration")))))
230 ;; Count latex macros as 1 word, ignoring their arguments.
231 ((save-excursion
232 (when (< (point-min) (point)) (backward-char))
233 (looking-at latex-macro-regexp))
234 (org-word-count--goto-char (match-end 0) end)
235 (cl-incf wc))
236 (t
237 (and (re-search-forward "\\w+\\W*" end 'skip)
238 (cl-incf wc))))))
239 wc))
240
241(defun org-word-count--goto-char (char end)
242 "Moves point to CHAR and from there passes 0+ non-word characters.
243Searchers to end as a maximum.
244
245This ensures that we are in an expected state (at the first word
246character after some non-word characters) after moving beyond
247headlines, links etc."
248 (goto-char char)
249 (re-search-forward "\\W*" end 'skip))
250
251(defvar org-word-count-counting nil
252 "Are we currently counting?")
253
254(defun org-word-count-recount-widen (&rest _)
255 (when (and (not org-word-count-counting))
256 (org-word-count-update)))
257
258(defun org-word-count-modeline ()
259 (setq org-word-count-string
260 (cond
261 ((eq org-word-count-word-count 'huge)
262 org-word-count-huge-string)
263 (org-word-count-word-count
264 (format org-word-count-format
265 (max 0 (+ org-word-count-word-count
266 org-word-count-correction))))))
267 (force-mode-line-update))
268
269(define-minor-mode org-word-count-mode
270 "Count words in `org-mode' buffers in the mode-line."
271 :lighter ""
272 :keymap (let ((map (make-sparse-keymap)))
273 (define-key map (kbd "C-c C-.") #'org-word-count-force-update)
274 map)
275 (cond (org-word-count-mode
276 (org-word-count-buffer)
277 (add-hook 'after-change-functions
278 #'org-word-count-delayed-update nil t)
279 (unless (member '(org-word-count-mode org-word-count-string)
280 mode-line-misc-info)
281 (add-to-list 'mode-line-misc-info
282 '(org-word-count-mode org-word-count-string)
283 nil
284 #'equal))
285 (dolist (fn org-word-count-update-after-funcs)
286 (advice-add fn :after #'org-word-count-update)))
287 (:else
288 (remove-hook 'after-change-functions
289 #'org-word-count-delayed-update t)
290 (setf mode-line-misc-info
291 (delete '(org-word-count-mode org-word-count-string)
292 mode-line-misc-info))
293 (dolist (fn org-word-count-update-after-funcs)
294 (advice-remove fn #'org-word-count-update)))))
295
296(provide 'org-word-count)
297;;; org-word-count.el ends here
diff --git a/lisp/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'.
© 2022 C. Duckworth. generated by cgit. comments, issues, and patches welcome at < git at acdw dot net >.