about summary refs log tree commit diff stats
diff options
context:
space:
mode:
-rw-r--r--.gitattributes5
-rw-r--r--.gitignore35
-rw-r--r--basics.el680
-rw-r--r--definitions.el149
-rw-r--r--early-init.el58
-rw-r--r--init.el1623
-rw-r--r--lisp/+completions.el65
-rw-r--r--lisp/+link-hint.el175
-rw-r--r--lisp/+org-capture.el49
-rw-r--r--lisp/+scratch.el75
-rw-r--r--lisp/acdw-chat.el206
-rw-r--r--lisp/acdw-mail.el439
-rw-r--r--lisp/acdw-org.el548
-rw-r--r--lisp/acdw-shell.el141
-rw-r--r--lisp/acdw-web.el374
-rw-r--r--lisp/acdw.el384
-rw-r--r--lisp/ical2org.el56
-rw-r--r--packages.el129
18 files changed, 750 insertions, 4441 deletions
diff --git a/.gitattributes b/.gitattributes deleted file mode 100644 index 78e9377..0000000 --- a/.gitattributes +++ /dev/null
@@ -1,5 +0,0 @@
1* text eol=lf
2
3*.lisp diff=lisp
4*.el diff=lisp
5*.org diff=org
diff --git a/.gitignore b/.gitignore index 67825c8..aebf66d 100644 --- a/.gitignore +++ b/.gitignore
@@ -1,30 +1,5 @@
1*~ 1*
2.#* 2!init.el
3.* 3!packages.el
4*.elc 4!definitions.el
5.etc/ 5!.gitignore \ No newline at end of file
6.org-id-locations
7auto-save-list/
8eln-cache/
9elpa/
10etc/
11feeds.txt
12gnus/
13old/
14pkg/
15racket-mode/
16server/
17straight/
18transient/
19var/
20eshell/*
21!eshell/aliases
22url/
23spell-fu/
24yoke/
25lisp/*-autoloads.el
26
27# put random stuff in here
28scratch.el
29jabber-avatar-cache/
30tree-sitter/ \ No newline at end of file
diff --git a/basics.el b/basics.el deleted file mode 100644 index 1405c84..0000000 --- a/basics.el +++ /dev/null
@@ -1,680 +0,0 @@
1;;; basics.el --- Super basic Emacs settings -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; These are the settings that I literally cannot live without. Basic
6;; settings, built-in packages, that kind of stuff. Everything else
7;; goes in init.el.
8
9;;; Code:
10
11(push (locate-user-emacs-file "lisp/") load-path)
12(require 'acdw)
13
14;;; Directories
15
16(defdir etc/ (locate-user-emacs-file "etc/")
17 "Where various Emacs files are placed."
18 :makedir)
19
20(defdir sync/ "~/sync/"
21 "My Syncthing directory."
22 :makedir)
23
24(defdir private/ (sync/ "emacs/private/")
25 "Private files and stuff."
26 :makedir)
27
28(use-package no-littering
29 :ensure t :demand t
30 :preface
31 (setq-default no-littering-etc-directory etc/
32 no-littering-var-directory etc/))
33
34
35;;; Settings
36
37;; Async
38(setq-default async-shell-command-buffer 'new-buffer
39 async-shell-command-display-buffer nil)
40
41;; Scrolling
42(setq-default auto-hscroll-mode t
43 auto-window-vscroll nil
44 fast-but-imprecise-scrolling t
45 hscroll-margin 1
46 hscroll-step 1
47 scroll-conservatively 25
48 scroll-margin 0
49 scroll-preserve-screen-position 1
50 scroll-step 1)
51(scroll-bar-mode -1)
52(horizontal-scroll-bar-mode -1)
53
54;; Cursor
55(setq-default cursor-in-non-selected-windows 'hollow
56 cursor-type 'bar
57 blink-cursor-blinks 1
58 blink-cursor-interval 0.25
59 blink-cursor-delay 0.25)
60(blink-cursor-mode)
61
62;; Mouse
63(setq-default mouse-drag-copy-region t
64 mouse-wheel-progressive-speed nil
65 mouse-yank-at-point t)
66
67;; Dialogs
68(unless (boundp 'use-short-answers)
69 (fset 'yes-or-no-p 'y-or-n-p))
70
71(setq-default read-answer-short t
72 use-dialog-box nil
73 use-file-dialog nil
74 use-short-answers t)
75
76;; Minibuffer
77(setq-default completion-ignore-case t
78 read-buffer-completion-ignore-case t
79 read-file-name-completion-ignore-case t
80 completions-detailed t
81 enable-recursive-minibuffers t
82 file-name-shadow-properties '(invisible t intangible t)
83 minibuffer-eldef-shorten-default t
84 minibuffer-prompt-properties '( read-only t
85 cursor-intangible t
86 face minibuffer-prompt))
87(file-name-shadow-mode)
88(minibuffer-electric-default-mode)
89
90(define-minor-mode truncate-lines-local-mode
91 "Truncate lines locally in a buffer."
92 :lighter " ..."
93 :group 'display
94 (setq-local truncate-lines truncate-lines-local-mode))
95
96(add-hook 'minibuffer-setup-hook #'truncate-lines-local-mode)
97
98(require 'savehist)
99(setq-default history-length 1024
100 history-delete-duplicates t
101 ;; savehist-file (etc/ "savehist.el")
102 savehist-save-minibuffer-history t
103 savehist-autosave-interval 30)
104(savehist-mode)
105
106;; Killing and yanking
107(setq-default kill-do-not-save-duplicates t
108 kill-read-only-ok t
109 ;; XXX: This setting causes an error message the first time it's
110 ;; called: "Selection owner couldn't convert: TIMESTAMP". I have
111 ;; absolutely no idea why I get this error, but it's generated in
112 ;; `x_get_foreign_selection'. I also can't inhibit the message or
113 ;; do anything else with it, so for now, I'll just live with the
114 ;; message.
115 save-interprogram-paste-before-kill t
116 yank-pop-change-selection t)
117(delete-selection-mode)
118
119;; Notifying the user
120(setq-default echo-keystrokes 0.01
121 ring-bell-function #'ignore)
122
123;; Point and mark
124(setq-default set-mark-command-repeat-pop t)
125
126;; The system
127(setq-default read-process-output-max (* 10 1024 1024))
128
129;; Startup
130(setq-default inhibit-startup-screen t
131 initial-buffer-choice t
132 initial-scratch-message nil)
133
134(define-advice startup-echo-area-message (:override ())
135 (if (get-buffer "*Warnings*")
136 ";_;"
137 "^_^"))
138
139(menu-bar-mode -1)
140(tool-bar-mode -1)
141(tooltip-mode -1)
142
143;; Text editing
144(setq-default fill-column 80
145 sentence-end-double-space nil
146 tab-width 8
147 tab-always-indent 'complete)
148(global-so-long-mode)
149
150(setq-default show-paren-delay 0.01
151 show-paren-style 'parenthesis
152 show-paren-when-point-in-periphery t
153 show-paren-when-point-inside-paren t)
154(show-paren-mode)
155(electric-pair-mode)
156
157;; Encodings
158(set-language-environment "UTF-8")
159(setq-default buffer-file-coding-system 'utf-8-unix
160 coding-system-for-read 'utf-8-unix
161 coding-system-for-write 'utf-8-unix
162 default-process-coding-system '(utf-8-unix . utf-8-unix)
163 locale-coding-system 'utf-8-unix)
164(set-charset-priority 'unicode)
165(prefer-coding-system 'utf-8-unix)
166(set-default-coding-systems 'utf-8-unix)
167(set-terminal-coding-system 'utf-8-unix)
168(set-keyboard-coding-system 'utf-8-unix)
169(pcase system-type
170 ((or 'ms-dos 'windows-nt)
171 (set-clipboard-coding-system 'utf-16-le)
172 (set-selection-coding-system 'utf-16-le))
173 (_
174 (set-selection-coding-system 'utf-8)
175 (set-clipboard-coding-system 'utf-8)))
176
177;; Abbrev
178(setq-default abbrev-file-name (sync/ "abbrev.el")
179 save-abbrevs 'silently)
180
181;; Files
182(setq-default auto-revert-verbose nil
183 global-auto-revert-non-file-buffers t
184 create-lockfiles nil
185 find-file-visit-truename t
186 mode-require-final-newline t
187 view-read-only t
188 save-silently t)
189(global-auto-revert-mode)
190
191(setq-default auto-save-default nil
192 auto-save-interval 1
193 auto-save-no-message t
194 auto-save-timeout 1
195 auto-save-visited-interval 1
196 remote-file-name-inhibit-auto-save-visited t)
197(add-to-list 'auto-save-file-name-transforms
198 `(".*" ,(etc/ "auto-save/" t) t))
199(auto-save-visited-mode)
200
201(setq-default backup-by-copying t
202 version-control t
203 kept-new-versions 8
204 kept-old-versions 8
205 delete-old-versions t
206 backup-directory-alist
207 `(("^/dev/shm" . nil)
208 ("^/tmp" . nil)
209 (,(getenv "XDG_RUNTIME_DIR") . nil)
210 ("." . ,(no-littering-expand-etc-file-name "backup"))))
211
212(require 'recentf)
213(setq-default ;; recentf-save-file (etc/ "recentf" t)
214 recentf-max-menu-items 500
215 recentf-max-saved-items nil ; Save the whole list
216 recentf-auto-cleanup 'mode
217 recentf-case-fold-search t)
218(add-to-list 'recentf-exclude etc/)
219(add-to-list 'recentf-exclude "-autoloads.el\\'")
220(add-hook 'buffer-list-update-hook #'recentf-track-opened-file)
221(add-hook 'after-save-hook #'recentf-save-list)
222(recentf-mode)
223
224(require 'saveplace)
225(setq-default ;; save-place-file (etc/ "places.el")
226 save-place-forget-unreadable-files (eq system-type
227 'gnu/linux))
228(save-place-mode)
229
230(require 'uniquify)
231(setq uniquify-after-kill-buffer-p t
232 uniquify-buffer-name-style 'forward
233 uniquify-ignore-buffers-re "^\\*"
234 uniquify-separator path-separator)
235
236(setq-local vc-follow-symlinks t
237 vc-make-backup-files t)
238
239;; Whitespace
240(require 'whitespace)
241(setq-default whitespace-style
242 '(face trailing tabs tab-mark))
243(global-whitespace-mode)
244(add-hook 'before-save-hook
245 (defun delete-trailing-whitespace-except-current-line ()
246 (save-excursion
247 (delete-trailing-whitespace (point-min)
248 (line-beginning-position))
249 (delete-trailing-whitespace (line-end-position)
250 (point-max)))))
251
252;; Native compilation
253(setq-default native-comp-async-report-warnings-errors 'silent
254 native-comp-deferred-compilation t
255 native-compile-target-directory (etc/ "eln" t))
256(when (boundp 'native-comp-eln-load-path)
257 (add-to-list 'native-comp-eln-load-path native-compile-target-directory))
258(when (fboundp 'startup-redirect-eln-cache)
259 (startup-redirect-eln-cache native-compile-target-directory))
260
261;; Custom file
262(setq-default custom-file (private/ "custom.el"))
263(define-advice package--save-selected-packages
264 (:around (orig &rest args) no-custom)
265 "Don't save `package-selected-packages' to `custom-file'."
266 (let ((custom-file (expand-file-name "custom.el"
267 temporary-file-directory)))
268 (apply orig args)))
269
270;; Goto Address
271(if (fboundp 'global-goto-address-mode)
272 (global-goto-address-mode)
273 (add-hook 'after-change-major-mode-hook #'goto-address-mode))
274
275;; Winner
276(winner-mode)
277
278
279;;; Keybindings
280
281(defun other-window|switch-buffer (arg)
282 "Call `other-window' or `switch-buffer' depending on windows.
283When called with prefix ARG, unconditionally switch buffer."
284 (interactive "P")
285 (if (or arg (one-window-p))
286 (switch-to-buffer (other-buffer) nil t)
287 (other-window 1)))
288
289(defun delete-window|bury-buffer ()
290 "Delete the current window, or bury the current buffer.
291If the current window is the only window, bury the buffer."
292 (interactive)
293 (condition-case e
294 (delete-window)
295 (t (bury-buffer))))
296
297(defun +cycle-spacing (&optional n)
298 ;; `cycle-spacing' is wildly different in 29.1 over 28.
299 "Negate N argument on `cycle-spacing'.
300That is, with a positive N, deletes newlines as well, leaving -N
301spaces. If N is negative, it will not delete newlines and leave
302N spaces."
303 (interactive "*p")
304 (cycle-spacing (- n)))
305
306(defun +comment-dwim (&optional prefix)
307 "Comments or uncomments current line or region.
308When called with PREFIX, start a comment at the end of the
309current line."
310 (interactive "P")
311 (if prefix
312 (comment-indent)
313 (apply #'comment-or-uncomment-region
314 (if (region-active-p)
315 (list (region-beginning)
316 (region-end))
317 (list (line-beginning-position)
318 (line-end-position))))))
319
320(defun +kill-buffer (&optional buffer-or-name)
321 "Kill the current buffer, or BUFFER-OR-NAME.
322When called interactively, prompt the user when given a prefix
323argument."
324 (interactive "P")
325 (cond
326 ((bufferp buffer-or-name)
327 (kill-buffer buffer-or-name))
328 ((null buffer-or-name)
329 (kill-current-buffer))
330 (:else
331 (kill-buffer (read-buffer "Kill: " nil :require-match)))))
332
333(defun +backward-kill-word (arg)
334 "Kill ARG words backward unless at the beginning of a line.
335When at the beginning of a line, delete blank lines before point."
336 (interactive "p")
337 (cond
338 ((bolp)
339 ;; This is the first bit of `delete-blank-lines'. -- acdw
340 (let (thisblank singleblank)
341 (save-excursion
342 (beginning-of-line)
343 (setq thisblank (looking-at "[ \t]*$"))
344 ;; Set singleblank if there is just one blank line here.
345 (setq singleblank
346 (and thisblank
347 (not (looking-at "[ \t]*\n[ \t]*$"))
348 (or (bobp)
349 (progn (forward-line -1)
350 (not (looking-at "[ \t]*$")))))))
351 ;; Delete preceding blank lines, and this one too if it's the only one.
352 (if thisblank
353 (progn
354 (beginning-of-line)
355 (if singleblank (forward-line 1))
356 (delete-region (point)
357 (if (re-search-backward "[^ \t\n]" nil t)
358 (progn (forward-line 1) (point))
359 (point-min)))))
360 (if (or (not thisblank)
361 singleblank)
362 (progn
363 (beginning-of-line)
364 (backward-delete-char 1)))))
365 (:else
366 (backward-kill-word arg))))
367
368(global-set-key [remap eval-expression] #'pp-eval-expression)
369(global-set-key (kbd "M-o") #'other-window|switch-buffer)
370(global-set-key [remap delete-window] #'delete-window|bury-buffer)
371(global-set-key [remap cycle-spacing] #'+cycle-spacing)
372(global-set-key (kbd "C-x C-k") #'+kill-buffer)
373(global-set-key [remap comment-dwim] #'+comment-dwim)
374(global-set-key [remap undo] #'undo-only)
375(global-set-key [remap backward-kill-word] #'+backward-kill-word)
376
377(global-set-key [f10] #'tmm-menubar)
378(advice-add 'tmm-add-prompt :after 'minibuffer-hide-completions)
379
380(when (fboundp '+lisp-comment-or-uncomment-sexp)
381 (define-key lisp-mode-map (kbd "C-M-;") #'+lisp-comment-or-uncomment-sexp)
382 (define-key emacs-lisp-mode-map (kbd "C-M-;")
383 #'+lisp-comment-or-uncomment-sexp)
384 (with-eval-after-load 'scheme
385 (define-key scheme-mode-map (kbd "C-M-;")
386 #'+lisp-comment-or-uncomment-sexp)))
387
388(define-key emacs-lisp-mode-map (kbd "C-c C-c")
389 #'eval-defun)
390(define-key emacs-lisp-mode-map (kbd "C-c C-k")
391 #'elisp-eval-region-or-buffer)
392(define-key lisp-interaction-mode-map (kbd "C-c C-c")
393 #'eval-defun)
394(define-key lisp-interaction-mode-map (kbd "C-c C-k")
395 #'elisp-eval-region-or-buffer)
396(define-advice eval-region (:around (orig start end &rest args) pulse)
397 (apply orig start end args)
398 (pulse-momentary-highlight-region start end))
399
400(global-set-key (kbd "C-x C-b") #'ibuffer)
401
402
403;;; Hooks
404
405(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
406
407(add-hook 'find-file-not-found-functions
408 (defun create-missing-directories ()
409 "Automatically create missing directories."
410 (let ((target-dir (file-name-directory buffer-file-name)))
411 (unless (file-exists-p target-dir)
412 (make-directory target-dir :parents)))))
413
414(add-hook 'find-file-hook
415 (defun vc-remote-off ()
416 "Turn VC off when remote."
417 (when (file-remote-p (buffer-file-name))
418 (setq-local vc-handled-backends nil))))
419
420
421;;; Advice
422
423(define-advice switch-to-buffer (:after (&rest _) normal-mode)
424 "Automatically determine the mode for non-file buffers."
425 (when-let ((_ (and (eq major-mode 'fundamental-mode)))
426 (buffer-file-name (buffer-name)))
427 (normal-mode)))
428
429(define-advice canonically-space-region
430 (:around (orig &rest args) double-space-sentences)
431 "Always double-space sentences canonically."
432 (let ((sentence-end-double-space t))
433 (apply orig args)))
434
435
436;;; Packages
437
438(use-package _acdw
439 :load-path private/)
440
441(use-package custom-allowed
442 :load-path "~/src/custom-allowed.el/"
443 :config
444 (add-to-list 'custom-allowed-variables 'safe-local-variable-values)
445 (add-to-list 'custom-allowed-variables 'ispell-buffer-session-localwords)
446 (add-to-list 'custom-allowed-variables 'warning-suppress-types)
447 (add-to-list 'custom-allowed-variables 'calendar-latitude)
448 (add-to-list 'custom-allowed-variables 'calendar-longitude)
449 (add-to-list 'custom-allowed-variables 'user-full-name)
450 (add-to-list 'custom-allowed-variables 'user-mail-address)
451 :hook
452 (after-init-hook . custom-allowed-load-custom-file))
453
454(use-package sophomore
455 :load-path "~/src/sophomore.el/"
456 :config
457 (sophomore-enable-all)
458 (sophomore-disable 'view-hello-file
459 'describe-gnu-project
460 'suspend-frame)
461 (sophomore-mode))
462
463(use-package compat
464 ;; This shouldn't be necessary, but sadly I believe that it is.
465 :ensure t)
466
467(use-package vertico
468 :ensure t :demand t
469 :config
470 (setq vertico-cycle t)
471 (add-hook 'vertico-mode-hook
472 (defun vertico-mode@fix-completions ()
473 (setq completion-in-region-function
474 (if vertico-mode
475 #'consult-completion-in-region
476 #'completion--in-region))))
477 (vertico-mode))
478
479(use-package vertico-directory
480 :after vertico
481 :bind (:map vertico-map
482 ("C-<backspace>" . vertico-directory-delete-word))
483 :hook (rfn-shadow-update-overlay-hook . vertico-directory-tidy))
484
485(use-package vertico-mouse
486 :after vertico
487 :config (vertico-mouse-mode))
488
489;; Example configuration for Consult
490(use-package consult
491 :ensure t
492 ;; Replace bindings. Lazily loaded due by `use-package'.
493 :bind (;; C-c bindings (mode-specific-map)
494 ("C-c h" . consult-history)
495 ("C-c m" . consult-mode-command)
496 ("C-c k" . consult-kmacro)
497 ;; C-x bindings (ctl-x-map)
498 ("C-x M-:" . consult-complex-command)
499 ("C-x b" . consult-buffer)
500 ("C-x 4 b" . consult-buffer-other-window)
501 ("C-x 5 b" . consult-buffer-other-frame)
502 ("C-x r b" . consult-bookmark)
503 ("C-x p b" . consult-project-buffer)
504 ;; Custom M-# bindings for fast register access
505 ("M-#" . consult-register-load)
506 ("M-'" . consult-register-store)
507 ("C-M-#" . consult-register)
508 ;; Other custom bindings
509 ("M-y" . consult-yank-pop)
510 ;; M-g bindings (goto-map)
511 ("M-g e" . consult-compile-error)
512 ("M-g f" . consult-flymake)
513 ("M-g g" . consult-goto-line)
514 ("M-g M-g" . consult-goto-line)
515 ("M-g o" . consult-outline)
516 ("M-g m" . consult-mark)
517 ("M-g k" . consult-global-mark)
518 ("M-g i" . consult-imenu)
519 ("M-g I" . consult-imenu-multi)
520 ;; M-s bindings (search-map)
521 ("M-s d" . consult-find)
522 ("M-s D" . consult-locate)
523 ("M-s g" . consult-grep)
524 ("M-s G" . consult-git-grep)
525 ("M-s r" . consult-ripgrep)
526 ("M-s l" . consult-line)
527 ("M-s L" . consult-line-multi)
528 ("M-s k" . consult-keep-lines)
529 ("M-s u" . consult-focus-lines)
530 ;; Isearch integration
531 ("M-s e" . consult-isearch-history)
532 :map isearch-mode-map
533 ("M-e" . consult-isearch-history)
534 ("M-s e" . consult-isearch-history)
535 ("M-s l" . consult-line)
536 ("M-s L" . consult-line-multi)
537 ;; Minibuffer history
538 :map minibuffer-local-map
539 ("M-s" . consult-history)
540 ("M-r" . consult-history))
541
542 ;; Enable automatic preview at point in the *Completions* buffer. This is
543 ;; relevant when you use the default completion UI.
544 :hook (completion-list-mode . consult-preview-at-point-mode)
545
546 ;; The :init configuration is always executed (Not lazy)
547 :init
548
549 ;; Optionally configure the register formatting. This improves the register
550 ;; preview for `consult-register', `consult-register-load',
551 ;; `consult-register-store' and the Emacs built-ins.
552 (setq register-preview-delay 0.5
553 register-preview-function #'consult-register-format)
554
555 ;; Optionally tweak the register preview window.
556 ;; This adds thin lines, sorting and hides the mode line of the window.
557 (advice-add #'register-preview :override #'consult-register-window)
558
559 (define-advice completing-read-multiple (:filter-args (args) indicator)
560 (cons (format "[CRM%s] %s"
561 (replace-regexp-in-string
562 "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" ""
563 crm-separator)
564 (car args))
565 (cdr args)))
566
567 ;; Use Consult to select xref locations with preview
568 (setq xref-show-xrefs-function #'consult-xref
569 xref-show-definitions-function #'consult-xref)
570
571 (setq completion-in-region-function #'consult-completion-in-region)
572
573 ;; Configure other variables and modes in the :config section,
574 ;; after lazily loading the package.
575 :config
576
577 ;; Optionally configure preview. The default value
578 ;; is 'any, such that any key triggers the preview.
579 ;; (setq consult-preview-key 'any)
580 ;; (setq consult-preview-key (kbd "M-."))
581 ;; (setq consult-preview-key (list (kbd "<S-down>") (kbd "<S-up>")))
582 ;; For some commands and buffer sources it is useful to configure the
583 ;; :preview-key on a per-command basis using the `consult-customize' macro.
584 (consult-customize
585 consult-theme :preview-key '(:debounce 0.2 any)
586 consult-ripgrep consult-git-grep consult-grep
587 consult-bookmark consult-recent-file consult-xref
588 consult--source-bookmark consult--source-file-register
589 consult--source-recent-file consult--source-project-recent-file
590 ;; :preview-key (kbd "M-.")
591 :preview-key '(:debounce 0.4 any))
592
593 ;; (consult-customize consult-line
594 ;; consult-ripgrep
595 ;; :initial (when (use-region-p)
596 ;; (buffer-substring-no-properties
597 ;; (region-beginning) (region-end))))
598
599 ;; Optionally configure the narrowing key.
600 ;; Both < and C-+ work reasonably well.
601 (setq consult-narrow-key "<") ;; (kbd "C-+")
602
603 ;; Optionally make narrowing help available in the minibuffer.
604 ;; You may want to use `embark-prefix-help-command' or which-key instead.
605 (define-key consult-narrow-map (vconcat consult-narrow-key "?")
606 #'consult-narrow-help))
607
608(use-package orderless
609 :ensure t :demand t
610 :init
611 (setq completion-styles '(orderless substring basic)
612 completion-category-defaults nil
613 completion-category-overrides
614 '((file (styles basic partial-completion orderless)))))
615
616(use-package marginalia
617 :ensure t :demand t
618 :config
619 (marginalia-mode))
620
621(use-package embark
622 :ensure t
623 :bind
624 (("C-." . embark-act)
625 ("M-." . embark-dwim)
626 ("C-h B" . embark-bindings))
627 :init
628 (setq prefix-help-command #'embark-prefix-help-command)
629 :config
630 (add-to-list 'display-buffer-alist
631 '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*"
632 nil
633 (window-parameters (mode-line-format . none)))))
634
635(use-package embark-consult
636 :ensure t
637 :hook
638 (embark-collect-mode . consult-preview-at-point-mode))
639
640(use-package undo-fu
641 :ensure t
642 :init
643 (setq undo-limit 67108864) ; 64mb.
644 (setq undo-strong-limit 100663296) ; 96mb.
645 (setq undo-outer-limit 1006632960) ; 960mb.
646 :bind (("C-/" . undo-fu-only-undo)
647 ("C-?" . undo-fu-only-redo)))
648
649(use-package undo-fu-session
650 :ensure t
651 :config
652 (setq undo-fu-session-compression (cond
653 ((executable-find "gunzip") 'gz)
654 ((executable-find "bzip2") 'bz2))
655 undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
656 "/git-rebase-todo\\'"))
657 (global-undo-fu-session-mode))
658
659(use-package crux
660 :ensure t :demand t
661 :bind (("C-x 4 t" . crux-transpose-windows))
662 :config
663 (crux-with-region-or-buffer indent-region)
664 (crux-with-region-or-buffer tabify)
665 (crux-with-region-or-buffer untabify)
666 (crux-reopen-as-root-mode))
667
668(use-package pixel-scroll
669 :demand t
670 :bind (([right-margin wheel-down] . pixel-scroll-precision)
671 ([right-margin double-wheel-down] . pixel-scroll-precision)
672 ([right-margin triple-wheel-down] . pixel-scroll-precision)
673 ([right-margin wheel-up] . pixel-scroll-precision)
674 ([right-margin double-wheel-up] . pixel-scroll-precision)
675 ([right-margin triple-wheel-up] . pixel-scroll-precision))
676 :config
677 (when (fboundp 'pixel-scroll-precision-mode)
678 (pixel-scroll-precision-mode)))
679
680;;; basics.el ends here
diff --git a/definitions.el b/definitions.el new file mode 100644 index 0000000..125c87e --- /dev/null +++ b/definitions.el
@@ -0,0 +1,149 @@
1;;; definitions.el --- definitions for my Emacs config -*- lexical-binding: t; -*-
2
3(defun other-window-or-switch-buffer (&optional arg)
4 "Switch to the other window.
5If a window is the only buffer on a frame, switch buffer. When
6run with \\[universal-argument], unconditionally switch buffer."
7 (interactive "P")
8 (if (or arg (one-window-p))
9 (switch-to-buffer (other-buffer) nil t)
10 (other-window 1)))
11
12(defun cycle-spacing@ (&optional n)
13 ;; `cycle-spacing' is wildly different in 29.1 over 28.
14 "Negate N argument on `cycle-spacing'.
15That is, with a positive N, deletes newlines as well, leaving -N
16spaces. If N is negative, it will not delete newlines and leave
17N spaces."
18 (interactive "*p")
19 (cycle-spacing (- n)))
20
21(defun first-frame@set-fonts ()
22 (remove-hook 'server-after-make-frame-hook
23 #'first-frame@set-fonts)
24 (face-spec-set 'default
25 `((t :family "Recursive Mono Casual Static"
26 :height 110)))
27 ;; Emojis
28 (cl-loop with ffl = (font-family-list)
29 for font in '("Noto Emoji" "Noto Color Emoji"
30 "Segoe UI Emoji" "Apple Color Emoji"
31 "FreeSans" "FreeMono" "FreeSerif"
32 "Unifont" "Symbola")
33 if (member font ffl)
34 do (set-fontset-font t 'symbol font))
35 ;; International fonts
36 (cl-loop with ffl = (font-family-list)
37 for (charset . font)
38 in '((latin . "Noto Sans")
39 (han . "Noto Sans CJK SC Regular")
40 (kana . "Noto Sans CJK JP Regular")
41 (hangul . "Noto Sans CJK KR Regular")
42 (cjk-misc . "Noto Sans CJK KR Regular")
43 (khmer . "Noto Sans Khmer")
44 (lao . "Noto Sans Lao")
45 (burmese . "Noto Sans Myanmar")
46 (thai . "Noto Sans Thai")
47 (ethiopic . "Noto Sans Ethiopic")
48 (hebrew . "Noto Sans Hebrew")
49 (arabic . "Noto Sans Arabic")
50 (gujarati . "Noto Sans Gujarati")
51 (devanagari . "Noto Sans Devanagari")
52 (kannada . "Noto Sans Kannada")
53 (malayalam . "Noto Sans Malayalam")
54 (oriya . "Noto Sans Oriya")
55 (sinhala . "Noto Sans Sinhala")
56 (tamil . "Noto Sans Tamil")
57 (telugu . "Noto Sans Telugu")
58 (tibetan . "Noto Sans Tibetan"))
59 if (member font ffl)
60 do (set-fontset-font t charset font)))
61
62(defun switch-themes ()
63 (interactive)
64 (let ((current-theme (car custom-enabled-themes)))
65 (mapc #'disable-theme custom-enabled-themes)
66 (enable-theme (pcase current-theme
67 ('modus-operandi 'modus-vivendi)
68 ('modus-vivendi 'modus-operandi)))))
69
70(defun renz/sort-by-alpha-length (elems)
71 "Sort ELEMS first alphabetically, then by length."
72 (sort elems (lambda (c1 c2)
73 (or (string-version-lessp c1 c2)
74 (< (length c1) (length c2))))))
75
76(defun renz/sort-by-history (elems)
77 "Sort ELEMS by minibuffer history.
78Use `mct-sort-sort-by-alpha-length' if no history is available."
79 (if-let ((hist (and (not (eq minibuffer-history-variable t))
80 (symbol-value minibuffer-history-variable))))
81 (minibuffer--sort-by-position hist elems)
82 (renz/sort-by-alpha-length elems)))
83
84(defun renz/completion-category ()
85 "Return completion category."
86 (when-let ((window (active-minibuffer-window)))
87 (with-current-buffer (window-buffer window)
88 (completion-metadata-get
89 (completion-metadata (buffer-substring-no-properties
90 (minibuffer-prompt-end)
91 (max (minibuffer-prompt-end) (point)))
92 minibuffer-completion-table
93 minibuffer-completion-predicate)
94 'category))))
95
96(defun renz/sort-multi-category (elems)
97 "Sort ELEMS per completion category."
98 (pcase (renz/completion-category)
99 ('nil elems) ; no sorting
100 ('kill-ring elems)
101 ('project-file (renz/sort-by-alpha-length elems))
102 (_ (renz/sort-by-history elems))))
103
104(defvar no-tabs-modes '(emacs-lisp-mode
105 lisp-mode
106 scheme-mode
107 python-mode
108 haskell-mode)
109 "Modes /not/ to indent with tabs.")
110
111(defun indent-tabs-mode-maybe ()
112 (if (apply #'derived-mode-p no-tabs-modes)
113 (indent-tabs-mode -1)
114 (indent-tabs-mode 1)))
115
116(define-minor-mode truncate-lines-mode
117 "Buffer-local mode to toggle `truncate-lines'."
118 :lighter ""
119 (setq-local truncate-lines truncate-lines-mode))
120
121;;; Region or buffer stuff
122
123(defun call-with-region-or-buffer (fn &rest _r)
124 "Call function FN with current region or buffer.
125Good to use for :around advice."
126 (if (region-active-p)
127 (funcall fn (region-beginning) (region-end))
128 (funcall fn (point-min) (point-max))))
129
130(defun delete-trailing-whitespace-except-current-line ()
131 (save-excursion
132 (delete-trailing-whitespace (point-min)
133 (line-beginning-position))
134 (delete-trailing-whitespace (line-end-position)
135 (point-max))))
136
137(defun create-missing-directories ()
138 "Automatically create missing directories."
139 (let ((target-dir (file-name-directory buffer-file-name)))
140 (unless (file-exists-p target-dir)
141 (make-directory target-dir :parents))))
142
143
144(defun vc-remote-off ()
145 "Turn VC off when remote."
146 (when (file-remote-p (buffer-file-name))
147 (setq-local vc-handled-backends nil)))
148
149
diff --git a/early-init.el b/early-init.el deleted file mode 100644 index 80d91db..0000000 --- a/early-init.el +++ /dev/null
@@ -1,58 +0,0 @@
1;;; early-init.el -*- lexical-binding: t -*-
2
3;; Bankruptcy: 9.4
4
5;; Debugging
6;; (setq debug-on-error t
7;; use-package-verbose t)
8;; (setq debug-on-message "Selection owner couldn’t convert: TIMESTAMP")
9
10;; Frames
11(setq default-frame-alist '((tool-bar-lines . 0)
12 (menu-bar-lines . 0)
13 (vertical-scroll-bars . nil)
14 (horizontal-scroll-bars . nil))
15 frame-inhibit-implied-resize t
16 frame-resize-pixelwise t
17 window-resize-pixelwise t
18 inhibit-x-resources t
19 indicate-empty-lines nil
20 indicate-buffer-boundaries nil)
21
22;; Packages
23(require 'package)
24(add-to-list 'package-archives
25 '("melpa" . "https://melpa.org/packages/") :append)
26(add-to-list 'package-archives
27 '("melpa-stable" . "https://stable.melpa.org/packages/") :append)
28(setq package-priorities '(("melpa" . 3)
29 ("nongnu" . 2)
30 ("gnu" . 1)
31 ("melpa-stable" . 0))
32 package-enable-at-startup nil)
33
34(package-initialize)
35(unless package-archive-contents
36 (package-refresh-contents))
37(unless (package-installed-p 'use-package)
38 (package-install 'use-package))
39
40(setq use-package-enable-imenu-support t
41 use-package-hook-name-suffix nil)
42
43(eval-when-compile
44 (require 'use-package))
45(setq use-package-compute-statistics debug-on-error)
46
47(define-advice use-package (:before (name &rest body) select)
48 "Add NAME to `package-selected-packages'."
49 (when (memq :ensure body)
50 (add-to-list 'package-selected-packages name)))
51
52;; (use-package use-package-vc
53;; :load-path "~/src/emacs/use-package-vc.el/"
54;; :config
55;; (define-advice package-vc-install (:around (orig &rest args) wtf)
56;; "Don't freak out about `package-archives' shit."
57;; (let ((package-archives nil))
58;; (apply orig args))))
diff --git a/init.el b/init.el index 707125e..4648042 100644 --- a/init.el +++ b/init.el
@@ -1,1163 +1,474 @@
1;;; init.el --- An Emacs of one's own -*- lexical-binding: t -*- 1;;; Emacs init.el -*- lexical-binding: t; -*-
2;; by Case Duckworth <acdw@acdw.net>
3;; Bankruptcy 10: "Annoyance"
2 4
3;; Author: Case Duckworth <acdw@acdw.net>, with inspo from many others 5;;; Commentary:
4;; Homepage: https://git.acdw.net/emacs
5;; Config-Requires: ((emacs "29.0"))
6;; Bankruptcy: 9.4
7 6
8;; This configuration is Free Software. Everyone is permitted to do whatever 7;; This is my Emacs configuration. There are many like it but this
9;; they want with it, without limitation. This software comes without any 8;; one is mine.
10;; warranty whatsoever, but with two pieces of advice:
11;; 9;;
12;; - Don't hurt others. 10;; For the tenth time!
13;; - Make good choices. 11
14 12;;; Packages
15;;; Code: 13
16 14(require 'package)
17(load (locate-user-emacs-file "basics")) ; super basic stuff 15(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/") t)
18 16(package-initialize)
19 17
20;;; Built-ins 18(dolist (pkg `(consult
21 19 marginalia
22(use-package emacs ; Misc. config 20 visual-fill-column
23 :config 21 adaptive-wrap
24 (setq recenter-positions '(top middle bottom) 22 geiser
25 initial-major-mode 'lisp-interaction-mode 23 ,(when (executable-find "csi") 'geiser-chicken)
26 initial-scratch-message ";; Emacs!\n\n" 24 avy
27 ;; (format "%s\n\n" 25 zzz-to-char
28 ;; (mapconcat (lambda (s) (format ";; %s" s)) 26 hungry-delete
29 ;; (process-lines "fortune" "-s") 27 undohist
30 ;; "\n")) 28 jinx))
31 eval-expression-print-level nil 29 (when (and pkg (not (package-installed-p pkg)))
32 eval-expression-print-length nil 30 (unless (ignore-errors (package-install pkg))
33 x-select-enable-clipboard-manager nil) 31 (package-refresh-contents)
34 ;; TODO: move this ... elsewhere 32 (package-install pkg))))
35 (setq mode-line-format 33
36 '("%e" 34(load (locate-user-emacs-file "definitions"))
37 mode-line-front-space 35(load (locate-user-emacs-file "packages"))
38 ;; (:propertize ("" mode-line-mule-info 36(load (locate-user-emacs-file "private"))
39 ;; mode-line-client 37
40 ;; mode-line-modified 38(setopt custom-file (locate-user-emacs-file "custom.el"))
41 ;; mode-line-remote) 39(load custom-file :noerror)
42 ;; display (min-width (5.0))) 40
43 ("" mode-line-mule-info 41;;; General keybinding changes
42
43(keymap-global-set "M-o" #'other-window-or-switch-buffer)
44
45(keymap-global-set "M-SPC" #'cycle-spacing@)
46
47(keymap-global-set "M-u" #'universal-argument)
48(keymap-set universal-argument-map "M-u" #'universal-argument-more)
49
50;;; Theme
51
52(if (daemonp)
53 (add-hook 'server-after-make-frame-hook #'first-frame@set-fonts)
54 (run-with-idle-timer 1 nil #'first-frame@set-fonts))
55
56(tool-bar-mode -1)
57
58(load-theme 'modus-vivendi :no-confirm :no-enable)
59(load-theme 'modus-operandi :no-confirm)
60
61(add-hook 'text-mode-hook #'visual-line-mode)
62
63;;; Mode line
64
65(defvar mode-line-position
66 '(""
67 (:eval (if line-number-mode "%3l" ""))
68 (:eval (if column-number-mode
69 (if column-number-indicator-zero-based
70 "/%2c"
71 "/%2C")
72 ""))
73 " (" (-3 "%p") ") "))
74
75(setopt mode-line-format
76 '(("%e" mode-line-front-space
44 mode-line-client 77 mode-line-client
45 mode-line-modified 78 mode-line-modified
46 mode-line-remote) 79 mode-line-remote " "
47 mode-line-frame-identification 80 mode-line-buffer-identification
48 mode-line-buffer-identification 81 (vc-mode vc-mode)
49 " " 82 " "
50 mode-line-position 83 (mode-line-position mode-line-position)
51 (vc-mode vc-mode) 84 mode-line-modes
52 " " 85 mode-line-misc-info
53 minions-mode-line-modes 86 mode-line-end-spaces)))
54 mode-line-misc-info 87
55 mode-line-end-spaces)) 88;; Remove modes from mode-line
56 (keymap-global-unset "C-\\") 89(dolist (minor-mode '(frowny-mode
57 (keymap-global-unset "<f2>") 90 whitespace-mode
58 (setf (alist-get "\\*Compile-Log\\*" display-buffer-alist nil nil #'equal) 91 hungry-delete-mode))
59 '(display-buffer-no-window)) 92 (setf (alist-get minor-mode minor-mode-alist) (list ""))
60 ;; (add-hook 'after-init-hook 93 (add-hook (intern (format "%s-hook" minor-mode))
61 ;; (defun global-mode-string@setup () 94 (lambda ()
62 ;; (defvar jabber-activity-mode-string) 95 (setf (alist-get minor-mode minor-mode-alist) (list "")))))
63 ;; (defvar org-mode-line-string) 96
64 ;; (defvar display-time-mode) 97;;; Completion & minibuffer
65 ;; (defvar display-time-string) 98
66 ;; (setf global-mode-string 99(setopt icomplete-in-buffer t
67 ;; '((t jabber-activity-mode-string) 100 icomplete-tidy-shadowed-file-names t)
68 ;; org-mode-line-string 101(fido-vertical-mode)
69 ;; (display-time-mode display-time-string))))) 102
70 (keymap-global-set "C-c t" 103(setopt completion-auto-help (not icomplete-mode)
71 (define-keymap 104 completion-auto-select 'second-tab
72 :prefix 'toggle-map 105 completions-header-format nil
73 "e" #'toggle-debug-on-error 106 completions-max-height 12
74 "q" #'toggle-debug-on-quit 107 completions-format 'one-column
75 "c" #'column-number-mode 108 completion-styles '(basic partial-completion flex)
76 "l" #'line-number-mode 109 completion-ignore-case t
77 "L" #'display-line-numbers-mode))) 110 read-buffer-completion-ignore-case t
78 111 read-file-name-completion-ignore-case t
79(use-package faces 112 completions-detailed t
80 :config 113 enable-recursive-minibuffers t
81 (add-hook 'server-after-make-frame-hook 114 file-name-shadow-properties '(invisible t intangible t)
82 (defun first-frame@set-fonts () 115 minibuffer-eldef-shorten-default t
83 (remove-hook 'server-after-make-frame-hook 116 minibuffer-prompt-properties '( read-only t
84 #'first-frame@set-fonts) 117 cursor-intangible t
85 (face-spec-set 'default 118 face minibuffer-prompt)
86 `((t :family ,(find-font 119 window-resize-pixelwise t
87 "Recursive Mono Casual Static" 120 frame-resize-pixelwise t)
88 "Comic Code" 121
89 "DejaVu Sans Mono") 122(add-hook 'completion-list-mode-hook #'truncate-lines-mode)
90 :height 110))) 123(add-hook 'minibuffer-setup-hook #'truncate-lines-mode)
91 (face-spec-set 'fixed-pitch 124
92 `((t :family ,(find-font 125;; Up/down when completing in the minibuffer
93 "Recursive Mono Linear Static" 126(define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion)
94 "Comic Code" 127(define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion)
95 "DejaVu Sans Mono") 128
96 :height 1.0))) 129;; Up/down when competing in a normal buffer
97 (face-spec-set 'variable-pitch 130(define-key completion-in-region-mode-map (kbd "C-p") #'minibuffer-previous-completion)
98 `((t :family ,(find-font 131(define-key completion-in-region-mode-map (kbd "C-n") #'minibuffer-next-completion)
99 "Recursive Sans Casual Static" 132
100 "Atkinson Hyperlegible" 133(setopt completions-sort #'renz/sort-multi-category)
101 "DejaVu Serif") 134
102 :height 1.0))) 135(setopt tab-always-indent 'complete)
103 (face-spec-set 'font-lock-comment-face 136
104 `((t :slant italic 137(file-name-shadow-mode)
105 :inherit variable-pitch))) 138(minibuffer-electric-default-mode)
106 ;; Emojis 139
107 (cl-loop with ffl = (font-family-list) 140(scroll-bar-mode -1)
108 for font in '("Noto Emoji" "Noto Color Emoji" 141(menu-bar-mode -1)
109 "Segoe UI Emoji" "Apple Color Emoji" 142
110 "FreeSans" "FreeMono" "FreeSerif" 143(add-hook 'prog-mode-hook #'indent-tabs-mode-maybe)
111 "Unifont" "Symbola") 144
112 if (member font ffl) 145(setopt electric-pair-skip-whitespace 'chomp)
113 do (set-fontset-font t 'symbol font)) 146(electric-pair-mode)
114 ;; International scripts 147
115 (cl-loop with ffl = (font-family-list) 148(setopt sh-basic-offset tab-width)
116 for (charset . font) 149
117 in '((latin . "Noto Sans") 150(keymap-set emacs-lisp-mode-map "C-c C-c" #'eval-defun)
118 (han . "Noto Sans CJK SC Regular") 151(keymap-set emacs-lisp-mode-map "C-c C-k" #'eval-buffer)
119 (kana . "Noto Sans CJK JP Regular") 152(keymap-set lisp-interaction-mode-map "C-c C-c" #'eval-defun)
120 (hangul . "Noto Sans CJK KR Regular") 153(keymap-set lisp-interaction-mode-map "C-c C-k" #'eval-buffer)
121 (cjk-misc . "Noto Sans CJK KR Regular") 154
122 (khmer . "Noto Sans Khmer") 155(advice-add 'indent-region :around #'call-with-region-or-buffer)
123 (lao . "Noto Sans Lao") 156(advice-add 'tabify :around #'call-with-region-or-buffer)
124 (burmese . "Noto Sans Myanmar") 157(advice-add 'untabify :around #'call-with-region-or-buffer)
125 (thai . "Noto Sans Thai") 158
126 (ethiopic . "Noto Sans Ethiopic") 159(with-eval-after-load 'scheme
127 (hebrew . "Noto Sans Hebrew") 160 (keymap-unset scheme-mode-map "M-o" t)
128 (arabic . "Noto Sans Arabic") 161 ;; Comparse "keywords" --- CHICKEN (http://wiki.call-cc.org/eggref/5/comparse)
129 (gujarati . "Noto Sans Gujarati") 162 (put 'sequence* 'scheme-indent-function 1)
130 (devanagari . "Noto Sans Devanagari") 163 (put 'satisfies 'scheme-indent-function 1)
131 (kannada . "Noto Sans Kannada") 164 (add-hook 'scheme-mode-hook #'geiser-mode))
132 (malayalam . "Noto Sans Malayalam") 165(with-eval-after-load 'geiser-mode
133 (oriya . "Noto Sans Oriya") 166 (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go)
134 (sinhala . "Noto Sans Sinhala") 167 (keymap-unset geiser-mode-map "C-." t))
135 (tamil . "Noto Sans Tamil") 168
136 (telugu . "Noto Sans Telugu") 169(setopt visual-fill-column-center-text t
137 (tibetan . "Noto Sans Tibetan")) 170 visual-fill-column-width (+ fill-column 2))
138 if (member font ffl) 171(advice-add 'text-scale-adjust :after #'visual-fill-column-adjust)
139 do (set-fontset-font t charset font)))) 172(add-hook 'visual-line-mode-hook #'visual-fill-column-mode)
140 (unless (daemonp) 173(add-hook 'visual-line-mode-hook #'adaptive-wrap-prefix-mode)
141 (run-with-idle-timer 1 nil #'first-frame@set-fonts))) 174
142 175(setopt major-mode
143(use-package text-mode 176 (lambda () ; guess major mode from buffer name
144 :config 177 (unless buffer-file-name
145 (add-hook 'text-mode-hook #'abbrev-mode)) 178 (let ((buffer-file-name (buffer-name)))
146 179 (set-auto-mode)))))
147(use-package prog-mode 180
148 :config 181;; Dialogs
149 ;;; TABS 182(unless (boundp 'use-short-answers)
150 (setq tab-width 8 183 (fset 'yes-or-no-p 'y-or-n-p))
151 sh-indentation tab-width 184
152 ) 185(setopt read-answer-short t
153 ;;; Hooks 186 use-dialog-box nil
154 (add-hook 'prog-mode-hook #'auto-fill-mode) 187 use-file-dialog nil
155 (add-hook 'prog-mode-hook 188 use-short-answers t)
156 (defun prog@indent-tabs-maybe () 189
157 (indent-tabs-mode 190(require 'savehist)
158 (if (derived-mode-p 'emacs-lisp-mode 191(setopt history-length 1024
159 'lisp-mode 192 history-delete-duplicates t
160 'scheme-mode 193 ;; savehist-file (etc/ "savehist.el")
161 'python-mode 194 savehist-save-minibuffer-history t
162 'haskell-mode) 195 savehist-autosave-interval 30)
163 -1 1)))) 196(savehist-mode)
164 (global-prettify-symbols-mode)) 197
165 198;; Killing and yanking
166(use-package auth-source 199(setopt kill-do-not-save-duplicates t
167 :config 200 kill-read-only-ok t
168 (setq auth-sources '(default "secrets:passwords")) 201 ;; XXX: This setting causes an error message the first time it's
169 (add-hook 'auth-info-hook #'truncate-lines-local-mode)) 202 ;; called: "Selection owner couldn't convert: TIMESTAMP". I have
170 203 ;; absolutely no idea why I get this error, but it's generated in
171(use-package fringe 204 ;; `x_get_foreign_selection'. I also can't inhibit the message or
172 :config 205 ;; do anything else with it, so for now, I'll just live with the
173 (fringe-mode '(nil . 0))) 206 ;; message.
174 207 save-interprogram-paste-before-kill t
175(use-package ispell 208 yank-pop-change-selection t)
176 :config 209(delete-selection-mode)
177 (setq ispell-program-name (choose-executable "aspell" "ispell")) 210
178 ;; (add-hook 'before-save-hook 211;; Notifying the user
179 ;; #'+ispell-move-buffer-words-to-dir-locals-hook) 212(setopt echo-keystrokes 0.01
180 (put 'ispell-buffer-session-localwords 'safe-local-variable 213 ring-bell-function #'ignore)
181 '+ispell-safe-local-p)) 214
182 215;; Point and mark
183(use-package dired 216(setopt set-mark-command-repeat-pop t)
184 :bind (("C-x C-j" . dired-jump) 217
185 ([remap list-directory] . dired) 218;; The system
186 :map dired-mode-map 219(setopt read-process-output-max (* 10 1024 1024))
187 ("C-j" . dired-up-directory) 220
188 ("<backspace>" . dired-up-directory)) 221;; Startup
189 :config 222(setopt inhibit-startup-screen t
190 (require 'dired-x) 223 initial-buffer-choice t
191 (setq dired-recursive-copies 'always 224 initial-scratch-message nil)
192 dired-recursive-deletes 'always 225
193 dired-create-destination-dirs 'always 226(define-advice startup-echo-area-message (:override ())
194 dired-do-revert-buffer t 227 (if (get-buffer "*Warnings*")
195 dired-hide-details-hide-symlink-targets nil 228 ";_;"
196 dired-isearch-filenames 'dwim 229 "^_^"))
197 delete-by-moving-to-trash t 230
198 dired-auto-revert-buffer t 231;; Text editing
199 dired-listing-switches "-AlFhv --group-directories-first" 232(setopt fill-column 80
200 ls-lisp-dirs-first t 233 sentence-end-double-space nil
201 dired-ls-F-marks-symlinks t 234 tab-width 8
202 dired-clean-confirm-killing-deleted-buffers nil 235 tab-always-indent 'complete)
203 dired-no-confirm '(byte-compile 236(global-so-long-mode)
204 load chgrp chmod chown 237
205 copy move hardlink symlink 238(setopt show-paren-delay 0.01
206 shell touch) 239 show-paren-style 'parenthesis
207 dired-dwim-target t) 240 show-paren-when-point-in-periphery t
208 (add-hook 'dired-mode-hook #'dired-hide-details-mode) 241 show-paren-when-point-inside-paren t)
209 (add-hook 'dired-mode-hook #'hl-line-mode) 242(show-paren-mode)
210 (add-hook 'dired-mode-hook #'truncate-lines-local-mode)) 243
211 244
212(use-package dictionary 245;; Encodings
213 :custom 246(set-language-environment "UTF-8")
214 (dictionary-server (if (or (executable-find "dictd") 247(setopt buffer-file-coding-system 'utf-8-unix
215 (file-exists-p "/usr/sbin/dictd")) ; debian 248 coding-system-for-read 'utf-8-unix
216 "localhost" 249 coding-system-for-write 'utf-8-unix
217 "dict.org")) 250 default-process-coding-system '(utf-8-unix . utf-8-unix)
218 :bind 251 locale-coding-system 'utf-8-unix)
219 (("C-c w d" . dictionary-search)) 252(set-charset-priority 'unicode)
220 :config 253(prefer-coding-system 'utf-8-unix)
221 (setf (alist-get "\\*Dictionary\\*" display-buffer-alist nil nil #'equal) 254(set-default-coding-systems 'utf-8-unix)
222 '(display-buffer-in-side-window 255(set-terminal-coding-system 'utf-8-unix)
223 (window-width . 80) 256(set-keyboard-coding-system 'utf-8-unix)
224 (side . right)))) 257(pcase system-type
225 258 ((or 'ms-dos 'windows-nt)
226(use-package calendar 259 (set-clipboard-coding-system 'utf-16-le)
227 :custom 260 (set-selection-coding-system 'utf-16-le))
228 (diary-file (private/ "diary"))) 261 (_
229 262 (set-selection-coding-system 'utf-8)
230(use-package mouse 263 (set-clipboard-coding-system 'utf-8)))
231 :config 264
232 (setq context-menu-functions '(context-menu-undo 265
233 context-menu-region 266;; Files
234 context-menu-middle-separator 267(setopt auto-revert-verbose nil
235 context-menu-local 268 global-auto-revert-non-file-buffers t
236 context-menu-minor)) 269 create-lockfiles nil
237 (context-menu-mode)) 270 find-file-visit-truename t
238 271 mode-require-final-newline t
239(use-package password-cache 272 view-read-only t
240 :config 273 save-silently t)
241 (setq password-cache t 274(global-auto-revert-mode)
242 password-cache-expiry 3600)) 275
243 276(setopt auto-save-default nil
244(use-package time 277 auto-save-interval 1
245 :config 278 auto-save-no-message t
246 (setq display-time-format " %H:%M" 279 auto-save-timeout 1
247 display-time-interval 60 280 auto-save-visited-interval 1
248 display-time-use-mail-icon t 281 remote-file-name-inhibit-auto-save-visited t)
249 display-time-mail-function 282(add-to-list 'auto-save-file-name-transforms
250 (defun +notmuch-new-mail-p () 283 `(".*" ,(locate-user-emacs-file "auto-save/") t))
251 (plist-get (cl-find "inbox+unread" 284(auto-save-visited-mode)
252 (ignore-errors 285
253 (notmuch-hello-query-counts notmuch-saved-searches)) 286(setopt backup-by-copying t
254 :key (lambda (l) (plist-get l :name)) 287 version-control t
255 :test #'equal) 288 kept-new-versions 8
256 :count)) 289 kept-old-versions 8
257 display-time-default-load-average nil) 290 delete-old-versions t)
258 (with-eval-after-load 'notmuch 291(setq-default backup-directory-alist
259 (add-hook 'notmuch-after-tag-hook #'display-time-update)) 292 `(("^/dev/shm" . nil)
260 ;; (display-time-mode) 293 ("^/tmp" . nil)
261 ) 294 (,(getenv "XDG_RUNTIME_DIR") . nil)
262 295 ("." . ,(locate-user-emacs-file "backup"))))
263(use-package tab-bar 296
264 :config 297(require 'recentf)
265 (setq tab-bar-show t 298(setopt
266 tab-bar-close-button-show t) 299 recentf-max-menu-items 500
267 (setopt tab-bar-format 300 recentf-max-saved-items nil ; Save the whole list
268 `(tab-bar-format-history 301 recentf-auto-cleanup 'mode
269 tab-bar-format-tabs 302 recentf-case-fold-search t)
270 tab-bar-separator 303;; (add-to-list 'recentf-exclude etc/)
271 tab-bar-format-add-tab 304(add-to-list 'recentf-exclude "-autoloads.el\\'")
272 tab-bar-format-align-right 305(add-hook 'buffer-list-update-hook #'recentf-track-opened-file)
273 ,(defun tab-bar-extra-info () 306(add-hook 'after-save-hook #'recentf-save-list)
274 `((global menu-item 307(recentf-mode)
275 ,(format-mode-line 308
276 '((jabber-activity-mode jabber-activity-mode-string) 309(require 'saveplace)
277 (:eval (when (and (fboundp 'org-clocking-p) 310(setopt
278 (org-clocking-p)) 311 save-place-forget-unreadable-files (eq system-type
279 (format " %s" 312 'gnu/linux))
280 (truncate-string-to-width 313(save-place-mode)
281 org-mode-line-string 314
282 16 315(require 'uniquify)
283 nil 316(setq uniquify-after-kill-buffer-p t
284 nil 317 uniquify-buffer-name-style 'forward
285 (truncate-string-ellipsis))))) 318 uniquify-ignore-buffers-re "^\\*"
286 (:eval (tmr-mode-line)) 319 uniquify-separator path-separator)
287 (display-time-mode 320
288 (:eval (format " %s" (string-trim display-time-string)))) 321(setq-local vc-follow-symlinks t
289 ("" " "))) 322 vc-make-backup-files t)
290 ignore)))) 323
291 mode-line-misc-info (cl-delete-if (lambda (x) 324;; Whitespace
292 (eq (car x) 'global-mode-string)) 325(require 'whitespace)
293 mode-line-misc-info)) 326(setopt whitespace-style
294 (if (daemonp) 327 '(face trailing tabs tab-mark))
295 (add-hook 'server-after-make-frame-hook 328(global-whitespace-mode)
296 (defun after-frame@tab-bar () 329(add-hook 'before-save-hook #'delete-trailing-whitespace-except-current-line)
297 (tab-bar-mode) 330
298 (remove-hook 'server-after-make-frame-hook 331;; Native compilation
299 #'after-frame@tab-bar))) 332(setopt native-comp-async-report-warnings-errors 'silent
300 (run-with-idle-timer 2 nil #'tab-bar-mode))) 333 native-comp-deferred-compilation t
301 334 native-compile-target-directory
302(use-package info 335 (locate-user-emacs-file "eln"))
303 :preface 336(when (boundp 'native-comp-eln-load-path)
304 (defun Info-copy-current-node-name-0 () 337 (add-to-list 'native-comp-eln-load-path native-compile-target-directory))
305 "Call `Info-copy-current-node-name' with a 0 prefix arg." 338(when (fboundp 'startup-redirect-eln-cache)
306 (interactive) 339 (startup-redirect-eln-cache native-compile-target-directory))
307 (Info-copy-current-node-name 0)) 340
308 :bind (:map Info-mode-map 341(global-goto-address-mode)
309 ("w" . Info-copy-current-node-name-0) 342
310 ("c" . Info-copy-current-node-name))) 343;; Winner
311 344(winner-mode)
312(use-package make-mode 345
313 :defer t 346;;; Hooks
314 :config 347(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
315 (add-hook 'makefile-mode-hook 348(add-hook 'find-file-not-found-functions #'create-missing-directories)
316 (defun make-mode@setup () 349(add-hook 'find-file-hook #'vc-remote-off)
317 (remove-hook 'write-file-functions 350(add-hook 'dired-mode-hook #'hl-line-mode)
318 #'makefile-warn-suspicious-lines t) 351(add-hook 'org-agenda-mode-hook #'hl-line-mode)
319 (remove-hook 'write-file-functions 352
320 #'makefile-warn-continuations t)))) 353;;; Tab bar
321 354
322(use-package eglot 355(defun tab-bar-end-space ()
323 :preface 356 `((end menu-item " " ignore)))
324 (defun +eglot-eldoc () 357
325 ;; https://www.masteringemacs.org/article/seamlessly-merge-multiple-documentation-sources-eldoc 358(setopt tab-bar-show t)
326 (setq eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly)) 359(add-to-list 'tab-bar-format 'tab-bar-format-align-right :append)
327 :hook 360(add-to-list 'tab-bar-format 'tab-bar-format-global :append)
328 ((bash-ts-mode . eglot-ensure) 361(add-to-list 'tab-bar-format 'tab-bar-end-space :append)
329 (scheme-mode . eglot-ensure)) 362(tab-bar-mode)
330 :config 363
331 (add-to-list 'eglot-server-programs 364;;; Org mode
332 '(scheme-mode . ("chicken-lsp-server"))) 365
333 (add-hook 'eglot-managed-mode #'+eglot-eldoc)) 366(keymap-global-set "C-c a" #'org-agenda)
334 367(setopt org-clock-clocked-in-display 'frame-title
335(use-package eldoc 368 org-clock-frame-title-format
336 :config 369 '("%b" " - " (t org-mode-line-string)))
337 (setq eldoc-documentation-strategy #'eldoc-documentation-compose-eagerly) 370
338 (setf (alist-get "^\\*eldoc for" display-buffer-alist nil nil #'equal) 371;;; Spelling
339 '(display-buffer-at-bottom 372
340 (window-height . 4))) 373(defun list-of-strings-p (x)
341 (eldoc-add-command-completions "paredit-")) 374 "Is X a list of strings?"
342 375 (and x
343(use-package pulse 376 (listp x)
344 :config 377 (cl-every #'stringp x)))
345 (setq pulse-flag nil 378
346 pulse-delay 1 379(put 'ispell-local-words 'safe-local-variable
347 pulse-iterations 1)) 380 'list-of-strings-p)
348 381
349(use-package flyspell 382(add-hook 'text-mode-hook #'jinx-mode)
350 :hook (org-mode-hook)) 383(with-eval-after-load 'jinx
351 384 (keymap-set jinx-mode-map "M-$" #'jinx-correct)
352;; (use-package display-fill-column-indicator 385 (keymap-set jinx-mode-map "C-M-$" #'jinx-languages))
353;; :hook (prog-mode-hook)) 386
354 387;;; Copy rich text to the keyboard
355(use-package package 388
356 :config 389;; Thanks to Oleh Krehel:
357 (defun package-update-async-in-progress (&rest _) 390;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
358 (message "Package async update in progress.")) 391;; So. Emacs can't do this itself because it doesn't support sending clipboard
359 392;; or selection contents as text/html. We have to use xclip instead.
360 (defun package-update-all-async () 393;; (defun org-to-html-to-clipboard (&rest org-export-args)
361 "Update packages asyncronously." 394;; "Export current org buffer to HTML, then copy it to the clipboard.
362 (interactive) 395;; ORG-EXPORT-ARGS are passed to `org-export-to-file'."
363 (let ((message "Package update (async)...") 396;; (let ((f (make-temp-file "org-html-export")))
364 (disable-fns '(package-update 397;; (apply #'org-export-to-file 'html f org-export-args)
365 package-update-all 398;; (start-process "xclip" " *xclip*"
366 package-update-all-async))) 399;; "xclip" "-verbose" "-i" f
367 (dolist (fn disable-fns) 400;; "-t" "text/html" "-selection" "clipboard")
368 (advice-add fn :override #'package-update-async-in-progress)) 401;; (message "HTML pasted to clipboard.")))
369 (message "%s" message) 402
370 (unwind-protect 403;; Wayland version.. TODO: make it work for both
371 (async-start 404(defun org-to-html-to-clipboard (&rest org-export-args)
372 `(lambda () 405 "Export current org buffer to HTML, then copy it to the clipboard.
373 (package-initialize) 406ORG-EXPORT-ARGS are passed to `org-export-to-file'."
374 (package-update-all)) 407 (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
375 `(lambda (result) 408 (apply #'org-export-to-buffer 'html buf org-export-args)
376 (message "%s %s" ,message result))) 409 (with-current-buffer buf
377 (dolist (fn ',disable-fns) 410 (call-process-region (point-min) (point-max)
378 (advice-remove fn 'package-update-async-in-progress)))))) 411 "wl-copy" nil nil nil
379 412 "-t" "text/html")
380(use-package ielm 413 (kill-buffer-and-window))
381 ;; https://www.n16f.net/blog/making-ielm-more-comfortable/ 414 (message "HTML copied to clipboard.")))
382 :preface 415
383 (defun +ielm-init-history () 416(defun org-subtree-to-html-to-clipboard ()
384 (let ((path (etc/ "ielm/history" t))) 417 "Export current subtree to HTML."
385 (setq-local comint-input-ring-file-name path)) 418 (interactive)
386 (setq-local comint-input-ring-size 10000) 419 (org-to-html-to-clipboard nil :subtree))
387 (setq-local comint-input-ignoredups t) 420
388 (ignore-errors (comint-read-input-ring))) 421(undohist-initialize)
389 (defun +ielm-write-history (&rest _args) 422
390 (with-file-modes #o600 423(require 'hungry-delete)
391 (comint-write-input-ring))) 424(setopt hungry-delete-chars-to-skip " \t"
392 (defun +ielm (&optional buf-name)
393 "Interactively evaluate Emacs Lisp expressions.
394Switches to the buffer named BUF-NAME if provided (`*ielm*' by default),
395or creates it if it does not exist.
396See `inferior-emacs-lisp-mode' for details."
397 (interactive)
398 (let (old-point
399 (buf-name (or buf-name "*ielm*")))
400 (unless (comint-check-proc buf-name)
401 (with-current-buffer (get-buffer-create buf-name)
402 (unless (zerop (buffer-size)) (setq old-point (point)))
403 (inferior-emacs-lisp-mode)))
404 (pop-to-buffer buf-name)
405 (when old-point (push-mark old-point))))
406 :bind (:map emacs-lisp-mode-map
407 ("C-c C-z" . +ielm))
408 :config
409 (add-hook 'ielm-mode-hook #'eldoc-mode)
410 (add-hook 'ielm-mode-hook #'+ielm-init-history)
411 (advice-add 'ielm-send-input :after #'+ielm-write-history))
412
413(use-package elec-pair
414 :config
415 (setopt electric-pair-skip-whitespace 'chomp)
416 (electric-pair-mode))
417
418(use-package bookmark
419 :config
420 (setopt bookmark-save-flag 1))
421
422(use-package sh-script
423 :config
424 (sh-electric-here-document-mode -1))
425
426(use-package cc-mode
427 :config
428 (setopt c-basic-offset 8))
429
430
431;;; Applications
432
433(use-package acdw-mail
434 :load-path "lisp/"
435 :demand t
436 :bind (("C-c n" . +notmuch-goto)))
437
438(use-package acdw-org
439 :load-path "lisp/"
440 :config
441 (global-set-key [f8] #'org-clock-out))
442
443(use-package acdw-shell
444 :load-path "lisp/")
445
446(use-package acdw-web
447 :load-path "lisp/")
448
449(use-package acdw-chat
450 :load-path "lisp/")
451
452(use-package _work
453 :load-path "~/sync/emacs/private/")
454
455
456;;; Locally-developed packages
457
458(use-package +scratch
459 :load-path "lisp/"
460 :config
461 (setq +scratch-save-dir (sync/ "emacs/scratch.d/" t))
462 (add-hook 'kill-buffer-query-functions #'+scratch@immortal)
463 (add-hook 'kill-emacs-hook #'+scratch-save-on-exit)
464 (with-current-buffer (get-scratch-buffer-create)
465 (local-set-key (kbd "C-x C-s") #'+scratch-save))
466 ;; Save *scratch* every hour
467 (run-at-time t (* 60 60) #'+scratch-save "%FT%H%z")
468 ;; Clean old *scratch* saves every day
469 (run-at-time t (* 60 60 24) #'+scratch-clean))
470
471(use-package pulse-location
472 :load-path "~/src/pulse-location.el/"
473 :config
474 (pulse-location-mode))
475
476(use-package emacs ; `modus-themes' isn't a package ...
477 :config
478 (setopt modus-themes-mixed-fonts t)
479 (add-hook 'modus-themes-after-load-theme-hook
480 (defun +reset-faces ()
481 (dolist (face '(font-lock-regexp-face
482 font-lock-variable-name-face
483 font-lock-preprocessor-face
484 font-lock-remove-face
485 font-lock-delimiter-face
486 font-lock-label-face
487 font-lock-operator-face
488 font-lock-property-face
489 font-lock-builtin-face
490 font-lock-number-face
491 font-lock-set-face
492 font-lock-warning-face
493 font-lock-punctuation-face
494 font-lock-constant-face
495 font-lock-type-face
496 font-lock-function-name-face
497 font-lock-reference-face
498 font-lock-negation-char-face
499 font-lock-misc-punctuation-face
500 font-lock-escape-face
501 font-lock-bracket-face))
502 (face-spec-set face '((t :foreground unspecified
503 :background unspecified))))
504 (face-spec-set 'font-lock-keyword-face
505 '((t :foreground unspecified
506 :background unspecified
507 :weight bold)))
508 (face-spec-set 'font-lock-doc-face
509 '((t :slant italic)))))
510 (add-hook 'after-init-hook
511 (defun modus@load ()
512 (+reset-faces)
513 (pcase (string-trim (shell-command-to-string "darkman get"))
514 ("light" (load-theme 'modus-operandi t))
515 ("dark" (load-theme 'modus-vivendi t))))))
516
517(use-package electric-cursor
518 :load-path "~/src/electric-cursor.el/"
519 :config
520 (setq electric-cursor-alist '((overwrite-mode . box)
521 (t . bar)))
522 (electric-cursor-mode))
523
524(use-package mode-line-bell
525 :load-path "~/src/mode-line-bell.el/"
526 :config
527 (setq mode-line-bell-flash-time 0.25)
528 (mode-line-bell-mode))
529
530(use-package titlecase
531 :load-path "~/src/titlecase.el/"
532 :preface
533 (defun +titlecase-sentence-style-dwim (&optional arg)
534 "Titlecase a sentence.
535With prefix ARG, toggle the value of
536`titlecase-downcase-sentences' before sentence-casing."
537 (interactive "P")
538 (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences)
539 titlecase-downcase-sentences)))
540 (titlecase-dwim 'sentence)))
541 (defun +titlecase-org-headings ()
542 (interactive)
543 (require 'org)
544 (save-excursion
545 (goto-char (point-min))
546 ;; See also `org-map-tree'. I'm not using that function because I want to
547 ;; skip the first headline. A better solution would be to patch
548 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
549 (let ((level (funcall outline-level))
550 (org-special-ctrl-a/e t))
551 (while (and (progn (outline-next-heading)
552 (> (funcall outline-level) level))
553 (not (eobp)))
554 (titlecase-region (progn (org-beginning-of-line) (point))
555 (progn (org-end-of-line) (point)))))))
556 :config
557 (with-eval-after-load 'scule
558 (keymap-set scule-map "M-t" #'titlecase-dwim)))
559
560(use-package scule
561 :load-path "~/src/scule.el/"
562 :bind-keymap ("M-c" . scule-map)
563 :init
564 ;; Use M-u for prefix keys
565 (keymap-global-set "M-u" #'universal-argument)
566 (keymap-set universal-argument-map "M-u" #'universal-argument-more))
567
568(use-package filldent
569 :load-path "~/src/filldent.el/"
570 :bind ("M-q" . filldent-dwim)
571 :config
572 (setq filldent-fill-modes '(web-mode)))
573
574(use-package frowny
575 :load-path "~/src/frowny.el/"
576 :config
577 (global-frowny-mode))
578
579(use-package keepassxc-shim
580 :load-path "~/src/keepassxc-shim.el/"
581 :config
582 (keepassxc-shim-activate))
583
584(use-package hippie-completing-read
585 :load-path "~/src/hippie-completing-read.el/"
586 :bind (("M-/" . hippie-completing-read)))
587
588
589;;; External packages
590
591(use-package async
592 :ensure t
593 :config
594 ;; https://github.com/jwiegley/emacs-async/issues/64
595 ;; (setq message-send-mail-function #'async-smtpmail-send-it)
596 (dired-async-mode)
597 (async-bytecomp-package-mode))
598
599(use-package trashed
600 :ensure t)
601
602(use-package form-feed
603 :ensure t
604 :hook (prog-mode-hook))
605
606;; (use-package clean-kill-ring
607;; :vc (:url "https://github.com/NicholasBHubbard/clean-kill-ring.el")
608;; :config
609;; (setq clean-kill-ring-prevent-duplicates t)
610;; (clean-kill-ring-mode))
611
612(use-package minions
613 :ensure t
614 :config (minions-mode))
615
616(use-package visual-fill-column
617 :preface
618 (defcustom visual-fill-column-widen-amount 4
619 "Amount to widen `fill-column' by in `visual-fill-column-mode'."
620 :type 'natnum
621 :group 'visual-fill-column)
622 (defun visual-fill-column--widen/narrow-handle-arg (cols)
623 (cond
624 ((null cols) visual-fill-column-widen-amount)
625 ((listp cols) (* visual-fill-column-widen-amount
626 (1+ (/ (car cols) 4))))
627 ((eq '- cols) (- visual-fill-column-widen-amount))
628 (:else cols)))
629 (defun visual-fill-column-widen (&optional cols)
630 "Widen `fill-column' by COLS, and re-display.
631If COLS is missing or nil, widen by
632`visual-fill-column-widen-amount'. When called with a plain
633\\[universal-argument], multiply that amount by 1 + the amount of
634\\[universal-argument]s. If called with a numerical prefix
635argument, widen by that number of columns."
636 (interactive "P")
637 (let ((cols (visual-fill-column--widen/narrow-handle-arg cols)))
638 (cl-incf fill-column cols)
639 (visual-fill-column-adjust)
640 (message "Fill-column: %s" fill-column)))
641 (defun visual-fill-column-narrow (&optional cols)
642 "Narrow `fill-column' by COLS, then redisplay.
643The prefix argument is as in `visual-fill-column-widen' but negated."
644 (interactive "P")
645 (let ((cols (visual-fill-column--widen/narrow-handle-arg cols)))
646 (cl-decf fill-column cols)
647 (visual-fill-column-adjust)
648 (message "Fill-column: %s" fill-column)))
649 :ensure t
650 :config
651 (setopt visual-fill-column-center-text t
652 visual-fill-column-extra-text-width '(3 . 3)
653 visual-fill-column-width (+ fill-column 4))
654 (keymap-set toggle-map "v" #'visual-fill-column-mode)
655 (keymap-set visual-fill-column-mode-map "C-x C->" #'visual-fill-column-widen)
656 (keymap-set visual-fill-column-mode-map "C-x C-<" #'visual-fill-column-narrow)
657 (add-hook 'visual-fill-column-mode-hook #'visual-line-mode)
658 (add-hook 'eww-mode-hook #'visual-fill-column-mode)
659 (advice-add 'text-scale-adjust :after #'visual-fill-column-adjust))
660
661(use-package mlscroll
662 :ensure t :defer 1
663 :after modus-themes
664 :preface
665 (define-advice load-theme (:after (&rest _) mlscroll)
666 (mlscroll-mode -1)
667 (when (seq-intersection '(modus-vivendi modus-operandi)
668 custom-enabled-themes)
669 (modus-themes-with-colors
670 (setq mlscroll-in-color fg-dim
671 mlscroll-out-color bg-inactive)))
672 (run-with-idle-timer 1 nil #'mlscroll-mode))
673 :config
674 (load-theme@mlscroll))
675
676(use-package cape
677 :ensure t
678 :config
679 (add-hook 'completion-at-point-functions #'cape-file 90)
680 (add-hook 'completion-at-point-functions #'cape-dabbrev 91)
681 (advice-add 'emacs-completion-at-point
682 :around #'cape-wrap-nonexclusive))
683
684(use-package wgrep
685 :ensure t
686 :config
687 (setq wgrep-enable-key (kbd "C-x C-q"))
688 :bind (:map grep-mode-map
689 ("C-x C-q" . wgrep-change-to-wgrep-mode)))
690
691(use-package avy
692 :ensure t
693 :bind (("M-j" . avy-goto-char-timer)
694 :map isearch-mode-map
695 ("M-j" . avy-isearch))
696 :config
697 (setq avy-background t
698 avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm")))
699
700(use-package zzz-to-char
701 :ensure t
702 :bind (("M-z" . zzz-to-char)))
703
704(use-package anzu
705 :ensure t
706 :bind (("M-%" . anzu-query-replace-regexp)
707 ("C-M-%" . anzu-query-replace)))
708
709(use-package isearch-mb
710 :ensure t
711 :config
712 (setq isearch-lazy-count t
713 isearch-regexp-lax-whitespace t
714 search-whitespace-regexp "\\W+"
715 search-default-mode t ; Search regexp by default
716 isearch-wrap-pause 'no)
717 (define-advice isearch-cancel (:before (&rest _) add-search-to-history)
718 "Add search string to history when canceling."
719 (unless (equal "" isearch-string)
720 (isearch-update-ring isearch-string isearch-regexp)))
721 (define-advice perform-replace (:around (orig &rest r) no-anykey-exit)
722 "Don't exit replace for any key that's not in `query-replace-map'."
723 (save-window-excursion
724 (cl-letf* ((lookup-key-orig (symbol-function 'lookup-key))
725 ((symbol-function 'lookup-key)
726 (lambda (map key &optional accept-default)
727 (or (apply lookup-key-orig map key accept-default)
728 (when (eq map query-replace-map) 'help)))))
729 (apply orig r))))
730 ;; Consult
731 (autoload 'consult-line "consult" nil t)
732 (autoload 'consult-isearch-history "consult" nil t)
733 (add-to-list 'isearch-mb--after-exit #'consult-line)
734 (add-to-list 'isearch-mb--with-buffer #'consult-isearch-history)
735 (keymap-set isearch-mb-minibuffer-map "M-s l" #'consult-line)
736 (keymap-set isearch-mb-minibuffer-map "M-r" #'consult-isearch-history)
737 ;; Anzu
738 (autoload 'anzu-isearch-query-replace "anzu" nil t)
739 (autoload 'anzu-isearch-query-replace-regexp "anzu" nil t)
740 (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace)
741 (add-to-list 'isearch-mb--after-exit #'anzu-isearch-query-replace-regexp)
742 (keymap-set isearch-mb-minibuffer-map
743 "M-%" #'anzu-isearch-query-replace-regexp)
744 (keymap-set isearch-mb-minibuffer-map
745 "C-M-%" #'anzu-isearch-query-replace)
746 (isearch-mb-mode))
747
748;; (use-package paredit
749;; :ensure t
750;; :hook ( emacs-lisp-mode-hook ielm-mode-hook
751;; eval-expression-minibuffer-setup-hook
752;; lisp-interaction-mode-hook
753;; lisp-mode-hook scheme-mode-hook
754;; fennel-mode-hook fennel-repl-mode-hook
755;; geiser-mode-hook geiser-repl-mode-hook)
756;; :config
757;; (keymap-set paredit-mode-map "C-j"
758;; (defun +paredit-newline ()
759;; (interactive)
760;; (call-interactively
761;; (if (derived-mode-p 'lisp-interaction-mode)
762;; #'eval-print-last-sexp #'paredit-newline))))
763;; (keymap-unset paredit-mode-map "RET" t)
764;; (keymap-unset paredit-mode-map "M-s" t)
765;; (keymap-unset paredit-mode-map "M-r" t)
766;; (add-to-list 'paredit-space-for-delimiter-predicates
767;; (defun paredit@dont-space-@ (endp delimiter)
768;; "Don't add a space after @ in `paredit-mode'."
769;; (let ((point (point)))
770;; (or endp
771;; (seq-every-p
772;; (lambda (prefix)
773;; (and (> point (length prefix))
774;; (let ((start (- point (length prefix)))
775;; (end point))
776;; (not (string= (buffer-substring start end)
777;; prefix)))))
778;; ;; Add strings to this list to inhibit adding a space
779;; ;; after them.
780;; '(",@")))))))
781
782(use-package hungry-delete
783 :ensure t
784 :config
785 (setq hungry-delete-chars-to-skip " \t"
786 hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip) 425 hungry-delete-skip-regexp (format "[%s]" hungry-delete-chars-to-skip)
787 hungry-delete-join-reluctantly nil) 426 hungry-delete-join-reluctantly nil)
788 (add-to-list 'hungry-delete-except-modes 'eshell-mode) 427(add-to-list 'hungry-delete-except-modes 'eshell-mode)
789 (add-to-list 'hungry-delete-except-modes 'nim-mode) 428(add-to-list 'hungry-delete-except-modes 'nim-mode)
790 (add-to-list 'hungry-delete-except-modes 'python-mode) 429(add-to-list 'hungry-delete-except-modes 'python-mode)
791 ;; Keys 430(global-hungry-delete-mode)
792 (with-eval-after-load 'paredit 431
793 (define-key paredit-mode-map [remap paredit-backward-delete] 432(setopt avy-background t
794 (defun paredit/hungry-delete-backward (arg) 433 avy-keys (string-to-list "asdfghjklqwertyuiopzxcvbnm"))
795 (interactive "*p") 434(keymap-global-set "M-j" #'avy-goto-char-timer)
796 (if (looking-back hungry-delete-skip-regexp) 435(keymap-set isearch-mode-map "M-j" #'avy-isearch)
797 (hungry-delete-backward (or arg 1)) 436(keymap-global-set "M-z" #'zzz-to-char)
798 (paredit-backward-delete arg)))) 437
799 (define-key paredit-mode-map [remap paredit-forward-delete] 438(marginalia-mode)
800 (defun paredit/hungry-delete-forward (arg) 439
801 (interactive "*p") 440(keymap-global-set "C-x b" #'consult-buffer)
802 (if (looking-at hungry-delete-skip-regexp) 441(keymap-global-set "C-x 4 b" #'consult-buffer-other-window)
803 (hungry-delete-forward (or arg 1)) 442(keymap-global-set "C-x 5 b" #'consult-buffer-other-frame)
804 (paredit-forward-delete arg))))) 443(keymap-global-set "C-x r b" #'consult-bookmark)
805 ;; Mode 444(keymap-global-set "M-y" #'consult-yank-pop)
806 (global-hungry-delete-mode)) 445(keymap-global-set "M-g g" #'consult-goto-line)
807 446(keymap-global-set "M-g M-g" #'consult-goto-line)
808(use-package macrostep 447(keymap-global-set "M-g o" #'consult-outline)
809 :ensure t 448(keymap-global-set "M-g m" #'consult-mark)
810 :after elisp-mode 449(keymap-global-set "M-g i" #'consult-imenu)
811 :bind ( :map emacs-lisp-mode-map 450(keymap-global-set "M-s d" #'consult-find)
812 ("C-c e" . macrostep-expand) 451(keymap-global-set "M-s D" #'consult-locate)
813 :map lisp-interaction-mode-map 452(keymap-global-set "M-s g" #'consult-grep)
814 ("C-c e" . macrostep-expand))) 453(keymap-global-set "M-s G" #'consult-git-grep)
815 454(keymap-global-set "M-s r" #'consult-ripgrep)
816(use-package package-lint 455(keymap-global-set "M-s l" #'consult-line)
817 :ensure t) 456(keymap-global-set "M-s k" #'consult-keep-lines)
818 457(keymap-global-set "M-s u" #'consult-focus-lines)
819(use-package sly 458
820 :ensure t 459(keymap-global-set "M-s e" #'consult-isearch-history)
821 :when inferior-lisp-program 460(keymap-set isearch-mode-map "M-e" #'consult-isearch-history)
822 :preface 461(keymap-set isearch-mode-map "M-s e" #'consult-isearch-history)
823 (setq inferior-lisp-program (choose-executable "sbcl")) 462(keymap-set isearch-mode-map "M-s l" #'consult-line)
824 (defun +sly-start-or-mrepl () 463
825 (interactive) 464(keymap-set minibuffer-local-map "M-n" #'consult-history)
826 (if (ignore-errors (sly-connection)) 465(keymap-set minibuffer-local-map "M-p" #'consult-history)
827 (sly-mrepl (lambda (buf) 466
828 (display-buffer-pop-up-window buf nil))) 467(setopt completion-in-region-function #'consult-completion-in-region
829 (call-interactively #'sly))) 468 xref-show-xrefs-function #'consult-xref
830 :config 469 xref-show-definitions-function #'consult-xref)
831 (autoload 'sly-mrepl "sly-mrepl" nil t) 470
832 (keymap-set sly-mode-map "C-c C-z" #'+sly-start-or-mrepl) 471(setopt initial-scratch-message ";;; Emacs!\n\n")
833 (setq sly-net-coding-system 'utf-8-unix) 472
834 (sly-symbol-completion-mode -1)) 473(keymap-global-set "C-x C-b" #'ibuffer)
835 474(add-hook 'ibuffer-hook #'hl-line-mode)
836(use-package pdf-tools
837 :ensure t
838 :mode ("\\.[pP][dD][fF]\\'" . pdf-view-mode)
839 :magic ("%PDF" . pdf-view-mode)
840 :config
841 (pdf-tools-install))
842
843(use-package keychain-environment
844 :ensure t
845 :when (executable-find "keychain")
846 :hook (after-init-hook . keychain-refresh-environment))
847
848(use-package web-mode
849 :ensure t
850 :mode ("\\.phtml\\'"
851 "\\.tpl\\.php\\'"
852 "\\.[agj]sp\\'"
853 "\\.as[cp]x\\'"
854 "\\.erb\\'"
855 "\\.mustache\\'"
856 "\\.djhtml\\'"
857 "\\.html?\\'")
858 :config
859 (add-hook 'web-mode-hook
860 (defun web-mode@setup ()
861 (indent-tabs-mode -1))))
862
863(use-package nginx-mode
864 :ensure t
865 :mode "/nginx/sites-\\(?:available\\|enabled\\)/")
866
867(use-package markdown-mode
868 :ensure t
869 :mode "\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'"
870 :config
871 (setq markdown-command (choose-executable
872 '("pandoc" "--from=markdown" "--to=html5")
873 "markdown"))
874 (add-hook 'markdown-mode-hook #'visual-fill-column-mode))
875
876(use-package pandoc-mode
877 :ensure t
878 :hook ((markdown-mode-hook . pandoc-mode)
879 (pandoc-mode-hook . pandoc-load-default-settings)))
880
881(use-package edit-indirect
882 :ensure
883 :bind (("C-c '" . edit-indirect-region)))
884
885(use-package transpose-frame
886 :ensure t
887 :bind (("C-x 5 t" . transpose-frame)
888 ("C-x 5 h" . flop-frame) ; horizontal
889 ("C-x 5 v" . flip-frame) ; vertical
890 ))
891
892(use-package magit
893 :pin melpa-stable
894 :ensure t
895 :bind ("C-x g" . magit))
896
897(use-package git-modes
898 :ensure t)
899
900(use-package eradio
901 :ensure t
902 :preface
903 (defun eradio-toggle|play (&optional arg)
904 "Run `eradio-toggle', or `eradio-play' with prefix ARG."
905 (interactive "P")
906 (if arg (eradio-play) (eradio-toggle)))
907 :bind (("C-c r p" . eradio-toggle|play)
908 ("C-c r s" . eradio-stop))
909 :config
910 (setq eradio-player '("mpv" "--no-video" "--no-terminal")
911 eradio-channels
912 ;; (name . url)
913 '(("Nightwave Plaza" . "http://radio.plaza.one/ogg")
914 ("Radio Paradise - Main Mix" .
915 "http://stream.radioparadise.com/rp_192m.ogg")
916 ("Radio Paradise - Mellow Mix" .
917 "http://stream.radioparadise.com/mellow-96m.ogg")
918 ("Radio Paradise - Rock Mix" .
919 "http://stream.radioparadise.com/rock-96m.ogg")
920 ("Radio Paradise - Global Mix" .
921 "http://stream.radioparadise.com/global-96m.ogg")
922 ("KLSU" . "http://130.39.238.143:8010/stream.mp3"))
923 ;; At some point I should actually ... write this in to this file or
924 ;; something. But until I decide to quit using radish altogether, this
925 ;; what I got.
926 ;; (with-current-buffer (find-file-noselect "~/etc/radish/stations")
927 ;; (let (chans)
928 ;; (dolist (line (string-split (buffer-substring-no-properties
929 ;; (point-min) (point-max))
930 ;; "\n")
931 ;; chans)
932 ;; (unless (string-match-p "^#" line)
933 ;; (let* ((ll (string-split line "\t"))
934 ;; (url (cl-first ll))
935 ;; (name (cl-second ll))
936 ;; (tags (cl-third ll)))
937 ;; (when (and name
938 ;; (string-match-p "[^ \n\t]*://[^ \n\t]*" url))
939 ;; (push (cons (format "%s - %s" name tags) url)
940 ;; chans)))))))
941 ))
942
943(use-package wiki-abbrev
944 :after org ; Don't need abbrevs til I load org.
945 :load-path "~/src/wiki-abbrev.el/"
946 :config
947 (setq wiki-abbrev-file (etc/ "wiki-abbrevs"))
948 (wiki-abbrev-insinuate))
949
950(use-package flyspell-correct
951 :ensure t
952 :preface
953 (defun +flyspell-correct-buffer (&optional prefix)
954 "Run `flyspell-correct-wrapper' on all misspelled words in the buffer.
955With PREFIX, prompt to change the current dictionary."
956 (interactive "P")
957 (flyspell-buffer)
958 (when prefix
959 (let ((current-prefix-arg nil))
960 (call-interactively #'ispell-change-dictionary)))
961 (flyspell-correct-move (point-min) :forward :rapid))
962 :after flyspell
963 :bind (("<f7>" . +flyspell-correct-buffer)
964 (:map flyspell-mode-map
965 ("C-;" . flyspell-correct-wrapper)))
966 :config
967 (setq flyspell-correct--cr-key ";")
968 (keymap-unset flyspell-mode-map "C-," t)
969 (keymap-unset flyspell-mode-map "C-." t))
970
971(use-package dired-subtree
972 :ensure t
973 :after dired
974 :bind (:map dired-mode-map
975 (("TAB" . dired-subtree-cycle)
976 ("i" . dired-subtree-toggle))))
977
978(use-package dired-hide-dotfiles
979 ;; I could maybe use a more general package for this ... see
980 ;; https://emacs.grym.io/#orgbbda609
981 :ensure t
982 :bind (:map dired-mode-map
983 ("." . dired-hide-dotfiles-mode)))
984
985(use-package dired-git-info
986 :ensure t
987 :bind (:map dired-mode-map
988 (")" . dired-git-info-mode))
989 :config
990 (setq dgi-auto-hide-details-p nil))
991
992(use-package expand-region ; needed for embrace anyway
993 :ensure t
994 :bind (("C-=" . er/expand-region)))
995
996(use-package embrace
997 :ensure t
998 :preface
999 (defmacro org-insert-or-embrace (char)
1000 "Define a function to insert CHAR, or `embrace' the region with it."
1001 (let* ((fn-name (intern (format "org-insert-or-embrace-%s" char)))
1002 (char (cond ((characterp char) char)
1003 ((stringp char) (string-to-char char))
1004 (t (user-error "Bad format for char: %S" char)))))
1005 `(defun ,fn-name (n)
1006 ,(format "Insert N %ss, or surround the region with them."
1007 (char-to-string char))
1008 (interactive "p")
1009 (if (region-active-p)
1010 (dotimes (_ n)
1011 (embrace--add-internal (region-beginning) (region-end) ,char)
1012 (forward-char 1))
1013 (self-insert-command n ,char)))))
1014 (with-eval-after-load 'org
1015 (require 'embrace)
1016 (keymap-set org-mode-map "*" (org-insert-or-embrace "*"))
1017 (keymap-set org-mode-map "/" (org-insert-or-embrace "/"))
1018 (keymap-set org-mode-map "_" (org-insert-or-embrace "_"))
1019 (keymap-set org-mode-map "=" (org-insert-or-embrace "="))
1020 (keymap-set org-mode-map "~" (org-insert-or-embrace "~"))
1021 (keymap-set org-mode-map "+" (org-insert-or-embrace "+")))
1022 :bind (("C-'" . embrace-commander))
1023 :hook ((org-mode-hook . embrace-org-mode-hook)
1024 (ruby-mode-hook . embrace-ruby-mode-hook)
1025 (emacs-lisp-mode-hook . embrace-emacs-lisp-mode-hook)
1026 (latex-mode-hook . embrace-LaTeX-mode-hook)))
1027
1028(use-package apheleia
1029 :ensure t
1030 :config
1031 (setq apheleia-hide-log-buffers t)
1032 (setf (alist-get 'shfmt apheleia-formatters)
1033 '("shfmt" "--case-indent"))
1034 (global-set-key (kbd "M-C-\\")
1035 (defun +apheleia-format|indent-buffer ()
1036 (interactive)
1037 (if-let ((formatters (apheleia--get-formatters)))
1038 (apheleia-format-buffer
1039 formatters
1040 (lambda ()
1041 (with-demoted-errors "Apheleia: %s"
1042 (when buffer-file-name
1043 (let ((apheleia--format-after-save-in-progress t))
1044 (apheleia--save-buffer-silently)))
1045 (run-hooks 'apheleia-post-format-hook))))
1046 (indent-region (point-min) (point-max))
1047 (when buffer-file-name
1048 (save-buffer))))))
1049
1050(use-package php-mode
1051 :ensure t)
1052
1053(use-package rec-mode
1054 :ensure t)
1055
1056
1057(use-package geiser
1058 :ensure t
1059 :config
1060 (when (executable-find "guile")
1061 (use-package geiser-guile :ensure t))
1062 (when (executable-find "chicken")
1063 (use-package geiser-chicken :ensure t))
1064 (when (or (prog1 (executable-find "chez")
1065 (setopt geiser-chez-binary
1066 (executable-find "chez")))
1067 (executable-find "petite")
1068 (executable-find "scheme"))
1069 (use-package geiser-chez :ensure t))
1070 (when (executable-find "gambit")
1071 (use-package geiser-gambit :ensure t))
1072 (when (executable-find "chibi-scheme")
1073 (use-package geiser-chibi :ensure t))
1074 (use-package macrostep-geiser
1075 :ensure t
1076 :config
1077 (eval-after-load 'geiser-mode
1078 '(add-hook 'geiser-mode-hook #'macrostep-geiser-setup))
1079 (eval-after-load 'geiser-repl
1080 '(add-hook 'geiser-repl-mode-hook #'macrostep-geiser-setup)))
1081 (with-eval-after-load 'geiser-mode
1082 (keymap-set geiser-mode-map "C-c C-k" #'geiser-eval-buffer-and-go)
1083 (keymap-unset geiser-mode-map "C-." t)
1084 (keymap-unset scheme-mode-map "M-o" t)))
1085
1086(use-package detached
1087 :when (executable-find "dtach")
1088 :ensure t
1089 :init
1090 (add-hook 'after-init-hook #'detached-init)
1091 :bind (([remap async-shell-command] . detached-shell-command)
1092 ([remap compile] . detached-compile)
1093 ([remap recompile] . detached-compile-recompile))
1094 :config
1095 (setf detached-terminal-data-command system-type)
1096 (with-eval-after-load 'consult
1097 (global-set-key [remap detached-open-session] #'detached-consult-session)))
1098
1099(use-package lin
1100 :ensure t
1101 :config
1102 (setq lin-face 'lin-cyan
1103 lin-mode-hooks
1104 '(dired-mode-hook
1105 ;; bongo-mode-hook
1106 ;; elfeed-search-mode-hook
1107 git-rebase-mode-hook
1108 grep-mode-hook
1109 ibuffer-mode-hook
1110 ilist-mode-hook
1111 ;; ledger-report-mode-hook
1112 log-view-mode-hook
1113 magit-log-mode-hook
1114 ;; mu4e-headers-mode-hook
1115 notmuch-search-mode-hook
1116 notmuch-tree-mode-hook
1117 occur-mode-hook
1118 org-agenda-mode-hook
1119 pdf-outline-buffer-mode-hook
1120 proced-mode-hook
1121 tabulated-list-mode-hook))
1122 (lin-global-mode))
1123
1124(use-package gcmh
1125 :ensure t
1126 :config
1127 (setq gcmh-idle-delay 'auto
1128 gcmh-verbose nil)
1129 (gcmh-mode))
1130
1131(use-package tmr
1132 :ensure t
1133 :preface
1134 (defun tmr-mode-line ()
1135 (if (seq-find (lambda (tmr)
1136 (not (tmr--timer-finishedp tmr)))
1137 tmr--timers)
1138 (propertize "⏲" 'face 'font-lock-warning-face)
1139 ""))
1140 ;; (add-to-list 'global-mode-string
1141 ;; '("" (:eval (tmr-mode-line)))
1142 ;; 'append)
1143 )
1144
1145(use-package dumb-jump
1146 :ensure t
1147 :hook ((xref-backend-functions . dumb-jump-xref-activate)))
1148
1149(use-package le-thesaurus
1150 :ensure t
1151 :bind (("C-c w s" . le-thesaurus-get-synonyms)
1152 ("C-c w a" . le-thesaurus-get-antonyms)))
1153
1154(use-package devdocs
1155 :ensure t
1156 ;; not sure what to bind anything to yet ... so M-x it is
1157 )
1158
1159(use-package comment-dwim-2
1160 :ensure t
1161 :bind (("M-;" . comment-dwim-2)
1162 :map org-mode-map
1163 ("M-;" . org-comment-dwim-2)))
diff --git a/lisp/+completions.el b/lisp/+completions.el deleted file mode 100644 index 9baaaf8..0000000 --- a/lisp/+completions.el +++ /dev/null
@@ -1,65 +0,0 @@
1;;; +completions.el --- Better default completions -*- lexical-binding: t; -*-
2
3;; From https://robbmann.io/posts/emacs-29-completions/
4
5(defun minibuffer@bindings ()
6 (unless vertico-mode
7 ;; Up/down when completing in the minibuffer
8 (define-key minibuffer-local-map (kbd "C-p") #'minibuffer-previous-completion)
9 (define-key minibuffer-local-map (kbd "C-n") #'minibuffer-next-completion)
10
11 ;; Up/down when competing in a normal buffer
12 (define-key completion-in-region-mode-map (kbd "C-p")
13 #'minibuffer-previous-completion)
14 (define-key completion-in-region-mode-map (kbd "C-n")
15 #'minibuffer-next-completion)))
16
17(add-hook 'vertico-mode-hook #'minibuffer@bindings)
18
19(defun renz/sort-by-alpha-length (elems)
20 "Sort ELEMS first alphabetically, then by length."
21 (sort elems (lambda (c1 c2)
22 (or (string-version-lessp c1 c2)
23 (< (length c1) (length c2))))))
24
25(defun renz/sort-by-history (elems)
26 "Sort ELEMS by minibuffer history.
27Use `mct-sort-sort-by-alpha-length' if no history is available."
28 (if-let ((hist (and (not (eq minibuffer-history-variable t))
29 (symbol-value minibuffer-history-variable))))
30 (minibuffer--sort-by-position hist elems)
31 (renz/sort-by-alpha-length elems)))
32
33(defun renz/completion-category ()
34 "Return completion category."
35 (when-let ((window (active-minibuffer-window)))
36 (with-current-buffer (window-buffer window)
37 (completion-metadata-get
38 (completion-metadata (buffer-substring-no-properties
39 (minibuffer-prompt-end)
40 (max (minibuffer-prompt-end) (point)))
41 minibuffer-completion-table
42 minibuffer-completion-predicate)
43 'category))))
44
45(defun renz/sort-multi-category (elems)
46 "Sort ELEMS per completion category."
47 (pcase (renz/completion-category)
48 ('nil elems) ; no sorting
49 ('kill-ring elems)
50 ('project-file (renz/sort-by-alpha-length elems))
51 (_ (renz/sort-by-history elems))))
52
53(setq completion-auto-help 'always
54 completion-auto-select 'second-tab
55 completions-max-height 10
56 completions-header-format nil
57 completion-show-help nil
58 completions-format 'one-column
59 save-completions-file-name (etc/ "completions")
60 completions-sort #'renz/sort-multi-category)
61
62(add-hook 'completion-list-mode-hook #'truncate-lines-local-mode)
63
64(provide '+completions)
65;;; +completions.el ends here
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 0e0b9b1..0000000 --- a/lisp/+link-hint.el +++ /dev/null
@@ -1,175 +0,0 @@
1;;; +link-hint.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'link-hint)
7
8(defgroup +link-hint nil
9 "Extra customizations for `link-hint'."
10 :group 'link-hint)
11
12(defcustom +link-hint-open-secondary-types '(gnus-w3m-image-url
13 gnus-w3m-url
14 markdown-link
15 mu4e-attachment
16 mu4e-url
17 notmuch-hello
18 nov-link
19 org-link
20 shr-url
21 text-url
22 w3m-link
23 w3m-message-link)
24 "Link types to define `:open-secondary' for.")
25
26(defvar +link-hint-map (make-sparse-keymap)
27 "Keymap for `link-hint' functionality.")
28
29(cl-defmacro +link-hint-define-keyword (keyword handler docstring
30 &optional (types 'link-hint-types)
31 &rest rest
32 &key multiple &allow-other-keys)
33 "Set up a `link-hint' KEYWORD, with optional TYPES.
34If TYPES is not present, use `link-hint-types'.
35
36KEYWORD defines the link-hint type. It will be used to create a
37function for opening links of the form \"link-hint-openKEYWORD\".
38
39HANDLER is the function to open a link with.
40
41DOCSTRING is the macro's documentation.
42
43Keyword arguments are passed to `link-hint-define-type' prefixed
44with the KEYWORD."
45 (declare (indent 2)
46 (doc-string 3))
47 (let ((types (symbol-value types))
48 (func-sym (intern (format "+link-hint-open%s" keyword)))
49 (mult-sym (intern (format "%s-multiple" keyword)))
50 (expr))
51 ;; Define the type
52 (push `(dolist (type ',types)
53 (link-hint-define-type type
54 ,keyword ,handler
55 ,@(mapcar (lambda (el)
56 (if (eq el :multiple)
57 mult-sym
58 el))
59 rest)))
60 expr)
61 ;; Define an opener
62 (push `(defun ,func-sym ()
63 ,(format "%s\n\nDefined by `+link-hint-define'." docstring)
64 (interactive)
65 (avy-with link-hint-open-link
66 (link-hint--one ,keyword)))
67 expr)
68 ;; Handle `:multiple'
69 (when multiple
70 (push `(defun ,(intern (format "+link-hint-open-multiple%s" keyword)) ()
71 ,(format "Open multiple links with `%s'.\n\nDefined by `+link-hint-define'."
72 func-sym)
73 (avy-with link-hint-open-multiple-links
74 (link-hint--multiple ,keyword)))
75 expr)
76 (push `(defun ,(intern (format "+link-hint-open-all%s" keyword)) ()
77 ,(format "Open all visible links with `%s'.\n\nDefined by `+link-hint-define'."
78 func-sym)
79 (avy-with link-hint-open-all-links
80 (link-hint--all ,keyword)))
81 expr))
82 ;; Return the built expression
83 `(progn ,@(nreverse expr))))
84
85(+link-hint-define-keyword :secondary browse-url-secondary-browser-function
86 "Open a link in the secondary browser."
87 +link-hint-open-secondary-types
88 :multiple t)
89
90(progn
91 (dolist
92 (type
93 '(gnus-w3m-image-url gnus-w3m-url markdown-link mu4e-attachment mu4e-url notmuch-hello nov-link org-link shr-url text-url w3m-link w3m-message-link))
94 (link-hint-define-type type :download
95 (function +browse-url-download)
96 :download-multiple t))
97 (defun +link-hint-open:download nil "Download a link to `eww-download-directory'.
98
99Defined by `+link-hint-define'."
100 (interactive)
101 (avy-with link-hint-open-link
102 (link-hint--one :download)))
103 (defun +link-hint-open-multiple:download nil "Open multiple links with `+link-hint-open:download'.
104
105Defined by `+link-hint-define'."
106 (avy-with link-hint-open-multiple-links
107 (link-hint--multiple :download)))
108 (defun +link-hint-open-all:download nil "Open all visible links with `+link-hint-open:download'.
109
110Defined by `+link-hint-define'."
111 (avy-with link-hint-open-all-links
112 (link-hint--all :download))))
113
114;; (defun +link-hint-open-secondary-setup (&optional types)
115;; "Define the `:open-secondary' link-hint type for TYPES.
116;; If TYPES is nil, define it for `+link-hint-open-secondary-types'."
117;; (dolist (type (or types +link-hint-open-secondary-types))
118;; (link-hint-define-type type
119;; :open-secondary browse-url-secondary-browser-function
120;; :open-secondary-multiple t)))
121
122;; (defun +link-hint-open-secondary ()
123;; "Open a link in the secondary browser."
124;; (interactive)
125;; (avy-with link-hint-open-link
126;; (link-hint--one :open-secondary)))
127
128(+link-hint-define-keyword :chrome #'browse-url-chrome
129 "Open a link with `browse-url-chrome'."
130 +link-hint-open-secondary-types
131 :multiple t)
132
133;; (defun +link-hint-open-chrome-setup (&optional types)
134;; "Define the `:open-chrome' link-hint type for TYPES.
135;; If TYPES is nil, define it for `+link-hint-open-secondary-types'."
136;; (dolist (type (or types +link-hint-open-secondary-types))
137;; (link-hint-define-type type
138;; :open-chrome #'browse-url-chrome
139;; :open-chrome-multiple t)))
140
141;; (defun +link-hint-open-chrome ()
142;; "Open a link with chrome."
143;; (interactive)
144;; (avy-with link-hint-open-link
145;; (link-hint--one :open-chrome)))
146
147(defun +link-hint-open-link (prefix)
148 "Open a link.
149Without a PREFIX, open using `browse-url-browser-function'; with
150a PREFIX, use `browse-url-secondary-browser-function'."
151 (interactive "P")
152 (let ((current-prefix-arg nil))
153 (avy-with link-hint-open-link
154 (link-hint--one (if prefix :open-secondary :open)))))
155
156;; test: https://www.acdw.net
157
158(defun +link-hint-open-multiple-links (prefix)
159 "Open multiple links.
160Without a PREFIX, open using `browse-url-browser-function'; with
161a PREFIX, use `browse-url-secondary-browser-function'."
162 (interactive "P")
163 (avy-with link-hint-open-multiple-links
164 (link-hint--one (if prefix :open-secondary :open))))
165
166(defun +link-hint-open-all-links (prefix)
167 "Open all visible links.
168Without a PREFIX, open using `browse-url-browser-function'; with
169a PREFIX, use `browse-url-secondary-browser-function'."
170 (interactive "P")
171 (avy-with link-hint-open-all-links
172 (link-hint--one (if prefix :open-secondary :open))))
173
174(provide '+link-hint)
175;;; +link-hint.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 2f7bf6a..0000000 --- a/lisp/+org-capture.el +++ /dev/null
@@ -1,49 +0,0 @@
1;;; +org-capture.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6;; Don't /require/ `org-capture', since that'll pull in all of `org' and that'll
7;; take a minute. Just let the compiler know that this variable exists.
8(defvar org-capture-templates nil)
9
10;; https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573
11(defun +org-capture-template-define (description &rest args)
12 "Define a capture template.
13Creates a list and adds it to `org-capture-templates', if it's
14not already there. ARGS is a plist, which in addition to the
15additional options `org-capture-templates' accepts (which see),
16takes the following and puts them in the right spot: `:keys',
17`:description', `:type', `:target', and `:template'."
18 (declare (indent 1))
19 (let* ((keys (plist-get args :keys))
20 (type (plist-get args :type))
21 (target (plist-get args :target))
22 (template (plist-get args :template))
23 (template-value (append
24 (list description)
25 (when (or type target template)
26 (list (or type 'entry) target template))
27 (cl-loop for i from 0 below (length args) by 2
28 unless (member (nth i args)
29 '(:keys :description :type
30 :target :template))
31 append (list (nth i args)
32 (plist-get args (nth i
33 args)))))))
34 ;; The only way I know how to do this properly (add a value to the end of
35 ;; the list, if it exists; otherwise update it) is to do this weird if-setf
36 ;; dance.
37 (if (seq-find (lambda (el) (equal (car el) keys))
38 org-capture-templates)
39 (setf (alist-get keys org-capture-templates nil nil #'equal)
40 template-value)
41 (setf org-capture-templates
42 (append org-capture-templates
43 (list (cons keys template-value)))))
44 ;; Regardless of what we do, return the new value of
45 ;; `org-capture-templates'.
46 org-capture-templates))
47
48(provide '+org-capture)
49;;; +org-capture.el
diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 5d749c6..0000000 --- a/lisp/+scratch.el +++ /dev/null
@@ -1,75 +0,0 @@
1;;; +scratch.el --- *scratch* improvements -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2023 Case Duckworth
4
5;; Author: Case Duckworth <case@acdw.net>
6;; Keywords: convenience
7
8;; This program is free software; you can redistribute it and/or modify
9;; it under the terms of the GNU General Public License as published by
10;; the Free Software Foundation, either version 3 of the License, or
11;; (at your option) any later version.
12
13;; This program is distributed in the hope that it will be useful,
14;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16;; GNU General Public License for more details.
17
18;; You should have received a copy of the GNU General Public License
19;; along with this program. If not, see <https://www.gnu.org/licenses/>.
20
21;;; Commentary:
22
23;;
24
25;;; Code:
26
27(defcustom +scratch-save-dir (locate-user-emacs-file "scratch.d")
28 "Where to save scratch files."
29 :type 'file)
30
31(defcustom +scratch-max-age (* 60 60 24 365)
32 "Maximum age of a saved scratch buffer. Default: one year."
33 :type 'natnum)
34
35(defun +scratch@immortal ()
36 "Don't kill *scratch* with `kill-buffer'."
37 (if (equal (buffer-name) "*scratch*")
38 (progn (bury-buffer) nil)
39 t))
40
41(defun +scratch-save (time-format)
42 "Save *scratch* buffer to `+scratch-save-dir'.
43TIME-FORMAT will be used to name the buffer."
44 (interactive (list "%FT%H%z"))
45 (with-current-buffer (get-scratch-buffer-create)
46 (let ((buffer-file-name (expand-file-name (format "%s.%s"
47 (format-time-string
48 time-format)
49 (pcase major-mode
50 ('org-mode "org")
51 ('emacs-lisp-mode "el")
52 (_ "txt")))
53 +scratch-save-dir)))
54 (unless (string-equal (buffer-substring (point-min) (point-max))
55 initial-scratch-message)
56 (save-buffer 0)))))
57
58(defun +scratch-save-on-exit ()
59 (+scratch-save "%FT%T%z")
60 (+scratch-clean))
61
62(defun +scratch-clean ()
63 "Clean up saved scratches.
64Scratch files older than `+scratch-max-age' will be removed."
65 (dolist (f (directory-files +scratch-save-dir))
66 (when (and (not (equal f "."))
67 (not (equal f ".."))
68 (> (time-convert (file-attribute-modification-time
69 (file-attributes f))
70 'integer)
71 +scratch-max-age))
72 (delete-file (expand-file-name f +scratch-save-dir) :trash))))
73
74(provide '+scratch)
75;;; +scratch.el ends here
diff --git a/lisp/acdw-chat.el b/lisp/acdw-chat.el deleted file mode 100644 index 9294ffe..0000000 --- a/lisp/acdw-chat.el +++ /dev/null
@@ -1,206 +0,0 @@
1;;; acdw-chat.el --- Chat applications (mostly jabber) -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defcustom jabber-prefix-width 10
6 "Width of jabber prompts and other prefixes."
7 :type 'number
8 :group 'jabber)
9
10(defun jabber-ui-setup ()
11 "Setup the `jabber' user interface."
12 (visual-fill-column-mode)
13 (electric-pair-local-mode -1)
14 (auto-fill-mode -1)
15 (setq-local wrap-prefix (make-string (+ 3 jabber-prefix-width) #x20)
16 visual-fill-column-extra-text-width `(,(+ 3 jabber-prefix-width)
17 . 1)))
18
19(defcustom jabber-biboumi-server "localhost"
20 "Biboumi server for `jabber-biboumi-muc-connect'."
21 :type 'string
22 :group 'jabber)
23
24(defcustom jabber-biboumi-irc-servers '("irc.libera.chat")
25 "IRC servers for the user to choose from with `jabber-biboumi-muc-connect'."
26 :type '(repeat string)
27 :group 'jabber)
28
29(defcustom jabber-biboumi-default-nick ""
30 "Default nick for biboumi rooms."
31 :type 'string
32 :group 'jabber)
33
34(defun jabber-biboumi-muc-connect (channel server nick &optional biboumi-server)
35 "Connect to a biboumi (IRC gateway) server MUC.
36CHANNEL, SERVER, NICK, and BIBOUMI-SERVER are passed to
37`jabber-muc-join'. If BIBOUMI-SERVER isn't given,
38`jabber-biboumi-server' is used."
39 (interactive (list (concat "#" (string-remove-prefix "#" (read-string
40 "Channel: ")))
41 (completing-read "Server: " jabber-biboumi-irc-servers)
42 (read-string (format "Nick [%s]: "
43 jabber-biboumi-default-nick)
44 nil nil jabber-biboumi-default-nick)))
45 (let ((room (format "%s%%%s@%s" channel server (or biboumi-server
46 jabber-biboumi-server))))
47 (if (assoc room *jabber-active-groupchats*)
48 (switch-to-buffer (jabber-muc-get-buffer room))
49 (jabber-muc-join (jabber-read-account)
50 room
51 nick
52 'popup))))
53
54(defalias 'jabber-irc-join 'jabber-biboumi-muc-connect)
55
56(defun jabber-connect-all* (&optional arg)
57 "Run `jabber-connect-all'.
58With a prefix ARG, disconnect first."
59 (interactive "p")
60 (when arg
61 (jabber-disconnect))
62 (jabber-connect-all))
63
64(defun jabber-group-yank-join-url ()
65 "Yank a url for joining the focused group."
66 (interactive)
67 (let ((s (format "xmpp:%s?join" jabber-group)))
68 (kill-new s)
69 (message s)))
70
71
72;;; Packages
73
74(use-package jabber
75 :load-path "~/src/jabber.el/"
76 :custom-face
77 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
78 :foreground unspecified
79 :weight normal)))
80 (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local
81 :foreground unspecified
82 :weight bold)))
83 (jabber-chat-prompt-local ((t :inherit minibuffer-prompt
84 :foreground unspecified
85 :weight normal
86 :slant italic)))
87 (jabber-chat-prompt-foreign ((t :inherit warning
88 :foreground unspecified
89 :weight normal)))
90 (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
91 :foreground unspecified)))
92 (jabber-rare-time-face ((t :inherit font-lock-comment-face
93 :foreground unspecified
94 :underline nil)))
95 :bind-keymap ("C-c j" . jabber-global-keymap)
96 :bind (("C-c C-SPC" . jabber-activity-switch-to))
97 :config
98 (setq jabber-account-list '(("acdw@hmm.st"))
99 jabber-auto-reconnect t
100 jabber-biboumi-server "irc.hmm.st"
101 jabber-biboumi-irc-servers '("irc.libera.chat"
102 "irc.oftc.net"
103 "irc.tilde.chat"
104 "tilde.town"
105 "m455.casa"
106 "irc.twitch.tv")
107 jabber-biboumi-default-nick "acdw"
108 jabber-last-read-marker (make-string fill-column ?.)
109 jabber-muc-decorate-presence-patterns
110 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
111 ("Mode #.*" . jabber-muc-presence-dim)
112 ("." . jabber-muc-presence-dim))
113 jabber-activity-make-strings #'jabber-activity-make-strings-shorten
114 jabber-rare-time-format " - - - - - - %H:%M %F"
115 jabber-chat-header-line-format
116 '("" (jabber-chat-buffer-show-avatar
117 (:eval
118 (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
119 (jabber-propertize " "
120 'display (get buddy 'avatar)))))
121 (:eval (replace-regexp-in-string "%" "%%"
122 (jabber-jid-displayname
123 jabber-chatting-with)))
124 "\t" (:eval (let ((buddy (jabber-jid-symbol jabber-chatting-with)))
125 (propertize
126 (or
127 (cdr (assoc (get buddy 'show) jabber-presence-strings))
128 (get buddy 'show))
129 'face
130 (or (cdr (assoc (get buddy 'show) jabber-presence-faces))
131 'jabber-roster-user-online))))
132 "\t" (:eval (jabber-fix-status (get (jabber-jid-symbol jabber-chatting-with) 'status)))
133 "\t" jabber-events-message
134 "\t" jabber-chatstates-message)
135 jabber-muc-header-line-format
136 '(" " (:eval (replace-regexp-in-string "%" "%%"
137 (jabber-jid-displayname
138 jabber-group)))
139 " / " jabber-muc-topic)
140 ;; buffer name formats
141 jabber-chat-buffer-format "*xmpp* %n"
142 jabber-browse-buffer-format "*xmpp-browse* %n"
143 jabber-groupchat-buffer-format "*xmpp-muc* %n"
144 jabber-muc-private-buffer-format "*xmpp-muc-private* %n"
145 ;; "prompt" (speaker) formats
146 jabber-groupchat-prompt-format (format "%%>%dn . " jabber-prefix-width)
147 jabber-chat-local-prompt-format (format "%%>%dn . " jabber-prefix-width)
148 jabber-chat-foreign-prompt-format (format "%%>%dn . " jabber-prefix-width)
149 jabber-muc-private-foreign-prompt-format "\n%g/%n . ")
150 ;; jabber muc nick coloring
151 ;; wgreenhous | I found 1.5 ok for saturation and 2.0 for value (modus)
152 ;; (setopt jabber-muc-nick-value 1.0
153 ;; jabber-muc-nick-saturation 1.0
154 ;; jabber-muc-colorize-local t
155 ;; jabber-muc-colorize-foreign t)
156 ;; When changing the above values, make sure to
157 ;; (setq jabber-muc-participant-colors nil)
158 (add-hook 'jabber-chat-mode-hook #'jabber-ui-setup)
159 (keymap-global-set "C-x C-j" #'dired-jump) ; Extremely annoying fix
160 ;; For each binding in `jabber-global-keymap', also bind the non-control
161 ;; character (lowercase)
162 (map-keymap (lambda (key command)
163 (define-key jabber-global-keymap (vector (+ key #x60)) command))
164 jabber-global-keymap)
165 (define-key jabber-global-keymap "c" #'jabber-connect-all*)
166 (require 'jabber-httpupload nil t)
167 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
168 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
169 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
170 (add-hook 'jabber-alert-muc-hooks
171 (defun jabber@highlight-acdw (&optional _ _ buf _ _)
172 (when buf
173 (with-current-buffer buf
174 (let ((regexp (rx word-boundary
175 "acdw" ; maybe get from the config?
176 word-boundary)))
177 (hi-lock-unface-buffer regexp)
178 (highlight-regexp regexp 'jabber-chat-prompt-local))))))
179 (add-hook 'jabber-chat-mode-hook
180 (defun jabber-chat@leave-when-kill ()
181 (add-hook 'kill-buffer-hook
182 (defun @jabber-leave@kill ()
183 (ignore-errors
184 (apply #'jabber-muc-leave (jabber-muc-argument-list))))
185 nil :local)))
186 (when (fboundp 'jabber-chat-update-focus)
187 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus))
188 (with-eval-after-load 'consult
189 (defvar jabber-chat-buffer-source
190 `( :name "Jabber"
191 :hidden nil
192 :narrow ?j
193 :category buffer
194 :state ,#'consult--buffer-state
195 :items ,(lambda ()
196 (mapcar #'buffer-name
197 (seq-filter (lambda (buf)
198 (with-current-buffer buf
199 (eq major-mode 'jabber-chat-mode)))
200 (buffer-list))))))
201 (add-to-list 'consult-buffer-sources 'jabber-chat-buffer-source :append)
202 (consult-customize
203 consult-buffer :preview-key "M-.")))
204
205(provide 'acdw-chat)
206;;; acdw-chat.el ends here
diff --git a/lisp/acdw-mail.el b/lisp/acdw-mail.el deleted file mode 100644 index bf20c9b..0000000 --- a/lisp/acdw-mail.el +++ /dev/null
@@ -1,439 +0,0 @@
1;;; acdw-mail.el --- My email configuration -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'message)
7
8;;; Variables
9
10(defcustom +message-send-dispatch-rules nil
11 "Alist to set variables based on the current from address."
12 :group 'message
13 :type '(alist :key-type (string :tag "From address")
14 :value-type (alist :tag "Rules"
15 :key-type (symbol :tag "Variable")
16 :value-type (sexp :tag "Value"))))
17
18(defcustom +notmuch-spam-tags '("+spam -inbox -unread")
19 "List of tag changes to apply when marking a thread as spam."
20 :group 'notmuch
21 :type '(repeat string))
22
23;;; Functions
24
25(defun +message-send-set-variables ()
26 "Set variables for `message-send' depending on the From: header.
27Useful in `message-send-hook'."
28 (unless +message-send-dispatch-rules
29 (load notmuch-init-file)
30 (or +message-send-dispatch-rules
31 (error "`+message-send-dispatch-rules' isn't set!")))
32 (let ((from (message-fetch-field "from")))
33 (cl-loop for (var . val) in (cl-loop for (address . bindings)
34 in +message-send-dispatch-rules
35 if (string-match-p address from)
36 return bindings)
37 do (set (make-local-variable var) val))))
38
39;; Thanks to Alex Schroeder!
40;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
41(defun +message-check-for-signature-change (&rest ignore)
42 "Check for a change in the To: or Cc: fields"
43 (when (and (message--in-tocc-p)
44 (not (buffer-narrowed-p)))
45 (save-excursion
46 (goto-char (point-max))
47 (let ((end (point)))
48 (when (re-search-backward message-signature-separator nil t)
49 (delete-region (1- (match-beginning 0)) end)))
50 (message-insert-signature))))
51
52(defun +message-signature-setup ()
53 (make-local-variable 'after-change-functions)
54 (push '+message-check-for-signature-change after-change-functions))
55
56(defun +notmuch-field-match-p (field regexp)
57 "Return whether message FIELD matches REGEXP."
58 (string-match-p regexp (or (message-fetch-field field) "")))
59
60(defun +notmuch-query-concat (&rest queries)
61 "Concatenate `notmuch' QUERIES with AND."
62 (mapconcat #'identity queries " AND "))
63
64;;;###autoload
65(defun +notmuch-goto (&optional prefix)
66 "Perform a saved `notmuch' search.
67Without a PREFIX argument, perform the first search in
68`notmuch-saved-searches'. With a single PREFIX argument
69(\\[universal-argument]), prompt the user as to which saved
70search to perform. With two PREFIX arguments, prompt the user
71for a free-form search. With any other PREFIX argument, open
72`notmuch-hello'."
73 (interactive "P")
74 (pcase prefix
75 ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
76 ('(4) (notmuch-search
77 (plist-get (cl-find (completing-read "Saved search: "
78 (mapcar (lambda (elt)
79 (plist-get elt :name))
80 notmuch-saved-searches))
81 notmuch-saved-searches
82 :key (lambda (elt) (plist-get elt :name))
83 :test #'equal)
84 :query)))
85 ('(16) (notmuch-search))
86 (_ (notmuch-hello))))
87
88(defun +notmuch-search-mark-spam (&optional ham start end)
89 "Mark the current thread or region as spam.
90That is, add the tags in `+notmuch-spam-tags' to the message.
91With an optional HAM argument (interactively,
92\\[universal-argument]), mark the message as not-spam, or ham, by
93reversing the tag changes."
94 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
95 (when +notmuch-spam-tags
96 (notmuch-search-tag (notmuch-tag-change-list +notmuch-spam-tags ham)
97 start end))
98 (when (eq start end)
99 (notmuch-search-next-thread)))
100
101(defun +notmuch-tree-mark-spam (&optional ham _ _)
102 "Mark the current message as spam.
103That is, add the tags in `+notmuch-spam-tags' to the message.
104With an optional HAM argument (interactively,
105\\[universal-argument]), mark the message as not-spam, or ham, by
106reversing the tag changes."
107 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
108 (when +notmuch-spam-tags
109 (notmuch-tree-tag (notmuch-tag-change-list +notmuch-spam-tags ham)))
110 (notmuch-tree-next-matching-message))
111
112(defun +notmuch-define-saved-search (name key search-type &rest queries)
113 "Wrapper to ease `notmuch-saved-searches' defining.
114NAME, KEY, and SEARCH-TYPE are paired with the corresponding keywords in
115`notmuch-saved-searches', which see. QUERIES are all concatenated together with
116AND. If QUERIES is prepended with more keyword arguments, those are added to
117the saved search as well."
118 (declare (indent 3))
119 (let (extra-keywords)
120 (while (keywordp (car queries))
121 (push (cadr queries) extra-keywords)
122 (push (car queries) extra-keywords)
123 (setf queries (cddr queries)))
124 (add-to-list 'notmuch-saved-searches
125 (append (list :name name
126 :key key
127 :search-type search-type
128 :query (apply #'+notmuch-query-concat queries))
129 (reverse extra-keywords))
130 :append
131 (lambda (a b)
132 (equal (plist-get a :name)
133 (plist-get b :name))))))
134
135(defun notmuch-async-poll ()
136 "Run `notmuch-poll' in an async process."
137 (interactive)
138 (if (require 'async nil t)
139 (progn
140 (message "Polling mail (async)...")
141 (async-start
142 (lambda ()
143 (ignore-errors
144 (push "~/usr/share/emacs/site-lisp/" load-path)
145 (require 'notmuch-lib)
146 (notmuch-poll)))
147 (lambda (_)
148 (message "Polling mail (async)...done"))))
149 (user-error "Feature `async' not found!")
150 (notmuch-poll)))
151
152;;; https://kitchingroup.cheme.cmu.edu/blog/2015/09/04/Checking-for-email-attachments-before-you-send-email/
153
154(defun email-says-attach-p ()
155 "Return t if email suggests there could be an attachment."
156 (save-excursion
157 (goto-char (point-min))
158 (re-search-forward "attach" nil t)))
159
160(defun email-has-attachment-p ()
161 "Return t if the currently open email has an attachment."
162 (save-excursion
163 (goto-char (point-min))
164 (re-search-forward "<#part" nil t)))
165
166(defun email-pre-send-check-attachment ()
167 (when (and (email-says-attach-p)
168 (not (email-has-attachment-p)))
169 (unless
170 (y-or-n-p
171 "Your email suggests an attachment, but none was found. Send anyway?")
172 (error "No attachment. Aborting send."))))
173
174;;; Process ical attachments
175;; https://www.reddit.com/r/emacs/comments/8s1ion/comment/e0x5kgd/
176
177(defun ical2org (&optional replace output-buffer)
178 "Run ical2org on contents of this buffer.
179If REPLACE (interactive prefix argument), replace contents of the
180buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to
181minibuffer."
182 (interactive "P")
183 (shell-command-on-region (point-min) (point-max)
184 "ical2org.awk"
185 output-buffer
186 replace
187 "*ical2org errors*"
188 'display-errors))
189
190(defun ical2org-capture ()
191 "Run `ical2org' on this buffer, then `org-capture' the result.
192Leaves current buffer as-was afterwards."
193 (interactive)
194 (let ((buf (current-buffer))
195 (ics (buffer-string)))
196 (ical2org 'replace buf)
197 (mark-whole-buffer)
198 (org-capture nil "a")
199 (mark-whole-buffer)
200 (delete-region (point-min) (point-max))
201 (insert ics)))
202
203(defun notmuch-ics-refile (filename header)
204 "Refile the current ICS buffer to FILENAME, under HEADER."
205 (org-refile nil nil
206 (list header
207 filename
208 nil
209 (with-current-buffer (find-file-noselect filename)
210 (org-find-exact-headline-in-buffer header))))
211 (notmuch-ics-kill))
212
213(defun notmuch-ics-kill ()
214 "Kill the current ICS buffer and delete its file."
215 (let ((kill-buffer-hook nil)
216 (kill-buffer-query-functions nil)
217 (file (buffer-file-name)))
218 (set-buffer-modified-p nil)
219 (kill-buffer-and-window)
220 (delete-file file)))
221
222(defun notmuch-ics-cancel ()
223 "Cancel saving ICS buffer."
224 (interactive)
225 (notmuch-ics-kill))
226
227(define-derived-mode notmuch-save-ics-mode org-mode
228 "Org-mode but with a different keymap.")
229
230(defun notmuch-save-ics ()
231 ;; XXX: this is hacky as hell
232 "Save a .ics file in a message."
233 (interactive)
234 (with-current-notmuch-show-message
235 (notmuch-foreach-mime-part
236 (lambda (part)
237 (when (and (listp part)
238 (or (equal "application/ics" (caadr part))
239 ;; (equal "text/calendar" (caadr part))
240 ))
241 (let* ((filename (format "/dev/shm/notmuch-%s.ics"
242 (time-convert (current-time) 'integer))))
243 (mm-save-part-to-file part filename)
244 (message "Converting ICS to org ...")
245 (with-current-buffer (find-file-other-window filename)
246 (ical2org 'replace (current-buffer))
247 (deactivate-mark)
248 (let ((org-mode-hook nil))
249 (notmuch-save-ics-mode))
250 (local-set-key (kbd "C-c C-c")
251 (lambda () (interactive)
252 (notmuch-ics-refile (sync/ "org/diary.org") "Appointments")))
253 (local-set-key (kbd "C-c C-k") #'notmuch-ics-cancel)
254 (setq-local header-line-format
255 (concat "ICAL buffer. "
256 "Finish: `C-c C-c'. "
257 "Abort: `C-c C-k'."))))))
258 (mm-dissect-buffer t t))))
259
260(add-hook 'notmuch-show-hook #'notmuch-save-ics)
261
262
263;;; Fixes
264
265;; https://nmbug.notmuchmail.org/nmweb/show/87bklhricc.fsf%40tethera.net
266
267(defun notmuch--indent-rigidly (start end count)
268 (cond
269 ((zerop count) t)
270 ((< count 0) (indent-rigidly start end count))
271 (t
272 (save-excursion
273 (let ((startpt (progn (goto-char start) (line-beginning-position)))
274 (endpt (progn (goto-char end) (line-end-position)))
275 (spaces (spaces-string count)))
276 (goto-char startpt)
277 (while
278 (progn
279 (insert spaces)
280 (cl-incf endpt count)
281 (and (zerop (forward-line 1)) (bolp)
282 (<= (point) endpt)))))))))
283
284(with-eval-after-load 'notmuch-show
285 ;; Redefine `notmuch-show-lazy-part' --- XXX: this is the most braindead way
286 ;; of doing this
287 (defun notmuch-show-lazy-part (part-args button)
288 ;; Insert the lazy part after the button for the part. We would just
289 ;; move to the start of the new line following the button and insert
290 ;; the part but that point might have text properties (eg colours
291 ;; from a message header etc) so instead we start from the last
292 ;; character of the button by adding a newline and finish by
293 ;; removing the extra newline from the end of the part.
294 (save-excursion
295 (goto-char (button-end button))
296 (insert "\n")
297 (let* ((inhibit-read-only t)
298 ;; We need to use markers for the start and end of the part
299 ;; because the part insertion functions do not guarantee
300 ;; to leave point at the end of the part.
301 (part-beg (copy-marker (point) nil))
302 (part-end (copy-marker (point) t))
303 ;; We have to save the depth as we can't find the depth
304 ;; when narrowed.
305 (depth (notmuch-show-get-depth)))
306 (save-restriction
307 (narrow-to-region part-beg part-end)
308 (delete-region part-beg part-end)
309 (apply #'notmuch-show-insert-bodypart-internal part-args)
310 (notmuch--indent-rigidly part-beg
311 part-end
312 (* notmuch-show-indent-messages-width depth)))
313 (goto-char part-end)
314 (delete-char 1)
315 (notmuch-show-record-part-information (cadr part-args)
316 (button-start button)
317 part-end)
318 ;; Create the overlay. If the lazy-part turned out to be empty/not
319 ;; showable this returns nil.
320 (notmuch-show-create-part-overlays button part-beg part-end))))
321 )
322
323
324;;; Packages
325
326(use-package bbdb
327 :ensure t
328 :config
329 (setopt bbdb-complete-mail-allow-cycling t
330 bbdb-file (private/ "bbdb"))
331 (add-hook 'custom-allowed-after-load-hook
332 (defun bbdb@after-custom ()
333 (require 'bbdb)
334 (require 'bbdb-message)
335 (bbdb-initialize 'message))))
336
337(use-package bbdb-vcard
338 :ensure t
339 :after bbdb)
340
341(use-package notmuch
342 :when (executable-find "notmuch")
343 :load-path "~/usr/share/emacs/site-lisp/"
344 :defer 30
345 :commands (notmuch-mua-new-mail
346 notmuch-search
347 notmuch-hello)
348 :preface (defdir notmuch/ (sync/ "emacs/notmuch/")
349 "Notmuch configuration directory."
350 :makedir)
351 :config
352 ;; Options
353 (setopt notmuch-init-file (notmuch/ "notmuch-init.el" t)
354 notmuch-address-save-filename (notmuch/ "addresses" t)
355 notmuch-address-use-company (featurep 'company)
356 notmuch-search-oldest-first nil
357 notmuch-archive-tags '("-inbox" "-unread")
358 notmuch-draft-tags '("+draft" "-inbox" "-unread")
359 +notmuch-spam-tags '("+spam")
360 mail-user-agent 'notmuch-user-agent
361 message-mail-user-agent t
362 notmuch-show-indent-content nil
363 message-kill-buffer-on-exit t
364 message-auto-save-directory nil
365 message-signature "Case Duckworth\nhttps://www.acdw.net"
366 send-mail-function #'sendmail-send-it
367 mail-specify-envelope-from t
368 message-sendmail-envelope-from 'header
369 message-envelope-from 'header
370 notmuch-saved-searches nil
371 notmuch-poll-script "~/usr/scripts/syncmail" ; XXX: Deprecated option
372 )
373 (load notmuch-init-file)
374 ;; Key bindings
375 (keymap-set notmuch-search-mode-map "!" #'+notmuch-search-mark-spam)
376 (keymap-set notmuch-search-mode-map "RET" #'notmuch-search-show-thread)
377 (keymap-set notmuch-search-mode-map "M-RET" #'notmuch-tree-from-search-thread)
378 (keymap-set notmuch-tree-mode-map "!" #'+notmuch-tree-mark-spam)
379 ;; Saved searches
380 (+notmuch-define-saved-search "inbox+unread" "m" 'tree
381 "tag:inbox" "tag:unread" "NOT tag:Spam")
382 (+notmuch-define-saved-search "inbox" "i" 'tree
383 "tag:inbox" "NOT tag:Spam")
384 (+notmuch-define-saved-search "lists+unread" "l" 'tree
385 "tag:/List/" "tag:unread")
386 (+notmuch-define-saved-search "lists" "L" 'tree
387 "tag:/List/")
388 (+notmuch-define-saved-search "unread" "u" 'tree
389 "tag:unread" "NOT tag:Spam")
390 (+notmuch-define-saved-search "flagged" "f" 'tree
391 "tag:flagged")
392 (+notmuch-define-saved-search "sent" "t" 'tree
393 "tag:sent")
394 (+notmuch-define-saved-search "drafts" "d" 'tree
395 "tag:draft")
396 (+notmuch-define-saved-search "all mail" "a" 'tree "*")
397 ;; Hooks and advice
398 (add-hook 'message-send-hook #'+message-send-set-variables)
399 (add-hook 'message-send-hook #'email-pre-send-check-attachment)
400 (add-hook 'message-setup-hook #'+message-signature-setup)
401 (autoload 'visual-fill-column-mode "visual-fill-column" nil t)
402 (add-hook 'notmuch-message-mode-hook #'visual-fill-column-mode)
403 (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
404
405 (define-advice notmuch-bury-or-kill-this-buffer (:after (&rest _) poll-async)
406 (call-process "swaymail"))
407
408 (define-advice notmuch-address-selection-function
409 (:override (prompt collection _) no-initial-input)
410 "Call `completing-read' with `notmuch-address-history'.
411This version doesn't add any initial-input."
412 (completing-read prompt collection nil nil nil 'notmuch-address-history))
413
414 (add-to-list 'notmuch-message-headers "List-Post" :append #'equal)
415 (define-advice notmuch-mua-new-reply (:around (orig &rest r) list-aware)
416 "Make `notmuch-mua-new-reply' list-aware."
417 (let ((ml (notmuch-show-get-header :List-Post)))
418 (apply orig r)
419 (require 'message)
420 (when ml
421 (with-buffer-modified-unmodified
422 (message-remove-header "To")
423 (message-add-header
424 (format "To: %s" (replace-regexp-in-string "<mailto:\\(.*\\)>" "\\1"
425 ml)))
426 (message-goto-body)))))
427
428 (define-advice notmuch-tag (:filter-args (args) trim)
429 "Trim whitespace from ends of tags."
430 (list (car args) (mapcar #'string-trim (cadr args))))
431 ;; Load init file
432 (load notmuch-init-file :noerror))
433
434(use-package notmuch-tags
435 :load-path "~/src/emacs/notmuch-tags.el/"
436 :commands (notmuch-tags-mode))
437
438(provide 'acdw-mail)
439;;; acdw-mail.el ends here
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el deleted file mode 100644 index 2ec3339..0000000 --- a/lisp/acdw-org.el +++ /dev/null
@@ -1,548 +0,0 @@
1;;; acdw-org.el --- My org customizations -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7;;; Variables
8
9(defcustom org-agenda-skip-file-regexp nil
10 "Files matching this regexp are removed from `org-agenda-files'."
11 :group 'org-agenda
12 :type 'regexp)
13
14;;; Functions
15
16
17;;; DWIM
18
19;; https://github.com/alphapapa/unpackaged.el,
20;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
21(defun +org-return-dwim (&optional arg)
22 "A helpful replacement for `org-return'.
23When called interactively with \\[universal-argument], call `org-return'
24itself. Other values of ARG will call `newline' with that ARG."
25 (interactive "P")
26 ;; Auto-fill if enabled
27 (when auto-fill-function
28 (dolist (func (ensure-list auto-fill-function))
29 (funcall func)))
30 (cl-letf* ((el (org-element-at-point))
31 ((symbol-function 'el-child-of)
32 (lambda (&rest types)
33 (org-element-lineage el types t))))
34 (cond ; Figure out what we're going to do
35 (arg ; Handle prefix ARG
36 (pcase arg
37 ('(4) (org-return t nil t))
38 (_ (newline arg t))))
39 ((and org-return-follows-link ; Open a link
40 (el-child-of 'link))
41 (org-open-at-point-global))
42 ((org-at-heading-p) ; Open a paragraph after a heading
43 (let ((heading-start (org-entry-beginning-position)))
44 (goto-char (org-entry-end-position))
45 (cond ((and (org-at-heading-p) ; Entry is only a heading
46 (= heading-start (org-entry-beginning-position)))
47 (end-of-line)
48 (newline 2))
49 (:else ; Entry is more than a heading
50 (forward-line -1)
51 (end-of-line)
52 (when (org-at-heading-p)
53 ;; Open a paragraph
54 (forward-line)
55 (newline)
56 (forward-line -1))
57 (while (not (looking-back "\\(?:[[:blank:]]?\n\\)\\{3\\}" nil))
58 (newline))
59 (forward-line -1)))))
60 ((org-at-item-checkbox-p) ; Insert a new checkbox item
61 (end-of-line)
62 (org-insert-todo-heading nil))
63 ((org-in-item-p) ; Insert a new list item
64 (let* ((context (org-element-context el))
65 (first-item-p (eq 'plain-list (car context)))
66 (itemp (eq 'item (car context)))
67 (emptyp (or
68 ;; This (regular) list item is empty
69 (eq (org-element-property :contents-begin context)
70 (org-element-property :contents-end context))
71 ;; This (definition) list item is empty
72 (looking-at " *::")))
73 (item-child-p (el-child-of 'item)))
74 (cond ((and itemp emptyp)
75 ;; This test has to be here even though it's the same as the
76 ;; :else clause, because an item that's empty will also satisfy
77 ;; the next clause.
78 (delete-region (line-beginning-position) (line-end-position))
79 (newline))
80 ((or first-item-p
81 (and itemp (not emptyp))
82 item-child-p)
83 (org-end-of-item)
84 (org-insert-item))
85 (:else
86 (delete-region (line-beginning-position) (line-end-position))
87 (newline)))))
88 ((and (fboundp 'org-inlinetask-in-task-p) ; Just return for inline tasks
89 (org-inlinetask-in-task-p))
90 (org-return))
91 ((org-at-table-p) ; Insert a new table row
92 (cond ((save-excursion ; Empty row: end the table
93 (beginning-of-line)
94 (cl-loop with end = (line-end-position)
95 for cell = (org-element-table-cell-parser)
96 always (eq (org-element-property :contents-begin cell)
97 (org-element-property :contents-end cell))
98 while (re-search-forward "|" end t)))
99 (delete-region (line-beginning-position) (line-end-position))
100 (org-return))
101 (:else ; Non-empty row
102 (org-return))))
103 (:else ; Something else
104 (org-return)))))
105
106(defun +org-table-copy-down|+org-return-dwim (&optional n)
107 "Call `org-table-copy-down' or `+org-return' depending on context."
108 (interactive "P")
109 (if (org-table-check-inside-data-field 'noerror)
110 (org-table-copy-down (or n 1))
111 (+org-return-dwim n)))
112
113
114;;; Buffer view cleanup
115
116(defun +org-hide-drawers-except-point ()
117 "Hide all drawers except for the one point is in."
118 ;; Most of this bit is taken from `org-fold--hide-drawers'.
119 (let ((pt (point))
120 (begin (point-min))
121 (end (point-max)))
122 (save-excursion
123 (goto-char begin)
124 (while (and (< (point) end)
125 (re-search-forward org-drawer-regexp end t))
126 (if (org-fold-folded-p nil 'drawer)
127 (goto-char (org-fold-next-folding-state-change 'drawer nil end))
128 (let* ((drawer (org-element-at-point))
129 (type (org-element-type drawer))
130 (el-begin (org-element-property :begin drawer))
131 (el-end (org-element-property :end drawer)))
132 (when (memq type '(drawer property-drawer))
133 (org-fold-hide-drawer-toggle
134 (if (< el-begin pt el-end) 'off 'on)
135 nil drawer)
136 (goto-char el-end))))))))
137
138
139;;; Copy rich text to the keyboard
140
141;; Thanks to Oleh Krehel:
142;; https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard
143;; So. Emacs can't do this itself because it doesn't support sending clipboard
144;; or selection contents as text/html. We have to use xclip instead.
145;; (defun org-to-html-to-clipboard (&rest org-export-args)
146;; "Export current org buffer to HTML, then copy it to the clipboard.
147;; ORG-EXPORT-ARGS are passed to `org-export-to-file'."
148;; (let ((f (make-temp-file "org-html-export")))
149;; (apply #'org-export-to-file 'html f org-export-args)
150;; (start-process "xclip" " *xclip*"
151;; "xclip" "-verbose" "-i" f
152;; "-t" "text/html" "-selection" "clipboard")
153;; (message "HTML pasted to clipboard.")))
154
155;; Wayland version.. TODO: make it work for both
156(defun org-to-html-to-clipboard (&rest org-export-args)
157 "Export current org buffer to HTML, then copy it to the clipboard.
158ORG-EXPORT-ARGS are passed to `org-export-to-file'."
159 (let ((buf (generate-new-buffer "*org-html-clipboard*" t)))
160 (apply #'org-export-to-buffer 'html buf org-export-args)
161 (with-current-buffer buf
162 (call-process-region (point-min) (point-max)
163 "wl-copy" nil nil nil
164 "-t" "text/html")
165 (kill-buffer-and-window))
166 (message "HTML copied to clipboard.")))
167
168(defun org-subtree-to-html-to-clipboard ()
169 "Export current subtree to HTML."
170 (interactive)
171 (org-to-html-to-clipboard nil :subtree))
172
173
174;;; Prompting
175
176(defun +org-prompt-for-property (property &optional clipboardp insert list)
177 "Prompt for PROPERTY and return a properly-formatted string.
178Pre-fill the input with clipboard contents if they match CLIPBOARDP. If
179CLIPBOARDP is nil or missing, don't pre-fill.
180
181If INSERT is non-nil, insert the property into the property
182drawer of the current org tree.
183
184If LIST is non-nil, return the result as a list instead of a string."
185 (let* ((kill (current-kill 0))
186 (value (read-string (concat property ": ")
187 (when (and clipboardp
188 (or (eq clipboardp t)
189 (funcall clipboardp kill)))
190 kill))))
191 (when insert
192 (org-set-property property value))
193 (if list
194 (list property value)
195 (format ":%s: %s" property value))))
196
197(defun +org-prompt-tags (&optional prompt global)
198 (let* ((buffer (org-capture-get :buffer))
199 (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
200 (org-last-tags-completion-table
201 (org-global-tags-completion-table
202 (if global (org-agenda-files) (list file))))
203 (org-add-colon-after-tag-completion t)
204 (ins (mapconcat
205 #'identity
206 (let ((crm-separator "[ \t]*:[ \t]*"))
207 (completing-read-multiple
208 (or prompt "Tags: ")
209 org-last-tags-completion-table nil nil nil
210 'org-tags-history))
211 ":")))
212 (when (org-string-nw-p ins)
213 (prog1 (concat
214 (unless (eq (char-before) ?:) ":")
215 ins
216 (unless (eq (char-after) ?:) ":"))
217 (when (org-at-heading-p) (org-align-tags))))))
218
219
220;;; Navigating headings
221
222(defun org-next-visible-heading-unfolding (arg)
223 (interactive "p")
224 (when (let ((pt (org-next-visible-heading arg)))
225 (and (buffer-narrowed-p)
226 (or (= (point) (point-min))
227 (and pt
228 (= pt (point-max))))))
229 (widen)
230 (org-next-visible-heading arg)
231 (org-narrow-to-subtree)))
232
233(defun org-previous-visible-heading-unfolding (arg)
234 (interactive "p")
235 (org-next-visible-heading-unfolding (- arg)))
236
237(defun org-up-heading-unfolding (arg)
238 (interactive "p")
239 (when (let ((pt (outline-up-heading arg)))
240 (and (buffer-narrowed-p)
241 (= (point) (point-min))))
242 (widen)
243 (org-up-heading-unfolding arg)
244 (org-narrow-to-subtree)))
245
246
247;;; Misc.
248
249(defun org-clock-in-or-out (prefix)
250 "If clocked in, clock out. Otherwise, clock in."
251 (interactive "P")
252 (if (org-clocking-p)
253 (org-clock-out prefix)
254 (org-clock-in prefix)))
255
256
257;;; Faces
258
259(defface org-bold '((t (:weight bold)))
260 "Bold face in `org-mode' documents.")
261
262(defface org-italic '((t (:slant italic)))
263 "Italic face in `org-mode' documents.")
264
265(defface org-underline '((t (:underline t)))
266 "Underline face in `org-mode' documents.")
267
268(defface org-strikethrough '((t (:strike-through t)))
269 "Strike-through face for `org-mode' documents.")
270
271
272;;; Packages
273
274(use-package org
275 :defer t
276 :custom-face
277 (org-level-1 ((t :inherit fixed-pitch
278 :weight bold
279 :slant italic
280 :height 1.0)))
281 (org-level-2 ((t :inherit fixed-pitch
282 :weight bold
283 :slant italic
284 :height 1.0)))
285 (org-level-3 ((t :inherit fixed-pitch
286 :weight bold
287 :height 1.0)))
288 (org-level-4 ((t :inherit org-level-3)))
289 (org-level-5 ((t :inherit org-level-4)))
290 (org-level-6 ((t :inherit org-level-5)))
291 (org-level-7 ((t :inherit org-level-6)))
292 (org-level-8 ((t :inherit org-level-7)))
293 (org-drawer ((t :inherit fixed-pitch)))
294 (org-property-value ((t :inherit fixed-pitch)))
295 (org-special-keyword ((t :inherit fixed-pitch)))
296 (org-indent ((t :inherit fixed-pitch)))
297 (org-table ((t :inherit fixed-pitch)))
298 :config
299 ;; Options
300 (setopt org-adapt-indentation nil
301 org-auto-align-tags t
302 org-archive-mark-done t
303 org-fold-catch-invisible-edits 'show-and-error
304 org-clock-clocked-in-display 'mode-line
305 org-clock-string-limit 0
306 org-clock-persist nil
307 org-confirm-babel-evaluate nil
308 org-cycle-separator-lines 0
309 org-deadline-warning-days 0
310 org-directory (sync/ "org/" t)
311 org-ellipsis (or (bound-and-true-p truncate-string-ellipsis) "…")
312 org-emphasis-alist
313 '(("*" org-bold)
314 ("/" org-italic)
315 ("_" org-underline)
316 ("=" org-verbatim)
317 ("~" org-code)
318 ("+" org-strikethrough))
319 org-fontify-done-headline t
320 org-fontify-quote-and-verse-blocks t
321 org-fontify-whole-heading-line t
322 org-hide-emphasis-markers t
323 org-html-coding-system 'utf-8-unix
324 org-image-actual-width (list (* (window-font-width)
325 (- fill-column 8)))
326 org-imenu-depth 3
327 org-indent-indentation-per-level 0
328 org-indent-mode-turns-on-hiding-stars nil
329 org-insert-heading-respect-content t
330 org-list-demote-modify-bullet '(("-" . "+")
331 ("+" . "-"))
332 org-log-done 'time
333 org-log-into-drawer t
334 org-num-skip-commented t
335 org-num-skip-unnumbered t
336 org-num-skip-footnotes t
337 org-outline-path-complete-in-steps nil
338 org-pretty-entities t
339 org-pretty-entities-include-sub-superscripts nil
340 org-refile-targets '((nil . (:maxlevel . 2))
341 (org-agenda-files . (:maxlevel . 1)))
342 org-refile-use-outline-path 'file
343 org-special-ctrl-a/e t
344 org-special-ctrl-k t
345 org-src-fontify-natively t
346 org-src-tab-acts-natively t
347 org-src-window-setup 'current-window
348 org-startup-truncated nil
349 org-startup-with-inline-images t
350 org-tags-column 0 ;(- 0 fill-column -3)
351 org-todo-keywords '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
352 "|" "DONE(d!)" "ASSIGNED(a@/!)")
353 (sequence "|" "CANCELED(k@)")
354 (sequence "MEETING(m)"))
355 org-use-fast-todo-selection 'auto
356 org-use-speed-commands t
357 org-element-use-cache nil)
358 ;; Keys
359 (keymap-set org-mode-map "C-M-k" #'kill-paragraph)
360 (keymap-set org-mode-map "C-M-t" #'transpose-paragraphs)
361 (keymap-set org-mode-map "RET" #'+org-return-dwim)
362 (keymap-set org-mode-map "S-<return>" #'+org-table-copy-down|+org-return-dwim)
363 (keymap-unset org-mode-map "C-'" t)
364 (keymap-unset org-mode-map "C-," t)
365 (keymap-set org-mode-map "C-c C-n" #'org-next-visible-heading-unfolding)
366 (keymap-set org-mode-map "C-c C-p" #'org-previous-visible-heading-unfolding)
367 (keymap-set org-mode-map "C-c C-u" #'org-up-heading-unfolding)
368 ;; Hooks
369 (add-hook 'org-mode-hook
370 (defun org-mode@setup ()
371 (when (require 'visual-fill-column nil t)
372 (setq-local visual-fill-column-extra-text-width '(2 . 2))
373 (visual-fill-column-mode))
374 (variable-pitch-mode)
375 (turn-off-auto-fill)
376 (org-indent-mode)
377 (abbrev-mode)
378 (add-hook 'before-save-hook
379 (defun before-save@org-mode@before-save ()
380 (org-align-tags 'all)
381 (+org-hide-drawers-except-point)
382 )
383 nil :local)))
384 ;; Extra font-lock keywords
385 (font-lock-add-keywords
386 'org-mode
387 `(;; List markers => org-indent
388 (,(concat
389 "^[ ]*\\(\\(?:[-+]\\|\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\)"
390 "\\(?:[ ]+\\|$\\)\\)"
391 "\\(?:\\[@\\(?:start:\\)?\\([0-9]+\\|[A-Za-z]\\)\\]"
392 "[ ]*\\)?"
393 "\\(?:\\(\\[[ X-]\\]\\)"
394 "\\(?:[ ]+\\|$\\)\\)?")
395 0 'org-indent))))
396
397(use-package org-clock
398 :bind (:map org-mode-map
399 ("<f8>" . org-clock-in-or-out))
400 :config
401 (setopt org-clock-clocked-in-display 'mode-line
402 ;; global-mode-string
403 ;; '((t jabber-activity-mode-string)
404 ;; (:eval (when (org-clocking-p) org-mode-line-string))
405 ;; (display-time-mode display-time-string))
406 )
407 ;; (add-hook 'org-clock-in-hook (defun org-clock@remove-from-global-mode-string ()
408 ;; (setq global-mode-string
409 ;; (delq 'org-mode-line-string global-mode-string))))
410 )
411
412(use-package org-agenda
413 :bind (("C-c a" . org-agenda))
414 :config
415 (setopt org-agenda-skip-deadline-if-done t
416 org-agenda-skip-scheduled-if-done t
417 org-agenda-span 10
418 org-agenda-block-separator ?─
419 org-agenda-time-grid '((daily today require-timed)
420 (800 1000 1200 1400 1600 1800 2000)
421 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
422 org-agenda-current-time-string "← now ───────────────"
423 org-agenda-include-diary nil ; I use the org-diary features
424 org-agenda-todo-ignore-deadlines 'near
425 org-agenda-todo-ignore-scheduled 'future
426 org-agenda-include-deadlines t
427 org-deadline-warning-days 0
428 org-agenda-show-future-repeats 'next
429 org-agenda-window-setup 'current-window
430 org-agenda-skip-file-regexp "sync-conflict"
431 org-agenda-inhibit-startup t
432 org-agenda-sticky t
433 org-agenda-follow-indirect t
434 org-stuck-projects '("TODO=\"WAIT\""
435 ("TODO" "NEXT")
436 nil
437 "")
438 org-agenda-custom-commands
439 `(("c" "Click Here Digital To-do"
440 ((agenda "" ((org-agenda-overriding-header "Tasks")
441 (org-agenda-span 'fortnight)
442 (org-agenda-start-day "+0")
443 (org-agenda-skip-function
444 '(org-agenda-skip-subtree-if 'todo
445 '("WAIT" "MCKENZIE" "RACHEL")))))
446 (stuck "" ((org-agenda-overriding-header "Waiting"))))
447 ((org-agenda-files ',(list (progn (require 'chd)
448 (chd/ "inbox-chd.org"))
449 (sync/ "org/diary.org")))))))
450 ;; Speedup agenda generation
451 ;; https://orgmode.org/manual/Speeding-Up-Your-Agendas.html
452 ;; https://orgmode.org/worg/agenda-optimization.html
453 (setopt org-agenda-dim-blocked-tasks nil
454 org-agenda-inhibit-startup t
455 org-agenda-use-tag-inheritance nil
456 org-agenda-ignore-properties '(effort appt stats category))
457 ;; Hooks and advice
458 (add-hook 'org-agenda-mode-hook #'truncate-lines-local-mode)
459 (add-hook 'org-agenda-mode-hook #'hl-line-mode)
460 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree)
461 ;; (add-hook 'org-agenda-after-show-hook #'+org-hide-drawers-except-point)
462 (define-advice org-agenda-files (:filter-return (files) skip-regexp)
463 "Filter some files from `org-agenda'."
464 (when org-agenda-skip-file-regexp
465 (setq files
466 (cl-remove-if (lambda (file)
467 (string-match-p org-agenda-skip-file-regexp
468 file))
469 files)))
470 files)
471 (define-advice org-agenda (:around (orig &rest r) inhibit-hooks)
472 (dlet ((org-mode-hook nil))
473 (apply orig r)))
474 (define-advice org-agenda-skip (:around (orig &rest r) fix-looking-at)
475 (dlet ((comment-start-skip "^\\s-*#\\(?: \\|$\\)"))
476 (apply orig r)))
477 ;; (advice-remove 'org-agenda 'org-agenda@inhibit-hooks)
478 (define-advice org-agenda-switch-to (:after (&rest _) do-hooks)
479 (run-hooks 'org-mode-hook))
480 (progress@around org-agenda-list "Building agenda")
481 (with-eval-after-load 'org-agenda
482 (add-to-list 'org-agenda-files (sync/ "org/diary.org"))))
483
484(use-package org-capture
485 :bind (("C-c c" . org-capture)))
486
487(use-package ol ; org-link
488 :after org
489 :preface
490 (defmacro +org-link-define-type (type args &rest body)
491 "Define an org link TYPE.
492A function named `+org-link-TYPE-open' will be created, with ARGS
493as its arguments and BODY as its body. BODY can be blank, in
494which case the user will be messaged (This is a good do-nothing
495effect for exporting link types)."
496 (declare (indent 2)
497 (doc-string 3)
498 (debug (sexp sexp def-body)))
499 (let ((fn (intern (format "+org-link-%s-open" type)))
500 (body (or body `((message ,(format "%S: %%S" type)
501 ,(car args)))))
502 (type-string (format "%S" type)))
503 `(prog1
504 (defun ,fn ,args ,@body)
505 (org-link-set-parameters ,type-string :follow #',fn))))
506 :config
507 (+org-link-define-type sms (number _))
508 (+org-link-define-type tel (number _)))
509
510(use-package ox ; org-export
511 :after org
512 :config
513 (require 'ox-md)
514 (setopt org-export-coding-system 'utf-8-unix
515 org-export-headline-levels 8
516 org-export-with-drawers nil
517 org-export-with-section-numbers nil
518 org-export-with-smart-quotes t
519 org-export-with-sub-superscripts t
520 org-export-with-toc nil))
521
522(use-package org-word-count
523 :load-path "~/src/org-word-count.el/"
524 :hook org-mode-hook)
525
526(use-package org-modern
527 :ensure t
528 :custom-face
529 (org-modern-label ((t :inherit fixed-pitch
530 :height 1.0)))
531 :hook (org-mode-hook)
532 :config
533 (setopt org-modern-star nil
534 org-modern-list '((43 . "◦")
535 (45 . "•")
536 (42 . "‣"))
537 org-hide-leading-stars nil
538 org-modern-hide-stars nil
539 org-tags-column 0
540 org-modern-keyword nil
541 org-modern-table nil))
542
543(use-package org-taskwise
544 :after org
545 :load-path "~/src/org-taskwise.el/")
546
547(provide 'acdw-org)
548;;; acdw-org.el ends here
diff --git a/lisp/acdw-shell.el b/lisp/acdw-shell.el deleted file mode 100644 index ce63bdc..0000000 --- a/lisp/acdw-shell.el +++ /dev/null
@@ -1,141 +0,0 @@
1;;; acdw-shell.el ---Shell config -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defvar eshell-buffer-format "*eshell:%s*"
6 "Format for eshell buffer names.")
7
8(defun eshell-rename-pwd ()
9 (rename-buffer (format eshell-buffer-format default-directory) t))
10
11(defun eshell-last-dir ()
12 (goto-char (point-max))
13 (insert "cd -")
14 (eshell-send-input))
15
16(defun eshellp (buffer-or-name)
17 (with-current-buffer buffer-or-name
18 (derived-mode-p 'eshell-mode)))
19
20(defun +eshell (&optional new)
21 (interactive "P")
22 (let ((dir default-directory)
23 (bname (format eshell-buffer-format default-directory))
24 (display-comint-buffer-action 'pop-to-buffer))
25 (if-let ((buf (and (not new)
26 (or (get-buffer bname)
27 (seq-find #'eshellp
28 (reverse (buffer-list)))))))
29 (pop-to-buffer buf)
30 (eshell new))
31 (eshell-rename-pwd)
32 (unless (equal default-directory dir)
33 (eshell/cd dir)
34 (eshell-send-input)
35 (goto-char (point-max)))))
36
37(defun +eshell-quit (&optional choose)
38 (interactive "P")
39 (if choose
40 (let* ((bufs (mapcar #'buffer-name
41 (seq-filter #'eshellp
42 (buffer-list))))
43 (buf (get-buffer
44 (completing-read "Eshell: "
45 bufs nil t nil nil (car bufs)))))
46 (quit-window)
47 (pop-to-buffer buf))
48 (quit-window)))
49
50(defun acdw/eshell-prompt ()
51 "My custom eshell prompt."
52 (concat (if (= 0 eshell-last-command-status)
53 "^_^ "
54 ";_; ")
55 (abbreviate-file-name (eshell/pwd))
56 (if (= (user-uid) 0) " # " " $ ")))
57
58
59;;; Packages
60
61(use-package eshell
62 :init
63 (add-hook 'eshell-post-command-hook #'eshell-rename-pwd)
64 (setopt eshell-modules-list
65 '(eshell-alias
66 eshell-basic
67 eshell-cmpl
68 eshell-dirs
69 eshell-elecslash
70 eshell-hist
71 eshell-ls
72 eshell-prompt
73 eshell-smart
74 eshell-extpipe
75 eshell-glob
76 eshell-hist
77 eshell-ls
78 eshell-pred
79 eshell-prompt
80 eshell-script
81 eshell-term
82 eshell-unix))
83 :commands eshell
84 :bind (("C-z" . +eshell)
85 :map eshell-mode-map
86 ("C-z" . +eshell-quit)
87 ("C-o" . eshell-last-dir))
88 :config
89 (require 'esh-module)
90 (require 'em-smart)
91 (require 'em-tramp)
92 (setq eshell-destroy-buffer-when-process-dies t
93 eshell-error-if-no-glob t
94 eshell-hist-ignoredups t
95 eshell-kill-on-exit t
96 eshell-prefer-lisp-functions t
97 eshell-prefer-lisp-variables t
98 eshell-scroll-to-bottom-on-input 'this
99 eshell-banner-message ""
100 eshell-hist-ignoredups 'erase
101 eshell-history-size 512
102 eshell-input-filter (lambda (input)
103 (or (eshell-input-filter-default input)
104 (eshell-input-filter-initial-space input)))
105 eshell-prompt-function #'acdw/eshell-prompt)
106 (add-hook 'eshell-mode-hook
107 (defun eshell-setup ()
108 (hungry-delete-mode -1)
109 (setq-local outline-regexp eshell-prompt-regexp
110 page-delimiter eshell-prompt-regexp
111 imenu-generic-expression
112 '(("Prompt" " $ \\(.*\\)" 1))
113 truncate-lines t)
114 (setenv "PAGER" "cat"))))
115
116(use-package eat
117 :ensure t
118 :hook (eshell-load-hook . eat-eshell-mode))
119
120(use-package exec-path-from-shell
121 :when (eq system-type 'gnu/linux)
122 :ensure t
123 :config
124 (add-to-list 'exec-path-from-shell-variables "SSH_AUTH_SOCK")
125 (add-to-list 'exec-path-from-shell-variables "SSH_AGENT_PID")
126 (add-to-list 'exec-path-from-shell-variables "GPG_AGENT_INFO")
127 (add-to-list 'exec-path-from-shell-variables "LANG")
128 (add-to-list 'exec-path-from-shell-variables "LC_CTYPE")
129 (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_HOME")
130 (add-to-list 'exec-path-from-shell-variables "XDG_CONFIG_DIRS")
131 (add-to-list 'exec-path-from-shell-variables "XDG_DATA_HOME")
132 (add-to-list 'exec-path-from-shell-variables "XDG_DATA_DIRS")
133 (add-to-list 'exec-path-from-shell-variables "XDG_CACHE_HOME")
134 (exec-path-from-shell-initialize))
135
136(use-package eshell-bookmark
137 :ensure t
138 :hook (eshell-mode-hook . eshell-bookmark-setup))
139
140(provide 'acdw-shell)
141;;; acdw-shell.el ends here
diff --git a/lisp/acdw-web.el b/lisp/acdw-web.el deleted file mode 100644 index 3b78e4d..0000000 --- a/lisp/acdw-web.el +++ /dev/null
@@ -1,374 +0,0 @@
1;;; acdw.web.el --- Web browsing and such -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6
7(defcustom +browse-url-other-safe-browser-functions nil
8 "Other safe browser functions."
9 :type '(repeat function))
10
11(defun +browse-url-browser-function-safe-p (f)
12 "Return t if F is a safe browser function."
13 (memq f (append +browse-url-other-safe-browser-functions
14 (mapcar (lambda (i)
15 (plist-get (cdr i) :value))
16 (seq-filter (lambda (i)
17 (eq (car i) 'function-item))
18 (cdr (get 'browse-url-browser-function
19 'custom-type)))))))
20
21;;; URL matcher generators
22
23(defun +browse-url-matches (&rest regexps)
24 "Return a lambda that will determine if a url matches REGEXPS.
25Each regexp will be tested in turn. The first one that matches
26is returned by the lambda.
27
28This is a good function to use in key positions in `browse-url-handlers'."
29 `(lambda (url &optional new-window)
30 (cl-loop for regexp in ',regexps
31 if (string-match-p regexp url)
32 return regexp)))
33
34;;; External URL handlers
35
36(cl-defmacro +browse-url-make-external-viewer-handler
37 (viewer
38 &key
39 args
40 (prompt "URL: ")
41 (program (executable-find (format "%s" viewer)))
42 (name (intern (format "+browse-url-with-%s" viewer)))
43 doc
44 (var (intern (format "%s-args" name)))
45 vardoc
46 (custom-group '+browse-url)
47 (fallback '(function browse-url-generic)))
48 "Create a `browse-url' handler function calling PROGRAM on the URL.
49This macro also creates a `customize' setting in CUSTOM-GROUP for
50PROGRAM's command-line arguments. ARGS specifies the
51default arguments for this user option.
52
53PROGRAM defaults to the result of calling `executable-find' on VIEWER.
54
55PROMPT is shown to the user in the function's `interactive' spec, as an argument
56to `browse-url-interactive-arg'.
57
58The resulting function is named NAME, which defaults to
59`+browse-url-with-VIEWER'. The custom variable is named VAR, which defaults
60to `NAME-args'. If DOC or VARDOC are provided, they'll be the documentation of
61the function and variable respectively; otherwise a basic default doc-string is
62used.
63
64If FALLBACK is non-nil (the default is `browse-url-generic'), the
65generated function will call FALLBACK if unable to start PROGRAM
66for some reason."
67 (declare (indent 1))
68 `(progn
69 (defcustom ,var ,args
70 ,(or vardoc (format "Arguments to pass to %s in `%s'."
71 viewer name))
72 :type '(repeat :tag "Command-line argument" string)
73 :group ',custom-group)
74 (defun ,name (url &optional new-window)
75 ,(or doc (format "Open URL in %s." viewer))
76 (interactive (browse-url-interactive-arg ,prompt))
77 (let* ((url (browse-url-encode-url url))
78 (process-environment (browse-url-process-environment)))
79 (message ,(format "Opening %%s in %s..." viewer) url)
80 (unless (ignore-errors (apply #'start-process
81 (format "%s %s" ',viewer url)
82 nil
83 ,program
84 (append ,var (list url))))
85 ,@(cond
86 (fallback `((funcall ,fallback url new-window)))
87 (:else `((message "Can't find viewer: %s" ,viewer)
88 nil))))))))
89
90;; Some default handlers
91
92(+browse-url-make-external-viewer-handler mpv
93 :args '("--cache-pause-wait=15"
94 "--cache-pause-initial=yes")
95 :prompt "Video URL: ")
96
97(+browse-url-make-external-viewer-handler miv
98 :program (executable-find "miv")
99 :prompt "Image URL: ")
100
101;;; External domains
102;; Some domains just don't open well in `eww'. The following function and user
103;; option define an easy way to automatically open those.
104
105(defcustom +browse-url-external-domains nil
106 "Domains to open in `browse-url-secondary-browser-function'.
107This is just a list of strings. They'll be regexp-escaped and
108passed to `+browse-url-external-url-p', which is a good function
109to put in `browse-url-handlers'.
110
111If an item in this list is a list itself, it should contain one string, a valid
112regexp that will not be regexp-quoted when matching against a url."
113 :type '(repeat (choice
114 (list :tag "Regexp" regexp)
115 (string :tag "Literal string"))))
116
117(with-eval-after-load 'custom-allowed
118 (add-to-list 'custom-allowed-variables '+browse-url-external-domains))
119
120(defun +browse-url-external-url-p (url)
121 "Return t if URL is a member of `+browse-url-external-domains'.
122This function only tests URL's domain."
123 (let ((host (url-host (url-generic-parse-url url))))
124 (cl-loop for domain in +browse-url-external-domains
125 if (string-match-p (if (stringp domain)
126 (regexp-quote domain)
127 (car domain))
128 host)
129 return t)))
130
131(defun +browse-url-external-domain-add (domain &optional regexp?)
132 "Add DOMAIN to `+browse-url-external-domains'.
133If REGEXP? is non-nil, it will note that the domain is a regexp.
134This function will also save `custom-file' with the updated value."
135 (interactive (pcase current-prefix-arg
136 (`nil
137 (list (read-from-minibuffer "Domain: ")
138 nil))
139 (`(4)
140 (list (read-from-minibuffer "Domain regex: ")
141 t))
142 (_
143 (list (read-from-minibuffer "Domain: ")
144 (y-or-n-p "Regex? ")))))
145 (let ((new (funcall (if regexp? #'list #'identity)
146 domain)))
147 (custom-set-variables
148 `(+browse-url-external-domains
149 ',(add-to-list '+browse-url-external-domains new)))
150 (with-current-buffer (find-file-noselect custom-file)
151 (custom-save-variables))
152 (message "%s added to `+browse-url-external-domains'."
153 domain)))
154
155;;; Downloading
156
157(defcustom +browse-url-download-open t
158 "Whether to open downloaded files after downloading."
159 :type 'boolean)
160
161(defun +browse-url-download (url &rest _)
162 "Download URL to `eww-download-directory'."
163 (interactive "sDownload URL: ")
164 (let ((dir eww-download-directory))
165 (when (functionp dir) (setq dir (funcall dir)))
166 (make-directory dir :parents)
167 (url-retrieve url
168 (lambda (s u d)
169 (let ((file (+browse-url-download-callback s u d)))
170 (when +browse-url-download-open
171 (browse-url-xdg-open file))))
172 (list url dir))))
173
174(defun +browse-url-download-callback (status url dir)
175 ;; A slight change to `eww-download-callback' that returns the downloaded
176 ;; filename.
177 (unless (plist-get status :error)
178 (let* ((obj (url-generic-parse-url url))
179 (path (directory-file-name (car (url-path-and-query obj))))
180 (file (eww-make-unique-file-name
181 (eww-decode-url-file-name (file-name-nondirectory path))
182 dir)))
183 (goto-char (point-min))
184 (re-search-forward "\r?\n\r?\n")
185 (let ((coding-system-for-write 'no-conversion))
186 (write-region (point) (point-max) file))
187 (message "Saved %s" file)
188 file)))
189
190;;; Unfucking the internet
191
192(defun eww-archiveis-url (url)
193 "Run URL through archive.is and browse the result."
194 (interactive (list (plist-get eww-data :url)))
195 (letrec ((nonce (lambda ()
196 (unwind-protect (eww-readable)
197 (remove-hook 'eww-after-render-hook nonce)))))
198 (add-hook 'eww-after-render-hook nonce)
199 (eww (format "https://archive.is/submit/?url=%s" url))))
200
201
202;;; Packages
203
204(use-package eww
205 :preface
206 (defun bookmark-eww--make ()
207 "Make eww bookmark record."
208 `((filename . ,(plist-get eww-data :url))
209 (title . ,(plist-get eww-data :title))
210 (time . ,(current-time-string))
211 (handler . ,#'bookmark-eww-handler)
212 (defaults . (,(concat
213 ;; url without the https and path
214 (replace-regexp-in-string
215 "/.*" ""
216 (replace-regexp-in-string
217 "\\`https?://" ""
218 (plist-get eww-data :url)))
219 " - "
220 ;; page title
221 (replace-regexp-in-string
222 "\\` +\\| +\\'" ""
223 (replace-regexp-in-string
224 "[\n\t\r ]+" " "
225 (plist-get eww-data :title))))))))
226 (defun bookmark-eww-handler (bm)
227 "Handler for eww bookmarks."
228 (eww-browse-url (alist-get 'filename bm)))
229 (defun bookmark-eww--setup ()
230 "Setup eww bookmark integration."
231 (setq-local bookmark-make-record-function #'bookmark-eww--make))
232 :commands (eww eww-browse-url)
233 :config
234 (setopt eww-use-browse-url ".")
235 (add-hook 'eww-mode-hook
236 (defun eww-mode@setup ()
237 (add-hook 'visual-fill-column-mode-hook
238 (defun visual-fill-column@eww-reload ()
239 (eww-reload :local))))
240 nil :local)
241 (keymap-set eww-mode-map "&"
242 (defun eww-browse-url-external (&optional url)
243 (interactive nil eww-mode)
244 (condition-case e
245 (funcall
246 browse-url-secondary-browser-function
247 (or url (plist-get eww-data :url)))
248 (:success (when (null url) (quit-window))) ; Interactive use
249 (t (signal (car e) (cdr e))))))
250 (add-hook 'eww-mode-hook #'bookmark-eww--setup)
251 (define-key eww-mode-map "b" #'bookmark-set)
252 (define-key eww-mode-map "B" #'bookmark-jump)
253 (define-key eww-mode-map (kbd "M-n") nil)
254 (define-key eww-mode-map (kbd "M-p") nil)
255 (define-key eww-mode-map (kbd "*") #'eww-archiveis-url))
256
257(use-package browse-url
258 :demand t
259 :config
260 (put 'browse-url-browser-function 'safe-local-variable
261 '+browse-url-browser-function-safe-p)
262 (setopt browse-url-browser-function #'eww-browse-url
263 browse-url-secondary-browser-function #'browse-url-firefox
264 browse-url-firefox-program (executable-find "firefox")
265 browse-url-firefox-arguments '("--new-tab")
266 ;; Dispatch browser based on URL
267 browse-url-handlers
268 `(;; Videos
269 (,(+browse-url-matches "youtube\\.com" "youtu\\.be"
270 "invidious" "yewtu\\.be"
271 "twitch\\.tv"
272 (rx "." (or "mp4" "gif" "mov" "MOV" "webm")
273 eos))
274 . +browse-url-with-mpv)
275 ;; Music
276 (,(+browse-url-matches "soundcloud\\.com" "bandcamp\\.com"
277 (rx "." (or "ogg" "mp3" "opus" "m4a") eos))
278 . +browse-url-with-mpv)
279 ;; Images
280 (,(+browse-url-matches "pbs\\.twimg\\.com"
281 (rx "." (or "jpeg" "jpg" "png" "pn"
282 "bmp" "webp")
283 eos))
284 . +browse-url-with-miv)
285 ;; Blobs
286 (,(+browse-url-matches (rx "." (or ".tar.gz" ".pdf") eos))
287 . +browse-url-download)
288 ;; External URLs --- see `+browse-url-external-domains'
289 (+browse-url-external-url-p
290 . ,browse-url-secondary-browser-function))
291 ;; External domains
292 ;; +browse-url-external-domains
293 ;; '("github.com" "gitlab.com" "codeberg.org"
294 ;; "tildegit.org" "git.tilde.town"
295 ;; "google.com" "imgur.com" "twitch.tv"
296 ;; "pixelfed" "instagram.com"
297 ;; "bibliogram.art" "reddit.com"
298 ;; "teddit.net" "libreddit.de"
299 ;; "streamable.com" "spotify.com"
300 ;; "hetzner.cloud" "melpa.org"
301 ;; "twitter.com" ("^t\\.co$")
302 ;; "nitter.snopyta.org" "nitter.net")
303 )
304 ;; External browsers: firefox > chromium > chrome
305 (when-let ((firefox (choose-executable "firefox"
306 "firefox-esr")))
307 (setopt browse-url-firefox-program firefox
308 browse-url-firefox-new-window-is-tab t
309 browse-url-firefox-arguments '("--new-tab")
310 browse-url-generic-program firefox
311 browse-url-generic-args browse-url-firefox-arguments))
312 (when-let ((chromium (choose-executable "chromium"
313 "chromium-browser")))
314 (setopt browse-url-chromium-program chromium
315 browse-url-generic-program chromium))
316 (when-let ((chrome (choose-executable "chrome"
317 "google-chrome-stable")))
318 (setopt browse-url-chrome-program chrome
319 browse-url-generic-program chrome)))
320
321(use-package browse-url-transform
322 :after browse-url
323 :load-path "~/src/browse-url-transform.el/"
324 :config
325 (setopt browse-url-transform-alist
326 `(;; Privacy-respecting alternatives
327 ("twitter\\.com" . "nitter.snopyta.org")
328 ("\\(?:\\(?:old\\.\\)?reddit\\.com\\)" . "libreddit.de")
329 ("medium\\.com" . "scribe.rip")
330 (".*substack\\.com.*" . ,substack-proxy)
331 ;; Text-mode of non-text-mode sites
332 ("www\\.npr\\.org" . "text.npr.org")
333 ;; Ask for raw versions of paste sites
334 ("^.*dpaste\\.com.*$" . "\\&.txt")
335 ("bpa\\.st/\\(.*\\)" . "bpa.st/raw/\\1")
336 ("\\(paste\\.debian\\.net\\)/\\(.*\\)" . "\\1/plain/\\2")
337 ("\\(pastebin\\.com\\)/\\\(.*\\)" . "\\1/raw/\\2")
338 ("\\(paste\\.centos\\.org/view\\)/\\(.*\\)" . "\\1/raw/\\2")))
339 (browse-url-transform-mode))
340
341;;; Link hint
342
343(use-package link-hint
344 :ensure t :demand t
345 :preface (keymap-global-unset "M-l")
346 :bind
347 (("M-l M-l" . +link-hint-open-link)
348 ("M-l l" . +link-hint-open-link)
349 ("M-l M-o" . +link-hint-open:secondary)
350 ("M-l o" . +link-hint-open:secondary)
351 ("M-l M-m" . +link-hint-open-multiple-links)
352 ("M-l m" . +link-hint-open-multiple-links)
353 ("M-l M-w" . link-hint-copy-link)
354 ("M-l w" . link-hint-copy-link)
355 ("M-l M-c" . +link-hint-open:chrome)
356 ("M-l c" . +link-hint-open:chrome)
357 ("M-l M-d" . +link-hint-open:download)
358 ("M-l d" . +link-hint-open:download))
359 :config
360 (require '+link-hint)
361 (setopt link-hint-avy-style 'at-full
362 link-hint-avy-all-windows t)
363 ;; For some reason, `link-hint-completion-list-candidate' freezes Emacs.
364 ;; Removing it fixes the problem, so ... that's what I've done. It's quite
365 ;; possible this problem isn't caused by `link-hint' at all, but rather by
366 ;; another package's configuration, but I don't care enough to fix it.
367 (setq link-hint-types
368 (delq 'link-hint-completion-list-candidate link-hint-types))
369 ;; (+link-hint-open-secondary-setup)
370 ;; (+link-hint-open-chrome-setup)
371 )
372
373(provide 'acdw-web)
374;;; acdw-web.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el deleted file mode 100644 index b76b947..0000000 --- a/lisp/acdw.el +++ /dev/null
@@ -1,384 +0,0 @@
1;;; acdw.el --- My Emacs extras -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'seq)
7
8(defmacro defdir (name directory &optional docstring makedir)
9 "Define a variable and a function NAME expanding to DIRECTORY.
10DOCSTRING is applied to the variable; its default is DIRECTORY's
11path. If MAKEDIR is non-nil, the directory and its parents will
12be created."
13 (declare (indent 2) (doc-string 3))
14 `(progn
15 (defvar ,name (expand-file-name ,directory)
16 ,(concat (or docstring (format "%s" directory)) "\n"
17 "Defined by `defdir'."))
18 (defun ,name (file &optional mkdir)
19 ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
20 "If MKDIR is non-nil, parent directories are created.\n"
21 "Defined by `defdir'.")
22 (let ((file-name (expand-file-name
23 (convert-standard-filename file) ,name)))
24 (when mkdir
25 (make-directory (file-name-directory file-name) :parents))
26 file-name))
27 ,(if makedir
28 `(make-directory ,directory :parents)
29 `(unless (file-exists-p ,directory)
30 (warn "Directory `%s' doesn't exist." ,directory)))))
31
32(defun choose-executable (&rest programs)
33 "Return the first of PROGRAMS that exists in the system's $PATH.
34Each of PROGRAMS can be a single string, or a list. If it's a list then its car
35will be tested with `executable-find', and the entire list returned. This
36enables passing arguments to a calling function."
37 (catch 'found
38 (dolist (prog programs)
39 (let ((exec (executable-find (car (ensure-list prog))))
40 (args (cdr-safe prog)))
41 (when exec
42 (throw 'found (if args (cons exec args) exec)))))))
43
44(defun file-string (file)
45 "Return the contents of FILE as a string."
46 (with-current-buffer (find-file-noselect file)
47 (buffer-string)))
48
49(defun unsmartify-region (begin end)
50 "Replace \"smart\" punctuation with \"dumb\" counterparts."
51 (interactive "*r")
52 (save-excursion
53 (goto-char begin)
54 (while (re-search-forward "[“”‘’–—]" end t)
55 (let ((replace (pcase (match-string 0)
56 ((or "“" "”") "\"")
57 ((or "‘" "’") "'")
58 ("–" "--")
59 ("—" "---"))))
60 (replace-match replace nil nil)))))
61
62(defun unsmartify-dwim ()
63 "Unsmartify the current region or the entire buffer."
64 (interactive)
65 (if (region-active-p)
66 (unsmartify-region (region-beginning) (region-end))
67 (unsmartify-region (point-min) (point-max))))
68
69(defun ++concat (func strings)
70 "Concat STRINGS processed by FUNC.
71Each of STRINGS can be a bare string or a list. Strings are
72passed through as-is, but lists are passed to FUNC first as
73arguments. Finally, all the resulting strings are `mapconcat'-ed
74together.
75
76As a special case, if `:separator' is the first of STRINGS, the
77string following will be used as a separator. Otherwise, a
78newline will be used."
79 (let (separator)
80 (when (eq (car strings) :separator)
81 (setq separator (cadr strings)
82 strings (cddr strings)))
83 (mapconcat (lambda (s)
84 (cond
85 ((listp s) (apply func s))
86 ((stringp s) s)
87 (t (user-error "Bad argument: %S" s))))
88 strings
89 (or separator "\n"))))
90
91(defun format-concat (&rest strings)
92 "Concatenate formatted STRINGS.
93Each of STRINGS can be a bare string or a list. Bare strings are passed as-is
94to `mapconcat' for concatenation and separation. Lists, however, are passed to
95`format' first.
96
97If `:separator' is the first of STRINGS, the next string will be
98used as a separator."
99 (++concat #'format strings))
100
101(defun list-append-removing-duplicates (&rest lists)
102 "Append LISTS, removing duplicates from the result.
103Any keyword arguments to `cl-remove-duplicates' should come
104before the LISTS."
105 (let (cl-remove-duplicates-args)
106 (while (keywordp (car lists))
107 (push (pop lists) cl-remove-duplicates-args)
108 (push (pop lists) cl-remove-duplicates-args))
109 (apply #'cl-remove-duplicates (apply #'append lists)
110 (nreverse cl-remove-duplicates-args))))
111
112(defun mapc-buffers (func &optional predicate)
113 "Map FUNC over buffers matching PREDICATE.
114Both FUNC and PREDICATE will be executed with no arguments and in
115the context of each buffer.
116
117If PREDICATE is nil or not given, map FUNC over all buffers."
118 (cl-loop for buf being the buffers
119 do (with-current-buffer buf
120 (when (and predicate
121 (funcall predicate))
122 (funcall func)))))
123
124(defun mapc-buffers-modes (func &rest modes)
125 "Map FUNC over buffers derived from MODES.
126FUNC will be executed with no arguments and in the context of
127each buffer."
128 (mapc-buffers func
129 (lambda ()
130 (apply #'derived-mode-p modes))))
131
132(defun find-font (&rest fonts)
133 "Return the first font of FONTS that is installed."
134 (cl-loop with ffl = (font-family-list)
135 for font in fonts
136 if (member font ffl)
137 return font))
138
139(defmacro progress@around (fn message &optional name)
140 "Define :around advice for functions adding a simple progress reporter."
141 (let ((orig (gensym))
142 (args (gensym))
143 (prog (gensym)))
144 `(define-advice ,fn (:around (,orig &rest ,args) ,(or name 'progress))
145 ,(format "Add a simple progress reporter to %s." fn)
146 (let ((,prog (make-progress-reporter
147 ,(format "%s..." (string-remove-suffix "..." message)))))
148 (apply ,orig ,args)
149 (progress-reporter-done ,prog)))))
150
151
152
153;;; Ispell in .dir-locals
154
155;; Let Emacs know a list of strings is safe
156(defun +ispell-safe-local-p (list)
157 (and (listp list)
158 (seq-every-p #'stringp list)))
159
160;; Can I instruct ispell to insert LocalWords in a different file?
161;; https://emacs.stackexchange.com/q/31396/2264
162
163;; How can I move all my file-local LocalWords to .dir-locals.el?
164;; https://emacs.stackexchange.com/q/31419
165
166;; Adapted from ispell.el:ispell-buffer-local-words
167(defun +ispell-buffer-local-words-list ()
168 (let (words)
169 (or ispell-buffer-local-name
170 (setf ispell-buffer-local-name (buffer-name)))
171 (save-excursion
172 (goto-char (point-min))
173 (while (search-forward ispell-words-keyword nil t)
174 (let ((end (point-at-eol))
175 (ispell-casechars (ispell-get-casechars))
176 string)
177 (while (re-search-forward " *\\([^ ]+\\)" end t)
178 (setf string (match-string-no-properties 1))
179 (if (and (< 1 (length string))
180 (equal 0 (string-match ispell-casechars string)))
181 (push string words))))))
182 words))
183
184;;;###autoload
185(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
186 "Move the current buffer-local words to .dir-locals.el.
187This function prompts the user to save .dir-locals.el, unless
188prefix ARG is non-nil; then it just saves them."
189 (interactive "P")
190 (unless (buffer-file-name)
191 (user-error "Buffer not attached to file"))
192 (hack-dir-local-variables)
193 (let ((print-level nil)
194 (print-length nil)
195 (before-save-hook nil)
196 (after-save-hook nil))
197 (when-let ((new-words (cl-remove-if
198 (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
199 ; where this came from
200 (list-append-removing-duplicates
201 :test #'string=
202 ispell-buffer-session-localwords
203 (alist-get 'ispell-buffer-session-localwords
204 dir-local-variables-alist)
205 (alist-get 'ispell-buffer-session-localwords
206 file-local-variables-alist)
207 (+ispell-buffer-local-words-list)))))
208 (save-excursion
209 (add-dir-local-variable
210 major-mode
211 'ispell-buffer-session-localwords
212 (setf ispell-buffer-session-localwords
213 new-words))
214 (when (or arg
215 (y-or-n-p "Save .dir-locals.el?"))
216 (save-buffer))
217 (bury-buffer))
218 (or ispell-buffer-local-name
219 (setf ispell-buffer-local-name (buffer-name)))
220 (save-excursion
221 (goto-char (point-min))
222 (while (search-forward ispell-words-keyword nil t)
223 (delete-region (point-at-bol) (1+ (point-at-eol))))))))
224
225;;;###autoload
226(defun +ispell-move-buffer-words-to-dir-locals-hook ()
227 "Convenience function for binding to a hook."
228 (+ispell-move-buffer-words-to-dir-locals t))
229
230
231;;; Comment-or-uncomment-sexp
232;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
233
234(defun +lisp-uncomment-sexp (&optional n)
235 "Uncomment N sexps around point."
236 (interactive "P")
237 (let* ((initial-point (point-marker))
238 (inhibit-field-text-motion t)
239 (p)
240 (end (save-excursion
241 (when (elt (syntax-ppss) 4)
242 (re-search-backward comment-start-skip
243 (line-beginning-position)
244 t))
245 (setq p (point-marker))
246 (comment-forward (point-max))
247 (point-marker)))
248 (beg (save-excursion
249 (forward-line 0)
250 (while (and (not (bobp))
251 (= end (save-excursion
252 (comment-forward (point-max))
253 (point))))
254 (forward-line -1))
255 (goto-char (line-end-position))
256 (re-search-backward comment-start-skip
257 (line-beginning-position)
258 t)
259 (ignore-errors
260 (while (looking-at-p comment-start-skip)
261 (forward-char -1)))
262 (point-marker))))
263 (unless (= beg end)
264 (uncomment-region beg end)
265 (goto-char p)
266 ;; Indentify the "top-level" sexp inside the comment.
267 (while (and (ignore-errors (backward-up-list) t)
268 (>= (point) beg))
269 (skip-chars-backward (rx (syntax expression-prefix)))
270 (setq p (point-marker)))
271 ;; Re-comment everything before it.
272 (ignore-errors
273 (comment-region beg p))
274 ;; And everything after it.
275 (goto-char p)
276 (forward-sexp (or n 1))
277 (skip-chars-forward "\r\n[:blank:]")
278 (if (< (point) end)
279 (ignore-errors
280 (comment-region (point) end))
281 ;; If this is a closing delimiter, pull it up.
282 (goto-char end)
283 (skip-chars-forward "\r\n[:blank:]")
284 (when (eq 5 (car (syntax-after (point))))
285 (delete-indentation))))
286 ;; Without a prefix, it's more useful to leave point where
287 ;; it was.
288 (unless n
289 (goto-char initial-point))))
290
291(defun +lisp-comment-sexp--raw ()
292 "Comment the sexp at point or ahead of point."
293 (pcase (or (bounds-of-thing-at-point 'sexp)
294 (save-excursion
295 (skip-chars-forward "\r\n[:blank:]")
296 (bounds-of-thing-at-point 'sexp)))
297 (`(,l . ,r)
298 (goto-char r)
299 (skip-chars-forward "\r\n[:blank:]")
300 (save-excursion
301 (comment-region l r))
302 (skip-chars-forward "\r\n[:blank:]"))))
303
304(defun +lisp-comment-or-uncomment-sexp (&optional n)
305 "Comment the sexp at point and move past it.
306If already inside (or before) a comment, uncomment instead.
307With a prefix argument N, (un)comment that many sexps."
308 (interactive "P")
309 (if (or (elt (syntax-ppss) 4)
310 (< (save-excursion
311 (skip-chars-forward "\r\n[:blank:]")
312 (point))
313 (save-excursion
314 (comment-forward 1)
315 (point))))
316 (+lisp-uncomment-sexp n)
317 (dotimes (_ (or n 1))
318 (+lisp-comment-sexp--raw))))
319
320
321;;; Random shit
322
323(defun insert-iso-date (&optional arg)
324 "Insert current date formatted ISO-8601 style.
325When called with \\[universal-argument] \\[insert-iso-date],
326include the time. When called with \\[universal-argument]
327\\[universal-argument] \\[insert-iso-date], prompt the user for the
328`format-time-string' format to use."
329 (interactive "P")
330 (insert (format-time-string (pcase arg
331 ('nil "%F")
332 ('(4) "%FT%T%z")
333 (_ (read-string "Time format: "))))))
334
335(defun unfill-paragraph ()
336 "Unfill the current paragraph."
337 (interactive)
338 (let ((fill-column most-positive-fixnum)
339 (fill-paragraph-function nil))
340 (fill-paragraph)))
341
342(defun fill-with-double-spaced-sentences-dwim (&optional start end)
343 "Fill paragraph or region, double-spacing sentences."
344 (interactive)
345 (let ((sentence-end-double-space t))
346 (unless (region-active-p)
347 (mark-paragraph))
348 (repunctuate-sentences :no-query
349 (region-beginning)
350 (region-end))
351 (fill-region (region-beginning)
352 (region-end))))
353
354(defun fill-with-double-spaced-sentences-dwim (&optional start end)
355 "Fill from START to END, double-spacing sentences.
356If START to END aren't given, or if a region isn't in use, fill
357the current paragraph."
358 (interactive "*r")
359 (let ((sentence-end-double-space t))
360 (save-mark-and-excursion
361 (save-restriction
362 (unless (region-active-p)
363 (setq start (progn (start-of-paragraph-text)
364 (point))
365 end (progn (end-of-paragraph-text)
366 (point))))
367 (narrow-to-region start end)
368 (goto-char (point-min))
369 (repunctuate-sentences :no-query)
370 (fill-region (point-min)
371 (point-max))))))
372
373(defun acdw-elisp-package-prepare (&optional file)
374 "Do all the elisp-package-preparing stuff on FILE.
375If FILE is nil or not given, do it on the current buffer."
376 (with-current-buffer (if file (find-file-noselect file) (current-buffer))
377 (check-parens)
378 (checkdoc)
379 (package-lint-buffer)
380 ;; TODO: use `lm-commentary' to write to README.org
381 ))
382
383(provide 'acdw)
384;;; acdw.el ends here
diff --git a/lisp/ical2org.el b/lisp/ical2org.el deleted file mode 100644 index 2716787..0000000 --- a/lisp/ical2org.el +++ /dev/null
@@ -1,56 +0,0 @@
1;;; ical2org.el --- Run ical2org in Emacs -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; based on code from this reddit thread:
6;; https://www.reddit.com/r/emacs/comments/8s1ion/ical2org_integrations/
7;;
8;; see also: icalendar.org (converts to diary format, might be all I need)
9;;
10;; XXX: This code currently imports into gnus, which isn't what I want.
11
12;;; Code:
13
14(defun ical2org (&optional replace output-buffer)
15 "Run ical2org on contents of this buffer.
16If REPLACE (interactive prefix argument), replace contents of the
17buffer. If no REPLACE nor OUTPUT-BUFFER, output goes to
18minibuffer."
19 (interactive "P")
20 (shell-command-on-region (point-min) (point-max)
21 "ical2org"
22 output-buffer
23 replace
24 "*ical2org errors*"
25 'display-errors))
26
27(defun ical2org-capture ()
28 "Run `ical2org' on this buffer, then `org-capture' the result.
29Leaves current buffer as-was afterwards."
30 (interactive)
31 (let ((buf (current-buffer))
32 (ics (buffer-string)))
33 (ical2org 'replace)
34 (mark-whole-buffer)
35 (call-interactively #'org-capture)
36 (with-current-buffer buf
37 (delete-region (point-min) (point-max))
38 (insert ics))))
39
40(defun my-gnus-org-capture-icalendar ()
41 "Capture any text/calendar invites with org."
42 (interactive)
43 (with-current-buffer gnus-article-buffer ;;; XXX
44 (save-excursion
45 (dolist (part gnus-article-mime-handle-alist)
46 (when (and (>= (length part) 3)
47 (listp (caddr part))
48 (or (equal "application/ics" (caaddr part))
49 (equal "text/calendar" (caaddr part))))
50 (save-window-excursion
51 (gnus-mime-copy-part (cdr part))
52 (ical2org-capture)))))))
53(add-hook 'gnus-article-prepare-hook #'my-gnus-org-capture-icalendar)
54
55(provide 'ical2org)
56;;; ical2org.el ends here
diff --git a/packages.el b/packages.el new file mode 100644 index 0000000..42d8eeb --- /dev/null +++ b/packages.el
@@ -0,0 +1,129 @@
1;;; packages.el --- my Emacs packages -*- lexical-binding: t; -*-
2
3(use-package scule
4 :load-path "~/src/scule.el/"
5 :bind-keymap ("M-c" . scule-map)
6 :init
7 ;; Use M-u for prefix keys
8 (keymap-global-set "M-u" #'universal-argument)
9 (keymap-set universal-argument-map "M-u" #'universal-argument-more))
10
11(use-package frowny
12 :load-path "~/src/frowny.el/"
13 :hook ((jabber-chat-mode . frowny-mode)))
14
15(use-package hippie-completing-read
16 :load-path "~/src/hippie-completing-read.el/"
17 :bind (("M-/" . hippie-completing-read)))
18
19(use-package mode-line-bell
20 :load-path "~/src/mode-line-bell.el/"
21 :config
22 (setq mode-line-bell-flash-time 0.25)
23 (mode-line-bell-mode))
24
25(use-package titlecase
26 :load-path "~/src/titlecase.el/"
27 :preface
28 (defun +titlecase-sentence-style-dwim (&optional arg)
29 "Titlecase a sentence.
30With prefix ARG, toggle the value of
31`titlecase-downcase-sentences' before sentence-casing."
32 (interactive "P")
33 (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences)
34 titlecase-downcase-sentences)))
35 (titlecase-dwim 'sentence)))
36 (defun +titlecase-org-headings ()
37 (interactive)
38 (require 'org)
39 (save-excursion
40 (goto-char (point-min))
41 ;; See also `org-map-tree'. I'm not using that function because I want to
42 ;; skip the first headline. A better solution would be to patch
43 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
44 (let ((level (funcall outline-level))
45 (org-special-ctrl-a/e t))
46 (while (and (progn (outline-next-heading)
47 (> (funcall outline-level) level))
48 (not (eobp)))
49 (titlecase-region (progn (org-beginning-of-line) (point))
50 (progn (org-end-of-line) (point)))))))
51 :config
52 (with-eval-after-load 'scule
53 (keymap-set scule-map "M-t" #'titlecase-dwim)))
54
55;;; Jabber
56
57(use-package jabber
58 :load-path "~/src/jabber.el"
59 :defer t
60 :bind-keymap (("C-c j" . jabber-global-keymap))
61 :preface nil
62 (setq-default jabber-chat-buffer-format "*%n*"
63 jabber-browse-buffer-format "*%n*"
64 jabber-groupchat-buffer-format "*%n*"
65 jabber-muc-private-buffer-format "*%n*")
66 :custom-face
67 (jabber-activity-face ((t :inherit jabber-chat-prompt-foreign
68 :foreground unspecified
69 :weight normal)))
70 (jabber-activity-personal-face ((t :inherit jabber-chat-prompt-local
71 :foreground unspecified
72 :weight bold)))
73 (jabber-chat-prompt-local ((t :inherit minibuffer-prompt
74 :foreground unspecified
75 :weight normal
76 :slant italic)))
77 (jabber-chat-prompt-foreign ((t :inherit warning
78 :foreground unspecified
79 :weight normal)))
80 (jabber-chat-prompt-system ((t :inherit font-lock-doc-face
81 :foreground unspecified)))
82 (jabber-rare-time-face ((t :inherit font-lock-comment-face
83 :foreground unspecified
84 :underline nil)))
85 :config
86 (require 'jabber-httpupload nil t)
87 (setopt jabber-auto-reconnect t
88 jabber-last-read-marker "~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~ ~"
89 jabber-muc-decorate-presence-patterns
90 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$" . nil)
91 ("Mode #.*" . jabber-muc-presence-dim)
92 ("." . jabber-muc-presence-dim))
93 jabber-activity-make-strings #'jabber-activity-make-strings-shorten
94 jabber-rare-time-format
95 (format " - - - - - %%H:%d %%F"
96 (let ((min (string-to-number (format-time-string "%M"))))
97 (* 5 (floor min 5))))
98 jabber-muc-header-line-format '(" " jabber-muc-topic))
99
100 (setopt jabber-groupchat-prompt-format "%n. "
101 jabber-chat-local-prompt-format "%n. "
102 jabber-chat-foreign-prompt-format "%n. "
103 jabber-muc-private-foreign-prompt-format "%g/%n. ")
104
105 (keymap-global-set "C-c C-SPC" #'jabber-activity-switch-to)
106 (map-keymap (lambda (key command)
107 (define-key jabber-global-keymap (vector (+ key #x60)) command))
108 jabber-global-keymap)
109 (keymap-global-set "C-x C-j" #'dired-jump)
110
111 (add-hook 'jabber-post-connect-hooks #'jabber-enable-carbons)
112 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
113 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo)
114 (add-hook 'jabber-chat-mode-hook 'visual-line-mode)
115 (add-hook 'jabber-chat-mode-hook (defun jabber-no-position ()
116 (setq-local mode-line-position nil)))
117
118 (add-hook 'jabber-alert-muc-hooks
119 (defun jabber@highlight-acdw (&optional _ _ buf _ _)
120 (when buf
121 (with-current-buffer buf
122 (let ((regexp (rx word-boundary
123 "acdw" ; maybe get from the config?
124 word-boundary)))
125 (hi-lock-unface-buffer regexp)
126 (highlight-regexp regexp 'jabber-chat-prompt-local))))))
127
128 (when (fboundp 'jabber-chat-update-focus)
129 (add-hook 'window-configuration-change-hook #'jabber-chat-update-focus)))