summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2022-10-17 21:41:28 -0500
committerCase Duckworth2022-10-17 21:41:28 -0500
commitaab5bfd074e57d06a79e39d7c7c4760e1f385a06 (patch)
tree7b111190a44458a970355f7a327cc5278c850293
parentasoi (diff)
downloademacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.tar.gz
emacs-aab5bfd074e57d06a79e39d7c7c4760e1f385a06.zip
Bankruptcy 9
-rw-r--r--.gitignore3
-rw-r--r--early-init.el129
-rw-r--r--eshell/aliases4
-rw-r--r--init.el2900
-rw-r--r--lisp/+Info.el84
-rw-r--r--lisp/+ace-window.el40
-rw-r--r--lisp/+apheleia.el50
-rw-r--r--lisp/+avy.el97
-rw-r--r--lisp/+bongo.el60
-rw-r--r--lisp/+browse-url.el156
-rw-r--r--lisp/+burly.el63
-rw-r--r--lisp/+casing.el82
-rw-r--r--lisp/+chicken.el34
-rw-r--r--lisp/+circe.el285
-rw-r--r--lisp/+compat.el64
-rw-r--r--lisp/+compile.el20
-rw-r--r--lisp/+consult.el47
-rw-r--r--lisp/+crux.el58
-rw-r--r--lisp/+cus-edit.el80
-rw-r--r--lisp/+dired.el28
-rw-r--r--lisp/+ecomplete.el45
-rw-r--r--lisp/+elfeed.el185
-rw-r--r--lisp/+elisp.el18
-rw-r--r--lisp/+emacs.el434
-rw-r--r--lisp/+embark.el28
-rw-r--r--lisp/+emms.el46
-rw-r--r--lisp/+eshell.el126
-rw-r--r--lisp/+eww.el71
-rw-r--r--lisp/+expand-region.el24
-rw-r--r--lisp/+finger.el46
-rw-r--r--lisp/+flyspell-correct.el24
-rw-r--r--lisp/+god-mode.el17
-rw-r--r--lisp/+hideshow.el44
-rw-r--r--lisp/+init.el117
-rw-r--r--lisp/+ispell.el97
-rw-r--r--lisp/+jabber.el278
-rw-r--r--lisp/+key.el106
-rw-r--r--lisp/+kmacro.el70
-rw-r--r--lisp/+link-hint.el169
-rw-r--r--lisp/+lisp.el195
-rw-r--r--lisp/+message.el26
-rw-r--r--lisp/+minibuffer.el14
-rw-r--r--lisp/+modeline.el488
-rw-r--r--lisp/+mwim.el42
-rw-r--r--lisp/+notmuch.el97
-rw-r--r--lisp/+nyan-mode.el42
-rw-r--r--lisp/+orderless.el60
-rw-r--r--lisp/+org-attach.el29
-rw-r--r--lisp/+org-capture.el164
-rw-r--r--lisp/+org-drawer-list.el47
-rw-r--r--lisp/+org-wc.el112
-rw-r--r--lisp/+org.el816
-rw-r--r--lisp/+ox.el29
-rw-r--r--lisp/+paredit.el26
-rw-r--r--lisp/+pdf-tools.el38
-rw-r--r--lisp/+pulse.el52
-rw-r--r--lisp/+scratch.el77
-rw-r--r--lisp/+setup.el216
-rw-r--r--lisp/+shr.el51
-rw-r--r--lisp/+slack.el27
-rw-r--r--lisp/+sly.el18
-rw-r--r--lisp/+straight.el42
-rw-r--r--lisp/+tab-bar.el394
-rw-r--r--lisp/+titlecase.el30
-rw-r--r--lisp/+util.el94
-rw-r--r--lisp/+vertico.el24
-rw-r--r--lisp/+vterm.el19
-rw-r--r--lisp/+window.el130
-rw-r--r--lisp/+xkcd.el16
-rw-r--r--lisp/+ytdious.el21
-rw-r--r--lisp/+zzz-to-char.el16
-rw-r--r--lisp/acdw.el595
-rw-r--r--lisp/dawn.el74
-rw-r--r--lisp/elephant.el58
-rw-r--r--lisp/find-script.el36
-rw-r--r--lisp/gdrive.el130
-rw-r--r--lisp/hide-cursor-mode.el116
-rw-r--r--lisp/long-s-mode.el67
-rw-r--r--lisp/private.el23
-rw-r--r--lisp/reading.el85
-rw-r--r--lisp/system.el179
-rw-r--r--lisp/user-save.el137
-rw-r--r--lisp/yoke.el125
-rw-r--r--machines/bob.el69
-rw-r--r--machines/gnu-linux.el5
-rw-r--r--machines/larry.el13
-rw-r--r--machines/windows-nt.el23
-rw-r--r--readme.md8
-rw-r--r--snippets/emacs-lisp-mode/+feature14
-rw-r--r--snippets/fundamental-mode/gpl3677
-rw-r--r--snippets/org-mode/sc4
-rw-r--r--snippets/scheme-mode/chicken8
-rw-r--r--snippets/sh-mode/getopts10
93 files changed, 411 insertions, 11726 deletions
diff --git a/.gitignore b/.gitignore index bc45f59..f7f259c 100644 --- a/.gitignore +++ b/.gitignore
@@ -19,7 +19,8 @@ var/
19eshell/* 19eshell/*
20!eshell/aliases 20!eshell/aliases
21url/ 21url/
22spell-fu/
23yoke/
22 24
23# put random stuff in here 25# put random stuff in here
24scratch.el 26scratch.el
25spell-fu/
diff --git a/early-init.el b/early-init.el index 615b417..173625f 100644 --- a/early-init.el +++ b/early-init.el
@@ -1,25 +1,6 @@
1;;; early-init.el -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; emacs early init -*- lexical-binding: t; -*-
2 2;; by C. Duckworth <acdw@acdw.net>
3;; Author: Case Duckworth <acdw@acdw.net> 3(provide 'early-init)
4;; Created: Sometime during Covid-19, 2020
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;;; License:
9
10;; Everyone is permitted to do whatever they like with this software
11;; without limitation. This software comes without any warranty
12;; whatsoever, but with two pieces of advice:
13;; - Be kind to yourself.
14;; - Make good choices.
15
16;;; Commentary:
17
18;; Starting with Emacs 27.1, early-init.el is sourced before
19;; package.el and any graphical frames. In this file, I set up frame
20;; parameters and packaging infrastructure.
21
22;;; Code:
23 4
24;;; Speed up init 5;;; Speed up init
25 6
@@ -60,19 +41,6 @@ restore that."
60(unless (eq debug-on-error 'startup) 41(unless (eq debug-on-error 'startup)
61 (+set-during-startup 'debug-on-error 'init)) 42 (+set-during-startup 'debug-on-error 'init))
62 43
63;;; Set up extra load paths and functionality
64
65(push (locate-user-emacs-file "lisp") load-path)
66(require 'acdw)
67(require '+compat)
68
69(+define-dir .etc (locate-user-emacs-file ".etc")
70 "Directory for all of Emacs's various files.
71See `no-littering' for examples.")
72
73(+define-dir sync/ (expand-file-name "~/Sync")
74 "My Syncthing directory.")
75
76;;; Default frame settings 44;;; Default frame settings
77 45
78(setq default-frame-alist '((tool-bar-lines . 0) 46(setq default-frame-alist '((tool-bar-lines . 0)
@@ -89,76 +57,35 @@ See `no-littering' for examples.")
89 ;; (bottom . right)) 57 ;; (bottom . right))
90 ) 58 )
91 59
92;;; No littering! 60;;; Set up extra load paths and functionality
93;; We install `no-littering' package below, but we can set the variables now.
94 61
95(setq no-littering-etc-directory .etc 62(push (locate-user-emacs-file "lisp") load-path)
96 no-littering-var-directory .etc 63(require 'acdw)
97 straight-base-dir .etc)
98 64
99;; https://github.com/emacscollective/no-littering/wiki/Setting-gccemacs'-eln-cache 65(+define-dir .etc (locate-user-emacs-file ".etc")
66 "Directory for all of Emacs's various files.
67See `no-littering' for examples.")
100 68
101(when (boundp 'comp-eln-load-path) 69(+define-dir sync/ (expand-file-name "~/Sync")
102 (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t)))) 70 "My Syncthing directory.")
103 71
104;;; Packages 72;;; Packages
105 73
106(setq package-enable-at-startup nil 74(setq package-enable-at-startup nil
107 package-quickstart nil 75 package-quickstart nil)
108 straight-host-usernames '((github . "duckwork") 76
109 (gitlab . "acdw")) 77(require 'yoke)
110 straight-check-for-modifications '(check-on-save 78
111 find-when-checking)) 79(yoke compat "https://git.sr.ht/~pkal/compat")
112 80
113;; Bootstrap straight.el 81(yoke no-littering "https://github.com/emacscollective/no-littering"
114;; https://github.com/raxod502/straight.el 82 (require 'no-littering)
115 83 (setq no-littering-etc-directory .etc
116(+with-message "Bootstrapping straight" 84 no-littering-var-directory .etc
117 (defvar bootstrap-version) 85 custom-file (.etc "custom.el"))
118 (let ((bootstrap-file 86 (when (boundp 'comp-eln-load-path)
119 (expand-file-name 87 (setcar comp-eln-load-path (expand-file-name (.etc "eln-cache" t))))
120 "straight/repos/straight.el/bootstrap.el" 88 (when (fboundp 'startup-redirect-eln-cache)
121 straight-base-dir)) 89 (startup-redirect-eln-cache
122 (bootstrap-version 5)) 90 (convert-standard-filename
123 (unless (file-exists-p bootstrap-file) 91 (.etc "eln-cache/")))))
124 (with-current-buffer
125 (url-retrieve-synchronously
126 (concat "https://raw.githubusercontent.com/"
127 "raxod502/straight.el/develop/install.el")
128 'silent 'inhibit-cookies)
129 (goto-char (point-max))
130 (eval-print-last-sexp)))
131 (load bootstrap-file nil 'nomessage)))
132
133;; Early-loaded packages -- those that, for some reason or another,
134;; need to be ensured to be loaded first.
135
136(require 'straight-x)
137
138(dolist (pkg '(el-patch
139 no-littering
140 setup
141 straight ; already installed, but what the hell
142 ))
143 (straight-use-package pkg)
144 (require pkg)
145 (require (intern (format "+%s" pkg)) nil :noerror))
146
147;; Setup `setup'
148
149(add-to-list 'setup-modifier-list '+setup-wrap-to-demote-errors)
150(unless (memq debug-on-error '(nil init))
151 (define-advice setup (:around (fn head &rest args) +setup-report)
152 (+with-progress ((format "[Setup] %S..." head))
153 (apply fn head args))))
154
155;;; Appendix
156
157;; Get rid of a dumb alias. straight-ಠ_ಠ-mode really slows down all
158;; minibuffer completion functions. Since it's a (rarely-used, even)
159;; alias anyway, I just define it back to nil. By the way, the alias
160;; is `straight-package-neutering-mode'.
161(defalias 'straight-ಠ_ಠ-mode nil)
162
163(provide 'early-init)
164;;; early-init.el ends here
diff --git a/eshell/aliases b/eshell/aliases deleted file mode 100644 index f47cb21..0000000 --- a/eshell/aliases +++ /dev/null
@@ -1,4 +0,0 @@
1alias sudo eshell/sudo $*
2alias ff find-file $1
3alias e find-file $1
4alias edit find-file $1
diff --git a/init.el b/init.el index bed69ee..d7a55d4 100644 --- a/init.el +++ b/init.el
@@ -1,2744 +1,176 @@
1;;; init.el --- Emacs initiation file -*- lexical-binding: t -*- 1;;; emacs init --- an init for emacs -*- lexical-binding: t; -*-
2 2;; by C. Duckworth <acdw@acdw.net>
3;; Author: Case Duckworth <acdw@acdw.net> 3;; URL: https://git.acdw.net/emacs
4;; Created: Sometime during Covid-19, 2020 4;; Bankruptcy: 9
5;; Keywords: configuration 5;;
6;; URL: https://tildegit.org/acdw/emacs
7;; Bankruptcy: 8
8
9;;; License:
10
11;; Everyone is permitted to do whatever they like with this software 6;; Everyone is permitted to do whatever they like with this software
12;; without limitation. This software comes without any warranty 7;; without limitation. This software comes without any warranty
13;; whatsoever, but with two pieces of advice: 8;; whatsoever, but with two pieces of advice:
14;; - Be kind to yourself. 9;; - Be kind to yourself.
15;; - Make good choices. 10;; - Make good choices.
16 11
17;;; Commentary 12(progn
18 13 ;; Settings
19;; My init.el. There are many like it, but this one is mine. 14 (setq truncate-string-ellipsis "…"
20 15 ring-bell-function #'ignore
21;; Ideas: 16 read-file-name-completion-ignore-case t)
22;; [[https://emacs.stackexchange.com/questions/17278/truncate-only-certain-lines-and-use-continuation-lines-elsewhere][Truncate org-mode headings]] 17 ;; Keys
23;; [[https://emacs.stackexchange.com/questions/7432/make-visual-line-mode-more-compatible-with-org-mode][another link that might be useful for truncating]] 18 (define-keys (current-global-map)
24 19 "C-x C-k" #'kill-current-buffer
25;;; Code: 20 "C-/" #'undo-only
26 21 "C-?" #'undo-redo
27(let ((early-features `((early-init . ,(locate-user-emacs-file "early-init")) 22 "M-j" nil
28 acdw private +key))) 23 "<Scroll_Lock>" nil)
29 (dolist (feature early-features)
30 (require (or (car-safe feature) feature) (cdr-safe feature) :noerror)))
31
32(setup (:require +casing)
33 (:global "M-u" #'universal-argument)
34 (+casing-mode +1))
35
36(setup (:require +emacs)
37 ;; +emacs.el contains super-basic defaults that are basically necessary for
38 ;; good functioning. In this block, I add extra things or more "experimental"
39 ;; ones that might not belong in a separate file.
40 (:also-load +lisp)
41 (:option truncate-string-ellipsis "…"
42 ring-bell-function 'ignore
43 read-file-name-completion-ignore-case t)
44 ;; Bindings
45 (:global "C-x C-k" #'kill-current-buffer
46 "C-M--" #'+goto-matching-paren
47 "C-c v" #'visible-mode
48 "C-M-;" #'+lisp-comment-or-uncomment-sexp
49 "C-x C-o" #'+switch-to-last-buffer
50 "C-x o" #'+switch-to-last-buffer
51 "C-x C-l" #'+open-paragraph ; original: downcase-region
52 "C-w" #'+kill-word-backward-or-region
53 "C-<backspace>" #'+backward-kill-word
54 "C-x TAB" #'+indent-rigidly
55 "<f7>" #'flyspell-mode
56 "C-\\" nil ; original: toggle-input-method
57 "C-/" #'undo-only
58 "C-?" #'undo-redo)
59 ;; Disable bindings
60 (:global "M-j" nil
61 "<Scroll_Lock>" nil)
62 (:+leader "C-d e" #'toggle-debug-on-error
63 "C-d q" #'toggle-debug-on-quit)
64 ;; C-h deletes backward - see https://idiomdrottning.org/bad-emacs-defaults
65 (global-set-key (kbd "C-h") 'delete-backward-char)
66 (keyboard-translate ?\C-h ?\C-?)
67 ;; Faces
68 (dolist (face '(line-number
69 line-number-major-tick
70 line-number-minor-tick
71 line-number-current-line))
72 (:face face '((t (:inherit fixed-pitch)))))
73 ;; Hooks
74 (add-hook 'prog-mode-hook #'turn-on-auto-fill)
75 (add-hook 'prog-mode-hook #'font-lock-todo-insinuate)
76 (add-hook 'text-mode-hook #'turn-on-auto-fill) ; XXX: do I want this ??
77 (add-hook 'special-mode-hook #'turn-off-auto-fill)
78 ;; Advice 24 ;; Advice
79 (advice-add #'completing-read-multiple :filter-args #'+crm-indicator)
80 ;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/hph14un/
81 (define-advice keyboard-escape-quit (:around (fn &rest r)) 25 (define-advice keyboard-escape-quit (:around (fn &rest r))
82 "Don't close splits on `keyboard-escape-quit'." 26 "Don't close quits on `keyboard-escape-quit'."
83 (let ((buffer-quit-function #'ignore)) 27 (let ((buffer-quit-function #'ignore))
84 (apply fn r)))) 28 (apply fn r)))
85 29 ;; Themes
86(setup (:require +init) 30 (load-theme 'modus-operandi))
87 (:local-hook user-save-before-save-hook #'+init-sort) 31
88 (+with-ensure-after-init 32(yoke auth-source nil
89 (:hook #'+init-add-setup-to-imenu))) 33 (setq auth-sources `(default "secrets:passwords"))
90 34 (setq-local-hook authinfo-mode-hook
91(setup (:require +window)) 35 truncate-lines t))
92 36
93(setup (:require auth-source) 37(yoke consult "https://github.com/minad/consult"
94 (:option auth-sources (list 'default 38 (require 'consult)
95 "secrets:passwords" 39 (setq register-preview-delay 0
96 (private/ "authinfo"))) 40 register-preview-function #'consult-register-format
97 (:with-mode authinfo-mode 41 xref-show-xrefs-function #'consult-xref
98 (:local-set truncate-lines t))) 42 tab-always-indent 'complete
99 43 completion-in-region-function #'consult-completion-in-region
100(setup (:require autoinsert) 44 consult-narrow-key "<"
101 ;; (auto-insert-mode +1) 45 consult--regexp-compiler #'consult--orderless-regexp-compiler)
102 )
103
104(setup (:require cus-edit)
105 ;; I don't use Custom to actually /make/ any customizations, but it's handy to
106 ;; (A) see what options are available and (B) persist some changes across
107 ;; restarts, for example, `safe-local-variables'.
108 (:require +cus-edit)
109 (:option custom-file (private/ "custom.el")
110 custom-magic-show nil
111 custom-magic-show-button t
112 custom-raised-buttons nil
113 custom-unlispify-tag-names nil
114 custom-variable-default-form 'lisp)
115 (dolist (var '(safe-local-variable-values
116 warning-suppress-types))
117 (add-to-list '+custom-variable-allowlist var))
118 ;; Load customizations now, and after init (to capture other possible
119 ;; variables I want to load) XXX: this is dumb
120 (+with-ensure-after-init
121 (+custom-load-ignoring-most-customizations))
122 (advice-add #'custom-buffer-create-internal :after #'+cus-edit-expand-widgets)
123 (:with-mode Custom-mode
124 (:local-set imenu-generic-expression +cus-edit-imenu-generic-expression)))
125
126(setup (:require find-script))
127
128(setup (:require goto-addr)
129 (if (fboundp #'global-goto-address-mode)
130 (global-goto-address-mode)
131 (add-hook 'after-change-major-mode-hook #'goto-address-mode)))
132
133(setup (:require pulse)
134 (:also-load +pulse)
135 (:option pulse-flag nil
136 pulse-delay 0.5
137 pulse-iterations 1)
138 (dolist (command '(+ace-window-or-switch-buffer
139 pop-mark pop-global-mark
140 Info-history-back Info-history-forward
141 ))
142 (add-to-list '+pulse-location-commands command))
143 (+ensure-after-init #'+pulse-location-mode))
144
145(setup (:require reading)
146 ;;(:hook-into view-mode) ; XXX doesn't go back
147 )
148
149(setup (:require user-save)
150 (add-hook 'user-save-before-save-hook #'+clean-empty-lines)
151 (add-hook 'user-save-before-save-hook (defun user-save@save-some-buffers ()
152 (save-some-buffers t t)))
153 (user-save-global-mode +1))
154
155(setup (:require winner)
156 (winner-mode +1))
157
158(setup +key
159 (+ensure-after-init #'+key-global-mode))
160
161(setup _work
162 (with-eval-after-load 'bbdb
163 (require '_work)))
164
165(setup abbrev
166 (:option abbrev-file-name (sync/ "abbrev.el")
167 save-abbrevs 'silent)
168 (with-eval-after-load 'user-save
169 (:with-mode edit-abbrevs-mode
170 (:hook #'user-save-mode-disable)))
171 (:hook-into text-mode
172 circe-chat-mode))
173
174(setup autorevert
175 (:option global-auto-revert-non-file-buffers t
176 auto-revert-verbose nil)
177 (global-auto-revert-mode +1))
178
179(setup awk-mode
180 (:apheleia gawk '("gawk" "-f-" "-o-")))
181
182(setup bookmark
183 (:option bookmark-save-flag 1
184 bookmark-watch-bookmark-file 'silent
185 bookmark-set-fringe-mark nil))
186
187(setup browse-url
188 (:require +browse-url)
189 (:option
190 browse-url-browser-function 'browse-url-default-browser
191 +browse-url-browser-function #'eww-browse-url
192 browse-url-generic-program (seq-some #'executable-find
193 '("firefox"
194 "chromium"
195 "chrome"))
196 browse-url-chrome-program (seq-some #'executable-find
197 '("chromium"
198 "chrome"
199 "google-chrome-stable"))
200 browse-url-generic-args (seq-some (lambda (e)
201 (when (equal (executable-find (car e))
202 browse-url-generic-program)
203 (cdr e)))
204 '(("firefox" "--new-tab")))
205 browse-url-secondary-browser-function (if (executable-find "firefox")
206 #'browse-url-firefox
207 #'browse-url-default-browser)
208 browse-url-new-window-flag nil
209 browse-url-firefox-arguments '("--new-tab")
210 browse-url-firefox-new-window-is-tab t)
211 (defvar +invidious-host
212 ;; TODO: Add variables for other transformations and what-not.
213 ;; ... or enable trying multiple servers
214 ;; "yewtu.be"
215 "youtube.com"
216 "Host for invidious instance.")
217 ;; Set up external browsing URLs.
218 (add-to-list '+custom-variable-allowlist
219 '+browse-url-secondary-browser-regexps)
220 (dolist (domain '("github.com" "gitlab.com" "google.com"
221 "imgur.com" "twitch.tv"
222 "pixelfed" "instagram.com" "bibliogram.art"
223 "reddit.com" "teddit.net"
224 "twitter.com" "nitter.net" "t.co"
225 "streamable.com" "spotify.com"
226 "hetzner.cloud"
227 "melpa.org"))
228 (add-to-list '+browse-url-secondary-browser-regexps
229 (replace-regexp-in-string "\\." "\\\\." domain)))
230 ;; Set up URL handlers.
231 (:option browse-url-handlers
232 (list
233 (cons (rx bos (or "gemini:" "gopher:")) #'elpher-browse-url-elpher)
234 (cons (rx ; images
235 "." (or "jpeg" "jpg" "png" "bmp" "webp") eos)
236 (lambda (&rest args)
237 (apply
238 (cond ((executable-find "mpv") #'+browse-image-with-mpv)
239 (t #'eww-browse-url))
240 args)))
241 (cons (rx (or ;; videos
242 "youtube.com" "youtu.be" "invidious" "yewtu.be"
243 (seq "." (or "mp4" "gif" "mov" "MOV" "webm") eos)
244 ;; music
245 "soundcloud.com" "bandcamp.com"
246 (seq "." (or "ogg" "mp3" "opus" "m4a") eos)))
247 (lambda (&rest args)
248 (apply (if (executable-find "mpv")
249 #'+browse-url-with-mpv
250 browse-url-secondary-browser-function)
251 args)))
252 (cons (+browse-url-secondary-browser-regexps-combine) ; non-text websites
253 (lambda (&rest args)
254 (apply browse-url-secondary-browser-function args)))
255 (cons "xkcd\\.com"
256 (lambda (&rest args)
257 (apply (if (fboundp #'xkcd-get)
258 (progn (require '+xkcd)
259 #'+xkcd-get-from-url)
260 +browse-url-browser-function)
261 args)))
262 (cons "." ; everything else
263 (lambda (&rest args)
264 (apply +browse-url-browser-function args)))))
265 (with-eval-after-load 'chd
266 (add-to-list 'browse-url-handlers
267 (cons chd/url-regexps #'browse-url-chrome)))
268 ;; Transform URLs before passing to `browse-url'
269 (:option +browse-url-transformations `((,(rx (or "youtube.com"
270 "youtu.be"))
271 . ,+invidious-host)
272 ("twitter\\.com" . "nitter.net")
273 ("instagram\\.com" . "bibilogram.art")
274 (,(rx (or "reddit.com"
275 "old.reddit.com"))
276 . "teddit.net")
277 ("medium\\.com" . "scribe.rip")
278 ("www\\.npr\\.org" . "text.npr.org")
279 ;;TODO: Various paste sites
280 ))
281 (+browse-url-transform-url-global-mode +1))
282
283(setup c-mode
284 (:with-hook c-mode-common-hook
285 (:hook #'indent-tabs-mode)))
286
287(setup calendar
288 (require '_location)
289 (:option diary-file (private/ "diary")))
290
291(setup compile
292 (:require +compile)
293 (:+key "<f5>" #'+compile-dispatch)
294 (:option compilation-always-kill t
295 compilation-ask-about-save nil
296 compilation-scroll-output t))
297
298(setup dired
299 (:require dired-x +dired)
300 (:straight dired+)
301 (:option dired-recursive-copies 'always
302 dired-recursive-deletes 'always
303 dired-create-destination-dirs 'always
304 dired-do-revert-buffer t
305 dired-hide-details-hide-symlink-targets nil
306 dired-isearch-filenames 'dwim
307 delete-by-moving-to-trash t
308 dired-auto-revert-buffer t
309 dired-listing-switches "-AlF"
310 ls-lisp-dirs-first t
311 dired-ls-F-marks-symlinks t
312 dired-clean-confirm-killing-deleted-buffers nil
313 dired-no-confirm '(byte-compile
314 load chgrp chmod chown
315 copy move hardlink symlink
316 shell touch)
317 dired-dwim-target t)
318 (:local-set truncate-lines t)
319 (:bind "<backspace>" #'dired-up-directory
320 "j" #'+dired-goto-file
321 "C-j" #'dired-up-directory)
322 (:hook #'dired-hide-details-mode
323 #'hl-line-mode
324 #'lin-mode
325 #'+dired-dim-git-ignores)
326 (+with-ensure-after-init ; Necessary because jabber loads later
327 (:+key "C-x C-j" #'dired-jump))
328 (dolist (refresh-after-func '(dired-do-flagged-delete))
329 (advice-add refresh-after-func :after #'revert-buffer))
330 (with-eval-after-load 'frowny
331 (add-to-list 'frowny-inhibit-modes #'dired-mode)))
332
333(setup eldoc
334 (:hook-into elisp-mode
335 lisp-interaction-mode))
336
337(setup elisp-mode
338 (:also-load +elisp)
339 (:option eval-expression-print-length nil
340 eval-expression-print-level nil)
341 (:with-mode emacs-lisp-mode
342 (:hook #'checkdoc-minor-mode))
343 (:bind-into (emacs-lisp-mode-map lisp-interaction-mode-map)
344 "C-c C-c" #'eval-defun
345 "C-c C-k" #'+elisp-eval-region-or-buffer
346 "C-c C-z" #'ielm)
347 (advice-add #'eval-region :around #'+eval-region@pulse))
348
349(setup eshell
350 (:also-load em-smart
351 em-tramp)
352 (:require +eshell
353 esh-module)
354 (+define-dir eshell/ (locate-user-emacs-file "eshell")
355 "Where to place Eshell-specific files.")
356 (:option eshell-aliases-file (eshell/ "aliases")
357 ;; What are these for???
358 eshell-rc-script (eshell/ "profile")
359 eshell-login-script (eshell/ "login")
360 eshell-destroy-buffer-when-process-dies t
361 eshell-directory-name eshell/
362 eshell-error-if-no-glob t
363 eshell-hist-ignore-dups t
364 eshell-kill-on-exit nil
365 eshell-prefer-lisp-functions t
366 eshell-prefer-lisp-variables t
367 eshell-review-quick-commands nil
368 eshell-save-history-on-exit t
369 eshell-scroll-to-bottom-on-input 'all
370 eshell-smart-space-goes-to-end t
371 eshell-where-to-jump 'begin
372 eshell-banner-message ""
373 eshell-prompt-regexp (rx bol (* (not (any ?# ?$ ?\n)))
374 " " (any ?# ?$)
375 (* " ")))
376 (:+leader "s" #'+eshell-here
377 "C-s" #'+eshell-here)
378 (:global "C-c C-z" #'+eshell-here)
379 (add-to-list 'eshell-modules-list 'eshell-tramp)
380 (with-eval-after-load 'mwim
381 (setf (alist-get 'eshell-mode mwim-beginning-of-line-function)
382 #'eshell-bol))
383 (:hook #'eshell-smart-initialize)
384 (+eshell-eval-after-load
385 ;; Local modes
386 (dolist (mode '((hungry-delete-mode . -1)))
387 (funcall (car mode) (cdr mode)))
388 ;; Set local settings
389 (dolist (setting `((outline-regexp . ,eshell-prompt-regexp)
390 (page-delimiter . ,eshell-prompt-regexp)
391 (imenu-generic-expression "Prompt"
392 ,(concat eshell-prompt-regexp
393 "\\(.*\\)")
394 1)
395 (truncate-lines . t)
396 (scroll-margin . 0)))
397 (set (make-local-variable (car setting)) (cdr setting)))
398 ;; Bind keys
399 (dolist (binding '(("C-d" . +eshell-quit-or-delete-char)))
400 (define-key eshell-mode-map
401 (kbd (car binding)) (cdr binding)))
402 ;; Environment variables
403 (dolist (environment '(("PAGER" . "cat")))
404 (setenv (car environment) (cdr environment)))))
405
406(setup eww
407 (:also-load +eww)
408 (:option eww-search-prefix "https://duckduckgo.com/html?q="
409 url-privacy-level '(email agent cookies lastloc)
410 eww-use-browse-url (rx bos (or "mailto:"
411 "gemini:"
412 "gopher:")))
413 (add-hook 'eww-after-render-hook #'reading-mode)
414 (:hook #'+eww-bookmark-setup
415 #'+eww-track-readable-mode)
416 (:bind "b" #'bookmark-set
417 "B" #'bookmark-jump
418 "M-n" nil
419 "M-p" nil))
420
421(setup hideshow
422 (:also-load +hideshow)
423 (:with-mode hs-minor-mode
424 (:hook-into prog-mode)
425 (:bind "C-<tab>" #'+hs-cycle
426 "C-S-<tab>" #'+hs-global-cycle
427 ;; but y tho
428 "C-S-<iso-lefttab>" #'+hs-global-cycle)))
429
430(setup ibuffer
431 (:also-load ibuf-ext)
432 (:option ibuffer-expert t
433 ibuffer-show-empty-filter-groups nil
434 ibuffer-saved-filter-groups
435 '(("default"
436 ("Org" (mode . org-mode))
437 ("emacs" (or (name . "^\\*scratch\\*$")
438 (name . "^\\*Messages\\*$")
439 (name . "^\\*Warnings\\*$")
440 (name . "^\\*straight-process\\*$")
441 (name . "^\\*Calendar\\*$")))
442 ("customize" (mode . Custom-mode))
443 ("emacs-config" (or (filename . ".emacs.d")
444 (mode . +init-mode)))
445 ("git" (or (name . "^\*magit")
446 (name . "^\magit")))
447 ("help" (or (mode . help-mode)
448 (mode . Info-mode)
449 (mode . helpful-mode)))
450 ("chat" (or (mode . erc-mode)
451 (mode . circe-server-mode)
452 (mode . circe-channel-mode)
453 (mode . jabber-chat-mode)
454 (mode . jabber-browse-mode)
455 (mode . jabber-roster-mode)))
456 ("shell" (or (mode . eshell-mode)
457 (mode . shell-mode)
458 (mode . vterm-mode)))
459 ("web" (or (mode . elpher-mode)
460 (mode . eww-mode))))))
461 (:hook (defun ibuffer@filter-to-default ()
462 (ibuffer-auto-mode +1)
463 (ibuffer-switch-to-saved-filter-groups "default"))))
464
465(setup info
466 (:also-load +Info)
467 (dolist (dir (split-string (getenv "INFOPATH") ":" t))
468 (add-to-list 'Info-additional-directory-list dir))
469 (:with-mode Info-mode ; -_-
470 (:hook #'reading-mode)
471 (:local-set +modeline-buffer-position #'+Info-modeline-breadcrumbs
472 +modeline-position-function #'ignore)
473 (:bind "c" #'+Info-copy-current-node-name
474 "w" #'+Info-copy-current-node-name)))
475
476(setup ispell
477 (:also-load +ispell)
478 (:option ispell-program-name (or (executable-find "ispell")
479 (executable-find "aspell")))
480 (put 'ispell-buffer-session-localwords
481 'safe-local-variable #'+ispell-safe-local-p)
482 (add-hook 'user-save-before-save-hook #'+ispell-move-buffer-words-to-dir-locals-hook))
483
484(setup kmacro
485 (:also-load +kmacro)
486 (with-eval-after-load '+kmacro
487 ;; (+kmacro-recording-indicator-mode +1)
488 (+kmacro-block-undo-mode +1)))
489
490(setup make-mode
491 (:hook (defun +make-remove-warnings ()
492 (dolist (f '(makefile-warn-continuations
493 makefile-warn-suspicious-lines))
494 (remove-hook 'write-file-functions f t)))))
495
496(setup midnight
497 (midnight-mode +1)
498 (add-hook 'midnight-hook #'recentf-cleanup))
499
500(setup minibuffer
501 (:require +minibuffer)
502 (:with-map minibuffer-local-map
503 (:bind "M-/" #'+minibuffer-complete-history)))
504
505(setup mouse
506 ;; Brand new for Emacs 28: see https://ruzkuku.com/texts/emacs-mouse.html
507 ;; Actually, look at this as well: https://www.emacswiki.org/emacs/Mouse3
508 (when (fboundp 'context-menu-mode)
509 (:option context-menu-functions
510 '(context-menu-ffap
511 context-menu-region
512 context-menu-undo
513 ;; context-menu-dictionary
514 ))
515 (context-menu-mode +1))
516 (dolist (click '(;; Fix scrolling in the margin
517 wheel-down double-wheel-down triple-wheel-down
518 wheel-up double-wheel-up triple-wheel-up))
519 (global-set-key (vector 'right-margin click) 'mwheel-scroll)
520 (global-set-key (vector 'left-margin click) 'mwheel-scroll)))
521
522(setup net-utils
523 (:needs "traceroute")
524 (:require +finger) ; fixes `finger' to use var below
525 (:option finger-X.500-host-regexps '(".") ; only send username
526 )
527 (with-eval-after-load 'transient
528 (transient-define-prefix net-utils ()
529 "Networking utilities"
530 ["Actions"
531 ("p" "Ping" ping)
532 ("i" "Ifconfig" ifconfig)
533 ("w" "Iwconfig" iwconfig)
534 ("n" "Netstat" netstat)
535 ("a" "Arp" arp)
536 ("r" "Route" route)
537 ("h" "Nslookup host" nslookup-host)
538 ("d" "Dig" dig)
539 ("s" "Smb Client" smbclient)
540 ("t" "Traceroute" traceroute)])
541 (:+key "C-z M-n" #'net-utils)))
542
543(setup notmuch
544 (:load-from "~/usr/share/emacs/site-lisp/")
545 (:load-after bbdb)
546 (:also-load +notmuch +message)
547 (+define-dir notmuch/ (sync/ "emacs/notmuch")
548 "Notmuch configuration and data.")
549 (:option notmuch-init-file (notmuch/ "notmuch-init.el" t)
550 notmuch-address-save-filename (notmuch/ "addresses" t)
551 notmuch-address-use-company (featurep 'company)
552 notmuch-search-oldest-first nil
553 notmuch-archive-tags '("-inbox" "-unread")
554 notmuch-draft-tags '("+draft" "-inbox" "-unread"))
555 ;; Reading mail
556 (:option notmuch-show-indent-content nil)
557 (add-hook 'notmuch-show-mode-hook #'visual-fill-column-mode)
558 (:with-mode notmuch-search-mode
559 (:bind "RET" #'notmuch-search-show-thread
560 "M-RET" #'notmuch-tree-from-search-thread
561 "!" #'+notmuch-search-mark-spam))
562 (:with-mode notmuch-tree-mode
563 (:bind "!" #'+notmuch-tree-mark-spam-then-next))
564 ;; Composing mail
565 (:option message-kill-buffer-on-exit t
566 message-auto-save-directory nil)
567 ;; Sending mail
568 (:option send-mail-function #'sendmail-send-it
569 mail-specify-envelope-from t
570 message-sendmail-envelope-from 'header
571 mail-envelope-from 'header)
572 ;; Extras and fixes
573 (with-eval-after-load 'notmuch
574 (load notmuch-init-file :noerror)
575 (add-hook 'message-setup-hook #'+message-signature-setup)
576 (add-hook 'message-send-hook #'+send-mail-dispatch)
577 (advice-add 'notmuch-tag :filter-args #'+notmuch-correct-tags)
578 (:option notmuch-saved-searches (list
579 (list :name "inbox+unread"
580 :query (+notmuch-query-concat
581 "tag:inbox"
582 "tag:unread"
583 "NOT tag:Spam")
584 :key "m"
585 :search-type 'tree)
586 (list :name "inbox"
587 :query (+notmuch-query-concat
588 "tag:inbox"
589 "NOT tag:Spam")
590 :key "i"
591 :search-type 'tree)
592 (list :name "lists+unread"
593 :query (+notmuch-query-concat
594 "tag:/List/"
595 "tag:unread")
596 :key "l"
597 :search-type 'tree)
598 (list :name "lists"
599 :query "tag:/List/"
600 :key "L"
601 :search-type 'tree)
602 (list :name "unread"
603 :query (+notmuch-query-concat
604 "tag:unread"
605 "NOT tag:Spam")
606 :key "u"
607 :search-type 'tree)
608 (list :name "flagged"
609 :query "tag:flagged"
610 :key "f"
611 :search-type 'tree)
612 (list :name "sent"
613 :query "tag:sent"
614 :key "t"
615 :search-type 'tree)
616 (list :name "drafts"
617 :query "tag:draft"
618 :key "d"
619 :search-type 'tree)
620 (list :name "all mail"
621 :query "*"
622 :key "a"
623 :search-type 'tree))))
624 (:+leader "m" #'notmuch-mua-new-mail "C-m" #'notmuch-jump-search
625 "n" #'notmuch "C-n" #'notmuch)
626 ;; For `focus'
627 (put 'notmuch-message 'bounds-of-thing-at-point 'notmuch-show-message-extent))
628
629(setup org
630 ;; Plain org with the `setup' form for sorting, but I install with straight.
631 (:straight (org
632 :type git :host nil
633 :repo "https://git.savannah.gnu.org/git/emacs/org-mode.git"
634 :local-repo "org"
635 :depth full
636 :pre-build (straight-recipes-org-elpa--build)
637 :build (:not autoloads)
638 :files (:defaults
639 "lisp/*.el"
640 ("etc/styles/" "etc/styles/*"))))
641 (:straight (org-contrib
642 :type git :host nil
643 :repo "https://git.sr.ht/~bzg/org-contrib"))
644 ;; DO NOT load system-installed org !!!
645 (setq load-path
646 (cl-remove-if (lambda (path) (string-match-p "lisp/org\\'" path)) load-path))
647 (:also-load +org)
648 (with-eval-after-load '+org (+org-agenda-inhibit-hooks-mode +1))
649 (:option org-adapt-indentation nil
650 org-auto-align-tags t
651 org-archive-mark-done t
652 org-fold-catch-invisible-edits 'show-and-error
653 org-clock-clocked-in-display 'mode-line
654 org-clock-frame-title-format (cons
655 '(t org-mode-line-string)
656 (cons " --- " frame-title-format))
657 org-clock-string-limit 7 ; just the clock bit
658 ;; org-clock-string-limit 25 ; gives enough information
659 org-clock-persist nil
660 org-confirm-babel-evaluate nil
661 org-cycle-separator-lines 0
662 org-directory (sync/ "org/" t)
663 org-ellipsis (or truncate-string-ellipsis "…")
664 org-fontify-done-headline t
665 org-fontify-quote-and-verse-blocks t
666 org-fontify-whole-heading-line t
667 org-hide-emphasis-markers t
668 org-html-coding-system 'utf-8-unix
669 org-image-actual-width (list (* (window-font-width)
670 (- fill-column 8)))
671 org-imenu-depth 3
672 org-indent-indentation-per-level 0
673 org-indent-mode-turns-on-hiding-stars nil
674 org-insert-heading-respect-content t
675 org-list-demote-modify-bullet '(("-" . "+")
676 ("+" . "-"))
677 org-log-done 'time
678 org-log-into-drawer t
679 org-num-skip-commented t
680 org-num-skip-unnumbered t
681 org-num-skip-footnotes t
682 org-outline-path-complete-in-steps nil
683 org-pretty-entities t
684 org-pretty-entities-include-sub-superscripts nil
685 org-refile-targets '((nil . (:maxlevel . 2))
686 (org-agenda-files . (:maxlevel . 1)))
687 org-refile-use-outline-path 'file
688 org-special-ctrl-a/e t
689 org-special-ctrl-k t
690 org-src-fontify-natively t
691 org-src-tab-acts-natively t
692 org-src-window-setup 'current-window
693 org-startup-truncated nil
694 org-startup-with-inline-images t
695 org-tags-column -77 ;; (- (- fill-column 1 (length org-ellipsis)))
696 org-todo-keywords
697 '((sequence "TODO(t)" "WAIT(w@/!)" "ONGOING(o@)"
698 "|" "DONE(d!)" "ASSIGNED(a@/!)")
699 (sequence "|" "CANCELED(k@)")
700 (sequence "MEETING(m)"))
701 org-use-speed-commands t
702 org-emphasis-alist '(("*" org-bold)
703 ("/" org-italic)
704 ("_" org-underline)
705 ("=" org-verbatim)
706 ("~" org-code)
707 ("+" org-strikethrough)))
708 ;; (setq org-todo-keywords
709 ;; '((sequence
710 ;; "TODO(t)"
711 ;; "NEXT(n!)" ; next action
712 ;; "DONE(d)" ; done)
713 ;; (sequence
714 ;; "WAIT(w@)" ; waiting to be actionable again
715 ;; "HOLD(h@/!)" ; actinable, but will do later
716 ;; "IDEA(i)" ; maybe someday
717 ;; "KILL(k@/!)" ; cancelled, aborted or is no longer applicable
718 ;; ))))
719 (:bind "RET" #'+org-return-dwim
720 "<S-return>" #'+org-table-copy-down
721 "M-RET" #'+org-meta-return
722 "C-c C-l" #'+org-insert-link-dwim
723 "C-c C-n" #'+org-next-heading-widen
724 "C-c C-p" #'+org-previous-heading-widen
725 "C-c C-o" #'+org-open-at-point-dwim
726 "`" #'+org-insert-tilde
727 "~" #'+org-insert-backtick
728 "C-c C-x l" #'org-toggle-link-display
729 "C-c C-x m" #'+org-toggle-view-emphasis
730 "C-c C-x r" #'+org-drawer-list-add-resource
731 "C-M-k" #'kill-paragraph
732 "C-M-t" #'transpose-paragraphs)
733 (:global [f8] #'org-clock-in
734 [f9] #'org-clock-out
735 "C-c l" #'org-store-link)
736 (+with-ensure-after-init
737 (:hook #'variable-pitch-mode
738 #'visual-fill-column-mode
739 #'turn-off-auto-fill
740 #'org-indent-mode ;; Needed for proper hanging indents in lists
741 #'prettify-symbols-mode
742 #'+org-wrap-on-hyphens))
743 (:local-set prettify-symbols-alist '(("DEADLINE:" . ?→)
744 ("SCHEDULED:" . ?↷)
745 ("CLOSED:" . ?✓))
746 ;; electric-pair-pairs
747 ;; (append electric-pair-pairs
748 ;; (mapcar (lambda (emph)
749 ;; (let ((ch (string-to-char (car emph))))
750 ;; (cons ch ch)))
751 ;; org-emphasis-alist))
752 )
753 (:local-hook user-save-before-save-hook #'+org-before-save@prettify-buffer)
754 (advice-add #'org-delete-backward-char :override #'+org-delete-backward-char)
755 ;; (define-advice org-open-at-point (:around (fn &rest r) open-external)
756 ;; "Open links from org externally."
757 ;; (let ((browse-url-browser-function browse-url-secondary-browser-function))
758 ;; (apply fn r)))
759 ;; (add-to-list '+custom-variable-allowlist 'org-agenda-files)
760 (with-eval-after-load 'org
761 (setf (alist-get "\\.x?html?\\'" org-file-apps nil nil #'equal)
762 #'+org-open-html)
763 (org-clock-persistence-insinuate)
764 (org-link-set-parameters "tel" :follow #'+org-tel-open)
765 (org-link-set-parameters "sms" :follow #'+org-sms-open)
766 (setf (alist-get "\\.x?html?\\'" org-file-apps nil nil #'equal)
767 #'+org-open-html)
768 (advice-add 'org-agenda :before
769 (defun +org-agenda-files-uniquify (&rest _)
770 (setq org-agenda-files
771 (seq-uniq org-agenda-files)))))
772 (:face 'org-done '((t (:inherit (modus-themes-subtle-green))))
773 'org-tag '((t (:inherit (secondary-selection))))
774 'org-todo '((t (:inherit (modus-themes-subtle-red)))))
775 ;; Extra keywords
776 (font-lock-add-keywords
777 'org-mode
778 '(;; Fancy list bullets
779 ;; NOTE: these `progn' and `default's are necessary; otherwise Emacs
780 ;; complains about "Invalid face reference: t" in org-mode buffers, because
781 ;; `compose-region' returns t.
782 ("^[ \t]*\\([-]\\) "
783 (0 (progn (compose-region (match-beginning 1) (match-end 1) "–") 'fixed-pitch)
784 ;; 'fixed-pitch t
785 ))
786 ("^[ \t]*\\([+]\\) "
787 (0 (progn (compose-region (match-beginning 1) (match-end 1) "•") 'fixed-pitch)
788 ;; 'fixed-pitch t
789 ))
790 ("^[ \t]+\\([*]\\) "
791 (0 ;; (progn (compose-region (match-beginning 1) (match-end 1) "→") 'fixed-pitch)
792 'fixed-pitch t))
793 ;; Fancy numbered lists (well, monospaced)
794 ("^[ \t]*\\(\\(?:[0-9]+\\|[A-Za-z]\\)[.)]\\) " 0 'fixed-pitch t)
795 ;; Make leading org-heading stars fixed-pitch
796 ("^\*+ " 0 'fixed-pitch t)
797 ))
798 (with-eval-after-load 'form-feed
799 ;; Horizontal lines
800 (font-lock-add-keywords
801 'org-mode
802 '(("^-----+" . form-feed--font-lock-face))))
803 (put 'browse-url-browser-function 'safe-local-variable
804 (lambda (val)
805 (eq (function-get val 'browse-url-browser-kind :autoload)
806 'external))))
807
808(setup org-agenda
809 (:option org-agenda-skip-deadline-if-done t
810 org-agenda-skip-scheduled-if-done t
811 org-agenda-span 10
812 org-agenda-block-separator ?─
813 org-agenda-time-grid
814 '((daily today require-timed)
815 (800 1000 1200 1400 1600 1800 2000)
816 " ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
817 org-agenda-current-time-string
818 "← now ─────────────────────────────────────────────────"
819 org-agenda-include-diary nil ; I use the org-diary features
820 org-agenda-todo-ignore-deadlines 'near
821 org-agenda-todo-ignore-scheduled 'future
822 org-agenda-include-deadlines t
823 org-deadline-warning-days 0
824 org-agenda-show-future-repeats 'next
825 org-agenda-window-setup 'current-window)
826 (unless after-init-time
827 (:option org-agenda-files (list (sync/ "org/"))))
828 (dolist (var '(org-agenda-files
829 org-agenda-file-regexp
830 org-agenda-templates))
831 (add-to-list '+custom-variable-allowlist var))
832 (define-advice org-agenda-files (:filter-return (ret))
833 "Remove SyncThing's sync-conflict files from the org agenda."
834 (seq-remove (lambda (f) (string-match-p "sync-conflict" f)) ret))
835 (:+leader "a" #'org-agenda "C-a" #'org-agenda)
836 (:hook #'hl-line-mode)
837 (:local-set truncate-lines t)
838 (add-hook 'org-agenda-after-show-hook #'org-narrow-to-subtree))
839
840(setup org-attach
841 (:also-load +org-attach)
842 (:option org-attach-method 'lns)
843 (with-eval-after-load '+org-attach
844 (+org-attach-fix-args-mode +1)))
845
846(setup org-capture
847 (:require +org-capture)
848 (:+leader "c" #'org-capture "C-c" #'org-capture)
849 (+org-capture-templates-setf "t" "Todo")
850 (+org-capture-templates-setf "tt"
851 `("Today!" entry (file "todo.org")
852 ,(concat "* TODO %^{Title}\n"
853 "DEADLINE: %t\n"
854 "\n%?")))
855 (+org-capture-templates-setf "ts"
856 `("Someday..." entry (file "todo.org")
857 ,(concat "* TODO %^{Title}\n"
858 ":PROPERTIES:\n"
859 ":CREATED: [%<%F %T>]\n"
860 ":END:\n"
861 "\n%?")))
862 (+org-capture-templates-setf "tm"
863 `("Media" entry (file "todo.org")
864 ,(concat "* TODO %^{TITLE}\n"
865 ":PROPERTIES:\n"
866 ":TITLE: %\\1\n"
867 ":AUTHOR: %^{AUTHOR}\n"
868 ":END:\n"
869 "\n%?")))
870 (+org-capture-templates-setf "l"
871 `("Link" entry (file "links.org")
872 "* %(+org-insert-link-dwim) %^g\n\n"))
873 (+org-capture-templates-setf "w" "Work")
874 (+org-capture-templates-setf "j"
875 '("Journal entry" plain
876 (file+olp+datetree "journal.org")
877 "**** %U\n%i\n%?"))
878 ;; TODO: Prompt for identity file from ~/.ssh and try to guess the hostname
879 ;; from there.
880 (+org-capture-templates-setf "s"
881 `("SSH Config" plain (file "~/.ssh/config")
882 ,(concat "\n\nHost %^{Host}"
883 "\n Hostname %\\1"
884 "\n User %^{User|%(user-login-name)}"
885 "\n IdentityFile %(read-file-name \"IdentityFile: \" \"~/.ssh/\")"
886 "\n IdentitiesOnly yes"
887 "\n PubkeyAuthentication yes"
888 "\n Port %^{Port|22}")
889 ))
890 (+org-capture-templates-setf "r"
891 `("Radio station" plain (file "~/.config/radio/stations")
892 ,(concat "%^{URL} %^{Description} %^{Tags [space delimited]}")
893 :immediate-finish t))
894 (+org-capture-sort))
895
896(setup org-id
897 (:load-after org)
898 ;; https://helpdeskheadesk.net/2022-03-13/
899 (:option org-id-method 'ts
900 org-attach-id-to-path-function-list '(org-attach-id-ts-folder-format
901 org-attach-id-uuid-folder-format)))
902
903(setup ox ; org-export
904 (:also-load +ox
905 ox-md)
906 (:option org-export-coding-system 'utf-8-unix
907 org-export-headline-levels 8
908 org-export-with-drawers nil
909 org-export-with-section-numbers nil
910 org-export-with-smart-quotes t
911 org-export-with-sub-superscripts t
912 org-export-with-toc nil)
913 (with-eval-after-load 'ox
914 (+org-export-pre-hooks-insinuate)))
915
916(setup password-cache
917 (:option password-cache t
918 password-cache-expiry (* 60 60)))
919
920(setup prettify-symbols-mode
921 (:option prettify-symbols-unprettify-at-point t))
922
923(setup prog
924 (:local-set comment-auto-fill-only-comments t)
925 (:hook #'prettify-symbols-mode))
926
927(setup scheme
928 ;; I use CHICKEN
929 (:require +chicken)
930 (:with-mode scheme-mode
931 (:file-match (rx ".scm" eos)))
932 (setq scheme-mit-dialect nil
933 scheme-program-name (executable-find "csi")
934 scheme-default-implementation 'chicken)
935 ;; Scheme complete
936 (straight-use-package 'scheme-complete)
937 (autoload 'scheme-smart-complete "scheme-complete" nil t)
938 (with-eval-after-load 'scheme
939 (define-key scheme-mode-map (kbd "TAB") #'scheme-complete-or-indent))
940 (autoload 'scheme-get-current-symbol-info "scheme-complete" nil t)
941 (:local-set eldoc-documentation-function #'scheme-get-current-symbol-info
942 lisp-indent-function #'scheme-smart-indent-function)
943 (:hook #'eldoc-mode))
944
945(setup scratch
946 (:require +scratch)
947 (:option initial-major-mode #'lisp-interaction-mode
948 initial-scratch-message ";;; What good will you work in the world today?\n\n")
949 (:+leader "." #'+scratch-switch-to-scratch
950 "C-." #'+scratch-switch-to-scratch
951 "," #'+scratch-switch-to-text
952 "C-," #'+scratch-switch-to-text)
953 (+with-ensure-after-init
954 (+scratch-text-scratch))
955 (add-hook 'kill-buffer-query-functions #'+scratch-immortal))
956
957(setup sh
958 (:option sh-indentation tab-width)
959 (:hook #'indent-tabs-mode)
960 (:apheleia shfmt '("shfmt")))
961
962(setup shell
963 (:option shell-command-prompt-show-cwd t)
964 (:local-set +modeline-position-function
965 (lambda () (string-replace (getenv "HOME")
966 "~"
967 default-directory)))
968 (:hook #'form-feed-mode))
969
970(setup shr
971 (:also-load +shr)
972 (:option shr-width (- fill-column 5) ; pad out for wide letters
973 shr-use-fonts t)
974 (dolist (mode '(eww-mode
975 elfeed-show-mode))
976 (add-hook (intern (format "%s-hook" mode)) #'+shr-heading-setup-imenu)))
977
978(setup tab-bar
979 (:require +tab-bar)
980 (:option tab-bar-tab-name-function '+tab-bar-basename
981 tab-bar-tab-name-truncated-max 20
982 tab-bar-tab-name-ellipsis truncate-string-ellipsis
983 tab-bar-show t
984 tab-bar-close-button-show t
985 tab-bar-new-button-show t
986 +tab-bar-menu-bar-icon " ; "
987 tab-bar-close-button (propertize " × "
988 'display t
989 'close-tab nil)
990 tab-bar-new-button (propertize "+ " 'display t))
991 ;; I need to set these here so that they take effect /before/ `display-time-mode'
992 (:option display-time-format "%H:%M"
993 display-time-mail-file :disable
994 display-time-load-average-threshold 50)
995 (:option tab-bar-format '(;;+tab-bar-format-menu-bar
996 tab-bar-format-history
997 tab-bar-format-tabs
998 tab-bar-separator
999 tab-bar-format-add-tab
1000 +tab-bar-format-align-right
1001 ;;+tab-bar-misc-info
1002 +tab-bar-org-clock
1003 +tab-bar-bongo
1004 ;;+tab-bar-emms
1005 +tab-bar-tracking-mode
1006 +tab-bar-notmuch-count
1007 +tab-bar-timer
1008 +tab-bar-date
1009 +tab-bar-space))
1010 (tab-bar-mode +1)
1011 (display-time-mode +1))
1012
1013(setup text-mode
1014 (:bind "C-M-k" #'kill-paragraph))
1015
1016(setup timer-list
1017 (:bind "d" #'timer-list-cancel)
1018 (:hook #'hl-line-mode
1019 #'lin-mode))
1020
1021(setup tramp
1022 (el-patch-feature tramp)
1023 (with-eval-after-load 'tramp
1024 (el-patch-defun tramp-debug-buffer-command-completion-p (_symbol buffer)
1025 "A predicate for Tramp interactive commands.
1026 They are completed by \"M-x TAB\" only in Tramp debug buffers."
1027 (with-current-buffer buffer
1028 (el-patch-wrap 2
1029 (save-restriction
1030 (widen)
1031 (string-equal (buffer-substring 1 10) ";; Emacs:")))))))
1032
1033(setup whitespace
1034 (:option whitespace-line-column nil
1035 whitespace-style '(face trailing tabs tab-mark))
1036 ;; I want trailing whitespace to be cleaned up, but I don't need to know about it.
1037 (:face 'whitespace-trailing '((t :inherit nil)))
1038 (:hook-into text-mode prog-mode))
1039
1040(setup (:straight 0x0)
1041 (:option 0x0-default-server 'ttm)
1042 (with-eval-after-load 'embark
1043 (define-key embark-region-map (kbd "U") #'0x0-dwim)))
1044
1045(setup (:straight ace-window)
1046 (:require +ace-window)
1047 (:option aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
1048 aw-display-mode-overlay nil
1049 aw-scope 'frame
1050 aw-minibuffer-flag t)
1051 (:+key "M-o" #'+ace-window-or-switch-buffer)
1052 (:face 'aw-mode-line-face '((t (:foreground "red"))))
1053 (+ace-window-display-mode +1))
1054
1055(setup (:straight (actually-selected-window :host github
1056 :repo "duckwork/actually-selected-window.el"))
1057 (actually-selected-window-mode +1))
1058
1059(setup (:straight adaptive-wrap)
1060 (:with-mode adaptive-wrap-prefix-mode
1061 (:hook-into visual-column-mode)))
1062
1063(setup (:straight affe
1064 (or (executable-find "rg")
1065 (and (executable-find "find")
1066 (executable-find "grep"))))
1067 (:load-after consult orderless vertico)
1068 (setq affe-regexp-compiler (defun affe-orderless-regexp-compiler (input &rest _)
1069 (setq input (orderless-pattern-compiler input))
1070 (cons input (lambda (str) (orderless--highlight input str)))))
1071 (+with-eval-after-loads (affe)
1072 (setq affe-regexp-compiler (defun affe-orderless-regexp-compiler (input &rest _)
1073 (setq input (orderless-pattern-compiler input))
1074 (cons input (lambda (str) (orderless--highlight input str)))))
1075 (:+key "M-s g" #'affe-grep
1076 "M-s f" #'affe-find)))
1077
1078(setup (:straight alert)
1079 (:option alert-default-style 'libnotify))
1080
1081(setup (:straight anzu)
1082 (:option anzu-cons-mode-line-p nil)
1083 (:+key [remap query-replace] #'anzu-query-replace-regexp
1084 [remap query-replace-regexp] #'anzu-query-replace-regexp)
1085 (global-anzu-mode +1)
1086 (:bind-into isearch
1087 [remap isearch-query-replace] #'anzu-isearch-query-replace
1088 [remap isearch-query-replace-regexp] #'anzu-isearch-query-replace-regexp))
1089
1090(setup (:straight apheleia)
1091 (:require apheleia +apheleia)
1092 (+apheleia/user-save-global-mode +1)
1093 (add-to-list 'apheleia-formatters `(fmt . ("fmt"
1094 "-s" ; split long lines but don't refill
1095 "-u" ; one space words, two space sentences
1096 "-w" ; set width (fill-column)
1097 ,(number-to-string (floor (* fill-column 1.1)))
1098 "-g" ; goal width
1099 ,(number-to-string fill-column)))))
1100
1101(setup (:straight avy)
1102 (:require avy +avy)
1103 (:option avy-background t
1104 avy-lead-faces
1105 '(avy-lead-face
1106 avy-lead-face-1 avy-lead-face-1 avy-lead-face-1
1107 avy-lead-face-1 avy-lead-face-1 avy-lead-face-1))
1108 (:face 'avy-background-face
1109 '((t (:foreground "#888888"))))
1110 (:+key "M-j" #'avy-goto-char-timer)
1111 (:bind-into isearch
1112 "M-j" #'avy-isearch)
1113 (setf (alist-get ?. avy-dispatch-alist) #'avy-action-embark)
1114 ;; (+avy-buffer-face-mode +1)
1115 )
1116
1117(setup (:straight bbdb)
1118 (:straight bbdb-vcard)
1119 (add-hook '+custom-after-load-hook
1120 (defun +bbdb-load ()
1121 (:require bbdb-autoloads
1122 bbdb)
1123 (bbdb-initialize 'gnus 'message)
1124 (bbdb-insinuate-message)
1125 (setq bbdb-complete-mail-allow-cycling t))))
1126
1127(setup (:straight (bongo :type git
1128 :flavor melpa
1129 :files ("*.el" "*.texi" "images" "*.rb" "bongo-pkg.el" "*.info")
1130 :pre-build ("makeinfo" "--no-split" "bongo.texi")
1131 :host github
1132 :repo "dbrock/bongo"))
1133 (:also-load +bongo)
1134 (:option bongo-default-directory "~/var/music"
1135 bongo-custom-backend-matchers '((mpv . (("https:") . t)))
1136 +bongo-radio-stations ; use `+bongo-radio' for these
1137 `(;; Local radio
1138 ("KLSU"
1139 . "http://130.39.238.143:8010/stream.mp3")
1140 ("WRKF: NPR for the Capital Region"
1141 . ,(concat "https://playerservices.streamtheworld.com/api/"
1142 "livestream-redirect/WRKFFM.mp3"))
1143 ("WRKF HD-2"
1144 . ,(concat "https://playerservices.streamtheworld.com/api/"
1145 "livestream-redirect/WRKFHD2.mp3"))
1146 ("WBRH: Jazz & More"
1147 . "http://wbrh.streamguys1.com/wbrh-mp3")
1148 ("KBRH Blues & Rhythm Hits"
1149 . "http://wbrh.streamguys1.com/kbrh-mp3")
1150 ;; Soma FM
1151 ("Soma FM Synphaera"
1152 . "https://somafm.com/synphaera256.pls")
1153 ("SomaFM BAGel Radio"
1154 . "https://somafm.com/bagel.pls")
1155 ("SomaFM Boot Liquor"
1156 . "https://somafm.com/bootliquor320.pls")
1157 ("SomaFM Deep Space One"
1158 . "https://somafm.com/deepspaceone.pls")
1159 ("SomaFM Fluid"
1160 . "https://somafm.com/fluid.pls")
1161 ("SomaFM Underground 80s"
1162 . "https://somafm.com/u80s256.pls")
1163 ;; Tildeverse & Friends
1164 ("tilderadio"
1165 . "https://azuracast.tilderadio.org/radio/8000/radio.ogg")
1166 ("vantaradio"
1167 . "https://vantaa.black/radio")
1168 ;; Other online radio
1169 ("BadRadio: 24/7 PHONK"
1170 . "https://s2.radio.co/s2b2b68744/listen")
1171 ("Cafe - lainon.life"
1172 . "https://lainon.life/radio/cafe.ogg.m3u")
1173 ("Everything - lainon.life"
1174 . "https://lainon.life/radio/everything.ogg.m3u")
1175 ("Swing - lainon.life"
1176 . "https://lainon.life/radio/swing.ogg.m3u")
1177 ("Cyberia - lainon.life"
1178 . "https://lainon.life/radio/cyberia.ogg.m3u")
1179 ("Nightwave Plaza - Online Vaporwave Radio"
1180 . "http://radio.plaza.one/opus")))
1181 (advice-add 'bongo-play :before #'+bongo-stop-all)
1182 (with-eval-after-load 'notifications
1183 (add-hook 'bongo-player-metadata-changed-hook #'+bongo-notify)))
1184
1185(setup (:straight brainfuck-mode))
1186
1187(setup (:straight browse-kill-ring)
1188 (:+key "C-M-y" #'browse-kill-ring)
1189 (:option browse-kill-ring-highlight-current-entry t
1190 browse-kill-ring-highlight-inserted-item 'pulse
1191 browse-kill-ring-separator " ")
1192 (:hook #'form-feed-mode))
1193
1194(setup (:straight burly)
1195 (:require burly +burly)
1196 (:global "C-x C-c" #'+burly-save-then-close-frame-remembering))
1197
1198(setup (:straight (cape :host github :repo "minad/cape"))
1199 (let
1200 ;; All available cape capfs listed here. Add them to the front since
1201 ;; they're reversed with `add-to-list'.
1202 ((append-fns '(cape-file
1203 cape-dabbrev
1204 cape-keyword))
1205 (remove-fns '(cap-abbrev
1206 cape-ispell
1207 cape-dict)))
1208 (dolist (fn append-fns)
1209 (add-to-list 'completion-at-point-functions fn :append))
1210 (dolist (fn remove-fns)
1211 (setq completion-at-point-functions
1212 (delete fn completion-at-point-functions)))
1213 ;; Fix position of t
1214 (when (memq t completion-at-point-functions)
1215 (setq completion-at-point-functions
1216 (append (delq t completion-at-point-functions)
1217 '(t))))))
1218
1219(setup (:straight circe)
1220 (:require _circe
1221 +circe)
1222 ;; (:also-load circe-chanop)
1223 ;; (+ensure-after-init (lambda () (defalias 'irc '+irc "Start IRC.")))
1224
1225 ;; Formatting options
1226 ;; (:option
1227 ;; ;; Messages between users
1228 ;; circe-format-action (format (format "%%%ds* {nick} {body}"
1229 ;; (- +circe-left-margin 2))
1230 ;; " ")
1231 ;; circe-format-say (format "{nick:%1$d.%1$ds} | {body}"
1232 ;; (- +circe-left-margin 3))
1233 ;; circe-format-self-action circe-format-action
1234 ;; circe-format-self-say (replace-regexp-in-string "|" ">" circe-format-say)
1235 ;; circe-format-notice (format "-{nick:%1$d.%1$ds}---{body}"
1236 ;; (- +circe-left-margin 4))
1237 ;; circe-format-message (format (format "%%%ds@ *{nick}* {body}"
1238 ;; (- +circe-left-margin 2))
1239 ;; " ")
1240 ;; circe-format-message-action (replace-regexp-in-string "@" "*"
1241 ;; circe-format-message)
1242 ;; circe-format-self-message (format (format "%%%ds> *{chattarget}* {body}"
1243 ;; (- +circe-left-margin 2))
1244 ;; " ")
1245 ;; ;; Meta messages
1246 ;; circe-format-server-channel-creation-time (+circe-format-meta
1247 ;; (concat "Channel {channel}"
1248 ;; " created on {date}") t)
1249 ;; circe-format-server-ctcp (+circe-format-meta
1250 ;; (concat "CTCP PING request to {target} from"
1251 ;; " {userhost}: {body}"))
1252 ;; circe-format-server-ctcp-ping-reply (+circe-format-meta
1253 ;; (concat
1254 ;; "CTCP PING reply to {target} from"
1255 ;; " {userhost}: {body}"))
1256 ;; circe-format-server-part (+circe-format-meta "PART {channel}: {reason}")
1257 ;; circe-format-server-quit (+circe-format-meta "QUIT: {reason}")
1258 ;; circe-format-server-quit-channel (+circe-format-meta
1259 ;; "QUIT {channel}: {reason}")
1260 ;; circe-format-server-join (+circe-format-meta "JOIN: {userinfo}")
1261 ;; circe-format-server-join-in-channel (+circe-format-meta
1262 ;; "JOIN {channel}: {userinfo}")
1263 ;; circe-format-server-lurker-activity (+circe-format-meta
1264 ;; "(JOINED {joindelta} ago)")
1265 ;; circe-format-server-message (+circe-format-meta "{body}" t)
1266 ;; circe-fromat-server-mode-change (+circe-format-meta
1267 ;; (concat "MODE: {target} {change}"
1268 ;; " by {setter} ({userhost})") t)
1269 ;; circe-format-server-netmerge (+circe-format-meta
1270 ;; (concat "NETMERGE: {split} at {date}"
1271 ;; " (/WL to see who's still missing)") t)
1272 ;; circe-format-server-netsplit (+circe-format-meta
1273 ;; (concat "NETSPLIT: {split}"
1274 ;; " (/WL to see who left)") t)
1275 ;; circe-format-server-nick-change (+circe-format-meta
1276 ;; "NICK WAS {old-nick} ({userhost})"
1277 ;; "new-nick")
1278 ;; circe-format-server-nick-regain (+circe-format-meta
1279 ;; "NICK REGAINED: {old-nick} ({userhost})"
1280 ;; "new-nick")
1281 ;; circe-format-server-notice (+circe-format-meta "-SERVER NOTICE- {body}" t)
1282 ;; circe-format-server-topic-time (+circe-format-meta
1283 ;; "TOPIC SET BY {setter} on {topic-date}")
1284 ;; circe-format-server-topic-time-for-channel (+circe-format-meta
1285 ;; (concat
1286 ;; "TOPIC ({channel}) SET BY"
1287 ;; " {setter} on {topic-date}"))
1288 ;; circe-format-server-whois-idle (+circe-format-meta "IDLE FOR {idle-duration}"
1289 ;; "whois-nick")
1290 ;; circe-format-server-whois-idle-with-signon (+circe-format-meta
1291 ;; (concat
1292 ;; "IDLE FOR {idle-duration}"
1293 ;; " (signon: {signon-date})")
1294 ;; "whois-nick")
1295 ;; circe-format-server-rejoin (+circe-format-meta
1296 ;; (concat "REJOIN: {userinfo} "
1297 ;; "after {departuredelta}"))
1298 ;; circe-format-server-topic (+circe-format-meta "TOPIC: {new-topic}")
1299 ;; circe-prompt-string (format (format "%%%ds> "
1300 ;; (- +circe-left-margin 2))
1301 ;; " "))
1302
1303 ;; (:option +circe-server-buffer-action (lambda (buf)
1304 ;; (message "Connected to %s" buf))
1305 ;; +circe-network-inhibit-autoconnect _circe-network-inhibit-autoconnect
1306 ;; circe-network-options _circe-network-options
1307 ;; circe-color-nicks-everywhere t
1308 ;; circe-default-part-message "See You, Space Cowpokes . . ."
1309 ;; circe-default-user user-real-login-name
1310 ;; circe-reduce-lurker-spam t
1311 ;; circe-server-auto-join-default-type :after-auth)
1312 ;; (:bind "C-c C-p" #'circe-command-PART
1313 ;; "C-c C-t" #'+circe-current-topic
1314 ;; "C-l" #'lui-track-jump-to-indicator
1315 ;; "C-<return>" #'+circe-chat@set-prompt)
1316
1317 ;; XXX: this doesn't quite work right.
1318 ;; (advice-add #'circe-command-PART :after #'+circe-kill-buffer)
1319 ;; (advice-add #'circe-command-QUIT :after #'+circe-quit@kill-buffer)
1320 ;; (advice-add #'circe-command-GQUIT :after #'+circe-gquit@kill-buffer)
1321
1322 ;; (:with-mode circe-chat-mode
1323 ;; (:local-set lui-input-function #'+lui-filter
1324 ;; +modeline-position-function #'ignore)
1325 ;; (:hook #'enable-circe-color-nicks
1326 ;; #'enable-circe-new-day-notifier
1327 ;; #'+circe-chat@set-prompt
1328 ;; ;; Filters
1329 ;; ;;#'+circe-F/C-mode
1330 ;; ;; For some reason `+circe-shorten-url-mode' won't work right out of
1331 ;; ;; the gate.
1332 ;; ;;(lambda () (run-at-time 0.25 nil #'+circe-shorten-url-mode))
1333 ;; )
1334 ;; (:bind "C-c C-s" #'circe-command-SLAP))
1335
1336 ;; (:with-mode lui-mode
1337 ;; (:option lui-fill-column (+ fill-column +circe-left-margin)
1338 ;; lui-fill-type nil
1339 ;; lui-max-buffer-size (+bytes 10 :kb)
1340 ;; lui-time-stamp-position 'right-margin
1341 ;; lui-time-stamp-format "| %H:%M"
1342 ;; lui-track-behavior 'before-switch-to-buffer
1343 ;; lui-track-indicator 'bar
1344 ;; lui-fill-remove-face-from-newline nil
1345 ;; lui-formatting-list `((,(+lui-make-formatting-list-rx "*")
1346 ;; 1 lui-strong-face)
1347 ;; (,(+lui-make-formatting-list-rx "_")
1348 ;; 1 lui-emphasis-face)
1349 ;; (,(+lui-make-formatting-list-rx "/")
1350 ;; 1 lui-emphasis-face))
1351 ;; lui-autopaste-function
1352 ;; (defun +0x0-upload-string (string)
1353 ;; "Upload a string using 0x0."
1354 ;; (with-temp-buffer
1355 ;; (insert string)
1356 ;; (0x0-upload-text (0x0--choose-server)))
1357 ;; (current-kill 0)))
1358 ;; (add-to-list '+pulse-location-commands #'lui-track-jump-to-indicator)
1359 ;; (:face 'lui-track-bar '((t ( :height 10
1360 ;; :underline ( :color foreground-color
1361 ;; :style line
1362 ;; :position line)
1363 ;; :extend t :inhert (default)))))
1364 ;; (:hook #'visual-line-mode
1365 ;; #'enable-lui-track
1366 ;; #'visual-fill-column-mode
1367 ;; #'enable-lui-autopaste
1368 ;; (defun turn-off-+nyan-mode () (+nyan-local-mode -1))
1369 ;; (defun turn-off-electric-pair-mode () (electric-pair-mode -1)))
1370 ;; (:local-set fringes-outside-margins t
1371 ;; right-margin-width (length lui-time-stamp-format)
1372 ;; scroll-margin 0
1373 ;; scroll-step 1
1374 ;; word-wrap t
1375 ;; wrap-prefix (+string-repeat +circe-left-margin " ")
1376 ;; line-number-mode nil
1377 ;; column-number-mode nil
1378 ;; file-percentage-mode nil
1379 ;; visual-fill-column-extra-text-width
1380 ;; (cons +circe-left-margin 0)))
1381
1382 (tracking-mode +1)
1383 (:with-mode tracking-mode
1384 (:option tracking-position 'before-modes)
1385 (:bind "C-c C-SPC" (lambda () (interactive)
1386 (if (and +tracking-hide-when-org-clocking
1387 (fboundp 'org-clocking-p)
1388 (org-clocking-p))
1389 (message "Bro, get back to work!")
1390 (call-interactively #'tracking-next-buffer))))
1391 (add-to-list 'mode-line-misc-info
1392 '(tracking-mode
1393 tracking-mode-line-buffers)))
1394
1395 ;; (with-eval-after-load 'topsy
1396 ;; (:option (append topsy-mode-functions)
1397 ;; '(circe-channel-mode . +circe-current-topic)))
1398
1399 ;; (with-eval-after-load 'circe-color-nicks
1400 ;; (add-hook 'modus-themes-after-load-theme-hook #'circe-nick-color-reset))
1401 ;; (add-hook 'kill-emacs-hook #'+circe-quit-all@kill-emacs)
1402 )
1403
1404(setup (:straight (clean-kill-ring :host github
1405 :repo "NicholasBHubbard/clean-kill-ring.el"))
1406 (:require)
1407 (:option clean-kill-ring-prevent-duplicates t)
1408 (clean-kill-ring-mode +1))
1409
1410(setup (:straight clhs))
1411
1412(setup (:straight consult)
1413 (+with-ensure-after-init
1414 (:require consult +consult))
1415 ;; from Consult wiki
1416 (:option register-preview-delay 0
1417 register-preview-function #'consult-register-format
1418 xref-show-xrefs-function #'consult-xref
1419 xref-show-definitions-function #'consult-xref
1420 tab-always-indent 'complete
1421 completion-in-region-function #'consult-completion-in-region
1422 )
1423 (:with-mode minibuffer-mode
1424 (:local-set completion-in-region-function #'consult-completion-in-region))
1425 (advice-add #'register-preview :override #'consult-register-window) 46 (advice-add #'register-preview :override #'consult-register-window)
1426 (dolist (binding '(;; C-c bindings (mode-specific-map) 47 (define-keys (current-global-map)
1427 ("C-c h" . consult-history) 48 ;; C-c bindings (mode-specific-map)
1428 ("C-c m" . consult-mode-command) 49 "C-c h" #'consult-history
1429 ("C-c b" . consult-bookmark) 50 "C-c m" #'consult-mode-command
1430 ("C-c k" . consult-kmacro) 51 "C-c b" #'consult-bookmark
1431 ;; C-x bindings (ctl-x-map) 52 "C-c k" #'consult-kmacro
1432 ("C-x M-:" . consult-complex-command) 53 ;; C-x bindings (ctl-x-map)
1433 ("<f2>" . consult-buffer) 54 "C-x M-:" #'consult-complex-command
1434 ("C-x b" . consult-buffer) 55 "<f2>" #'consult-buffer
1435 ("C-x 4 b" . consult-buffer-other-window) 56 "C-x b" #'consult-buffer
1436 ("C-x 5 b" . consult-buffer-other-frame) 57 "C-x 4 b" #'consult-buffer-other-window
1437 ;; Custom M-# bindings for fast register access 58 "C-x 5 b" #'consult-buffer-other-frame
1438 ("M-#" . consult-register-load) 59 ;; Custom M-# bindings for fast register access
1439 ("M-'" . consult-register-store) 60 "M-#" #'consult-register-load
1440 ("C-M-#" . consult-register) 61 "M-'" #'consult-register-store
1441 ;; Other custom bindings 62 "C-M-#" #'consult-register
1442 ("M-y" . consult-yank-pop) 63 ;; Other custom bindings
1443 ;;("<f1> a" . consult-apropos) 64 "M-y" #'consult-yank-pop
1444 ;; M-g bindings (goto-map) 65 ;;("<f1> a" . consult-apropos)
1445 ("M-g e" . consult-compile-error) 66 ;; M-g bindings (goto-map)
1446 ("M-g f" . consult-flymake) ; or consult-flycheck 67 "M-g e" #'consult-compile-error
1447 ("M-g g" . consult-goto-line) 68 "M-g f" #'consult-flymake ; or consult-flycheck
1448 ("M-g M-g" . consult-goto-line) 69 "M-g g" #'consult-goto-line
1449 ("M-g o" . consult-outline) ; or consult-org-heading 70 "M-g M-g" #'consult-goto-line
1450 ("M-g m" . consult-mark) 71 "M-g o" #'consult-outline ; or consult-org-heading
1451 ("M-g k" . consult-global-mark) 72 "M-g m" #'consult-mark
1452 ("M-g i" . consult-imenu) 73 "M-g k" #'consult-global-mark
1453 ("M-g M-i" . consult-imenu) 74 "M-g i" #'consult-imenu
1454 ("M-g I" . consult-imenu-multi) 75 "M-g M-i" #'consult-imenu
1455 ;; M-s bindings (search-map) 76 "M-g I" #'consult-imenu-multi
1456 ("M-s f" . consult-find) 77 ;; M-s bindings (search-map)
1457 ("M-s F" . consult-locate) 78 "M-s f" #'consult-find
1458 ("M-s g" . consult-grep) 79 "M-s F" #'consult-locate
1459 ("M-s G" . consult-git-grep) 80 "M-s g" #'consult-grep
1460 ("M-s r" . consult-ripgrep) 81 "M-s G" #'consult-git-grep
1461 ("M-s l" . consult-line) 82 "M-s r" #'consult-ripgrep
1462 ("M-s L" . consult-line-multi) 83 "M-s l" #'consult-line
1463 ("M-s m" . consult-multi-occur) 84 "M-s L" #'consult-line-multi
1464 ("M-s k" . consult-keep-lines) 85 "M-s m" #'consult-multi-occur
1465 ("M-s u" . consult-focus-lines) 86 "M-s k" #'consult-keep-lines
1466 ;; Isearch integration 87 "M-s u" #'consult-focus-lines
1467 ("M-s e" . consult-isearch-history))) 88 ;; Isearch integration
1468 (global-set-key (kbd (car binding)) (cdr binding))) 89 "M-s e" #'consult-isearch-history)
1469 (with-eval-after-load 'isearch-mode 90 (eval-after isearch-mode
1470 (dolist (binding '(("M-e" . consult-isearch-history) 91 (define-keys isearch-mode-map
1471 ("M-s e" . consult-isearch-history) 92 "M-e" #'consult-isearch-history
1472 ("M-s l" . consult-line) 93 "M-s e" #'consult-isearch-history
1473 ("M-s L" . consult-line-multi))) 94 "M-s l" #'consult-line
1474 (define-key isearch-mode-map (car binding) (cdr binding)))) 95 "M-s L" #'consult-line-multi))
1475 (:+menu "b" #'consult-buffer 96 (eval-after org
1476 "f" #'find-file) 97 (define-key org-mode-map (kbd "M-g o") #'consult-org-heading)))
1477 (:bind-into org 98
1478 "M-g o" #'consult-org-heading) 99(yoke orderless "https://github.com/oantolin/orderless"
1479 (advice-add 'consult-yank-pop :after #'+yank@indent) 100 (require 'orderless)
1480 (+with-eval-after-loads (consult +consult) 101 (setq completion-styles '(substring orderless basic)
1481 (:option consult-narrow-key "<" 102 completion-category-defaults nil
1482 consult-project-root-function '+consult-project-root) 103 completion-category-overrides '((file (styles basic partial-completion)))
1483 (add-to-list 'consult-buffer-filter 104 orderless-component-separator #'orderless-escapable-split-on-space))
1484 (rx "*" (or "scratch" "text") "*")) 105
1485 (consult-customize consult-theme 106(yoke vertico "https://github.com/minad/vertico"
1486 :preview-key '(:debounce 0.2 any)) 107 (require 'vertico)
1487 (consult-customize consult-ripgrep consult-git-grep consult-grep 108 (setq resize-mini-windows 'grow-only
1488 consult-bookmark consult-recent-file consult-xref 109 vertico-count-format nil
1489 consult--source-recent-file 110 vertico-cycle t)
1490 consult--source-project-recent-file 111 (vertico-mode))
1491 consult--source-bookmark consult-buffer 112
1492 :preview-key (kbd "M-,")) 113(yoke marginalia "https://github.com/minad/marginalia/"
1493 (consult-history-to-modes ((minibuffer-local-map . nil) 114 (marginalia-mode))
1494 (shell-mode-map . shell-mode-hook) 115
1495 (term-mode-map . term-mode-hook) 116(yoke slime "https://github.com/slime/slime"
1496 (term-raw-map . term-mode-hook) 117 ;; r7rs-swank
1497 (comint-mode-map . comint-mode-hook) 118 (let ((r7rsloc (yoke-git "https://github.com/ecraven/r7rs-swank")))
1498 (sly-mrepl-mode-map . sly-mrepl-hook))) 119 (cond
1499 (with-eval-after-load 'orderless 120 ((executable-find "chibi-scheme")
1500 (:option consult--regexp-compiler #'consult--orderless-regexp-compiler)))) 121 (defun chibi-scheme-start-swank (file encoding)
1501 122 (format "%S\n\n" `(start-swank ,file)))
1502(setup (:straight crux) 123 (setq slime-lisp-implementations
1503 ;; yes it's silly I have an addon to this addon. 124 (cons `(chibi-scheme
1504 (:require crux +crux) 125 ("chibi-scheme" ,(format "-A%s" r7rsloc)
1505 (:option crux-shell-func #'crux-eshell 126 "-m" "(chibi-swank)")
1506 crux-shell-buffer-name "eshell" 127 :init chibi-scheme-start-swank)
1507 +crux-default-date-format "%F") 128 (bound-and-true-p slime-lisp-implementations)))))))
1508 (:global "C-o" #'crux-smart-open-line 129
1509 "C-x 4 t" #'crux-transpose-windows 130(yoke puni "https://github.com/amaikinono/puni"
1510 "M-w" #'+crux-kill-ring-save 131 (puni-global-mode)
1511 "C-k" #'+crux-kill-and-join-forward 132 (electric-pair-mode)
1512 "C-c d" #'+crux-insert-date-or-time) 133 (define-keys puni-mode-map
1513 (crux-with-region-or-buffer indent-region) 134 "C-)" #'puni-slurp-forward
1514 135 "C-(" #'puni-slurp-backward
1515 (el-patch-feature crux) 136 "C-}" #'puni-barf-forward
1516 (with-eval-after-load 'crux 137 "C-{" #'puni-barf-backward))
1517 (el-patch-defun crux-reopen-as-root () 138
1518 "Find file as root if necessary. 139(yoke hungry-delete "https://github.com/nflath/hungry-delete"
1519 140 (setq hungry-delete-chars-to-skip " \t"
1520 Meant to be used as `find-file-hook'. 141 hungry-delete-join-reluctantly nil)
1521 See also `crux-reopen-as-root-mode'." 142 (eval-after hungry-delete
1522 (unless (or 143 (add-to-list* 'hungry-delete-except-modes
1523 ;; This helps fix for `nov-mode', and possibly others. 144 'eshell-mode
1524 (el-patch-add (null buffer-file-name)) 145 'nim-mode
1525 (tramp-tramp-file-p buffer-file-name) 146 'python-mode))
1526 (equal major-mode 'dired-mode) 147 (defun +hungry-delete-or (hd-fn fn arg)
1527 (not (file-exists-p (file-name-directory buffer-file-name))) 148 (funcall (if (looking-back (format "[%s]" hungry-delete-chars-to-skip) arg)
1528 (file-writable-p buffer-file-name) 149 hd-fn
1529 (crux-file-owned-by-user-p buffer-file-name)) 150 fn)
1530 (crux-find-alternate-file-as-root buffer-file-name)))) 151 arg))
1531 (crux-reopen-as-root-mode +1)) 152 (define-keys puni-mode-map
1532 153 [remap puni-backward-delete-char]
1533(setup (:straight csv-mode)) 154 (defun puni@hungry-delete-backward (arg)
1534 155 (interactive "p")
1535(setup (:straight denote) 156 (+hungry-delete-or #'hungry-delete-backward
1536 (:option denote-directory (expand-file-name "~/var/notes"))) 157 #'puni-backward-delete-char
1537 158 arg))
1538(setup (:straight dictionary) 159 [remap puni-forward-delete-char]
1539 (:option dictionary-use-single-buffer t) 160 (defun puni@hungry-delete-forward (arg)
1540 (autoload 'dictionary-search "dictionary" 161 (interactive "p")
1541 "Ask for a word and search it in all dictionaries" t) 162 (+hungry-delete-or #'hungry-delete-forward
1542 (:hook #'reading-mode)) 163 #'puni-forward-delete-char
1543 164 arg)))
1544(setup (:straight diff-hl) 165 (global-hungry-delete-mode))
1545 (global-diff-hl-mode +1)) 166
1546 167(yoke cape "https://github.com/minad/cape"
1547(setup (:straight dired-git-info) 168 (defun cape-insinuate ()
1548 (:bind-into dired 169 (add-to-list* 'completion-at-point-functions
1549 ")" #'dired-git-info-mode)) 170 #'cape-dabbrev
1550 171 #'cape-file))
1551(setup (:straight dired-open) 172 (add-hook* '(text-mode-hook prog-mode-hook)
1552 (:load-after dired)) 173 #'cape-insinuate))
1553 174
1554(setup (:straight dired-rsync) 175(yoke minions "https://github.com/tarsius/minions"
1555 (:load-after dired) 176 (minions-mode))
1556 (:bind-into dired-mode
1557 "r" #'dired-rsync))
1558
1559(setup (:straight dired-subtree)
1560 (:load-after dired)
1561 (:bind-into dired
1562 "TAB" #'dired-subtree-cycle
1563 "i" #'dired-subtree-toggle))
1564
1565(setup (:straight (discord :host github
1566 :repo "davep/discord.el"
1567 :fork (:repo "duckwork/discord.el"))))
1568
1569(setup (:straight dumb-jump)
1570 (add-hook 'xref-backend-functions #'dumb-jump-xref-activate))
1571
1572(setup (:straight ebuku
1573 (executable-find "buku"))
1574 (:option ebuku-display-on-startup 'recent
1575 ebuku-recent-count 100))
1576
1577(setup (:straight edit-server)
1578 (:option edit-server-url-major-mode-alist `(("github\\.com" . ,(if (fboundp 'gfm-mode)
1579 #'gfm-mode
1580 #'markdown-mode))
1581 ("reddit\\.com" . markdown-mode)
1582 ("notabug\\.org" . markdown-mode)
1583 ("tildes\\.net" . markdown-mode)))
1584 (+with-ensure-after-init
1585 (edit-server-start)))
1586
1587(setup (:straight editorconfig)
1588 (:with-mode conf-mode
1589 (:file-match (rx ".editorconfig" eos)))
1590 (with-eval-after-load 'editorconfig
1591 (dolist (m '(emacs-lisp-mode
1592 lisp-mode
1593 scheme-mode))
1594 (add-to-list 'editorconfig-exclude-modes m)))
1595 (editorconfig-mode +1))
1596
1597(setup (:straight electric-cursor)
1598 (:option electric-cursor-alist '((overwrite-mode . hbar)
1599 (god-local-mode . box)
1600 (t . bar)))
1601 (electric-cursor-mode +1))
1602
1603;; (setup (:straight elfeed)
1604;; (:require +elfeed)
1605;; (+define-dir elfeed/ (sync/ "emacs/elfeed/" t))
1606;; (:option
1607;; elfeed-curl-program-name (executable-find "curl")
1608;; elfeed-use-curl elfeed-curl-program-name
1609;; elfeed-curl-extra-arguments '("--insecure")
1610;; elfeed-enclosure-default-dir (cl-loop for dir in '("~/var/download/"
1611;; "~/Downloads/")
1612;; if (file-exists-p dir)
1613;; return dir)
1614;; elfeed-search-filter "@10-days-ago +unread"
1615;; elfeed-search-trailing-width 24
1616;; elfeed-search-title-min-width 24
1617;; elfeed-search-title-max-width 78
1618;; elfeed-search-remain-on-entry t
1619;; elfeed-show-unique-buffers t
1620;; elfeed-db-directory (elfeed/ "db/" t))
1621;; (:+leader "f" #'elfeed "C-f" #'elfeed)
1622;; (advice-add #'elfeed-search-fetch :after #'beginning-of-buffer)
1623;; (:with-mode elfeed-search-mode
1624;; (:bind "&" #'+elfeed-search-browse-generic
1625;; "w" #'elfeed-search-yank
1626;; "y" nil
1627;; "a" #'+elfeed-show-mark-read-and-advance)
1628;; (:hook #'hl-line-mode)
1629;; ;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/hphfh4e/
1630;; (advice-add #'elfeed-search-update--force :after #'elfeed-db-save)
1631;; (advice-add #'elfeed :before #'elfeed-db-load))
1632;; (:with-mode elfeed-show-mode
1633;; (:bind "SPC" #'+elfeed-scroll-up-command
1634;; "S-SPC" #'+elfeed-scroll-down-command
1635;; "&" #'+elfeed-show-browse-generic
1636;; "RET" #'shr-browse-url
1637;; "w" #'elfeed-show-yank
1638;; "y" nil)
1639;; (:hook #'reading-mode)
1640;; (:option +elfeed--update-repeat (* 60 30) ; 1/2 hour
1641;; +elfeed--update-first-time 60))
1642;; (+elfeed-update-async-mode +1)
1643;; (add-hook '+elfeed-update-proceed-hook (defun non-work-hours? ()
1644;; "Return nil if during work hours, t otherwise."
1645;; (let* ((now (current-time))
1646;; (now* (decode-time now))
1647;; (work-start* (append '(0 0 8) (cdddr now*))) ; 8:00 AM
1648;; (work-end* (append '(0 0 18) (cdddr now*))) ; 6:00 PM
1649;; (work-start (encode-time work-start*))
1650;; (work-end (encode-time work-end*)))
1651;; (or (time-less-p now work-start)
1652;; (time-less-p work-end now))))))
1653
1654;; (setup (:straight elfeed-org)
1655;; (:also-load +org-capture)
1656;; (:option rmh-elfeed-org-files (list (elfeed/ "elfeed.org" t)))
1657;; (elfeed-org)
1658;; (+org-capture-templates-setf "f"
1659;; `("Feed" entry
1660;; (file+olp ,(car rmh-elfeed-org-files) "Feeds")
1661;; "* %? %^g")))
1662
1663;; (setup (:straight (elfeed-tube :host github :repo "karthink/elfeed-tube")
1664;; (or (executable-find "youtube-dl")
1665;; (executable-find "yt-dlp")))
1666;; (:straight (elfeed-tube-mpv :host github :repo "karthink/elfeed-tube"))
1667;; (:load-after elfeed)
1668;; (with-eval-after-load 'elfeed
1669;; (elfeed-tube-setup)
1670;; (:bind-into (elfeed-show-mode-map elfeed-search-mode-map)
1671;; "F" #'elfeed-tube-fetch
1672;; [remap save-buffer] #'elfeed-tube-save)
1673;; (:bind-into elfeed-show-mode-map
1674;; "C-c C-f" #'elfeed-tube-mpv-follow-mode
1675;; "C-c C-w" #'elfeed-tube-mpv-where)))
1676
1677(setup (:straight elpher)
1678 (:bind "l" #'elpher-back))
1679
1680(setup (:straight emacs-everywhere
1681 (cl-loop for prog in '("xclip" "xdotool" "xprop" "xwininfo")
1682 if (executable-find prog)
1683 return prog
1684 finally return nil)))
1685
1686(setup (:straight embark)
1687 (:require embark
1688 +embark)
1689 (:option prefix-help-command 'embark-prefix-help-command
1690 embark-keymap-prompter-key ";")
1691 (:+key "C-." #'embark-act
1692 "M-." #'embark-dwim
1693 "<f1> B" #'embark-bindings)
1694 (:with-map minibuffer-local-map
1695 (:bind "C-." #'embark-act
1696 "M-." #'embark-dwim))
1697 (:with-map embark-file-map
1698 (:bind "l" #'vlf)))
1699
1700(setup (:straight embark-consult)
1701 (:load-after consult embark)
1702 (add-hook 'embark-collect-mode-hook #'consult-preview-at-point-mode))
1703
1704(setup (:straight embrace)
1705 (dolist (mode '(LaTeX-mode org-mode ruby-mode))
1706 (add-hook (intern (format "%s-hook" mode))
1707 (intern (format "embrace-%s-hook" mode))))
1708 (:face 'embrace-help-pair-face '((t ( :inverse-video nil
1709 :inherit font-lock-keyword-face))))
1710 (:+key "C-," #'embrace-commander))
1711
1712(setup (:straight (ement :host github
1713 :repo "alphapapa/ement.el")
1714 ;; `plz' is a requirement, but isn't on an elpa.
1715 (setup (:straight (plz :host github
1716 :repo "alphapapa/plz.el"))
1717 t)))
1718
1719(setup (:straight epithet)
1720 (dolist (hook '(Info-selection-hook
1721 ;; eww-after-render-hook
1722 help-mode-hook
1723 occur-mode-hook))
1724 (add-hook hook #'epithet-rename-buffer))
1725 (if (boundp 'eww-auto-rename-buffer) ; Emacs 29
1726 (:option eww-auto-rename-buffer 'title)
1727 (add-hook 'eww-after-render-hook #'epithet-rename-buffer)))
1728
1729(setup (:straight eros)
1730 (:option eros-eval-result-prefix "; "
1731 eros-overlays-use-font-lock nil)
1732 (:hook-into emacs-lisp-mode
1733 lisp-interaction-mode))
1734
1735(setup (:straight eshell-bookmark)
1736 (add-hook 'eshell-mode-hook #'eshell-bookmark-setup))
1737
1738(setup (:straight eshell-syntax-highlighting)
1739 (:hook-into eshell-mode))
1740
1741(setup (:straight eshell-vterm
1742 :quit)
1743 (:load-after eshell)
1744 (defalias 'eshell/v 'eshell-exec-visual)
1745 (eshell-vterm-mode +1))
1746
1747(setup (:straight exec-path-from-shell
1748 (eq system-type 'gnu/linux))
1749 (require 'exec-path-from-shell)
1750 (dolist (var '("SSH_AUTH_SOCK"
1751 "SSH_AGENT_PID"
1752 "GPG_AGENT_INFO"
1753 "LANG"
1754 "LC_CTYPE"
1755 "XDG_CONFIG_HOME"
1756 "XDG_CONFIG_DIRS"
1757 "XDG_DATA_HOME"
1758 "XDG_DATA_DIRS"
1759 "XDG_CACHE_HOME"))
1760 (add-to-list 'exec-path-from-shell-variables var))
1761 (exec-path-from-shell-initialize))
1762
1763(setup (:straight expand-region)
1764 (:require expand-region +expand-region)
1765 (:option expand-region-fast-keys-enabled nil)
1766 (:+key "C-=" #'er/expand-region
1767 "C--" #'+er/contract-or-negative-argument))
1768
1769(setup (:straight fennel-mode)
1770 (with-eval-after-load 'apheleia
1771 (when-let ((fnlfmt (executable-find "fnlfmt")))
1772 (setf (alist-get 'fnlfmt apheleia-formatters) (list fnlfmt 'filepath))
1773 (setf (alist-get 'fennel-mode apheleia-mode-alist) 'fnlfmt))))
1774
1775(setup (:straight (filldent :host nil
1776 :repo "https://codeberg.org/acdw/filldent.el"))
1777 (:+key "M-q" #'filldent-unfill-toggle))
1778
1779(setup (:straight (flymake-chicken
1780 :host github
1781 :repo "chicken-contrib/flymake-chicken"))
1782 (add-hook 'scheme-mode-hook (defun +flymake-chicken-init ()
1783 (add-hook 'flymake-diagnostic-functions
1784 #'flymake-chicken-backend
1785 nil t))))
1786
1787(setup (:straight (flymake-collection :host github
1788 :repo "mohkale/flymake-collection"))
1789 (+ensure-after-init #'flymake-collection-hook-setup))
1790
1791(setup (:straight (flyspell-correct
1792 :fork (:host github :repo "duckwork/flyspell-correct"
1793 :branch "metadata-category")))
1794 (:load-after flyspell)
1795 (:also-load +flyspell-correct)
1796 (:option flyspell-correct--cr-key ";")
1797 (:bind-into flyspell
1798 "C-;" #'flyspell-correct-wrapper
1799 "<f7>" #'+flyspell-correct-buffer))
1800
1801(setup (:straight focus)
1802 (:require)
1803 (add-hook 'modus-themes-after-load-theme-hook
1804 (defun focus-update@after-modus-load ()
1805 (modus-themes-with-colors
1806 (:face 'focus-unfocused `((t ( :foreground ,fg-inactive
1807 :background ,bg-inactive
1808 :weight normal
1809 :slant normal
1810 :extend t)))))))
1811 ;; XXX: This doesn't work, because notmuch overlays shit on the buffer
1812 (setf (alist-get 'notmuch-show-mode focus-mode-to-thing)
1813 'notmuch-message)
1814 (:hook-into notmuch-show-mode))
1815
1816(setup (:straight (forge :host github :repo "magit/forge")
1817 (eq system-type 'gnu/linux))
1818 (:quit) ; XXX: Somehow missing compat-26
1819 (add-to-list 'forge-alist
1820 '("tildegit.org" "tildegit.org/api/v1" "tildegit.org"
1821 forge-gitea-repository)))
1822
1823(setup (:straight form-feed)
1824 ;; See also `page-break-lines', further down.
1825 (:face 'form-feed-line '((t (:strike-through t))))
1826 (global-form-feed-mode +1))
1827
1828(setup (:straight (frowny :host nil
1829 :repo "https://codeberg.org/acdw/frowny.el"))
1830 (:option frowny-eyes (rx (any ":=") (opt "'") (? "-")))
1831 (add-to-list 'frowny-inhibit-modes 'vterm-mode)
1832 (global-frowny-mode +1))
1833
1834;; (setup (:straight (geiser
1835;; :type git
1836;; :flavor melpa
1837;; :files ("elisp/*.el" "doc/*" "geiser-pkg.el")
1838;; :pre-build ("make" "-Cdoc" "geiser.info")
1839;; :host gitlab
1840;; :repo "emacs-geiser/geiser"))
1841;; (dolist (pkg '( geiser-chicken geiser-guile
1842;; macrostep-geiser
1843;; scheme-complete))
1844;; (straight-use-package pkg))
1845;; (:require +chicken)
1846;; (+chicken-indentation-insinuate)
1847;; (:with-mode scheme-mode
1848;; (:file-match (rx ".scm" eos)))
1849;; (setf (alist-get "\\.scm\\'" auto-insert-alist nil nil #'equal)
1850;; '(insert "#!/bin/sh\n#| -*- scheme -*-\nexec csi -s $0 \"$@\"\n|#\n"))
1851;; ;; (when-let ((scmfmt-exe (executable-find "scmfmt")))
1852;; ;; (with-eval-after-load 'apheleia
1853;; ;; (setf (alist-get 'scmfmt apheleia-formatters) (list scmfmt-exe))
1854;; ;; (setf (alist-get 'scheme-mode apheleia-mode-alist) 'scmfmt)))
1855;; )
1856
1857(setup (:straight (ghelp :repo "https://github.com/casouri/ghelp"))
1858 ;;; XXX: set this up!
1859 (:require))
1860
1861(setup (:straight (git-modes :host github :repo "magit/git-modes"))
1862 (:require git-modes))
1863
1864(setup (:straight god-mode
1865 :quit "I could never get the hang of this.")
1866 (setq god-mode-enable-function-key-translation nil)
1867 (:require god-mode
1868 +god-mode)
1869 (:+key "C-M-g" #'god-mode-all)
1870 (:with-mode god-local-mode
1871 (:bind "i" #'+god-mode-insert
1872 "a" nil)))
1873
1874(setup (:straight helpful)
1875 (:+key "<f1> f" #'helpful-callable
1876 "<f1> v" #'helpful-variable
1877 "<f1> k" #'helpful-key
1878 "<f1> ." #'helpful-at-point)
1879 ;; Load faster on first invocation by pre-loading a slow function
1880 ;; (see https://github.com/Wilfred/helpful/issues/236)
1881 (run-with-idle-timer 1 nil (lambda ()
1882 (require 'info-look)
1883 (info-lookup-setup-mode 'symbol 'emacs-lisp-mode))))
1884
1885(setup (:straight (hippie-completing-read :host nil
1886 :repo "https://codeberg.org/acdw/hippie-completing-read.el"))
1887 (:+key "M-/" #'hippie-completing-read))
1888
1889(setup (:straight hungry-delete)
1890 (:option hungry-delete-chars-to-skip " \t"
1891 hungry-delete-join-reluctantly nil)
1892 (+with-ensure-after-init
1893 (dolist (m '(eshell-mode
1894 nim-mode
1895 python-mode))
1896 (add-to-list 'hungry-delete-except-modes m)))
1897 (:bind-into paredit
1898 ;; I define these functions here because they really require both packages
1899 ;; to make any sense. So, would I put them in `+hungry-delete' or
1900 ;; `+paredit' ? There's no satisfactory answer.
1901 [remap paredit-backward-delete]
1902 (defun acdw/paredit-hungry-delete-backward (arg)
1903 (interactive "P")
1904 (if (looking-back "[ \t]" 1)
1905 (hungry-delete-backward (or arg 1))
1906 (paredit-backward-delete arg)))
1907 [remap paredit-forward-delete]
1908 (defun acdw/paredit-hungry-delete-forward (arg)
1909 (interactive "P")
1910 (if (looking-at "[ \t]")
1911 (hungry-delete-forward (or arg 1))
1912 (paredit-forward-delete arg))))
1913 (global-hungry-delete-mode +1))
1914
1915(setup (:straight i3wm-config-mode
1916 (executable-find "i3")))
1917
1918(setup (:straight info+)
1919 (:load-after info)
1920 (:option Info-fontify-isolated-quote-flag nil
1921 Info-breadcrumbs-in-mode-line-mode nil
1922 Info-fontify-emphasis-flag nil
1923 Info-fontify-quotations nil
1924 Info-saved-history-file (.etc "info-history"))
1925 (add-hook 'Info-mode-hook #'Info-variable-pitch-text-mode))
1926
1927(setup (:straight isearch-mb)
1928 ;; This complicatedness is an attempt to make it easier to add and
1929 ;; subtract `isearch-mb' bindings using the suggestions in the
1930 ;; project's README.
1931 (:load-after consult anzu)
1932 (:when-loaded
1933 (dolist (spec '((isearch-mb--with-buffer
1934 ("M-e" . consult-isearch)
1935 ("C-o" . loccur-isearch))
1936 (isearch-mb--after-exit
1937 ("M-%" . anzu-isearch-query-replace)
1938 ("M-s l" . consult-line))))
1939 (let ((isearch-mb-list (car spec))
1940 (isearch-mb-binds (cdr spec)))
1941 (dolist (cell isearch-mb-binds)
1942 (let ((key (car cell))
1943 (command (cdr cell)))
1944 (when (fboundp command)
1945 (add-to-list isearch-mb-list command)
1946 (define-key isearch-mb-minibuffer-map (kbd key) command)))))))
1947 (isearch-mb-mode +1))
1948
1949(setup (:straight (jabber :host nil
1950 :repo "https://codeberg.org/emacs-jabber/emacs-jabber"
1951 :files ("*.el" "*.texi"
1952 ("jabber-fallback-lib"
1953 "jabber-fallback-lib/hexrgb.el"
1954 "jabber-fallback-lib/srv.el"
1955 "jabber-fallback-lib/fsm.el")
1956 "jabber-pkg.el")
1957 :fork ( :host nil
1958 :repo "https://codeberg.org/acdw/emacs-jabber")))
1959 (:require jabber +jabber)
1960 ;; (:option +jabber-pre-prompt "~ ~ ~\n")
1961 (add-to-list 'jabber-post-connect-hooks 'jabber-enable-carbons)
1962 (:option jabber-account-list '(("acdw@hmm.st"))
1963 jabber-groupchat-buffer-format "%n"
1964 jabber-chat-buffer-format "%n"
1965 jabber-muc-private-buffer-format "%n(%g)"
1966 jabber-muc-header-line-format '("" jabber-muc-topic)
1967 jabber-activity-show-p #'ignore
1968 jabber-muc-decorate-presence-patterns
1969 '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
1970 ("." . jabber-muc-presence-dim))
1971 jabber-muc-colorize-foreign nil ; doesn't match my color theme
1972 jabber-groupchat-prompt-format "[%t] %n> "
1973 jabber-chat-local-prompt-format "[%t] %n> "
1974 jabber-chat-foreign-prompt-format "[%t] %n> "
1975 ;; jabber-chat-foreign-prompt-format
1976 ;; (concat +jabber-pre-prompt
1977 ;; "%n\n"
1978 ;; (make-string +jabber-ws-prefix
1979 ;; ?\ ))
1980 ;; jabber-chat-local-prompt-format
1981 ;; (concat +jabber-pre-prompt
1982 ;; "%n\n"
1983 ;; (make-string +jabber-ws-prefix
1984 ;; ?\ ))
1985 ;; jabber-groupchat-prompt-format
1986 ;; (concat +jabber-pre-prompt
1987 ;; "%n\n"
1988 ;; (make-string +jabber-ws-prefix
1989 ;; ?\ ))
1990 jabber-auto-reconnect t)
1991 (add-hook 'modus-themes-after-load-theme-hook
1992 (defun jabber-chat@after-modus-themes-load ()
1993 (modus-themes-with-colors
1994 (:face 'jabber-chat-prompt-foreign `((t (:foreground ,red)))
1995 'jabber-chat-prompt-local `((t (:foreground ,blue)))
1996 'jabber-chat-prompt-system `((t (:foreground ,green)))))
1997 (setq jabber-muc-nick-value (pcase (frame--current-backround-mode (selected-frame))
1998 ('light 0.5)
1999 ('dark 1.0)))
2000 (+mapc-some-buffers #'+jabber-colors-update
2001 (lambda () (derived-mode-p 'jabber-chat-mode
2002 'jabber-roster-mode
2003 'jabber-activity-mode
2004 'jabber-browse-mode)))))
2005 (dolist (mode '(jabber-chat-mode
2006 jabber-browse-mode
2007 jabber-roster-mode
2008 jabber-console-mode))
2009 (let ((hook (intern (format "%s-hook" mode))))
2010 (add-hook hook #'visual-fill-column-mode)
2011 (add-hook hook (defun +electric-pair-disable-local-mode () (electric-pair-local-mode -1)))
2012 ;; (add-hook hook (lambda () (setq-local wrap-prefix " ")))
2013 ))
2014 (with-eval-after-load 'tracking
2015 (add-to-list 'tracking-ignored-buffers "discuss@conference.soprani.ca"))
2016 (:with-mode jabber-chat-mode
2017 (:local-set +modeline-position-function (lambda ()
2018 (cond
2019 ((string-match-p "hmm@" (buffer-name))
2020 "🤔 ")))
2021 file-percentage-mode nil
2022 ;; wrap-prefix (make-string +jabber-ws-prefix ?\ )
2023 comment-start nil)
2024 (:bind "C-c C-t" #'jabber-muc-set-topic))
2025 (:+leader "C-j" jabber-global-keymap)
2026 (advice-add 'jabber-activity-add :after #'+jabber-tracking-add)
2027 (advice-add 'jabber-activity-add-muc :after #'+jabber-tracking-add-muc)
2028 ;;; Alerting hooks --- remove echo messages
2029 (remove-hook 'jabber-alert-muc-hooks 'jabber-muc-echo)
2030 (remove-hook 'jabber-alert-presence-hooks 'jabber-presence-echo))
2031
2032(setup (:straight (keepassxc-shim :host nil
2033 :repo "https://codeberg.org/acdw/keepassxc-shim.el"))
2034 (keepassxc-shim-activate))
2035
2036(setup (:straight keychain-environment
2037 (executable-find "keychain"))
2038 (keychain-refresh-environment))
2039
2040(setup (:straight lacarte)
2041 (:+key "<f10>" #'lacarte-execute-menu-command))
2042
2043(setup (:straight (lin :host nil
2044 :repo "https://git.sr.ht/~protesilaos/lin"))
2045 (:require)
2046 (lin-global-mode +1))
2047
2048(setup (:straight link-hint)
2049 (:require +link-hint)
2050 (+link-hint-open-secondary-setup)
2051 (+link-hint-open-chrome-setup)
2052 (:option link-hint-avy-style 'at-full
2053 link-hint-avy-all-windows t)
2054 (:+key "M-l" +link-hint-map)
2055 (:with-map +link-hint-map
2056 (:bind "M-l" #'+link-hint-open-link "l" #'+link-hint-open-link
2057 "M-o" #'+link-hint-open-secondary "o" #'+link-hint-open-secondary
2058 "M-m" #'link-hint-open-multiple-links "m" #'link-hint-open-multiple-links
2059 "M-w" #'link-hint-copy-link "w" #'link-hint-copy-link
2060 "M-c" #'+link-hint-open-chrome "c" #'+link-hint-open-chrome)))
2061
2062(setup (:straight lua-mode)
2063 (:file-match (rx ".lua" eos)))
2064
2065(setup (:straight (machine
2066 :host nil
2067 :repo "https://codeberg.org/acdw/machine.el"))
2068 (+with-ensure-after-init ; So that they override anything here.
2069 ;; Emoji fonts
2070 (let ((ffl (font-family-list))
2071 (emoji-fonts '("Noto Color Emoji"
2072 "Noto Emoji"
2073 "Segoe UI Emoji"
2074 "Apple Color Emoji"
2075 "FreeSans"
2076 "FreeMono"
2077 "FreeSerif"
2078 "Unifont"
2079 "Symbola")))
2080 (dolist (font emoji-fonts)
2081 (when (member font ffl)
2082 (set-fontset-font t 'symbol (font-spec :family font) nil :append))))
2083 (machine-settings-load)))
2084
2085(setup (:straight macrostep)
2086 (:require macrostep)
2087 (dolist (m '(emacs-lisp-mode-map
2088 lisp-interaction-mode-map))
2089 (define-key (symbol-value m) (kbd "C-c e") #'macrostep-expand)))
2090
2091(setup (:straight (magit :host github :repo "magit/magit"
2092 :build (:not compile))
2093 (:straight (transient :host github :repo "magit/transient"
2094 :build (:not compile))))
2095 (autoload 'transient--with-suspended-override "transient"))
2096
2097(setup (:straight marginalia)
2098 (marginalia-mode +1))
2099
2100(setup (:straight markdown-mode)
2101 (:option markdown-hide-markup nil)
2102 (:file-match (rx (or ".md" ".markdown" ".mdown") eos))
2103 (with-eval-after-load 'visual-fill-column
2104 (:hook #'visual-fill-column-mode))
2105 (with-eval-after-load 'apheleia
2106 (when-let ((mdfmt-exe (executable-find "markdownfmt")))
2107 (setf (alist-get 'markdownfmt apheleia-formatters) (list mdfmt-exe))
2108 (setf (alist-get 'markdown-mode apheleia-mode-alist) 'markdownfmt)
2109 (setf (alist-get 'gfm-mode apheleia-mode-alist) 'markdownfmt))))
2110
2111(setup (:straight (mastodon
2112 :fork (:host nil :repo "https://codeberg.org/acdw/mastodon.el")))
2113 (:option mastodon-instance-url "https://tiny.tilde.website"
2114 mastodon-active-user "acdw"
2115 mastodon-client--token-file (.etc "mastodon.plstore")
2116 mastodon-auth-source-file (seq-some (lambda (i)
2117 (when (and (stringp i)
2118 (file-exists-p i))
2119 i))
2120 auth-sources)
2121 mastodon-tl--show-avatars t
2122 mastodon-tl--enable-proportional-fonts nil)
2123 (:hook #'mastodon-async-mode
2124 #'variable-pitch-mode
2125 #'hl-line-mode
2126 #'lin-mode))
2127
2128(setup (:straight minions)
2129 (minions-mode +1))
2130
2131(setup (:straight (mode-line-bell
2132 :host github :repo "purcell/mode-line-bell"
2133 :fork (:host github :repo "duckwork/mode-line-bell"
2134 :branch "remap-face")))
2135 ;; This is still, annoyingly, not quite working right.
2136 (:face 'mode-line-bell '((t (:inherit mode-line-highlight))))
2137 (:option mode-line-bell-flash-time 0.1)
2138 (mode-line-bell-mode +1))
2139
2140(setup (:straight (modus-themes
2141 :host nil
2142 :repo "https://git.sr.ht/~protesilaos/modus-themes"))
2143 (require 'modus-themes (.etc "straight/build/modus-themes/modus-themes"))
2144 (:option modus-themes-mixed-fonts t
2145 modus-themes-bold-constructs t
2146 modus-themes-italic-constructs t
2147 modus-themes-headings '((1 monochrome bold overline)
2148 (2 monochrome bold)
2149 (3 monochrome italic)
2150 (t monochrome)))
2151 (dotimes (facen-1 8)
2152 (let ((facen (1+ facen-1)))
2153 (custom-set-faces
2154 `(,(intern (format "org-level-%s" facen))
2155 ((t :inherit
2156 (,(intern (format "modus-themes-heading-%s" facen))
2157 fixed-pitch))
2158 :now)))))
2159 (:face 'modus-themes-tab-active '((t ( :bold nil)))
2160 'modus-themes-tab-inactive '((t ( :italic t))))
2161
2162 (define-advice modus-themes--current-theme (:around (fn &rest r))
2163 "Fix a \"nil is not a Modus theme\" error."
2164 (or (apply fn r)
2165 'modus-operandi))
2166
2167 ;; This needs to be after the themes are loaded, I think.
2168 (add-hook 'modus-themes-after-load-theme-hook
2169 (defun +modus-themes-mostly-monochrome ()
2170 "Set up mdous-themes to be mostly monochrome."
2171 ;; Major mode in the mode-line
2172 (modus-themes-with-colors
2173 (custom-set-faces
2174 `(font-lock-builtin-face
2175 ((,class :inherit modus-themes-bold
2176 :foreground unspecified)))
2177 `(font-lock-comment-face
2178 ((,class :inherit default
2179 :slant normal
2180 :height 1.0
2181 :foreground ,fg-comment-yellow)))
2182 `(font-lock-comment-delimiter-face
2183 ((,class :inherit fixed-pitch
2184 :foreground ,fg-comment-yellow)))
2185 `(font-lock-constant-face
2186 ((,class :inherit underline
2187 :foreground unspecified)))
2188 `(font-lock-doc-face
2189 ((,class :inherit modus-themes-slant
2190 :foreground ,fg-docstring)))
2191 `(font-lock-function-name-face
2192 ((,class :foreground unspecified
2193 :slant italic)))
2194 `(font-lock-keyword-face
2195 ((,class :inherit modus-themes-bold
2196 :foreground unspecified)))
2197 `(font-lock-negation-char-face
2198 ((,class :inherit modus-themes-bold
2199 :foreground unspecified)))
2200 `(font-lock-preprocessor-face
2201 ((,class :foreground unspecified)))
2202 `(font-lock-regexp-grouping-backslash
2203 ((,class :foreground ,fg-escape-char-backslash)))
2204 `(font-lock-regexp-grouping-construct
2205 ((,class :foreground ,fg-escape-char-construct)))
2206 `(font-lock-string-face
2207 ((,class :foreground ,fg-special-warm)))
2208 `(font-lock-type-face
2209 ((,class :inherit modus-themes-bold
2210 :foreground unspecified)))
2211 `(font-lock-variable-name-face
2212 ((,class :foreground unspecified)))
2213 `(font-lock-warning-face
2214 ((,class :inherit modus-themes-bold
2215 :foreground ,red-nuanced-fg)))
2216 `(font-lock-todo-face
2217 ((,class :inherit font-lock-comment-face
2218 :foreground ,fg-header
2219 :background ,yellow-intense-bg)))
2220 ;; `(mode-line
2221 ;; ((,class :height 100)))
2222 ;; `(mode-line-inactive
2223 ;; ((,class :height 100)))
2224 ;; `(tab-bar
2225 ;; ((,class :height 100)))
2226 ))))
2227
2228 (require 'dawn)
2229 (dawn-schedule #'modus-themes-load-operandi
2230 #'modus-themes-load-vivendi))
2231
2232(setup (:straight mwim)
2233 (:require +mwim)
2234 (:option +mwim-passthrough-modes '(comint-mode
2235 eshell-mode
2236 vterm-mode
2237 crossword-mode
2238 geiser-repl-mode))
2239 (:global "C-a" #'mwim-beginning
2240 "C-e" #'mwim-end))
2241
2242(setup (:straight native-complete)
2243 (with-eval-after-load 'shell
2244 (native-complete-setup-bash))
2245 (:with-hook shell-mode-hook
2246 (:local-set completion-at-point-functions
2247 (cons 'native-complete-at-point
2248 completion-at-point-functions))))
2249
2250(setup (:straight notmuch-bookmarks)
2251 (:load-after notmuch)
2252 (:when-loaded
2253 (notmuch-bookmarks-mode +1)))
2254
2255(setup (:straight notmuch-labeler
2256 :quit "Buggy")
2257 (:load-after notmuch))
2258
2259(setup (:straight (notmuch-tags
2260 :repo "https://git.madhouse-project.org/algernon/notmuch-tags.el"
2261 :fork (:repo "https://codeberg.org/acdw/notmuch-tags.el"))))
2262
2263(setup (:straight nov)
2264 (:hook #'visual-fill-column-mode)
2265 (:file-match (rx ".epub" eos)))
2266
2267(setup (:straight (nyan-mode
2268 :fork (:repo "duckwork/nyan-mode")))
2269 (:require nyan-mode +nyan-mode)
2270 (with-eval-after-load 'modus-themes
2271 (add-hook 'modus-themes-after-load-theme-hook
2272 (defun +nyan-modus-update-colors ()
2273 (modus-themes-with-colors
2274 (set-face-attribute '+nyan-mode-line nil
2275 :background bg-special-warm))))
2276 (+nyan-modus-update-colors))
2277 (+nyan-mode +1))
2278
2279(setup (:straight ol-notmuch))
2280
2281(setup (:straight orderless)
2282 (:require +orderless)
2283 (:option completion-styles '(substring orderless basic)
2284 completion-category-defaults nil
2285 completion-category-overrides
2286 '((file (styles basic partial-completion))
2287 (command (styles +orderless-with-initialism))
2288 (variable (styles +orderless-with-initialism))
2289 (symbol (styles +orderless-with-initialism)))
2290 orderless-component-separator #'orderless-escapable-split-on-space
2291 orderless-style-dispatchers '(+orderless-dispatch)))
2292
2293(setup (:straight org-appear)
2294 (:option org-appear-autoemphasis t
2295 org-appear-autoentities t
2296 org-appear-autokeywords t
2297 org-appear-autolinks nil
2298 org-appear-autosubmarkers t
2299 org-appear-delay 0)
2300 (:hook-into org-mode))
2301
2302(setup (:straight org-download)
2303 (:require)
2304 (:option org-download-method 'attach
2305 org-download-backend (cond ((executable-find "curl") 'curl)
2306 ((executable-find "wget") 'wget)
2307 (:else 'url-retrieve)))
2308 (add-hook 'dired-mode-hook 'org-download-enable))
2309
2310(setup (:straight (org-drawer-list
2311 :host github
2312 :repo "d12frosted/org-drawer-list"))
2313 (:load-after org)
2314 (:also-load +org-drawer-list))
2315
2316(setup (:straight org-mime)
2317 (:option org-mime-export-ascii 'utf-8)
2318 (add-hook 'message-mode-hook
2319 (defun org-mime-setup@message-mode ()
2320 (local-set-key (kbd "C-c M-o") 'org-mime-htmlize)))
2321 (add-hook 'org-mode-hook
2322 (defun org-mime-setup@org-mode ()
2323 (local-set-key (kbd "C-c M-o") 'org-mime-org-buffer-htmlize))))
2324
2325(setup (:straight (org-taskwise
2326 :host nil
2327 :repo "https://codeberg.org/acdw/org-taskwise.el.git"))
2328 (with-eval-after-load 'org
2329 (require 'org-taskwise)
2330 (define-key org-mode-map (kbd "C-x n t") #'org-taskwise-narrow-to-task)))
2331
2332(setup (:straight org-wc)
2333 (:load-after org simple-modeline)
2334 (:also-load +org-wc)
2335 (add-hook 'org-mode-hook #'+org-wc-mode))
2336
2337(setup (:straight orglink)
2338 (:option orglink-activate-in-modes '(text-mode prog-mode))
2339 (global-orglink-mode +1)
2340 (global-goto-address-mode -1))
2341
2342(setup (:straight package-lint))
2343
2344(setup (:straight package-lint-flymake)
2345 (add-hook 'emacs-mode-hook #'package-lint-flymake-setup)
2346 ;; Remove it from init.el files
2347 (add-hook '+init-mode-hook #'flymake-mode-off))
2348
2349(setup (:straight page-break-lines)
2350 (:option page-break-lines-char ?—)
2351 (:hook-into jabber-chat-mode))
2352
2353(setup (:straight paredit)
2354 (:also-load +paredit)
2355 (:bind "DEL" #'paredit-backward-delete
2356 "C-<backspace>" #'+paredit-backward-kill-word
2357 "C-w" (lambda (arg) (interactive "P")
2358 (+kill-word-backward-or-region arg #'paredit-backward-kill-word))
2359 "M-s" nil)
2360 (dolist (hook '(emacs-lisp-mode-hook
2361 eval-expression-minibuffer-setup-hook
2362 ielm-mode-hook
2363 lisp-interaction-mode-hook
2364 lisp-mode-hook
2365 scheme-mode-hook
2366 geiser-mode-hook
2367 geiser-repl-mode-hook
2368 fennel-mode-hook
2369 fennel-repl-mode-hook))
2370 (add-hook hook #'enable-paredit-mode))
2371 (:also-load eldoc)
2372 (eldoc-add-command #'paredit-backward-delete #'paredit-close-round))
2373
2374(setup (:straight paren-face)
2375 (:hook-into emacs-lisp-mode
2376 ielm-mode sly-repl-mode
2377 lisp-mode
2378 lisp-interaction-mode
2379 scheme-mode))
2380
2381(setup (:straight pdf-tools
2382 (or (executable-find "gcc")
2383 (executable-find "g++")))
2384 (:also-load +pdf-tools)
2385 (:with-mode pdf-view-mode
2386 (:local-set +modeline-position-function #'+pdf-view-position)
2387 (:file-match (rx ".pdf" eos)))
2388 (pdf-tools-install :no-query))
2389
2390(setup (:straight persistent-scratch)
2391 (:require)
2392 (:option persistent-scratch-save-file (sync/ "emacs/scratch")
2393 persistent-scratch-backup-directory (sync/ "emacs/scratch.d/" t)
2394 persistent-scratch-backup-file-name-format "%Y-%m-%dT%H:%M_%s")
2395 (persistent-scratch-autosave-mode +1)
2396 (+mapc-some-buffers (lambda () (persistent-scratch-mode +1))
2397 persistent-scratch-scratch-buffer-p-function))
2398
2399(setup (:straight (plancat
2400 :host nil
2401 :repo "https://codeberg.org/acdw/plancat.el"))
2402 (:option plancat-user "acdw"))
2403
2404(setup (:straight pocket-reader)
2405 (:option pocket-reader-open-url-default-function #'browse-url)
2406 (:+leader "p" #'pocket-reader
2407 "C-p" #'pocket-reader)
2408 (dolist (mode '((eww-mode-map . eww)
2409 (w3m-mode-map . w3m)
2410 (elfeed-search-mode-map . elfeed-search)
2411 (elfeed-show-mode-map . elfeed-show)))
2412 (with-eval-after-load (cdr mode)
2413 (define-key (symbol-value (car mode)) "\"" #'pocket-reader-add-link))
2414 (with-eval-after-load '+link-hint
2415 (+link-hint-pocket-add-setup)
2416 (define-key +link-hint-map "M-\"" #'+link-hint-pocket-add)
2417 (define-key +link-hint-map "\"" #'+link-hint-pocket-add))))
2418
2419(setup (:straight rainbow-mode)
2420 (:hook-into prog-mode))
2421
2422(setup (:straight (shell-command+
2423 :host nil
2424 :repo "https://git.sr.ht/~pkal/shell-command-plus"))
2425 (:option shell-command-prompt "$ ")
2426 (:bind-into dired
2427 "M-!" 'shell-command+)
2428 (:+key "M-!" #'shell-command+))
2429
2430(setup (:straight sicp))
2431
2432(setup (:straight (simple-modeline
2433 :host github :repo "gexplorer/simple-modeline"
2434 :fork (:host github :repo "duckwork/simple-modeline")))
2435 (:require +modeline)
2436 (:option +modeline-modified-icon-alist '((ephemeral . "~")
2437 (special . "*")
2438 (readonly . "=")
2439 (modified . "+")
2440 (t . "-"))
2441 +modeline-minions-icon "&"
2442 +modeline-buffer-name-max-length 0.35)
2443 ;; Segments
2444 (:option simple-modeline-segments
2445 `(( ; left
2446 +modeline-ace-window-display
2447 +modeline-modified
2448 +modeline-buffer-name
2449 +modeline-major-mode
2450 (lambda () (+modeline-vc " : "))
2451 +modeline-nyan-on-focused
2452 +modeline-anzu
2453 )
2454 ( ; right
2455 simple-modeline-segment-process
2456 (lambda ()
2457 (unless +tab-bar-misc-info-mode
2458 (+modeline-concat
2459 '(+modeline-track
2460 simple-modeline-segment-misc-info))))
2461 (lambda () (when (featurep 'dired-rsync)
2462 dired-rsync-modeline-status))
2463 ,(+modeline-concat
2464 '(+modeline-god-mode
2465 +modeline-kmacro-indicator
2466 +modeline-reading-mode
2467 +modeline-narrowed
2468 +modeline-text-scale
2469 +modeline-input-method)
2470 " ")
2471 +modeline-position
2472 +modeline-spacer
2473 )))
2474 (simple-modeline-mode +1))
2475
2476(setup (:straight slack)
2477 (:also-load +slack)
2478 (:option slack-prefer-current-team t
2479 slack-buffer-emojify t
2480 slack-thread-also-send-to-room nil
2481 slack-typing-visibility 'buffer
2482 slack-buffer-create-on-notify t
2483 slack-enable-wysiwyg t
2484 slack-file-dir (xdg-user-dir "DOWNLOAD")
2485 slack-display-team-name nil)
2486 (with-eval-after-load '+slack
2487 (+slack-register-teams))
2488 (with-eval-after-load 'alert
2489 ;; Don't notify for Slack messages
2490 (alert-add-rule :category "slack"
2491 :style 'ignore)))
2492
2493;; (setup (:straight sly
2494;; (defvar +lisp-bin (executable-find "sbcl")))
2495;; (:also-load sly-autoloads
2496;; +sly)
2497;; (:option inferior-lisp-program +lisp-bin
2498;; sly-kill-without-query-p t
2499;; sly-command-switch-to-existing-lisp t)
2500;; (:with-mode lisp-mode
2501;; (:bind "C-c C-z" #'sly-mrepl))
2502;; (:with-feature sly-mrepl
2503;; (dolist (key '("RET" "<return>"))
2504;; (:bind key #'sly-mrepl-return-at-end))
2505;; (:bind "C-c C-c" #'sly-mrepl-return)))
2506
2507(setup (:straight slime))
2508
2509(setup (:straight smartscan)
2510 (:with-map smartscan-map
2511 (:bind "M-'" nil))
2512 (:hook-into prog-mode))
2513
2514(setup (:straight (sophomore
2515 :host nil
2516 :repo "https://codeberg.org/acdw/sophomore.el"))
2517 (sophomore-enable #'narrow-to-region)
2518 (sophomore-disable ; These are mostly annoying commands
2519 #'view-hello-file
2520 #'describe-gnu-project
2521 #'suspend-frame)
2522 (sophomore-disable-with 'confirm
2523 #'save-buffers-kill-terminal)
2524 (sophomore-disable-with 'confirm-y
2525 #'+save-buffers-quit)
2526 (sophomore-mode +1))
2527
2528(setup (:straight (spongebob-case
2529 :host nil
2530 :repo "https://codeberg.org/acdw/spongebob-case.el")))
2531
2532(setup (:straight ssh-config-mode)
2533 (:file-match (rx "/.ssh/config" eos)
2534 (rx "/ssh" (? "d") "_config" eos))
2535 (:with-mode ssh-known-hosts-mode
2536 (:file-match (rx "/knownhosts" eos)))
2537 (:with-mode ssh-authorized-keys-mode
2538 (:file-match (rx "/authorized_keys" (? "2") eos))))
2539
2540;; (setup (:straight super-save)
2541;; (:option auto-save-default nil
2542;; super-save-auto-save-when-idle t
2543;; super-save-idle-duration 30
2544;; super-save-exclude '(".gpg")
2545;; super-save-remote-files nil)
2546;; (auto-save-visited-mode -1)
2547;; (super-save-mode +1))
2548
2549(setup (:straight systemd
2550 (executable-find "systemd"))
2551 (:option systemd-man-function 'woman))
2552
2553(setup (:straight (titlecase
2554 :host nil
2555 :repo "https://codeberg.org/acdw/titlecase.el"
2556 :files ("*")))
2557 (:require titlecase +titlecase)
2558 (add-to-list 'titlecase-skip-words-regexps (rx word-boundary
2559 (+ (any upper digit))
2560 word-boundary))
2561 (:with-map +casing-map
2562 (:bind "t" #'titlecase-dwim
2563 "M-t" #'titlecase-dwim
2564 "s" #'+titlecase-sentence-style-dwim
2565 "M-s" #'+titlecase-sentence-style-dwim)))
2566
2567(setup (:straight topsy)
2568 (:hook-into ;;prog-mode
2569 circe-chat-mode)
2570 (:when-loaded
2571 (:option
2572 topsy-header-line-format
2573 '(:eval
2574 (list
2575 (propertize " "
2576 'display
2577 `((space
2578 :align-to
2579 ,(unless (bound-and-true-p visual-fill-column-mode)
2580 0))))
2581 (funcall topsy-fn))))))
2582
2583(setup (:straight transpose-frame)
2584 (defvar +transpose-frame-map
2585 (let ((map (make-sparse-keymap)))
2586 (dolist (bind '(("t" . transpose-frame)
2587 ("v" . flip-frame)
2588 ("h" . flop-frame)
2589 ("r" . rotate-frame-clockwise)
2590 ("R" . rotate-frame-anticlockwise)))
2591 (define-key map (car bind) (cdr bind)))
2592 map)
2593 "Map for transposing frames.")
2594 (define-key +key-mode-map (kbd "C-x 5 t") +transpose-frame-map))
2595
2596(setup (:straight trashed)
2597 (:+leader "t" #'trashed)
2598 (:option trashed-action-confirmer #'y-or-n-p
2599 trashed-use-header-line t
2600 trashed-size-format 'human-readable))
2601
2602(setup (:straight undo-fu) (:quit "Trying native undo functionality")
2603 (:option undo-fu-allow-undo-in-region t)
2604 (:global "C-/" #'undo-fu-only-undo
2605 "C-?" #'undo-fu-only-redo))
2606
2607(setup (:straight undo-fu-session)
2608 (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
2609 "/git-rebase-todo\\'")
2610 undo-fu-session-directory (.etc "undo/" t)
2611 undo-fu-session-compression (cond
2612 ((executable-find "gzip") 'gz)
2613 ((executable-find "bzip2") 'bz2)
2614 ((executable-find "xz") 'xz)
2615 (t nil)))
2616 (global-undo-fu-session-mode +1))
2617
2618(setup (:straight (undo-hl
2619 :host github
2620 :repo "casouri/undo-hl"))
2621 (:require)
2622 (:face 'undo-hl-delete '((t :strikethrough t))
2623 'undo-hl-insert '((t :underline t)))
2624 (:hook-into text-mode prog-mode))
2625
2626(setup (:straight valign
2627 :quit "Doesn't work with narrowed tables.")
2628 (:option valign-fancy-bar t)
2629 (:hook-into org-mode
2630 markdown-mode))
2631
2632(setup (:straight (vertico
2633 :host github
2634 :repo "minad/vertico"
2635 :files ("*" "extensions/*"
2636 (:exclude ".git"))))
2637 (:require vertico +vertico)
2638 (:option resize-mini-windows 'grow-only
2639 vertico-count-format nil
2640 vertico-cycle t)
2641 (advice-add #'vertico-next :around #'+vertico-ding-wrap)
2642 (when (boundp 'native-comp-deferred-compilation-deny-list)
2643 (add-to-list 'native-comp-deferred-compilation-deny-list "vertico"))
2644 (vertico-mode +1)
2645 ;; Extensions
2646 (:also-load vertico-directory
2647 vertico-mouse
2648 vertico-quick)
2649 (vertico-mouse-mode +1)
2650 (:with-map vertico-map
2651 (:bind "RET" #'vertico-directory-enter
2652 "DEL" #'vertico-directory-delete-char
2653 "M-DEL" #'vertico-directory-delete-word
2654 "TAB" #'+vertico-widen-or-complete
2655 "M-j" #'vertico-quick-insert))
2656 (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy))
2657
2658(setup (:straight visual-fill-column)
2659 (:option visual-fill-column-center-text t
2660 (append reading-modes) '(visual-fill-column-mode . +1))
2661 (:hook #'visual-line-mode)
2662 (:hook-into org-mode)
2663 (advice-add #'text-scale-adjust :after #'visual-fill-column-adjust)
2664 (:global [f12] #'visual-fill-column-mode))
2665
2666(setup (:straight vlf)
2667 (:require vlf-setup))
2668
2669(setup (:straight vterm
2670 (and module-file-suffix
2671 (executable-find "cmake")))
2672 (:also-load +vterm)
2673 (:option vterm-always-compile-module t
2674 vterm-buffer-name-string "vterm: %s"
2675 vterm-max-scrollback 100000 ; max allowed by vterm-module.h
2676 )
2677 (advice-add 'counsel-yank-pop-action :around
2678 #'+vterm-counsel-yank-pop-action))
2679
2680(setup (:straight (vundo
2681 :host github
2682 :repo "casouri/vundo")))
2683
2684(setup (:straight web-mode)
2685 (:file-match (rx "." (or "htm" "html" "phtml" "tpl.php"
2686 "asp" "gsp" "jsp" "ascx" "aspx"
2687 "erb" "mustache" "djhtml")
2688 eos))
2689 (with-eval-after-load 'apheleia
2690 (setf (alist-get 'web-mode apheleia-mode-alist)
2691 'prettier)))
2692
2693(setup (:straight whitespace-cleanup-mode)
2694 (:option whitespace-cleanup-mode-preserve-point t
2695 whitespace-cleanup-mode-only-if-initially-clean nil)
2696 (global-whitespace-cleanup-mode +1))
2697
2698(setup (:straight wrap-region)
2699 (:require wrap-region)
2700 (wrap-region-add-wrappers
2701 '(("*" "*" nil org-mode)
2702 ("~" "~" nil org-mode)
2703 ("/" "/" nil org-mode)
2704 ("=" "=" nil org-mode)
2705 ("+" "+" nil org-mode)
2706 ("_" "_" nil org-mode)
2707 ("$" "$" nil (org-mode latex-mode))))
2708 (:hook-into org-mode
2709 latex-mode))
2710
2711(setup (:straight xkcd)
2712 (:also-load +xkcd)
2713 (:hook #'visual-fill-column-mode))
2714
2715(setup (:straight xr))
2716
2717(setup (:straight yaml-mode)
2718 (:file-match (rx "." (or "yml" "yaml") eos)))
2719
2720(setup (:straight yaoddmuse))
2721
2722(setup (:straight yasnippet)
2723 (:option yas-snippet-dirs (list
2724 (expand-file-name "snippets" user-emacs-directory)
2725 (sync/ "emacs/snippets" t)))
2726 (yas-global-mode +1))
2727
2728(setup (:straight (ytdious
2729 :host github :repo "spiderbit/ytdious"
2730 :fork (:host github :repo "duckwork/ytdious")))
2731 (:also-load +ytdious)
2732 (:option ytdious-invidious-api-url (if +invidious-host
2733 (concat "https://" +invidious-host)
2734 "https://invidious.snopyta.org"))
2735 (:bind "y" #'+ytdious-watch))
2736
2737(setup (:straight zoom-frm)
2738 (:+key "M-+" #'zoom-frm-in
2739 "M-_" #'zoom-frm-out))
2740
2741(setup (:straight zzz-to-char)
2742 (:require +zzz-to-char)
2743 (:option zzz-to-char-reach (+bytes 1 :kib))
2744 (:global "M-z" #'+zzz-to-char))
diff --git a/lisp/+Info.el b/lisp/+Info.el deleted file mode 100644 index 46bd5f8..0000000 --- a/lisp/+Info.el +++ /dev/null
@@ -1,84 +0,0 @@
1;;; +Info.el -*- lexical-binding: t; -*-
2
3;;Copyright (C) 2022 Case Duckworth
4
5;;; Code:
6
7(require 'info)
8
9(defun +Info-copy-current-node-name (&optional arg)
10 "Put the name of the current Info invocation intothe kill ring.
11This is the same as `Info-copy-current-node-name', but with the
12arg reversed."
13 (interactive "P" Info-mode)
14 (Info-copy-current-node-name (unless arg 0)))
15
16(defun +Info-modeline-breadcrumbs ()
17 (let ((nodes (Info-toc-nodes Info-current-file))
18 (node Info-current-node)
19 (crumbs ())
20 (depth Info-breadcrumbs-depth-internal)
21 (text ""))
22 ;; Get ancestors from the cached parent-children node info
23 (while (and (not (equal "Top" node)) (> depth 0))
24 (setq node (nth 1 (assoc node nodes)))
25 (when node (push node crumbs))
26 (setq depth (1- depth)))
27 ;; Add bottom node.
28 (setq crumbs (nconc crumbs (list Info-current-node)))
29 (when crumbs
30 ;; Add top node (and continuation if needed).
31 (setq crumbs (cons "Top" (if (member (pop crumbs) '(nil "Top"))
32 crumbs
33 (cons nil crumbs))))
34 (dolist (node crumbs)
35 (let ((crumbs-map (make-sparse-keymap))
36 (menu-map (make-sparse-keymap "Breadcrumbs in Mode Line")))
37 (define-key crumbs-map [mode-line mouse-3] menu-map)
38 (when node
39 (define-key menu-map [Info-prev]
40 `(menu-item "Previous Node" Info-prev
41 :visible ,(Info-check-pointer "prev[ious]*") :help "Go to the previous node"))
42 (define-key menu-map [Info-next]
43 `(menu-item "Next Node" Info-next
44 :visible ,(Info-check-pointer "next") :help "Go to the next node"))
45 (define-key menu-map [separator] '("--"))
46 (define-key menu-map [Info-breadcrumbs-in-mode-line-mode]
47 `(menu-item "Toggle Breadcrumbs" Info-breadcrumbs-in-mode-line-mode
48 :help "Toggle displaying breadcrumbs in the Info mode-line"
49 :button (:toggle . Info-breadcrumbs-in-mode-line-mode)))
50 (define-key menu-map [Info-set-breadcrumbs-depth]
51 `(menu-item "Set Breadcrumbs Depth" Info-set-breadcrumbs-depth
52 :help "Set depth of breadcrumbs to show in the mode-line"))
53 (setq node (if (equal node Info-current-node)
54 (propertize
55 (replace-regexp-in-string "%" "%%" Info-current-node)
56 'face 'mode-line-buffer-id
57 'help-echo "mouse-1: Scroll back, mouse-2: Scroll forward, mouse-3: Menu"
58 'mouse-face 'mode-line-highlight
59 'local-map
60 (progn
61 (define-key crumbs-map [mode-line mouse-1] 'Info-mouse-scroll-down)
62 (define-key crumbs-map [mode-line mouse-2] 'Info-mouse-scroll-up)
63 crumbs-map))
64 (propertize
65 node
66 'local-map (progn (define-key crumbs-map [mode-line mouse-1]
67 `(lambda () (interactive) (Info-goto-node ,node)))
68 (define-key crumbs-map [mode-line mouse-2]
69 `(lambda () (interactive) (Info-goto-node ,node)))
70 crumbs-map)
71 'mouse-face 'mode-line-highlight
72 'help-echo "mouse-1, mouse-2: Go to this node; mouse-3: Menu")))))
73 (let ((nodetext (if (not (equal node "Top"))
74 node
75 (concat (format "(%s)" (if (stringp Info-current-file)
76 (file-name-nondirectory Info-current-file)
77 ;; Some legacy code can still use a symbol.
78 Info-current-file))
79 node))))
80 (setq text (concat text (if (equal node "Top") "" " > ") (if node nodetext "...")))))
81 text)))
82
83(provide '+Info)
84;;; +Info.el ends here
diff --git a/lisp/+ace-window.el b/lisp/+ace-window.el deleted file mode 100644 index 9e631a2..0000000 --- a/lisp/+ace-window.el +++ /dev/null
@@ -1,40 +0,0 @@
1;;; +ace-window.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'ace-window)
6
7;;;###autoload
8(define-minor-mode +ace-window-display-mode
9 "Minor mode for updating data for `+modeline-ace-window-display'."
10 ;; This is stolen from ace-window.el but with the mode-line stuff ripped out.
11 :global t
12 (if +ace-window-display-mode
13 (progn ; Enable
14 (aw-update)
15 (force-mode-line-update t)
16 (add-hook 'window-configuration-change-hook 'aw-update)
17 (add-hook 'after-make-frame-functions 'aw--after-make-frame t)
18 (advice-add 'aw--lead-overlay :override 'ignore))
19 (progn ; Disable
20 (remove-hook 'window-configuration-change-hook 'aw-update)
21 (remove-hook 'after-make-frame-functions 'aw--after-make-frame)
22 (advice-remove 'aw--lead-overlay 'ignore))))
23
24;; (defun +ace-window--mode-line-hint (path leaf)
25;; (let ((wnd (cdr leaf)))
26;; (with-selected-window wnd
27;; ())))
28
29;;;###autoload
30(defun +ace-window-or-switch-buffer (arg)
31 "Call `ace-window' with ARG if more than one window is visible.
32Switch to most recent buffer otherwise."
33 ;; cribbed from `crux-other-window-or-switch-buffer'
34 (interactive "p")
35 (if (one-window-p)
36 (switch-to-buffer nil)
37 (ace-window arg)))
38
39(provide '+ace-window)
40;;; +ace-window.el ends here
diff --git a/lisp/+apheleia.el b/lisp/+apheleia.el deleted file mode 100644 index 51cf145..0000000 --- a/lisp/+apheleia.el +++ /dev/null
@@ -1,50 +0,0 @@
1;;; +apheleia.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'el-patch)
7(require 'user-save)
8
9;; https://github.com/raxod502/apheleia/pull/63#issue-1077529623
10(cl-defun +apheleia-indent-region (&key buffer scratch formatter callback &allow-other-keys)
11 (with-current-buffer scratch
12 (setq-local indent-line-function
13 (buffer-local-value 'indent-line-function buffer))
14 (indent-region (point-min)
15 (point-max))
16 (funcall callback)))
17
18;;; Why does the original function have to check for `apheleia-mode' ?
19(el-patch-defun apheleia--format-after-save ()
20 "Run code formatter for current buffer if any configured, then save."
21 (unless apheleia--format-after-save-in-progress
22 (when (el-patch-swap apheleia-mode
23 (or apheleia-mode
24 +apheleia/user-save-mode))
25 (when-let ((formatters (apheleia--get-formatters)))
26 (apheleia-format-buffer
27 formatters
28 (lambda ()
29 (with-demoted-errors "Apheleia: %s"
30 (when buffer-file-name
31 (let ((apheleia--format-after-save-in-progress t))
32 (apheleia--save-buffer-silently)))
33 (run-hooks 'apheleia-post-format-hook))))))))
34
35
36(define-minor-mode +apheleia/user-save-mode
37 "Minor mode for reformatting code on `user-save'.
38Customize with `apheleia-mode-alist' and `apheleia-formatters'."
39 :lighter " Apheleia/US"
40 (if +apheleia/user-save-mode
41 (add-hook 'user-save-after-save-hook #'apheleia--format-after-save nil 'local)
42 (remove-hook 'user-save-after-save-hook #'apheleia--format-after-save 'local)))
43
44(define-globalized-minor-mode +apheleia/user-save-global-mode
45 +apheleia/user-save-mode +apheleia/user-save-mode)
46
47(put '+apheleia/user-save-mode 'safe-local-variable #'booleanp)
48
49(provide '+apheleia)
50;;; +apheleia.el ends here
diff --git a/lisp/+avy.el b/lisp/+avy.el deleted file mode 100644 index b0837a3..0000000 --- a/lisp/+avy.el +++ /dev/null
@@ -1,97 +0,0 @@
1;;; +avy.el -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; https://karthinks.com/software/avy-can-do-anything/
6
7;;; Code:
8
9(require 'avy)
10
11(defun avy-action-embark (pt)
12 (unwind-protect
13 (save-excursion
14 (goto-char pt)
15 (embark-act))
16 (select-window
17 (cdr (ring-ref avy-ring 0))))
18 t)
19
20
21;;; Remove `buffer-face-mode' when avy is active.
22
23(defcustom +avy-buffer-face-functions '(avy-goto-char
24 avy-goto-char-in-line
25 avy-goto-char-2
26 avy-goto-char-2-above
27 avy-goto-char-2-below
28 avy-goto-word-0
29 avy-goto-whitespace-end
30 avy-goto-word-0-above
31 avy-goto-word-0-below
32 avy-goto-whitespace-end-above
33 avy-goto-whitespace-end-below
34 avy-goto-word-1
35 avy-goto-word-1-above
36 avy-goto-word-1-below
37 avy-goto-symbol-1
38 avy-goto-symbol-1-above
39 avy-goto-symbol-1-below
40 avy-goto-subword-0
41 avy-goto-subword-1
42 avy-goto-word-or-subword-1
43 avy-goto-line
44 avy-goto-line-above
45 avy-goto-line-below
46 avy-goto-end-of-line
47 avy-goto-char-timer)
48 "Functions to disable `buffer-face-mode' during.")
49
50(defvar-local +avy-buffer-face-mode-face nil
51 "The state of `buffer-face-mode' before calling `avy-with'.")
52
53;;; XXX: Doesn't switch back if avy errors out or quits
54(defun +avy@un-buffer-face (win)
55 "BEFORE advice on `avy-with' to disable `buffer-face-mode'."
56 (with-current-buffer (window-buffer win)
57 (when buffer-face-mode
58 (setq +avy-buffer-face-mode-face buffer-face-mode-face)
59 (buffer-face-mode -1))))
60
61(defun +avy@re-buffer-face (win)
62 "AFTER advice on `avy-with' to re-enable `buffer-face-mode'."
63 (with-current-buffer (window-buffer win)
64 (when +avy-buffer-face-mode-face
65 (setq buffer-face-mode-face +avy-buffer-face-mode-face)
66 (buffer-face-mode +1)))
67 (let ((bounds (bounds-of-thing-at-point 'symbol)))
68 (when (and (car bounds)
69 (cdr bounds))
70 (pulse-momentary-highlight-region (car bounds) (cdr bounds)))))
71
72(defun +avy@buffer-face (fn &rest r)
73 "AROUND advice for avy to dis/enable `buffer-face-mode'."
74 (if avy-all-windows
75 (walk-windows #'+avy@un-buffer-face nil (eq avy-all-windows 'all-frames)))
76 (condition-case e
77 (apply fn r)
78 ((quit error) (message "Avy: %S" e) nil)
79 (:sucess e))
80 (if avy-all-windows
81 (walk-windows #'+avy@re-buffer-face nil (eq avy-all-windows 'all-frames))))
82
83(define-minor-mode +avy-buffer-face-mode
84 "Turn off `buffer-face-mode' before doing Avy selections.
85Restore the mode after the selection."
86 :lighter ""
87 :global t
88 (setq +avy-buffer-face-mode-face nil)
89 (cond
90 (+avy-buffer-face-mode
91 (dolist (fn +avy-buffer-face-functions)
92 (advice-add fn :around #'+avy@buffer-face)))
93 (t (dolist (fn +avy-buffer-face-functions)
94 (advice-remove fn #'+avy@buffer-face)))))
95
96(provide '+avy)
97;;; avy.el ends here
diff --git a/lisp/+bongo.el b/lisp/+bongo.el deleted file mode 100644 index da68024..0000000 --- a/lisp/+bongo.el +++ /dev/null
@@ -1,60 +0,0 @@
1;;; +bongo.el --- customizations in bongo -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(defgroup +bongo nil
8 "Extra customization for `bongo'."
9 :group 'bongo)
10
11(defun +bongo-notify ()
12 (notifications-notify
13 :title "Now Playing"
14 :body (let ((bongo-field-separator "
15"))
16 (substring-no-properties (bongo-formatted-infoset)))
17 :urgency 'low
18 :transient t))
19
20(defun +bongo-stop-all ()
21 "Ensure only one bongo playlist is playing at a time.
22This is intended to be :before advice to `bongo-play'."
23 (mapc (lambda (b)
24 (with-current-buffer b
25 (when-let* ((modep (derived-mode-p
26 'bongo-playlist-mode))
27 (bongo-playlist-buffer b)
28 (playingp (bongo-playing-p)))
29 (bongo-stop))))
30 (buffer-list)))
31
32
33;;; Bongo Radio
34
35(defcustom +bongo-radio-stations nil
36 "Stations to play using `+bongo-radio'.")
37
38(defcustom +bongo-radio-buffer-name "*Bongo Radio*"
39 "Name of the buffer that holds all bongo radio stations."
40 :type 'string)
41
42(defun +bongo-radio ()
43 (interactive)
44 (switch-to-buffer (or (get-buffer +bongo-radio-buffer-name)
45 (+bongo-radio-init))))
46
47(defun +bongo-radio-init ()
48 (interactive)
49 (let ((bongo-playlist-buffer (get-buffer-create +bongo-radio-buffer-name))
50 (bongo-confirm-flush-playlist nil))
51 (with-bongo-playlist-buffer
52 (bongo-playlist-mode)
53 (bongo-flush-playlist :delete-all)
54 (cl-loop for (name . url) in +bongo-radio-stations
55 do (bongo-insert-uri url name)))
56 (prog1 (switch-to-buffer bongo-playlist-buffer)
57 (goto-char (point-min)))))
58
59(provide '+bongo)
60;;; +bongo.el ends here
diff --git a/lisp/+browse-url.el b/lisp/+browse-url.el deleted file mode 100644 index fc479e4..0000000 --- a/lisp/+browse-url.el +++ /dev/null
@@ -1,156 +0,0 @@
1;;; +browse-url.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'browse-url)
6(require 'cl-lib)
7
8(defgroup +browse-url nil
9 "Group for my `browse-url' extras."
10 :group 'browse-url)
11
12;;; URL Handlers
13
14(defun +browse-url-set-handlers (&optional handlers)
15 "Set HANDLERS for `browse-url'.
16Set `browse-url-handlers', if they exist; else
17`browse-url-browser-function'. The reason for this switch is
18that the latter is deprecated in Emacs 28+.
19
20If HANDLERS is absent or nil, recompute handlers. This can be
21useful when changing the default browser."
22 (let ((h (if (boundp 'browse-url-handlers)
23 'browse-url-handlers
24 'browse-url-browser-function)))
25 (set-default h (or handlers (symbol-value h)))))
26
27(cl-defmacro +browse-url-make-external-viewer-handler
28 (viewer default-args &optional (prompt "URL: ")
29 &key
30 (custom-group '+browse-url)
31 (name (format "+browse-url-with-%s" viewer))
32 (fallback #'browse-url-generic))
33 "Create a `browse-url' handler function that calls VIEWER on the url.
34Also create a `customize' setting in CUSTOM-GROUP for VIEWER's
35arguments. DEFAULT-ARGS specifies the default arguments that
36setting should have. PROMPT will be shown to user in the
37function's `interactive' spec, as an argument to
38`browse-url-interactive-arg'. The resulting function will be
39named NAME, defaulting to \"+browse-url-with-VIEWER\", and the variable
40\"NAME-args\".
41
42If FALLBACK is non-nil, it's a function to fallback on if the
43`start-process' call fails in anyway."
44 (declare (indent 1))
45 `(progn
46 (defcustom ,(intern (format "%s-args" name))
47 ,default-args
48 ,(format "Arguments to pass to %s in `%s'." viewer name)
49 :type '(repeat :tag "Command-line argument" string)
50 :group ',custom-group)
51 (defun ,(intern name) (url &optional new-window)
52 ,(format "Open URL in %s." viewer)
53 (interactive (browse-url-interactive-arg ,prompt))
54 (let* ((url (browse-url-encode-url url))
55 (process-environment (browse-url-process-environment)))
56 (message ,(format "Opening %%s in %s..." viewer) url)
57 (unless (ignore-errors
58 (apply #'start-process
59 (concat ,viewer " " url) nil
60 ,viewer
61 (append ,(intern (format "%s-args" name))
62 (list url))))
63 (funcall fallback url new-window))))))
64
65;; Reference implementation: mpv
66(+browse-url-make-external-viewer-handler "mpv" '("--cache-pause-wait=30"
67 "--cache-pause-initial=yes")
68 "Video URL: ")
69;; And feh too
70(+browse-url-make-external-viewer-handler "feh" '("--auto-zoom"
71 "--geometry" "800x600"))
72;; And ... mpv, but for images
73(+browse-url-make-external-viewer-handler "mpv"
74 '("--image-display-duration=inf")
75 "Image URL: "
76 :name "+browse-image-with-mpv")
77
78;;; Easily add extra domains to open in `browse-url-secondary-browser-function'
79;; I like to open most websites in eww, but a lot of website on the modern web
80;; just make that hard to do. Right now I have a list in `browse-url-handlers'
81;; with domains in an (rx (or ...)) form, but that's not super easy to config.
82;; With this custom setting, I'm making it a list that'll be way easier to
83;; customize.
84
85(defcustom +browse-url-secondary-browser-regexps nil
86 "List of URL regexps to open with `browse-url-secondary-browser-function'."
87 :type '(repeat regexp))
88
89;; Because `browse-url-browser-function', when set to an alist, must be of the
90;; form (REGEXP . FUNCTION), I need to convert
91;; `+browse-url-secondary-browser-regexps' into a regexp.
92
93(defun +browse-url-secondary-browser-regexps-combine ()
94 "Combine `+browse-url-secondary-browser-regexps'.
95This combines a list of regexps into one regexp."
96 (mapconcat #'identity +browse-url-secondary-browser-regexps "\\\|"))
97
98;;; URL Transformation Functions
99;; There's a lot of bad websites out there. Luckily we can easily redirect
100;; requests to more privacy-respecting, or just less javascript-ridden, sites
101;; using some basic regex magic. Inspired by add-ons like
102;; https://einaregilsson.com/redirector/.
103
104(defcustom +browse-url-transformations nil
105 "Transformation rules for various URLs.
106This is an alist, the keys of which are regexen to match URLs
107against, and the values are how to transform them. Match capture
108data will be used in the transformations."
109 :type
110 '(alist :key-type (string :tag "URL regex match")
111 :value-type (string :tag "URL regex transformation"))
112 :group '+browse-url)
113
114(defun +browse-url-transform-advice (url &rest args)
115 "ADVICE to transform URL for later opening by `browse-url'.
116ARGS are ignored here, but passed on for later processing."
117 ;; Basically, loop through `+browse-url-transformations' until finding a CAR
118 ;; that matches the URL. If one is found, transform it using `replace-match'
119 ;; with the CDR of that cell, or if one isn't, just pass the URL unchanged,
120 ;; along with the rest of the args, in a list to the original caller (probably
121 ;; `browse-url'.)
122 (apply 'list
123 (cl-loop with url = (substring-no-properties
124 (if (consp url) (car url) url))
125 for (regex . transformation) in +browse-url-transformations
126 if (string-match regex url)
127 return (replace-match transformation nil nil url)
128 ;; else
129 finally return url)
130 args))
131
132(define-minor-mode +browse-url-transform-url-mode
133 "Minor mode to transform a URL before passing it to `browse-url'.
134This can be used to \"redirect\" URLs, for example from an
135information silo to a more privacy-respecting one (e.g.,
136\"twitter.com\" -> \"nitter.com\"), by adding advice to `browse-url'.
137
138When using this mode, ensure that the transformed URL is also in
139`browse-url-handlers', since that's what `browse-url' will see."
140 :lighter " Xurl"
141 :keymap nil
142 (if +browse-url-transform-url-mode
143 (advice-add 'browse-url :filter-args '+browse-url-transform-advice)
144 (advice-remove 'browse-url '+browse-url-transform-advice)))
145
146(define-global-minor-mode +browse-url-transform-url-global-mode
147 +browse-url-transform-url-mode +browse-url-transform-url-mode)
148
149(defun +browse-url-other-window (&rest args)
150 "Browse URL in the other window."
151 (let ((browsed (apply #'browse-url args)))
152 (when (bufferp browsed)
153 (switch-to-buffer-other-window browsed))))
154
155(provide '+browse-url)
156;;; +browse-url.el ends here
diff --git a/lisp/+burly.el b/lisp/+burly.el deleted file mode 100644 index a32bc97..0000000 --- a/lisp/+burly.el +++ /dev/null
@@ -1,63 +0,0 @@
1;;; +burly.el --- Bespoke burly add-ons -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'burly)
8
9(defgroup +burly nil
10 "Extra `burly' customizations."
11 :group 'burly
12 :prefix "+burly-")
13
14(defcustom +burly-windows-bookmark-name "pre-close-window-config"
15 "The name of the window config bookmark pre-frame deletion.")
16
17(defun +burly--get-name (arg)
18 "Get the name of a Burly bookmark to restore.
19If ARG is passed, ask for the bookmark's name; otherwise, just
20use `+burly-windows-bookmark-name'."
21 (if arg
22 (completing-read "Save Burly bookmark: " (burly-bookmark-names)
23 nil nil burly-bookmark-prefix)
24 +burly-windows-bookmark-name))
25
26(defun +burly-recover-windows-bookmark (&optional arg frame)
27 "Recover the window configuration from a previous bookmark.
28ARG is passed to `+burly--get-name', which see."
29 (interactive (list current-prefix-arg
30 (selected-frame)))
31 (with-selected-frame frame
32 (burly-open-bookmark (+burly--get-name arg))))
33
34(defun +burly--recover-windows-on-new-frame (frame)
35 "Recover the current window configuration in a new frame.
36This function removes itself from `after-make-frame-functions'."
37 ;; XXX: For some reason, *scratch* pops up. So I need to run this after a
38 ;; short delay, which sadly causes a flash of *scratch*.
39 (run-with-idle-timer 0.1 nil
40 (lambda (f) (+burly-recover-windows-bookmark nil f))
41 frame)
42 (remove-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame))
43
44(defun +burly-save-then-close-frame (&optional arg)
45 "Save window configuration and close the frame.
46ARG is passed to `+burly--get-name', which see."
47 (interactive "P")
48 (if (not (frame-parameter nil 'client))
49 (when (yes-or-no-p "Sure you want to quit? ")
50 (save-buffers-kill-emacs))
51 (save-some-buffers t)
52 (burly-bookmark-windows (+burly--get-name arg))
53 (delete-frame nil :force)))
54
55(defun +burly-save-then-close-frame-remembering ()
56 "Save window configurations and close the frame.
57The next frame created will restore the window configuration."
58 (interactive)
59 (add-hook 'after-make-frame-functions #'+burly--recover-windows-on-new-frame 90)
60 (+burly-save-then-close-frame))
61
62(provide '+burly)
63;;; +burly.el ends here
diff --git a/lisp/+casing.el b/lisp/+casing.el deleted file mode 100644 index c8e9e4d..0000000 --- a/lisp/+casing.el +++ /dev/null
@@ -1,82 +0,0 @@
1;;; +casing.el --- Word-case-twiddling things -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'thingatpt)
6
7;;;###autoload
8(defun +upcase-dwim (arg)
9 "Upcase words in the region, or upcase word at point.
10If the region is active, this function calls `upcase-region'.
11Otherwise, it calls `upcase-word' on the word at point (using
12`thingatpt'), and the following ARG - 1 words."
13 (interactive "*p")
14 (if (use-region-p)
15 (upcase-region (region-beginning) (region-end) (region-noncontiguous-p))
16 (let ((following (1- arg))
17 (word-bound (save-excursion
18 (skip-chars-forward "^[:word:]")
19 (bounds-of-thing-at-point 'word))))
20 (when (and (car word-bound) (cdr word-bound))
21 (upcase-region (car word-bound) (cdr word-bound))
22 (goto-char (cdr word-bound))
23 (upcase-word following)))))
24
25;;;###autoload
26(defun +downcase-dwim (arg)
27 "Downcase words in the region, or downcase word at point.
28If the region is active, this function calls `downcase-region'.
29Otherwise, it calls `downcase-word' on the word at point (using
30`thingatpt'), and the following ARG - 1 words."
31 (interactive "*p")
32 (if (use-region-p)
33 (downcase-region (region-beginning) (region-end) (region-noncontiguous-p))
34 (let ((following (1- arg))
35 (word-bound (save-excursion
36 (skip-chars-forward "^[:word:]")
37 (bounds-of-thing-at-point 'word))))
38 (when (and (car word-bound) (cdr word-bound))
39 (downcase-region (car word-bound) (cdr word-bound))
40 (goto-char (cdr word-bound))
41 (downcase-word following)))))
42
43;;;###autoload
44(defun +capitalize-dwim (arg)
45 "Capitalize words in the region, or capitalize word at point.
46If the region is active, this function calls `capitalize-region'.
47Otherwise, it calls `capitalize-word' on the word at point (using
48`thingatpt'), and the following ARG - 1 words."
49 (interactive "*p")
50 (if (use-region-p)
51 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
52 (let ((following (1- arg))
53 (word-bound (save-excursion
54 (skip-chars-forward "^[:word:]")
55 (bounds-of-thing-at-point 'word))))
56 (when (and (car word-bound) (cdr word-bound))
57 (capitalize-region (car word-bound) (cdr word-bound))
58 (goto-char (cdr word-bound))
59 (capitalize-word following)))))
60
61;; Later on, I'll add repeat maps and stuff in here...
62
63(defvar +casing-map (let ((map (make-sparse-keymap)))
64 (define-key map "u" #'+upcase-dwim)
65 (define-key map (kbd "M-u") #'+upcase-dwim)
66 (define-key map "l" #'+downcase-dwim)
67 (define-key map (kbd "M-l") #'+downcase-dwim)
68 (define-key map "c" #'+capitalize-dwim)
69 (define-key map (kbd "M-c") #'+capitalize-dwim)
70 map)
71 "Keymap for case-related twiddling.")
72
73(define-minor-mode +casing-mode
74 "Enable easy case-twiddling commands."
75 :lighter " cC"
76 :global t
77 :keymap (let ((map (make-sparse-keymap)))
78 (define-key map (kbd "M-c") +casing-map)
79 map))
80
81(provide '+casing)
82;;; +casing.el ends here
diff --git a/lisp/+chicken.el b/lisp/+chicken.el deleted file mode 100644 index 15713f8..0000000 --- a/lisp/+chicken.el +++ /dev/null
@@ -1,34 +0,0 @@
1;;; +chicken.el --- Chicken Scheme additions -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;; Reload [[https://wiki.call-cc.org/eggref/5/awful][awful]] with a keybinding
8
9(defun +chicken-awful-reload ()
10 "Reload awful by visiting /reload."
11 (interactive)
12 (save-buffer)
13 (condition-case e
14 (url-retrieve-synchronously "http://localhost:8080/reload")
15 (file-error (progn
16 (message "Couldn't ping awful's server. Starting...")
17 (start-process "awful" (generate-new-buffer "*awful*")
18 "awful" "--development-mode" (buffer-file-name))))
19 (t (message "Some awful error occurred!"))))
20
21(defun +chicken-indentation-insinuate ()
22 "Insinuate indentation from
23https://wiki.call-cc.org/emacs#tweaking-stock-scheme-mode-indentation."
24 (defun scheme-module-indent (state indent-point normal-indent) 0)
25 (put 'module 'scheme-indent-function 'scheme-module-indent)
26 (put 'and-let* 'scheme-indent-function 1)
27 (put 'parameterize 'scheme-indent-function 1)
28 (put 'handle-exceptions 'scheme-indent-function 1)
29 (put 'when 'scheme-indent-function 1)
30 (put 'unless 'scheme-indent-function 1)
31 (put 'match 'scheme-indent-function 1))
32
33(provide '+chicken)
34;;; +chicken.el ends here
diff --git a/lisp/+circe.el b/lisp/+circe.el deleted file mode 100644 index 382f0ab..0000000 --- a/lisp/+circe.el +++ /dev/null
@@ -1,285 +0,0 @@
1;;; +circe.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require '+util)
6(require 'circe)
7
8(defgroup +circe nil
9 "Extra customizations for Circe."
10 :group 'circe)
11
12(defcustom +circe-left-margin 16
13 "The size of the margin on the left."
14 :type 'integer)
15
16(defcustom +circe-network-inhibit-autoconnect nil
17 "Servers to inhibit autoconnecting from `circe-network-options'."
18 :type '(repeat string))
19
20;;; Connecting to IRC
21
22;;;###autoload
23(defun +irc ()
24 "Connect to all IRC networks in `circe-network-options'."
25 (interactive)
26 (dolist (network (mapcar 'car circe-network-options))
27 (unless (member network +circe-network-inhibit-autoconnect)
28 (+circe-maybe-connect network))))
29
30(defun +circe-network-connected-p (network)
31 "Return t if connected to NETWORK, nil otherwise."
32 (catch 'return
33 (dolist (buffer (circe-server-buffers))
34 (with-current-buffer buffer
35 (when (string= network circe-server-network)
36 (throw 'return t))))))
37
38(defun +circe-maybe-connect (network)
39 "Connect to NETWORK, asking for confirmation to reconnect."
40 (interactive ("sNetwork: "))
41 (when (or (not (+circe-network-connected-p network))
42 (yes-or-no-p (format "Already connected to %s, reconnect? "
43 network)))
44 (circe network)))
45
46;;; Channel information
47
48(defvar-local +circe-current-topic ""
49 "Cached topic of the buffer's channel.")
50
51(defun +circe-current-topic (&optional message)
52 "Return the topic of the current channel.
53When called with optional MESSAGE non-nil, or interactively, also
54message the current topic."
55 (interactive "p")
56 (let ((topic
57 (or (save-excursion
58 (goto-char (point-max))
59 (and (re-search-backward
60 (rx (group "*** "
61 (or "Topic" "topic" "TOPIC")
62 (* (not ":")) ": ")
63 (group (+ nonl)))
64 nil t)
65 (buffer-substring-no-properties
66 (match-beginning 2) (match-end 2))))
67 +circe-current-topic)))
68 (setq +circe-current-topic topic)
69 (when message
70 (message "%s" topic))
71 topic))
72
73;;; Formatting messages
74
75(defun +circe-format-meta (string &optional no-nick)
76 "Return a format string for `lui-format' for metadata messages.
77Include nick unless NO-NICK is non-nil. If NO-NICK is a string,
78replace {nick} in the string with {NO-NICK}."
79 (cond
80 ((stringp no-nick)
81 (format "{%1$s:%2$d.%2$ds} *** %3$s"
82 no-nick (- +circe-left-margin 3) string))
83 (no-nick
84 (format (format "%%%ds *** %s" (- +circe-left-margin 3) string) " "))
85 (t
86 (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string))))
87
88(defun +circe-format-meta* (string)
89 "Return a format string for `lui-format' for metadata messages, /without/ ")
90
91(defmacro +lui-make-formatting-list-rx (char)
92 "Make a formatting regex for CHAR delimiters.
93For entry into `lui-formatting-list'."
94 `(rx (or bol whitespace)
95 (group ,char (+? (not (any whitespace ,char))) ,char)
96 (or eol whitespace)))
97
98;;; Hooks & Advice
99
100(defun +circe-chat@set-prompt ()
101 "Set the prompt to the (shortened) buffer name."
102 (interactive)
103 (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin
104 :after " > "
105 :ellipsis "~"
106 :alignment 'right))))
107
108(defun +circe-kill-buffer (&rest _)
109 "Kill a circe buffer without confirmation, and after a delay."
110 (let ((circe-channel-killed-confirmation)
111 (circe-server-killed-confirmation))
112 (when (derived-mode-p 'lui-mode) ; don't spuriously kill
113 (ignore-errors
114 (kill-buffer)))))
115
116(defun +circe-quit@kill-buffer (&rest _)
117 "ADVICE: kill all buffers of a server after `circe-command-QUIT'."
118 (with-circe-server-buffer
119 (dolist (buf (circe-server-buffers))
120 (with-current-buffer buf
121 (+circe-kill-buffer)))
122 (+circe-kill-buffer)))
123
124(defun +circe-gquit@kill-buffer (&rest _)
125 "ADVICE: kill all Circe buffers after `circe-command-GQUIT'."
126 (let ((circe-channel-killed-confirmation)
127 (circe-server-killed-confirmation))
128 (dolist (buf (circe-server-buffers))
129 (with-current-buffer buf
130 (+circe-quit@kill-buffer)))))
131
132(defun +circe-quit-all@kill-emacs ()
133 "Quit all circe buffers when killing Emacs."
134 (ignore-errors
135 (advice-remove 'circe-command-GQUIT
136 'circe-gquit@kill-buffer)
137 (circe-command-GQUIT "Quitting Emacs, bye!")))
138
139;;; Patches
140
141(require 'el-patch)
142
143(el-patch-feature circe)
144(defvar +circe-server-buffer-action 'pop-to-buffer-same-window
145 "What to do with `circe-server' buffers when created.")
146
147(el-patch-defun circe (network-or-server &rest server-options)
148 "Connect to IRC.
149
150Connect to the given network specified by NETWORK-OR-SERVER.
151
152When this function is called, it collects options from the
153SERVER-OPTIONS argument, the user variable
154`circe-network-options', and the defaults found in
155`circe-network-defaults', in this order.
156
157If NETWORK-OR-SERVER is not found in any of these variables, the
158argument is assumed to be the host name for the server, and all
159relevant settings must be passed via SERVER-OPTIONS.
160
161All SERVER-OPTIONS are treated as variables by getting the string
162\"circe-\" prepended to their name. This variable is then set
163locally in the server buffer.
164
165See `circe-network-options' for a list of common options."
166 (interactive (circe--read-network-and-options))
167 (let* ((options (circe--server-get-network-options network-or-server
168 server-options))
169 (buffer (circe--server-generate-buffer options)))
170 (with-current-buffer buffer
171 (circe-server-mode)
172 (circe--server-set-variables options)
173 (circe-reconnect))
174 (el-patch-swap (pop-to-buffer-same-window buffer)
175 (funcall +circe-server-buffer-action buffer))))
176
177;;; Chat commands
178
179(defun circe-command-SLAP (nick)
180 "Slap NICK around a bit with a large trout."
181 (interactive (list (completing-read "Nick to slap: "
182 (circe-channel-nicks)
183 nil t nil)))
184 (circe-command-ME (format "slaps %s about a bit with a large trout" nick)))
185
186;;; Filtering functions --- XXX: These don't work right.
187;; Set `lui-input-function' to `+lui-filter', then add the filters you want to
188;; `circe-channel-mode-hook'.
189
190(defvar +lui-filters nil
191 "Stack of input functions to apply.
192This is an alist with cells of the structure (TAG . FN), so we
193can easily remove elements.")
194(make-variable-buffer-local '+lui-filters)
195
196(defun +lui-filter (text &optional fn-alist)
197 (let ((fs (nreverse (purecopy (or fn-alist +lui-filters)))))
198 (while fs
199 (setq text (funcall (cdr (pop fs)) text)))
200 (circe--input text)))
201
202(defmacro +circe-define-filter (name docstring &rest body)
203 "Define a filter for circe-inputted text."
204 (declare (doc-string 2)
205 (indent 1))
206 (let (plist)
207 (while (keywordp (car-safe body))
208 (push (pop body) plist)
209 (push (pop body) plist))
210 ;; Return value
211 `(define-minor-mode ,name
212 ,docstring
213 ,@(nreverse plist)
214 (when (derived-mode-p 'circe-chat-mode)
215 (if ,name
216 (push '(,name . (lambda (it) ,@body)) +lui-filters)
217 (setq +lui-filters
218 (assoc-delete-all ',name +lui-filters)))))))
219
220;; CAPPY HOUR! (Pure idiocy)
221
222(+circe-define-filter +circe-cappy-hour-mode
223 "ENABLE CAPPY HOUR IN CIRCE!"
224 :lighter " CAPPY HOUR"
225 (upcase it))
226
227;; URL Shortener
228
229(+circe-define-filter +circe-shorten-url-mode
230 "Shorten long urls when chatting."
231 :lighter " c0x0"
232 (+circe-0x0-shorten-urls it))
233
234(defvar +circe-0x0-max-length 20
235 "Maximum length of URLs before using a shortener.")
236
237(defun +circe-0x0-shorten-urls (text)
238 "Find urls in TEXT and shorten them using `0x0'."
239 (require '0x0)
240 (require 'browse-url)
241 (let ((case-fold-search t))
242 (replace-regexp-in-string
243 browse-url-button-regexp
244 (lambda (match)
245 (if (> (length match) +circe-0x0-max-length)
246 (+with-message (format "Shortening URL: %s" match)
247 (0x0-shorten-uri (0x0--choose-server)
248 (substring-no-properties match)))
249 match))
250 text)))
251
252(defun +circe-shorten-urls-all ()
253 "Turn on `+circe-shorten-url-mode' in all chat buffers."
254 (interactive)
255 (+mapc-some-buffers
256 (lambda () (+circe-shorten-url-mode +1))
257 (lambda (buf)
258 (derived-mode-p 'circe-chat-mode))))
259
260;; Temperature conversion
261
262(+circe-define-filter +circe-F/C-mode
263 "Convert degF to degF/degC for international chats."
264 :lighter " F/C"
265 (str-F/C it))
266
267(defun fahrenheit-to-celsius (degf)
268 "Convert DEGF to Celsius."
269 (round (* (/ 5.0 9.0) (- degf 32))))
270
271(defun celsius-to-fahrenheit (degc)
272 "Convert DEGC to Fahrenheit."
273 (round (+ 32 (* (/ 9.0 5.0) degc))))
274
275(defun str-F/C (text)
276 (replace-regexp-in-string "[^.]\\([[:digit:]]+\\(?:\\.[[:digit:]]+\\)?[fF]\\)"
277 (lambda (match)
278 (format "%s/%dC" match
279 (fahrenheit-to-celsius
280 (string-to-number match))))
281 text
282 nil 1))
283
284(provide '+circe)
285;;; +circe.el ends here
diff --git a/lisp/+compat.el b/lisp/+compat.el deleted file mode 100644 index 286d5da..0000000 --- a/lisp/+compat.el +++ /dev/null
@@ -1,64 +0,0 @@
1;;; +compat.el --- Thin backward-compatibility shim -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; I use different versionso of Emacs. Sometimes I have to copy-paste functions
6;; from newer Emacs to make my customizations work. This is that file.
7
8;; This is probably ill-advised.
9
10;;; Code:
11
12;;; Load stuff in +compat/ subdirectory
13(dolist (file (directory-files (locate-user-emacs-file "lisp/+compat") :full "\\.el\\'"))
14 (load file :noerror))
15
16;;; Only define things if not already defined
17(defmacro +compat-defun (name &rest args)
18 `(if (fboundp ',name)
19 (message "+compat: `%s' already bound." ',name)
20 (defun ,name ,@args)))
21
22(defmacro +compat-defmacro (name &rest args)
23 `(if (fboundp ',name)
24 (message "+compat: `%s' already bound." ',name)
25 (defmacro ,name ,@args)))
26
27;;; Single functions
28
29(+compat-defmacro dlet (binders &rest body)
30 "Like `let' but using dynamic scoping."
31 (declare (indent 1) (debug let))
32 ;; (defvar FOO) only affects the current scope, but in order for
33 ;; this not to affect code after the main `let' we need to create a new scope,
34 ;; which is what the surrounding `let' is for.
35 ;; FIXME: (let () ...) currently doesn't actually create a new scope,
36 ;; which is why we use (let (_) ...).
37 `(let (_)
38 ,@(mapcar (lambda (binder)
39 `(defvar ,(if (consp binder) (car binder) binder)))
40 binders)
41 (let ,binders ,@body)))
42
43;; https://git.savannah.gnu.org/cgit/emacs.git/diff/?id=772b189143453745a8e014e21d4b6b78f855bba3
44(+compat-defun rename-visited-file (new-location)
45 "Rename the file visited by the current buffer to NEW-LOCATION.
46This command also sets the visited file name. If the buffer
47isn't visiting any file, that's all it does.
48
49Interactively, this prompts for NEW-LOCATION."
50 (interactive
51 (list (if buffer-file-name
52 (read-file-name "Rename visited file to: ")
53 (read-file-name "Set visited file name: "
54 default-directory
55 (expand-file-name
56 (file-name-nondirectory (buffer-name))
57 default-directory)))))
58 (when (and buffer-file-name
59 (file-exists-p buffer-file-name))
60 (rename-file buffer-file-name new-location))
61 (set-visited-file-name new-location nil t))
62
63(provide '+compat)
64;;; +compat.el ends here
diff --git a/lisp/+compile.el b/lisp/+compile.el deleted file mode 100644 index a69db7d..0000000 --- a/lisp/+compile.el +++ /dev/null
@@ -1,20 +0,0 @@
1;;; +compile.el --- Extras for compile -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(defcustom +compile-function nil
8 "Function to run to \"compile\" a buffer."
9 :type 'function
10 :local t
11 :risky nil)
12
13(defun +compile-dispatch (&optional arg)
14 "Run `+compile-function', if bound, or `compile'.
15Any prefix ARG is passed to that function."
16 (interactive "P")
17 (call-interactively (or +compile-function #'compile)))
18
19(provide '+compile)
20;;; +compile.el ends here
diff --git a/lisp/+consult.el b/lisp/+consult.el deleted file mode 100644 index 21c2565..0000000 --- a/lisp/+consult.el +++ /dev/null
@@ -1,47 +0,0 @@
1;;; +consult.el --- consult additions -*- lexical-binding: t -*-
2
3;;; Code:
4
5(defun +consult-project-root ()
6 "Return either the current project, or the VC root, of current file."
7 (if (and (functionp 'project-current)
8 (project-current))
9 (car (project-roots (project-current)))
10 (vc-root-dir)))
11
12;;; Cribbed functions
13;; https://github.com/minad/consult/wiki
14
15(defun consult--orderless-regexp-compiler (input type &rest _)
16 (setq input (orderless-pattern-compiler input))
17 (cons
18 (mapcar (lambda (r) (consult--convert-regexp r type)) input)
19 (lambda (str) (orderless--highlight input str))))
20
21(defmacro consult-history-to-modes (map-hook-alist)
22 (let (defuns)
23 (dolist (map-hook map-hook-alist)
24 (let ((map-name (symbol-name (car map-hook)))
25 (key-defs `(progn (define-key
26 ,(car map-hook)
27 (kbd "M-r")
28 (function consult-history))
29 (define-key ,(car map-hook)
30 (kbd "M-s") nil))))
31 (push (if (cdr map-hook)
32 `(add-hook ',(cdr map-hook)
33 (defun
34 ,(intern (concat map-name
35 "@consult-history-bind"))
36 nil
37 ,(concat
38 "Bind `consult-history' to M-r in "
39 map-name ".\n"
40 "Defined by `consult-history-to-modes'.")
41 ,key-defs))
42 key-defs)
43 defuns)))
44 `(progn ,@ (nreverse defuns))))
45
46(provide '+consult)
47;;; +consult.el ends here
diff --git a/lisp/+crux.el b/lisp/+crux.el deleted file mode 100644 index c55a0b9..0000000 --- a/lisp/+crux.el +++ /dev/null
@@ -1,58 +0,0 @@
1;;; +crux.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'crux)
6
7(defgroup +crux nil
8 "Extra crux customizations."
9 :group 'crux
10 :prefix "+crux-")
11
12(defun +crux-kill-ring-save (begin end arg)
13 "Copy region to the kill-ring, possibly indenting it first.
14Copy from BEGIN to END using `kill-ring-save' if no argument was
15passed, or with `crux-indent-rigidly-and-copy-to-clipboard' if
16one was."
17 (interactive "r\nP")
18 (call-interactively (if arg
19 #'crux-indent-rigidly-and-copy-to-clipboard
20 #'kill-ring-save))
21 (pulse-momentary-highlight-region begin end))
22
23(defcustom +crux-default-date-format "%c"
24 "Default date format to use for `+crux-insert-date-or-time'.
25Should be a format parsable by `format-time-string'."
26 :type 'string)
27
28(defcustom +crux-alternate-date-format "%FT%T%z"
29 "Alternate date format to use for `+crux-insert-date-or-time'.
30Should be a format parsable by `format-time-string'."
31 :type 'string)
32
33(defun +crux-insert-date-or-time (arg)
34 "Insert current date or time.
35Called without a prefix ARG, insert the time formatted by
36`+crux-default-date-format'. When called with \\[universal-argument],
37format the time with `+crux-alternate-date-format'. Otherwise,
38prompt for the time format."
39 (interactive "*P")
40 (let ((time (current-time)))
41 (insert (cond
42 ((null arg) (format-time-string +crux-default-date-format time))
43 ((eq (car-safe arg) 4)
44 (format-time-string +crux-alternate-date-format time))
45 (t (format-time-string (read-string "Time Format: ") time))))))
46
47(defun +crux-kill-and-join-forward (&optional arg)
48 "If at end of line, join with following; else (visual)-kill line.
49In `visual-line-mode', runs command `kill-visual-line'; in other
50modes, runs command `kill-line'. Passes ARG to command when
51provided. Deletes whitespace at join."
52 (interactive "P")
53 (if (and (eolp) (not (bolp)))
54 (delete-indentation 1)
55 (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg)))
56
57(provide '+crux)
58;;; +crux.el ends here
diff --git a/lisp/+cus-edit.el b/lisp/+cus-edit.el deleted file mode 100644 index a67279c..0000000 --- a/lisp/+cus-edit.el +++ /dev/null
@@ -1,80 +0,0 @@
1;;; +cus-edit.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; The naming convention for this library, called "cus-edit.el" on the
6;; filesystem, is all over the damn place. Whatever.
7
8;;; Code:
9
10(require 'cl-lib)
11(require 'seq)
12
13(defgroup +customize nil
14 "Extra customize customizations."
15 :prefix "+customize-"
16 :group 'customize)
17
18(defcustom +cus-edit-imenu-generic-expression ; thanks u/oantolin!
19 `(("Faces" ,(rx (seq bol
20 (or "Show" "Hide") " "
21 (group (zero-or-more nonl))
22 " face: [sample]"))
23 1)
24 ("Variables" ,(rx (seq bol
25 (or "Show Value" "Hide") " "
26 (group (zero-or-more
27 (not (any "\n:"))))))
28 1))
29 "Show faces and variables in `imenu' in a `customize' buffer."
30 :type 'sexp ; This is .. over-simplified.
31 )
32
33(defcustom +custom-variable-allowlist nil
34 "Variables to allow changing while loading the Custom file.")
35
36(defcustom +custom-after-load-hook nil
37 "Functions to run after loading the custom file.")
38
39(defun +custom-load-ignoring-most-customizations (&optional
40 error
41 nomessage
42 nosuffix
43 must-suffix)
44 "Load `custom-file', ignoring most customizations.
45Ignore all faces, and only load variables in
46`+customize-variable-allowlist'. All the optional
47variables---ERROR, NOMESSAGE, NOSUFFIX, MUST-SUFFIX---are
48passed on to `load'.
49
50NOTE: ERROR is the opposite of its value in `load' -- meaning
51that this function by default does /not/ error, but will if you
52pass t to it."
53 (cl-letf (((symbol-function 'custom-set-faces) 'ignore)
54 ((symbol-function 'custom-set-variables)
55 (lambda (&rest args)
56 (apply #'custom-theme-set-variables 'user
57 (seq-filter (lambda (el)
58 (memq (car el)
59 +custom-variable-allowlist))
60 args)))))
61 (load custom-file (not error) nomessage nosuffix must-suffix))
62 (run-hooks '+custom-after-load-hook))
63
64(defun +cus-edit-expand-widgets (&rest _)
65 "Expand descriptions in `Custom-mode' buffers."
66 (interactive)
67 ;; "More/Hide" widgets (thanks alphapapa!)
68 (widget-map-buttons (lambda (widget _)
69 (pcase (widget-get widget :off)
70 ("More" (widget-apply-action widget)))
71 nil))
72 ;; "Show Value" widgets (the little triangles)
73 (widget-map-buttons (lambda (widget _)
74 (pcase (widget-get widget :off)
75 ("Show Value"
76 (widget-apply-action widget)))
77 nil)))
78
79(provide '+cus-edit)
80;;; +cus-edit.el ends here
diff --git a/lisp/+dired.el b/lisp/+dired.el deleted file mode 100644 index 2e42c19..0000000 --- a/lisp/+dired.el +++ /dev/null
@@ -1,28 +0,0 @@
1;;; +dired.el -*- lexical-binding: t -*-
2
3;;; Code:
4
5(with-eval-after-load 'vertico
6 (defun +dired-goto-file (file)
7 "ADVICE for `dired-goto-file' to make RET call `vertico-exit'."
8 (interactive ; stolen from `dired-goto-file'
9 (prog1
10 (list (dlet ((vertico-map (copy-keymap vertico-map)))
11 (define-key vertico-map (kbd "RET") #'vertico-exit)
12 (expand-file-name (read-file-name "Goto file: "
13 (dired-current-directory)))))
14 (push-mark)))
15 (dired-goto-file file)))
16
17;;; [[https://www.reddit.com/r/emacs/comments/u2lf9t/weekly_tips_tricks_c_thread/i4n9aoa/?context=3][Dim files in .gitignore]]
18
19(defun +dired-dim-git-ignores ()
20 "Dim out .gitignore contents"
21 (require 'vc)
22 (when-let ((ignores (vc-default-ignore-completion-table 'git ".gitignore"))
23 (exts (make-local-variable 'completion-ignored-extensions)))
24 (dolist (item ignores)
25 (add-to-list exts item))))
26
27(provide '+dired)
28;;; +dired.el ends here
diff --git a/lisp/+ecomplete.el b/lisp/+ecomplete.el deleted file mode 100644 index b1392cf..0000000 --- a/lisp/+ecomplete.el +++ /dev/null
@@ -1,45 +0,0 @@
1;;; +ecomplete.el --- ecomplete extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; see [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/ecomplete-extras.el][oantolin's config]]
6
7;;; Code:
8
9(require 'ecomplete)
10
11(defun +ecomplete--name+address (email)
12 "Return a pair of the name and address for an EMAIL."
13 (let (name)
14 (when (string-match "^\\(?:\\(.*\\) \\)?<\\(.*\\)>$" email)
15 (setq name (match-string 1 email)
16 email (match-string 2 email)))
17 (cons name email)))
18
19(defun +ecomplete-add-email (email)
20 "Add email address to ecomplete's database."
21 (interactive "sEmail address: ")
22 (pcase-let ((`(,name . ,email) (+ecomplete--name+address email)))
23 (unless name (setq name (read-string "Name: ")))
24 (ecomplete-add-item
25 'mail email
26 (format (cond ((equal name "") "%s%s")
27 ((string-match-p "^\\(?:[A-Za-z0-9 ]*\\|\".*\"\\)$" name)
28 "%s <%s>")
29 (t "\"%s\" <%s>"))
30 name email))
31 (ecomplete-save)))
32
33(defun +ecomplete-remove-email (email)
34 "Remove email address from ecomplete's database."
35 (interactive
36 (list (completing-read "Email address: "
37 (ecomplete-completion-table 'mail))))
38 (when-let ((email (cdr (+ecomplete--name+address email)))
39 (entry (ecomplete-get-item 'mail email)))
40 (setf (cdr (assq 'mail ecomplete-database))
41 (remove entry (cdr (assq 'mail ecomplete-database))))
42 (ecomplete-save)))
43
44(provide '+ecomplete)
45;;; +ecomplete.el ends here
diff --git a/lisp/+elfeed.el b/lisp/+elfeed.el deleted file mode 100644 index c3e5301..0000000 --- a/lisp/+elfeed.el +++ /dev/null
@@ -1,185 +0,0 @@
1;;; +elfeed.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'elfeed)
6
7;; https://karthinks.com/software/lazy-elfeed/
8(defun +elfeed-scroll-up-command (&optional arg)
9 "Scroll up or go to next feed item in Elfeed"
10 (interactive "^P")
11 (let ((scroll-error-top-bottom nil))
12 (condition-case-unless-debug nil
13 (scroll-up-command arg)
14 (error (elfeed-show-next)))))
15
16(defun +elfeed-scroll-down-command (&optional arg)
17 "Scroll up or go to next feed item in Elfeed"
18 (interactive "^P")
19 (let ((scroll-error-top-bottom nil))
20 (condition-case-unless-debug nil
21 (scroll-down-command arg)
22 (error (elfeed-show-prev)))))
23
24(defun +elfeed-search-browse-generic ()
25 "Browse a url with `browse-url-generic-browser'."
26 (interactive)
27 (elfeed-search-browse-url t))
28
29(defun +elfeed-show-browse-generic ()
30 "Browse a url with `browse-url-generic-browser'."
31 (interactive)
32 (elfeed-show-visit t))
33
34(defun +elfeed-show-mark-read-and-advance ()
35 "Mark an item as read and advance to the next item.
36If multiple items are selected, don't advance."
37 (interactive)
38 (call-interactively #'elfeed-search-untag-all-unread)
39 (unless (region-active-p)
40 (call-interactively #'next-line)))
41
42;;; Fetch feeds async
43;; https://github.com/skeeto/elfeed/issues/367
44
45(defun +elfeed--update-message ()
46 (message "[Elfeed] Update in progress")
47 'ignore)
48
49(defvar +elfeed--update-running-p nil "Whether an update is currently running.")
50(defvar +elfeed--update-count 0 "How many times `+elfeed-update-command' has run.")
51(defcustom +elfeed-update-niceness 15
52 "How \"nice\" `+elfeed-update-command' should be."
53 :type 'integer
54 :group 'elfeed)
55
56(defcustom +elfeed-update-lockfile
57 (expand-file-name "+elfeed-update-lock" (temporary-file-directory))
58 "The file to ")
59
60(defun +elfeed-update-command ()
61 (interactive)
62 (unless (or +elfeed--update-running-p
63 (derived-mode-p 'elfeed-show-mode 'elfeed-search-mode))
64 (let ((script (expand-file-name "/tmp/elfeed-update.el"))
65 (update-message-format "[Elfeed] Background update: %s"))
66 (setq +elfeed--update-running-p t)
67 (elfeed-db-save)
68 (advice-add 'elfeed :override #'+elfeed--update-message)
69 (ignore-errors (kill-buffer "*elfeed-search*"))
70 (ignore-errors (kill-buffer "*elfeed-log*"))
71 (elfeed-db-unload)
72 (make-directory (file-name-directory script) :parents)
73 (with-temp-buffer
74 (insert
75 (let ((print-level nil)
76 (print-length nil))
77 (prin1-to-string ;; Print the following s-expression to a string
78 `(progn
79 ;; Set up the environment
80 (setq lexical-binding t)
81 (load (locate-user-emacs-file "early-init"))
82 (dolist (pkg '(elfeed elfeed-org))
83 (straight-use-package pkg)
84 (require pkg))
85 ;; Copy variables from current environment
86 (progn
87 ,@(cl-loop for copy-var in '(rmh-elfeed-org-files
88 elfeed-db-directory
89 elfeed-curl-program-name
90 elfeed-use-curl
91 elfeed-curl-extra-arguments
92 elfeed-enclosure-default-dir)
93 collect `(progn (message "%S = %S" ',copy-var ',(symbol-value copy-var))
94 (setq ,copy-var ',(symbol-value copy-var)))))
95 ;; Define new variables for this environment
96 (progn
97 ,@(cl-loop for (new-var . new-val) in '((elfeed-curl-max-connections . 4))
98 collect `(progn (message "%S = %S" ',new-var ',new-val)
99 (setq ,new-var ',new-val))))
100 ;; Redefine `elfeed-log' to log everything
101 (defun elfeed-log (level fmt &rest objects)
102 (princ (format "[%s] [%s]: %s\n"
103 (format-time-string "%F %T")
104 level
105 (apply #'format fmt objects))))
106 ;; Run elfeed
107 (elfeed-org)
108 (elfeed)
109 (elfeed-db-load)
110 (elfeed-update)
111 ;; Wait for `elfeed-update' to finish
112 (let ((q<5-count 0))
113 (while (and (> (elfeed-queue-count-total) 0)
114 (< q<5-count 5))
115 (sleep-for 5)
116 (message "Elfeed queue count total: %s" (elfeed-queue-count-total))
117 (when (< (elfeed-queue-count-total) 5)
118 (cl-incf q<5-count))
119 (accept-process-output)))
120 ;; Garbage collect and save the database
121 (elfeed-db-gc)
122 (elfeed-db-save)
123 (princ (format ,update-message-format "done."))))))
124 (write-file script))
125 (chmod script #o777)
126 (message update-message-format "start")
127 (set-process-sentinel (start-process-shell-command
128 "Elfeed" "*+elfeed-update-background*"
129 (format "nice -n %d %s %s"
130 +elfeed-update-niceness
131 "emacs -Q --script"
132 script))
133 (lambda (proc stat)
134 (advice-remove 'elfeed #'+elfeed--update-message)
135 (setq +elfeed--update-running-p nil)
136 (unless (string= stat "killed")
137 (setq +elfeed--update-count (1+ +elfeed--update-count)))
138 (message update-message-format (string-trim stat)))))))
139
140(defvar +elfeed--update-timer nil "Timer for `elfeed-update-command'.")
141(defvar +elfeed--update-first-time 6 "How long to wait for the first time.")
142(defvar +elfeed--update-repeat (* 60 15) "How long between updates.")
143
144(defcustom +elfeed-update-proceed-hook nil
145 "Predicates to query before running `+elfeed-update-command'.
146Each hook is passed no arguments."
147 :type 'hook)
148
149(defun +elfeed-update-command-wrapper ()
150 "Run `+elfeed-update-command', but only sometimes.
151If any of the predicates in `+elfeed-update-proceed-hook' return
152nil, don't run `+elfeed-update-command'. If they all return
153non-nil, proceed."
154 (when (run-hook-with-args-until-failure '+elfeed-update-proceed-hook)
155 (+elfeed-update-command)))
156
157(defun +elfeed--cancel-update-timer ()
158 "Cancel `+elfeed--update-timer'."
159 (unless +elfeed--update-running-p
160 (ignore-errors (cancel-timer +elfeed--update-timer))
161 (setq +elfeed--update-timer nil)))
162
163(defun +elfeed--reinstate-update-timer ()
164 "Reinstate `+elfeed--update-timer'."
165 ;; First, unload the db
166 (setq +elfeed--update-timer
167 (run-at-time +elfeed--update-first-time
168 +elfeed--update-repeat
169 #'+elfeed-update-command-wrapper)))
170
171(define-minor-mode +elfeed-update-async-mode
172 "Minor mode to update elfeed async-style."
173 :global t
174 (if +elfeed-update-async-mode
175 (progn ; enable
176 (+elfeed--reinstate-update-timer)
177 (advice-add 'elfeed :before '+elfeed--cancel-update-timer)
178 (advice-add 'elfeed-search-quit-window :after '+elfeed--reinstate-update-timer))
179 (progn ; disable
180 (advice-remove 'elfeed '+elfeed--cancel-update-timer)
181 (advice-remove 'elfeed-search-quit-window '+elfeed--reinstate-update-timer)
182 (+elfeed--cancel-update-timer))))
183
184(provide '+elfeed)
185;;; +elfeed.el ends here
diff --git a/lisp/+elisp.el b/lisp/+elisp.el deleted file mode 100644 index 3eafbf3..0000000 --- a/lisp/+elisp.el +++ /dev/null
@@ -1,18 +0,0 @@
1;;; +elisp.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defun +elisp-eval-region-or-buffer ()
6 (interactive)
7 (if (region-active-p)
8 (eval-region (region-beginning) (region-end))
9 (+eval-region@pulse (lambda (_ _) (eval-buffer)) (point-min) (point-max))))
10
11;; Should I move this to `+pulse' ?
12(defun +eval-region@pulse (advised beg end &rest args)
13 "ADVICE to pulse an eval'd region."
14 (apply advised beg end args)
15 (pulse-momentary-highlight-region beg end))
16
17(provide '+elisp)
18;;; +elisp.el ends here
diff --git a/lisp/+emacs.el b/lisp/+emacs.el deleted file mode 100644 index 9158b62..0000000 --- a/lisp/+emacs.el +++ /dev/null
@@ -1,434 +0,0 @@
1;;; +emacs.el --- measured defaults for Emacs -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; I find myself copy-pasting a lot of "boilerplate" type code when
6;; bankrupting my Emacs config and starting afresh. Instead of doing
7;; that, I'm putting it here, where it'll be easier to include in my
8;; config.
9
10;; Of course, some might say I could just ... stop bankrupting my
11;; Emacs. But like, why would I want to?
12
13;; Other notable packages include
14;; - https://git.sr.ht/~technomancy/better-defaults/
15;; - https://github.com/susam/emfy
16
17;;; Code:
18
19(require 'early-init (locate-user-emacs-file "early-init.el"))
20
21(defun +set-major-mode-from-buffer-name (&optional buf)
22 "Set the major mode for BUF from the buffer's name.
23Do this only if the buffer is not visiting a file."
24 (unless buffer-file-name
25 (let ((buffer-file-name (buffer-name buf)))
26 (set-auto-mode))))
27
28
29;;; General settings
30
31(setq-default
32 apropos-do-all t
33 async-shell-command-buffer 'new-buffer
34 async-shell-command-display-buffer nil
35 auto-hscroll-mode 'current-line
36 auto-revert-verbose t
37 auto-save-default nil
38 auto-save-file-name-transforms `((".*" ,(.etc "auto-save/") ,(car (secure-hash-algorithms)))
39 (".*" ,(.etc "auto-save/") t))
40 auto-save-interval 30
41 auto-save-list-file-prefix (.etc "auto-save/.saves-" t)
42 auto-save-timeout 30
43 auto-save-visited-interval 5
44 auto-window-vscroll nil
45 backup-by-copying t
46 backup-directory-alist `((".*" . ,(.etc "backup/" t)))
47 blink-cursor-blinks 1
48 comp-deferred-compilation nil
49 completion-category-defaults nil
50 completion-category-overrides '((file (styles . (partial-completion))))
51 completion-ignore-case t
52 completion-styles '(substring partial-completion)
53 create-lockfiles nil
54 cursor-in-non-selected-windows 'hollow
55 cursor-type 'bar
56 custom-file (.etc "custom.el")
57 delete-old-versions t
58 echo-keystrokes 0.1
59 ediff-window-setup-function 'ediff-setup-windows-plain
60 eldoc-echo-area-use-multiline-p nil
61 eldoc-idle-delay 0.1
62 enable-recursive-minibuffers t
63 executable-prefix-env t
64 fast-but-imprecise-scrolling t
65 file-name-shadow-properties '(invisible t intangible t)
66 fill-column 80
67 find-file-visit-truename t
68 frame-resize-pixelwise t
69 global-auto-revert-non-file-buffers t
70 global-mark-ring-max 100
71 hscroll-margin 1
72 hscroll-step 1
73 imenu-auto-rescan t
74 image-use-external-converter (or (executable-find "convert")
75 (executable-find "gm")
76 (executable-find "ffmpeg"))
77 indent-tabs-mode nil
78 inhibit-startup-screen t
79 initial-buffer-choice t
80 kept-new-versions 6
81 kept-old-versions 2
82 kill-do-not-save-duplicates t
83 kill-read-only-ok t
84 kill-ring-max 500
85 kmacro-ring-max 20
86 load-prefer-newer noninteractive
87 major-mode '+set-major-mode-from-buffer-name
88 mark-ring-max 50
89 minibuffer-eldef-shorten-default t
90 minibuffer-prompt-properties (list 'read-only t
91 'cursor-intangible t
92 'face 'minibuffer-prompt)
93 mode-require-final-newline 'visit-save
94 mouse-drag-copy-region t
95 mouse-wheel-progressive-speed nil
96 mouse-yank-at-point t
97 native-comp-async-report-warnings-errors 'silent
98 native-comp-deferred-compilation nil
99 read-answer-short t
100 read-buffer-completion-ignore-case t
101 ;; read-extended-command-predicate
102 ;; (when (fboundp
103 ;; 'command-completion-default-include-p)
104 ;; 'command-completion-default-include-p)
105 read-process-output-max (+bytes 1 :mib) ; We’re in the future man. Set that to at least a megabyte
106 recenter-positions '(top middle bottom)
107 regexp-search-ring-max 100
108 regexp-search-ring-max 200
109 save-interprogram-paste-before-kill t
110 save-some-buffers-default-predicate #'+save-some-buffers-p
111 scroll-conservatively 101
112 scroll-down-aggressively 0.01
113 scroll-margin 2
114 scroll-preserve-screen-position 1
115 scroll-step 1
116 scroll-up-aggressively 0.01
117 search-ring-max 200
118 search-ring-max 200
119 sentence-end-double-space t
120 set-mark-command-repeat-pop t
121 show-paren-delay 0
122 show-paren-style 'parenthesis
123 show-paren-when-point-in-periphery t
124 show-paren-when-point-inside-paren t
125 ;;show-trailing-whitespace t
126 tab-bar-show 1
127 tab-width 8 ; so alignment expecting the default looks right
128 tramp-backup-directory-alist backup-directory-alist
129 undo-limit 100000000 ; 10 MB
130 use-dialog-box nil
131 use-file-dialog nil
132 use-short-answers t
133 vc-follow-symlinks t
134 vc-make-backup-files t
135 version-control t
136 view-read-only t
137 visible-bell nil
138 window-resize-pixelwise t
139 x-select-enable-clipboard t
140 x-select-enable-primary t
141 yank-pop-change-selection t
142 )
143
144;; Programming language offsets.
145;; Set these after the initial block so I can use `tab-width'
146(setq-default
147 c-basic-offset tab-width)
148
149;; Emacs 28 ships with an option, `use-short-answers', that makes this form
150;; obsolete, but I still use 27 at work.
151(when (version< emacs-version "28")
152 (fset 'yes-or-no-p 'y-or-n-p))
153
154
155;;; Encodings
156
157;; Allegedly, this is the only one you need...
158(set-language-environment "UTF-8")
159;; But I still set all of these, for fun.
160(setq-default locale-coding-system 'utf-8-unix
161 coding-system-for-read 'utf-8-unix
162 coding-system-for-write 'utf-8-unix
163 buffer-file-coding-system 'utf-8-unix
164 default-process-coding-system '(utf-8-unix . utf-8-unix)
165 x-select-request-type '(UTF8_STRING
166 COMPOUND_TEXT
167 TEXT
168 STRING))
169
170(set-charset-priority 'unicode)
171(prefer-coding-system 'utf-8-unix)
172(set-default-coding-systems 'utf-8-unix)
173(set-terminal-coding-system 'utf-8-unix)
174(set-keyboard-coding-system 'utf-8-unix)
175
176(pcase system-type
177 ((or 'ms-dos 'windows-nt)
178 (set-clipboard-coding-system 'utf-16-le)
179 (set-selection-coding-system 'utf-16-le))
180 (_
181 (set-selection-coding-system 'utf-8)
182 (set-clipboard-coding-system 'utf-8)))
183
184
185;;; Modes
186
187(dolist (enable-mode '(global-auto-revert-mode
188 blink-cursor-mode
189 electric-pair-mode
190 show-paren-mode
191 global-so-long-mode
192 minibuffer-depth-indicate-mode
193 file-name-shadow-mode
194 minibuffer-electric-default-mode
195 delete-selection-mode
196 auto-save-visited-mode
197 ;; column-number-mode
198 ))
199 (when (fboundp enable-mode)
200 (funcall enable-mode +1)))
201
202(dolist (disable-mode '(tooltip-mode
203 tool-bar-mode
204 menu-bar-mode
205 scroll-bar-mode
206 horizontal-scroll-bar-mode))
207 (when (fboundp disable-mode)
208 (funcall disable-mode -1)))
209
210
211;;; Hooks
212
213(add-hook 'after-save-hook #'executable-make-buffer-file-executable-if-script-p)
214(add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
215
216(defun +auto-create-missing-dirs ()
217 "Automatically create missing directories when finding a file."
218 ;; https://emacsredux.com/blog/2022/06/12/auto-create-missing-directories/
219 (let ((target-dir (file-name-directory buffer-file-name)))
220 (unless (file-exists-p target-dir)
221 (make-directory target-dir t))))
222
223(add-hook 'find-file-not-found-functions #'+auto-create-missing-dirs)
224
225(defvar +save-some-buffers-debounce-time nil
226 "Last time `+save-some-buffers-debounce' was run.")
227
228(defcustom +save-some-buffers-debounce-timeout 5
229 "Number of seconds to wait before saving buffers again.")
230
231(defun +save-some-buffers-debounce (&rest _)
232 "Run `save-some-buffers', but only if it's been a while."
233 (unless (and +save-some-buffers-debounce-time
234 (< (- (time-convert nil 'integer) +save-some-buffers-debounce-time)
235 +save-some-buffers-debounce-timeout))
236 (save-some-buffers t)
237 (setq +save-some-buffers-debounce-time (time-convert nil 'integer))))
238
239(add-function :after after-focus-change-function #'+save-some-buffers-debounce)
240
241
242;;; Better-default functions ...
243
244(defun +cycle-spacing (&optional n preserve-nl-back mode)
245 "Negate N argument on `cycle-spacing'.
246That is, with a positive N, deletes newlines as well, leaving -N
247spaces. If N is negative, it will not delete newlines and leave
248N spaces. See docstring of `cycle-spacing' for the meaning of
249PRESERVE-NL-BACK and MODE."
250 (interactive "*p")
251 (cycle-spacing (- n) preserve-nl-back mode))
252
253(defun +save-buffers-quit (&optional arg)
254 "Silently save each buffer, then kill the current connection.
255If the current frame has no client, kill Emacs itself using
256`save-buffers-kill-emacs' after confirming with the user.
257
258With prefix ARG, silently save all file-visiting buffers, then
259kill without asking."
260 (interactive "P")
261 (save-some-buffers t)
262 (if (and (not (frame-parameter nil 'client))
263 (and (not arg)))
264 (when (yes-or-no-p "Sure you want to quit? ")
265 (save-buffers-kill-emacs))
266 (delete-frame nil :force)))
267
268(defun +kill-word-backward-or-region (&optional arg backward-kill-word-fn)
269 "Kill active region or ARG words backward.
270BACKWARD-KILL-WORD-FN is the function to call to kill a word
271backward. It defaults to `backward-kill-word'."
272 (interactive "P")
273 (call-interactively (if (region-active-p)
274 #'kill-region
275 (or backward-kill-word-fn #'backward-kill-word))))
276
277(defun +backward-kill-word-wrapper (fn &optional arg)
278 "Kill backward using FN until the beginning of a word, smartly.
279If point is on at the beginning of a line, kill the previous new
280line. If the only thing before point on the current line is
281whitespace, kill that whitespace.
282
283With argument ARG: if ARG is a number, just call FN
284ARG times. Otherwise, just call FN."
285 ;; I want this to be a wrapper so that I can call other word-killing functions
286 ;; with it. It's *NOT* advice because those functions probably use
287 ;; `backward-kill-word' under the hood (looking at you, paredit), so advice
288 ;; will make things weird.
289 (if (null arg)
290 (cond
291 ((looking-back "^" 1)
292 (let ((delete-active-region nil))
293 (delete-backward-char 1)))
294 ((looking-back "^[ ]*")
295 (delete-horizontal-space :backward-only))
296 (t (call-interactively fn)))
297 (funcall fn (if (listp arg) 1 arg))))
298
299(defun +backward-kill-word (&optional arg)
300 "Kill word backward using `backward-kill-word'.
301ARG is passed to `backward-kill-word'."
302 (interactive "P")
303 (+backward-kill-word-wrapper #'backward-kill-word arg))
304
305;;; ... and advice
306
307;; Indent the region after a yank.
308(defun +yank@indent (&rest _)
309 "Indent the current region."
310 (indent-region (min (point) (mark)) (max (point) (mark))))
311(advice-add #'yank :after #'+yank@indent)
312(advice-add #'yank-pop :after #'+yank@indent)
313
314
315;;; Extra functions
316
317(defun +save-some-buffers-p ()
318 "Predicate for `save-some-buffers-default-predicate'.
319It returns nil with remote files and those without attached files."
320 (and (buffer-file-name)
321 (not (file-remote-p (buffer-file-name)))))
322
323;; https://www.wwwtech.de/articles/2013/may/emacs:-jump-to-matching-paren-beginning-of-block
324(defun +goto-matching-paren (&optional arg)
325 "Go to the matching paren, similar to vi's %."
326 (interactive "p")
327 (or arg (setq arg 1))
328 (cond
329 ;; Check for "outside of bracket" positions
330 ((looking-at "[\[\(\{]") (forward-sexp arg))
331 ((looking-back "[\]\)\}]" 1) (backward-sexp arg))
332 ;; Otherwise, move from inside the bracket
333 ((looking-at "[\]\)\}]") (forward-char) (backward-sexp arg))
334 ((looking-back "[\[\(\{]" 1) (backward-char) (forward-sexp arg))
335 (t (up-list arg t t))))
336
337(defun +delete-window-or-bury-buffer ()
338 "Delete the current window, or bury the current buffer.
339If the current window is the only window, bury the buffer."
340 (interactive)
341 (condition-case e
342 (delete-window)
343 (t (bury-buffer))))
344
345
346;;; Bindings
347
348(global-set-key (kbd "C-x C-c") #'+save-buffers-quit)
349(global-set-key (kbd "M-SPC") #'+cycle-spacing)
350(global-set-key (kbd "M-/") #'hippie-expand)
351(global-set-key (kbd "M-=") #'count-words)
352(global-set-key (kbd "C-x C-b") #'ibuffer)
353(global-set-key (kbd "C-s") #'isearch-forward-regexp)
354(global-set-key (kbd "C-r") #'isearch-backward-regexp)
355(global-set-key (kbd "C-M-s") #'isearch-forward)
356(global-set-key (kbd "C-M-r") #'isearch-backward)
357(global-set-key (kbd "C-x 4 n") #'clone-buffer)
358;; https://christiantietze.de/posts/2022/07/shift-click-in-emacs-to-select/
359(global-set-key (kbd "S-<down-mouse-1>") #'mouse-set-mark)
360(global-set-key (kbd "C-x 0") #'+delete-window-or-bury-buffer)
361
362
363;;; Required libraries
364
365(when (require 'uniquify nil :noerror)
366 (setq-default uniquify-buffer-name-style 'forward
367 uniquify-separator path-separator
368 uniquify-after-kill-buffer-p t
369 uniquify-ignore-buffers-re "^\\*"))
370
371(when (require 'goto-addr)
372 (if (fboundp 'global-goto-address-mode)
373 (global-goto-address-mode +1)
374 (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
375
376(when (require 'recentf nil :noerror)
377 (setq-default recentf-save-file (.etc "recentf.el")
378 recentf-max-menu-items 100
379 recentf-max-saved-items nil
380 recentf-auto-cleanup 'mode)
381 (add-to-list 'recentf-exclude .etc)
382 (recentf-mode +1))
383
384(when (require 'savehist nil :noerror)
385 (setq-default history-length t
386 history-delete-duplicates t
387 history-autosave-interval 60
388 savehist-file (.etc "savehist.el")
389 ;; Other variables --- don't truncate any of these.
390 ;; `add-to-history' uses the values of these variables unless
391 ;; they're nil, in which case it falls back to `history-length'.
392 kill-ring-max 100
393 mark-ring-max 100
394 global-mark-ring-max 100
395 regexp-search-ring-max 100
396 search-ring-max 100
397 kmacro-ring-max 100
398 eww-history-limit 100)
399 (dolist (var '(extended-command-history
400 global-mark-ring
401 mark-ring
402 kill-ring
403 kmacro-ring
404 regexp-search-ring
405 search-ring))
406 (add-to-list 'savehist-additional-variables var))
407 (savehist-mode +1))
408
409(when (require 'saveplace nil :noerror)
410 (setq-default save-place-file (.etc "places.el")
411 save-place-forget-unreadable-files (eq system-type 'gnu/linux))
412 (save-place-mode +1))
413
414;; (when (require 'tramp)
415;; ;; thanks Irreal! https://irreal.org/blog/?p=895
416;; (add-to-list 'tramp-default-proxies-alist
417;; '(nil "\\`root\\'" "/ssh:%h:"))
418;; (add-to-list 'tramp-default-proxies-alist
419;; '((regexp-quote (system-name)) nil nil)))
420
421
422;;; Newer features
423;; These aren't in older version of Emacs, but they're so nice.
424
425(when (fboundp 'repeat-mode)
426 (setq-default repeat-exit-key "g"
427 repeat-exit-timeout 5)
428 (repeat-mode +1))
429
430(when (fboundp 'pixel-scroll-precision-mode)
431 (pixel-scroll-precision-mode +1))
432
433(provide '+emacs)
434;;; +emacs.el ends here
diff --git a/lisp/+embark.el b/lisp/+embark.el deleted file mode 100644 index e66d4b3..0000000 --- a/lisp/+embark.el +++ /dev/null
@@ -1,28 +0,0 @@
1;;; +embark.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; https://github.com/oantolin/embark/wiki/Additional-Actions
6
7;;; Code:
8
9(require 'embark)
10
11(embark-define-keymap embark-straight-map
12 ("u" straight-visit-package-website)
13 ("r" straight-get-recipe)
14 ("i" straight-use-package)
15 ("c" straight-check-package)
16 ("F" straight-pull-package)
17 ("f" straight-fetch-package)
18 ("p" straight-push-package)
19 ("n" straight-normalize-package)
20 ("m" straight-merge-package))
21
22(add-to-list 'embark-keymap-alist '(straight . embark-straight-map))
23
24(with-eval-after-load 'marginalia
25 (add-to-list 'marginalia-prompt-categories '("recipe\\|package" . straight)))
26
27(provide '+embark)
28;;; +embark.el ends here
diff --git a/lisp/+emms.el b/lisp/+emms.el deleted file mode 100644 index 403cbff..0000000 --- a/lisp/+emms.el +++ /dev/null
@@ -1,46 +0,0 @@
1;;; +emms.el --- EMMS customizations -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'emms-player-mpv)
8(require 'el-patch)
9
10;; https://lists.gnu.org/archive/html/emms-help/2022-01/msg00006.html
11(el-patch-feature emms-player-mpv)
12(with-eval-after-load 'emms-player-mpv
13 (el-patch-defun emms-player-mpv-start (track)
14 (setq emms-player-mpv-stopped nil)
15 (emms-player-mpv-proc-playing nil)
16 (let
17 ((track-name (emms-track-get track 'name))
18 (track-is-playlist (memq (emms-track-get track 'type)
19 '(streamlist playlist))))
20 (if (emms-player-mpv-ipc-fifo-p)
21 (progn
22 ;; ipc-stop is to clear any buffered commands
23 (emms-player-mpv-ipc-stop)
24 (emms-player-mpv-proc-init (if track-is-playlist "--playlist" "--")
25 track-name)
26 (emms-player-started emms-player-mpv))
27 (let*
28 ((play-cmd
29 `(batch
30 ((,(el-patch-swap
31 (if track-is-playlist 'loadlist 'loadfile)
32 'loadfile)
33 ,track-name replace))
34 ((set pause no))))
35 (start-func
36 ;; Try running play-cmd and retry it on connection failure, e.g. if mpv died
37 (apply-partially 'emms-player-mpv-cmd play-cmd
38 (lambda (_mpv-data mpv-error)
39 (when (eq mpv-error 'connection-error)
40 (emms-player-mpv-cmd play-cmd))))))
41 (if emms-player-mpv-ipc-stop-command
42 (setq emms-player-mpv-ipc-stop-command start-func)
43 (funcall start-func)))))))
44
45(provide '+emms)
46;;; +emms.el ends here
diff --git a/lisp/+eshell.el b/lisp/+eshell.el deleted file mode 100644 index b874141..0000000 --- a/lisp/+eshell.el +++ /dev/null
@@ -1,126 +0,0 @@
1;;; +eshell.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5;; https://karthinks.com/software/jumping-directories-in-eshell/
6(defun eshell/z (&optional regexp)
7 "Navigate to a previously visited directory in eshell, or to
8any directory proferred by `consult-dir'."
9 (let ((eshell-dirs (delete-dups
10 (mapcar 'abbreviate-file-name
11 (ring-elements eshell-last-dir-ring)))))
12 (cond
13 ((and (not regexp) (featurep 'consult-dir))
14 (let* ((consult-dir--source-eshell `(:name "Eshell"
15 :narrow ?e
16 :category file
17 :face consult-file
18 :items ,eshell-dirs))
19 (consult-dir-sources (cons consult-dir--source-eshell
20 consult-dir-sources)))
21 (eshell/cd (substring-no-properties
22 (consult-dir--pick "Switch directory: ")))))
23 (t (eshell/cd (if regexp (eshell-find-previous-directory regexp)
24 (completing-read "cd: " eshell-dirs)))))))
25
26;;; Start and quit
27
28;; from https://old.reddit.com/r/emacs/comments/1zkj2d/advanced_usage_of_eshell/
29(defun +eshell-here ()
30 "Go to eshell and set current directory to current buffer's."
31 ;; consider: make a new eshell buffer when given a prefix argument.
32 (interactive)
33 (let ((dir (file-name-directory (or (buffer-file-name)
34 default-directory))))
35 (eshell)
36 (eshell/pushd ".")
37 (cd dir)
38 (goto-char (point-max))
39 (eshell-kill-input)
40 (eshell-send-input)
41 (setq-local scroll-margin 0)
42 (recenter 0)))
43
44(defun +eshell-quit-or-delete-char (arg)
45 "Delete the character to the right, or quit eshell on an empty line."
46 (interactive "p")
47 (if (and (eolp) (looking-back eshell-prompt-regexp))
48 (progn (eshell-life-is-too-much)
49 (when (and (<= 1 (count-windows))
50 ;; TODO: This is not what I want. What I really want is
51 ;; for an eshell-only frame (i.e., called from a
52 ;; keybind) to delete itself, but a regular Emacs frame
53 ;; with Eshell inside to stick around. I think I'll
54 ;; need to make a frame-local (?) variable for that to
55 ;; work.
56 (> (length (frame-list)) 2)
57 server-process)
58 (delete-frame)))
59 (delete-forward-char arg)))
60
61;;; Insert previous arguments
62;; Record arguments
63
64(defvar eshell-arg-history nil)
65(defvar eshell-arg-history-index nil)
66(add-to-list 'savehist-additional-variables 'eshell-arg-history)
67
68(defun eshell-record-args (&rest _)
69 "Record unique arguments onto the front of `eshell-arg-history'."
70 (setq eshell-arg-history
71 (cl-loop with history = eshell-arg-history
72 for arg in (reverse eshell-last-arguments)
73 do (setq history (cons arg (remove arg history)))
74 finally return history)))
75
76(defun eshell-insert-prev-arg ()
77 "Insert an argument from `eshell-arg-history' at point."
78 (interactive)
79 (if (eq last-command 'eshell-insert-prev-arg)
80 (progn
81 (let ((pos (point)))
82 (eshell-backward-argument 1)
83 (delete-region (point) pos))
84 (if-let ((text (nth eshell-arg-history-index
85 eshell-arg-history)))
86 (progn
87 (insert text)
88 (cl-incf eshell-arg-history-index))
89 (insert (cl-first eshell-arg-history))
90 (setq eshell-arg-history-index 1)))
91 (insert (cl-first eshell-arg-history))
92 (setq eshell-arg-history-index 1)))
93
94;;;###autoload
95(define-minor-mode eshell-arg-hist-mode
96 "Minor mode to enable argument history, like bash/zsh with M-."
97 :lighter "$."
98 :keymap (let ((map (make-sparse-keymap)))
99 (define-key map (kbd "M-.") #'eshell-insert-prev-arg)
100 map)
101 (if eshell-arg-hist-mode
102 (add-hook 'eshell-post-command-hook #'eshell-record-args nil t)
103 (remove-hook 'eshell-post-command-hook #'eshell-record-args t)))
104
105;;;###autoload
106(defmacro +eshell-eval-after-load (&rest forms)
107 "Execute FORMS after Eshell is loaded.
108If Eshell is already loaded in the session, immediately execute
109forms.
110
111I wrote this because Eshell doesn't properly do loading or
112something, it's really annoying to work with."
113 (declare (indent 0))
114 `(progn
115 (defun +eshell@setup ()
116 "Setup the Eshell session."
117 ,@forms)
118 (when (featurep 'eshell)
119 `(dolist (buf (buffer-list))
120 (with-current-buffer buf
121 (when (derived-mode-p 'eshell-mode)
122 (+eshell@setup)))))
123 (add-hook 'eshell-mode-hook #'+eshell@setup)))
124
125(provide '+eshell)
126;;; +eshell.el ends here
diff --git a/lisp/+eww.el b/lisp/+eww.el deleted file mode 100644 index 8d53571..0000000 --- a/lisp/+eww.el +++ /dev/null
@@ -1,71 +0,0 @@
1;;; +eww.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'bookmark)
6(require 'eww)
7
8;; Track whether the current page is readable
9
10(defvar-local +eww-readable-p nil
11 "Whether `eww-readable' has been toggled on the current buffer.")
12
13(defun +eww-mark-readable (&rest _)
14 "ADVICE to mark current eww buffer \"readable.\""
15 (setq-local +eww-readable-p t))
16
17(defun +eww-mark-unreadable (&rest _)
18 "ADVICE to mark current eww buffer \"unreadable.\""
19 (setq-local +eww-readable-p nil))
20
21(defvar +eww-readable-unreadable-after-functions '(eww-render
22 eww-reload
23 eww-back-url)
24 "Functions after which the page is rendered \"unreadable\".")
25
26;;;###autoload
27(define-minor-mode +eww-track-readable-mode
28 "Track whether the current webpage has been rendered readable."
29 :lighter ""
30 (if +eww-track-readable-mode
31 (progn
32 (advice-add 'eww-readable :after #'+eww-mark-readable)
33 (dolist (func +eww-readable-unreadable-after-functions)
34 (advice-add func :after #'+eww-mark-unreadable)))
35 (dolist (func +eww-readable-unreadable-after-functions)
36 (advice-remove func #'+eww-mark-unreadable))
37 (advice-remove 'eww-readable #'+eww-mark-readable)))
38
39;; Integrate bookmarks in eww
40
41(defun +eww-bookmark--make ()
42 "Make eww bookmark record."
43 `((filename . ,(plist-get eww-data :url))
44 (title . ,(plist-get eww-data :title))
45 (time . ,(current-time-string))
46 (handler . ,#'+eww-bookmark-handler)
47 (defaults . (,(concat
48 ;; url without the https and path
49 (replace-regexp-in-string
50 "/.*" ""
51 (replace-regexp-in-string
52 "\\`https?://" ""
53 (plist-get eww-data :url)))
54 " - "
55 ;; page title
56 (replace-regexp-in-string
57 "\\` +\\| +\\'" ""
58 (replace-regexp-in-string
59 "[\n\t\r ]+" " "
60 (plist-get eww-data :title))))))))
61
62(defun +eww-bookmark-handler (bm)
63 "Handler for eww bookmarks."
64 (eww-browse-url (alist-get 'filename bm)))
65
66(defun +eww-bookmark-setup ()
67 "Setup eww bookmark integration."
68 (setq-local bookmark-make-record-function #'+eww-bookmark--make))
69
70(provide '+eww)
71;;; +eww.el ends here
diff --git a/lisp/+expand-region.el b/lisp/+expand-region.el deleted file mode 100644 index 8aac3ce..0000000 --- a/lisp/+expand-region.el +++ /dev/null
@@ -1,24 +0,0 @@
1;;; +expand-region.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;
6
7;;; Code:
8
9;; Because of `wrap-region', I can't use `expand-region-fast-keys-enabled'. So
10;; instead of that, I'm adding this to the binding to C--, but I also want to be
11;; able to use the negative argument. So there's this.
12(defun +er/contract-or-negative-argument (arg)
13 "Contract the region if the last command expanded it.
14Otherwise, pass the ARG as a negative argument."
15 (interactive "p")
16 (cond ((memq last-command '(er/expand-region
17 er/contract-region
18 +er/contract-or-negative-argument))
19
20 (er/contract-region arg))
21 (t (call-interactively #'negative-argument))))
22
23(provide '+expand-region)
24;;; +expand-region.el ends here
diff --git a/lisp/+finger.el b/lisp/+finger.el deleted file mode 100644 index 1a878bc..0000000 --- a/lisp/+finger.el +++ /dev/null
@@ -1,46 +0,0 @@
1;;; +finger.el --- Finger bugfix -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; `net-utils' defines `finger', which purportedly consults
6;; `finger-X.500-host-regexps' to determine what hosts to only send a username
7;; to. I've found that that is not the case, and so I've patched it. At some
8;; point I'll submit this to Emacs itself.
9
10;;; Code:
11
12(require 'net-utils) ; this requires everything else I'll need.
13(require 'seq)
14
15(defun finger (user host)
16 "Finger USER on HOST.
17This command uses `finger-X.500-host-regexps'
18and `network-connection-service-alist', which see."
19 ;; One of those great interactive statements that's actually
20 ;; longer than the function call! The idea is that if the user
21 ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
22 ;; host name. If we don't see an "@", we'll prompt for the host.
23 (interactive
24 (let* ((answer (read-from-minibuffer "Finger User: "
25 (net-utils-url-at-point)))
26 (index (string-match (regexp-quote "@") answer)))
27 (if index
28 (list (substring answer 0 index)
29 (substring answer (1+ index)))
30 (list answer
31 (read-from-minibuffer "At Host: "
32 (net-utils-machine-at-point))))))
33 (let* ((user-and-host (concat user "@" host))
34 (process-name (concat "Finger [" user-and-host "]"))
35 (regexps finger-X.500-host-regexps)
36 ) ;; found
37 (when (seq-some (lambda (r) (string-match-p r host)) regexps)
38 (setq user-and-host user))
39 (run-network-program
40 process-name
41 host
42 (cdr (assoc 'finger network-connection-service-alist))
43 user-and-host)))
44
45(provide '+finger)
46;;; +finger.el ends here
diff --git a/lisp/+flyspell-correct.el b/lisp/+flyspell-correct.el deleted file mode 100644 index 22f8c82..0000000 --- a/lisp/+flyspell-correct.el +++ /dev/null
@@ -1,24 +0,0 @@
1;;; +flyspell-correct.el --- -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'flyspell-correct)
6
7(defun +flyspell-correct-buffer (&optional prefix)
8 "Run `flyspell-correct-wrapper' on all misspelled words in the buffer.
9With PREFIX, prompt to change the current dictionary."
10 (interactive "P")
11 (flyspell-buffer)
12 (when prefix
13 (let ((current-prefix-arg nil))
14 (call-interactively #'ispell-change-dictionary)))
15 (+with-message "Checking spelling"
16 (flyspell-correct-move (point-min) :forward :rapid)))
17
18(defun +flyspell-correct-buffer-h (&rest _)
19 "Run `+flyspell-correct-buffer'.
20This is suitable for placement in a hook."
21 (+flyspell-correct-buffer))
22
23(provide '+flyspell-correct)
24;;; +flyspell-correct.el ends here
diff --git a/lisp/+god-mode.el b/lisp/+god-mode.el deleted file mode 100644 index f70e76b..0000000 --- a/lisp/+god-mode.el +++ /dev/null
@@ -1,17 +0,0 @@
1;;; +god-mode.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defun +god-mode-insert ()
6 "Leave `god-local-mode' at point."
7 (interactive)
8 (god-local-mode -1))
9
10(defun +god-mode-append ()
11 "Leave `god-local-mode' after point."
12 (interactive)
13 (forward-char 1)
14 (god-local-mode -1))
15
16(provide '+god-mode)
17;;; +god-mode.el ends here
diff --git a/lisp/+hideshow.el b/lisp/+hideshow.el deleted file mode 100644 index e60efb8..0000000 --- a/lisp/+hideshow.el +++ /dev/null
@@ -1,44 +0,0 @@
1;;; +hideshow.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; initiated by https://karthinks.com/software/simple-folding-with-hideshow/
6
7;;; Code:
8
9(defun +hs-cycle (&optional level)
10 (interactive "p")
11 (let (message-log-max
12 (inhibit-message t))
13 (if (= level 1)
14 (pcase last-command
15 ('+hs-cycle
16 (hs-hide-level 1)
17 (setq this-command 'hs-cycle-children))
18 ('hs-cycle-children
19 ;; TODO: Fix this case. `hs-show-block' needs to be
20 ;; called twice to open all folds of the parent
21 ;; block.
22 (save-excursion (hs-show-block))
23 (hs-show-block)
24 (setq this-command 'hs-cycle-subtree))
25 ('hs-cycle-subtree
26 (hs-hide-block))
27 (_
28 (if (not (hs-already-hidden-p))
29 (hs-hide-block)
30 (hs-hide-level 1)
31 (setq this-command 'hs-cycle-children))))
32 (hs-hide-level level)
33 (setq this-command 'hs-hide-level))))
34
35(defun +hs-global-cycle ()
36 (interactive)
37 (pcase last-command
38 ('+hs-global-cycle
39 (save-excursion (hs-show-all))
40 (setq this-command 'hs-global-show))
41 (_ (hs-hide-all))))
42
43(provide '+hideshow)
44;;; +hideshow.el ends here
diff --git a/lisp/+init.el b/lisp/+init.el deleted file mode 100644 index 903f2dc..0000000 --- a/lisp/+init.el +++ /dev/null
@@ -1,117 +0,0 @@
1;;; +init.el --- extra init.el stuff -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; Yes, I edit my init.el often enough I need to write a mode for it. The
6;; sorting function is based on code from
7;; https://github.com/alphapapa/unpackaged.el
8
9;;; Code:
10
11(require '+lisp)
12
13;;; Sort `setup' forms
14
15(defun +init--sexp-setup-p (sexp-str &optional head)
16 "Is SEXP-STR a `setup' form, optionally with a HEAD form?"
17 (let ((head (if (and head (symbolp head))
18 (symbol-name head)
19 head)))
20 (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str)
21 (if head
22 (string-match-p (concat "\\`.*" head) sexp-str)
23 t))))
24
25(defun +init-sort ()
26 "Sort init.el.
27Sort based on the following heuristic: `setup' forms (the
28majority of my init.el) are sorted after everything else, and
29within that group, forms with a HEAD of `:require' are sorted
30first, and `:straight' HEADs are sorted last. All other forms
31are sorted lexigraphically."
32 (interactive)
33 ;; I have to make my own "version" of `save-excursion', since the mark and
34 ;; point are lost (I think that's the problem) when sorting the buffer.
35 (let* ((current-point (point))
36 (current-defun (beginning-of-defun))
37 (defun-point (- current-point (point)))
38 (current-defun-re (buffer-substring-no-properties (line-beginning-position)
39 (line-end-position))))
40 (widen) ; It makes no sense to `save-restriction'
41 (+lisp-sort-sexps
42 (point-min) (point-max)
43 ;; Key function
44 nil
45 ;; Sort function
46 (lambda (s1 s2)
47 (let ((s1 (cdr s1)) (s2 (cdr s2)))
48 (cond
49 ;; Sort everything /not/ `setup' /before/ `setup'
50 ((and (+init--sexp-setup-p s1)
51 (not (+init--sexp-setup-p s2)))
52 nil)
53 ((and (+init--sexp-setup-p s2)
54 (not (+init--sexp-setup-p s1)))
55 t)
56 ;; otherwise...
57 (t (let ((s1-straight (+init--sexp-setup-p s1 :straight))
58 (s2-straight (+init--sexp-setup-p s2 :straight))
59 (s1-require (+init--sexp-setup-p s1 :require))
60 (s2-require (+init--sexp-setup-p s2 :require)))
61 (cond
62 ;; `:straight' setups have extra processing
63 ((and s1-straight s2-straight)
64 (let* ((r (rx (: ":straight" (? "-when") (* space) (? "("))))
65 (s1 (replace-regexp-in-string r "" s1))
66 (s2 (replace-regexp-in-string r "" s2)))
67 (string< s1 s2)))
68 ;; `:require' setups go first
69 ((and s1-require (not s2-require)) t)
70 ((and s2-require (not s1-require)) nil)
71 ;; `:straight' setups go last
72 ((and s1-straight (not s2-straight)) nil)
73 ((and s2-straight (not s1-straight)) t)
74 ;; otherwise, sort lexigraphically
75 (t (string< s1 s2)))))))))
76 ;; Return to original point relative to the defun we were in
77 (ignore-errors (goto-char (point-min))
78 (re-search-forward current-defun-re)
79 (beginning-of-defun)
80 (goto-char (+ (point) defun-point)))))
81
82(defun +init-sort-then-save ()
83 "Sort init.el, then save it."
84 (interactive)
85 (+init-sort)
86 (if (fboundp #'user-save-buffer)
87 (user-save-buffer)
88 (save-buffer)))
89
90;;; Add `setup' forms to `imenu-generic-expression'
91
92(defun +init-add-setup-to-imenu ()
93 "Recognize `setup' forms in `imenu'."
94 ;; `imenu-generic-expression' automatically becomes buffer-local when set
95 (setf (alist-get "Setup" imenu-generic-expression nil nil #'equal)
96 (list
97 (rx (: "(setup" (+ space)
98 (group (? "(") (* nonl))))
99 1))
100 (when (boundp 'consult-imenu-config)
101 (setf (alist-get ?s
102 (plist-get
103 (alist-get 'emacs-lisp-mode consult-imenu-config)
104 :types))
105 '("Setup"))))
106
107;;; Major mode
108
109;;;###autoload
110(define-derived-mode +init-mode emacs-lisp-mode "Init.el"
111 "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.")
112
113;;;###autoload
114(add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode))
115
116(provide '+init)
117;;; +init.el ends here
diff --git a/lisp/+ispell.el b/lisp/+ispell.el deleted file mode 100644 index fbfc0f0..0000000 --- a/lisp/+ispell.el +++ /dev/null
@@ -1,97 +0,0 @@
1;;; +ispell.el --- Customizations for `ispell' -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'cl-lib)
8(require 'seq)
9
10;; Utility function TODO: move elsewhere
11(defun +ispell-append-removing-duplicates (&rest lists)
12 "Append LISTS, removing duplicates from the result.
13Any keyword arguments to `cl-remove-duplicates' should come
14before the LISTS."
15 (let (cl-remove-duplicates-args)
16 (while (keywordp (car lists))
17 (push (pop lists) cl-remove-duplicates-args)
18 (push (pop lists) cl-remove-duplicates-args))
19 (apply #'cl-remove-duplicates (apply #'append lists)
20 (nreverse cl-remove-duplicates-args))))
21
22;;; Ispell in .dir-locals
23
24;; Let Emacs know a list of strings is safe
25(defun +ispell-safe-local-p (list)
26 (and (listp list)
27 (seq-every-p #'stringp list)))
28
29;; Can I instruct ispell to insert LocalWords in a different file?
30;; https://emacs.stackexchange.com/q/31396/2264
31
32;; How can I move all my file-local LocalWords to .dir-locals.el?
33;; https://emacs.stackexchange.com/q/31419
34
35;; Adapted from ispell.el:ispell-buffer-local-words
36(defun +ispell-buffer-local-words-list ()
37 (let (words)
38 (or ispell-buffer-local-name
39 (setq ispell-buffer-local-name (buffer-name)))
40 (save-excursion
41 (goto-char (point-min))
42 (while (search-forward ispell-words-keyword nil t)
43 (let ((end (point-at-eol))
44 (ispell-casechars (ispell-get-casechars))
45 string)
46 (while (re-search-forward " *\\([^ ]+\\)" end t)
47 (setq string (match-string-no-properties 1))
48 (if (and (< 1 (length string))
49 (equal 0 (string-match ispell-casechars string)))
50 (push string words))))))
51 words))
52
53;;;###autoload
54(defun +ispell-move-buffer-words-to-dir-locals (&optional arg)
55 "Move the current buffer-local words to .dir-locals.el.
56This function prompts the user to save .dir-locals.el, unless
57prefix ARG is non-nil; then it just saves them."
58 (interactive "P")
59 (unless (buffer-file-name)
60 (user-error "Buffer not attached to file"))
61 (hack-dir-local-variables)
62 (let ((print-level nil)
63 (print-length nil))
64 (when-let ((new-words (cl-remove-if (lambda (el) (eq el '\.\.\.)) ; XXX: NO IDEA
65 ; where this came from
66 (+ispell-append-removing-duplicates
67 :test #'string=
68 ispell-buffer-session-localwords
69 (alist-get 'ispell-buffer-session-localwords
70 dir-local-variables-alist)
71 (alist-get 'ispell-buffer-session-localwords
72 file-local-variables-alist)
73 (+ispell-buffer-local-words-list)))))
74 (save-excursion
75 (add-dir-local-variable
76 major-mode
77 'ispell-buffer-session-localwords
78 (setq ispell-buffer-session-localwords
79 new-words))
80 (when (or arg
81 (y-or-n-p "Save .dir-locals.el?"))
82 (save-buffer))
83 (bury-buffer))
84 (or ispell-buffer-local-name
85 (setq ispell-buffer-local-name (buffer-name)))
86 (save-excursion
87 (goto-char (point-min))
88 (while (search-forward ispell-words-keyword nil t)
89 (delete-region (point-at-bol) (1+ (point-at-eol))))))))
90
91;;;###autoload
92(defun +ispell-move-buffer-words-to-dir-locals-hook ()
93 "Convenience function for binding to a hook."
94 (+ispell-move-buffer-words-to-dir-locals t))
95
96(provide '+ispell)
97;;; +ispell.el ends here
diff --git a/lisp/+jabber.el b/lisp/+jabber.el deleted file mode 100644 index e018b0c..0000000 --- a/lisp/+jabber.el +++ /dev/null
@@ -1,278 +0,0 @@
1;;; +jabber.el --- Customizations for jabber.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Most changes I want to PR and contribute, but a few don't make sense to
6;; contribute upstream, at least not now.
7
8;;; Code:
9
10(require 'jabber)
11(require 'tracking)
12
13(defgroup +jabber nil
14 "Extra jabber.el customizations."
15 :group 'jabber)
16
17(defcustom +jabber-ws-prefix 0
18 "Width to pad left side of chats."
19 :type 'string)
20
21(defcustom +jabber-pre-prompt " \n"
22 "String to put before the prompt."
23 :type 'string)
24
25(defvar +jabber-tracking-show-p #'jabber-activity-show-p-default
26 "Function that checks if the given JID should be shown in the mode line.
27This does the same as `jabber-activity-show-p', but for the
28`tracking-mode' mode-line.")
29
30(defun +jabber-tracking-add (from buffer text proposed-alert)
31 "ADVICE to add jabber buffers to `tracking-buffers'."
32 (when (funcall +jabber-tracking-show-p from)
33 (tracking-add-buffer buffer 'jabber-activity-face)))
34
35(defun +jabber-tracking-add-muc (nick group buffer text proposed-alert)
36 "ADVICE to add jabber MUC buffers to `tracking-buffers'."
37 (when (funcall +jabber-tracking-show-p group)
38 (tracking-add-buffer buffer 'jabber-activity-face)))
39
40;;; Hiding presence messages:
41;; https://paste.sr.ht/~hdasch/f0ad09fbcd08e940a4fda71c2f40abc1c4efd45f
42
43;; Tame MUC presence notifications.
44
45;; This patch hides or applies a face to MUC presence notifications in
46;; the MUC chat buffer. To control its behavior, customize
47;; ’jabber-muc-decorate-presence-patterns’. By default it does nothing.
48
49;; ’jabber-muc-decorate-presence-patterns’ is a list of pairs consisting
50;; of a regular expression and a either a face or ‘nil’. If a the
51;; regular expression matches a presence notification, then either:
52
53;; - the specified face is applied to the notification message
54;; - or if the second value of the pair is nil, the notification is
55;; discarded
56
57;; If no regular expression in the list of pairs matches the notification
58;; message, the message is displayed unchanged.
59
60;; For example, the customization:
61
62;; '(jabber-muc-decorate-presence-patterns
63;; '(("\\( enters the room ([^)]+)\\| has left the chatroom\\)$")
64;; ("." . jabber-muc-presence-dim)))
65
66;; hides participant enter/leave notifications. It also diminishes other
67;; presence notification messages to make it easier to distinguish
68;; between conversation and notifications.
69
70(defface jabber-muc-presence-dim
71 '((t (:foreground "dark grey" :weight light :slant italic)))
72 "face for diminished presence notifications.")
73
74(defcustom jabber-muc-decorate-presence-patterns nil
75 "List of regular expressions and face pairs.
76When a presence notification matches a pattern, display it with
77associated face. Ignore notification if face is ‘nil’."
78 :type '(repeat
79 :tag "Patterns"
80 (cons :format "%v"
81 (regexp :tag "Regexp")
82 (choice
83 (const :tag "Ignore" nil)
84 (face :tag "Face" :value jabber-muc-presence-dim))))
85 :group 'jabber-alerts)
86
87(defun jabber-muc-maybe-decorate-presence (node)
88 "Filter presence notifications."
89 (cl-destructuring-bind (key msg &key time) node
90 (let* ((match (cl-find-if
91 (lambda (pair)
92 (string-match (car pair) msg))
93 jabber-muc-decorate-presence-patterns))
94 (face (cdr-safe match)))
95 (if match
96 (when face
97 (jabber-maybe-print-rare-time
98 (ewoc-enter-last
99 jabber-chat-ewoc
100 (list key
101 (propertize msg 'face face)
102 :time time))))
103 (jabber-maybe-print-rare-time
104 (ewoc-enter-last jabber-chat-ewoc node))))))
105
106(defun jabber-muc-process-presence (jc presence)
107 (let* ((from (jabber-xml-get-attribute presence 'from))
108 (type (jabber-xml-get-attribute presence 'type))
109 (x-muc (cl-find-if
110 (lambda (x) (equal (jabber-xml-get-attribute x 'xmlns)
111 "http://jabber.org/protocol/muc#user"))
112 (jabber-xml-get-children presence 'x)))
113 (group (jabber-jid-user from))
114 (nickname (jabber-jid-resource from))
115 (symbol (jabber-jid-symbol from))
116 (our-nickname (gethash symbol jabber-pending-groupchats))
117 (item (car (jabber-xml-get-children x-muc 'item)))
118 (actor (jabber-xml-get-attribute (car (jabber-xml-get-children item 'actor)) 'jid))
119 (reason (car (jabber-xml-node-children (car (jabber-xml-get-children item 'reason)))))
120 (error-node (car (jabber-xml-get-children presence 'error)))
121 (status-codes (if error-node
122 (list (jabber-xml-get-attribute error-node 'code))
123 (mapcar
124 (lambda (status-element)
125 (jabber-xml-get-attribute status-element 'code))
126 (jabber-xml-get-children x-muc 'status)))))
127 ;; handle leaving a room
128 (cond
129 ((or (string= type "unavailable") (string= type "error"))
130 ;; error from room itself? or are we leaving?
131 (if (or (null nickname)
132 (member "110" status-codes)
133 (string= nickname our-nickname))
134 ;; Assume that an error means that we were thrown out of the
135 ;; room...
136 (let* ((leavingp t)
137 (message (cond
138 ((string= type "error")
139 (cond
140 ;; ...except for certain cases.
141 ((or (member "406" status-codes)
142 (member "409" status-codes))
143 (setq leavingp nil)
144 (concat "Nickname change not allowed"
145 (when error-node
146 (concat ": " (jabber-parse-error error-node)))))
147 (t
148 (concat "Error entering room"
149 (when error-node
150 (concat ": " (jabber-parse-error error-node)))))))
151 ((member "301" status-codes)
152 (concat "You have been banned"
153 (when actor (concat " by " actor))
154 (when reason (concat " - '" reason "'"))))
155 ((member "307" status-codes)
156 (concat "You have been kicked"
157 (when actor (concat " by " actor))
158 (when reason (concat " - '" reason "'"))))
159 (t
160 "You have left the chatroom"))))
161 (when leavingp
162 (jabber-muc-remove-groupchat group))
163 ;; If there is no buffer for this groupchat, don't bother
164 ;; creating one just to tell that user left the room.
165 (let ((buffer (get-buffer (jabber-muc-get-buffer group))))
166 (if buffer
167 (with-current-buffer buffer
168 (jabber-muc-maybe-decorate-presence
169 (list (if (string= type "error")
170 :muc-error
171 :muc-notice)
172 message
173 :time (current-time)))))
174 (message "%s: %s" (jabber-jid-displayname group) message))))
175 ;; or someone else?
176 (let* ((plist (jabber-muc-participant-plist group nickname))
177 (jid (plist-get plist 'jid))
178 (name (concat nickname
179 (when jid
180 (concat " <"
181 (jabber-jid-user jid)
182 ">")))))
183 (jabber-muc-remove-participant group nickname)
184 (with-current-buffer (jabber-muc-create-buffer jc group)
185 (jabber-muc-maybe-decorate-presence
186 (list :muc-notice
187 (cond
188 ((member "301" status-codes)
189 (concat name " has been banned"
190 (when actor (concat " by " actor))
191 (when reason (concat " - '" reason "'"))))
192 ((member "307" status-codes)
193 (concat name " has been kicked"
194 (when actor (concat " by " actor))
195 (when reason (concat " - '" reason "'"))))
196 ((member "303" status-codes)
197 (concat name " changes nickname to "
198 (jabber-xml-get-attribute item 'nick)))
199 (t
200 (concat name " has left the chatroom")))
201 :time (current-time))))))
202 (t
203 ;; someone is entering
204
205 (when (or (member "110" status-codes) (string= nickname our-nickname))
206 ;; This is us. We just succeeded in entering the room.
207 ;;
208 ;; The MUC server is supposed to send a 110 code whenever this
209 ;; is our presence ("self-presence"), but at least one
210 ;; (ejabberd's mod_irc) doesn't, so check the nickname as well.
211 ;;
212 ;; This check might give incorrect results if the server
213 ;; changed our nickname to avoid collision with an existing
214 ;; participant, but even in this case the window where we have
215 ;; incorrect information should be very small, as we should be
216 ;; getting our own 110+210 presence shortly.
217 (let ((whichgroup (assoc group *jabber-active-groupchats*)))
218 (if whichgroup
219 (setcdr whichgroup nickname)
220 (add-to-list '*jabber-active-groupchats* (cons group nickname))))
221 ;; The server may have changed our nick. Record the new one.
222 (puthash symbol nickname jabber-pending-groupchats))
223
224 ;; Whoever enters, we create a buffer (if it didn't already
225 ;; exist), and print a notice. This is where autojoined MUC
226 ;; rooms have buffers created for them. We also remember some
227 ;; metadata.
228 (let ((old-plist (jabber-muc-participant-plist group nickname))
229 (new-plist (jabber-muc-parse-affiliation x-muc)))
230 (jabber-muc-modify-participant group nickname new-plist)
231 (let ((report (jabber-muc-report-delta nickname old-plist new-plist
232 reason actor)))
233 (when report
234 (with-current-buffer (jabber-muc-create-buffer jc group)
235 (jabber-muc-maybe-decorate-presence
236 (list :muc-notice report
237 :time (current-time)))
238 ;; Did the server change our nick?
239 (when (member "210" status-codes)
240 (ewoc-enter-last
241 jabber-chat-ewoc
242 (list :muc-notice
243 (concat "Your nick was changed to " nickname " by the server")
244 :time (current-time))))
245 ;; Was this room just created? If so, it's a locked
246 ;; room. Notify the user.
247 (when (member "201" status-codes)
248 (ewoc-enter-last
249 jabber-chat-ewoc
250 (list :muc-notice
251 (with-temp-buffer
252 (insert "This room was just created, and is locked to other participants.\n"
253 "To unlock it, ")
254 (insert-text-button
255 "configure the room"
256 'action (apply-partially 'call-interactively 'jabber-muc-get-config))
257 (insert " or ")
258 (insert-text-button
259 "accept the default configuration"
260 'action (apply-partially 'call-interactively 'jabber-muc-instant-config))
261 (insert ".")
262 (buffer-string))
263 :time (current-time))))))))))))
264
265(defun +jabber-colors-update (&optional buffer)
266 "Update jabber colors in BUFFER, defaulting to the current."
267 (with-current-buffer (or buffer (current-buffer))
268 (when jabber-buffer-connection
269 (setq jabber-muc-participant-colors nil)
270 (cond (jabber-chatting-with
271 (jabber-chat-create-buffer jabber-buffer-connection
272 jabber-chatting-with))
273 (jabber-group
274 (jabber-muc-create-buffer jabber-buffer-connection
275 jabber-group))))))
276
277(provide '+jabber)
278;;; +jabber.el ends here
diff --git a/lisp/+key.el b/lisp/+key.el deleted file mode 100644 index a217dad..0000000 --- a/lisp/+key.el +++ /dev/null
@@ -1,106 +0,0 @@
1;;; +key.el --- minor mode for keymaps -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Much of the code here was cribbed from https://emacs.stackexchange.com/a/358,
6;; which in turn was cribbed in part from
7;; https://github.com/kaushalmodi/.emacs.d/blob/master/elisp/modi-mode.el,
8;; https://github.com/jwiegley/use-package/blob/master/bind-key.el and
9;; elsewhere.
10
11;; The basic idea is to have a minor-mode for my personal key customizations,
12;; especially a "leader key" set up à la vim. In Emacs, I use `C-z' for this
13;; leader key, because of its easy location and relative uselessness by default.
14
15;;; Code:
16
17(require 'easy-mmode)
18(require 'setup nil t)
19
20;; I need to define this map before the proper mode map.
21(defvar +key-leader-map (let ((map (make-sparse-keymap))
22 (c-z (global-key-binding "\C-z")))
23 ;;(define-key map "\C-z" c-z)
24 map)
25 "A leader keymap under the \"C-z\" bind.")
26
27;; http://xahlee.info/emacs/emacs/emacs_menu_app_keys.html and
28(defvar +key-menu-map (let ((map (make-sparse-keymap)))
29 (define-key map (kbd "<menu>")
30 #'execute-extended-command)
31 map)
32 "Custom bindings behind the menu key.")
33
34(defvar +key-mode-map (let ((map (make-sparse-keymap)))
35 (define-key map "\C-z" +key-leader-map)
36 (define-key map (kbd "<menu>") +key-menu-map)
37 map)
38 "Keymap for `+key-mode'.")
39
40(defun turn-off-+key-mode ()
41 "Turn off `+key-mode'."
42 (+key-mode -1))
43
44;;;###autoload
45(define-minor-mode +key-mode
46 "A minor mode with keybindings that will override every other mode."
47 :init-value t
48 :lighter " +"
49 (if +key-mode
50 (progn ; Enable
51 (add-to-list 'emulation-mode-map-alists
52 `((+key-mode . ,+key-mode-map)))
53 ;; Disable in minibuffer
54 (add-hook 'minibuffer-setup-hook #'turn-off-+key-mode)
55 ;; compat Linux-Windows
56 (define-key key-translation-map (kbd "<apps>") (kbd "<menu>"))
57 ;; curse you, thinkpad keyboard!!!
58 (define-key key-translation-map (kbd "<print>") (kbd "<menu>"))
59 )
60 ;; Disable
61 (setq emulation-mode-map-alists
62 (assoc-delete-all '+key-mode emulation-mode-map-alists
63 (lambda (a b)
64 (equal (car a) b))))
65 (remove-hook 'minibuffer-setup-hook #'turn-off-+key-mode)
66 (define-key key-translation-map (kbd "<print>") nil)
67 (define-key key-translation-map (kbd "<apps>") nil)))
68
69;;;###autoload
70(defun +key-setup ()
71 "Ensure `+key-mode' happens after init."
72 (if after-init-time
73 (+key-global-mode)
74 (add-hook 'after-init-hook #'+key-global-mode)))
75
76;;;###autoload
77(define-globalized-minor-mode +key-global-mode +key-mode +key-mode)
78
79;; Extras for `setup'
80(with-eval-after-load 'setup
81 (setup-define :+key
82 (lambda (key command)
83 `(define-key +key-mode-map ,key ,command))
84 :documentation "Bind KEY to COMMAND in `+key-mode-map'."
85 :debug '(form sexp)
86 :ensure '(kbd nil)
87 :repeatable t)
88
89 (setup-define :+leader
90 (lambda (key command)
91 `(define-key +key-leader-map ,key ,command))
92 :documentation "Bind KEY to COMMAND in `+key-leader-map'."
93 :debug '(form sexp)
94 :ensure '(kbd nil)
95 :repeatable t)
96
97 (setup-define :+menu
98 (lambda (key command)
99 `(define-key +key-menu-map ,key ,command))
100 :documentation "Bind KEY to COMMAND in `+key-leader-map'."
101 :debug '(form sexp)
102 :ensure '(kbd nil)
103 :repeatable t))
104
105(provide '+key)
106;;; +key.el ends here
diff --git a/lisp/+kmacro.el b/lisp/+kmacro.el deleted file mode 100644 index a3cde61..0000000 --- a/lisp/+kmacro.el +++ /dev/null
@@ -1,70 +0,0 @@
1;;; +kmacro.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Many of these come from this Reddit thread:
6;; https://old.reddit.com/r/emacs/comments/rlli0u/whats_your_favorite_defadvice/
7
8;;; Code:
9
10(require 'kmacro)
11
12;; Indicate when a kmacro is being recorded in the mode-line
13
14(defface +kmacro-modeline nil
15 "Face when kmacro is active")
16
17(set-face-attribute '+kmacro-modeline nil
18 :background "Firebrick"
19 :box '(:line-width -1 :color "salmon"
20 :style released-button))
21
22(defun +kmacro-change-mode-line (&rest _)
23 "Remap the mode-line face when recording a kmacro."
24
25 (add-to-list 'face-remapping-alist '(mode-line . +kmacro-modeline)))
26
27(defun +kmacro-restore-mode-line (&rest _)
28 "Restore the mode-line face after kmacro is done recording."
29 (setf face-remapping-alist
30 (assoc-delete-all 'mode-line face-remapping-alist)))
31
32(define-minor-mode +kmacro-recording-indicator-mode
33 "Change the mode-line's face when recording a kmacro."
34 :lighter ""
35 :global t
36 (if +kmacro-recording-indicator-mode
37 (progn
38 (advice-add #'kmacro-start-macro :before #'+kmacro-change-mode-line)
39 (advice-add #'kmacro-keyboard-quit :after #'+kmacro-restore-mode-line)
40 (advice-add #'kmacro-end-macro :after #'+kmacro-restore-mode-line))
41 (+kmacro-restore-mode-line)
42 (advice-remove #'kmacro-start-macro #'+kmacro-change-mode-line)
43 (advice-remove #'kmacro-keyboard-quit #'+kmacro-restore-mode-line)
44 (advice-remove #'kmacro-end-macro #'+kmacro-restore-mode-line)))
45
46;; Undo keyboard macros in a single bound (like vi!)
47
48(defun +kmacro-block-undo (fn &rest args)
49 (let ((marker (prepare-change-group)))
50 (unwind-protect (apply fn args)
51 (undo-amalgamate-change-group marker))))
52
53(define-minor-mode +kmacro-block-undo-mode
54 "Undo kmacros all at once (like vi)."
55 :global t
56 :lighter " KUndo"
57 (if +kmacro-block-undo-mode
58 (dolist (fn '(kmacro-call-macro
59 kmacro-exec-ring-item
60 dot-mode-execute
61 apply-macro-to-region-lines))
62 (advice-add fn :around #'+kmacro-block-undo))
63 (dolist (fn '(kmacro-call-macro
64 kmacro-exec-ring-item
65 dot-mode-execute
66 apply-macro-to-region-lines))
67 (advice-remove fn #'+kmacro-block-undo))))
68
69(provide '+kmacro)
70;;; +kmacro.el ends here
diff --git a/lisp/+link-hint.el b/lisp/+link-hint.el deleted file mode 100644 index 205e915..0000000 --- a/lisp/+link-hint.el +++ /dev/null
@@ -1,169 +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(defun +link-hint-open-secondary-setup (&optional types)
91 "Define the `:open-secondary' link-hint type for TYPES.
92If TYPES is nil, define it for `+link-hint-open-secondary-types'."
93 (dolist (type (or types +link-hint-open-secondary-types))
94 (link-hint-define-type type
95 :open-secondary browse-url-secondary-browser-function
96 :open-secondary-multiple t)))
97
98(defun +link-hint-open-secondary ()
99 "Open a link in the secondary browser."
100 (interactive)
101 (avy-with link-hint-open-link
102 (link-hint--one :open-secondary)))
103
104(defun +link-hint-open-chrome-setup (&optional types)
105 "Define the `:open-chrome' link-hint type for TYPES.
106If TYPES is nil, define it for `+link-hint-open-secondary-types'."
107 (dolist (type (or types +link-hint-open-secondary-types))
108 (link-hint-define-type type
109 :open-chrome #'browse-url-chrome
110 :open-chrome-multiple t)))
111
112(defun +link-hint-open-chrome ()
113 "Open a link with chrome."
114 (interactive)
115 (avy-with link-hint-open-link
116 (link-hint--one :open-chrome)))
117
118;; (cl-defmacro +link-hint-add-type (keyword )
119;; "Define link-hint type KEYWORD to operate on TYPES.
120;; If TYPES is nil or absent, define KEYWORD for all
121;; `link-hint-types'."
122;; (let (forms)
123;; (dolist (type (or types link-hint-types))
124;; (push `(link-hint-define-type ,type ,keyword ,function) forms))
125;; (push `(defun ,(intern (format "+link-hint%s" ,keyword))
126;; ))))
127
128(defun +link-hint-open-link (prefix)
129 "Open a link.
130Without a PREFIX, open using `browse-url-browser-function'; with
131a PREFIX, use `browse-url-secondary-browser-function'."
132 (interactive "P")
133 (avy-with link-hint-open-link
134 (link-hint--one (if prefix :open-secondary :open))))
135
136(defun +link-hint-open-multiple-links (prefix)
137 "Open multiple links.
138Without a PREFIX, open using `browse-url-browser-function'; with
139a PREFIX, use `browse-url-secondary-browser-function'."
140 (interactive "P")
141 (avy-with link-hint-open-multiple-links
142 (link-hint--one (if prefix :open-secondary :open))))
143
144(defun +link-hint-open-all-links (prefix)
145 "Open all visible links.
146Without a PREFIX, open using `browse-url-browser-function'; with
147a PREFIX, use `browse-url-secondary-browser-function'."
148 (interactive "P")
149 (avy-with link-hint-open-all-links
150 (link-hint--one (if prefix :open-secondary :open))))
151
152;;; Pocket-reader.el integration
153
154(defun +link-hint-pocket-add-setup (&optional types)
155 "Define the `:pocket-add' link-hint type for TYPES.
156If TYPES is nil, define it for `link-hint-types'."
157 (dolist (type (or types link-hint-types))
158 (link-hint-define-type type
159 :pocket-add #'pocket-reader-generic-add-link
160 :pocket-add-multiple t)))
161
162(defun +link-hint-pocket-add ()
163 "Add a link to the Pocket reader."
164 (interactive)
165 (avy-with link-hint-open-link
166 (link-hint--one :pocket-add)))
167
168(provide '+link-hint)
169;;; +link-hint.el ends here
diff --git a/lisp/+lisp.el b/lisp/+lisp.el deleted file mode 100644 index a78e40e..0000000 --- a/lisp/+lisp.el +++ /dev/null
@@ -1,195 +0,0 @@
1;;; +lisp.el --- extra lisp functionality -*- lexical-binding: t -*-
2
3;;; Code:
4
5;;; Sort sexps in a region.
6;; https://github.com/alphapapa/unpackaged.el
7
8(defun +lisp-skip-whitespace ()
9 (while (looking-at (rx (1+ (or space "\n"))))
10 (goto-char (match-end 0))))
11
12(defun +lisp-skip-both ()
13 (while (cond ((or (nth 4 (syntax-ppss))
14 (ignore-errors
15 (save-excursion
16 (forward-char 1)
17 (nth 4 (syntax-ppss)))))
18 (forward-line 1))
19 ((looking-at (rx (1+ (or space "\n"))))
20 (goto-char (match-end 0))))))
21
22(defun +lisp-sort-sexps (beg end &optional key-fn sort-fn)
23 "Sort sexps between BEG and END.
24Comments stay with the code below.
25
26Optional argument KEY-FN will determine where in each sexp to
27start sorting. e.g. (lambda (sexp) (symbol-name (car sexp)))
28
29Optional argument SORT-FN will determine how to sort two sexps'
30strings. It's passed to `sort'. By default, it sorts the sexps
31with `string<' starting with the key determined by KEY-FN."
32 (interactive "r")
33 (save-excursion
34 (save-restriction
35 (narrow-to-region beg end)
36 (goto-char beg)
37 (+lisp-skip-both)
38 (cl-destructuring-bind (sexps markers)
39 (cl-loop do (+lisp-skip-whitespace)
40 for start = (point-marker)
41 for sexp = (ignore-errors
42 (read (current-buffer)))
43 for end = (point-marker)
44 while sexp
45 ;; Collect the real string, then one used for sorting.
46 collect (cons (buffer-substring (marker-position start)
47 (marker-position end))
48 (save-excursion
49 (goto-char (marker-position start))
50 (+lisp-skip-both)
51 (if key-fn
52 (funcall key-fn sexp)
53 (buffer-substring
54 (point)
55 (marker-position end)))))
56 into sexps
57 collect (cons start end)
58 into markers
59 finally return (list sexps markers))
60 (setq sexps (sort sexps (if sort-fn sort-fn
61 (lambda (a b)
62 (string< (cdr a) (cdr b))))))
63 (cl-loop for (real . sort) in sexps
64 for (start . end) in markers
65 do (progn
66 (goto-char (marker-position start))
67 (insert-before-markers real)
68 (delete-region (point) (marker-position end))))))))
69
70;;; Comment-or-uncomment-sexp
71;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
72
73(defun +lisp-uncomment-sexp (&optional n)
74 "Uncomment N sexps around point."
75 (interactive "P")
76 (let* ((initial-point (point-marker))
77 (inhibit-field-text-motion t)
78 (p)
79 (end (save-excursion
80 (when (elt (syntax-ppss) 4)
81 (re-search-backward comment-start-skip
82 (line-beginning-position)
83 t))
84 (setq p (point-marker))
85 (comment-forward (point-max))
86 (point-marker)))
87 (beg (save-excursion
88 (forward-line 0)
89 (while (and (not (bobp))
90 (= end (save-excursion
91 (comment-forward (point-max))
92 (point))))
93 (forward-line -1))
94 (goto-char (line-end-position))
95 (re-search-backward comment-start-skip
96 (line-beginning-position)
97 t)
98 (ignore-errors
99 (while (looking-at-p comment-start-skip)
100 (forward-char -1)))
101 (point-marker))))
102 (unless (= beg end)
103 (uncomment-region beg end)
104 (goto-char p)
105 ;; Indentify the "top-level" sexp inside the comment.
106 (while (and (ignore-errors (backward-up-list) t)
107 (>= (point) beg))
108 (skip-chars-backward (rx (syntax expression-prefix)))
109 (setq p (point-marker)))
110 ;; Re-comment everything before it.
111 (ignore-errors
112 (comment-region beg p))
113 ;; And everything after it.
114 (goto-char p)
115 (forward-sexp (or n 1))
116 (skip-chars-forward "\r\n[:blank:]")
117 (if (< (point) end)
118 (ignore-errors
119 (comment-region (point) end))
120 ;; If this is a closing delimiter, pull it up.
121 (goto-char end)
122 (skip-chars-forward "\r\n[:blank:]")
123 (when (eq 5 (car (syntax-after (point))))
124 (delete-indentation))))
125 ;; Without a prefix, it's more useful to leave point where
126 ;; it was.
127 (unless n
128 (goto-char initial-point))))
129
130(defun +lisp-comment-sexp--raw ()
131 "Comment the sexp at point or ahead of point."
132 (pcase (or (bounds-of-thing-at-point 'sexp)
133 (save-excursion
134 (skip-chars-forward "\r\n[:blank:]")
135 (bounds-of-thing-at-point 'sexp)))
136 (`(,l . ,r)
137 (goto-char r)
138 (skip-chars-forward "\r\n[:blank:]")
139 (save-excursion
140 (comment-region l r))
141 (skip-chars-forward "\r\n[:blank:]"))))
142
143(defun +lisp-comment-or-uncomment-sexp (&optional n)
144 "Comment the sexp at point and move past it.
145If already inside (or before) a comment, uncomment instead.
146With a prefix argument N, (un)comment that many sexps."
147 (interactive "P")
148 (if (or (elt (syntax-ppss) 4)
149 (< (save-excursion
150 (skip-chars-forward "\r\n[:blank:]")
151 (point))
152 (save-excursion
153 (comment-forward 1)
154 (point))))
155 (+lisp-uncomment-sexp n)
156 (dotimes (_ (or n 1))
157 (+lisp-comment-sexp--raw))))
158
159;;; Sort `setq' constructs
160;;https://emacs.stackexchange.com/questions/33039/
161
162(defun +lisp-sort-setq ()
163 (interactive)
164 (save-excursion
165 (save-restriction
166 (let ((sort-end (progn
167 (end-of-defun)
168 (backward-char)
169 (point-marker)))
170 (sort-beg (progn
171 (beginning-of-defun)
172 (or (re-search-forward "[ \\t]*(" (point-at-eol) t)
173 (point-at-eol))
174 (forward-sexp)
175 (or (re-search-forward "\\<" (point-at-eol) t)
176 (point-at-eol))
177 (point-marker))))
178 (narrow-to-region (1- sort-beg) (1+ sort-end))
179 (sort-subr nil #'+lisp-sort-setq-next-record
180 #'+lisp-sort-setq-end-record)))))
181
182(defun +lisp-sort-setq-next-record ()
183 (condition-case nil
184 (progn
185 (forward-sexp 1)
186 (backward-sexp))
187 ('scan-error (end-of-buffer))))
188
189(defun +lisp-sort-setq-end-record ()
190 (condition-case nil
191 (forward-sexp 2)
192 ('scan-error (end-of-buffer))))
193
194(provide '+lisp)
195;;; +lisp.el ends here
diff --git a/lisp/+message.el b/lisp/+message.el deleted file mode 100644 index b8bc234..0000000 --- a/lisp/+message.el +++ /dev/null
@@ -1,26 +0,0 @@
1;;; +message.el --- Extra message-mode functions -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;; Thanks to Alex Schroeder for this!
8;; https://www.emacswiki.org/emacs/Change_Signature_Dynamically
9
10(defun +message-check-for-signature-change (&rest ignore)
11 "Check for a change in the To: or Cc: fields"
12 (when (and (message--in-tocc-p)
13 (not (buffer-narrowed-p)))
14 (save-excursion
15 (goto-char (point-max))
16 (let ((end (point)))
17 (when (re-search-backward message-signature-separator nil t)
18 (delete-region (1- (match-beginning 0)) end)))
19 (message-insert-signature))))
20
21(defun +message-signature-setup ()
22 (make-local-variable 'after-change-functions)
23 (push '+message-check-for-signature-change after-change-functions))
24
25(provide '+message)
26;;; +message.el ends here
diff --git a/lisp/+minibuffer.el b/lisp/+minibuffer.el deleted file mode 100644 index 7aa57a5..0000000 --- a/lisp/+minibuffer.el +++ /dev/null
@@ -1,14 +0,0 @@
1;;; +minibuffer.el -*- lexical-binding: t -*-
2
3;;; Code:
4
5;; https://www.manueluberti.eu//emacs/2021/12/10/shell-command/
6(defun +minibuffer-complete-history ()
7 "Complete minibuffer history."
8 (interactive)
9 (completion-in-region (minibuffer--completion-prompt-end) (point-max)
10 (symbol-value minibuffer-history-variable)
11 nil))
12
13(provide '+minibuffer)
14;;; +minibuffer.el ends here
diff --git a/lisp/+modeline.el b/lisp/+modeline.el deleted file mode 100644 index c6e8463..0000000 --- a/lisp/+modeline.el +++ /dev/null
@@ -1,488 +0,0 @@
1;;; +modeline.el --- my modeline customizations -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; `+modeline.el' is kind of a dumping ground for various
6;; modeline-related functions. I probably don't use everything in
7;; here. Credit given where possible.
8
9;;; Code:
10
11(require '+util)
12(require 'actually-selected-window)
13(require 'simple-modeline)
14(require 'minions)
15
16(defgroup +modeline nil
17 "Various customization options for my modeline things."
18 :prefix "+modeline-"
19 :group 'simple-modeline)
20
21(defcustom +modeline-default-spacer " "
22 "Default spacer to use for modeline elements.
23All modeline elements take an optional argument, `spacer', which
24will default to this string.")
25
26;;; Combinators
27
28(defun +modeline-concat (segments &optional separator)
29 "Concatenate multiple functional modeline SEGMENTS.
30Each segment in SEGMENTS is a function returning a mode-line
31construct.
32
33Segments are separated using SEPARATOR, which defaults to
34`+modeline-default-spacer'. Only segments that evaluate to a
35non-zero-length string will be separated, for a cleaner look.
36
37This function returns a lambda that should be `:eval'd or
38`funcall'd in a mode-line context."
39 (let ((separator (or separator +modeline-default-spacer)))
40 (lambda ()
41 (let (this-sep result)
42 (dolist (segment segments)
43 (let ((segstr (funcall segment this-sep)))
44 (when (and segstr
45 (not (equal segstr "")))
46 (push segstr result)
47 (setq this-sep separator))))
48 (apply #'concat
49 (nreverse result))))))
50
51(defun +modeline-spacer (&optional n spacer &rest strings)
52 "Make an N-length SPACER, or prepend SPACER to STRINGS.
53When called with no arguments, insert `+modeline-default-spacer'.
54N will repeat SPACER N times, and defaults to 1. SPACER defaults
55to `+modeline-default-spacer', but can be any string. STRINGS
56should form a mode-line construct when `concat'ed."
57 (declare (indent 2))
58 (let ((spacer (or spacer +modeline-default-spacer))
59 (n (or n 1))
60 (strings (cond((null strings) '(""))
61 ((equal strings '("")) nil)
62 ((atom strings) (list strings))
63 (t strings)))
64 r)
65 (when strings (dotimes (_ n) (push spacer r)))
66 (apply #'concat (apply #'concat r) strings)))
67
68;;; Modeline segments
69
70(defun +modeline-sanitize-string (string)
71 "Sanitize a string for `format-mode-line'."
72 (when string
73 (string-replace "%" "%%" string)))
74
75(defcustom +modeline-buffer-name-max-length 0
76 "Maximum length of `+modeline-buffer-name'.
77If > 0 and < 1, use that portion of the window's width. If > 1,
78use that many characters. If anything else, don't limit. If the
79buffer name is longer than the max length, it will be shortened
80and appended with `truncate-string-ellipsis'."
81 :type '(choice (const :tag "No maximum length" 0)
82 (natnum :tag "Number of characters")
83 (float :tag "Fraction of window's width")))
84
85(defcustom +modeline-buffer-position nil
86 "What to put in the `+modeline-buffer-name' position."
87 :type 'function
88 :local t)
89
90(defun +modeline-buffer-name (&optional spacer) ; gonsie
91 "Display the buffer name."
92 (let ((bufname (string-trim (string-replace "%" "%%%%" (buffer-name)))))
93 (+modeline-spacer nil spacer
94 (if (and +modeline-buffer-position (fboundp +modeline-buffer-position))
95 (funcall +modeline-buffer-position)
96 (propertize (cond
97 ((ignore-errors
98 (and
99 (> +modeline-buffer-name-max-length 0)
100 (< +modeline-buffer-name-max-length 1)))
101 (truncate-string-to-width bufname
102 (* (window-total-width)
103 +modeline-buffer-name-max-length)
104 nil nil t))
105 ((ignore-errors
106 (> +modeline-buffer-name-max-length 1))
107 (truncate-string-to-width bufname
108 +modeline-buffer-name-max-length
109 nil nil t))
110 (t bufname))
111 'help-echo (or (buffer-file-name)
112 (buffer-name))
113 'mouse-face 'mode-line-highlight)))))
114
115(defcustom +modeline-minions-icon "&"
116 "The \"icon\" for `+modeline-minions' button."
117 :type 'string)
118
119(defun +modeline-minions (&optional spacer)
120 "Display a button for `minions-minor-modes-menu'."
121 (+modeline-spacer nil spacer
122 (propertize
123 +modeline-minions-icon
124 'help-echo "Minor modes menu\nmouse-1: show menu."
125 'local-map (purecopy (simple-modeline-make-mouse-map
126 'mouse-1
127 (lambda (event)
128 (interactive "e")
129 (with-selected-window
130 (posn-window (event-start event))
131 (minions-minor-modes-menu)))))
132 'mouse-face 'mode-line-highlight)))
133
134(defcustom +modeline-major-mode-faces '((text-mode . font-lock-string-face)
135 (prog-mode . font-lock-keyword-face)
136 (t . font-lock-warning-face))
137 "Mode->face mapping for `+modeline-major-mode'.
138If the current mode is derived from the car of a cell, the face
139in the cdr will be applied to the major-mode in the mode line."
140 :type '(alist :key-type function
141 :value-type face))
142
143(defface +modeline-major-mode-face nil
144 "Face for modeline major-mode.")
145
146(defun +modeline-major-mode (&optional spacer)
147 "Display the current `major-mode'."
148 (+modeline-spacer nil spacer
149 "("
150 (propertize ;; (+string-truncate (format-mode-line mode-name) 16)
151 (format-mode-line mode-name)
152 'face (when (actually-selected-window-p)
153 ;; XXX: This is probably really inefficient. I need to
154 ;; simply detect which mode it's in when I change major
155 ;; modes (`change-major-mode-hook') and change the face
156 ;; there, probably.
157 ;; (catch :done (dolist (cel +modeline-major-mode-faces)
158 ;; (when (derived-mode-p (car cel))
159 ;; (throw :done (cdr cel))))
160 ;; (alist-get t +modeline-major-mode-faces))
161 '+modeline-major-mode-face)
162 'keymap (let ((map (make-sparse-keymap)))
163 (bindings--define-key map [mode-line down-mouse-1]
164 `(menu-item "Menu Bar" ignore
165 :filter ,(lambda (_) (mouse-menu-major-mode-map))))
166 (define-key map [mode-line mouse-2] 'describe-mode)
167 (bindings--define-key map [mode-line down-mouse-3]
168 `(menu-item "Minions" minions-minor-modes-menu))
169 map)
170 'help-echo (+concat (list (format-mode-line mode-name) " mode")
171 "mouse-1: show menu"
172 "mouse-2: describe mode"
173 "mouse-3: display minor modes")
174 'mouse-face 'mode-line-highlight)
175 ")"))
176
177(defcustom +modeline-modified-icon-alist '((ephemeral . "*")
178 (readonly . "=")
179 (modified . "+")
180 (special . "~")
181 (t . "-"))
182 "\"Icons\" to display depending on buffer status in modeline.
183The CAR of each field is one of `readonly', `modified',
184`special', `ephemeral', or t, and the CDR is a string to display
185in that mode.
186
187`readonly' is true if the buffer is read-only and visiting a file.
188`modified' is true if the buffer is modified.
189`special' is true if the buffer is a special-mode or derived buffer.
190`ephemeral' is true if the buffer is not visiting a file.
191t is the fall-back, shown when nothing else in the alist applies.
192
193The order of elements matters: whichever one matches first is applied."
194 :type '(alist :key-type symbol
195 :value-type string)
196 :options '("readonly" "modified" "special" "t"))
197
198(defcustom +modeline-modified-icon-special-modes '(special-mode)
199 "Modes to apply the `special-mode' icon to in the
200`+modeline-modified'."
201 :type '(repeat function))
202
203(defun +modeline-modified (&optional spacer) ; modified from `simple-modeline-status-modified'
204 "Display a color-coded \"icon\" indicator for the buffer's status."
205 (let* ((icon (catch :icon
206 (dolist (cell +modeline-modified-icon-alist)
207 (when (pcase (car cell)
208 ('ephemeral (not (buffer-file-name)))
209 ('readonly buffer-read-only)
210 ('modified (buffer-modified-p))
211 ('special
212 (apply 'derived-mode-p
213 +modeline-modified-icon-special-modes))
214 ('t t)
215 (_ nil))
216 (throw :icon cell))))))
217 (+modeline-spacer nil spacer
218 (propertize (or (cdr-safe icon) "")
219 'help-echo (format "Buffer \"%s\" is %s."
220 (buffer-name)
221 (pcase (car-safe icon)
222 ('t "unmodified")
223 ('nil "unknown")
224 (_ (car-safe icon))))))))
225
226(defun +modeline-narrowed (&optional spacer)
227 "Display an indication that the buffer is narrowed."
228 (when (buffer-narrowed-p)
229 (+modeline-spacer nil spacer
230 (propertize "N"
231 'help-echo (format "%s\n%s"
232 "Buffer is narrowed."
233 "mouse-2: widen buffer.")
234 'local-map (purecopy (simple-modeline-make-mouse-map
235 'mouse-2 'mode-line-widen))
236 'face 'font-lock-doc-face
237 'mouse-face 'mode-line-highlight))))
238
239(defun +modeline-reading-mode (&optional spacer)
240 "Display an indication that the buffer is in `reading-mode'."
241 (when reading-mode
242 (+modeline-spacer nil spacer
243 (propertize
244 (concat "R" (when (bound-and-true-p +eww-readable-p) "w"))
245 'help-echo (format "%s\n%s"
246 "Buffer is in reading-mode."
247 "mouse-2: disable reading-mode.")
248 'local-map (purecopy
249 (simple-modeline-make-mouse-map
250 'mouse-2 (lambda (ev)
251 (interactive "e")
252 (with-selected-window
253 (posn-window
254 (event-start ev))
255 (reading-mode -1)
256 (force-mode-line-update)))))
257 'face 'font-lock-doc-face
258 'mouse-face 'mode-line-highlight))))
259
260(define-minor-mode file-percentage-mode
261 "Toggle the percentage display in the mode line (File Percentage Mode)."
262 :init-value t :global t :group 'mode-line)
263
264(defun +modeline--percentage ()
265 "Return point's progress through current file as a percentage."
266 (let ((tot (count-screen-lines (point-min) (point-max) :ignore-invisible)))
267 (floor (* 100 (/ (float (line-number-at-pos)) tot)))))
268
269(defun +modeline--buffer-contained-in-window-p ()
270 "Whether the buffer is totally contained within its window."
271 (let ((window-min (save-excursion (move-to-window-line 0) (point)))
272 (window-max (save-excursion (move-to-window-line -1) (point))))
273 (and (<= window-min (point-min))
274 (>= window-max (point-max)))))
275
276(defun +modeline-file-percentage (&optional spacer)
277 "Display the position in the current file."
278 (when file-percentage-mode
279 ;; (let ((perc (+modeline--percentage)))
280 ;; (propertize (+modeline-spacer nil spacer
281 ;; (cond
282 ;; ((+modeline--buffer-contained-in-window-p) "All")
283 ;; ((= (line-number-at-pos) (line-number-at-pos (point-min))) "Top")
284 ;; ((= (line-number-at-pos) (line-number-at-pos (point-max))) "Bot")
285 ;; ;; Why the 10 %s? Not sure. `format' knocks them
286 ;; ;; down to 5, then `format-mode-line' kills all but
287 ;; ;; two. If I use only 8, the margin is much too
288 ;; ;; large. Something else is obviously going on, but
289 ;; ;; I'm at a loss as to what it could be.
290 ;; (t (format "%d%%%%%%%%%%" perc))))
291 ;; ;; TODO: add scroll-up and scroll-down bindings.
292 ;; ))
293 (let ((perc (format-mode-line '(-2 "%p"))))
294 (+modeline-spacer nil spacer
295 "/"
296 (pcase perc
297 ("To" "Top")
298 ("Bo" "Bot")
299 ("Al" "All")
300 (_ (format ".%02d" (string-to-number perc))))))))
301
302(defun +modeline-file-percentage-ascii-icon (&optional spacer)
303 (when file-percentage-mode
304 (+modeline-spacer nil spacer
305 (let ((perc (format-mode-line '(-2 "%p"))))
306 (pcase perc
307 ("To" "/\\")
308 ("Bo" "\\/")
309 ("Al" "[]")
310 (_ (let ((vec (vector "/|" "//" "||" "\\\\" "\\|" "\\|"))
311 (perc (string-to-number perc)))
312 (aref vec (floor (/ perc 17))))))))))
313
314(defun +modeline-file-percentage-icon (&optional spacer)
315 "Display the position in the current file as an icon."
316 (when file-percentage-mode
317 (let ((perc (+modeline--percentage)))
318 (propertize (+modeline-spacer nil spacer
319 (cond
320 ((+modeline--buffer-contained-in-window-p) "111")
321 ((= perc 0) "000")
322 ((< perc 20) "001")
323 ((< perc 40) "010")
324 ((< perc 60) "011")
325 ((< perc 80) "100")
326 ((< perc 100) "101")
327 ((>= perc 100) "110")))
328 'help-echo (format "Point is %d%% through the buffer."
329 perc)))))
330
331(define-minor-mode region-indicator-mode
332 "Toggle the region indicator in the mode line."
333 :init-value t :global t :group 'mode-line)
334
335(defun +modeline-region (&optional spacer)
336 "Display an indicator if the region is active."
337 (when (and region-indicator-mode
338 (region-active-p))
339 (+modeline-spacer nil spacer
340 (propertize (format "%d%s"
341 (apply '+ (mapcar (lambda (pos)
342 (- (cdr pos)
343 (car pos)))
344 (region-bounds)))
345 (if (and (< (point) (mark))) "-" "+"))
346 'font-lock-face 'font-lock-variable-name-face))))
347
348(defun +modeline-line (&optional spacer)
349 (when line-number-mode
350 (+modeline-spacer nil spacer
351 "%3l")))
352
353(defun +modeline-column (&optional spacer)
354 (when column-number-mode
355 (+modeline-spacer nil spacer
356 "|"
357 (if column-number-indicator-zero-based "%2c" "%2C"))))
358
359(defcustom +modeline-position-function nil
360 "Function to use instead of `+modeline-position' in modeline."
361 :type '(choice (const :tag "Default" nil)
362 function)
363 :local t)
364
365(defun +modeline-position (&optional spacer)
366 "Display the current cursor position.
367See `line-number-mode', `column-number-mode', and
368`file-percentage-mode'. If `+modeline-position-function' is set
369to a function in the current buffer, call that function instead."
370 (cond ((functionp +modeline-position-function)
371 (when-let* ((str (funcall +modeline-position-function)))
372 (+modeline-spacer nil spacer str)))
373 (t (funcall (+modeline-concat '(+modeline-region
374 +modeline-line
375 +modeline-column
376 +modeline-file-percentage)
377 "")))))
378
379(defun +modeline-vc (&optional spacer)
380 "Display the version control branch of the current buffer in the modeline."
381 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom
382 (when-let ((backend (vc-backend buffer-file-name)))
383 (+modeline-spacer nil spacer
384 (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))))
385
386(defun +modeline-track (&optional spacer)
387 "Display `tracking-mode' information."
388 (when tracking-mode
389 tracking-mode-line-buffers))
390
391(defun +modeline-anzu (&optional spacer)
392 "Display `anzu--update-mode-line'."
393 (+modeline-spacer nil spacer
394 (anzu--update-mode-line)))
395
396(defun +modeline-text-scale (&optional spacer)
397 "Display text scaling level."
398 ;; adapted from https://github.com/seagle0128/doom-modeline
399 (when (and (boundp 'text-scale-mode-amount)
400 (/= text-scale-mode-amount 0))
401 (+modeline-spacer nil spacer
402 (concat (if (> text-scale-mode-amount 0) "+" "-")
403 (number-to-string text-scale-mode-amount)))))
404
405(defun +modeline-ace-window-display (&optional spacer)
406 "Display `ace-window-display-mode' information in the modeline."
407 (when (and +ace-window-display-mode
408 ace-window-mode)
409 (+modeline-spacer nil spacer
410 (window-parameter (selected-window) 'ace-window-path))))
411
412(defun +modeline-god-mode (&optional spacer)
413 "Display an icon when `god-mode' is active."
414 (when (and (boundp 'god-local-mode) god-local-mode)
415 (+modeline-spacer nil spacer
416 (propertize "Ω"
417 'help-echo (concat "God mode is active."
418 "\nmouse-1: exit God mode.")
419 'local-map (purecopy
420 (simple-modeline-make-mouse-map
421 'mouse-1 (lambda (e)
422 (interactive "e")
423 (with-selected-window
424 (posn-window
425 (event-start e))
426 (god-local-mode -1)
427 (force-mode-line-update)))))
428 'mouse-face 'mode-line-highlight))))
429
430(defun +modeline-input-method (&optional spacer)
431 "Display which input method is active."
432 (when current-input-method
433 (+modeline-spacer nil spacer
434 (propertize current-input-method-title
435 'help-echo (format
436 (concat "Current input method: %s\n"
437 "mouse-1: Describe current input method\n"
438 "mouse-3: Toggle input method")
439 current-input-method)
440 'local-map (purecopy
441 (let ((map (make-sparse-keymap)))
442 (define-key map [mode-line mouse-1]
443 (lambda (e)
444 (interactive "e")
445 (with-selected-window (posn-window (event-start e))
446 (describe-current-input-method))))
447 (define-key map [mode-line mouse-3]
448 (lambda (e)
449 (interactive "e")
450 (with-selected-window (posn-window (event-start e))
451 (toggle-input-method nil :interactive))))
452 map))
453 'mouse-face 'mode-line-highlight))))
454
455(defface +modeline-kmacro-indicator '((t :foreground "Firebrick"))
456 "Face for the kmacro indicator in the modeline.")
457
458(defun +modeline-kmacro-indicator (&optional spacer)
459 "Display an indicator when recording a kmacro."
460 (when defining-kbd-macro
461 (+modeline-spacer nil spacer
462 (propertize "●"
463 'face '+modeline-kmacro-indicator
464 'help-echo (format (concat "Defining a macro\n"
465 "Current step: %d\n"
466 "mouse-1: Stop recording")
467 kmacro-counter)
468 'local-map (purecopy (simple-modeline-make-mouse-map
469 'mouse-1 (lambda (e)
470 (interactive "e")
471 (with-selected-window
472 (posn-window (event-start e))
473 (kmacro-end-macro nil)))))
474 'mouse-face 'mode-line-highlight))))
475
476(defface +nyan-mode-line nil
477 "Face for nyan-cat in mode line.")
478
479(defun +modeline-nyan-on-focused (&optional spacer)
480 "Display the cat from `nyan-mode', but only on the focused window."
481 (require 'nyan-mode)
482 (when (and (or nyan-mode (bound-and-true-p +nyan-local-mode))
483 (actually-selected-window-p))
484 (+modeline-spacer nil spacer
485 (propertize (nyan-create) 'face '+nyan-mode-line))))
486
487(provide '+modeline)
488;;; +modeline.el ends here
diff --git a/lisp/+mwim.el b/lisp/+mwim.el deleted file mode 100644 index 97a2b04..0000000 --- a/lisp/+mwim.el +++ /dev/null
@@ -1,42 +0,0 @@
1;;; +mwim.el --- Extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'seq)
8
9(defgroup +mwim nil
10 "Extra `mwim' customizations."
11 :group 'mwim)
12
13(defcustom +mwim-passthrough-modes nil
14 "Modes to not move-where-I-mean."
15 :type '(repeat function))
16
17(defun +mwim-beginning-maybe (&optional arg)
18 "Perform `mwim-beginning', maybe.
19Will just do \\[beginning-of-line] in one of
20`+mwim-passthrough-modes'."
21 (interactive)
22 (if (apply #'derived-mode-p +mwim-passthrough-modes)
23 (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode))))
24 (key "C-a"))
25 (call-interactively (or (keymap-lookup this-mode-map key t t)
26 (keymap-lookup (current-global-map) key t t))))
27 (call-interactively #'mwim-beginning)))
28
29(defun +mwim-end-maybe (&optional arg)
30 "Perform `mwim-beginning', maybe.
31Will just do \\[end-of-line] in one of
32`+mwim-passthrough-modes'."
33 (interactive)
34 (if (apply #'derived-mode-p +mwim-passthrough-modes)
35 (let ((this-mode-map (symbol-value (intern (format "%s-map" major-mode))))
36 (key "C-e"))
37 (call-interactively (or (keymap-lookup this-mode-map key t t)
38 (keymap-lookup (current-global-map) key t t))))
39 (call-interactively #'mwim-end)))
40
41(provide '+mwim)
42;;; +mwim.el ends here
diff --git a/lisp/+notmuch.el b/lisp/+notmuch.el deleted file mode 100644 index 9e79c5a..0000000 --- a/lisp/+notmuch.el +++ /dev/null
@@ -1,97 +0,0 @@
1;;; +notmuch.el --- Notmuch extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; This is stuff that I suppose /could/ go in notmuch/init.el, but ... doesn't.
6
7;;; Code:
8
9(require 'cl-lib)
10(require 'notmuch)
11
12(defvar +notmuch-send-dispatch-rules nil
13 "Alist of from addresses and variables to set when sending.")
14
15(defun +notmuch-query-concat (&rest queries)
16 "Concatenate notmuch queries."
17 (mapconcat #'identity queries " AND "))
18
19(defun +send-mail-dispatch ()
20 "Dispatch mail sender, depending on account."
21 (let ((from (message-fetch-field "from")))
22 (dolist (vars (cl-loop for (addr . vars) in +notmuch-send-dispatch-rules
23 if (string-match-p addr from) return vars))
24 (set (car vars) (cdr vars)))))
25
26(defun +notmuch-correct-tags (args)
27 (list (car args) (mapcar #'string-trim (cadr args))))
28
29(defun +notmuch-goto (&optional prefix)
30 "Go straight to a `notmuch' search.
31Without PREFIX argument, go to the first one in
32`notmuch-saved-searches'; with a PREFIX argument, prompt the user
33for which saved search to go to; with a double PREFIX
34argument (\\[universal-argument] \\[universal-argument]), prompt
35for search."
36 (interactive "P")
37 (pcase prefix
38 ('nil (notmuch-search (plist-get (car notmuch-saved-searches) :query)))
39 ('(4) (notmuch-search (plist-get (cl-find (completing-read "Saved Search: "
40 (mapcar (lambda (el)
41 (plist-get el :name))
42 notmuch-saved-searches))
43 notmuch-saved-searches
44 :key (lambda (el) (plist-get el :name))
45 :test #'equal)
46 :query)))
47 (_ (notmuch-search))))
48
49;; Don't add an initial input when completing addresses
50(el-patch-feature notmuch)
51(with-eval-after-load 'notmuch
52 (el-patch-defun notmuch-address-selection-function (prompt collection initial-input)
53 "Call (`completing-read'
54 PROMPT COLLECTION nil nil INITIAL-INPUT 'notmuch-address-history)"
55 (completing-read
56 prompt collection nil nil
57 (el-patch-swap initial-input
58 nil)
59 'notmuch-address-history)))
60
61(defcustom +notmuch-spam-tags '("+spam" "+Spam")
62 "A list of tag changes to apply when marking a thread as spam."
63 :type '(repeat string))
64
65(defun +notmuch-tree-mark-spam-then-next (&optional ham beg end)
66 "Mark the current message as spam and move to the next."
67 (interactive "P")
68 (+notmuch-tree-mark-spam ham)
69 (notmuch-tree-next-matching-message))
70
71(defun +notmuch-tree-mark-spam (&optional ham)
72 "Mark the current message as spam.
73That is, apply the tag changes in `+notmuch-spam-tags' to it. If
74an optional prefix HAM argument is given, the message will be
75marked as not-spam (\"ham\"), i.e., the tag changes in
76`+notmuch-spam-tags' will be reversed."
77 (interactive "P")
78 (when +notmuch-spam-tags
79 (notmuch-tree-tag
80 (notmuch-tag-change-list +notmuch-spam-tags ham))))
81
82(defun +notmuch-search-mark-spam (&optional ham beg end)
83 "Mark the current thread or region as spam.
84This adds the tags in `+notmuch-spam-tags' to the message. With
85an optional HAM prefix argument, mark the messages as
86not-spam (\"ham\").
87
88This function advances the next thread when finished."
89 (interactive (cons current-prefix-arg (notmuch-interactive-region)))
90 (when +notmuch-spam-tags
91 (notmuch-search-tag
92 (notmuch-tag-change-list +notmuch-spam-tags ham) beg end))
93 (when (eq beg end)
94 (notmuch-search-next-thread)))
95
96(provide '+notmuch)
97;;; +notmuch.el ends here
diff --git a/lisp/+nyan-mode.el b/lisp/+nyan-mode.el deleted file mode 100644 index 33ae9af..0000000 --- a/lisp/+nyan-mode.el +++ /dev/null
@@ -1,42 +0,0 @@
1;;; +nyan-mode.el --- Extras for nyan-mode -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;;; Update even without line number in the mode line.
8
9(defcustom +nyan-mode-update-functions
10 '( end-of-buffer beginning-of-buffer
11 next-line previous-line
12 org-next-visible-heading org-previous-visible-heading)
13 "Functions after which to force a mode-line update."
14 :type '(repeat function))
15
16(defun +nyan-mode--fmlu (&rest _)
17 "Update the mode-line, advice-style."
18 (force-mode-line-update))
19
20(defun +nyan-mode-advice (&rest _)
21 "Advise line-moving functions when in `nyan-mode'."
22 (dolist (fn +nyan-mode-update-functions)
23 (if nyan-mode
24 (advice-add fn :after #'+nyan-mode--fmlu)
25 (advice-remove fn #'+nyan-mode--fmlu))))
26
27(defface +nyan-mode-line nil
28 "Face for the nyan-mode mode-line indicator.")
29
30(define-minor-mode +nyan-local-mode
31 "My very own `nyan-mode' that isn't global and doesn't update the mode-line."
32 :global nil
33 :group 'nyan
34 (dolist (fn +nyan-mode-update-functions)
35 (if +nyan-local-mode
36 (advice-add fn :after #'+nyan-mode--fmlu)
37 (advice-remove fn #'+nyan-mode--fmlu))))
38
39(define-globalized-minor-mode +nyan-mode +nyan-local-mode +nyan-local-mode)
40
41(provide '+nyan-mode)
42;;; +nyan-mode.el ends here
diff --git a/lisp/+orderless.el b/lisp/+orderless.el deleted file mode 100644 index ac8c1b4..0000000 --- a/lisp/+orderless.el +++ /dev/null
@@ -1,60 +0,0 @@
1;;; +orderless.el --- Mostly from minad -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; See https://github.com/minad/consult/wiki#minads-orderless-configuration
6
7;;; Code:
8
9(require 'orderless)
10
11;;; Dispataching
12
13(defvar +orderless-dispatch-alist '((?% . char-fold-to-regexp)
14 (?! . orderless-without-literal)
15 (?` . orderless-initialism)
16 (?= . orderless-literal)
17 (?~ . orderless-flex))
18 "Charcters to dispatch styles on orderless segments.")
19
20(defun +orderless-dispatch (pattern index _total)
21 "Dispatch orderless segments of a search string.
22Dispatchers are taken from `+orderless-dispatch-alist', and added
23to the following defaults:
24
25- regexp$ :: matches REGEXP at the end of the pattern.
26- .ext :: matches EXT (at end of pattern)
27
28Dispatch characters can be added at the beginning or ending of a
29segment to make that segment match accordingly."
30 (cond
31 ;; Ensure that $ works with Consult commands, which add disambiguation
32 ;; suffixes
33 ((string-suffix-p "$" pattern)
34 (cons 'orderless-regexp
35 (concat (substring pattern 0 -1) "[\x100000-\x10FFFD]*$")))
36 ;; File extensions
37 ((and
38 ;; Completing filename or eshell
39 (or minibuffer-completing-file-name
40 (derived-mode-p 'eshell-mode))
41 ;; File extension
42 (string-match-p "\\`\\.." pattern))
43 (cons 'orderless-regexp
44 (concat "\\." (substring pattern 1) "[\x100000-\x10FFFD]*$")))
45 ;; Ignore single !
46 ((string= "!" pattern) `(orderless-literal . ""))
47 ;; Prefix and suffix
48 ((if-let (x (assq (aref pattern 0) +orderless-dispatch-alist))
49 (cons (cdr x) (substring pattern 1))
50 (when-let (x (assq (aref pattern (1- (length pattern)))
51 +orderless-dispatch-alist))
52 (cons (cdr x) (substring pattern 0 -1)))))))
53
54(orderless-define-completion-style +orderless-with-initialism
55 (orderless-matching-styles '(orderless-initialism
56 orderless-literal
57 orderless-regexp)))
58
59(provide '+orderless)
60;;; +orderless.el ends here
diff --git a/lisp/+org-attach.el b/lisp/+org-attach.el deleted file mode 100644 index 5e7cc7f..0000000 --- a/lisp/+org-attach.el +++ /dev/null
@@ -1,29 +0,0 @@
1;;; +org-attach.el --- Fixes for org-attach -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; `org-attach-attach' doesn't fix the path name. Before I submit a bug, I'm
6;; just fixing it by advising `org-attach-attach'.
7
8;;; Code:
9
10(defun +org-attach-attach-fix-args (args)
11 "ADVICE for `org-attach-attach' to normalize FILE first.
12VISIT-DIR and METHOD are passed through unchanged.
13
14This should be applied as `:filter-args' advice."
15 (cons (expand-file-name (car args)) (cdr args)))
16
17(define-minor-mode +org-attach-fix-args-mode
18 "Fix the arguments passed to `org-attach-attach'.
19This mode normalizes the filename passed to `org-attach-attach'
20so that links can be properly made."
21 :lighter ""
22 :keymap nil
23 :global t ; I figure, what does this hurt?
24 (if +org-attach-fix-args-mode
25 (advice-add 'org-attach-attach :filter-args #'+org-attach-attach-fix-args)
26 (advice-remove 'org-attach-attach #'+org-attach-attach-fix-args)))
27
28(provide '+org-attach)
29;;; +org-attach.el ends here
diff --git a/lisp/+org-capture.el b/lisp/+org-capture.el deleted file mode 100644 index 7ed4e00..0000000 --- a/lisp/+org-capture.el +++ /dev/null
@@ -1,164 +0,0 @@
1;;; +org-capture.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'cl-lib)
6(require 'acdw)
7;; We don't require `org-capture' here because I'll have to require this library
8;; to init.el /before/ org-capture is fully needed. But I do need to declare
9;; `org-capture-templates'.
10(defvar org-capture-templates nil)
11
12(defun +org-capture--get (key &optional list)
13 "Find KEY in LIST, or return nil.
14LIST defaults to `org-capture-templates'."
15 (alist-get key (or list org-capture-templates) nil nil #'equal))
16
17;; Set it up as a generic value. Based on the one for `alist-get'.
18(gv-define-expander +org-capture--get
19 (lambda (do key &optional alist)
20 (setq alist (or alist org-capture-templates))
21 (macroexp-let2 macroexp-copyable-p k key
22 (gv-letplace (getter setter) alist
23 (macroexp-let2 nil p `(assoc ,k ,getter 'equal)
24 (funcall do `(cdr ,p)
25 (lambda (v)
26 (macroexp-let2 nil v v
27 (let ((set-exp
28 `(if ,p (setcdr ,p ,v)
29 ,(funcall setter
30 `(cons (setq ,p (cons ,k ,v))
31 ,getter)))))
32 `(progn
33 ,set-exp
34 ,v))))))))))
35
36(defun +org-capture-sort (&optional list)
37 "Sort LIST by string keys.
38LIST is a symbol and defaults to `org-capture-templates'."
39 (setq list (or list 'org-capture-templates))
40 (set list (sort (symbol-value list) (lambda (a b)
41 (string< (car a) (car b))))))
42
43(defun +org-capture-sort-after-init (&optional list)
44 "Sort LIST with `+org-capture-sort' after Emacs init."
45 (+ensure-after-init #'+org-capture-sort))
46
47;;;###autoload
48(defun +org-capture-templates-setf (key value &optional list sort-after)
49 "Add KEY to LIST, using `setf'.
50LIST is a symbol and defaults to `org-capture-templates' -- so
51this function sets values on a list that's structured as such.
52
53Thus, KEY is a string key. If it's longer than one character,
54this function will search LIST for each successive run of
55characters before the final, ensuring sub-lists exist of the
56form (CHARS DESCRIPTION).
57
58For example, if KEY is \"abc\", first a LIST item of the form (a
59DESCRIPTION), if non-existant, will be added to the list (with a
60default description), then an item of the
61form (\"ab\" DESCRIPTION), before adding (KEY VALUE) to the LIST.
62
63VALUE is the template or group header required for
64`org-capture-templates', which see.
65
66SORT-AFTER, when set to t, will call
67`+org-capture-templates-sort' after setting, to ensure org can
68properly process the variable."
69 ;; LIST defaults to `org-capture-templates'
70 (declare (indent 2))
71 (unless list (setq list 'org-capture-templates))
72 ;; Ensure VALUE is a list to cons properly
73 (unless (listp value) (setq value (list value)))
74 (when (> (length key) 1)
75 ;; Check for existence of groups.
76 (let ((expected (cl-loop for i from 1 to (1- (length key))
77 collect (substring key 0 i) into keys
78 finally return keys)))
79 (cl-loop for ek in expected
80 if (not (+org-capture--get ek (symbol-value list))) do
81 (setf (+org-capture--get ek (symbol-value list))
82 (list (format "(Group %s)" ek))))))
83 (prog1 ;; Set KEY to VALUE
84 (setf (+org-capture--get key (symbol-value list)) value)
85 ;; Sort after, maybe
86 (when sort-after (+org-capture-sort list))))
87
88(defun +org-template--ensure-path (keys &optional list)
89 "Ensure path of keys exists in `org-capture-templates'."
90 (unless list (setq list 'org-capture-templates))
91 (when (> (length key) 1)
92 ;; Check for existence of groups.
93 (let ((expected (cl-loop for i from 1 to (1- (length key))
94 collect (substring key 0 i) into keys
95 finally return keys)))
96 (cl-loop for ek in expected
97 if (not (+org-capture--get ek (symbol-value list))) do
98 (setf (+org-capture--get ek (symbol-value list))
99 (list (format "(Group %s)" ek)))))))
100
101(defcustom +org-capture-default-type 'entry
102 "Default template for `org-capture-templates'."
103 :type '(choice (const :tag "Entry" entry)
104 (const :tag "Item" item)
105 (const :tag "Check Item" checkitem)
106 (const :tag "Table Line" table-line)
107 (const :tag "Plain Text" plain)))
108
109(defcustom +org-capture-default-target ""
110 "Default target for `org-capture-templates'."
111 ;; TODO: type
112 )
113
114(defcustom +org-capture-default-template nil
115 "Default template for `org-capture-templates'."
116 ;; TODO: type
117 )
118
119(defun +org-define-capture-templates-group (keys description)
120 "Add a group title to `org-capture-templates'."
121 (setf (+org-capture--get keys org-capture-templates)
122 (list description)))
123
124;; [[https://github.com/cadadr/configuration/blob/39813a771286e542af3aa333172858532c3bb257/emacs.d/gk/gk-org.el#L1573][from cadadr]]
125(defun +org-define-capture-template (keys description &rest args)
126 "Define a capture template and necessary antecedents.
127ARGS is a plist, which in addition to the additional options
128`org-capture-templates' accepts, takes the following and places
129them accordingly: :type, :target, and :template. Each of these
130corresponds to the same field in `org-capture-templates's
131docstring, which see. Likewise with KEYS and DESCRIPTION, which
132are passed separately to the function.
133
134This function will also create all the necessary intermediate
135capture keys needed for `org-capture'; that is, if KEYS is
136\"wcp\", entries for \"w\" and \"wc\" will both be ensured in
137`org-capture-templates'."
138 (declare (indent 2))
139 ;; Check for existence of parent groups
140 (when (> (length keys) 1)
141 (let ((expected (cl-loop for i from 1 to (1- (length keys))
142 collect (substring 0 i) into keys
143 finally return keys)))
144 (cl-loop
145 for ek in expected
146 if (not (+org-capture--get ek org-capture-templates))
147 do (+org-define-capture-templates-group ek (format "(Group %s)" ek)))))
148 (if (null args)
149 ;; Add the title
150 (+org-define-capture-templates-group keys description)
151 ;; Add the capture template.
152 (setf (+org-capture--get keys org-capture-templates)
153 (append (list (or (plist-get args :type)
154 +org-capture-default-type)
155 (or ( plist-get args :target)
156 +org-capture-default-target)
157 (or (plist-get args :template)
158 +org-capture-default-template))
159 (cl-loop for (key val) on args by #'cddr
160 unless (member key '(:type :target :template))
161 append (list key val))))))
162
163(provide '+org-capture)
164;;; +org-capture.el ends here
diff --git a/lisp/+org-drawer-list.el b/lisp/+org-drawer-list.el deleted file mode 100644 index 5066d4d..0000000 --- a/lisp/+org-drawer-list.el +++ /dev/null
@@ -1,47 +0,0 @@
1;;; +org-drawer-list.el --- Add stuff to org drawers easy-style -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'org)
8(require '+org)
9(require 'ol)
10(require 'org-drawer-list)
11
12(defcustom +org-drawer-list-resources-drawer "RESOURCES"
13 "Where to add links with `+org-drawer-list-add-resource'.")
14
15(defun +org-drawer-list-add-resource (url &optional title)
16 "Add URL to the resource drawer of the current tree.
17The resource drawer is given by the variable
18`+org-drawer-list-resources-drawer'. If optional TITLE is given,
19format the list item as an Org link."
20 (interactive
21 (let* ((clipboard-url (if (string-match-p (rx (sequence bos
22 (or "http"
23 "gemini"
24 "gopher"
25 "tel"
26 "mailto")))
27 (current-kill 0))
28 (string-trim (current-kill 0))
29 (read-string "Resource URL: ")))
30 (url-title (let ((clipboard-headings
31 (+org-insert--get-title-and-headings clipboard-url)))
32 (read-string "title (edit): "
33 (completing-read
34 "title: " clipboard-headings
35 nil nil nil nil (car clipboard-headings))))))
36 (list clipboard-url url-title)))
37 (let (current-visible-mode visible-mode)
38 ;; XXX: This is not the "proper" way to fix the issue I was having --- I've
39 ;; isolated the bug to somewhere in `org-insert-item', but this fix works
40 ;; well enough™ for now.
41 (visible-mode +1)
42 (org-drawer-list-add +org-drawer-list-resources-drawer
43 (org-link-make-string url title))
44 (visible-mode (if current-visible-mode +1 -1))))
45
46(provide '+org-drawer-list)
47;;; +org-drawer-list.el ends here
diff --git a/lisp/+org-wc.el b/lisp/+org-wc.el deleted file mode 100644 index 89b2708..0000000 --- a/lisp/+org-wc.el +++ /dev/null
@@ -1,112 +0,0 @@
1;;; +org-wc.el --- org-wc in the modeline -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'org-wc)
8(require '+modeline)
9(require 'cl-lib)
10
11(defgroup +org-wc nil
12 "Extra fast word-counting in `org-mode'"
13 :group 'org-wc
14 :group 'org)
15
16(defvar-local +org-wc-word-count nil
17 "Running total of words in this buffer.")
18
19(defcustom +org-wc-update-after-funcs '(org-narrow-to-subtree
20 org-narrow-to-block
21 org-narrow-to-element
22 org-capture-narrow)
23 "Functions after which to update the word count."
24 :type '(repeat function))
25
26(defcustom +org-wc-deletion-idle-timer 0.25
27 "Length of time, in seconds, to wait before updating word-count."
28 :type 'number)
29
30(defcustom +org-wc-huge-change 5000
31 "Number of characters that constitute a \"huge\" insertion."
32 :type 'number)
33
34(defcustom +org-wc-huge-buffer 10000
35 "Number of words past which we're not going to try to count."
36 :type 'number)
37
38(defvar +org-wc-correction -5
39 "Number to add to `+org-wc-word-count', for some reason?
40`+org-wc-word-count' seems to consistently be off by 5. Thus
41this correction. (At some point I should correct the underlying
42code... probably).")
43
44(defvar-local +org-wc-update-timer nil)
45
46(defun +org-wc-delayed-update (&rest _)
47 (if +org-wc-update-timer
48 (setq +org-wc-update-timer nil)
49 (setq +org-wc-update-timer
50 (run-with-idle-timer +org-wc-deletion-idle-timer nil #'+org-wc-update))))
51
52(defun +org-wc-force-update ()
53 (interactive)
54 (message "Counting words...")
55 (when (timerp +org-wc-update-timer)
56 (cancel-timer +org-wc-update-timer))
57 (+org-wc-update)
58 (message "Counting words...done"))
59
60(defun +org-wc-update (&rest _) ; Needs variadic parameters, since it's advice
61 (dlet ((+org-wc-counting t))
62 (+org-wc-buffer)
63 (force-mode-line-update)
64 (setq +org-wc-update-timer nil)))
65
66(defun +org-wc-changed (start end length)
67 (+org-wc-delayed-update))
68
69(defun +org-wc-buffer ()
70 "Count the words in the buffer."
71 (when (and (derived-mode-p 'org-mode)
72 (not (eq +org-wc-word-count 'huge)))
73 (setq +org-wc-word-count
74 (cond
75 ((> (count-words (point-min) (point-max))
76 +org-wc-huge-buffer)
77 'huge)
78 (t (org-word-count-aux (point-min) (point-max)))))))
79
80(defvar +org-wc-counting nil
81 "Are we currently counting?")
82
83(defun +org-wc-recount-widen (&rest _)
84 (when (and (not +org-wc-counting))
85 (+org-wc-update)))
86
87(defun +org-wc-modeline ()
88 (cond
89 ((eq +org-wc-word-count 'huge) "huge")
90 (+org-wc-word-count (format "%sw" (max 0 (+ +org-wc-word-count +org-wc-correction))))))
91
92(define-minor-mode +org-wc-mode
93 "Count words in `org-mode' buffers in the mode-line."
94 :lighter ""
95 :keymap (let ((map (make-sparse-keymap)))
96 (define-key map (kbd "C-c C-.") #'+org-wc-force-update)
97 map)
98 (if +org-wc-mode
99 (progn ; turn on
100 (+org-wc-buffer)
101 (add-hook 'after-change-functions #'+org-wc-delayed-update nil t)
102 (setq-local +modeline-position-function #'+org-wc-modeline)
103 (dolist (fn +org-wc-update-after-funcs)
104 (advice-add fn :after #'+org-wc-update)))
105 (progn ; turn off
106 (remove-hook 'after-change-functions #'+org-wc-delayed-update t)
107 (kill-local-variable '+modeline-position-function)
108 (dolist (fn +org-wc-update-after-funcs)
109 (advice-remove fn #'+org-wc-update)))))
110
111(provide '+org-wc)
112;;; +org-wc.el ends here
diff --git a/lisp/+org.el b/lisp/+org.el deleted file mode 100644 index dc0ce1b..0000000 --- a/lisp/+org.el +++ /dev/null
@@ -1,816 +0,0 @@
1;;; +org.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'el-patch)
6(require 'org)
7(require 'org-element)
8(require 'ox)
9
10;;; org-return-dwim - [[https://github.com/alphapapa/unpackaged.el][unpackaged]] and [[http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/][kitchin]]
11
12(defun +org-element-descendant-of (type element)
13 "Return non-nil if ELEMENT is a descendant of TYPE.
14TYPE should be an element type, like `item' or `paragraph'.
15ELEMENT should be a list like that returned by `org-element-context'."
16 ;; MAYBE: Use `org-element-lineage'.
17 (when-let* ((parent (org-element-property :parent element)))
18 (or (eq type (car parent))
19 (+org-element-descendant-of type parent))))
20
21(defun +org-return-dwim (&optional prefix)
22 "A helpful replacement for `org-return'. With PREFIX, call `org-return'.
23
24On headings, move point to position after entry content. In
25lists, insert a new item or end the list, with checkbox if
26appropriate. In tables, insert a new row or end the table."
27 (interactive "P")
28 ;; Auto-fill if enabled
29 (when auto-fill-function
30 (if (listp auto-fill-function)
31 (dolist (func auto-fill-function)
32 (funcall func))
33 (funcall auto-fill-function)))
34 (if prefix
35 ;; Handle prefix args
36 (pcase prefix
37 ('(4) (newline))
38 ('(16) (newline 2))
39 ;; this is ... not ideal. but whatever.
40 (_ (newline prefix)))
41 (cond
42 ;; Act depending on context around point.
43 ((and org-return-follows-link
44 (eq 'link (car (org-element-context))))
45 ;; Link: Open it.
46 (org-open-at-point-global))
47
48 ((org-at-heading-p)
49 ;; Heading: Move to position after entry content.
50 ;; NOTE: This is probably the most interesting feature of this function.
51 (let ((heading-start (org-entry-beginning-position)))
52 (goto-char (org-entry-end-position))
53 (cond ((and (org-at-heading-p)
54 (= heading-start (org-entry-beginning-position)))
55 ;; Entry ends on its heading; add newline after
56 (end-of-line)
57 (insert "\n\n"))
58 (t
59 ;; Entry ends after its heading; back up
60 (forward-line -1)
61 (end-of-line)
62 (when (org-at-heading-p)
63 ;; At the same heading
64 (forward-line)
65 (insert "\n")
66 (forward-line -1))
67 (while (not
68 (looking-back
69 (rx (repeat 3 (seq (optional blank) "\n")))
70 nil))
71 (insert "\n"))
72 (forward-line -1)))))
73
74 ((org-at-item-checkbox-p)
75 ;; Checkbox: Insert new item with checkbox.
76 (org-insert-todo-heading nil))
77
78 ((org-in-item-p)
79 ;; Plain list
80 (let* ((context (org-element-context))
81 (first-item-p (eq 'plain-list (car context)))
82 (itemp (eq 'item (car context)))
83 (emptyp (or
84 ;; Empty list item (regular)
85 (eq (org-element-property :contents-begin context)
86 (org-element-property :contents-end context))
87 ;; Empty list item (definition)
88 ;; This seems to work, with minimal testing. -- 2022-02-17
89 (looking-at " *::")))
90 (item-child-p
91 (+org-element-descendant-of 'item context)))
92 ;; The original function from unpackaged just tested the (or ...) test
93 ;; in this cond, in an if. However, that doesn't auto-end nested
94 ;; lists. So I made this form a cond and added the (and...) test in
95 ;; the first position, which is clunky (the delete-region... stuff
96 ;; comes twice) and might not be needed. More testing, obviously, but
97 ;; for now, it works well enough.
98 (cond ((and itemp emptyp)
99 (delete-region (line-beginning-position) (line-end-position))
100 (insert "\n"))
101 ((or first-item-p
102 (and itemp (not emptyp))
103 item-child-p)
104 (org-insert-item))
105 (t (delete-region (line-beginning-position) (line-end-position))
106 (insert "\n")))))
107
108 ((when (fboundp 'org-inlinetask-in-task-p)
109 (org-inlinetask-in-task-p))
110 ;; Inline task: Don't insert a new heading.
111 (org-return))
112
113 ((org-at-table-p)
114 (cond ((save-excursion
115 (beginning-of-line)
116 ;; See `org-table-next-field'.
117 (cl-loop with end = (line-end-position)
118 for cell = (org-element-table-cell-parser)
119 always (equal (org-element-property :contents-begin cell)
120 (org-element-property :contents-end cell))
121 while (re-search-forward "|" end t)))
122 ;; Empty row: end the table.
123 (delete-region (line-beginning-position) (line-end-position))
124 (org-return))
125 (t
126 ;; Non-empty row: call `org-return'.
127 (org-return))))
128 (t
129 ;; All other cases: call `org-return'.
130 (org-return)))))
131
132(defun +org-table-copy-down (n)
133 "Call `org-table-copy-down', or `org-return' outside of a table.
134N is passed to the functions."
135 (interactive "p")
136 (if (org-table-check-inside-data-field 'noerror)
137 (org-table-copy-down n)
138 (+org-return-dwim n)))
139
140;;; org-fix-blank-lines - unpackaged.el
141
142(defun +org-fix-blank-lines (&optional prefix)
143 "Ensure blank lines around headings.
144Optional PREFIX argument operates on the entire buffer.
145Drawers are included with their headings."
146 (interactive "P")
147 (let ((org-element-use-cache nil))
148 (org-map-entries (lambda ()
149 (let ((beg (org-entry-beginning-position))
150 (end (org-entry-end-position)))
151 (org-with-wide-buffer
152 ;; `org-map-entries' narrows the buffer, which
153 ;; prevents us from seeing newlines before the
154 ;; current heading, so we do this part widened.
155 (while (not (looking-back "\n\n" nil))
156 ;; Insert blank lines before heading.
157 (insert "\n")))
158
159 ;; Insert blank lines before entry content
160 (forward-line)
161 (while (and (org-at-planning-p)
162 (< (point) (point-max)))
163 ;; Skip planning lines
164 (forward-line))
165 (while (re-search-forward
166 org-drawer-regexp end t)
167 ;; Skip drawers. You might think that
168 ;; `org-at-drawer-p' would suffice, but for
169 ;; some reason it doesn't work correctly when
170 ;; operating on hidden text. This works, taken
171 ;; from `org-agenda-get-some-entry-text'.
172 (re-search-forward "^[ \t]*:END:.*\n?" end t)
173 (goto-char (match-end 0)))
174 (unless (or (= (point) (point-max))
175 (org-at-heading-p)
176 (looking-at-p "\n"))
177 (insert "\n"))))
178 t
179 (if prefix
180 nil
181 'tree))))
182
183;;; org-count-words
184
185(defun +org-count-words-stupidly (start end &optional limit)
186 "Count words between START and END, ignoring a lot.
187
188Since this function is, for some reason, pricy, the optional
189parameter LIMIT sets a word limit at which to stop counting.
190Once the function hits that number, it'll return -LIMIT
191instead of the true count."
192 (interactive (list nil nil))
193 (cond ((not (called-interactively-p 'any))
194 (let ((words 0)
195 (continue t))
196 (save-excursion
197 (save-restriction
198 (narrow-to-region start end)
199 (goto-char (point-min))
200 (while (and continue
201 (< (point) (point-max)))
202 (cond
203 ;; Ignore comments
204 ((or (org-at-comment-p)
205 (org-in-commented-heading-p))
206 (forward-line))
207 ;; Ignore headings
208 ((or (org-at-heading-p))
209 (forward-line))
210 ;; Ignore property and log drawers
211 ((or (looking-at org-drawer-regexp)
212 (looking-at org-clock-drawer-re))
213 (search-forward ":END:" nil :noerror)
214 (forward-line))
215 ;; Ignore DEADLINE and SCHEDULED keywords
216 ((or (looking-at org-deadline-regexp)
217 (looking-at org-scheduled-regexp)
218 (looking-at org-closed-time-regexp))
219 (forward-line))
220 ;; Ignore tables
221 ((org-at-table-p) (forward-line))
222 ;; Ignore hyperlinks, but count the descriptions
223 ((looking-at org-link-bracket-re)
224 (when-let ((desc (match-string-no-properties 5)))
225 (save-match-data
226 (setq words (+ words
227 (length (remove ""
228 (org-split-string
229 desc "\\W")))))))
230 (goto-char (match-end 0)))
231 ;; Ignore source blocks
232 ((org-in-src-block-p) (forward-line))
233 ;; Ignore blank lines
234 ((looking-at "^$")
235 (forward-line))
236 ;; Count everything else
237 (t
238 ;; ... unless it's in a few weird contexts
239 (let ((contexts (org-context)))
240 (cond ((or (assoc :todo-keyword contexts)
241 (assoc :priority contexts)
242 (assoc :keyword contexts)
243 (assoc :checkbox contexts))
244 (forward-word-strictly))
245
246 (t (setq words (1+ words))
247 (if (and limit
248 (> words limit))
249 (setq words (- limit)
250 continue nil))
251 (forward-word-strictly)))))))))
252 words))
253 ((use-region-p)
254 (message "%d words in region"
255 (+org-count-words-stupidly (region-beginning)
256 (region-end))))
257 (t
258 (message "%d words in buffer"
259 (+org-count-words-stupidly (point-min)
260 (point-max))))))
261
262;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
263
264(defun +org-insert--get-title-and-headings (url)
265 "Retrieve title and headings from URL.
266Return as a list."
267 (with-current-buffer (url-retrieve-synchronously url)
268 (let ((dom (libxml-parse-html-region (point-min) (point-max))))
269 (cl-remove-if
270 (lambda (i) (string= i ""))
271 (apply #'append (mapcar (lambda (tag)
272 (mapcar #'dom-text
273 (dom-by-tag dom tag)))
274 '(title h1 h2 h3 h4 h5 h6)))))))
275
276(defun +org-insert-link-dwim (&optional interactivep)
277 "Like `org-insert-link' but with personal dwim preferences."
278 (interactive '(t))
279 (let* ((point-in-link (org-in-regexp org-link-any-re 1))
280 (clipboard-url (when (string-match-p
281 (rx (sequence bos
282 (or "http"
283 "gemini"
284 "gopher"
285 "tel"
286 "mailto")))
287 (current-kill 0))
288 (current-kill 0)))
289 (region-content (when (region-active-p)
290 (buffer-substring-no-properties (region-beginning)
291 (region-end))))
292 (org-link (when (and clipboard-url (not point-in-link))
293 (org-link-make-string
294 (string-trim clipboard-url)
295 (or region-content
296 (let ((clipboard-headings
297 (+org-insert--get-title-and-headings clipboard-url)))
298 (read-string "title (edit): "
299 (completing-read
300 "title: " clipboard-headings
301 nil nil nil nil (car clipboard-headings)))))))))
302 (if interactivep
303 (cond ((and region-content clipboard-url (not point-in-link))
304 (delete-region (region-beginning) (region-end))
305 (insert org-link))
306 ((and clipboard-url (not point-in-link))
307 (insert org-link))
308 (t
309 (call-interactively 'org-insert-link)))
310 org-link)))
311
312;;; Navigate headings with widening
313
314(defun +org-next-heading-widen (arg)
315 "Find the ARGth next org heading, widening if necessary."
316 (interactive "p")
317 (let ((current-point (point))
318 (point-target (if (> arg 0) (point-max) (point-min))))
319 (org-next-visible-heading arg)
320 (when (and (buffer-narrowed-p)
321 (= (point) point-target)
322 (or (and (> arg 0))
323 (and (< arg 0)
324 (= (point) current-point))))
325 (widen)
326 (org-next-visible-heading arg))))
327
328(defun +org-previous-heading-widen (arg)
329 "Find the ARGth previous org heading, widening if necessary."
330 (interactive "p")
331 (+org-next-heading-widen (- arg)))
332
333;;; Hooks & Advice
334
335(defvar +org-before-save-prettify-buffer t
336 "Prettify org buffers before saving.")
337
338(put '+org-before-save-prettify-buffer 'safe-local-variable #'booleanp)
339
340(defun +org-before-save@prettify-buffer ()
341 (when +org-before-save-prettify-buffer
342 (save-mark-and-excursion
343 (+org-unsmartify)
344 (+org-fix-blank-lines t)
345 (org-align-tags t)
346 (org-hide-drawer-all)
347 (when (buffer-narrowed-p)
348 (goto-char (point-min))
349 (forward-line 1)
350 (org-narrow-to-subtree)))))
351
352(defun +org-delete-backward-char (N)
353 "Keep tables aligned while deleting N characters backward.
354When deleting backwards, in tables this function will insert
355whitespace in front of the next \"|\" separator, to keep the
356table aligned. The table will still be marked for re-alignment
357if the field did fill the entire column, because, in this case
358the deletion might narrow the column."
359 (interactive "p")
360 (save-match-data
361 (org-check-before-invisible-edit 'delete-backward)
362 (if (and (= N 1)
363 (not overwrite-mode)
364 (not (org-region-active-p))
365 (not (eq (char-before) ?|))
366 (save-excursion (skip-chars-backward " \t") (not (bolp)))
367 (looking-at-p ".*?|")
368 (org-at-table-p))
369 (progn (forward-char -1) (org-delete-char 1))
370 (backward-delete-char-untabify N)
371 (org-fix-tags-on-the-fly))))
372
373;;; Smarter {super,sub}scripts
374;; https://old.reddit.com/r/emacs/comments/qzlzm0/what_are_your_top_key_bindings_rebindings_minor/hmwyhm3/
375;; I don't use this currently because I found out about
376;; `org-pretty-entities-include-sub-superscripts', which really does exactly
377;; what I wanted.
378
379(defface +org-script-markers '((t (:inherit shadow)))
380 "Face to be used for sub/superscripts markers i.e., ^, _, {, }.")
381
382;; Hiding the super and subscript markers is extremely annoying
383;; since any remotely complex equation becomes a chore. And leaving
384;; it not raised is jarring to the eye. So this fontifies the
385;; buffer just like how auctex does -- use a muted colour to
386;; highlight the markup and raise the script.
387(defun +org-raise-scripts (limit)
388 "Differences from `org-raise-scripts' are:
389
390- It doesn't actually hide the markup used for super and subscript.
391- It uses a custom face to highlight the markup: +org-script-markers.
392- It doesn't require `org-pretty-entities' to be t."
393 (when (and org-pretty-entities-include-sub-superscripts
394 (re-search-forward
395 (if (eq org-use-sub-superscripts t)
396 org-match-substring-regexp
397 org-match-substring-with-braces-regexp)
398 limit t))
399 (let* ((pos (point)) table-p comment-p
400 (mpos (match-beginning 3))
401 (emph-p (get-text-property mpos 'org-emphasis))
402 (link-p (get-text-property mpos 'mouse-face))
403 (keyw-p (eq 'org-special-keyword (get-text-property mpos 'face))))
404 (goto-char (point-at-bol))
405 (setq table-p (looking-at-p org-table-dataline-regexp)
406 comment-p (looking-at-p "^[ \t]*#[ +]"))
407 (goto-char pos)
408 ;; Handle a_b^c
409 (when (member (char-after) '(?_ ?^)) (goto-char (1- pos)))
410 (unless (or comment-p emph-p link-p keyw-p)
411 (put-text-property (match-beginning 3) (match-end 0)
412 'display
413 (if (equal (char-after (match-beginning 2)) ?^)
414 ;; (nth (if table-p 3 1) org-script-display)
415 (nth 3 org-script-display)
416 ;; (nth (if table-p 2 0) org-script-display)
417 (nth 2 org-script-display)))
418 (put-text-property (match-beginning 2) (match-end 2)
419 'face '+org-script-markers)
420 (when (and (eq (char-after (match-beginning 3)) ?{)
421 (eq (char-before (match-end 3)) ?}))
422 (put-text-property (match-beginning 3) (1+ (match-beginning 3))
423 'face '+org-script-markers)
424 (put-text-property (1- (match-end 3)) (match-end 3)
425 'face '+org-script-markers)))
426 t)))
427
428;; Extra link types
429
430(defun +org-tel-open (number _)
431 "Notify the user of what phone NUMBER to call."
432 (message "Call: %s" number))
433
434(defun +org-sms-open (number _)
435 "Notify the user of what phone NUMBER to text."
436 (message "SMS: %s" number))
437
438;; Make a horizontal rule!
439
440(defun +org-horizontal-rule ()
441 "Make a horizontal rule after the current line."
442 (interactive nil org-mode)
443 (unless (eq (line-beginning-position) (line-end-position))
444 (end-of-line)
445 (newline))
446 (dotimes (_ fill-column)
447 (insert "-")))
448
449;; Follow links, DWIM style
450
451(defun +org-open-at-point-dwim (&optional arg)
452 "Open thing at point, or if there isn't something, list things."
453 (interactive "P")
454 (save-excursion
455 (let* ((this-char-type (org-element-type (org-element-context)))
456 (prev-char-type (ignore-errors
457 (save-excursion
458 (backward-char)
459 (org-element-type (org-element-context)))))
460 (types '(citation citation-reference clock comment comment-block
461 footnote-definition footnote-reference headline
462 inline-src-block inlinetask keyword link
463 node-property planning src-block timestamp))
464 (type this-char-type))
465 (when (and (memq this-char-type types) (memq prev-char-type types))
466 (backward-char)
467 (setq type prev-char-type)) ; what the fuckckckckck
468 ;; Okay, so this ^ is pretty janky and doesn't /really/ work that well,
469 ;; especially on DEADLINE (and probably SCHEDULED) lines. However, since
470 ;; I really just want to open the list of URLs /most of the time/, I'm
471 ;; fixing it like this instead.
472 (unless (and (memq type types)
473 (ignore-errors (org-open-at-point arg)
474 t))
475 (while (not
476 (progn
477 (org-back-to-heading)
478 (car (org-offer-links-in-entry (current-buffer) (point) 1))))
479 (org-up-heading-all 1))
480 (org-open-at-point arg)))))
481
482;;; Open local HTML files with `browse-url'
483
484(defun +org-open-html (file-path link-string)
485 "Open FILE-PATH with `browse-url'.
486This function is intended to use with `org-file-apps'. See the
487 documentation of that function for a description of the two
488 arguments here, FILE-PATH and LINK-STRING."
489 (message "Opening %s (%s)..." file-path link-string)
490 (browse-url file-path))
491
492(defun +org-insert-horizontal-rule (prefix)
493 "Insert a horizontal rule (-----) after the current line.
494With PREFIX, insert before the current line."
495 (interactive "P")
496 (if prefix
497 (move-beginning-of-line nil)
498 (move-end-of-line nil)
499 (forward-line 1))
500 (insert "-----\n"))
501
502;;; Make code snippets in org-mode easier to type
503;; http://mbork.pl/2022-01-17_Making_code_snippets_in_Org-mode_easier_to_type
504
505(defun +org-insert-backtick ()
506 "Insert a backtick using `org-self-insert-command'."
507 (interactive)
508 (setq last-command-event ?`)
509 (call-interactively #'org-self-insert-command))
510
511(defvar-local +org-insert-tilde-language nil
512 "Default language name in the current Org file.
513If nil, `org-insert-tilde' after 2 tildes inserts an \"example\"
514block. If a string, it inserts a \"src\" block with the given
515language name.")
516
517(defun +org-insert-tilde ()
518 "Insert a tilde using `org-self-insert-command'."
519 (interactive)
520 (if (string= (buffer-substring-no-properties (- (point) 3) (point))
521 "\n~~")
522 (progn (delete-char -2)
523 (if +org-insert-tilde-language
524 (insert (format "#+begin_src %s\n#+end_src"
525 +org-insert-tilde-language))
526 (insert "#+begin_example\n#+end_example"))
527 (forward-line -1)
528 (if (string= +org-insert-tilde-language "")
529 (move-end-of-line nil)
530 ;;(org-edit-special) ; Useful really only with splits.
531 ))
532 (setq last-command-event ?~)
533 (call-interactively #'org-self-insert-command)))
534
535;;; Better org faces
536;; see `org-emphasis-alist'
537
538(defface org-bold '((t (:weight bold)))
539 "Bold face in `org-mode' documents.")
540
541(defface org-italic '((t (:slant italic)))
542 "Italic face in `org-mode' documents.")
543
544(defface org-underline '((t (:underline t)))
545 "Underline face in `org-mode' documents.")
546
547(defface org-strikethrough '((t (:strike-through t)))
548 "Strike-through face for `org-mode' documents.")
549
550;; `org-verbatim' and `org-code' are apparently already things, so we skip them
551;; here.
552
553;;; Copy org trees as HTML
554
555;; Thanks to Oleh Krehel, via [[https://emacs.stackexchange.com/questions/54292/copy-results-of-org-export-directly-to-clipboard][this StackExchange question]].
556(defun +org-export-clip-to-html
557 (&optional async subtreep visible-only body-only ext-plist post-process)
558 "Export region to HTML, and copy it to the clipboard.
559Arguments ASYNC, SUBTREEP, VISIBLE-ONLY, BODY-ONLY, EXT-PLIST,
560and POST-PROCESS are passed to `org-export-to-file'."
561 (interactive) ; XXX: hould this be interactive?
562 (message "Exporting Org to HTML...")
563 (let ((org-tmp-file "/tmp/org.html"))
564 (org-export-to-file 'html org-tmp-file
565 async subtreep visible-only body-only ext-plist post-process)
566 (start-process "xclip" "*xclip*"
567 "xclip" "-verbose"
568 "-i" org-tmp-file
569 "-t" "text/html"
570 "-selection" "clipboard"))
571 (message "Exporting Org to HTML...done."))
572
573;; Specialized functions
574(defun +org-export-clip-subtree-to-html ()
575 "Export current subtree to HTML."
576 (interactive)
577 (+org-export-clip-to-html nil :subtree))
578
579;;; Unsmartify quotes and dashes and stuff.
580(defun +org-unsmartify ()
581 "Replace \"smart\" punctuation with their \"dumb\" counterparts."
582 (interactive)
583 (save-excursion
584 (goto-char (point-min))
585 (while (re-search-forward "[“”‘’–—]" nil t)
586 (let ((replace (pcase (match-string 0)
587 ((or "“" "”") "\"")
588 ((or "‘" "’") "'")
589 ("–" "--")
590 ("—" "---"))))
591 (replace-match replace nil nil)))))
592
593;;; go forward and backward in the tree, ~ cleanly ~
594;; https://stackoverflow.com/a/25201697/10756297
595
596(defun +org-show-next-heading-tidily ()
597 "Show next entry, keeping other entries closed."
598 (interactive)
599 (if (save-excursion (end-of-line) (outline-invisible-p))
600 (progn (org-show-entry) (show-children))
601 (outline-next-heading)
602 (unless (and (bolp) (org-on-heading-p))
603 (org-up-heading-safe)
604 (hide-subtree)
605 (user-error "Boundary reached"))
606 (org-overview)
607 (org-reveal t)
608 (org-show-entry)
609 (recenter-top-bottom)
610 (show-children)
611 (recenter-top-bottom 1)))
612
613(defun +org-show-previous-heading-tidily ()
614 "Show previous entry, keeping other entries closed."
615 (interactive)
616 (let ((pos (point)))
617 (outline-previous-heading)
618 (unless (and (< (point) pos) (bolp) (org-on-heading-p))
619 (goto-char pos)
620 (hide-subtree)
621 (user-error "Boundary reached"))
622 (org-overview)
623 (org-reveal t)
624 (org-show-entry)
625 (recenter-top-bottom)
626 (show-children)
627 (recenter-top-bottom 1)))
628
629;;; Make `org-flag-region' (which folds subtrees) recognize
630;; [[https://teddit.net/r/orgmode/comments/u3du0v/how_to_make_orgcycle_respect_and_always_show_the/][from u/yantar92]]
631
632;; (advice-add 'org-flag-region :around #'org-flag-region@unfold-page-breaks)
633(defun org-flag-region@unfold-page-breaks (oldfun from to flag &optional spec)
634 "ADVICE to unfold all the page-break lines inside a folded region."
635 (funcall oldfun from to flag spec)
636 (when (and flag (not (eq 'visible spec)))
637 (org-with-point-at from
638 (while (re-search-forward "\n\u000c\n" to t)
639 (org-flag-region (match-beginning 0) (match-end 0) t 'visible)))))
640
641;;; Emacs 28+: wrap on hyphens
642;; https://emacs.stackexchange.com/a/71342/37239
643
644(defcustom +org-category-table (let ((table (copy-category-table)))
645 (modify-category-entry ?- ?| table)
646 table)
647 "Character category table for `org-mode'."
648 :type 'sexp)
649
650(defun +org-wrap-on-hyphens ()
651 "Soft-wrap `org-mode' buffers on spaces and hyphens."
652 (set-category-table +org-category-table)
653 (setq-local word-wrap-by-category t))
654
655
656;;; Inhibit hooks on `org-agenda'
657;; It's really annoying when I call `org-agenda' and five hundred Ispell
658;; processes are created because I have `flyspell-mode' in the hook. This mode
659;; inhibits those hooks when entering the agenda, but runs them when opening the
660;; actual buffer.
661
662(defun +org-agenda-inhibit-hooks (fn &rest r)
663 "Advice to inhibit hooks when entering `org-agenda'."
664 (dlet ((org-mode-hook nil)) ; I'm not sure if `dlet' is strictly needed
665 (apply fn r)))
666
667(defvar-local +org-hook-has-run-p nil
668 "Whether `org-mode-hook' has run in the current buffer.")
669
670(defun +org-agenda-switch-run-hooks (&rest _)
671 "Advice to run `org-mode-hook' when entering org-mode.
672This should only fire when switching to a buffer from `org-agenda'."
673 (unless +org-hook-has-run-p
674 (run-mode-hooks 'org-mode-hook)
675 (setq +org-hook-has-run-p t)))
676
677(define-minor-mode +org-agenda-inhibit-hooks-mode
678 "Inhibit `org-mode-hook' when opening `org-agenda'."
679 :lighter ""
680 :global t
681 (if +org-agenda-inhibit-hooks-mode
682 (progn ; Enable
683 (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks)
684 (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks))
685 (progn ; Disable
686 (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks)
687 (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks))))
688
689
690;;; "Fix" `org-align-tags'
691
692(el-patch-defun org-align-tags (&optional all)
693 "Align tags in current entry.
694When optional argument ALL is non-nil, align all tags in the
695visible part of the buffer."
696 (let ((get-indent-column
697 (lambda ()
698 (let ((offset (el-patch-swap
699 (if (bound-and-true-p org-indent-mode)
700 (* (1- org-indent-indentation-per-level)
701 (1- (org-current-level)))
702 0)
703 0)))
704 (+ org-tags-column
705 (if (> org-tags-column 0) (- offset) offset))))))
706 (if (and (not all) (org-at-heading-p))
707 (org--align-tags-here (funcall get-indent-column))
708 (save-excursion
709 (if all
710 (progn
711 (goto-char (point-min))
712 (while (re-search-forward org-tag-line-re nil t)
713 (org--align-tags-here (funcall get-indent-column))))
714 (org-back-to-heading t)
715 (org--align-tags-here (funcall get-indent-column)))))))
716
717;;; Meta-return
718
719(defun +org-meta-return (&optional arg)
720 "Insert a new line, or wrap a region in a table.
721See `org-meta-return', but `+org-return-dwim' does most of the
722stuff I would want out of that function already.
723
724When called with a prefix ARG, will still unconditionally call
725`org-insert-heading'."
726 (interactive "P")
727 (org-fold-check-before-invisible-edit 'insert)
728 (or (run-hook-with-args-until-success 'org-metareturn-hook) ; Allow customizations
729 (call-interactively (cond (arg #'org-insert-heading)
730 ((org-at-table-p) #'org-table-wrap-region)
731 (t #'org-return)))))
732
733
734;;; move org archives to a dedicated file
735;; (defun +org-archive-monthwise (archive-file)
736;; (if (file-exists-p archive-file)
737;; (with-current-buffer (find-file-noselect archive-file)
738;; (let ((dir (file-name-directory (file-truename archive-file)))
739;; (prog (make-progress-reporter (format "Archiving from %s..." archive-file)))
740;; (keep-going t))
741;; (goto-char (point-min))
742;; (while keep-going
743;; (when-let* ((time (or (org-entry-get (point) "ARCHIVE_TIME")
744;; (org-get-deadline-time (point))))
745;; (parsed-time (and time
746;; (org-parse-time-string time)))
747;; (refile-target (format "%s%02d-%02d.org"
748;; dir
749;; (decoded-time-year parsed-time)
750;; (decoded-time-month parsed-time)))
751;; (title-str (format "#+title: Archive for %02d-%02d (%s)\n\n"
752;; (decoded-time-year parsed-time)
753;; (decoded-time-month parsed-time)
754;; (file-truename archive-file))))
755;; (unless (file-exists-p refile-target)
756;; (with-current-buffer (find-file-noselect refile-target)
757;; (insert title-str)
758;; (save-buffer)))
759;; (org-refile nil nil (list ""
760;; refile-target
761;; nil
762;; 0)))
763;; (progress-reporter-update prog)
764;; (org-next-visible-heading 1)
765;; (when (>= (point) (point-max))
766;; (setq keep-going nil)))))
767;; (message "Archive file %s does not exist!" archive-file)))
768
769
770;;; +org-toggle-view-emphasis
771;; I thought this function was already written somewhere...
772(defun +org-toggle-view-emphasis ()
773 "Toggle `org-hide-emphasis-markers' and redraw the buffer."
774 (interactive)
775 (setq-local org-hide-emphasis-markers (not org-hide-emphasis-markers))
776 (font-lock-update))
777
778
779;;; el-patch
780
781(el-patch-defun org-format-outline-path (path &optional width prefix separator)
782 "Format the outline path PATH for display.
783WIDTH is the maximum number of characters that is available.
784PREFIX is a prefix to be included in the returned string,
785such as the file name.
786SEPARATOR is inserted between the different parts of the path,
787the default is \"/\"."
788 (setq width (or width 79))
789 (setq path (delq nil path))
790 (unless (> width 0)
791 (user-error "Argument `width' must be positive"))
792 (setq separator (or separator "/"))
793 (let* ((org-odd-levels-only nil)
794 (fpath (concat
795 prefix (and prefix path separator)
796 (mapconcat
797 (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
798 (cl-loop for head in path
799 for n from 0
800 collect (el-patch-swap
801 (org-add-props
802 head nil 'face
803 (nth (% n org-n-level-faces) org-level-faces))
804 head))
805 separator))))
806 (when (> (length fpath) width)
807 (if (< width 7)
808 ;; It's unlikely that `width' will be this small, but don't
809 ;; waste characters by adding ".." if it is.
810 (setq fpath (substring fpath 0 width))
811 (setf (substring fpath (- width 2)) "..")))
812 fpath))
813
814
815(provide '+org)
816;;; +org.el ends here
diff --git a/lisp/+ox.el b/lisp/+ox.el deleted file mode 100644 index 8748a55..0000000 --- a/lisp/+ox.el +++ /dev/null
@@ -1,29 +0,0 @@
1;;; +ox.el --- org-export helpers -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'ox)
8
9;;; Run hooks before doing any exporting at all
10
11(defcustom +org-export-pre-hook nil
12 "Functions to run /before/ `org-export-as' does anything.
13These will run on the buffer about to be exported, NOT a copy."
14 :type 'hook)
15
16(defun +org-export-pre-run-hooks (&rest _)
17 "Run hooks in `+org-export-pre-hook'."
18 (run-hooks '+org-export-pre-hook))
19
20(defun +org-export-pre-hooks-insinuate ()
21 "Advise `org-export-as' to run `+org-export-pre-hook'."
22 (advice-add 'org-export-as :before #'+org-export-pre-run-hooks))
23
24(defun +org-export-pre-hooks-remove ()
25 "Remove pre-hook advice on `org-export-as'."
26 (advice-remove 'org-export-as #'+org-export-pre-run-hooks))
27
28(provide '+ox)
29;;; +ox.el ends here
diff --git a/lisp/+paredit.el b/lisp/+paredit.el deleted file mode 100644 index 0c65328..0000000 --- a/lisp/+paredit.el +++ /dev/null
@@ -1,26 +0,0 @@
1;;; +paredit.el --- bespoke paredit stuffs -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require '+emacs) ; `+backward-kill-word-wrapper'
8
9(defun +paredit--backward-kill-word (&optional n)
10 "Perform `paredit-backward-kill-word' N times."
11 (interactive "p")
12 (dotimes (_ (or n 1))
13 (paredit-backward-kill-word)))
14
15(defun +paredit-backward-kill-word (&optional arg)
16 "Kill a word backward using `paredit-backward-kill-word'.
17Wrapped in `+backward-kill-word-wrapper', which see.
18
19Prefix ARG means to just call `paredit-backward-kill-word'."
20 ;; Of course, `paredit-backward-kill-word' doesn't TAKE an argument ... :///
21 ;; So I had to write the wrapper above.
22 (interactive)
23 (+backward-kill-word-wrapper #'+paredit--backward-kill-word arg))
24
25(provide '+paredit)
26;;; +paredit.el ends here
diff --git a/lisp/+pdf-tools.el b/lisp/+pdf-tools.el deleted file mode 100644 index 9b15b27..0000000 --- a/lisp/+pdf-tools.el +++ /dev/null
@@ -1,38 +0,0 @@
1;;; +pdf-tools.el --- Extras for the excellent pdf-tools' -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;; XXX: The way I'm dispatching browsers here is /very/ down-and-dirty. It
8;; needs to be much improved.
9
10(defun +pdf-view-open-all-pagelinks (&optional browse-url-func)
11 "Open all the links on this page of a PDF.
12BROWSE-URL-FUNC overrides the default `browse-url'."
13 (interactive)
14 (let ((links (pdf-info-pagelinks (pdf-view-current-page)))
15 (browse-url-func (or browse-url-func #'browse-url))
16 (seen))
17 (dolist (link links)
18 (when-let* ((uri (alist-get 'uri link))
19 (_ (not (member uri seen))))
20 (push uri seen)
21 (funcall browse-url-func uri)))))
22
23(defun +pdf-view-open-links-in-chrome ()
24 "Open all links on this PDF page in Chrome.
25See also `+pdf-view-open-all-pagelinks'."
26 (interactive)
27 (+pdf-view-open-all-pagelinks #'browse-url-chrome))
28
29(defun +pdf-view-position (&optional spacer)
30 "Return the page we're on for the modeline."
31 (when (derived-mode-p 'pdf-view-mode)
32 (format "%sp.%s/%s"
33 (or spacer (bound-and-true-p +modeline-default-spacer) " ")
34 (pdf-view-current-page)
35 (pdf-info-number-of-pages))))
36
37(provide '+pdf-tools)
38;;; +pdf-tools.el ends here
diff --git a/lisp/+pulse.el b/lisp/+pulse.el deleted file mode 100644 index eefdd83..0000000 --- a/lisp/+pulse.el +++ /dev/null
@@ -1,52 +0,0 @@
1;;; +pulse.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'pulse)
6
7(defgroup +pulse nil
8 "Extra customizations for `pulse'."
9 :group 'pulse
10 :prefix "+pulse-")
11
12(defcustom +pulse-location-commands '(scroll-up-command
13 scroll-down-command
14 recenter-top-bottom
15 other-window
16 switch-to-buffer
17 redraw-frame)
18 "Commands to pulse the current line after.
19Good for finding location."
20 :type '(repeat function))
21
22(defcustom +pulse-location-function '+pulse-line-current-window
23 "What function to call after `+pulse-location-commands'."
24 :type 'function)
25
26;; XXX: this doesn't work yet. I only want to pulse the line in the
27;; active window, so when I have the same buffer viewed in multiple
28;; windows I can still see where my cursor is. To see the issue, C-x
29;; 2 then C-x o a few times.
30(defun +pulse-line-current-window (&rest _)
31 "Pulse the current line, but only if this window is active."
32 (pulse-momentary-highlight-one-line
33 (window-point (selected-window))))
34
35(defun +pulse--advice-remove (symbol where function &optional props)
36 "Remove advice SYMBOL from FUNCTION.
37This uses the same args as `advice-add' for easy toggling.
38WHERE and PROPS are discarded."
39 (ignore where props)
40 (advice-remove symbol function))
41
42(define-minor-mode +pulse-location-mode
43 "After moving locations, pulse where we are."
44 :global t
45 :keymap nil
46 (dolist (command +pulse-location-commands)
47 (funcall
48 (if +pulse-location-mode 'advice-add '+pulse--advice-remove)
49 command :after +pulse-location-function)))
50
51(provide '+pulse)
52;;; +pulse.el ends here
diff --git a/lisp/+scratch.el b/lisp/+scratch.el deleted file mode 100644 index 7fc2bde..0000000 --- a/lisp/+scratch.el +++ /dev/null
@@ -1,77 +0,0 @@
1;;; +scratch.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5;;(require 'scratch)
6
7(defun +scratch-immortal ()
8 "Bury, don't kill \"*scratch*\" buffer.
9For `kill-buffer-query-functions'."
10 (if (or (eq (current-buffer) (get-buffer "*scratch*"))
11 (eq (current-buffer) (get-buffer "*text*")))
12 (progn (bury-buffer)
13 nil)
14 t))
15
16(defun +scratch-buffer-setup ()
17 "Add comment to `scratch' buffer and name it accordingly."
18 (let* ((mode (format "%s" major-mode))
19 (string (concat "Scratch buffer for:" mode "\n\n")))
20 (when scratch-buffer
21 (save-excursion
22 (insert string)
23 (goto-char (point-min))
24 (comment-region (point-at-bol) (point-at-eol)))
25 (next-line 2))
26 (rename-buffer (concat "*scratch<" mode ">*") t)))
27
28(defun +scratch-fortune ()
29 (let* ((fmt (if (executable-find "fmt")
30 (format "| fmt -%d -s" (- fill-column 2))
31 ""))
32 (s (string-trim
33 (if (executable-find "fortune")
34 (shell-command-to-string (concat "fortune -s" fmt))
35 "ABANDON ALL HOPE YE WHO ENTER HERE"))))
36 (concat (replace-regexp-in-string "^" ";; " s)
37 "\n\n")))
38
39;; [[https://old.reddit.com/r/emacs/comments/ui1q41/weekly_tips_tricks_c_thread/i7ef4xg/][u/bhrgunatha]]
40(defun +scratch-text-scratch ()
41 "Create a \"*text*\" scratch buffer in Text mode."
42 (with-current-buffer (get-buffer-create "*text*")
43 (text-mode)))
44
45(defcustom +scratch-buffers '("*text*" "*scratch*")
46 "Scratch buffers.")
47
48(defvar +scratch-last-non-scratch-buffer nil
49 "Last buffer that wasn't a scratch buffer.")
50
51(defun +scratch-toggle (buffer)
52 "Switch to BUFFER, or to the previous (non-scratch) buffer."
53 (if (or (null +scratch-last-non-scratch-buffer)
54 (not (member (buffer-name (current-buffer)) +scratch-buffers)))
55 ;; Switch to a scratch buffer
56 (progn
57 (setq +scratch-last-non-scratch-buffer (current-buffer))
58 (switch-to-buffer buffer))
59 ;; Switch away from scratch buffer ...
60 (if (equal (get-buffer-create buffer) (current-buffer))
61 ;; to the original buffer
62 (switch-to-buffer +scratch-last-non-scratch-buffer)
63 ;; to another scratch
64 (switch-to-buffer buffer))))
65
66(defun +scratch-switch-to-scratch ()
67 "Switch to scratch buffer."
68 (interactive)
69 (+scratch-toggle "*scratch*"))
70
71(defun +scratch-switch-to-text ()
72 "Switch to text buffer."
73 (interactive)
74 (+scratch-toggle "*text*"))
75
76(provide '+scratch)
77;;; +scratch.el ends here
diff --git a/lisp/+setup.el b/lisp/+setup.el deleted file mode 100644 index a08526a..0000000 --- a/lisp/+setup.el +++ /dev/null
@@ -1,216 +0,0 @@
1;;; +setup.el -- my `setup' commands -*- lexical-binding: t -*-
2
3;; Author: Case Duckworth <acdw@acdw.net>
4
5;; This file is NOT part of GNU Emacs.
6
7;;; License:
8;; Everyone is permitted to do whatever with this software, without
9;; limitation. This software comes without any warranty whatsoever,
10;; but with two pieces of advice:
11;; - Don't hurt yourself.
12;; - Make good choices.
13
14;;; Commentary:
15
16;; `setup', by Philip Kaludercic, is a wonderful package that works
17;; sort of like `use-package', but to my mind it's cleaner and easier
18;; to extend. These are my additions to the local macros provided by
19;; the package.
20
21;;; Code:
22
23(require 'el-patch)
24(require 'setup)
25(require 'straight)
26(require 'cl-lib)
27
28(defun +setup-warn (message &rest args)
29 "Warn the user that something bad happened in `setup'."
30 (display-warning 'setup (format message args)))
31
32(defun +setup-wrap-to-demote-errors (body name)
33 "Wrap BODY in a `with-demoted-errors' block.
34This behavior is prevented if `setup-attributes' contains the
35symbol `without-error-demotion'.
36
37This function differs from `setup-wrap-to-demote-errors' in that
38it includes the NAME of the setup form in the warning output."
39 (if (memq 'without-error-demotion setup-attributes)
40 body
41 `(with-demoted-errors ,(format "Error in setup form on line %d (%s): %%S"
42 (line-number-at-pos)
43 name)
44 ,body)))
45
46
47;;; New forms
48
49(setup-define :quit
50 'setup-quit
51 :documentation "Quit the current `setup' form.
52Good for commenting.")
53
54(setup-define :face
55 (lambda (face spec)
56 `(custom-set-faces (list ,face ,spec 'now "Customized by `setup'.")))
57 :documentation "Customize FACE with SPEC using `custom-set-faces'."
58 :repeatable t)
59
60(setup-define :load-after
61 (lambda (&rest features)
62 (let ((body `(require ',(setup-get 'feature))))
63 (dolist (feature (nreverse features))
64 (setq body `(with-eval-after-load ',feature ,body)))
65 body))
66 :documentation "Load the current feature after FEATURES.")
67
68(setup-define :load-from
69 (lambda (path)
70 `(let ((path* (expand-file-name ,path)))
71 (if (file-exists-p path*)
72 (add-to-list 'load-path path*)
73 ,(setup-quit))))
74 :documentation "Add PATH to load path.
75This macro can be used as NAME, and it will replace itself with
76the nondirectory part of PATH.
77If PATH does not exist, abort the evaluation."
78 :shorthand (lambda (args)
79 (intern
80 (file-name-nondirectory
81 (directory-file-name (cadr args))))))
82
83(setup-define :needs
84 (lambda (executable)
85 `(unless (executable-find ,executable)
86 ,(setup-quit)))
87 :documentation "If EXECUTABLE is not in the path, stop here."
88 :repeatable 1)
89
90
91;;; Package integrations
92
93;;; Straight.el
94
95(defun setup--straight-handle-arg (arg var)
96 (cond
97 ((and (boundp var) (symbol-value var)) t)
98 ((keywordp arg) (set var t))
99 ((functionp arg) (set var nil) (funcall arg))
100 ((listp arg) (set var nil) arg)))
101
102(with-eval-after-load 'straight
103 (setup-define :straight
104 (lambda (recipe &rest predicates)
105 (let* ((skp (make-symbol "straight-keyword-p"))
106 (straight-use-p
107 (cl-mapcar
108 (lambda (f) (setup--straight-handle-arg f skp))
109 predicates))
110 (form `(unless (and ,@straight-use-p
111 (condition-case e
112 (straight-use-package ',recipe)
113 (error
114 (+setup-warn ":straight error: %S"
115 ',recipe)
116 ,(setup-quit))
117 (:success t)))
118 ,(setup-quit))))
119 ;; Keyword arguments --- :quit is special and should short-circuit
120 (if (memq :quit predicates)
121 (setq form `,(setup-quit))
122 ;; Otherwise, handle the rest of them ...
123 (when-let ((after (cadr (memq :after predicates))))
124 (setq form `(with-eval-after-load ,(if (eq after t)
125 (setup-get 'feature)
126 after)
127 ,form))))
128 ;; Finally ...
129 form))
130 :documentation "Install RECIPE with `straight-use-package'.
131If PREDICATES are given, only install RECIPE if all of them return non-nil.
132The following keyword arguments are also recognized:
133- :quit --- immediately stop evaluating. Good for commenting.
134- :after FEATURE --- only install RECIPE after FEATURE is loaded.
135 If FEATURE is t, install RECIPE after the current feature."
136 :repeatable nil
137 :indent 1
138 :shorthand (lambda (sexp)
139 (let ((recipe (cadr sexp)))
140 (or (car-safe recipe) recipe)))))
141
142;;; Apheleia
143
144(setup-define :apheleia
145 (lambda (name formatter &optional mode -pend)
146 (let* ((mode (or mode (setup-get 'mode)))
147 (current-formatters (and -pend
148 (alist-get mode apheleia-formatters))))
149 `(with-eval-after-load 'apheleia
150 (setf (alist-get ',name apheleia-formatters)
151 ,formatter)
152 (setf (alist-get ',mode apheleia-mode-alist)
153 ',(pcase -pend
154 (:append (append (ensure-list current-formatters)
155 (list name)))
156 (:prepend (cons name (ensure-list current-formatters)))
157 ('nil name)
158 (_ (error "Improper `:apheleia' -PEND argument")))))))
159 :documentation
160 "Register a formatter to `apheleia''s lists.
161NAME is the name given to the formatter in `apheleia-formatters'
162and `apheleia-mode-alist'. FORMATTER is the command paired with
163NAME in `apheleia-formatters'. MODE is the mode or modes to add
164NAME to in `apheleia-mode-alist'. If MODE is not given or nil,
165use the setup form's MODE. Optional argument -PEND can be one of
166`:append' or `:prepend', and if given will append or prepend the
167given NAME to the current formatters for the MODE in
168`apheleia-mode-alist', rather than replace them (the default).
169
170Example:
171(setup
172 (:apheleia isort (\"isort\" \"--stdout\" \"-\")
173 python-mode))
174; =>
175(progn
176 (setf (alist-get 'isort apheleia-formatters)
177 '(\"isort\" \"--stdout\" \"-\"))
178 (setf (alist-get 'python-mode apheleia-mode-alist)
179 'isort))
180
181This form cannot be repeated, and it cannot be used as HEAD.")
182
183
184;;; Redefines of `setup' forms
185
186(setup-define :bind-into
187 (lambda (feature-or-map &rest rest)
188 (cl-loop for f/m in (ensure-list feature-or-map)
189 collect (if (string-match-p "-map\\'" (symbol-name f/m))
190 `(:with-map ,f/m (:bind ,@rest))
191 `(:with-feature ,f/m (:bind ,@rest)))
192 into forms
193 finally return `(progn ,@forms)))
194 :documentation "Bind into keys into the map(s) of FEATURE-OR-MAP.
195FEATURE-OR-MAP can be a feature or map name or a list of them.
196The arguments REST are handled as by `:bind'."
197 :debug '(sexp &rest form sexp)
198 :indent 1)
199
200(setup-define :require
201 (lambda (&rest features)
202 (require 'cl-lib)
203 (if features
204 `(progn ,@(cl-loop for feature in features collect
205 `(unless (require ',feature nil t)
206 ,(setup-quit))))
207 `(unless (require ',(setup-get 'feature) nil t)
208 ,(setup-quit))))
209 :documentation "Try to require FEATURE, or stop evaluating body.
210This macro can be used as NAME, and it will replace itself with
211the first FEATURE."
212 :repeatable nil
213 :shorthand #'cadr)
214
215(provide '+setup)
216;;; +setup.el ends here
diff --git a/lisp/+shr.el b/lisp/+shr.el deleted file mode 100644 index af4bf5b..0000000 --- a/lisp/+shr.el +++ /dev/null
@@ -1,51 +0,0 @@
1;;; +shr.el --- SHR extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7;;; [[https://github.com/oantolin/emacs-config/blob/master/my-lisp/shr-heading.el][shr-heading]], by oantolin
8
9(defun +shr-heading-next (&optional arg)
10 "Move forward by ARG headings (any h1-h4).
11If ARG is negative move backwards, ARG defaults to 1."
12 (interactive "p")
13 (unless arg (setq arg 1))
14 (catch 'return
15 (dotimes (_ (abs arg))
16 (when (> arg 0) (end-of-line))
17 (if-let ((match
18 (funcall (if (> arg 0)
19 #'text-property-search-forward
20 #'text-property-search-backward)
21 'face '(shr-h1 shr-h2 shr-h3 shr-h4)
22 (lambda (tags face)
23 (cl-loop for x in (if (consp face) face (list face))
24 thereis (memq x tags))))))
25 (goto-char
26 (if (> arg 0) (prop-match-beginning match) (prop-match-end match)))
27 (throw 'return nil))
28 (when (< arg 0) (beginning-of-line)))
29 (beginning-of-line)
30 (point)))
31
32(defun +shr-heading-previous (&optional arg)
33 "Move backward by ARG headings (any h1-h4).
34If ARG is negative move forwards instead, ARG defaults to 1."
35 (interactive "p")
36 (+shr-heading-next (- (or arg 1))))
37
38(defun +shr-heading--line-at-point ()
39 "Return the current line."
40 (buffer-substring (line-beginning-position) (line-end-position)))
41
42(defun +shr-heading-setup-imenu ()
43 "Setup imenu for h1-h4 headings in eww buffer.
44Add this function to appropriate major mode hooks such as
45`eww-mode-hook' or `elfeed-show-mode-hook'."
46 (setq-local
47 imenu-prev-index-position-function #'+shr-heading-previous
48 imenu-extract-index-name-function #'+shr-heading--line-at-point))
49
50(provide '+shr)
51;;; +shr.el ends here
diff --git a/lisp/+slack.el b/lisp/+slack.el deleted file mode 100644 index cdf2747..0000000 --- a/lisp/+slack.el +++ /dev/null
@@ -1,27 +0,0 @@
1;;; +slack.el --- Slack customizations and extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'slack)
8
9(defgroup +slack nil
10 "Extra slack customizations."
11 :group 'slack
12 :prefix "+slack-")
13
14(defcustom +slack-teams nil
15 "Teams to register using `slack-register-team'.
16This is a list of plists that are passed directly to
17`slack-register-team'."
18 ;;TODO: type
19 )
20
21(defun +slack-register-teams ()
22 "Register teams in `+slack-teams'."
23 (dolist (team +slack-teams)
24 (apply #'slack-register-team team)))
25
26(provide '+slack)
27;;; +slack.el ends here
diff --git a/lisp/+sly.el b/lisp/+sly.el deleted file mode 100644 index 8d8fd6a..0000000 --- a/lisp/+sly.el +++ /dev/null
@@ -1,18 +0,0 @@
1;;; +sly.el --- Sly customizations -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'sly)
8
9(defun sly-mrepl-return-at-end ()
10 (interactive)
11 (if (<= (point-max) (point))
12 (sly-mrepl-return)
13 (if (bound-and-true-p paredit-mode)
14 (paredit-newline)
15 (electric-newline-and-maybe-indent))))
16
17(provide '+sly)
18;;; +sly.el ends here
diff --git a/lisp/+straight.el b/lisp/+straight.el deleted file mode 100644 index cba6c96..0000000 --- a/lisp/+straight.el +++ /dev/null
@@ -1,42 +0,0 @@
1;;; +straight.el --- Straight.el extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(defun +straight-update-package (package &optional recursive)
8 "Update PACKAGE using straight.
9This pulls, rebuilds, and loads the updated PACKAGE."
10 (interactive (list (straight--select-package "Update package"
11 #'straight--installed-p)
12 current-prefix-arg))
13 (+with-message (format "Pulling package `%s'%s" package
14 (if recursive " and deps" ""))
15 (funcall (if recursive
16 #'straight-pull-package-and-deps
17 #'straight-pull-package)
18 package
19 :from-upstream))
20 (+with-message (format "Rebuilding package `%s'%s" package
21 (if recursive " and deps" ""))
22 (straight-rebuild-package package recursive))
23 (+with-message (format "Loading package `%s'%s" package
24 (if recursive " and deps" ""))
25 (ignore-errors (load-library (symbol-name package)))
26 (when recursive
27 (dolist (dep (straight--get-transitive-dependencies package))
28 (ignore-errors (load-library (symbol-name package)))))))
29
30(defun +straight-update-all (from-upstream)
31 "Update all installed packages using straight.
32This pulls and rebuilds all packages at once. It does not reload
33all of them, for reasons that should be obvious.
34
35With a prefix argument, it also pulls the packages FROM-UPSTREAM."
36 (interactive "P")
37 (straight-pull-recipe-repositories)
38 (straight-pull-all from-upstream)
39 (straight-rebuild-all))
40
41(provide '+straight)
42;;; +straight.el ends here
diff --git a/lisp/+tab-bar.el b/lisp/+tab-bar.el deleted file mode 100644 index 6c9debd..0000000 --- a/lisp/+tab-bar.el +++ /dev/null
@@ -1,394 +0,0 @@
1;;; +tab-bar.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Emacs 28 comes with an easy-to-use `tab-bar-format' option, but I still use
6;; Emacs 27 on my Windows machine. Thus, the code in this file.
7
8;;; Code:
9
10(require 'acdw)
11(require 'tab-bar)
12
13(defface +tab-bar-extra
14 '((t :inherit (tab-bar font-lock-comment-face)))
15 "Tab bar face for extra information, like the menu-bar and time."
16 :group 'basic-faces)
17
18
19;; Common
20
21(defun +tab-bar-space (&optional n)
22 "Display a space N characters long, or 1."
23 `((space menu-item ,(+string-repeat (or n 1) " ") ignore)))
24
25(defun +tab-bar-misc-info ()
26 "Display `mode-line-misc-info', formatted for the tab-bar."
27 `((misc-info menu-item ,(string-trim-right
28 (format-mode-line mode-line-misc-info))
29 ignore)))
30
31(defcustom +tracking-hide-when-org-clocking nil
32 "Hide the `tracking-mode' information when clocked in."
33 :type 'boolean)
34
35(defun format-mode-line-unescaping (construct)
36 "Return a mode-line construct as a string, but unescape `%'s."
37 (format-mode-line
38 (cond ((listp construct)
39 (cl-loop for item in construct
40 collect (cond ((stringp item)
41 (string-replace "%" "%%" item))
42 ((and (listp item) (eq :propertize (car item)))
43 (format-mode-line-unescaping item))
44 (t item))))
45 ((stringp construct) (string-replace "%" "%%" construct))
46 (t construct))))
47
48(defun +tab-bar-tracking-mode ()
49 "Display `tracking-mode-line-buffers' in the tab-bar."
50 ;; TODO: write something to convert a mode-line construct to a tab-bar
51 ;; construct.
52 (when (and (bound-and-true-p tracking-mode)
53 (not (and +tracking-hide-when-org-clocking
54 (bound-and-true-p org-clock-current-task))))
55 (cons (when (> (length tracking-mode-line-buffers) 0)
56 '(track-mode-line-separator menu-item " " ignore))
57 (cl-loop for i from 0 below (length tracking-mode-line-buffers)
58 as item = (nth i tracking-mode-line-buffers)
59 collect (append (list (intern (format "tracking-mode-line-%s" i))
60 'menu-item
61 (string-trim (format-mode-line-unescaping item)))
62 (if-let ((keymap (plist-get item 'keymap)))
63 (list (alist-get 'down-mouse-1 (cdadr keymap)))
64 (list #'ignore))
65 (when-let ((help (plist-get item 'help-echo)))
66 (list :help help)))))))
67
68(defun +tab-bar-timer ()
69 "Display `+timer-string' in the tab-bar."
70 (when (> (length (bound-and-true-p +timer-string)) 0)
71 `((timer-string menu-item
72 ,(concat " " +timer-string)
73 (lambda (ev)
74 (interactive "e")
75 (cond ((not +timer-timer) nil)
76 ((equal +timer-string +timer-running-string)
77 (popup-menu
78 '("Running timer"
79 ["Cancel timer" +timer-cancel t])
80 ev))
81 (t (setq +timer-string ""))))))))
82
83(defun +tab-bar-date ()
84 "Display `display-time-string' in the tab-bar."
85 (when display-time-mode
86 `((date-time-string menu-item
87 ,(substring-no-properties (concat " " (string-trim display-time-string)))
88 (lambda (ev)
89 (interactive "e")
90 (popup-menu
91 (append '("Timer")
92 (let (r)
93 (dolist (time '(3 5 10))
94 (push (vector (format "Timer for %d minutes" time)
95 `(lambda () (interactive)
96 (+timer ,time))
97 :active t)
98 r))
99 (nreverse r))
100 '(["Timer for ..." +timer t]))
101 ev))
102 :help (discord-date-string)))))
103
104(defun +tab-bar-notmuch-count ()
105 "Display a notmuch count in the tab-bar."
106 (when (and (executable-find "notmuch")
107 (featurep 'notmuch))
108 (let* ((counts (ignore-errors (notmuch-hello-query-counts notmuch-saved-searches)))
109 (next (cl-find "inbox+unread" counts :key (lambda (l) (plist-get l :name)) :test 'equal))
110 (next-count (plist-get next :count)))
111 (when (and next-count (> next-count 0))
112 `((notmuch-count menu-item
113 ,(format " |%s|" next-count)
114 ignore
115 :help ,(format "%s mails requiring attention." next-count)))))))
116
117(defun +tab-bar-org-clock ()
118 "Display `org-mode-line-string' in the tab-bar."
119 (when (and (fboundp 'org-clocking-p)
120 (org-clocking-p))
121 ;; org-mode-line-string
122 `((org-clocking menu-item
123 ,org-mode-line-string
124 (lambda (ev)
125 (interactive "e")
126 (let ((menu (make-sparse-keymap
127 (or org-clock-current-task "Org-Clock"))))
128 (map-keymap (lambda (key binding)
129 (when (consp binding)
130 (define-key-after menu (vector key)
131 (copy-sequence binding))))
132 (org-clock-menu))
133 (message "%S" ev)
134 (popup-menu menu ev)))
135 :help ,(or (replace-regexp-in-string
136 (rx "[[" (group (* (not "]")))
137 "][" (group (* (not "]")))
138 "]]")
139 "\\2"
140 org-clock-current-task)
141 "Org-Clock")))))
142
143(defcustom +tab-bar-emms-max-length 24
144 "Maximum length of `+tab-bar-emms'."
145 :type 'number)
146
147(defun +tab-bar-emms ()
148 "Display EMMS now playing information."
149 (when (and (bound-and-true-p emms-mode-line-mode)
150 emms-player-playing-p)
151 (let ((now-playing (+string-truncate (emms-mode-line-playlist-current)
152 (- +tab-bar-emms-max-length 2))))
153 `(emms-now-playing menu-item
154 ,(concat "{" now-playing "}" " ")
155 emms-pause
156 ( :help ,(emms-mode-line-playlist-current))))))
157
158(defun +tab-bar-bongo ()
159 "Display Bongo now playing information."
160 (when-let ((modep (bound-and-true-p bongo-mode-line-indicator-mode))
161 (buf (cl-some (lambda (b)
162 (with-current-buffer b
163 (when-let* ((modep (derived-mode-p 'bongo-playlist-mode))
164 (bongo-playlist-buffer b)
165 (playingp (bongo-playing-p)))
166 b)))
167 (buffer-list))))
168 `((bongo-now-playing menu-item
169 ,(concat "{"
170 (let ((bongo-field-separator ""))
171 (+string-truncate (replace-regexp-in-string
172 "\\(.*\\)\\(.*\\)\\(.*\\)"
173 "\\1: \\3"
174 (bongo-formatted-infoset))
175 ;; This isn't right
176 (- (min 50 (/ (frame-width) 3 )) 2)))
177 "}")
178 (lambda () (interactive)
179 (let ((bongo-playlist-buffer
180 ;; XXX: I'm sure this is terribly inefficient
181 (cl-some (lambda (b)
182 (with-current-buffer b
183 (when-let* ((modep (derived-mode-p
184 'bongo-playlist-mode))
185 (bongo-playlist-buffer b)
186 (playingp (bongo-playing-p)))
187 b)))
188 (buffer-list))))
189 (with-bongo-playlist-buffer
190 (bongo-pause/resume))))
191 :help ,(funcall bongo-header-line-function)))))
192
193(defvar +tab-bar-show-original nil
194 "Original value of `tab-bar-show'.")
195
196(defun +tab-bar-basename ()
197 "Generate the tab name from the basename of the buffer of the
198 selected window."
199 (let* ((tab-file-name (buffer-file-name (window-buffer
200 (minibuffer-selected-window)))))
201 (concat " "
202 (if tab-file-name
203 (file-name-nondirectory tab-file-name)
204 (+tab-bar-tab-name-truncated-left)))))
205
206;;; FIXME this doesn't work...
207;; (defvar +tab-bar-tab-min-width 8
208 ;; "Minimum width of a tab on the tab bar.")
209
210;; (defvar +tab-bar-tab-max-width 24
211 ;; "Maximum width of a tab on the tab bar.")
212
213;; (defun +tab-bar-fluid-calculate-width ()
214 ;; "Calculate the width of each tab in the tab-bar."
215 ;; (let* ((tab-bar-list (cdr (tab-bar-make-keymap-1)))
216 ;; (tab-bar-avail-width (frame-width))
217 ;; (tab-bar-tab-count (length (tab-bar-tabs)))
218 ;; (tab-bar-close-button-char-width 1)
219 ;; (tab-bar-add-tab-button-char-width 1)
220 ;; (tab-bar-total-width
221 ;; (length (mapconcat
222 ;; (lambda (el)
223 ;; (when-let ((str (car-safe (cdr-safe (cdr-safe el)))))
224 ;; (substring-no-properties (eval str))))
225 ;; tab-bar-list)))
226 ;; (tab-bar-total-tab-width
227 ;; (+ (* tab-bar-tab-count tab-bar-close-button-char-width)
228 ;; tab-bar-add-tab-button-char-width
229 ;; (length (mapconcat
230 ;; (lambda (el)
231 ;; (substring-no-properties (alist-get 'name el)))
232 ;; (tab-bar-tabs)))))
233 ;; (tab-bar-total-nontab-width (- tab-bar-total-width
234 ;; tab-bar-total-tab-width)))
235 ;; (min +tab-bar-tab-max-width
236 ;; (max +tab-bar-tab-min-width
237 ;; (/ (- tab-bar-avail-width
238 ;; tab-bar-total-tab-width
239 ;; tab-bar-total-nontab-width)
240 ;; tab-bar-tab-count)))))
241
242;; (defun +tab-bar-fluid-width ()
243 ;; "Generate the tab name to fluidly fit in the given space."
244 ;; (let* ((tab-file-name (buffer-file-name (window-buffer
245 ;; (minibuffer-selected-window)))))
246 ;; (format (format " %%s%%%ds" (+tab-bar-fluid-calculate-width))
247 ;; (if tab-file-name
248 ;; (file-name-nondirectory tab-file-name)
249 ;; (+tab-bar-tab-name-truncated-left))
250 ;; " ")))
251
252(defun +tab-bar-tab-name-truncated-left ()
253 "Generate the tab name from the buffer of the selected window.
254This is just like `tab-bar-tab-name-truncated', but truncates the
255name to the left."
256 (let* ((tab-name (buffer-name (window-buffer (minibuffer-selected-window))))
257 (ellipsis (cond
258 (tab-bar-tab-name-ellipsis)
259 ((char-displayable-p ?…) "…")
260 ("...")))
261 (l-ell (length ellipsis))
262 (l-name (length tab-name)))
263 (if (< (length tab-name) tab-bar-tab-name-truncated-max)
264 tab-name
265 (propertize (concat
266 (when (> (+ l-name l-ell) tab-bar-tab-name-truncated-max)
267 ellipsis)
268 (truncate-string-to-width tab-name l-name
269 (max 0 (- l-name tab-bar-tab-name-truncated-max l-ell))))
270 'help-echo tab-name))))
271
272(defun +tab-bar-format-align-right ()
273 "Align the rest of tab bar items to the right, pixel-wise."
274 ;; XXX: ideally, wouldn't require `shr' here
275 (require 'shr) ; `shr-string-pixel-width'
276 (let* ((rest (cdr (memq '+tab-bar-format-align-right tab-bar-format)))
277 (rest (tab-bar-format-list rest))
278 (rest (mapconcat (lambda (item) (nth 2 item)) rest ""))
279 (hpos (shr-string-pixel-width rest))
280 (str (propertize " " 'display `(space :align-to (- right (,hpos))))))
281 `((align-right menu-item ,str ignore))))
282
283
284;;; Menu bar
285;; stole from https://github.com/emacs-mirror/emacs/blob/master/lisp/tab-bar.el
286
287(defun +tab-bar-menu-bar (event)
288 "Pop up the same menu as displayed by the menu bar.
289Used by `tab-bar-format-menu-bar'."
290 (interactive "e")
291 (let ((menu (make-sparse-keymap (propertize "Menu Bar" 'hide t))))
292 (run-hooks 'activate-menubar-hook 'menu-bar-update-hook)
293 (map-keymap (lambda (key binding)
294 (when (consp binding)
295 (define-key-after menu (vector key)
296 (copy-sequence binding))))
297 (menu-bar-keymap))
298 (popup-menu menu event)))
299
300(defcustom +tab-bar-menu-bar-icon " Emacs "
301 "The string to use for the tab-bar menu icon."
302 :type 'string)
303
304(defun +tab-bar-format-menu-bar ()
305 "Produce the Menu button for the tab bar that shows the menu bar."
306 `((menu-bar menu-item (propertize +tab-bar-menu-bar-icon 'face '+tab-bar-extra)
307 +tab-bar-menu-bar :help "Menu Bar")))
308
309
310;;; Tab bar format tabs
311
312(require 'el-patch)
313(el-patch-feature tab-bar)
314(with-eval-after-load 'tab-bar
315 (el-patch-defun tab-bar--format-tab (tab i)
316 "Format TAB using its index I and return the result as a keymap."
317 (append
318 (el-patch-remove
319 `((,(intern (format "sep-%i" i)) menu-item ,(tab-bar-separator) ignore)))
320 (cond
321 ((eq (car tab) 'current-tab)
322 `((current-tab
323 menu-item
324 ,(funcall tab-bar-tab-name-format-function tab i)
325 ignore
326 :help "Current tab")))
327 (t
328 `((,(intern (format "tab-%i" i))
329 menu-item
330 ,(funcall tab-bar-tab-name-format-function tab i)
331 ,(alist-get 'binding tab)
332 :help "Click to visit tab"))))
333 (when (alist-get 'close-binding tab)
334 `((,(if (eq (car tab) 'current-tab) 'C-current-tab (intern (format "C-tab-%i" i)))
335 menu-item ""
336 ,(alist-get 'close-binding tab)))))))
337
338
339;; Emacs 27
340
341(defun +tab-bar-misc-info-27 (output &rest _)
342 "Display `mode-line-misc-info' in the `tab-bar' on Emacs 27.
343This is :filter-return advice for `tab-bar-make-keymap-1'."
344 (let* ((reserve (length (format-mode-line mode-line-misc-info)))
345 (str (propertize " "
346 'display `(space :align-to (- right (- 0 right-margin)
347 ,reserve)))))
348 (prog1 (append output
349 `((align-right menu-item ,str nil))
350 (+tab-bar-misc-info)))))
351
352
353;; Emacs 28
354
355(defvar +tab-bar-format-original nil
356 "Original value of `tab-bar-format'.")
357
358(defun +tab-bar-misc-info-28 ()
359 "Display `mode-line-misc-info', right-aligned, on Emacs 28."
360 (append (unless (memq 'tab-bar-format-align-right tab-bar-format)
361 '(tab-bar-format-align-right))
362 '(+tab-bar-misc-info)))
363
364
365
366(define-minor-mode +tab-bar-misc-info-mode
367 "Show the `mode-line-misc-info' in the `tab-bar'."
368 :lighter ""
369 :global t
370 (if +tab-bar-misc-info-mode
371 (progn ; Enable
372 (setq +tab-bar-show-original tab-bar-show)
373 (cond
374 ((boundp 'tab-bar-format) ; Emacs 28
375 (setq +tab-bar-format-original tab-bar-format)
376 (unless (memq '+tab-bar-misc-info tab-bar-format)
377 (setq tab-bar-format
378 (append tab-bar-format (+tab-bar-misc-info-28)))))
379 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
380 (advice-add 'tab-bar-make-keymap-1 :filter-return
381 '+tab-bar-misc-info-27)))
382 (setq tab-bar-show t))
383 (progn ; Disable
384 (setq tab-bar-show +tab-bar-show-original)
385 (cond
386 ((boundp 'tab-bar-format) ; Emacs 28
387 (setq tab-bar-format +tab-bar-format-original))
388 ((fboundp 'tab-bar-make-keymap-1) ; Emacs 27
389 (advice-remove 'tab-bar-make-keymap-1 '+tab-bar-misc-info-27))))))
390
391
392
393(provide '+tab-bar)
394;;; +tab-bar.el ends here
diff --git a/lisp/+titlecase.el b/lisp/+titlecase.el deleted file mode 100644 index 655ebe1..0000000 --- a/lisp/+titlecase.el +++ /dev/null
@@ -1,30 +0,0 @@
1;;; +titlecase.el --- Titlecase extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(defun +titlecase-sentence-style-dwim (&optional arg)
8 "Titlecase a sentence.
9With prefix ARG, toggle the value of
10`titlecase-downcase-sentences' before sentence-casing."
11 (interactive "P")
12 (let ((titlecase-downcase-sentences (if arg (not titlecase-downcase-sentences)
13 titlecase-downcase-sentences)))
14 (titlecase-dwim 'sentence)))
15
16(defun +titlecase-org-headings ()
17 (interactive)
18 (save-excursion
19 (goto-char (point-min))
20 ;; See also `org-map-tree'. I'm not using that function because I want to
21 ;; skip the first headline. A better solution would be to patch
22 ;; `titlecase-line' to ignore org-mode metadata (TODO cookies, tags, etc).
23 (let ((level (funcall outline-level)))
24 (while (and (progn (outline-next-heading)
25 (> (funcall outline-level) level))
26 (not (eobp)))
27 (titlecase-line)))))
28
29(provide '+titlecase)
30;;; +titlecase.el ends here
diff --git a/lisp/+util.el b/lisp/+util.el deleted file mode 100644 index a87eae9..0000000 --- a/lisp/+util.el +++ /dev/null
@@ -1,94 +0,0 @@
1;;; +util.el --- utility whatevers -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; This file is going to be my version of like, subr.el -- lots of
6;; random shit that all goes in here.
7
8;;; Code:
9
10(require 'cl-lib)
11
12(defgroup +util nil
13 "Utility whatevers."
14 :group 'convenience)
15
16;;; STRINGS
17
18(defcustom +string-default-alignment 'left
19 "Default alignment."
20 :type '(choice (const :tag "Left" 'left)
21 (const :tag "Right" 'right)))
22
23;; stolen from s.el
24(defun +string-repeat (n s)
25 "Make a string of S repeated N times."
26 (declare (pure t)
27 (side-effect-free t))
28 (let (ss)
29 (while (> n 0)
30 (setq ss (cons s ss)
31 n (1- n)))
32 (apply 'concat ss)))
33
34(defun +string-truncate (s length &optional ellipsis alignment)
35 "Return S, shortened to LENGTH including ELLIPSIS and aligned to ALIGNMENT.
36
37ELLIPSIS defaults to `truncate-string-ellipsis', or \"...\".
38
39ALIGNMENT defaults to `+string-default-alignment'."
40 (declare (pure t)
41 (side-effect-free t))
42 (let ((ellipsis (or ellipsis truncate-string-ellipsis "..."))
43 (alignment (or alignment +string-default-alignment)))
44 (if (> (length s) length)
45 (format "%s%s"
46 (substring s 0 (- length (length ellipsis)))
47 ellipsis)
48 s)))
49
50(cl-defun +string-align (s len
51 &key
52 (before "") (after "") (fill " ")
53 (ellipsis (or truncate-string-ellipsis "..."))
54 (alignment +string-default-alignment))
55 "Print S to fit in LEN characters.
56Optional arguments BEFORE and AFTER specify strings to go on
57either side of S.
58
59FILL is the string to fill extra space with (default \" \").
60
61ELLIPSIS is the string to show when S is too long to fit (default
62`truncate-string-ellipsis' or \"...\"). If nil, don't truncate
63the string.
64
65ALIGNMENT can be one of these:
66- nil: align to `+string-default-alignment'
67- `left': align left
68- `right': align right"
69 (let* ((s-length (length s))
70 (before-length (length before))
71 (after-length (length after))
72 (max-length (- len (+ before-length after-length)))
73 (left-over (max 0 (- max-length s-length)))
74 (filler (+string-repeat left-over fill)))
75 (format "%s%s%s%s%s"
76 before
77 (if (eq alignment 'left) "" filler)
78 (if ellipsis (+string-truncate s max-length ellipsis alignment) s)
79 (if (eq alignment 'right) "" filler)
80 after)))
81
82;;; COMMANDS
83
84(defun +dos2unix (buffer)
85 "Replace \r\n with \n in BUFFER."
86 (interactive "*b")
87 (save-excursion
88 (with-current-buffer buffer
89 (goto-char (point-min))
90 (while (search-forward (string ?\C-m ?\C-j) nil t)
91 (replace-match (string ?\C-j) nil t)))))
92
93(provide '+util)
94;;; +util.el ends here
diff --git a/lisp/+vertico.el b/lisp/+vertico.el deleted file mode 100644 index d4fb3a3..0000000 --- a/lisp/+vertico.el +++ /dev/null
@@ -1,24 +0,0 @@
1;;; +vertico.el -*- lexical-binding: t; -*-
2
3;;; Code:
4
5;; https://old.reddit.com/r/emacs/comments/rbmfwk/weekly_tips_tricks_c_thread/hof7rz7/
6;; Add this advice to `vertico-next'.
7;; Takes care of `vertico-previous' as well, since it calls `vertico-next'.
8(defun +vertico-ding-wrap (origin &rest args)
9 "ADVICE to wrap `vertico-next': ding when wrapping."
10 (let ((beg-index vertico--index))
11 (apply origin args)
12 (unless (eq 1 (abs (- beg-index vertico--index)))
13 (ding))))
14
15(defun +vertico-widen-or-complete ()
16 (interactive)
17 (if (or vertico-unobtrusive-mode
18 vertico-flat-mode)
19 (progn (vertico-unobtrusive-mode -1)
20 (vertico-flat-mode -1))
21 (call-interactively #'vertico-insert)))
22
23(provide '+vertico)
24;;; +vertico.el ends here
diff --git a/lisp/+vterm.el b/lisp/+vterm.el deleted file mode 100644 index 06c0028..0000000 --- a/lisp/+vterm.el +++ /dev/null
@@ -1,19 +0,0 @@
1;;; +vterm.el --- Vterm extras -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'vterm)
8
9(defun +vterm-counsel-yank-pop-action (orig-fun &rest args)
10 (if (equal major-mode 'vterm-mode)
11 (let ((inhibit-read-only t)
12 (yank-undo-function (lambda (_start _end) (vterm-undo))))
13 (cl-letf (((symbol-function 'insert-for-yank)
14 (lambda (str) (vterm-send-string str t))))
15 (apply orig-fun args)))
16 (apply orig-fun args)))
17
18(provide '+vterm)
19;;; +vterm.el ends here
diff --git a/lisp/+window.el b/lisp/+window.el deleted file mode 100644 index 52b3712..0000000 --- a/lisp/+window.el +++ /dev/null
@@ -1,130 +0,0 @@
1;;; +window.el --- Fixes for Emacs's window.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; Do I want to propose this change in the Emacs ML?
6
7;;; Code:
8
9(require 'window)
10
11;;; Split windows based on `window-total-width', not `window-width'
12;; I have to just redefine these functions because the check is really deep in
13;; there.
14
15(defun window-splittable-p (window &optional horizontal)
16 "Return non-nil if `split-window-sensibly' may split WINDOW.
17Optional argument HORIZONTAL nil or omitted means check whether
18`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
19non-nil means check whether WINDOW may be split horizontally.
20
21WINDOW may be split vertically when the following conditions
22hold:
23- `window-size-fixed' is either nil or equals `width' for the
24 buffer of WINDOW.
25- `split-height-threshold' is an integer and WINDOW is at least as
26 high as `split-height-threshold'.
27- When WINDOW is split evenly, the emanating windows are at least
28 `window-min-height' lines tall and can accommodate at least one
29 line plus - if WINDOW has one - a mode line.
30
31WINDOW may be split horizontally when the following conditions
32hold:
33- `window-size-fixed' is either nil or equals `height' for the
34 buffer of WINDOW.
35- `split-width-threshold' is an integer and WINDOW is at least as
36 wide as `split-width-threshold'.
37- When WINDOW is split evenly, the emanating windows are at least
38 `window-min-width' or two (whichever is larger) columns wide."
39 (when (and (window-live-p window)
40 (not (window-parameter window 'window-side)))
41 (with-current-buffer (window-buffer window)
42 (if horizontal
43 ;; A window can be split horizontally when its width is not
44 ;; fixed, it is at least `split-width-threshold' columns wide
45 ;; and at least twice as wide as `window-min-width' and 2 (the
46 ;; latter value is hardcoded).
47 (and (memq window-size-fixed '(nil height))
48 ;; Testing `window-full-width-p' here hardly makes any
49 ;; sense nowadays. This can be done more intuitively by
50 ;; setting up `split-width-threshold' appropriately.
51 (numberp split-width-threshold)
52 (>= (window-total-width window)
53 (max split-width-threshold
54 (* 2 (max window-min-width 2)))))
55 ;; A window can be split vertically when its height is not
56 ;; fixed, it is at least `split-height-threshold' lines high,
57 ;; and it is at least twice as high as `window-min-height' and 2
58 ;; if it has a mode line or 1.
59 (and (memq window-size-fixed '(nil width))
60 (numberp split-height-threshold)
61 (>= (window-height window)
62 (max split-height-threshold
63 (* 2 (max window-min-height
64 (if mode-line-format 2 1))))))))))
65
66(defun split-window-sensibly (&optional window)
67 "Split WINDOW in a way suitable for `display-buffer'.
68WINDOW defaults to the currently selected window.
69If `split-height-threshold' specifies an integer, WINDOW is at
70least `split-height-threshold' lines tall and can be split
71vertically, split WINDOW into two windows one above the other and
72return the lower window. Otherwise, if `split-width-threshold'
73specifies an integer, WINDOW is at least `split-width-threshold'
74columns wide and can be split horizontally, split WINDOW into two
75windows side by side and return the window on the right. If this
76can't be done either and WINDOW is the only window on its frame,
77try to split WINDOW vertically disregarding any value specified
78by `split-height-threshold'. If that succeeds, return the lower
79window. Return nil otherwise.
80
81By default `display-buffer' routines call this function to split
82the largest or least recently used window. To change the default
83customize the option `split-window-preferred-function'.
84
85You can enforce this function to not split WINDOW horizontally,
86by setting (or binding) the variable `split-width-threshold' to
87nil. If, in addition, you set `split-height-threshold' to zero,
88chances increase that this function does split WINDOW vertically.
89
90In order to not split WINDOW vertically, set (or bind) the
91variable `split-height-threshold' to nil. Additionally, you can
92set `split-width-threshold' to zero to make a horizontal split
93more likely to occur.
94
95Have a look at the function `window-splittable-p' if you want to
96know how `split-window-sensibly' determines whether WINDOW can be
97split."
98 (let ((window (or window (selected-window))))
99 (or (and (window-splittable-p window)
100 ;; Split window vertically.
101 (with-selected-window window
102 (split-window-below)))
103 (and (window-splittable-p window t)
104 ;; Split window horizontally.
105 (with-selected-window window
106 (split-window-right)))
107 (and
108 ;; If WINDOW is the only usable window on its frame (it is
109 ;; the only one or, not being the only one, all the other
110 ;; ones are dedicated) and is not the minibuffer window, try
111 ;; to split it vertically disregarding the value of
112 ;; `split-height-threshold'.
113 (let ((frame (window-frame window)))
114 (or
115 (eq window (frame-root-window frame))
116 (catch 'done
117 (walk-window-tree (lambda (w)
118 (unless (or (eq w window)
119 (window-dedicated-p w))
120 (throw 'done nil)))
121 frame nil 'nomini)
122 t)))
123 (not (window-minibuffer-p window))
124 (let ((split-height-threshold 0))
125 (when (window-splittable-p window)
126 (with-selected-window window
127 (split-window-below))))))))
128
129(provide '+window)
130;;; +window.el ends here
diff --git a/lisp/+xkcd.el b/lisp/+xkcd.el deleted file mode 100644 index 6780b90..0000000 --- a/lisp/+xkcd.el +++ /dev/null
@@ -1,16 +0,0 @@
1;;; +xkcd.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'xkcd)
8
9(defun +xkcd-get-from-url (url &rest _)
10 "Open XKCD from URL."
11 (if (string-match "xkcd\\.com/\\([0-9]+\\)" url)
12 (xkcd-get (string-to-number (match-string 1 url)))
13 (funcall +browse-url-browser-function url)))
14
15(provide '+xkcd)
16;;; +xkcd.el ends here
diff --git a/lisp/+ytdious.el b/lisp/+ytdious.el deleted file mode 100644 index 6124149..0000000 --- a/lisp/+ytdious.el +++ /dev/null
@@ -1,21 +0,0 @@
1;;; +ytdious.el --- Ytdious customizations -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; https://github.com/spiderbit/ytdious
6
7;;; Code:
8
9(defun +ytdious-watch ()
10 "Stream video at point in mpv."
11 (interactive)
12 (let* ((video (ytdious-get-current-video))
13 (id (ytdious-video-id-fun video)))
14 (start-process "ytdious mpv" nil
15 "mpv"
16 (concat "https://www.youtube.com/watch?v=" id))
17 "--ytdl-format=bestvideo[height<=?720]+bestaudio/best")
18 (message "Starting streaming..."))
19
20(provide '+ytdious)
21;;; +ytdious.el ends here
diff --git a/lisp/+zzz-to-char.el b/lisp/+zzz-to-char.el deleted file mode 100644 index b3f27f7..0000000 --- a/lisp/+zzz-to-char.el +++ /dev/null
@@ -1,16 +0,0 @@
1;;; +zzz-to-char.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;
6
7;;; Code:
8
9(defun +zzz-to-char (prefix)
10 "Call `zzz-to-char' or `zzz-up-to-char' with PREFIX arg."
11 (interactive "P")
12 (call-interactively
13 (if prefix #'zzz-up-to-char #'zzz-to-char)))
14
15(provide '+zzz-to-char)
16;;; +zzz-to-char.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 99ab733..1c6f826 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -1,28 +1,10 @@
1;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- 1;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*-
2 2;; by C. Duckworth <acdw@acdw.net>
3;;; Commentary: 3(provide 'acdw)
4
5;; What's that saying about how the hardest things in computer science
6;; are naming and off-by-one errors? Well, the naming one I know very
7;; well. I've been trying to figure out a good way to prefix my
8;; bespoke functions, other stuff I found online, and various emacs
9;; lisp detritus for quite some time (I reckon at over a year, as of
10;; 2021-11-02). Finally, I found the answer in the writings of Daniel
11;; Mendler: I'll prefix everything with a `+' !
12
13;; To that end, pretty much everything in lisp/ will have a filename
14;; like "+org.el", except of course this file, and maybe a few
15;; /actually original/ libraries I haven't had the wherewithal to
16;; package out properly yet.
17
18;; Is it perfect? No. Is it fine? Yes. Here it is.
19
20;;; Code:
21 4
22(require 'diary-lib) 5(require 'cl-lib)
23(require 'solar) ; for +sunrise-sunset
24 6
25;;; Define a directory and an expanding function 7;;; Define both a directory and a function expanding to a file in that directory
26 8
27(defmacro +define-dir (name directory &optional docstring inhibit-mkdir) 9(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
28 "Define a variable and function NAME expanding to DIRECTORY. 10 "Define a variable and function NAME expanding to DIRECTORY.
@@ -46,488 +28,91 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
46 (make-directory (file-name-directory file-name) :parents)) 28 (make-directory (file-name-directory file-name) :parents))
47 file-name)))) 29 file-name))))
48 30
49(defun +suppress-messages (oldfn &rest args) ; from pkal 31;;; Convenience macros
50 "Advice wrapper for suppressing `message'.
51OLDFN is the wrapped function, that is passed the arguments
52ARGS."
53 (let ((msg (current-message)))
54 (prog1
55 (let ((inhibit-message t))
56 (apply oldfn args))
57 (when msg
58 (message "%s" msg)))))
59 32
60(defun +ensure-after-init (function) 33(defun eval-after-init (fn)
61 "Ensure FUNCTION runs after init, or now if already initialized. 34 "Evaluate FN after inititation, or now if Emacs is initialized.
62If Emacs is already started, run FUNCTION. Otherwise, add it to 35FN is called with no arguments."
63`after-init-hook'. FUNCTION is called with no arguments."
64 (if after-init-time 36 (if after-init-time
65 (funcall function) 37 (funcall fn)
66 (add-hook 'after-init-hook function))) 38 (add-hook 'after-init-hook fn)))
67 39
68(defmacro +with-ensure-after-init (&rest body) 40(defmacro eval-after (features &rest body)
69 "Ensure BODY forms run after init. 41 "Evaluate BODY, but only after loading FEATURES.
70Convenience macro wrapper around `+ensure-after-init'." 42FEATURES can be an atom or a list; as an atom it works like
71 (declare (indent 0) (debug (def-body))) 43`with-eval-after-load'. The special feature `init' will evaluate
72 `(+ensure-after-init (lambda () ,@body))) 44BODY after Emacs is finished initializing."
73 45 (declare (indent 1)
74(defun +remember-prefix-arg (p-arg P-arg) 46 (debug (form def-body)))
75 "Display prefix ARG, in \"p\" and \"P\" `interactive' types. 47 (if (eq features 'init)
76I keep forgetting how they differ." 48 `(eval-after-init (lambda () ,@body))
77 (interactive "p\nP") 49 (unless (listp features)
78 (message "p: %S P: %S" p-arg P-arg)) 50 (setq features (list features)))
79 51 (if (null features)
80(defmacro +defvar (var value &rest _) 52 (macroexp-progn body)
81 "Quick way to `setq' a variable from a `defvar' form." 53 (let* ((this (car features))
82 (declare (doc-string 3) (indent 2)) 54 (rest (cdr features)))
83 `(setq ,var ,value)) 55 `(with-eval-after-load ',this
84 56 (eval-after ,rest ,@body))))))
85(defmacro +with-message (message &rest body) 57
86 "Execute BODY, with MESSAGE. 58;;; Convenience functions
87If body executes without errors, MESSAGE...Done will be displayed." 59
88 (declare (indent 1)) 60(defun define-keys (maps &rest keydefs)
89 (let ((msg (gensym))) 61 "Define KEYDEFS in MAPS.
90 `(let ((,msg ,message)) 62Convenience wrapper around `define-key'."
91 (condition-case e 63 (unless (zerop (mod (length keydefs) 2))
92 (progn (message "%s..." ,msg) 64 (user-error "Wrong number of arguments: %S" (length keydefs)))
93 ,@body) 65 (dolist (map (if (or (atom maps) (eq (car maps) 'keymap))
94 (:success (message "%s...done" ,msg)) 66 (list maps)
95 (t (signal (car e) (cdr e))))))) 67 maps))
96 68 (cl-loop for (key def) on keydefs by #'cddr
97(defun +mapc-some-buffers (func &optional predicate-or-modes) 69 do (let ((key (if (stringp key) (kbd key) key)))
98 "Perform FUNC on all buffers satisfied by PREDICATE-OR-MODES. 70 (define-key (if (symbolp map)
99By default, act on all buffers. 71 (symbol-value map)
100 72 map)
101Both PREDICATE-OR-MODES and FUNC are called with no arguments, 73 key def)))))
102but within a `with-current-buffer' form on the currently-active 74
103buffer. 75(defmacro setq-local-hook (hook &rest args)
104 76 "Run `setq-local' on ARGS when running HOOK."
105As a special case, if PREDICATE-OR-MODES is a list, it will be
106interpreted as a list of major modes. In this case, FUNC will
107only be called on buffers derived from one of the modes in
108PREDICATE-OR-MODES."
109 (let ((pred (or predicate-or-modes t)))
110 (dolist (buf (buffer-list))
111 (with-current-buffer buf
112 (when (cond ((functionp pred)
113 (funcall pred))
114 ((listp pred)
115 (apply #'derived-mode-p pred))
116 (t pred))
117 (funcall func))))))
118
119;; https://github.com/cstby/emacs.d/blob/main/init.el#L67
120(defun +clean-empty-lines (&optional begin end)
121 "Remove duplicate empty lines from BEGIN to END.
122Called interactively, this function acts on the region, if
123active, or else the entire buffer."
124 (interactive "*r")
125 (unless (region-active-p)
126 (setq begin (point-min)
127 end (save-excursion
128 (goto-char (point-max))
129 (skip-chars-backward "\n[:space:]")
130 (point))))
131 (save-excursion
132 (save-restriction
133 (narrow-to-region begin end)
134 (goto-char (point-min))
135 (while (re-search-forward "\n\n\n+" nil :move)
136 (replace-match "\n\n"))
137 ;; Insert a newline at the end.
138 (goto-char (point-max))
139 (unless (or (buffer-narrowed-p)
140 (= (line-beginning-position) (line-end-position)))
141 (insert "\n")))))
142
143(defcustom +open-paragraph-ignore-modes '(special-mode lui-mode comint-mode)
144 "Modes in which `+open-paragraph' makes no sense."
145 :type '(repeat function))
146
147(defun +open-paragraph (&optional arg)
148 "Open a paragraph after paragraph at point.
149A paragraph is defined as continguous non-empty lines of text
150surrounded by empty lines, so opening a paragraph means to make
151three blank lines, then place the point on the second one.
152
153Called with prefix ARG, open a paragraph before point."
154 ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
155 (interactive "*P")
156 ;; TODO: add `+open-paragraph-ignore-modes'
157 (unless (apply #'derived-mode-p +open-paragraph-ignore-modes)
158 ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because
159 ;; that's weird with org, and I'm guessing other modes too.
160 (unless (looking-at "^$") (forward-line (if arg -1 +1)))
161 (while (and (not (looking-at "^$"))
162 (= 0 (forward-line (if arg -1 +1)))))
163 (newline)
164 (when arg (newline) (forward-line -2))
165 (delete-blank-lines)
166 (newline 2)
167 (previous-line)))
168
169(defun +split-window-then (&optional where arg)
170 "Split the window into a new buffer.
171With non-nil ARG (\\[universal-argument] interactively), don't
172prompt for a buffer to switch to. This function will split the
173window using `split-window-sensibly', or open the new window in
174the direction specified by WHERE. WHERE is ignored when called
175interactively; if you want specific splitting, use
176`+split-window-right-then' or `+split-window-below-then'."
177 (interactive "i\nP")
178 ;; TODO: Canceling at the switching phase leaves the point in the other
179 ;; window. Ideally, the user would see this as one action, meaning a cancel
180 ;; would return to the original window.
181 (pcase where
182 ;; These directions are 'backward' to the OG Emacs split-window commands,
183 ;; because by default Emacs leaves the cursor in the original window. Most
184 ;; users probably expect a switch to the new window, at least I do.
185 ((or 'right :right) (split-window-right) (other-window 1))
186 ((or 'left :left) (split-window-right))
187 ((or 'below :below) (split-window-below) (other-window 1))
188 ((or 'above :above) (split-window-below))
189 ((pred null)
190 (or (split-window-sensibly)
191 (if (< (window-height) (window-width))
192 (split-window-below)
193 (split-window-right)))
194 (other-window 1))
195 (_ (user-error "Unknown WHERE paramater: %s" where)))
196 (unless arg
197 (condition-case nil
198 (call-interactively
199 (pcase (read-char "(B)uffer or (F)ile?")
200 (?b (if (fboundp #'consult-buffer)
201 #'consult-buffer
202 #'switch-to-buffer))
203 (?f #'find-file)
204 (_ #'ignore)))
205 (quit (delete-window)))))
206
207(defun +split-window-right-then (&optional arg)
208 "Split window right, then prompt for a new buffer.
209With optional ARG (\\[universal-argument]), just split."
210 (interactive "P")
211 (+split-window-then :right arg))
212
213(defun +split-window-below-then (&optional arg)
214 "Split window below, then prompt for a new buffer.
215With optional ARG (\\[universal-argument]), just split."
216 (interactive "P")
217 (+split-window-then :below arg))
218
219(defun +bytes (number unit)
220 "Convert NUMBER UNITs to bytes.
221UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib,
222:tib, :pib, :eib, :zib, :yib."
223 (* number (pcase unit
224 ;; Base 10 units
225 (:kb 1000)
226 (:mb (* 1000 1000))
227 (:gb (* 1000 1000 1000))
228 (:tb (* 1000 1000 1000 1000))
229 (:pb (* 1000 1000 1000 1000 1000))
230 (:eb (* 1000 1000 1000 1000 1000 1000))
231 (:zb (* 1000 1000 1000 1000 1000 1000 1000))
232 (:yb (* 1000 1000 1000 1000 1000 1000 1000 1000))
233 ;; Base 2 units
234 (:kib 1024)
235 (:mib (* 1024 1024))
236 (:gib (* 1024 1024 1024))
237 (:tib (* 1024 1024 1024 1024))
238 (:pib (* 1024 1024 1024 1024 1024))
239 (:eib (* 1024 1024 1024 1024 1024 1024))
240 (:zib (* 1024 1024 1024 1024 1024 1024 1024))
241 (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024)))))
242
243;;; Font lock TODO keywords
244
245(defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG")
246 "Keywords to highlight with `font-lock-todo-face'.")
247
248(defface font-lock-todo-face '((t :inherit font-lock-comment-face
249 :background "yellow"))
250 ;; TODO: XXX: FIXME: BUG: testing :)
251 "Face for TODO keywords.")
252
253(defun font-lock-todo-insinuate ()
254 (let ((keyword-regexp
255 (rx bow (group (eval (let ((lst '(or)))
256 (dolist (kw font-lock-todo-keywords)
257 (push kw lst))
258 (nreverse lst))))
259 ":")))
260 (font-lock-add-keywords
261 nil
262 `((,keyword-regexp 1 'font-lock-todo-face prepend)))))
263
264;; I don't use this much but I always forget the exact implementation, so this
265;; is more to remember than anything else.
266(defmacro setc (&rest vars-and-vals)
267 "Set VARS-AND-VALS by customizing them or using set-default.
268Use like `setq'."
269 `(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr
270 if (null val) return (user-error "Not enough arguments")
271 collecting `(funcall (or (get ',var 'custom-get)
272 #'set-default)
273 ',var ',val)
274 into ret
275 finally return ret)))
276
277(defun +set-faces (specs)
278 "Set fonts to SPECS.
279Specs is an alist: its cars are faces and its cdrs are the plist
280passed to `set-face-attribute'. Note that the FRAME argument is
281always nil; this function is mostly intended for use in init."
282 (dolist (spec specs)
283 (apply #'set-face-attribute (car spec) nil (cdr spec))))
284
285(defcustom chat-functions '(+irc
286 jabber-connect-all
287 ;; slack-start
288 )
289 "Functions to start when calling `chat'."
290 :type '(repeat function)
291 :group 'applications)
292
293(defun +string-repeat (n str)
294 "Repeat STR N times."
295 (let ((r ""))
296 (dotimes (_ n)
297 (setq r (concat r str)))
298 r))
299
300;; (defun chat-disconnect ()
301;; "Disconnect from all chats."
302;; (interactive)
303;; (+with-progress "Quitting circe..."
304;; (ignore-errors
305;; (circe-command-GQUIT "peace love bread")
306;; (cancel-timer (irc-connection-get conn :flood-timer))))
307;; (+with-progress "Quitting jabber..."
308;; (ignore-errors
309;; (jabber-disconnect)))
310;; (when (boundp '+slack-teams)
311;; (+with-progress "Quitting-slack..."
312;; (dolist (team +slack-teams)
313;; (ignore-errors
314;; (slack-team-disconnect team)))
315;; (ignore-errors (slack-ws-close))))
316;; (+with-progress "Killing buffers..."
317;; (ignore-errors
318;; (+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally."
319;; (let ((kill-buffer-query-functions nil))
320;; (tracking-remove-buffer (current-buffer))
321;; (kill-buffer)))
322;; (lambda () "Return t if derived from the following modes."
323;; (derived-mode-p 'lui-mode
324;; 'jabber-chat-mode
325;; 'jabber-roster-mode
326;; 'jabber-browse-mode
327;; 'slack-mode))))))
328
329;; I can never remember all the damn chat things I run, so this just does all of em.
330;; (defun chat (&optional arg)
331;; "Initiate all chat functions.
332;; With optional ARG, kill all chat-related buffers first."
333;; (interactive "P")
334;; (when arg (chat-disconnect))
335;; (dolist-with-progress-reporter (fn chat-functions)
336;; "Connecting to chat..."
337;; (call-interactively fn)))
338
339(defun +forward-paragraph (arg)
340 "Move forward ARG (simple) paragraphs.
341A paragraph here is simply defined: it's a block of buffer that's
342separated from others by two newlines."
343 (interactive "p")
344 (let ((direction (/ arg (abs arg))))
345 (forward-line direction)
346 (while (not (or (bobp)
347 (eobp)
348 (= arg 0)))
349 (if (looking-at "^[ \f\t]*$")
350 (setq arg (- arg direction))
351 (forward-line direction)))))
352
353(defun +backward-paragraph (arg)
354 "Move backward ARG (simple) paragraphs.
355See `+forward-paragraph' for the behavior."
356 (interactive "p")
357 (+forward-paragraph (- arg)))
358
359(defun +concat (&rest strings)
360 "Concat STRINGS separated by SEPARATOR.
361Each item in STRINGS is either a string or a list or strings,
362which is concatenated without any separator.
363
364SEPARATOR defaults to the newline (\\n)."
365 (let (ret
366 ;; I don't know why a `cl-defun' with
367 ;; (&rest strings &key (separator "\n")) doesn't work
368 (separator (or (cl-loop for i from 0 upto (length strings)
369 if (eq (nth i strings) :separator)
370 return (nth (1+ i) strings))
371 "\n")))
372 (while strings
373 (let ((string (pop strings)))
374 (cond ((eq string :separator) (pop strings))
375 ((listp string) (push (apply #'concat string) ret))
376 ((stringp string) (push string ret)))))
377 (mapconcat #'identity (nreverse ret) separator)))
378
379(defun +file-string (file)
380 "Fetch the contents of FILE and return its string."
381 (with-current-buffer (find-file-noselect file)
382 (buffer-string)))
383
384(defmacro +with-progress (pr-args &rest body)
385 "Perform BODY wrapped in a progress reporter.
386PR-ARGS is the list of arguments to pass to
387`make-progress-reporter'; it can be a single string for the
388message, as well. If you want to use a formatted string, wrap
389the `format' call in a list."
390 (declare (indent 1)) 77 (declare (indent 1))
391 (let ((reporter (gensym)) 78 (let ((fn (intern (format "%s-setq-local" hook))))
392 (pr-args (if (listp pr-args) pr-args (list pr-args)))) 79 (when (and (fboundp fn)
393 `(let ((,reporter (make-progress-reporter ,@pr-args))) 80 (functionp fn))
394 (prog1 (progn ,@body) 81 (setq args (append (function-get fn 'setq-local-hook-settings) args)))
395 (progress-reporter-done ,reporter))))) 82 (unless (and (< 0 (length args))
396 83 (zerop (mod (length args) 2)))
397(defmacro +with-eval-after-loads (features &rest body) 84 (user-error "Wrong number of arguments: %S" (length args)))
398 "Execute BODY after all FEATURES are loaded." 85 `(progn
399 (declare (indent 1) (debug (form def-body))) 86 (defun ,fn ()
400 (unless (listp features) 87 ,(format "Set local variables after `%s'." hook)
401 (setq features (list features))) 88 (setq-local ,@args))
402 (if (null features) 89 (function-put ',fn 'setq-local-hook-settings ',args)
403 (macroexp-progn body) 90 (add-hook ',hook #',fn))))
404 (let* ((this (car features)) 91
405 (rest (cdr features))) 92(unless (fboundp 'ensure-list)
406 `(with-eval-after-load ',this 93 ;; Just in case we're using an old version of Emacs.
407 (+with-eval-after-loads ,rest ,@body))))) 94 (defun ensure-list (object)
408 95 "Return OBJECT as a list.
409(defun +scratch-buffer (&optional nomode) 96If OBJECT is already a list, return OBJECT itself. If it's
410 "Create a new scratch buffer and switch to it. 97not a list, return a one-element list containing OBJECT."
411If the region is active, paste its contents into the scratch 98 (if (listp object)
412buffer. The scratch buffer inherits the mode of the current 99 object
413buffer unless NOMODE is non-nil. When called interactively, 100 (list object))))
414NOMODE will be set when called with \\[universal-argument]." 101
415 (interactive "P") 102(defun add-to-list* (lists &rest things)
416 (let* ((mode major-mode) 103 "Add THINGS to LISTS.
417 (bufname (generate-new-buffer-name (format "*scratch (%s)*" mode))) 104LISTS can be one list variable or a list.
418 (paste (and (region-active-p) 105Each thing of THINGS can be either a variablel (the thing), or a list of the form
419 (prog1 106(ELEMENT &optional APPEND COMPARE-FN), which is passed to
420 (buffer-substring (mark t) (point)) 107`add-to-list'."
421 (deactivate-mark))))) 108 (dolist (l (ensure-list lists))
422 (when (and (not nomode) 109 (dolist (thing things)
423 (bound-and-true-p ess-dialect)) ; Not sure what `ess-dialect' is 110 (apply #'add-to-list l (ensure-list thing)))))
424 (setq mode (intern-soft (concat ess-dialect "-mode")))) 111
425 ;; Set up buffer 112(defun add-hook* (hooks &rest functions)
426 (switch-to-buffer (get-buffer-create bufname)) 113 "Add FUNCTIONS to HOOKS.
427 (when (and (not nomode) mode) 114Each function in FUNCTIONS can be a singleton or a list of the
428 (ignore-errors (funcall mode))) 115form (FUNCTION &optional DEPTH LOCAL)."
429 (insert (format "%s Scratch buffer for %s%s\n\n" 116 (dolist (hook (ensure-list hooks))
430 comment-start mode comment-end)) 117 (dolist (fn functions)
431 (when paste (insert paste)) 118 (apply #'add-hook hook (ensure-list fn)))))
432 (get-buffer bufname)))
433
434(defun +indent-rigidly (arg &optional interactive)
435 "Indent all lines in the region, or the current line.
436This calls `indent-rigidly' and passes ARG to it."
437 (interactive "P\np")
438 (unless (region-active-p)
439 (push-mark)
440 (push-mark (line-beginning-position) nil t)
441 (goto-char (line-end-position)))
442 (call-interactively #'indent-rigidly))
443
444(defun +sort-lines (reverse beg end)
445 "Sort lines in region, ignoring leading whitespace.
446REVERSE non-nil means descending order; interactively, REVERSE is
447the prefix argument, and BEG and END are the region. The
448variable `sort-fold-case' determines whether case affects the
449sort order."
450 (interactive "P\nr")
451 (save-excursion
452 (save-restriction
453 (narrow-to-region beg end)
454 (goto-char (point-min))
455 (let ((inhibit-field-text-motion t))
456 (sort-subr reverse
457 #'forward-line
458 #'end-of-line
459 #'beginning-of-line-text)))))
460
461(defun +crm-indicator (args)
462 "AROUND advice for `completing-read-multiple'."
463 ;; [[https://github.com/minad/vertico/blob/8ab2cddf3a1fb8799611b1d35118bf579aaf3154/README.org][from vertico's README]]
464 (cons (format "[CRM%s] %s"
465 (replace-regexp-in-string
466 "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" ""
467 crm-separator)
468 (car args))
469 (cdr args)))
470
471
472;;; Timers!
473;; inspired by [[https://git.sr.ht/~protesilaos/tmr/tree/main/item/tmr.el][prot's tmr.el package]]
474
475(defvar +timer-string nil)
476(defvar +timer-timer nil)
477
478(defcustom +timer-running-string "⏰"
479 "What to display when the timer is running."
480 :type 'string)
481(defcustom +timer-done-string "❗"
482 "What to display when the timer is done."
483 :type 'string)
484
485(defun +timer (time)
486 "Set a timer for TIME."
487 (interactive (list (read-string "Set a timer for how long? ")))
488 (let ((secs (cond ((natnump time) (* time 60))
489 ((and (stringp time)
490 (string-match-p "[0-9]\\'" time))
491 (* (string-to-number time) 60))
492 (t (let ((secs 0)
493 (time time))
494 (save-match-data
495 (while (string-match "\\([0-9.]+\\)\\([hms]\\)" time)
496 (cl-incf secs
497 (* (string-to-number (match-string 1 time))
498 (pcase (match-string 2 time)
499 ("h" 3600)
500 ("m" 60)
501 ("s" 1))))
502 (setq time (substring time (match-end 0)))))
503 secs)))))
504 (message "Setting timer for \"%s\" (%S seconds)..." time secs)
505 (setq +timer-string +timer-running-string)
506 (setq +timer-timer (run-with-timer secs nil
507 (lambda ()
508 (message "%S-second timer DONE!" secs)
509 (setq +timer-string +timer-done-string)
510 (let ((visible-bell t)
511 (ring-bell-function nil))
512 (ding))
513 (ding))))))
514
515(defun +timer-cancel ()
516 "Cancel the running timer."
517 (interactive)
518 (cond ((not +timer-timer)
519 (message "No timer found!"))
520 (t
521 (cancel-timer +timer-timer)
522 (message "Timer canceled.")))
523 (setq +timer-string nil))
524
525
526
527(defun +switch-to-last-buffer ()
528 "Switch to the last-used buffer in this window."
529 (interactive)
530 (switch-to-buffer nil))
531
532(provide 'acdw)
533;;; acdw.el ends here
diff --git a/lisp/dawn.el b/lisp/dawn.el deleted file mode 100644 index a184a84..0000000 --- a/lisp/dawn.el +++ /dev/null
@@ -1,74 +0,0 @@
1;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; There is also circadian.el, but it doesn't quite work for me.
6;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
7;; somewhere else (which I've forgotten) and my own brain :)
8
9;;; Code:
10
11(require 'calendar)
12(require 'cl-lib)
13(require 'solar)
14
15(defvar dawn--dawn-timer nil
16 "Timer for dawn-command.")
17
18(defvar dawn--dusk-timer nil
19 "Timer for dusk-command.")
20
21(defvar dawn--reset-timer nil
22 "Timer to reset dawn at midnight.")
23
24(defun dawn-encode-time (f)
25 "Encode fractional time F."
26 (let ((hhmm (cl-floor f))
27 (date (cdddr (decode-time))))
28 (encode-time
29 (append (list 0
30 (round (* 60 (cadr hhmm)))
31 (car hhmm)
32 )
33 date))))
34
35(defun dawn-midnight ()
36 "Return the time of the /next/ midnight."
37 (let ((date (cdddr (decode-time))))
38 (encode-time
39 (append (list 0 0 0 (1+ (car date))) (cdr date)))))
40
41(defun dawn-sunrise ()
42 "Return the time of today's sunrise."
43 (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
44
45(defun dawn-sunset ()
46 "Return the time of today's sunset."
47 (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
48
49(defun dawn-schedule (dawn-command dusk-command)
50 "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
51RESET is an argument for internal use."
52 (let ((dawn (dawn-sunrise))
53 (dusk (dawn-sunset)))
54 (cond
55 ((time-less-p nil dawn)
56 ;; If it isn't dawn yet, it's still dark. Run DUSK-COMMAND and schedule
57 ;; DAWN-COMMAND and DUSK-COMMAND for later.
58 (funcall dusk-command)
59 (run-at-time dawn nil dawn-command)
60 (run-at-time dusk nil dusk-command))
61 ((time-less-p nil dusk)
62 ;; If it isn't dusk yet, it's still light. Run DAWN-COMMAND and schedule
63 ;; DUSK-COMMAND.
64 (funcall dawn-command)
65 (run-at-time dusk nil dusk-command))
66 (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
67 (funcall dusk-command)))
68 ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
69 ;(unless reset)
70 (run-at-time (dawn-midnight) nil
71 #'dawn-schedule dawn-command dusk-command)))
72
73(provide 'dawn)
74;;; dawn.el ends here
diff --git a/lisp/elephant.el b/lisp/elephant.el deleted file mode 100644 index 3cae17a..0000000 --- a/lisp/elephant.el +++ /dev/null
@@ -1,58 +0,0 @@
1;;; elephant.el --- Remember variables and modes -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defmacro elephant-remember (alist)
6 "Setup a closure remembering symbols to apply with
7`remember-reset'. The variables will be renamed using TEMPLATE.
8ALIST contains cells of the form (SYMBOL . NEW-VALUE), where
9SYMBOL is a variable or mode name, and its value is what to set
10after `remember-set'."
11 (unless lexical-binding
12 (user-error "`elephant' requires lexical binding."))
13
14 (let* ((template (format "elephant--%s-%%s" (gensym)))
15 (reset-fn (intern (format template "reset"))))
16 (cl-destructuring-bind (let-list fn-set-list fn-reset-list)
17 (cl-loop
18 for (sym . val) in (if (symbolp alist) (symbol-value alist) alist)
19 as rem = (intern (format template sym))
20
21 collect (list rem sym)
22 into let-list
23
24 collect (cond ((eq val 'enable)
25 `(,sym +1))
26 ((eq val 'disable)
27 `(,sym -1))
28 (t `(setq-local ,sym ,val)))
29 into fn-set-list
30
31 collect (cond ((memq val '(enable disable))
32 `(progn (,sym (if ,rem +1 -1))
33 (fmakunbound ',rem)))
34 (t `(progn (setq-local ,sym ,rem)
35 (makunbound ',rem))))
36 into fn-reset-list
37
38 finally return (list let-list
39 fn-set-list
40 fn-reset-list))
41 `(progn
42 (defvar-local ,reset-fn nil
43 "Function to recall values from `elephant-remember'.")
44 (let ,let-list
45 (setf (symbol-function ',reset-fn)
46 (lambda ()
47 ,@fn-reset-list
48 (redraw-display)
49 (fmakunbound ',reset-fn))))
50 ,@fn-set-list
51 ',reset-fn))))
52
53(defun elephant-forget ()
54 "Forget all symbols generated by `elephant-remember'."
55 )
56
57(provide 'elephant)
58;;; elephant.el ends here
diff --git a/lisp/find-script.el b/lisp/find-script.el deleted file mode 100644 index 9e3633a..0000000 --- a/lisp/find-script.el +++ /dev/null
@@ -1,36 +0,0 @@
1;;; find-script.el --- Find a script in $PATH -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; This package makes it easier to find a script to edit in $PATH. The initial
6;; `rehash-exes' is slow, but it's stored in `*exes*' as a caching mechanism.
7;; However, I'm sure it could be improved.
8
9;; In addition, `*exes*' currently contains /all/ executables in $PATH, which
10;; ... maybe only the ones stored in some text format should be shown.
11
12;;; Code:
13
14(defvar *exes* nil
15 "All the exectuables in $PATH.
16Run `rehash-exes' to refresh this variable.")
17
18(defun rehash-exes ()
19 "List all the executables in $PATH.
20Also sets `*exes*' parameter."
21 (setq *exes*
22 (cl-loop for dir in exec-path
23 append (file-expand-wildcards (concat dir "*"))
24 into exes
25 finally return exes)))
26
27;;;###autoload
28(defun find-script (script)
29 "Find a file in $PATH."
30 (interactive
31 (list (let ((exes (or *exes* (rehash-exes))))
32 (completing-read "Script> " exes nil t))))
33 (find-file script))
34
35(provide 'find-script)
36;;; find-script.el ends here
diff --git a/lisp/gdrive.el b/lisp/gdrive.el deleted file mode 100644 index 41a3660..0000000 --- a/lisp/gdrive.el +++ /dev/null
@@ -1,130 +0,0 @@
1;;; gdrive.el --- Gdrive integration -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2022 Case Duckworth
4
5;; Author: Case Duckworth <case@bob>
6;; Keywords: convenience, data, docs
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;; [[https://github.com/prasmussen/gdrive][gdrive]] is a Go program to interface with Google Drive. This library connects
24;; that to Emacs.
25
26;;; Code:
27
28(require 'cl-lib)
29
30(defgroup gdrive nil
31 "Customizations for Emacs's gdrive module."
32 :group 'applications
33 :prefix "gdrive-")
34
35(defcustom gdrive-bin (executable-find "gdrive")
36 "Where gdrive binary is located."
37 :type 'string)
38
39(defcustom gdrive-buffer "*gdrive*"
40 "Default buffer for gdrive output."
41 :type 'string)
42
43;;; Global flags
44
45;;;; -c, --config <configDir>
46;;;;; Application path, default: /Users/<user>/.gdrive
47(defcustom gdrive-config-dir nil
48 "Application path.")
49
50;;;; --refresh-token <refreshToken>
51;;;;; Oauth refresh token used to get access token (for advanced users)
52(defcustom gdrive-refresh-token nil
53 "Oauth refresh token used to get access token.
54(For advanced users).")
55
56;;;; --access-token <accessToken>
57;;;;; Oauth access token, only recommended for short-lived requests because of
58;;;;; short lifetime (for advanced users)
59(defcustom gdrive-access-token nil
60 "Oauth access token.
61Only recommended for short-lived requests because of short
62lifetime (for advanced users).")
63
64;;;; --service-account <accountFile>
65;;;;; Oauth service account filename, used for server to server communication
66;;;;; without user interaction (file is relative to config dir)
67(defcustom gdrive-service-account nil
68 "Oauth service account filename.
69Used for server to server communication without user
70interaction (file is relative to config dir).")
71
72(defun gdrive--global-arguments ()
73 "Build global arguments for gdrive."
74 (append
75 (when gdrive-config-dir (list "--config" gdrive-config-dir))
76 (when gdrive-refresh-token (list "--refresh-token" gdrive-refresh-token))
77 (when gdrive-access-token (list "--access-token" gdrive-access-token))
78 (when gdrive-service-account (list "--service-account" gdrive-service-account))))
79
80;;; List files
81;; gdrive [global] list [options]
82;;;; -m, --max <maxFiles>
83;;;; Max files to list, default: 30
84;;;; -q, --query <query>
85;;;;; Default query: "trashed = false and 'me' in owners". See https://developers.google.com/drive/search-parameters
86;;;; --order <sortOrder>
87;;;;; Sort order. See https://godoc.org/google.golang.org/api/drive/v3#FilesListCall.OrderBy
88;;;; --name-width <nameWidth>
89;;;;; Width of name column, default: 40, minimum: 9, use 0 for full width
90;; NOTE: gdrive-list will pass 0 for this argument.
91;;;; --absolute Show absolute path to file (will only show path from first parent)
92;;;; --no-header Dont print the header
93;; NOTE: gdrive-list will always pass this argument.
94;;;; --bytes Size in bytes
95(cl-defun gdrive-list (&key max query order absolute no-header bytes)
96 "Run the \"gdrive list\" command.
97MAX is the max files to list; it defaults to 30. QUERY is the
98query to pass; the default is \"trashed = false and 'me' in
99owners\"."
100 (gdrive--run (append (gdrive--global-arguments)
101 (list "list")
102 (when max (list "--max" max))
103 (when query (list "--query" query))
104 (when order (list "--order" order))
105 (list "--name-width" "0")
106 (when absolute (list "--absolute"))
107 (when no-header (list "--no-header"))
108 (when bytes (list "--bytes")))))
109
110
111(defmacro gdrive-query)
112
113
114(defun gdrive--build-command-name (command)
115 "INTERNAL: Build a string name for COMMAND."
116 (concat "gdrive-" (car command)))
117
118(defun gdrive--run (command &optional buffer)
119 "Run 'gdrive COMMAND', collecting results in BUFFER.
120COMMAND, if not a list, will be made a list and appended to
121`gdrive-bin'.
122BUFFER defaults to `gdrive-buffer'."
123 (let ((command (if (listp command) command (list command)))
124 (buffer (or buffer gdrive-buffer)))
125 (make-process :name (gdrive--build-command-name command)
126 :buffer buffer
127 :command (cons gdrive-bin command))))
128
129(provide 'gdrive)
130;;; gdrive.el ends here
diff --git a/lisp/hide-cursor-mode.el b/lisp/hide-cursor-mode.el deleted file mode 100644 index 6325d81..0000000 --- a/lisp/hide-cursor-mode.el +++ /dev/null
@@ -1,116 +0,0 @@
1;;; hide-cursor-mode.el --- Hide the cursor and scroll-lock -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; From Karthik: https://karthinks.com/software/more-less-emacs/
6
7;;; Code:
8
9(defvar-local hide-cursor--original nil)
10
11(progn
12 (progn :autoload-end
13 (defvar-local hide-cursor-mode nil "Non-nil if Hide-Cursor mode is enabled.
14Use the command `hide-cursor-mode' to change this variable."))
15 (defun hide-cursor-mode
16 (&optional arg)
17 "Hide or show the cursor.
18
19This is a minor mode. If called interactively, toggle the
20`Hide-Cursor mode' mode. If the prefix argument is positive,
21enable the mode, and if it is zero or negative, disable the mode.
22
23If called from Lisp, toggle the mode if ARG is `toggle'. Enable
24the mode if ARG is nil, omitted, or is a positive number.
25Disable the mode if ARG is a negative number.
26
27To check whether the minor mode is enabled in the current buffer,
28evaluate `hide-cursor-mode'.
29
30The mode's hook is called both when the mode is enabled and when
31it is disabled.
32
33When the cursor is hidden `scroll-lock-mode' is enabled, so that
34the buffer works like a pager."
35 (interactive
36 (list
37 (if current-prefix-arg
38 (prefix-numeric-value current-prefix-arg)
39 'toggle)))
40 (let
41 ((last-message
42 (current-message)))
43 (setq hide-cursor-mode
44 (cond
45 ((eq arg 'toggle)
46 (not hide-cursor-mode))
47 ((and
48 (numberp arg)
49 (< arg 1))
50 nil)
51 (t t)))
52 (when
53 (boundp 'local-minor-modes)
54 (setq local-minor-modes
55 (delq 'hide-cursor-mode local-minor-modes))
56 (when hide-cursor-mode
57 (push 'hide-cursor-mode local-minor-modes)))
58 (if hide-cursor-mode
59 (progn
60 (scroll-lock-mode 1)
61 (setq-local hide-cursor--original cursor-type)
62 (setq-local cursor-type nil))
63 (scroll-lock-mode -1)
64 (setq-local cursor-type
65 (or hide-cursor--original t)))
66 (run-hooks 'hide-cursor-mode-hook
67 (if hide-cursor-mode 'hide-cursor-mode-on-hook 'hide-cursor-mode-off-hook))
68 (if
69 (called-interactively-p 'any)
70 (progn nil
71 (unless
72 (and
73 (current-message)
74 (not
75 (equal last-message
76 (current-message))))
77 (let
78 ((local " in current buffer"))
79 (message "Hide-Cursor mode %sabled%s"
80 (if hide-cursor-mode "en" "dis")
81 local))))))
82 (force-mode-line-update)
83 hide-cursor-mode)
84 :autoload-end
85 (defvar hide-cursor-mode-hook nil)
86 (unless
87 (get 'hide-cursor-mode-hook 'variable-documentation)
88 (put 'hide-cursor-mode-hook 'variable-documentation "Hook run after entering or leaving `hide-cursor-mode'.
89No problems result if this variable is not bound.
90`add-hook' automatically binds it. (This is true for all hook variables.)"))
91 (put 'hide-cursor-mode-hook 'custom-type 'hook)
92 (put 'hide-cursor-mode-hook 'standard-value
93 (list nil))
94 (defvar hide-cursor-mode-map
95 (let
96 ((m
97 (let
98 ((map
99 (make-sparse-keymap)))
100 (define-key map
101 [f7]
102 (function hide-cursor-mode))
103 map)))
104 (cond
105 ((keymapp m)
106 m)
107 ((listp m)
108 (easy-mmode-define-keymap m))
109 (t
110 (error "Invalid keymap %S" m))))
111 "Keymap for `hide-cursor-mode'.")
112 (with-no-warnings
113 (add-minor-mode 'hide-cursor-mode '"H" hide-cursor-mode-map nil nil)))
114
115(provide 'hide-cursor-mode)
116;;; hide-cursor-mode.el ends here
diff --git a/lisp/long-s-mode.el b/lisp/long-s-mode.el deleted file mode 100644 index 784cb7d..0000000 --- a/lisp/long-s-mode.el +++ /dev/null
@@ -1,67 +0,0 @@
1;;; long-s-mode.el --- Proper typography for Emacs -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; from Catie on #emacs
6
7;;; Code:
8
9(define-minor-mode long-s-mode
10 "Minor mode for inserting 'ſ' characters")
11
12(defconst +long-s+ ?ſ)
13(defconst +short-s+ ?s)
14
15(defun long-s-p (char)
16 (char-equal char +long-s+))
17
18(defun short-s-p (char)
19 (or (char-equal char +short-s+)))
20
21(defun s-char-p (char)
22 (or (long-s-p char)
23 (short-s-p char)))
24
25(defun alpha-char-p (char)
26 (memq (get-char-code-property char 'general-category)
27 '(Ll Lu Lo Lt Lm Mn Mc Me Nl)))
28
29(defun long-s-insert-short-s ()
30 (interactive)
31 (if (long-s-p (preceding-char))
32 (insert-char +short-s+)
33 (insert-char +long-s+)))
34
35(defun long-s-insert-space ()
36 (interactive)
37 (if (long-s-p (preceding-char))
38 (progn (delete-backward-char 1)
39 (insert-char +short-s+))
40 (save-excursion
41 (while (not (alpha-char-p (preceding-char)))
42 (backward-char))
43 (when (long-s-p (preceding-char))
44 (delete-backward-char 1)
45 (insert-char +short-s+))))
46 (insert-char ?\ ))
47
48(defvar long-s-mode-map
49 (let ((map (make-sparse-keymap)))
50 (set-keymap-parent map (current-global-map))
51 (define-key map (kbd "s") #'long-s-insert-short-s)
52 (define-key map (kbd "SPC") #'long-s-insert-space)
53 map))
54
55(setq long-s-mode-map
56 (let ((map (make-sparse-keymap)))
57 (define-key map (kbd "s") #'long-s-insert-short-s)
58 (define-key map (kbd "SPC") #'long-s-insert-space)
59 map))
60
61(unless (seq-some #'(lambda (x) (eq (car x) 'long-s-mode))
62 minor-mode-map-alist)
63 (push (cons 'long-s-mode long-s-mode-map)
64 minor-mode-map-alist))
65
66(provide 'long-s-mode)
67;;; long-s-mode.el ends here
diff --git a/lisp/private.el b/lisp/private.el deleted file mode 100644 index 4f6115e..0000000 --- a/lisp/private.el +++ /dev/null
@@ -1,23 +0,0 @@
1;;; private.el -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'acdw)
8
9(defgroup private nil
10 "Private things are private. Shhhhh....")
11
12;; Private directory
13
14(+define-dir private/ (sync/ "emacs/private")
15 "Private secretive secrets inside.")
16(add-to-list 'load-path private/)
17
18;; Load random private stuff
19
20(require '_acdw)
21
22(provide 'private)
23;;; private.el ends here
diff --git a/lisp/reading.el b/lisp/reading.el deleted file mode 100644 index a0d22f4..0000000 --- a/lisp/reading.el +++ /dev/null
@@ -1,85 +0,0 @@
1;;; reading.el --- minor mode for reading -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(defgroup reading nil
6 "Group for Reading mode customizations."
7 :prefix "reading-"
8 :group 'convenience)
9
10(defcustom reading-vars '((indicate-empty-lines . nil)
11 (indicate-buffer-boundaries . nil))
12 "Alist of variables to set in function `reading-mode'.
13The car of each cell is the variable name, and the cdr is the
14value to set it to."
15 :type '(alist :key-type variable
16 :value-type sexp))
17
18(defcustom reading-modes '((display-fill-column-indicator-mode . -1)
19 (blink-cursor-mode . -1))
20 "Alist of modes to set in function `reading-mode'.
21The car of each cell is the function name, and the cdr is the
22value to call it with."
23 :type '(alist :key-type function
24 :value-type sexp))
25
26;;; Internal
27
28(defvar reading--remembered-template "reading--remembered-%s-value"
29 "The template passed to `format' for remembered modes and variables.")
30
31(defun reading--remember (things func)
32 "Apply FUNC to THINGS, remembering their previous value for later."
33 (declare (indent 1))
34 (unless (listp things)
35 (setq things (list things)))
36 (dolist (thing things)
37 (set (make-local-variable
38 (intern (format reading--remembered-template thing)))
39 (and (boundp thing)
40 (symbol-value thing)))
41 (funcall func thing)))
42
43(defun reading--recall (things func)
44 "Recall previously remembered THINGS by applying FUNC to them.
45FUNC should be a function with the signature (THING REMEMBERED-SETTING)."
46 (declare (indent 1))
47 (unless (listp things)
48 (setq things (list things)))
49 (dolist (thing things)
50 (with-demoted-errors "reading--recall: %S"
51 (let ((value (symbol-value
52 (intern
53 (format reading--remembered-template thing)))))
54 (funcall func thing value)))))
55
56;;; Mode
57
58;;;###autoload
59(defvar reading-mode-map (make-sparse-keymap)
60 "Keymap for `reading-mode'.")
61
62;;;###autoload
63(define-minor-mode reading-mode
64 "A mode for reading."
65 :lighter " Read"
66 (if reading-mode
67 ;; turn on
68 (progn
69 (reading--remember (mapcar #'car reading-vars)
70 (lambda (var)
71 (set (make-local-variable var)
72 (cdr (assoc var reading-vars)))))
73 (reading--remember (mapcar #'car reading-modes)
74 (lambda (mode)
75 (funcall mode (cdr (assoc mode reading-modes))))))
76 ;; turn off
77 (reading--recall (mapcar #'car reading-vars)
78 (lambda (var orig-val)
79 (set (make-local-variable var) orig-val)))
80 (reading--recall (mapcar #'car reading-modes)
81 (lambda (mode orig-setting)
82 (funcall mode (if orig-setting +1 -1))))))
83
84(provide 'reading)
85;;; reading.el ends here
diff --git a/lisp/system.el b/lisp/system.el deleted file mode 100644 index 73cd80b..0000000 --- a/lisp/system.el +++ /dev/null
@@ -1,179 +0,0 @@
1;;; system.el --- Load system-dependendant settings -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;; When using Emacs on multiple computers, some variables and functions need
6;; different definitions. This library is built to assist in working with
7;; different system configurations for Emacs.
8
9;;; TODO:
10
11;; machine.el
12;; machine-case to switch on machine
13;;
14
15;;; Code:
16
17(require 'cl-lib)
18
19(defgroup system nil
20 "System-specific configurations."
21 :group 'emacs
22 :prefix "system-")
23
24;;; Settings
25
26(defcustom system-load-directory (locate-user-emacs-file "systems"
27 "~/.emacs-systems")
28 "The directory where system-specific configurations live."
29 :type 'file)
30
31;; These `defcustom's are best-guess defaults.
32
33(defcustom system-default-font (cond
34 ((memq system-type '(ms-dos windows-nt))
35 "Consolas")
36 (t "monospace"))
37 "The font used for the `default' face.
38Set this in your system files."
39 :type 'string)
40
41(defcustom system-default-height 100
42 "The height used for the `default' face.
43Set this in your system files."
44 :type 'number)
45
46(defcustom system-variable-pitch-font (cond
47 ((memq system-type '(ms-dos windows-nt))
48 "Arial")
49 (t "sans-serif"))
50 "The font used for the `variable-pitch' face.
51Set this in your system files."
52 :type 'string)
53
54(defcustom system-variable-pitch-height 1.0
55 "The height used for the `variable-pitch' face.
56A floating-point number is recommended, since that makes it
57relative to the `default' face height.
58
59Set this in your system files."
60 :type 'number)
61
62(defcustom system-files-order '(:type :name :user)
63 "The order to load `system-files' in.
64The elements of this list correspond to the keys in
65`system-system'."
66 :type '(list (const :tag "System type" :type)
67 (const :tag "System name" :name)
68 (const :tag "Current user" :user)))
69
70;;; Variables
71
72(defvar system-system nil
73 "Plist of systems that Emacs is in.
74The keys are as follows:
75
76- :name - `system-name'
77- :type - `system-type'
78- :user - `user-login-name'
79
80Each value is made safe to be a file name by passing through
81`system--safe'.
82
83Do not edit this by hand. Instead, call `system-get-systems'.")
84
85(defvar system-files nil
86 "List of files to load for system-specific configuration.
87Do not edit this by hand. Instead, call `system-get-system-files'.")
88
89
90;;; Functions
91
92(defun system--warn (message &rest args)
93 "Display a system-file warning message.
94This function is like `warn', except it uses a `system' type."
95 (display-warning 'system (apply #'format-message message args)))
96
97(defun system--safe (str)
98 "Make STR safe for a file name."
99 (let ((bad-char-regexp ))
100 (downcase (string-trim
101 (replace-regexp-in-string "[#%&{}\$!'\":@<>*?/ \r\n\t+`|=]+"
102 "-" str)
103 "-" "-"))))
104
105(defun system-get-systems ()
106 "Determine the current system(s).
107This system updates `system-system', which see."
108 ;; Add system-name
109 (setf (plist-get system-system :name)
110 (intern (system--safe (system-name))))
111 ;; Add system-type
112 (setf (plist-get system-system :type)
113 (intern (system--safe (symbol-name system-type))))
114 ;; Add current user
115 (setf (plist-get system-system :user)
116 ;; Use `user-real-login-name' in case Emacs gets called under su.
117 (intern (system--safe (user-real-login-name))))
118 system-system)
119
120(defun system-get-files ()
121 "Determine the current systems' load-files.
122The system load-files should live in `system-load-directory', and
123named using either the raw name given by the values of
124`system-system', or that name prepended with the type, e.g.,
125\"name-bob.el\", for a system named \"bob\".
126
127The second form of file-name is to work around name collisions,
128e.g. if a there's a user named \"bob\" and a system named
129\"bob\".
130
131This function updates `system-files'."
132 ;; Get systems
133 (system-get-systems)
134 ;; Re-set `system-files'
135 (setq system-files nil)
136
137 (let (ret)
138 (dolist (key (reverse system-files-order))
139 (let* ((val (plist-get system-system key))
140 (key-val (intern (system--safe (format "%s-%s" key val)))))
141 (push (list key-val val) ret)))
142
143 ;; Update `system-files'.
144 (setq system-files ret)))
145
146;;;###autoload
147(defun system-settings-load (&optional error nomessage)
148 "Load system settings from `system-files'.
149Each list in `system-files' will be considered item-by-item; the
150first found file in each will be loaded.
151
152ERROR determines how to deal with errors: if nil, warn the user
153when no system-files can be found or when the system being used
154cannot be determined. If t, these warnings are elevated to
155errors. Any other value ignores the warnings completely.
156
157NOMESSAGE is passed directly to `load'."
158 (system-get-files)
159 (if system-files
160 (let (files-loaded)
161 (dolist (ss system-files)
162 (catch :done
163 (dolist (s ss)
164 (let ((fn (expand-file-name (format "%s" s)
165 system-load-directory)))
166 (when (load fn t nomessage)
167 (push fn files-loaded)
168 (throw :done nil))))))
169 (unless files-loaded
170 (cond ((eq error t) (error "Error loading system-files.")
171 (null error) (system--warn "Couldn't load system-files."))))
172 files-loaded)
173 (funcall (cond ((eq error t) #'error)
174 ((null error) #'system--warn)
175 (t #'ignore))
176 "Couldn't determine the system being used.")))
177
178(provide 'system)
179;;; system.el ends here
diff --git a/lisp/user-save.el b/lisp/user-save.el deleted file mode 100644 index 674abac..0000000 --- a/lisp/user-save.el +++ /dev/null
@@ -1,137 +0,0 @@
1;;; user-save.el --- Do things when explicitly saving files -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021--2022 Case Duckworth <acdw@acdw.net>
4;; URL: ...
5;; Version: 0.1.0
6;; Package-Requires: ((emacs "24.3"))
7;; Keywords: files
8
9;;; Commentary:
10
11;; Because `super-save-mode' automatically saves every time we move away from a
12;; buffer, it tends to run a lot of `before-save-hook's that don't need to be
13;; run that often. For that reason, I'm writing a mode where C-x C-s saves
14;; /and/ runs all the "real" before-save-hooks, so that super-save won't
15;; automatically do things like format the buffer all the time.
16
17;;; Code:
18
19(require 'cl-lib)
20
21(defgroup user-save nil
22 "Group for `user-save-mode' customizations."
23 :group 'files
24 :prefix "user-save-")
25
26(defcustom user-save-hook-into-kill-emacs nil
27 "Add a hook to perform `user-save' to `kill-emacs-hook'.
28This option is only useful is `user-save-mode' is active when
29Emacs is killed."
30 :type 'boolean)
31
32(defcustom user-save-inhibit-modes '(special-mode)
33 "List of modes to inhibit `user-save-mode' from activation in."
34 :type '(repeat symbol))
35
36(defcustom user-save-inhibit-predicates '(user-save-non-file-buffer-p)
37 "List of predicates to inhibit `user-save-mode' from activation.
38Each predicate will be called with no arguments, and if it
39returns t, will inhibit `user-save-mode' from activating."
40 :type '(repeat function))
41
42(defcustom user-save-before-save-hook nil
43 "Hook to run before the user, not Emacs, saves the buffer."
44 :type 'hook)
45
46(defcustom user-save-after-save-hook nil
47 "Hook to run after the user, not Emacs, saves the buffer."
48 :type 'hook)
49
50(defvar user-save-mode-map (let ((map (make-sparse-keymap)))
51 (define-key map (kbd "C-x C-s") #'user-save-buffer)
52 (define-key map (kbd "C-x s") #'user-save-some-buffers)
53 map)
54 "Keymap for `user-save-mode'.
55This map shadows the default map for `save-buffer'.")
56
57(defun user-save-run-hooks (which &rest _)
58 "Run the hooks in one of the user-save-hooks.
59If WHICH is `'before', run `user-save-before-save-hook';
60if it's `after', run `user-save-after-save-hook'.
61This does /not/ also save the buffer."
62 (with-demoted-errors "User-save-hook error: %S"
63 (run-hooks (intern (format "user-save-%s-save-hook" which)))))
64
65(defun user-save-non-file-buffer-p (&optional buffer-or-name)
66 "Return whether BUFFER-OR-NAME is a non-file buffer.
67BUFFER-OR-NAME, if omitted, defaults to the current buffer."
68 (with-current-buffer (or buffer-or-name (current-buffer))
69 (not (buffer-file-name))))
70
71(defun user-save-buffer (&optional arg)
72 "Save current buffer in visited file if modified.
73This function is precisely the same as `save-buffer', but with
74one modification: it also runs functions in `user-save-hook'.
75This means that if you have some functionality in Emacs to
76automatically save buffers periodically, but have hooks you want
77to automatically run when the buffer saves that are
78computationally expensive or just aren't something you want to
79run all the time, put them in `user-save-hook'.
80
81ARG is passed directly to `save-buffer'."
82 (interactive '(called-interactively))
83 (message "User-Saving the buffer...")
84 (user-save-run-hooks 'before)
85 (save-buffer arg)
86 (user-save-run-hooks 'after)
87 (message "User-Saving the buffer...Done."))
88
89(defun user-save-some-buffers (&optional pred)
90 "Save some buffers as though the user saved them.
91This function does not ask the user about each buffer, but PRED
92is used in almost the same way as `save-some-buffers': if it's
93nil or t, it will save all file-visiting modified buffers; if
94it's a zero-argument function, that will be called to determine
95whether the buffer needs to be saved."
96 ;; This could maybe be much better.
97 (interactive "P")
98 (unless pred (setq pred save-some-buffers-default-predicate))
99 (dolist (buf (buffer-list))
100 (with-current-buffer buf
101 (when (and (buffer-modified-p)
102 (buffer-file-name)
103 (or (null pred)
104 (if (functionp pred) (funcall pred) pred)))
105 (user-save-buffer)))))
106
107;;;###autoload
108(define-minor-mode user-save-mode
109 "Mode to enable an an extra user-save hook."
110 :lighter " US"
111 :keymap user-save-mode-map)
112
113;;;###autoload
114(defun user-save-mode-disable ()
115 "Turn off `user-save-mode' in the current buffer."
116 (user-save-mode -1))
117
118;;;###autoload
119(defun user-save-mode-in-some-buffers ()
120 "Enable `user-save-mode', but only in some buffers.
121The mode will not be enabled in buffers derived from modes in
122`user-save-inhibit-modes', those for which
123`user-save-inhibit-predicates' return t, or in the minibuffer."
124 (unless (or (minibufferp)
125 (cl-some #'derived-mode-p user-save-inhibit-modes)
126 (run-hook-with-args-until-failure 'user-save-inhibit-predicates))
127 (user-save-mode +1)))
128
129;;;###autoload
130(define-globalized-minor-mode user-save-global-mode user-save-mode user-save-mode-in-some-buffers
131 (if user-save-global-mode
132 (when user-save-hook-into-kill-emacs
133 (add-hook 'kill-emacs-hook #'user-save-some-buffers))
134 (remove-hook 'kill-emacs-hook #'user-save-some-buffers)))
135
136(provide 'user-save)
137;;; user-save.el ends here
diff --git a/lisp/yoke.el b/lisp/yoke.el new file mode 100644 index 0000000..2673e5e --- /dev/null +++ b/lisp/yoke.el
@@ -0,0 +1,125 @@
1;;; yoke.el --- yoke packages in to your editing system -*- lexical-binding: t; -*-
2;; by C. Duckworth <acdw@acdw.net>
3(provide 'yoke)
4(require 'cl-lib)
5
6(defgroup yoke nil
7 "Customizations for yoke, a package manager thing."
8 :group 'applications
9 :prefix "yoke-")
10
11(defcustom yoke-dir (locate-user-emacs-file "yoke")
12 "Where yoke packages live."
13 :type 'file)
14
15(defun yoke-repo-local-p (repo)
16 (string-match-p (rx bos (or "." "~" "/")) repo))
17
18(defun yoke-repo-dir (pkg repo)
19 (if (yoke-repo-local-p repo)
20 (expand-file-name repo)
21 (expand-file-name (format "%s" pkg) yoke-dir)))
22
23(defun yoke-git (repo &optional dir)
24 "Git REPO from the internet and put it into `yoke-dir'.
25If DIR is passed, clone there; otherwise just clone. Return the
26directory created."
27 (let ((dir (or dir (yoke-repo-dir (file-name-nondirectory repo) repo))))
28 (unless (or (yoke-repo-local-p repo) (file-exists-p dir))
29 (message "Downloading %S..." repo)
30 (call-process "git" nil (get-buffer-create "*yoke*") nil
31 "clone" repo dir)
32 (message "Downloading %S... done" repo))
33 dir))
34
35(defun yoke-lasso (pkg repo)
36 "Add PKG to `load-path' so it can be used.
37If PKG is not installed, install it from REPO. Packages will be
38installed to `yoke-dir'."
39 (let* ((dir (yoke-repo-dir pkg repo)))
40 (yoke-git repo dir)
41 (cond
42 ((file-exists-p dir)
43 (add-to-list 'load-path dir)
44 ;; This bit is stolen from `straight'.
45 (eval-and-compile (require 'autoload))
46 (let ((generated-autoload-file
47 (expand-file-name (format "%s-autoloads.el" pkg) dir))
48 (backup-inhibited t)
49 (version-control 'never)
50 (message-log-max nil)
51 (inhibit-message t))
52 (unless (file-exists-p generated-autoload-file)
53 (let ((find-file-hook nil)
54 (write-file-functions nil)
55 (debug-on-error nil)
56 (left-margin 0))
57 (if (fboundp 'make-directory-autoloads)
58 (make-directory-autoloads dir generated-autoload-file)
59 (and (fboundp 'update-directory-autoloads)
60 (update-directory-autoloads dir)))))
61 (when-let ((buf (find-buffer-visiting generated-autoload-file)))
62 (kill-buffer buf))
63 (load generated-autoload-file :noerror :nomessage)))
64 (t (user-error "Directory \"%s\" doesn't exist." dir)))
65 dir))
66
67(defun yoke-get (key args)
68 "Get KEY's value from ARGS, or return nil.
69Similar-ish to `plist-get', but works on non-proper plists."
70 (cond
71 ((null args) nil)
72 ((eq key (car args)) (cadr args))
73 (t (yoke-get key (cdr args)))))
74
75(defmacro when1 (test &rest body)
76 "Like `when', but return the value of the test."
77 (declare (indent 1))
78 (let ((g (gensym)))
79 `(let ((,g ,test))
80 (when ,g
81 ,@body
82 ,g))))
83
84(defun delete2 (list &rest elems)
85 "Delete ELEM and the next item from LIST."
86 (let ((r nil))
87 (while (consp list)
88 (if (member (car list) elems)
89 (setq list (cdr list))
90 (setq r (cons (car list) r)))
91 (setq list (cdr list)))
92 (reverse r)))
93
94(defun yoke-pkg-name (pkg)
95 (intern (format "yoke:%s" pkg)))
96
97(cl-defmacro yoke (pkg
98 &optional repo
99 &body body
100 &key
101 requires ; :requires ((PKG REPO)...)
102 dest ; :dest DESTINATION
103 (when t whenp) ; :when PREDICATE
104 (unless nil unlessp) ; :unless PREDICATE
105 &allow-other-keys)
106 "Yoke a PKG into your Emacs session."
107 (declare (indent defun))
108 (let ((name (yoke-pkg-name pkg)))
109 `(cl-block ,name
110 (condition-case e
111 (let ((*yoke-name* ',name)
112 (*yoke-repo* ,repo)
113 (*yoke-dest* ,(when repo `(yoke-repo-dir ',pkg ,repo))))
114 ,@(list (cond
115 ((and whenp unlessp)
116 `(when (or (not ,when) ,unless)
117 (cl-return-from ,name nil)))
118 (whenp `(unless ,when (cl-return-from ,name nil)))
119 (unlessp `(when ,unless (cl-return-from ,name nil)))))
120 ,@(cl-loop for (pkg repo) in requires
121 collect `(or (yoke-lasso ',pkg ,repo)
122 (cl-return-from ,name nil)))
123 ,@(when repo `((yoke-lasso ',pkg ,repo)))
124 ,@(delete2 body :requires :when :unless))
125 (t (message "%s: %S" ',name e))))))
diff --git a/machines/bob.el b/machines/bob.el deleted file mode 100644 index a408e5c..0000000 --- a/machines/bob.el +++ /dev/null
@@ -1,69 +0,0 @@
1;;; bob.el --- Customizations for "bob" -*- lexical-binding: t; -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'acdw)
8(require 'machine)
9
10(defcustom +bob-face-plist
11 '( :dejavu ("DejaVu Sans Mono" "DejaVu Sans")
12 :iosevka ("Iosevka Comfy Wide" "Iosevka Comfy Duo")
13 :plex ("IBM Plex Mono" "IBM Plex Serif")
14 :go/djv ("Go Mono" "DejaVu Sans")
15 :tt (("TT2020Base" 120) "TT2020 Base Style E") ; no italic
16 :courier ("Courier Prime Code" "Courier Prime")
17 :gaegu (("Gaegu" 140) "Gaegu") ; no italic
18 :comic (("Comic Code" 100) "Comic Code")
19 :comic/fantasque (("Comic Code" 100) "Fantasque Sans Mono")
20 :terminus (("Terminus (TTF)" 120) "Terminus (TTF)")
21 :cmu (("CMU Typewriter Text" 160) "CMU Concrete")
22 :apl (("APL386 Unicode" 120) "Comic Code")
23 )
24 "A plist of possible font combinations.")
25
26(defcustom +bob-face-pair :comic ;; (+bob-set-faces)
27 "The index of `+bob-face-pairs' to use.")
28
29(defun +bob-set-faces (&rest _)
30 (let* ((face-pair (plist-get +bob-face-plist +bob-face-pair))
31 (base-face (if (stringp (car face-pair))
32 (car face-pair)
33 (caar face-pair)))
34 (var-face (if (stringp (cadr face-pair))
35 (cadr face-pair)
36 (caadr face-pair)))
37 (base-size (or (ignore-errors (cadar face-pair))
38 100))
39 (var-size (or (ignore-errors (cadadr face-pair))
40 1.0))
41 (italic-face nil)
42 ;; (bold-face nil)
43 (mono-face nil))
44 (+set-faces
45 `((default
46 :family ,base-face
47 :height ,base-size
48 :weight regular)
49 (bold :family ,(or (bound-and-true-p bold-face) base-face)
50 :weight extra-bold)
51 (italic :family ,(or (bound-and-true-p italic-face) base-face)
52 :weight normal
53 :slant italic)
54 (fixed-pitch :family ,(or (bound-and-true-p mono-face) base-face)
55 :height 1.0)
56 (variable-pitch
57 :family ,(or var-face base-face)
58 :height ,var-size
59 ;; :weight medium
60 )
61 ;; (org-italic
62 ;; :family ,(or var-face base-face)
63 ;; :slant italic)
64 ))))
65
66;; Other ideas: [[https://twitter.com/NPRougier/status/1488570192561160195][from Nic Rougier]]
67(add-hook 'machine-after-load-theme-hook #'+bob-set-faces)
68
69;; bob.el ends here (+bob-set-faces)
diff --git a/machines/gnu-linux.el b/machines/gnu-linux.el deleted file mode 100644 index 309ca34..0000000 --- a/machines/gnu-linux.el +++ /dev/null
@@ -1,5 +0,0 @@
1;;; linux.el -*- lexical-binding: t; -*-
2
3(setq machine-default-height 105)
4
5;;; linux.el ends here
diff --git a/machines/larry.el b/machines/larry.el deleted file mode 100644 index ba4edb2..0000000 --- a/machines/larry.el +++ /dev/null
@@ -1,13 +0,0 @@
1;;; larry.el --- Customizations for "larry" -*- lexical-binding: t; -*-
2
3;;; Code:
4
5(require 'acdw)
6(require 'machine)
7
8(add-function :after machine-after-load-theme
9 (defun +larry-set-faces (&rest _)
10 (+set-faces
11 `((default :family "DejaVu Sans Mono")
12 (fixed-pitch :family "DejaVu Sans Mono")
13 (variable-pitch :family "DejaVu Sans")))))
diff --git a/machines/windows-nt.el b/machines/windows-nt.el deleted file mode 100644 index a95754e..0000000 --- a/machines/windows-nt.el +++ /dev/null
@@ -1,23 +0,0 @@
1;;; windows.el --- Windows settings! -*- lexical-binding: t; -*-
2
3;; Annoying gnu-tls bug; I "always" trust the certificate anyway, so let's be
4;; insecure.
5(setq network-security-level 'low
6 debug-on-error t)
7
8;; Fonts
9
10(setq machine-default-font "Cascadia Mono"
11 machine-default-height 90
12 machine-variable-pitch-font "Carlito"
13 machine-variable-pitch-height 1.2)
14
15;; Add C:\Program Files\* and C:\Program Files (x86)\* to exec-path
16(dolist (path (append (file-expand-wildcards "C:/Program Files/*")
17 (file-expand-wildcards "c:/Program Files (x86)/*")
18 ;; Others...
19 (save-match-data
20 (split-string (getenv "PATH") ";" t))))
21 (add-to-list 'exec-path path :append))
22
23;;; windows.el ends here
diff --git a/readme.md b/readme.md deleted file mode 100644 index 6573e43..0000000 --- a/readme.md +++ /dev/null
@@ -1,8 +0,0 @@
1# ~/.emacs
2
3This is my Emacs config. There are many like it, but this one is mine.
4
5## interesting bits
6
7Check out the `lisp/` folder, there's a bunch of cool stuff there. My
8`early-init.el` is pretty static, but interesting stuff happens in `init.el`.
diff --git a/snippets/emacs-lisp-mode/+feature b/snippets/emacs-lisp-mode/+feature deleted file mode 100644 index 1b8a721..0000000 --- a/snippets/emacs-lisp-mode/+feature +++ /dev/null
@@ -1,14 +0,0 @@
1# -*- mode: snippet -*-
2# name: +feature
3# key: +f
4# --
5;;; `(file-name-nondirectory (buffer-file-name))` --- ${1:Title} -*- lexical-binding: t; -*-
6
7;;; Commentary:
8
9;;; Code:
10
11$0
12
13(provide '`(file-name-nondirectory (file-name-sans-extension (buffer-file-name)))`)
14;;; `(file-name-nondirectory (buffer-file-name))` ends here \ No newline at end of file
diff --git a/snippets/fundamental-mode/gpl3 b/snippets/fundamental-mode/gpl3 deleted file mode 100644 index 2e02b3d..0000000 --- a/snippets/fundamental-mode/gpl3 +++ /dev/null
@@ -1,677 +0,0 @@
1# key: gpl3
2# name: gpl3
3# --
4GNU GENERAL PUBLIC LICENSE
5Version 3, 29 June 2007
6
7Copyright (C) ${1:`(format-time-string "%Y")`} ${2:`user-full-name`} <${3:`user-mail-address`}>
8Everyone is permitted to copy and distribute verbatim copies
9of this license document, but changing it is not allowed.
10
11Preamble
12
13The GNU General Public License is a free, copyleft license for
14software and other kinds of works.
15
16The licenses for most software and other practical works are designed
17to take away your freedom to share and change the works. By contrast,
18the GNU General Public License is intended to guarantee your freedom to
19share and change all versions of a program--to make sure it remains free
20software for all its users. We, the Free Software Foundation, use the
21GNU General Public License for most of our software; it applies also to
22any other work released this way by its authors. You can apply it to
23your programs, too.
24
25When we speak of free software, we are referring to freedom, not
26price. Our General Public Licenses are designed to make sure that you
27have the freedom to distribute copies of free software (and charge for
28them if you wish), that you receive source code or can get it if you
29want it, that you can change the software or use pieces of it in new
30free programs, and that you know you can do these things.
31
32To protect your rights, we need to prevent others from denying you
33these rights or asking you to surrender the rights. Therefore, you have
34certain responsibilities if you distribute copies of the software, or if
35you modify it: responsibilities to respect the freedom of others.
36
37For example, if you distribute copies of such a program, whether
38gratis or for a fee, you must pass on to the recipients the same
39freedoms that you received. You must make sure that they, too, receive
40or can get the source code. And you must show them these terms so they
41know their rights.
42
43Developers that use the GNU GPL protect your rights with two steps:
44(1) assert copyright on the software, and (2) offer you this License
45giving you legal permission to copy, distribute and/or modify it.
46
47For the developers' and authors' protection, the GPL clearly explains
48that there is no warranty for this free software. For both users' and
49authors' sake, the GPL requires that modified versions be marked as
50changed, so that their problems will not be attributed erroneously to
51authors of previous versions.
52
53Some devices are designed to deny users access to install or run
54modified versions of the software inside them, although the manufacturer
55can do so. This is fundamentally incompatible with the aim of
56protecting users' freedom to change the software. The systematic
57pattern of such abuse occurs in the area of products for individuals to
58use, which is precisely where it is most unacceptable. Therefore, we
59have designed this version of the GPL to prohibit the practice for those
60products. If such problems arise substantially in other domains, we
61stand ready to extend this provision to those domains in future versions
62of the GPL, as needed to protect the freedom of users.
63
64Finally, every program is threatened constantly by software patents.
65States should not allow patents to restrict development and use of
66software on general-purpose computers, but in those that do, we wish to
67avoid the special danger that patents applied to a free program could
68make it effectively proprietary. To prevent this, the GPL assures that
69patents cannot be used to render the program non-free.
70
71The precise terms and conditions for copying, distribution and
72modification follow.
73
74TERMS AND CONDITIONS
75
760. Definitions.
77
78"This License" refers to version 3 of the GNU General Public License.
79
80"Copyright" also means copyright-like laws that apply to other kinds of
81works, such as semiconductor masks.
82
83"The Program" refers to any copyrightable work licensed under this
84License. Each licensee is addressed as "you". "Licensees" and
85"recipients" may be individuals or organizations.
86
87To "modify" a work means to copy from or adapt all or part of the work
88in a fashion requiring copyright permission, other than the making of an
89exact copy. The resulting work is called a "modified version" of the
90earlier work or a work "based on" the earlier work.
91
92A "covered work" means either the unmodified Program or a work based
93on the Program.
94
95To "propagate" a work means to do anything with it that, without
96permission, would make you directly or secondarily liable for
97infringement under applicable copyright law, except executing it on a
98computer or modifying a private copy. Propagation includes copying,
99distribution (with or without modification), making available to the
100public, and in some countries other activities as well.
101
102To "convey" a work means any kind of propagation that enables other
103parties to make or receive copies. Mere interaction with a user through
104a computer network, with no transfer of a copy, is not conveying.
105
106An interactive user interface displays "Appropriate Legal Notices"
107to the extent that it includes a convenient and prominently visible
108feature that (1) displays an appropriate copyright notice, and (2)
109tells the user that there is no warranty for the work (except to the
110extent that warranties are provided), that licensees may convey the
111work under this License, and how to view a copy of this License. If
112the interface presents a list of user commands or options, such as a
113menu, a prominent item in the list meets this criterion.
114
1151. Source Code.
116
117The "source code" for a work means the preferred form of the work
118for making modifications to it. "Object code" means any non-source
119form of a work.
120
121A "Standard Interface" means an interface that either is an official
122standard defined by a recognized standards body, or, in the case of
123interfaces specified for a particular programming language, one that
124is widely used among developers working in that language.
125
126The "System Libraries" of an executable work include anything, other
127than the work as a whole, that (a) is included in the normal form of
128packaging a Major Component, but which is not part of that Major
129Component, and (b) serves only to enable use of the work with that
130Major Component, or to implement a Standard Interface for which an
131implementation is available to the public in source code form. A
132"Major Component", in this context, means a major essential component
133(kernel, window system, and so on) of the specific operating system
134(if any) on which the executable work runs, or a compiler used to
135produce the work, or an object code interpreter used to run it.
136
137The "Corresponding Source" for a work in object code form means all
138the source code needed to generate, install, and (for an executable
139work) run the object code and to modify the work, including scripts to
140control those activities. However, it does not include the work's
141System Libraries, or general-purpose tools or generally available free
142programs which are used unmodified in performing those activities but
143which are not part of the work. For example, Corresponding Source
144includes interface definition files associated with source files for
145the work, and the source code for shared libraries and dynamically
146linked subprograms that the work is specifically designed to require,
147such as by intimate data communication or control flow between those
148subprograms and other parts of the work.
149
150The Corresponding Source need not include anything that users
151can regenerate automatically from other parts of the Corresponding
152Source.
153
154The Corresponding Source for a work in source code form is that
155same work.
156
1572. Basic Permissions.
158
159All rights granted under this License are granted for the term of
160copyright on the Program, and are irrevocable provided the stated
161conditions are met. This License explicitly affirms your unlimited
162permission to run the unmodified Program. The output from running a
163covered work is covered by this License only if the output, given its
164content, constitutes a covered work. This License acknowledges your
165rights of fair use or other equivalent, as provided by copyright law.
166
167You may make, run and propagate covered works that you do not
168convey, without conditions so long as your license otherwise remains
169in force. You may convey covered works to others for the sole purpose
170of having them make modifications exclusively for you, or provide you
171with facilities for running those works, provided that you comply with
172the terms of this License in conveying all material for which you do
173not control copyright. Those thus making or running the covered works
174for you must do so exclusively on your behalf, under your direction
175and control, on terms that prohibit them from making any copies of
176your copyrighted material outside their relationship with you.
177
178Conveying under any other circumstances is permitted solely under
179the conditions stated below. Sublicensing is not allowed; section 10
180makes it unnecessary.
181
1823. Protecting Users' Legal Rights From Anti-Circumvention Law.
183
184No covered work shall be deemed part of an effective technological
185measure under any applicable law fulfilling obligations under article
18611 of the WIPO copyright treaty adopted on 20 December 1996, or
187similar laws prohibiting or restricting circumvention of such
188measures.
189
190When you convey a covered work, you waive any legal power to forbid
191circumvention of technological measures to the extent such circumvention
192is effected by exercising rights under this License with respect to
193the covered work, and you disclaim any intention to limit operation or
194modification of the work as a means of enforcing, against the work's
195users, your or third parties' legal rights to forbid circumvention of
196technological measures.
197
1984. Conveying Verbatim Copies.
199
200You may convey verbatim copies of the Program's source code as you
201receive it, in any medium, provided that you conspicuously and
202appropriately publish on each copy an appropriate copyright notice;
203keep intact all notices stating that this License and any
204non-permissive terms added in accord with section 7 apply to the code;
205keep intact all notices of the absence of any warranty; and give all
206recipients a copy of this License along with the Program.
207
208You may charge any price or no price for each copy that you convey,
209and you may offer support or warranty protection for a fee.
210
2115. Conveying Modified Source Versions.
212
213You may convey a work based on the Program, or the modifications to
214produce it from the Program, in the form of source code under the
215terms of section 4, provided that you also meet all of these conditions:
216
217a) The work must carry prominent notices stating that you modified
218it, and giving a relevant date.
219
220b) The work must carry prominent notices stating that it is
221released under this License and any conditions added under section
2227. This requirement modifies the requirement in section 4 to
223"keep intact all notices".
224
225c) You must license the entire work, as a whole, under this
226License to anyone who comes into possession of a copy. This
227License will therefore apply, along with any applicable section 7
228additional terms, to the whole of the work, and all its parts,
229regardless of how they are packaged. This License gives no
230permission to license the work in any other way, but it does not
231invalidate such permission if you have separately received it.
232
233d) If the work has interactive user interfaces, each must display
234Appropriate Legal Notices; however, if the Program has interactive
235interfaces that do not display Appropriate Legal Notices, your
236work need not make them do so.
237
238A compilation of a covered work with other separate and independent
239works, which are not by their nature extensions of the covered work,
240and which are not combined with it such as to form a larger program,
241in or on a volume of a storage or distribution medium, is called an
242"aggregate" if the compilation and its resulting copyright are not
243used to limit the access or legal rights of the compilation's users
244beyond what the individual works permit. Inclusion of a covered work
245in an aggregate does not cause this License to apply to the other
246parts of the aggregate.
247
2486. Conveying Non-Source Forms.
249
250You may convey a covered work in object code form under the terms
251of sections 4 and 5, provided that you also convey the
252machine-readable Corresponding Source under the terms of this License,
253in one of these ways:
254
255a) Convey the object code in, or embodied in, a physical product
256(including a physical distribution medium), accompanied by the
257Corresponding Source fixed on a durable physical medium
258customarily used for software interchange.
259
260b) Convey the object code in, or embodied in, a physical product
261(including a physical distribution medium), accompanied by a
262written offer, valid for at least three years and valid for as
263long as you offer spare parts or customer support for that product
264model, to give anyone who possesses the object code either (1) a
265copy of the Corresponding Source for all the software in the
266product that is covered by this License, on a durable physical
267medium customarily used for software interchange, for a price no
268more than your reasonable cost of physically performing this
269conveying of source, or (2) access to copy the
270Corresponding Source from a network server at no charge.
271
272c) Convey individual copies of the object code with a copy of the
273written offer to provide the Corresponding Source. This
274alternative is allowed only occasionally and noncommercially, and
275only if you received the object code with such an offer, in accord
276with subsection 6b.
277
278d) Convey the object code by offering access from a designated
279place (gratis or for a charge), and offer equivalent access to the
280Corresponding Source in the same way through the same place at no
281further charge. You need not require recipients to copy the
282Corresponding Source along with the object code. If the place to
283copy the object code is a network server, the Corresponding Source
284may be on a different server (operated by you or a third party)
285that supports equivalent copying facilities, provided you maintain
286clear directions next to the object code saying where to find the
287Corresponding Source. Regardless of what server hosts the
288Corresponding Source, you remain obligated to ensure that it is
289available for as long as needed to satisfy these requirements.
290
291e) Convey the object code using peer-to-peer transmission, provided
292you inform other peers where the object code and Corresponding
293Source of the work are being offered to the general public at no
294charge under subsection 6d.
295
296A separable portion of the object code, whose source code is excluded
297from the Corresponding Source as a System Library, need not be
298included in conveying the object code work.
299
300A "User Product" is either (1) a "consumer product", which means any
301tangible personal property which is normally used for personal, family,
302or household purposes, or (2) anything designed or sold for incorporation
303into a dwelling. In determining whether a product is a consumer product,
304doubtful cases shall be resolved in favor of coverage. For a particular
305product received by a particular user, "normally used" refers to a
306typical or common use of that class of product, regardless of the status
307of the particular user or of the way in which the particular user
308actually uses, or expects or is expected to use, the product. A product
309is a consumer product regardless of whether the product has substantial
310commercial, industrial or non-consumer uses, unless such uses represent
311the only significant mode of use of the product.
312
313"Installation Information" for a User Product means any methods,
314procedures, authorization keys, or other information required to install
315and execute modified versions of a covered work in that User Product from
316a modified version of its Corresponding Source. The information must
317suffice to ensure that the continued functioning of the modified object
318code is in no case prevented or interfered with solely because
319modification has been made.
320
321If you convey an object code work under this section in, or with, or
322specifically for use in, a User Product, and the conveying occurs as
323part of a transaction in which the right of possession and use of the
324User Product is transferred to the recipient in perpetuity or for a
325fixed term (regardless of how the transaction is characterized), the
326Corresponding Source conveyed under this section must be accompanied
327by the Installation Information. But this requirement does not apply
328if neither you nor any third party retains the ability to install
329modified object code on the User Product (for example, the work has
330been installed in ROM).
331
332The requirement to provide Installation Information does not include a
333requirement to continue to provide support service, warranty, or updates
334for a work that has been modified or installed by the recipient, or for
335the User Product in which it has been modified or installed. Access to a
336network may be denied when the modification itself materially and
337adversely affects the operation of the network or violates the rules and
338protocols for communication across the network.
339
340Corresponding Source conveyed, and Installation Information provided,
341in accord with this section must be in a format that is publicly
342documented (and with an implementation available to the public in
343source code form), and must require no special password or key for
344unpacking, reading or copying.
345
3467. Additional Terms.
347
348"Additional permissions" are terms that supplement the terms of this
349License by making exceptions from one or more of its conditions.
350Additional permissions that are applicable to the entire Program shall
351be treated as though they were included in this License, to the extent
352that they are valid under applicable law. If additional permissions
353apply only to part of the Program, that part may be used separately
354under those permissions, but the entire Program remains governed by
355this License without regard to the additional permissions.
356
357When you convey a copy of a covered work, you may at your option
358remove any additional permissions from that copy, or from any part of
359it. (Additional permissions may be written to require their own
360removal in certain cases when you modify the work.) You may place
361additional permissions on material, added by you to a covered work,
362for which you have or can give appropriate copyright permission.
363
364Notwithstanding any other provision of this License, for material you
365add to a covered work, you may (if authorized by the copyright holders of
366that material) supplement the terms of this License with terms:
367
368a) Disclaiming warranty or limiting liability differently from the
369terms of sections 15 and 16 of this License; or
370
371b) Requiring preservation of specified reasonable legal notices or
372author attributions in that material or in the Appropriate Legal
373Notices displayed by works containing it; or
374
375c) Prohibiting misrepresentation of the origin of that material, or
376requiring that modified versions of such material be marked in
377reasonable ways as different from the original version; or
378
379d) Limiting the use for publicity purposes of names of licensors or
380authors of the material; or
381
382e) Declining to grant rights under trademark law for use of some
383trade names, trademarks, or service marks; or
384
385f) Requiring indemnification of licensors and authors of that
386material by anyone who conveys the material (or modified versions of
387it) with contractual assumptions of liability to the recipient, for
388any liability that these contractual assumptions directly impose on
389those licensors and authors.
390
391All other non-permissive additional terms are considered "further
392restrictions" within the meaning of section 10. If the Program as you
393received it, or any part of it, contains a notice stating that it is
394governed by this License along with a term that is a further
395restriction, you may remove that term. If a license document contains
396a further restriction but permits relicensing or conveying under this
397License, you may add to a covered work material governed by the terms
398of that license document, provided that the further restriction does
399not survive such relicensing or conveying.
400
401If you add terms to a covered work in accord with this section, you
402must place, in the relevant source files, a statement of the
403additional terms that apply to those files, or a notice indicating
404where to find the applicable terms.
405
406Additional terms, permissive or non-permissive, may be stated in the
407form of a separately written license, or stated as exceptions;
408the above requirements apply either way.
409
4108. Termination.
411
412You may not propagate or modify a covered work except as expressly
413provided under this License. Any attempt otherwise to propagate or
414modify it is void, and will automatically terminate your rights under
415this License (including any patent licenses granted under the third
416paragraph of section 11).
417
418However, if you cease all violation of this License, then your
419license from a particular copyright holder is reinstated (a)
420provisionally, unless and until the copyright holder explicitly and
421finally terminates your license, and (b) permanently, if the copyright
422holder fails to notify you of the violation by some reasonable means
423prior to 60 days after the cessation.
424
425Moreover, your license from a particular copyright holder is
426reinstated permanently if the copyright holder notifies you of the
427violation by some reasonable means, this is the first time you have
428received notice of violation of this License (for any work) from that
429copyright holder, and you cure the violation prior to 30 days after
430your receipt of the notice.
431
432Termination of your rights under this section does not terminate the
433licenses of parties who have received copies or rights from you under
434this License. If your rights have been terminated and not permanently
435reinstated, you do not qualify to receive new licenses for the same
436material under section 10.
437
4389. Acceptance Not Required for Having Copies.
439
440You are not required to accept this License in order to receive or
441run a copy of the Program. Ancillary propagation of a covered work
442occurring solely as a consequence of using peer-to-peer transmission
443to receive a copy likewise does not require acceptance. However,
444nothing other than this License grants you permission to propagate or
445modify any covered work. These actions infringe copyright if you do
446not accept this License. Therefore, by modifying or propagating a
447covered work, you indicate your acceptance of this License to do so.
448
44910. Automatic Licensing of Downstream Recipients.
450
451Each time you convey a covered work, the recipient automatically
452receives a license from the original licensors, to run, modify and
453propagate that work, subject to this License. You are not responsible
454for enforcing compliance by third parties with this License.
455
456An "entity transaction" is a transaction transferring control of an
457organization, or substantially all assets of one, or subdividing an
458organization, or merging organizations. If propagation of a covered
459work results from an entity transaction, each party to that
460transaction who receives a copy of the work also receives whatever
461licenses to the work the party's predecessor in interest had or could
462give under the previous paragraph, plus a right to possession of the
463Corresponding Source of the work from the predecessor in interest, if
464the predecessor has it or can get it with reasonable efforts.
465
466You may not impose any further restrictions on the exercise of the
467rights granted or affirmed under this License. For example, you may
468not impose a license fee, royalty, or other charge for exercise of
469rights granted under this License, and you may not initiate litigation
470(including a cross-claim or counterclaim in a lawsuit) alleging that
471any patent claim is infringed by making, using, selling, offering for
472sale, or importing the Program or any portion of it.
473
47411. Patents.
475
476A "contributor" is a copyright holder who authorizes use under this
477License of the Program or a work on which the Program is based. The
478work thus licensed is called the contributor's "contributor version".
479
480A contributor's "essential patent claims" are all patent claims
481owned or controlled by the contributor, whether already acquired or
482hereafter acquired, that would be infringed by some manner, permitted
483by this License, of making, using, or selling its contributor version,
484but do not include claims that would be infringed only as a
485consequence of further modification of the contributor version. For
486purposes of this definition, "control" includes the right to grant
487patent sublicenses in a manner consistent with the requirements of
488this License.
489
490Each contributor grants you a non-exclusive, worldwide, royalty-free
491patent license under the contributor's essential patent claims, to
492make, use, sell, offer for sale, import and otherwise run, modify and
493propagate the contents of its contributor version.
494
495In the following three paragraphs, a "patent license" is any express
496agreement or commitment, however denominated, not to enforce a patent
497(such as an express permission to practice a patent or covenant not to
498sue for patent infringement). To "grant" such a patent license to a
499party means to make such an agreement or commitment not to enforce a
500patent against the party.
501
502If you convey a covered work, knowingly relying on a patent license,
503and the Corresponding Source of the work is not available for anyone
504to copy, free of charge and under the terms of this License, through a
505publicly available network server or other readily accessible means,
506then you must either (1) cause the Corresponding Source to be so
507available, or (2) arrange to deprive yourself of the benefit of the
508patent license for this particular work, or (3) arrange, in a manner
509consistent with the requirements of this License, to extend the patent
510license to downstream recipients. "Knowingly relying" means you have
511actual knowledge that, but for the patent license, your conveying the
512covered work in a country, or your recipient's use of the covered work
513in a country, would infringe one or more identifiable patents in that
514country that you have reason to believe are valid.
515
516If, pursuant to or in connection with a single transaction or
517arrangement, you convey, or propagate by procuring conveyance of, a
518covered work, and grant a patent license to some of the parties
519receiving the covered work authorizing them to use, propagate, modify
520or convey a specific copy of the covered work, then the patent license
521you grant is automatically extended to all recipients of the covered
522work and works based on it.
523
524A patent license is "discriminatory" if it does not include within
525the scope of its coverage, prohibits the exercise of, or is
526conditioned on the non-exercise of one or more of the rights that are
527specifically granted under this License. You may not convey a covered
528work if you are a party to an arrangement with a third party that is
529in the business of distributing software, under which you make payment
530to the third party based on the extent of your activity of conveying
531the work, and under which the third party grants, to any of the
532parties who would receive the covered work from you, a discriminatory
533patent license (a) in connection with copies of the covered work
534conveyed by you (or copies made from those copies), or (b) primarily
535for and in connection with specific products or compilations that
536contain the covered work, unless you entered into that arrangement,
537or that patent license was granted, prior to 28 March 2007.
538
539Nothing in this License shall be construed as excluding or limiting
540any implied license or other defenses to infringement that may
541otherwise be available to you under applicable patent law.
542
54312. No Surrender of Others' Freedom.
544
545If conditions are imposed on you (whether by court order, agreement or
546otherwise) that contradict the conditions of this License, they do not
547excuse you from the conditions of this License. If you cannot convey a
548covered work so as to satisfy simultaneously your obligations under this
549License and any other pertinent obligations, then as a consequence you may
550not convey it at all. For example, if you agree to terms that obligate you
551to collect a royalty for further conveying from those to whom you convey
552the Program, the only way you could satisfy both those terms and this
553License would be to refrain entirely from conveying the Program.
554
55513. Use with the GNU Affero General Public License.
556
557Notwithstanding any other provision of this License, you have
558permission to link or combine any covered work with a work licensed
559under version 3 of the GNU Affero General Public License into a single
560combined work, and to convey the resulting work. The terms of this
561License will continue to apply to the part which is the covered work,
562but the special requirements of the GNU Affero General Public License,
563section 13, concerning interaction through a network will apply to the
564combination as such.
565
56614. Revised Versions of this License.
567
568The Free Software Foundation may publish revised and/or new versions of
569the GNU General Public License from time to time. Such new versions will
570be similar in spirit to the present version, but may differ in detail to
571address new problems or concerns.
572
573Each version is given a distinguishing version number. If the
574Program specifies that a certain numbered version of the GNU General
575Public License "or any later version" applies to it, you have the
576option of following the terms and conditions either of that numbered
577version or of any later version published by the Free Software
578Foundation. If the Program does not specify a version number of the
579GNU General Public License, you may choose any version ever published
580by the Free Software Foundation.
581
582If the Program specifies that a proxy can decide which future
583versions of the GNU General Public License can be used, that proxy's
584public statement of acceptance of a version permanently authorizes you
585to choose that version for the Program.
586
587Later license versions may give you additional or different
588permissions. However, no additional obligations are imposed on any
589author or copyright holder as a result of your choosing to follow a
590later version.
591
59215. Disclaimer of Warranty.
593
594THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
595APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
596HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
597OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
598THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
599PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
600IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
601ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
602
60316. Limitation of Liability.
604
605IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
606WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
607THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
608GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
609USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
610DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
611PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
612EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
613SUCH DAMAGES.
614
61517. Interpretation of Sections 15 and 16.
616
617If the disclaimer of warranty and limitation of liability provided
618above cannot be given local legal effect according to their terms,
619reviewing courts shall apply local law that most closely approximates
620an absolute waiver of all civil liability in connection with the
621Program, unless a warranty or assumption of liability accompanies a
622copy of the Program in return for a fee.
623
624END OF TERMS AND CONDITIONS
625
626How to Apply These Terms to Your New Programs
627
628If you develop a new program, and you want it to be of the greatest
629possible use to the public, the best way to achieve this is to make it
630free software which everyone can redistribute and change under these terms.
631
632To do so, attach the following notices to the program. It is safest
633to attach them to the start of each source file to most effectively
634state the exclusion of warranty; and each file should have at least
635the "copyright" line and a pointer to where the full notice is found.
636
637A fancy and fast mode-line inspired by minimalism design.
638Copyright (C) 2018 Vincent Zhang <seagle0128@gmail.com>
639
640This program is free software: you can redistribute it and/or modify
641it under the terms of the GNU General Public License as published by
642the Free Software Foundation, either version 3 of the License, or
643(at your option) any later version.
644
645This program is distributed in the hope that it will be useful,
646but WITHOUT ANY WARRANTY; without even the implied warranty of
647MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
648GNU General Public License for more details.
649
650You should have received a copy of the GNU General Public License
651along with this program. If not, see <http://www.gnu.org/licenses/>.
652
653Also add information on how to contact you by electronic and paper mail.
654
655If the program does terminal interaction, make it output a short
656notice like this when it starts in an interactive mode:
657
658doom-modeline Copyright (C) 2018 Vincent Zhang <seagle0128@gmail.com>
659This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
660This is free software, and you are welcome to redistribute it
661under certain conditions; type `show c' for details.
662
663The hypothetical commands `show w' and `show c' should show the appropriate
664parts of the General Public License. Of course, your program's commands
665might be different; for a GUI interface, you would use an "about box".
666
667You should also get your employer (if you work as a programmer) or school,
668if any, to sign a "copyright disclaimer" for the program, if necessary.
669For more information on this, and how to apply and follow the GNU GPL, see
670<http://www.gnu.org/licenses/>.
671
672The GNU General Public License does not permit incorporating your program
673into proprietary programs. If your program is a subroutine library, you
674may consider it more useful to permit linking proprietary applications with
675the library. If this is what you want to do, use the GNU Lesser General
676Public License instead of this License. But first, please read
677<http://www.gnu.org/philosophy/why-not-lgpl.html>.
diff --git a/snippets/org-mode/sc b/snippets/org-mode/sc deleted file mode 100644 index f536dae..0000000 --- a/snippets/org-mode/sc +++ /dev/null
@@ -1,4 +0,0 @@
1# key: sc
2# name: sc
3# --
4[sc name="${1: $(yas-choose-value '("total-recovery" "br-location-page" "_locationnameslisted" "organizations-helped" "other-results" "truck-accident-results" "car-wreck-results" "personal-injury-results" "number-locations" "experience" "employees" "mon-number" "mon-address" "lc-number" "lc-address" "ham-number" "ham-address" "zac-number" "zac-address" "liv-number" "liv-address" "asc-number" "asc-address" "shrev-number" "shrev-address" "alx-address" "alx-number" "laf-number" "laf-address" "toll-free" "br-number" "br-address" "gmia" "g-guarantee" "ds-number"))}"][/sc] $0 \ No newline at end of file
diff --git a/snippets/scheme-mode/chicken b/snippets/scheme-mode/chicken deleted file mode 100644 index 19a98e1..0000000 --- a/snippets/scheme-mode/chicken +++ /dev/null
@@ -1,8 +0,0 @@
1# -*- mode: snippet -*-
2# name: chicken
3# key: chicken
4# --
5\#!/bin/sh
6\#| -*- scheme -*-
7exec csi -s $0 \"$@\"
8|#
diff --git a/snippets/sh-mode/getopts b/snippets/sh-mode/getopts deleted file mode 100644 index 8f6fc39..0000000 --- a/snippets/sh-mode/getopts +++ /dev/null
@@ -1,10 +0,0 @@
1# -*- mode: snippet -*-
2# name: getopts
3# key: getopts
4# --
5while getopts ${1:h} opt; do
6 case "$opt" in
7 $0
8 esac
9done
10shift $(( OPTIND -1 )) \ No newline at end of file