about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2023-08-01 20:31:55 -0500
committerCase Duckworth2023-08-01 20:31:55 -0500
commit3d42d13602bef3b80747a37f77730445216c2c7a (patch)
tree43f61fbe0415805010c412412bce420b5d030fc2
parentmeh (diff)
downloadetc-3d42d13602bef3b80747a37f77730445216c2c7a.tar.gz
etc-3d42d13602bef3b80747a37f77730445216c2c7a.zip
Add emacs/init.el
-rw-r--r--emacs/init.el1926
1 files changed, 1926 insertions, 0 deletions
diff --git a/emacs/init.el b/emacs/init.el new file mode 100644 index 0000000..a0324cf --- /dev/null +++ b/emacs/init.el
@@ -0,0 +1,1926 @@
1;;; ~/.emacs -*- mode: emacs-lisp; lexical-binding: t; -*-
2;; by Case Duckworth <acdw@acdw.net>
3;; License: GPLv3
4
5(setopt custom-file (locate-user-emacs-file "custom.el"))
6(load custom-file :noerror)
7
8(add-hook 'after-init-hook
9 (lambda () (load (locate-user-emacs-file "private") :noerror)))
10
11(require 'package)
12(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
13(package-initialize)
14
15(defun package-ensure (pkg &optional local require)
16 "Ensure PKG is installed.
17PKG can be a symbol, a string, or a list. A symbol will be
18installed using `package-install' from `package-archives'. A
19string will use `package-vc-install', which see. If given a
20list, it will be interpreted as a full set of arguments to one of
21the above functions, depending on the type of its car.
22
23If LOCAL is t, add ~/src/PKG.el to `load-path' and generate
24autoloads. If LOCAL is a string, Add that directory to
25`load-path'.
26
27If REQUIRE is non-nil, require the package after installing it."
28 (setq pkg (ensure-list pkg))
29
30 (cond
31 (local
32 (unless (stringp local)
33 (setq local (expand-file-name
34 (format "~/src/%s.el" (car pkg)))))
35 (unless (file-directory-p local)
36 (user-error "Package directory does not exist: %s" local))
37 (let ((autoload-file (expand-file-name
38 (format "%s-autoloads.el" (car pkg))
39 local))
40 (backup-inhibited t))
41 (add-to-list 'load-path local)
42 (loaddefs-generate local autoload-file)
43 (load autoload-file nil t))
44 (setq pkg (intern (format "%s" (car pkg)))))
45
46 ((symbolp (car pkg))
47 (unless (ignore-errors (apply #'package-install pkg))
48 (package-refresh-contents)
49 (apply #'package-install pkg))
50 (setq pkg (car pkg)))
51
52 ((stringp (car pkg))
53 (let ((pkg-name (intern (file-name-base (car pkg)))))
54 (unless (package-installed-p pkg-name)
55 (apply #'package-vc-install pkg))
56 (setq pkg pkg-name))))
57
58 (when require
59 (require pkg))
60
61 pkg)
62
63(defmacro setf/assoc (alist key val &optional keep)
64 "Set KEY to VAL in ALIST using `assoc'/`equal' semantics.
65Written as a convenience to writing out this long `alist-get'
66call every time. If VAL is nil, the entry with KEY is removed from ALIST unless
67KEEP is also non-nil."
68 `(setf (alist-get ,key ,alist nil ,(not keep) #'equal)
69 ,val))
70
71(defmacro comment (&rest _) (declare (indent defun)) nil)
72
73(defun add-local-mode-hook (mode-hook hook func)
74 "Add FUNC to HOOK locally in buffers with MODE-HOOK."
75 (add-hook mode-hook
76 (lambda () (add-hook hook func nil t))))
77
78(package-ensure 'crux)
79(crux-reopen-as-root-mode)
80
81(crux-with-region-or-buffer indent-region)
82(crux-with-region-or-buffer tabify)
83(crux-with-region-or-buffer untabify)
84
85(keymap-global-set "C-c i" #'crux-find-user-init-file)
86
87(setopt auth-sources '(default
88 "secrets:passwords"
89 "~/.authinfo"))
90
91(setq disabled-command-function nil)
92
93
94;;; Theme
95
96(setopt modus-themes-bold-constructs t)
97(setopt modus-themes-italic-constructs t)
98(setopt modus-themes-variable-pitch-ui t)
99(setopt modus-themes-disable-other-themes t)
100
101(tool-bar-mode -1)
102(menu-bar-mode -1)
103(scroll-bar-mode -1)
104(tooltip-mode -1)
105
106(setopt scroll-conservatively 101)
107
108(setopt read-answer-short t)
109(setopt use-dialog-box nil)
110(setopt use-file-dialog nil)
111(setopt use-short-answers t)
112
113(setopt inhibit-startup-screen t)
114(setopt initial-buffer-choice t)
115(setopt initial-scratch-message
116 ;; ";; Emacs!\n\n"
117 nil)
118
119(setopt x-underline-at-descent-line t)
120(setopt blink-cursor-delay 0.25)
121(setopt blink-cursor-interval 0.25)
122(setopt blink-cursor-blinks 4)
123
124(define-advice startup-echo-area-message (:override ())
125 (if (get-buffer "*Warnings*")
126 ";_;"
127 "^_^"))
128
129(defun reset-faces (&rest _)
130 (dolist (face '(font-lock-regexp-face
131 font-lock-builtin-face
132 font-lock-variable-name-face
133 font-lock-preprocessor-face
134 font-lock-remove-face
135 font-lock-delimiter-face
136 font-lock-label-face
137 font-lock-operator-face
138 font-lock-property-face
139 font-lock-builtin-face
140 font-lock-number-face
141 font-lock-keyword-face
142 font-lock-set-face
143 font-lock-punctuation-face
144 font-lock-constant-face
145 font-lock-type-face
146 font-lock-function-name-face
147 font-lock-reference-face
148 font-lock-misc-punctuation-face
149 font-lock-bracket-face))
150 (face-spec-set face '((t :foreground unspecified
151 :background unspecified))))
152 (when-let ((current (cl-loop for modus in modus-themes-collection
153 if (memq modus custom-enabled-themes)
154 return modus
155 finally return nil)))
156 (modus-themes-with-colors
157 (dolist (face '(font-lock-doc-face
158 font-lock-string-face))
159 (face-spec-set face `((t :foreground unspecified
160 :background unspecified
161 :slant italic))))
162 ;; (face-spec-set 'font-lock-comment-face
163 ;; :inherit doesn't work for some reason??
164 ;; `((t :foreground
165 ;; ,fg-alt)))
166 )))
167(advice-add 'load-theme :after #'reset-faces)
168
169(defvar dark-theme 'modus-vivendi-tinted)
170(defvar light-theme 'modus-operandi-tinted)
171
172(load-theme dark-theme :no-confirm :no-enable)
173(load-theme light-theme :no-confirm :no-enable)
174(if (and (executable-find "darkman")
175 (let ((stat (shell-command "darkman get")))
176 (and (= stat 0)
177 (equal (with-current-buffer shell-command-buffer-name
178 (buffer-substring (point-min) (point-max)))
179 "dark\n"))))
180 (load-theme dark-theme :no-confirm)
181 (load-theme light-theme :no-confirm))
182
183
184(defun first-frame@set-fonts ()
185 (remove-hook 'server-after-make-frame-hook
186 #'first-frame@set-fonts)
187 (face-spec-set 'default
188 `((t :family "Recursive Mono Casual Static"
189 :height 110)))
190 (face-spec-set 'variable-pitch
191 `((t :family "Recursive Sans Casual Static"
192 :height 1.0)))
193 ;; Emojis
194 (cl-loop with ffl = (font-family-list)
195 for font in '("Noto Emoji" "Noto Color Emoji"
196 "Segoe UI Emoji" "Apple Color Emoji"
197 "FreeSans" "FreeMono" "FreeSerif"
198 "Unifont" "Symbola")
199 if (member font ffl)
200 do (set-fontset-font t 'symbol font))
201 ;; International fonts
202 (cl-loop with ffl = (font-family-list)
203 for (charset . font)
204 in '((latin . "Noto Sans")
205 (han . "Noto Sans CJK SC Regular")
206 (kana . "Noto Sans CJK JP Regular")
207 (hangul . "Noto Sans CJK KR Regular")
208 (cjk-misc . "Noto Sans CJK KR Regular")
209 (khmer . "Noto Sans Khmer")
210 (lao . "Noto Sans Lao")
211 (burmese . "Noto Sans Myanmar")
212 (thai . "Noto Sans Thai")
213 (ethiopic . "Noto Sans Ethiopic")
214 (hebrew . "Noto Sans Hebrew")
215 (arabic . "Noto Sans Arabic")
216 (gujarati . "Noto Sans Gujarati")
217 (devanagari . "Noto Sans Devanagari")
218 (kannada . "Noto Sans Kannada")
219 (malayalam . "Noto Sans Malayalam")
220 (oriya . "Noto Sans Oriya")
221 (sinhala . "Noto Sans Sinhala")
222 (tamil . "Noto Sans Tamil")
223 (telugu . "Noto Sans Telugu")
224 (tibetan . "Noto Sans Tibetan"))
225 if (member font ffl)
226 do (set-fontset-font t charset font))
227 ;; XXX: tab-bar does a weird thing, so i set it up here....
228 (setopt tab-bar-show t)
229 (tab-bar-mode))
230
231(defun run-after-init-or-first-frame (func)
232 "Run FUNC after init or after the first frame."
233 (if (daemonp)
234 (add-hook 'server-after-make-frame-hook func)
235 (add-hook 'after-init-hook func)))
236
237(run-after-init-or-first-frame #'first-frame@set-fonts)
238
239(setopt frame-resize-pixelwise t)
240(setopt window-resize-pixelwise t)
241
242(defun tab-bar-end-space ()
243 `((end menu-item " " ignore)))
244
245(add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
246(add-to-list 'tab-bar-format 'tab-bar-format-global :append)
247(add-to-list 'tab-bar-format 'tab-bar-end-space :append)
248
249(add-hook 'dired-mode-hook #'hl-line-mode)
250(with-eval-after-load 'org-agenda
251 (add-hook 'org-agenda-mode-hook #'hl-line-mode))
252
253(with-eval-after-load 'tabulated-list
254 (add-hook 'tabulated-list-mode-hook #'hl-line-mode))
255
256(setopt echo-keystrokes 0.01)
257
258(setopt switch-to-buffer-in-dedicated-window 'pop)
259(setopt switch-to-buffer-obey-display-actions t)
260
261(when (package-ensure 'adaptive-wrap)
262 (add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode))
263
264;;; Ediff
265
266(setopt ediff-split-window-function #'split-window-horizontally)
267(setopt ediff-window-setup-function #'ediff-setup-windows-plain)
268
269;;; Man pages
270
271(setopt Man-notify-method 'aggressive)
272
273;;; Mode-line
274
275(defun hide-minor-mode (mode &optional hook)
276 "Hide MODE from the mode-line.
277HOOK is used to trigger the action, and defaults to MODE-hook."
278 (setf (alist-get mode minor-mode-alist) (list ""))
279 (add-hook (intern (or hook (format "%s-hook" mode)))
280 (lambda () (hide-minor-mode mode))))
281
282(setq mode-line-modes
283 (let ((recursive-edit-help-echo
284 "Recursive edit, type M-C-c to get out"))
285 (list (propertize "%[" 'help-echo recursive-edit-help-echo)
286 `(:propertize ("" mode-name)
287 help-echo "Major mode\n\
288mouse-1: Display major mode menu\n\
289mouse-2: Show help for major mode\n\
290mouse-3: Toggle minor modes"
291 face bold
292 mouse-face mode-line-highlight
293 local-map ,mode-line-major-mode-keymap)
294 '("" mode-line-process)
295 `(:propertize ("" minor-mode-alist)
296 mouse-face mode-line-highlight
297 help-echo "Minor mode\n\
298mouse-1: Display minor mode menu\n\
299mouse-2: Show help for minor mode\n\
300mouse-3: Toggle minor modes"
301 local-map ,mode-line-minor-mode-keymap)
302 (propertize "%n" 'help-echo "mouse-2: Remove narrowing from buffer"
303 'mouse-face 'mode-line-highlight
304 'local-map (make-mode-line-mouse-map
305 'mouse-2 #'mode-line-widen))
306 (propertize "%]" 'help-echo recursive-edit-help-echo)
307 " ")))
308
309(setopt mode-line-format
310 '(("%e"
311 mode-line-front-space
312 (:propertize (""
313 mode-line-client
314 mode-line-modified
315 mode-line-remote)
316 display (min-width (3.0)))
317 " "
318 mode-line-buffer-identification
319 (vc-mode
320 (" (" (:eval (string-trim vc-mode)) ")"))
321 " "
322 (mode-line-position
323 (" ∙ " mode-line-position))
324 " ∙ "
325 mode-line-modes ; the one above
326 mode-line-misc-info
327 mode-line-end-spaces)))
328
329
330;;; Completion and minibuffer
331
332(setopt tab-always-indent 'complete)
333(setopt completion-styles '(basic partial-completion substring flex))
334
335;; XXX: this is 'too good' when I'm in the process of typing out things.
336;; (when (package-ensure "https://git.sr.ht/~pkal/typo")
337;; (add-to-list 'completion-styles 'typo :append))
338
339(setopt completion-ignore-case t)
340(setopt read-buffer-completion-ignore-case t)
341(setopt read-file-name-completion-ignore-case t)
342(setopt completion-flex-nospace t)
343
344;; These aren't /that/ useful if you're not using *Completions*.
345(setopt completions-detailed t)
346(setopt completion-auto-help 'visible)
347(setopt completion-auto-select 'second-tab)
348(setopt completions-header-format nil)
349(setopt completions-format 'one-column)
350(setopt completions-max-height 20)
351
352;; (defun minibuffer-next-completion-or-line (n)
353;; "Move to the next N completion in minibuffer, or Nth next line."
354;; (interactive "p")
355;; (if (and (eq last-command 'minibuffer-next-completion)
356;; (not (minibufferp)))
357;; (forward-line n)
358;; (minibuffer-next-completion n)))
359
360;; (defun minibuffer-previous-completion-or-line (n)
361;; "Move to the previous N completion, or Nth previous line."
362;; (interactive "p")
363;; (setq last-command 'minibuffer-next-completion-or-line)
364;; (minibuffer-next-completion-or-line (- n)))
365
366(progn
367 (keymap-set minibuffer-local-map "C-p"
368 #'minibuffer-previous-completion)
369 (keymap-set minibuffer-local-map "C-n"
370 #'minibuffer-next-completion)
371 ;; (keymap-set completion-in-region-mode-map "C-p"
372 ;; #'minibuffer-previous-completion)
373 ;; (keymap-set completion-in-region-mode-map "C-n"
374 ;; #'minibuffer-next-completion)
375 )
376
377(setf/assoc display-buffer-alist
378 "\\*Completions\\*"
379 '((display-buffer-reuse-mode-window)))
380
381(setopt enable-recursive-minibuffers t)
382(minibuffer-depth-indicate-mode)
383(minibuffer-electric-default-mode)
384
385(setopt file-name-shadow-properties '(invisible t intangible t))
386(file-name-shadow-mode)
387
388(define-minor-mode truncate-lines-local-mode
389 "Toggle `truncate-lines' in the current buffer."
390 :lighter ""
391 (setq-local truncate-lines truncate-lines-local-mode))
392
393(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode)
394(add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode)
395
396(when (package-ensure 'consult nil t)
397 (keymap-global-set "C-x b" #'consult-buffer)
398 (keymap-global-set "C-x 4 b" #'consult-buffer-other-window)
399 (keymap-global-set "C-x 5 b" #'consult-buffer-other-frame)
400 (keymap-global-set "C-x r b" #'consult-bookmark)
401 (keymap-global-set "M-y" #'consult-yank-pop)
402 (keymap-global-set "M-g g" #'consult-goto-line)
403 (keymap-global-set "M-g M-g" #'consult-goto-line)
404 (keymap-global-set "M-g o" #'consult-outline)
405 (keymap-global-set "M-g m" #'consult-mark)
406 (keymap-global-set "M-g i" #'consult-imenu)
407 (keymap-global-set "M-s d" #'consult-find)
408 (keymap-global-set "M-s D" #'consult-locate)
409 (keymap-global-set "M-s g" #'consult-grep)
410 (keymap-global-set "M-s G" #'consult-git-grep)
411 (keymap-global-set "M-s r" #'consult-ripgrep)
412 (keymap-global-set "M-s l" #'consult-line)
413 (keymap-global-set "M-s k" #'consult-keep-lines)
414 (keymap-global-set "M-s u" #'consult-focus-lines)
415
416 (keymap-global-set "M-s e" #'consult-isearch-history)
417 (keymap-set isearch-mode-map "M-e" #'consult-isearch-history)
418 (keymap-set isearch-mode-map "M-s e" #'consult-isearch-history)
419 (keymap-set isearch-mode-map "M-s l" #'consult-line)
420
421 (setopt xref-show-xrefs-function #'consult-xref)
422 (setopt xref-show-definitions-function #'xref-show-definitions-completing-read)
423
424 (setopt consult-preview-key "M-.")
425
426 (consult-customize
427 consult-ripgrep consult-git-grep consult-grep
428 consult-xref
429 :preview-key '(:debounce 0.4 any)))
430
431(when (package-ensure 'marginalia)
432 (marginalia-mode))
433
434(setopt history-length t)
435(setopt history-delete-duplicates t)
436(setopt savehist-save-minibuffer-history t)
437(setopt savehist-autosave-interval 5)
438(savehist-mode)
439
440
441;;; Text editing
442
443(setopt fill-column 80)
444(global-so-long-mode)
445
446(defun cycle-spacing* (&optional n)
447 "Negate N argument on `cycle-spacing'."
448 (interactive "*p")
449 (cycle-spacing (- n)))
450(keymap-global-set "M-SPC" #'cycle-spacing*)
451
452(when (package-ensure 'hungry-delete)
453 (setopt hungry-delete-chars-to-skip " \t")
454 (setopt hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip))
455 (setopt hungry-delete-join-reluctantly nil)
456 (with-eval-after-load 'hungry-delete
457 (add-to-list 'hungry-delete-except-modes 'eshell-mode)
458 (add-to-list 'hungry-delete-except-modes 'nim-mode)
459 (add-to-list 'hungry-delete-except-modes 'python-mode)
460 (hide-minor-mode 'hungry-delete-mode))
461 (global-hungry-delete-mode))
462
463(setopt isearch-lazy-count t)
464(setopt isearch-regexp-lax-whitespace t)
465(setopt isearch-wrap-pause 'no)
466(setopt search-default-mode t)
467(setopt search-whitespace-regexp ".*?") ; swiper-style
468(setopt search-ring-max 256)
469(setopt regexp-search-ring-max 256)
470
471(define-advice isearch-cancel (:before () add-to-history)
472 "Add search string to history when canceling isearch."
473 (unless (string-equal "" isearch-string)
474 (isearch-update-ring isearch-string isearch-regexp)))
475
476(define-advice perform-replace (:around (fn &rest args) dont-exit-on-anykey)
477 "Don't exit replace for anykey that's not in `query-replace-map'."
478 (save-window-excursion
479 (cl-letf* ((lookup-key-orig
480 (symbol-function 'lookup-key))
481 ((symbol-function 'lookup-key)
482 (lambda (map key &optional accept-default)
483 (or (apply lookup-key-orig map key accept-default)
484 (when (eq map query-replace-map) 'help)))))
485 (apply fn args))))
486
487(when (package-ensure 'isearch-mb)
488 (with-eval-after-load 'isearch-mb
489 (with-eval-after-load 'consult
490 (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history)
491 (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history)
492 (add-to-list 'isearch-mb--after-exit #'consult-line)
493 (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line))
494 (with-eval-after-load 'anzu
495 (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace)
496 (keymap-set isearch-mb-minibuffer-map "M-%"
497 #'anzu-isearch-query-replace)))
498 (isearch-mb-mode))
499
500(when (package-ensure 'anzu)
501 (setopt anzu-mode-lighter "")
502 (setopt anzu-deactivate-region t)
503 (keymap-global-set "M-%" #'anzu-query-replace-regexp)
504 (keymap-global-set "C-M-%" #'anzu-query-replace)
505 (keymap-set isearch-mode-map "M-%" #'anzu-isearch-query-replace-regexp)
506 (keymap-set isearch-mode-map "C-M-%" #'anzu-isearch-query-replace)
507 (global-anzu-mode))
508
509(keymap-global-set "M-/" #'hippie-expand)
510(keymap-global-set "C-x C-b" #'ibuffer)
511
512(add-hook 'ibuffer-mode-hook #'hl-line-mode)
513
514(defun call-with-region-or-buffer (fn &rest _r)
515 "Call function FN with current region or buffer.
516Good to use for :around advice."
517 ;; This `interactive' form is needed to override the advised function's form,
518 ;; to avoid errors when the region isn't active. This means that FN must take
519 ;; 2 arguments, the beginning and the end of the region to act on.
520 (interactive)
521 (if (region-active-p)
522 (funcall fn (region-beginning) (region-end))
523 (funcall fn (point-min) (point-max))))
524
525(delete-selection-mode)
526
527(when (package-ensure 'avy)
528 (setopt avy-background t)
529 (setopt avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm"))
530 (keymap-global-set "M-j" #'avy-goto-char-timer)
531 (keymap-set isearch-mode-map "M-j" #'avy-isearch))
532
533(when (package-ensure 'zzz-to-char)
534 (keymap-global-set "M-z"
535 (defun zzz-to-char* (arg)
536 (interactive "P")
537 (call-interactively
538 (if arg #'zzz-to-char #'zzz-to-char-up-to-char)))))
539
540;;; Prose
541
542(add-hook 'text-mode-hook #'visual-line-mode)
543
544(when (package-ensure 'olivetti)
545 (add-hook 'text-mode-hook #'olivetti-mode))
546
547(when (package-ensure 'jinx)
548 (add-hook 'text-mode-hook #'jinx-mode)
549 (with-eval-after-load 'jinx
550 (keymap-set jinx-mode-map "M-$" #'jinx-correct)
551 (keymap-set jinx-mode-map "C-M-$" #'jinx-languages)))
552
553(defun org-fk-region (start end)
554 "Get the Flesch-Kincaid score of an `org-mode' region."
555 (interactive "r")
556 (let ((buf (get-buffer-create " *fk*" t)))
557 (shell-command-on-region start end
558 "pandoc -t plain -f org | ~/src/fk/fk.perl"
559 buf)
560 (with-current-buffer buf
561 (buffer-substring-no-properties (point-min) (- (point-max) 1)))
562 (kill-buffer buf)))
563
564(crux-with-region-or-buffer org-fk-region)
565
566(when (package-ensure 'scule t t)
567 (keymap-global-set "M-c" scule-map))
568
569(when (package-ensure 'titlecase t)
570 (keymap-set scule-map "M-t" #'titlecase-dwim))
571
572(setopt dictionary-default-popup-strategy "lev") ; Levenshtein distance 1
573(setopt dictionary-server "dict.org")
574(setopt dictionary-use-single-buffer t)
575(keymap-global-set "M-#"
576 (defun dictionary-lookup-dwim ()
577 (interactive)
578 (unless (ignore-errors (dictionary-lookup-definition))
579 (call-interactively #'dictionary-search))))
580
581(package-ensure 'markdown-mode)
582
583;;; Programming
584
585(setopt electric-pair-skip-whitespace 'chomp)
586(electric-pair-mode)
587
588(setopt show-paren-delay 0.01)
589(setopt show-paren-style 'parenthesis)
590(setopt show-paren-when-point-in-periphery t)
591(setopt show-paren-when-point-inside-paren t)
592(show-paren-mode)
593
594(add-hook 'prog-mode-hook #'auto-fill-mode)
595(add-hook 'prog-mode-hook #'display-fill-column-indicator-mode)
596(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
597
598(when (package-ensure 'dumb-jump)
599 (add-hook 'xref-backend-functions #'dumb-jump-xref-activate))
600
601(add-hook 'prog-mode-hook #'prettify-symbols-mode)
602
603(keymap-global-set "M-:" #'pp-eval-expression)
604
605;; Tabs
606
607(setopt tab-width 8)
608
609(defvar space-indent-modes '(emacs-lisp-mode
610 lisp-interaction-mode
611 lisp-mode
612 scheme-mode
613 python-mode
614 haskell-mode
615 text-mode)
616 "Modes to indent with spaces, not tabs.")
617
618(defun indent-tabs-mode-maybe ()
619 (setq indent-tabs-mode
620 (if (apply #'derived-mode-p space-indent-modes) nil t)))
621(add-hook 'prog-mode-hook #'indent-tabs-mode-maybe)
622
623(setopt sh-basic-offset tab-width)
624(setopt perl-indent-level tab-width)
625
626;; Scheme
627
628(when (package-ensure 'geiser)
629 (when (executable-find "csi")
630 (when (package-ensure 'geiser-chicken)
631 (setf/assoc auto-mode-alist "\\.egg\\'" 'scheme-mode)))
632 (setopt scheme-program-name (or (executable-find "csi")
633 "scheme"))
634 (add-hook 'scheme-mode-hook #'geiser-mode))
635
636(require 'autoinsert)
637(setf/assoc auto-insert-alist
638 "\\.scm"
639 '(nil "#!/bin/sh" \n
640 "#| -*- scheme -*-" \n
641 "exec csi -ss \"$0\" \"$@\"" \n
642 _ \n
643 "|#" \n \n))
644
645;; Emacs lisp
646
647(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun)
648(keymap-set emacs-lisp-mode-map "C-c C-b" #'eval-buffer)
649(keymap-set emacs-lisp-mode-map "C-c C-z" #'ielm) ; TODO: better-ize
650(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun)
651(keymap-set lisp-interaction-mode-map "C-c C-b" #'eval-buffer)
652(keymap-set lisp-interaction-mode-map "C-c C-z" #'ielm) ; TODO: better-ize
653
654(add-hook 'after-init-hook
655 (lambda ()
656 (define-advice eval-buffer (:after (&rest _) message)
657 (message "Buffer %s evaluated." (current-buffer)))))
658
659
660;;; Files
661
662(setopt auto-revert-verbose nil)
663(setopt global-auto-revert-non-file-buffers t)
664(global-auto-revert-mode)
665
666(setopt create-lockfiles nil)
667(setopt mode-require-final-newline t)
668(setopt view-read-only t)
669(setopt save-silently t)
670
671(setopt auto-save-default nil)
672(setopt auto-save-no-message t)
673(setopt auto-save-interval 2)
674(setopt auto-save-timeout 2)
675(setopt auto-save-visited-interval 2)
676(setopt remote-file-name-inhibit-auto-save t)
677(setopt remote-file-name-inhibit-auto-save-visited t)
678(add-to-list 'auto-save-file-name-transforms
679 `(".*" ,(locate-user-emacs-file "auto-save/") t))
680(auto-save-visited-mode)
681
682(setopt backup-by-copying t)
683(setopt version-control t)
684(setopt kept-new-versions 3)
685(setopt kept-old-versions 3)
686(setopt delete-old-versions t)
687(add-to-list 'backup-directory-alist '("^/dev/shm/" . nil))
688(add-to-list 'backup-directory-alist '("^/tmp/" . nil))
689(when-let ((xrd (getenv "XDG_RUNTIME_DIR")))
690 (add-to-list 'backup-directory-alist (cons xrd nil)))
691(add-to-list 'backup-directory-alist
692 (cons "." (locate-user-emacs-file "backup/"))
693 :append)
694
695(setopt recentf-max-menu-items 100)
696(setopt recentf-max-saved-items nil)
697(setopt recentf-case-fold-search t)
698(with-eval-after-load 'recentf
699 (add-to-list 'recentf-exclude "-autoloads.el\\'"))
700(add-hook 'buffer-list-update-hook #'recentf-track-opened-file)
701(add-hook 'after-save-hook #'recentf-save-list)
702(recentf-mode)
703
704(setopt save-place-forget-unreadable-files (eq system-type 'gnu/linux))
705(save-place-mode)
706
707;; Encodings
708(set-language-environment "UTF-8")
709(setopt buffer-file-coding-system 'utf-8-unix)
710(setopt coding-system-for-read 'utf-8-unix)
711(setopt coding-system-for-write 'utf-8-unix)
712(setopt default-process-coding-system '(utf-8-unix . utf-8-unix))
713(setopt locale-coding-system 'utf-8-unix)
714(set-charset-priority 'unicode)
715(prefer-coding-system 'utf-8-unix)
716(set-default-coding-systems 'utf-8-unix)
717(set-terminal-coding-system 'utf-8-unix)
718(set-keyboard-coding-system 'utf-8-unix)
719(pcase system-type
720 ((or 'ms-dos 'windows-nt)
721 (set-clipboard-coding-system 'utf-16-le)
722 (set-selection-coding-system 'utf-16-le))
723 (_
724 (set-selection-coding-system 'utf-8)
725 (set-clipboard-coding-system 'utf-8)))
726
727;; Undo
728(when (package-ensure 'undohist)
729 (undohist-initialize))
730
731;;; ...
732
733(setopt bookmark-save-flag 1)
734
735(defun c-w-dwim (num)
736 "Delete NUM words backward, or the region if it's active."
737 (interactive "p")
738 (if (region-active-p)
739 (call-interactively #'kill-region)
740 (call-interactively #'backward-kill-word)))
741(keymap-global-set "C-w" #'c-w-dwim)
742
743(setf/assoc display-buffer-alist
744 "\\`\\*Warnings\\*"
745 '((display-buffer-no-window)))
746
747(winner-mode)
748
749(setopt set-mark-command-repeat-pop t)
750
751(when (package-ensure 'embark nil t)
752 (when (and (package-installed-p 'consult)
753 (package-ensure 'embark-consult nil t))
754 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))
755 (keymap-global-set "C-." #'embark-act)
756 (keymap-global-set "M-." #'embark-dwim)
757 (keymap-global-set "C-h B" #'embark-bindings)
758 (setopt prefix-help-command #'embark-prefix-help-command)
759 (setf/assoc display-buffer-alist
760 "\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
761 '(nil (window-parameters (mode-line-format . none)))))
762
763(setopt eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly)
764(setopt eldoc-idle-delay 0.01)
765
766(setopt recenter-positions '(top middle bottom))
767
768(defmacro inhibit-messages (&rest body)
769 "Inhibit all messages in BODY."
770 (declare (indent defun))
771 `(cl-letf (((symbol-function 'message) #'ignore))
772 ,@body))
773
774(add-hook 'find-file-not-found-functions
775 (defun create-missing-directories ()
776 "Automatically create missing directories."
777 (let ((target-dir (file-name-directory buffer-file-name)))
778 (unless (file-exists-p target-dir)
779 (make-directory target-dir :parents)))))
780
781(setopt vc-follow-symlinks t)
782(setopt vc-make-backup-files t)
783(add-hook 'find-file-hook
784 (defun vc-remote-off ()
785 "Turn VC off when remote."
786 (when (file-remote-p (buffer-file-name))
787 (setq-local vc-handled-backends nil))))
788(with-eval-after-load 'vc-dir
789 (add-hook 'vc-dir-mode-hook #'hl-line-mode))
790
791(defun vc-jump ()
792 "Run `vc-dir' on the current directory.
793Saves a keystroke."
794 (interactive)
795 (vc-dir default-directory))
796(keymap-global-set "C-x v j" #'vc-jump)
797
798(setopt whitespace-style '(face trailing tabs tab-mark))
799(global-whitespace-mode)
800(hide-minor-mode 'whitespace-mode)
801(add-hook 'before-save-hook
802 (defun delete-trailing-whitespace-except-current-line ()
803 (save-excursion
804 (delete-trailing-whitespace (point-min)
805 (line-beginning-position))
806 (delete-trailing-whitespace (line-end-position)
807 (point-max)))))
808
809(defun list-of-strings-p (x)
810 "Is X a list of strings?"
811 (and x
812 (listp x)
813 (cl-every #'stringp x)))
814
815(put 'ispell-local-words 'safe-local-variable
816 'list-of-strings-p)
817
818(package-ensure '0x0) ; TODO: write my own package for rsync
819
820(when (package-ensure 'electric-cursor t)
821 (hide-minor-mode 'electric-cursor-mode)
822 (setopt electric-cursor-alist '((overwrite-mode . (hbar . 8))
823 (t . box)))
824 (electric-cursor-mode))
825
826(defun fill-double-space-sentences-region (start end)
827 "Fill from START to END, double-spacing sentences."
828 (let ((sentence-end-double-space t))
829 (repunctuate-sentences :no-query start end)
830 (fill-region start end)))
831
832(defun unfill-region (start end &optional unfill-func)
833 "Unfill region from START to END."
834 (let ((fill-column most-positive-fixnum)
835 (fill-paragraph-function nil))
836 (funcall (or unfill-func #'fill-region) start end)))
837
838(defun fill-or-unfill-region (start end &optional interactive)
839 "Fill or unfill from START to END."
840 (interactive "*r\np")
841 (if (and interactive
842 (eq last-command 'fill-or-unfill-region))
843 ;; If called interactively more than once, toggle filling mode.
844 (if (with-current-buffer "*Messages*"
845 (goto-char (point-max))
846 (goto-char (beginning-of-line))
847 (looking-at "Unfilling"))
848 (fill-double-space-sentences-region start end)
849 (unfill-region start end #'fill-double-space-sentences-region))
850 ;; Otherwise, detect filled status based on the length of lines in the
851 ;; region. If just one of them is longer than `fill-column', consider the
852 ;; region unfilled.
853 (let ((filled-p (cl-some (lambda (ln) (<= 1 (length ln) fill-column))
854 (string-split (buffer-substring start end)
855 "[\n\r]+"))))
856 (if filled-p
857 (progn
858 (message "Unfilling region")
859 (unfill-region start end #'fill-double-space-sentences-region))
860 (progn
861 (message "Filling region")
862 (fill-double-space-sentences-region start end))))))
863
864(defun fill-or-unfill-dwim ()
865 (interactive)
866 (save-mark-and-excursion
867 (unless (region-active-p)
868 (mark-paragraph))
869 (call-interactively #'fill-or-unfill-region)))
870
871(keymap-global-set "M-q" #'fill-or-unfill-dwim)
872
873;; Fix annoying error messages when I type the <FN> key
874(keymap-global-set "<0x100811d0>" #'ignore) ; Keychron
875(keymap-global-set "<WakeUp>" #'ignore) ; Laptop
876
877(keymap-global-set "M-u" #'universal-argument)
878(keymap-set universal-argument-map "M-u" #'universal-argument-more)
879
880(defun kill-buffer-dwim (&optional buffer-or-name)
881 "Kill BUFFER-OR-NAME or the current buffer."
882 (interactive "P")
883 (cond
884 ((bufferp buffer-or-name)
885 (kill-buffer buffer-or-name))
886 ((null buffer-or-name)
887 (kill-current-buffer))
888 (:else
889 (kill-buffer (read-buffer "Kill: " nil :require-match)))))
890(keymap-global-set "C-x C-k" #'kill-buffer-dwim)
891
892(defun other-window-dwim (&optional arg)
893 "Switch to another window/buffer.
894Calls `other-window', which see, unless
895- the current window is alone on its frame
896- `other-window-dwim' is called with \\[universal-argument]
897In these cases, switch to the last-used buffer."
898 (interactive "P")
899 (if (or arg (one-window-p))
900 (switch-to-buffer (other-buffer) nil t)
901 (other-window 1)))
902(keymap-global-set "M-o" #'other-window-dwim)
903(keymap-global-set "C-x o" #'other-window-dwim)
904
905(defun delete-window-dwim ()
906 "Delete the current window or bury its buffer.
907If the current window is alone in its frame, bury the buffer
908instead."
909 (interactive)
910 (unless (ignore-errors (delete-window) t)
911 (bury-buffer)))
912(keymap-global-set "C-x 0" #'delete-window-dwim)
913
914
915;;; Org mode
916
917(keymap-global-set "C-c a" #'org-agenda)
918(keymap-global-set "C-c c" #'org-capture)
919(keymap-global-set "C-c l" #'org-store-link)
920
921(setopt org-clock-clocked-in-display 'mode-line)
922(setopt org-clock-out-remove-zero-time-clocks t)
923(setopt org-clock-frame-title-format '("%b" " - " (t org-mode-line-string)))
924(setopt org-tags-column (- (- fill-column 3)))
925(setopt org-log-into-drawer t)
926(setopt org-clock-into-drawer t)
927(setopt org-special-ctrl-a/e t)
928(setopt org-special-ctrl-k t)
929(setopt org-archive-mark-done t)
930(setopt org-agenda-window-setup 'current-window)
931(setopt org-agenda-restore-windows-after-quit t)
932(setopt org-agenda-skip-deadline-if-done t)
933(setopt org-agenda-skip-scheduled-if-done t)
934(setopt org-agenda-inhibit-startup t)
935(setopt org-deadline-warning-days 0)
936(setopt org-cycle-separator-lines 0)
937(setopt org-agenda-span 10)
938(setopt org-blank-before-new-entry '((heading . t)
939 (plain-list-item . nil)))
940
941(defvar-local org-agenda/setup-done nil)
942
943(add-hook 'org-agenda-after-show-hook
944 (defun org-agenda-after-show/setup ()
945 (org-narrow-to-subtree)
946 (goto-char (point-min))
947 (unless org-agenda/setup-done
948 (run-hooks 'org-mode-hook))
949 (setq org-agenda/setup-done t)))
950
951;; org-return-dwim
952;; https://github.com/alphapapa/unpackaged.el,
953;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
954(defun org-return-dwim (&optional arg)
955 "A helpful replacement for `org-return'.
956When called interactively with \\[universal-argument], call `org-return'
957itself. Other values of ARG will call `newline' with that ARG."
958 (interactive "P")
959 ;; Auto-fill if enabled
960 (when auto-fill-function
961 (dolist (func (ensure-list auto-fill-function))
962 (funcall func)))
963 (cl-letf* ((el (org-element-at-point))
964 ((symbol-function 'el-child-of)
965 (lambda (&rest types)
966 (org-element-lineage el types t))))
967 (cond ; Figure out what we're going to do
968 (arg ; Handle prefix ARG
969 (pcase arg
970 ('(4) (org-return t nil t))
971 (_ (newline arg t))))
972 ((and org-return-follows-link ; Open a link
973 (el-child-of 'link))
974 (org-open-at-point-global))
975 ((org-at-heading-p) ; Open a paragraph after a heading
976 (let ((heading-start (org-entry-beginning-position)))
977 (goto-char (org-entry-end-position))
978 (cond ((and (org-at-heading-p) ; Entry is only a heading
979 (= heading-start (org-entry-beginning-position)))
980 (end-of-line)
981 (newline 2))
982 (:else ; Entry is more than a heading
983 (forward-line -1)
984 (end-of-line)
985 (when (org-at-heading-p)
986 ;; Open a paragraph
987 (forward-line)
988 (newline)
989 (forward-line -1))
990 (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
991 (newline))
992 (forward-line -1)))))
993 ((org-at-item-checkbox-p) ; Insert a new checkbox item
994 (end-of-line)
995 (org-insert-todo-heading nil))
996 ((org-in-item-p) ; Insert a new list item
997 (let* ((context (org-element-context el))
998 (first-item-p (eq 'plain-list (car context)))
999 (itemp (eq 'item (car context)))
1000 (emptyp (or
1001 ;; This (regular) list item is empty
1002 (eq (org-element-property :contents-begin context)
1003 (org-element-property :contents-end context))
1004 ;; This (definition) list item is empty
1005 (looking-at " *::")))
1006 (item-child-p (el-child-of 'item)))
1007 (cond ((and itemp emptyp)
1008 ;; This test has to be here even though it's the same as the
1009 ;; :else clause, because an item that's empty will also satisfy
1010 ;; the next clause.
1011 (delete-region (line-beginning-position) (line-end-position))
1012 (newline))
1013 ((or first-item-p
1014 (and itemp (not emptyp))
1015 item-child-p)
1016 (org-end-of-item)
1017 (org-insert-item))
1018 (:else
1019 (delete-region (line-beginning-position) (line-end-position))
1020 (newline)))))
1021 ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
1022 (org-inlinetask-in-task-p))
1023 (org-return))
1024 ((org-at-table-p) ; Insert a new table row
1025 (cond ((save-excursion ; Empty row: end the table
1026 (beginning-of-line)
1027 (cl-loop with end = (line-end-position)
1028 for cell = (org-element-table-cell-parser)
1029 always (eq (org-element-property :contents-begin cell)
1030 (org-element-property :contents-end cell))
1031 while (re-search-forward "|" end t)))
1032 (delete-region (line-beginning-position) (line-end-position))
1033 (org-return))
1034 (:else ; Non-empty row
1035 (org-return))))
1036 (:else ; Something else
1037 (org-return)))))
1038
1039(defun org-table-copy-down|org-return-dwim (&optional n)
1040 "Call `org-table-copy-down' or `+org-return' depending on context."
1041 (interactive "P")
1042 (if (org-table-check-inside-data-field 'noerror)
1043 (org-table-copy-down (or n 1))
1044 (org-return-dwim n)))
1045
1046(defmacro org-insert-or-surround (character)
1047 (let ((c (gensym)))
1048 `(defun ,(intern (format "org-insert-or-surround-%s" character)) (arg)
1049 ,(format "Insert %s or surround the region with it." character)
1050 (interactive "p")
1051 (let ((,c ,(if (stringp character)
1052 (string-to-char character)
1053 character)))
1054 (if (org-region-active-p)
1055 (let ((begin (region-beginning))
1056 (end (region-end)))
1057 (save-mark-and-excursion
1058 (deactivate-mark)
1059 (goto-char begin)
1060 (self-insert-command arg ,c)
1061 (goto-char (+ 1 end))
1062 (self-insert-command arg ,c)))
1063 (self-insert-command arg ,c))))))
1064
1065(with-eval-after-load 'org
1066 (keymap-set org-mode-map "RET" #'org-return-dwim)
1067 (keymap-set org-mode-map "S-<return>" #'org-table-copy-down|org-return-dwim)
1068 (keymap-set org-mode-map "*" (org-insert-or-surround "*"))
1069 (keymap-set org-mode-map "/" (org-insert-or-surround "/"))
1070 (keymap-set org-mode-map "_" (org-insert-or-surround "_"))
1071 (keymap-set org-mode-map "=" (org-insert-or-surround "="))
1072 (keymap-set org-mode-map "~" (org-insert-or-surround "~"))
1073 (keymap-set org-mode-map "+" (org-insert-or-surround "+")))
1074
1075;; Copy rich text to the keyboard
1076(defcustom clipboard-html-copy-program
1077 (if (or (equal "wayland"
1078 (getenv "XDG_SESSION_TYPE"))
1079 (getenv "WAYLAND_DISPLAY"))
1080 '("wl-copy" "-t" "text/html")
1081 '("xclip" "-t" "text/html" "-selection" "clipboard"))
1082 "Program to use to copy HTML to the clipboard.
1083Should be a list of strings---the command line.
1084Defaults to 'wl-copy' on wayland and 'xclip' on Xorg."
1085 :type '(repeat string))
1086
1087(defun org-export-html-copy (&rest org-export-args)
1088 "Export current org buffer to HTML and copy to clipboard as rich text.
1089ORG-EXPORT-ARGS are passed to `org-export-to-buffer'."
1090 (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
1091 (apply #'org-export-to-buffer 'html buf org-export-args)
1092 (with-current-buffer buf
1093 (apply #'call-process-region
1094 (point-min)
1095 (point-max)
1096 (car clipboard-html-copy-program)
1097 nil ; don't delete text
1098 nil ; discard the output
1099 nil ; don't redisplay
1100 (cdr clipboard-html-copy-program))
1101 (kill-buffer-and-window))
1102 (message "HTML copied to clipboard.")))
1103
1104(defun org-subtree-to-html-to-clipboard ()
1105 "Export current subtree to HTML."
1106 (interactive)
1107 (org-export-html-copy nil :subtree))
1108
1109;; (info "(org) Breaking Down Tasks")
1110(defun org-summary-todo (n-done n-not-done)
1111 "Switch entry to DONE when all subentries are done, to TODO otherwise."
1112 (let (org-log-done org-log-states) ; turn off logging
1113 (org-todo (if (= n-not-done 0) "DONE" "TODO"))))
1114(add-hook 'org-after-todo-statistics-hook #'org-summary-todo)
1115
1116;; Clean up the buffer view
1117(defun org-hide-drawers-except-point ()
1118 "Hide all drawers except for the one point is in."
1119 ;; Most of this bit is taken from `org-fold--hide-drawers'.
1120 (let ((pt (point))
1121 (begin (point-min))
1122 (end (point-max)))
1123 (save-excursion
1124 (goto-char begin)
1125 (while (and (< (point) end)
1126 (re-search-forward org-drawer-regexp end t))
1127 (if (org-fold-folded-p nil 'drawer)
1128 (goto-char (org-fold-next-folding-state-change 'drawer nil end))
1129 (let* ((drawer (org-element-at-point))
1130 (type (org-element-type drawer))
1131 (el-begin (org-element-property :begin drawer))
1132 (el-end (org-element-property :end drawer)))
1133 (when (memq type '(drawer property-drawer))
1134 (org-fold-hide-drawer-toggle
1135 (if (< el-begin pt el-end) 'off 'on)
1136 nil drawer)
1137 (goto-char el-end))))))))
1138(add-local-mode-hook 'org-mode-hook 'before-save-hook
1139 #'org-hide-drawers-except-point)
1140
1141;; Fix braindead behavior
1142(with-eval-after-load 'org-mouse
1143 (defun org--mouse-open-at-point (orig-fun &rest args)
1144 (let ((context (org-context)))
1145 (cond
1146 ;; Don't org-cycle when clicking on headline stars. The biggest problem
1147 ;; is that this function advises `org-open-at-point', so I can't C-c C-o
1148 ;; from a headline star.
1149 ;; ((assq :headline-stars context) (org-cycle))
1150 ((assq :checkbox context) (org-toggle-checkbox))
1151 ((assq :item-bullet context)
1152 (let ((org-cycle-include-plain-lists t)) (org-cycle)))
1153 ((org-footnote-at-reference-p) nil)
1154 (t (apply orig-fun args))))))
1155
1156(defun define-org-capture-template (description &rest args)
1157 "Define an template for `org-capture-templates'.
1158Will not replace an existing template unless `:force' in ARGS is
1159non-nil. ARGS is a plist, which in addition to the additional
1160options `org-capture-templates' accepts (which see), also accepts
1161the following: `:keys', `:description', `:type', `:target', and
1162`:template'."
1163 (declare (indent 1))
1164 (let* ((keys (plist-get args :keys))
1165 (type (plist-get args :type))
1166 (target (plist-get args :target))
1167 (template (plist-get args :template))
1168 (force (plist-get args :force))
1169 (template-value
1170 (append
1171 (list description)
1172 (when (or type target template)
1173 (list (or type 'entry) target template))
1174 (cl-loop for i from 0 below (length args) by 2
1175 unless (member (nth i args)
1176 '( :keys :description :type
1177 :target :template))
1178 append (list (nth i args)
1179 (plist-get args (nth i args)))))))
1180 (if (seq-find (lambda (el) (equal (car el) keys))
1181 org-capture-templates)
1182 (and force
1183 (setf (alist-get keys org-capture-templates nil nil #'equal)
1184 template-value))
1185 (setf org-capture-templates
1186 (append org-capture-templates
1187 (list (cons keys template-value)))))
1188 org-capture-templates))
1189
1190(add-hook 'org-mode-hook
1191 (defun org-mode-line-position ()
1192 (setq-local mode-line-position
1193 '((:propertize
1194 ("" mode-line-percent-position)
1195 local-map mode-line-column-line-number-mode-map
1196 display (min-width (5.0)))
1197 (org-word-count-mode org-word-count-string))))
1198 (setq mode-line-misc-info
1199 (delete '(org-word-count-mode org-word-count-string)
1200 mode-line-misc-info)))
1201
1202;;; Org word count
1203;; also does Flesch-Kincaid reading level.
1204;; TODO: customization ... stuff.
1205
1206(defun fk-region (start end)
1207 (interactive "r")
1208 ;; (let* ((fk-buf (get-buffer-create " *fk*"))
1209 ;; (fk-proc
1210 ;; (start-process "fk" fk-buf "/home/acdw/src/fk/fk.perl")))
1211 ;; (set-process-sentinel fk-proc #'ignore)
1212 ;; (process-send-region fk-proc start end)
1213 ;; (process-send-eof fk-proc)
1214 ;; (with-current-buffer fk-buf
1215 ;; (goto-char (point-max))
1216 ;; (forward-line -1)
1217 ;; (string-chop-newline (buffer-substring-no-properties
1218 ;; (line-beginning-position) (point-max)))))
1219
1220 (let ((shell-command-buffer-name (format " *fk/%s*" (buffer-name))))
1221 (shell-command-on-region start end "~/src/fk/fk.perl")
1222 (with-current-buffer shell-command-buffer-name
1223 (buffer-substring-no-properties (point-min) (- (point-max) 1))))
1224 )
1225
1226(defun org-word-count-region (start end &optional interactive)
1227 (interactive "r\np")
1228 (when (derived-mode-p 'org-mode)
1229 (save-window-excursion
1230 (inhibit-messages
1231 (let ((shell-command-buffer-name (format " *wc/%s*" (buffer-name)))
1232 wc fk)
1233 (shell-command-on-region start end
1234 "pandoc -t plain -f org")
1235 (with-current-buffer shell-command-buffer-name
1236 (setq wc (count-words (point-min) (point-max)))
1237 (setq fk (string-to-number (fk-region (point-min) (point-max)))))
1238 (when interactive (message "%s" wc))
1239 (list wc fk))))))
1240
1241(defvar-local org-word-count-string ""
1242 "Number of words in buffer.")
1243
1244(defun update-org-word-count-string ()
1245 (when (derived-mode-p 'org-mode)
1246 (setq org-word-count-string
1247 (apply #'format " %dw/%.2ffk"
1248 (org-word-count-region (point-min) (point-max))))))
1249
1250(defvar org-word-count-timer nil
1251 "Timer for `org-word-count'.")
1252
1253(define-minor-mode org-word-count-mode
1254 "Count words and update the org-word-count-string."
1255 :lighter " owc"
1256 (cond
1257 ((and (derived-mode-p 'org-mode)
1258 org-word-count-mode)
1259 (unless (timerp org-word-count-timer)
1260 (setq org-word-count-timer
1261 (run-with-idle-timer 1 t #'update-org-word-count-string))))
1262 (:else
1263 (when (timerp org-word-count-timer)
1264 (cancel-timer org-word-count-timer))
1265 (setq org-word-count-timer nil)
1266 (setq org-word-count-mode nil))))
1267(hide-minor-mode 'org-word-count-mode)
1268
1269(add-hook 'org-mode-hook #'org-word-count-mode)
1270
1271;;; Org recentering
1272
1273(defun org-recenter (&optional arg)
1274 (interactive "P")
1275 (if (or arg
1276 (eq last-command 'org-recenter))
1277 (recenter-top-bottom arg)
1278 (save-excursion
1279 (unless (org-at-heading-p)
1280 (ignore-errors (org-previous-visible-heading 1)))
1281 (recenter-top-bottom 0))))
1282(with-eval-after-load 'org
1283 (keymap-set org-mode-map "C-l" #'org-recenter))
1284
1285;;; Org links -- extra types
1286
1287(with-eval-after-load 'ol
1288 (org-link-set-parameters "tel" :follow #'ignore)
1289 (org-link-set-parameters "sms" :follow #'ignore))
1290
1291
1292;;; Jabber
1293
1294;; (when (package-ensure 'jabber t t)
1295;; (setopt jabber-chat-buffer-format "*%n*")
1296;; (setopt jabber-browse-buffer-format "*%n*")
1297;; (setopt jabber-groupchat-buffer-format "*%n*")
1298;; (setopt jabber-muc-private-buffer-format "*%n*")
1299
1300;; (face-spec-set 'jabber-activity-face
1301;; '((t :inherit jabber-chat-prompt-foreign
1302;; :foreground unspecified
1303;; :weight normal)))
1304;; (face-spec-set 'jabber-activity-personal-face
1305;; '((t :inherit jabber-chat-prompt-local
1306;; :foreground unspecified
1307;; :weight bold)))
1308;; (face-spec-set 'jabber-chat-prompt-local
1309;; '((t :inherit minibuffer-prompt
1310;; :foreground unspecified
1311;; :weight normal
1312;; :slant italic)))
1313;; (face-spec-set 'jabber-chat-prompt-foreign
1314;; '((t :inherit warning
1315;; :foreground unspecified
1316;; :weight normal)))
1317;; (face-spec-set 'jabber-chat-prompt-system
1318;; '((t :inherit font-lock-doc-face
1319;; :foreground unspecified)))
1320;; (face-spec-set 'jabber-rare-time-face
1321;; '((t :inherit font-lock-comment-face
1322;; :foreground unspecified
1323;; :underline nil)))
1324
1325;; (setopt jabber-auto-reconnect t)
1326;; (setopt jabber-last-read-marker
1327;; "-------------------------------------------------------------------")
1328;; (setopt jabber-muc-decorate-presence-patterns
1329;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
1330;; ("Mode #.*" . jabber-muc-presence-dim)
1331;; ("." . jabber-muc-presence-dim)))
1332;; (setopt jabber-activity-make-strings #'jabber-activity-make-strings-shorten)
1333;; (setopt jabber-rare-time-format
1334;; (format " - - - - - %%H:%d %%F"
1335;; (let ((min (string-to-number (format-time-string "%M"))))
1336;; (* 5 (floor min 5)))))
1337;; (setopt jabber-muc-header-line-format '(" " jabber-muc-topic))
1338
1339;; (setopt jabber-groupchat-prompt-format "%n. ")
1340;; (setopt jabber-chat-local-prompt-format "%n. ")
1341;; (setopt jabber-chat-foreign-prompt-format "%n. ")
1342;; (setopt jabber-muc-private-foreign-prompt-format "%g/%n. ")
1343
1344;; (defun jabber-connect-all* (&optional arg)
1345;; "Connect to all defined jabber accounts.
1346;; If called with ARG non-nil, or with \\[universal-argument],
1347;; disconnect first."
1348;; (interactive "P")
1349;; (when arg (jabber-disconnect))
1350;; (jabber-connect-all))
1351
1352;; (with-eval-after-load 'jabber
1353;; (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to)
1354;; (require 'jabber-httpupload nil t)
1355;; (map-keymap (lambda (key command)
1356;; (define-key jabber-global-keymap (vector (+ key #x60)) command))
1357;; jabber-global-keymap)
1358;; (keymap-global-set "C-x C-j" #'dired-jump)
1359;; (keymap-set jabber-global-keymap "c" #'jabber-connect-all*)
1360;; (keymap-global-set "C-c j" jabber-global-keymap))
1361
1362;; (remove-hook 'jabber-alert-muc-hooks #'jabber-muc-echo)
1363;; (remove-hook 'jabber-alert-presence-hooks #'jabber-presence-echo)
1364;; (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
1365;; (add-hook 'jabber-chat-mode-hook #'olivetti-mode)
1366;; (add-hook 'jabber-chat-mode-hook
1367;; (defun jabber-chat-mode-no-position ()
1368;; (setq-local mode-line-position nil)))
1369;; (add-hook 'jabber-alert-muc-hooks
1370;; (defun jabber@highlight-acdw (&optional _ _ buf _ _)
1371;; (when buf
1372;; (with-current-buffer buf
1373;; (let ((regexp (rx word-boundary
1374;; "acdw" ; maybe get from the config?
1375;; word-boundary)))
1376;; (hi-lock-unface-buffer regexp)
1377;; (highlight-regexp regexp 'jabber-chat-prompt-local))))))
1378
1379;; (add-hook 'jabber-chat-mode-hook
1380;; (defun electric-pair-local-disable ()
1381;; (electric-pair-local-mode -1)))
1382
1383;; (when (fboundp 'jabber-chat-update-focus)
1384;; (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)))
1385
1386
1387;;; Dired
1388
1389(keymap-global-set "C-x C-j" #'dired-jump)
1390(with-eval-after-load 'dired
1391 (keymap-set dired-mode-map "C-j" #'dired-up-directory))
1392
1393(setopt dired-auto-revert-buffer t)
1394(setopt dired-dwim-target t) ; dired-dwim-target-next ?
1395
1396
1397;;; Browsing the web
1398
1399(setopt browse-url-browser-function #'eww-browse-url)
1400
1401(defcustom browse-url-safe-browser-functions nil
1402 "\"Safe\" browser functions."
1403 :type '(repeat-function))
1404
1405(defun browse-url-browser-function-safe-p (fn)
1406 "Return t if FN is a \"safe\" browser function."
1407 (memq fn (append browse-url-safe-browser-functions
1408 (mapcar (lambda (i)
1409 (plist-get (cdr i) :value))
1410 (seq-filter (lambda (i)
1411 (eq (car i) 'function-item))
1412 (cdr (get 'browse-url-browser-function
1413 'custom-type)))))))
1414
1415(put 'browse-url-browser-function 'safe-local-variable
1416 'browse-url-browser-function-safe-p)
1417
1418;;; EWW
1419
1420(setopt eww-use-browse-url ".")
1421(setopt eww-auto-rename-buffer 'title)
1422(setopt eww-default-download-directory
1423 (or (xdg-user-dir "DOWNLOAD")
1424 "~/Downloads"))
1425(setopt eww-history-limit nil)
1426
1427(defun eww-readable/olivetti ()
1428 (interactive)
1429 (olivetti-mode +1)
1430 (eww-readable)
1431 (eww-reload t))
1432
1433(with-eval-after-load 'eww
1434 (keymap-set eww-mode-map "R" #'eww-readable/olivetti))
1435
1436;; Use Emacs bookmarks for EWW
1437(defun bookmark-eww--make ()
1438 "Make eww bookmark record."
1439 `((filename . ,(plist-get eww-data :url))
1440 (title . ,(plist-get eww-data :title))
1441 (time . ,(current-time-string))
1442 (handler . ,#'bookmark-eww-handler)
1443 (defaults . (,(concat
1444 ;; url without the https and path
1445 (replace-regexp-in-string
1446 "/.*" ""
1447 (replace-regexp-in-string
1448 "\\`https?://" ""
1449 (plist-get eww-data :url)))
1450 " - "
1451 ;; page title
1452 (replace-regexp-in-string
1453 "\\` +\\| +\\'" ""
1454 (replace-regexp-in-string
1455 "[\n\t\r ]+" " "
1456 (plist-get eww-data :title))))))))
1457
1458(defun bookmark-eww-handler (bm)
1459 "Handler for eww bookmarks."
1460 (eww-browse-url (alist-get 'filename bm)))
1461
1462(defun bookmark-eww--setup ()
1463 "Setup eww bookmark integration."
1464 (setq-local bookmark-make-record-function #'bookmark-eww--make))
1465(add-hook 'eww-mode-hook #'bookmark-eww--setup)
1466
1467(with-eval-after-load 'eww
1468 (define-key eww-mode-map "b" #'bookmark-set)
1469 (define-key eww-mode-map "B" #'bookmark-jump))
1470
1471;; Transforming URLs
1472;; `eww-transform-url' exists, but I like my package better.
1473
1474(when (package-ensure 'browse-url-transform t)
1475 (setopt browse-url-transform-alist
1476 `(;; Privacy-respecting alternatives
1477 ("twitter\\.com" . "nitter.snopyta.org")
1478 ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de")
1479 ("medium\\.com" . "scribe.rip")
1480 ;; Text-mode of non-text-mode sites
1481 ("www\\.npr\\.org" . "text.npr.org")
1482 ;; Ask for raw versions of paste sites
1483 ("^.*dpaste\\.com.*$" . "\\&.txt")
1484 ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1")
1485 ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2")
1486 ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2")
1487 ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2")))
1488 (browse-url-transform-mode)
1489 (hide-minor-mode 'browse-url-transform-mode))
1490
1491(with-eval-after-load 'browse-url-transform
1492 (setq eww-url-transformers ; `setopt' causes a warning about custom-type
1493 '(eww-remove-tracking
1494 browse-url-transform-url)))
1495
1496;; External browsers: firefox > chromium > chrome
1497(setq browse-url-firefox-program
1498 (or (executable-find "firefox")
1499 (executable-find "firefox-esr"))
1500 browse-url-firefox-new-window-is-tab t
1501 browse-url-firefox-arguments '("--new-tab")
1502
1503 browse-url-chromium-program
1504 (or (executable-find "chromium")
1505 (executable-find "chromium-browser"))
1506
1507 browse-url-chrome-program
1508 (or (executable-find "chrome")
1509 (executable-find "google-chrome-stable"))
1510
1511 browse-url-secondary-browser-function
1512 (cond (browse-url-firefox-program #'browse-url-firefox)
1513 (browse-url-chromium-program #'browse-url-chromium)
1514 (browse-url-chrome-program #'browse-url-chrome)
1515 (t #'browse-url-default-browser)))
1516
1517(defmacro open-url-with (commandline &optional buffer error-buffer)
1518 (let ((buffer (or buffer " *open-url-with*"))
1519 (error-buffer (or error-buffer " *open-url-with/errors*")))
1520 `(lambda (url &rest _)
1521 (cl-letf (((alist-get ,buffer
1522 display-buffer-alist
1523 nil nil #'equal)
1524 '(display-buffer-no-window)))
1525 (async-shell-command (format ,commandline url)
1526 ,buffer
1527 ,error-buffer)))))
1528
1529(defun add-browse-url-handler (regexp opener)
1530 "Add OPENER to open REGEXP urls."
1531 (setf/assoc browse-url-handlers
1532 regexp
1533 opener))
1534
1535(add-browse-url-handler (rx (or (: ".pdf" eos)
1536 (: ".PDF" eos)))
1537 (open-url-with "zathura %s"))
1538(add-browse-url-handler (rx (or (: ".mp4" eos)
1539 "youtube.com"
1540 "piped.kavin.rocks"))
1541 (open-url-with "mpv %s"))
1542
1543(when (package-ensure 'elpher)
1544 (add-browse-url-handler (rx bos "gemini:")
1545 #'elpher-browse-url-elpher))
1546
1547;; Hinting at links
1548(when (package-ensure 'link-hint)
1549 (setopt link-hint-avy-style 'at-full)
1550 (setopt link-hint-avy-all-windows t)
1551 (defvar link-hint-map
1552 (define-keymap
1553 :name "Open a link"
1554 :prefix 'link-hint-map
1555 "M-l" #'link-hint-open-link
1556 "M-w" #'link-hint-copy-link))
1557 (keymap-global-set "M-l" 'link-hint-map))
1558
1559
1560;;; Eshell
1561
1562(setopt eshell-modules-list
1563 '(eshell-alias
1564 eshell-banner
1565 eshell-basic
1566 eshell-cmpl
1567 eshell-dirs
1568 eshell-elecslash
1569 eshell-extpipe
1570 eshell-glob
1571 eshell-hist
1572 eshell-ls
1573 eshell-pred
1574 eshell-prompt
1575 eshell-script
1576 eshell-smart
1577 eshell-unix))
1578
1579(setopt eshell-banner-message "")
1580(setopt eshell-destroy-buffer-when-process-dies t)
1581(setopt eshell-error-if-no-glob t)
1582(setopt eshell-hist-ignoredups 'erase)
1583(setopt eshell-kill-on-exit t)
1584(setopt eshell-prefer-lisp-functions t)
1585(setopt eshell-prefer-lisp-variables t)
1586(setopt eshell-scroll-to-bottom-on-input 'this)
1587(setopt eshell-history-size 1024)
1588(setopt eshell-input-filter (lambda (input)
1589 (or (eshell-input-filter-default input)
1590 (eshell-input-filter-initial-space input))))
1591(setopt eshell-prompt-function
1592 (lambda ()
1593 (concat (if (= 0 eshell-last-command-status)
1594 "^_^"
1595 ";_;")
1596 " "
1597 (abbreviate-file-name (eshell/pwd))
1598 (if (= (user-uid) 0)
1599 " # "
1600 " $ "))))
1601(setopt eshell-scroll-to-bottom-on-input 'this)
1602
1603(add-hook 'eshell-mode-hook
1604 (defun eshell-setup ()
1605 (setq-local outline-regexp eshell-prompt-regexp)
1606 (setq-local page-delimiter eshell-prompt-regexp)
1607 (setq-local imenu-generic-expression
1608 '(("Prompt" " \\($\\|#\\) \\(.*\\)" 2)))
1609 (setq-local truncate-lines t)))
1610
1611(setenv "PAGER" (executable-find "cat"))
1612
1613(setopt eshell-where-to-jump 'begin)
1614(setopt eshell-review-quick-commands nil)
1615(setopt eshell-smart-space-goes-to-end t)
1616
1617(when (package-ensure 'eat)
1618 (add-hook 'eshell-first-time-mode-hook #'eat-eshell-mode)
1619 (with-eval-after-load 'eat
1620 (keymap-unset eat-eshell-semi-char-mode-map "M-o" t)))
1621
1622(if (package-ensure 'eshell-toggle)
1623 (keymap-global-set "C-z" #'eshell-toggle)
1624 ;; If the package doesn't load for some reason, do the dumb thing instead
1625 (defun eshellp (buffer-or-name)
1626 (with-current-buffer buffer-or-name
1627 (derived-mode-p 'eshell-mode)))
1628
1629 (defun eshell-pop-up (&optional arg)
1630 "Pop up an eshell in the `default-directory'.
1631NEW is passed to `eshell'."
1632 (interactive "P")
1633 (require 'eshell)
1634 (let ((dir default-directory)
1635 (display-comint-buffer-action 'pop-to-buffer))
1636 (if-let ((buf (and (not arg)
1637 (or (get-buffer eshell-buffer-name)
1638 (seq-find #'eshellp (reverse (buffer-list)))))))
1639 (pop-to-buffer buf)
1640 (eshell arg))
1641 ;; In the eshell buffer
1642 (unless (file-equal-p default-directory dir)
1643 (eshell/cd dir)
1644 (eshell-send-input)
1645 (goto-char (point-max)))))
1646
1647 (keymap-global-set "C-z" #'eshell-pop-up)
1648 (with-eval-after-load 'esh-mode
1649 (keymap-set eshell-mode-map "C-z" #'quit-window)))
1650
1651(when (package-ensure 'wiki-abbrev t)
1652 (wiki-abbrev-insinuate)
1653 (add-hook 'text-mode-hook #'abbrev-mode))
1654
1655;;; Dinghie
1656
1657(add-to-list 'mode-line-misc-info
1658 '(buffer-ding-cookie (:propertize buffer-ding-cookie
1659 face error))
1660 :append)
1661
1662(defvar buffer-ding-timer nil
1663 "Timer for `buffer-ding'.")
1664(defvar buffer-ding-cookie nil
1665 "Variable to hold the `face-remap-add-relative' cookie.")
1666(defcustom buffer-ding-timeout 0.25
1667 "How long to ding the buffer for.")
1668
1669(defun buffer-unding ()
1670 "Unflash the buffer after done `ding'ing."
1671 ;; (face-remap-remove-relative buffer-ding-cookie)
1672 (setq buffer-ding-cookie nil)
1673 (force-mode-line-update t))
1674
1675(defun buffer-ding ()
1676 "Flash the buffer for `ding'."
1677 (cond
1678 ((timerp buffer-ding-timer)
1679 (cancel-timer buffer-ding-timer)
1680 (setq buffer-ding-timer nil)
1681 (buffer-ding))
1682 ((and (null buffer-ding-timer)
1683 buffer-ding-cookie)
1684 (setq buffer-ding-cookie nil)
1685 (buffer-unding))
1686 (t
1687 ;; (setq buffer-ding-cookie (face-remap-add-relative 'default 'error))
1688 (setq buffer-ding-cookie " Ding!")
1689 (force-mode-line-update)
1690 (run-with-timer buffer-ding-timeout nil #'buffer-unding))))
1691
1692;; (setopt ring-bell-function (lambda () (pulse-momentary-highlight-region
1693;; (window-start) (window-end))))
1694
1695(setopt ring-bell-function #'buffer-ding)
1696(add-hook 'isearch-mode-end-hook #'buffer-unding)
1697
1698(defun mapc-buffers (fn &rest modes)
1699 (cl-loop for buf being the buffers
1700 do (with-current-buffer buf
1701 (when (or (null modes)
1702 (apply #'derived-mode-p modes))
1703 (funcall fn)))))
1704
1705(defun mapc-buffers/progress (msg fn &rest modes)
1706 (dolist-with-progress-reporter (buf (buffer-list)) msg
1707 (with-current-buffer buf
1708 (when (or (null modes)
1709 (apply #'derived-mode-p modes))
1710 (funcall fn)))))
1711
1712;;; Flash!
1713
1714(defun flash-region@ (orig start end &rest args)
1715 (apply orig start end args)
1716 (pulse-momentary-highlight-region start end))
1717
1718(advice-add 'eval-region :around #'flash-region@)
1719(with-eval-after-load 'geiser
1720 (advice-add 'geiser-eval-region :around #'flash-region@))
1721
1722;;; KeepassXC Integration
1723
1724(when (package-ensure 'keepassxc-shim t)
1725 (keepassxc-shim-activate))
1726
1727;;; RCIRC
1728
1729(when (require 'rcirc)
1730 (setopt rcirc-default-full-name user-full-name)
1731 (setopt rcirc-default-user-name user-login-name)
1732 (setopt rcirc-authenticate-before-join t)
1733 (setopt rcirc-display-server-buffer nil)
1734 (setopt rcirc-buffer-maximum-lines 1000)
1735 (setopt rcirc-kill-channel-buffers t)
1736 (setopt rcirc-track-ignore-server-buffer-flag t)
1737
1738 ;; Theming
1739 (setopt rcirc-prompt "%t> ")
1740 (setopt rcirc-default-part-reason "See You Space Cowboy . . .")
1741 (setopt rcirc-default-quit-reason "(TLS connection improperly terminated)")
1742 (setopt rcirc-url-max-length 24)
1743 (setopt rcirc-response-formats
1744 '(("PRIVMSG" . "<%N> %m")
1745 ("NOTICE" . "-%N- %m")
1746 ("ACTION" . "* %N %m")
1747 ("COMMAND" . "%fs%m%f-")
1748 ("ERROR" . "%fw!!! %m")
1749 ("FAIL" . "(%fwFAIL%f-) %m")
1750 ("WARN" . "(%fwWARN%f-) %m")
1751 ("NOTE" . "(%fwNOTE%f-) %m")
1752 (t . "%fp*** %fs%n %r %m")))
1753
1754 (face-spec-set 'rcirc-nick-in-message-full-line
1755 '((t :foreground unspecified
1756 :background unspecified
1757 :weight unspecified
1758 :inherit nil)))
1759
1760 (add-to-list 'rcirc-omit-responses "NAMES")
1761
1762 (defun chat/setup ()
1763 (whitespace-mode -1)
1764 (electric-pair-local-mode -1)
1765 ;; IDK what's the deal with this
1766 (olivetti-mode +1)
1767 (visual-line-mode -1)
1768 (word-wrap-whitespace-mode +1))
1769
1770 (setq rcirc-debug-flag t)
1771
1772 (advice-add 'rcirc :after
1773 (defun enable-rcirc-track-minor-mode (&rest _)
1774 (rcirc-track-minor-mode 1)))
1775
1776 (defun rcirc-kill ()
1777 "Kill all rcirc buffers and turn off `rcirc-track-minor-mode'."
1778 (interactive)
1779 (mapc-buffers/progress "Killing rcirc buffers..."
1780 (lambda ()
1781 (let ((kill-buffer-hook))
1782 (kill-buffer)))
1783 'rcirc-mode)
1784 (dolist-with-progress-reporter (server rcirc-server-alist)
1785 "Removing cached passwords..."
1786 (when-let ((pwf (plist-get server :password-function)))
1787 (setf (plist-get server :password)
1788 pwf)))
1789 (rcirc-track-minor-mode -1))
1790
1791 (add-hook 'rcirc-mode-hook #'chat/setup)
1792 (add-hook 'rcirc-mode-hook #'rcirc-omit-mode)
1793 (add-hook 'rcirc-track-minor-mode-hook
1794 (defun rcirc-track@buffer-list-change ()
1795 (add-hook 'buffer-list-update-hook
1796 #'rcirc-window-configuration-change)))
1797
1798 ;; "Fix" some things
1799 (setf rcirc-implemented-capabilities
1800 ;; I don't use these, and they mess up display in a few of my chats
1801 (delete "message-tags" rcirc-implemented-capabilities))
1802
1803 ;; Adding servers more better-er
1804 (defun rcirc-add-server (name &rest spec)
1805 "Add a server to `rcirc-server-alist' and `rcirc-authinfo' at once.
1806TODO: fully document"
1807 (let ((name* (if (plist-get spec :host)
1808 (plist-get spec :host)
1809 name))
1810 (nick (or (plist-get spec :nick)
1811 (bound-and-true-p rcirc-default-nick)
1812 (bound-and-true-p user-login-name)))
1813 (user-name (or (plist-get spec :user-name)
1814 (plist-get spec :user)
1815 (plist-get spec :nick)
1816 (bound-and-true-p rcirc-default-user-name)
1817 (bound-and-true-p rcirc-default-nick)
1818 (bound-and-true-p user-login-name)))
1819 (password (let ((password (or (plist-get spec :password)
1820 (plist-get spec :pass))))
1821 ;; (cond
1822 ;; ((functionp password) (funcall password))
1823 ;; ((stringp password) password))
1824 password
1825 )))
1826 ;; Add the server to `rcirc-server-alist'
1827 (setf (alist-get name* rcirc-server-alist nil nil #'equal)
1828 (append
1829 (list :nick nick
1830 :user-name user-name)
1831 (when password (list :password password))
1832 (when-let ((full-name (plist-get spec :full-name)))
1833 (list :full-name full-name))
1834 (when-let ((channels (plist-get spec :channels)))
1835 (list :channels channels))
1836 (when-let ((port (plist-get spec :port)))
1837 (list :port port))
1838 (when-let ((encryption (plist-get spec :encryption)))
1839 (list :encryption encryption))
1840 (when-let ((server-alias (or (plist-get spec :server-alias)
1841 (and (plist-get spec :host)
1842 name))))
1843 (list :server-alias server-alias))))
1844 ;; Add it to `rcirc-authinfo'
1845 (when-let ((auth (plist-get spec :auth)))
1846 (unless password (user-error "Trying to auth without a password"))
1847 (setf (alist-get name* rcirc-authinfo nil nil #'equal)
1848 (cl-case auth
1849 (nickserv (list 'nickserv nick password))
1850 (bitlbee (list 'bitlbee nick password))
1851 (quakenet (list 'quakenet user-name password))
1852 (sasl (list 'sasl user-name password))
1853 ;; (chanserv) ; These two aren't supported.
1854 ;; (certfp)
1855 (t (user-error "Unsupported :auth type `%s'"
1856 (plist-get plist :auth))))))
1857 ;; Return the server's name so that we don't leak authinfo
1858 name))
1859
1860 (defun rcirc-resolve-passwords (&rest _)
1861 (dolist-with-progress-reporter (s rcirc-server-alist)
1862 "Resolving lambda passwords in `rcirc-server-alist...'"
1863 (let ((pw (plist-get (cdr s) :password)))
1864 (setf (plist-get (cdr s) :password-function) pw)
1865 (setf (plist-get (cdr s) :password)
1866 (if (functionp pw) (funcall pw) pw))))
1867 (dolist-with-progress-reporter (i rcirc-authinfo)
1868 "Resolving lambda passwords in `rcirc-authinfo...'"
1869 (let ((pw (cadddr i)))
1870 (setf (cadddr i)
1871 (if-let ((s (assoc (car i) rcirc-server-alist)))
1872 (plist-get (cdr s) :password)
1873 (if (functionp pw) (funcall pw) pw))))))
1874
1875 (advice-add 'rcirc :before #'rcirc-resolve-passwords)
1876
1877 (defun rcirc/password (&rest spec)
1878 (lambda ()
1879 (auth-info-password
1880 (car
1881 (apply #'auth-source-search spec)))))
1882
1883 (setq rcirc-server-alist nil)
1884
1885 (rcirc-add-server "tilde.town"
1886 :host "localhost" :port 6969
1887 :channels '("#tildetown" "#newbirc")
1888 :auth 'sasl
1889 :password
1890 (rcirc/password :host "localhost:6969" :user "acdw"))
1891 ;; (rcirc-add-server "43beans.casa"
1892 ;; :host "localhost" :port 6970
1893 ;; :channels '("#beans")
1894 ;; :auth nil
1895 ;; :password nil)
1896 (rcirc-add-server "tilde.chat"
1897 :host "irc.tilde.chat" :port 6697 :encryption 'tls
1898 ;; :channels left blank. There's some kind of race
1899 ;; condition in SASL and identd that means I authenticate
1900 ;; before being fully authenticated? Or something.
1901 ;; Tilde.chat's NickServ does autojoin, though, so that
1902 ;; works out without an afternoon of debugging.
1903 :auth 'sasl
1904 :password (rcirc/password :host "tilde.chat" :user "acdw"))
1905 (rcirc-add-server "m455.casa"
1906 :port 6697 :encryption 'tls
1907 :channels '("#basement" "#43beans")
1908 :auth 'sasl
1909 :password (rcirc/password :host "m455.casa" :user "acdw"))
1910 (rcirc-add-server "libera.chat"
1911 :host "irc.libera.chat" :port 6697 :encryption 'tls
1912 :channels '("#emacs" "#rcirc")
1913 :auth 'sasl
1914 :password (rcirc/password :host "libera.chat" :user "acdw"))
1915 ;; End of rcirc configuration.
1916 )
1917
1918(when (package-ensure 'web-mode)
1919 (add-to-list 'auto-mode-alist '("\\.html?\\'" . web-mode))
1920 (add-to-list 'auto-mode-alist '("\\.phtml\\'" . web-mode))
1921 (add-to-list 'auto-mode-alist '("\\.tpl\\.php\\'" . web-mode))
1922 (add-to-list 'auto-mode-alist '("\\. [agj]sp\\'" . web-mode))
1923 (add-to-list 'auto-mode-alist '("\\.as[cp]x\\'" . web-mode))
1924 (add-to-list 'auto-mode-alist '("\\.erb\\'" . web-mode))
1925 (add-to-list 'auto-mode-alist '("\\.mustache\\'" . web-mode))
1926 (add-to-list 'auto-mode-alist '("\\.djhtml\\'" . web-mode)))