about summary refs log tree commit diff stats
diff options
context:
space:
mode:
authorCase Duckworth2021-11-21 23:57:41 -0600
committerCase Duckworth2021-11-21 23:57:41 -0600
commita2657993bad828af6743c68931a0e848bfcdec53 (patch)
tree1e9220389184a0c68bc9f6bfe08edca3f2a362e6
parentUn-stupidify org-mode filling (diff)
downloademacs-a2657993bad828af6743c68931a0e848bfcdec53.tar.gz
emacs-a2657993bad828af6743c68931a0e848bfcdec53.zip
I DECLARE BANKRUPTCY ... 8
Didn't think to do this till pretty .. written, so here we are.
-rw-r--r--.gitignore4
-rw-r--r--README.org30
-rw-r--r--TODO.org230
-rw-r--r--early-init.el229
-rw-r--r--eshell.el83
-rw-r--r--gnus.el156
-rw-r--r--init.el2802
-rw-r--r--lisp/+avy.el21
-rw-r--r--lisp/+circe.el148
-rw-r--r--lisp/+consult.el47
-rw-r--r--lisp/+defaults.el239
-rw-r--r--lisp/+dired.el8
-rw-r--r--lisp/+eshell.el (renamed from lisp/acdw-eshell.el)67
-rw-r--r--lisp/+init.el92
-rw-r--r--lisp/+lisp.el71
-rw-r--r--lisp/+org.el (renamed from lisp/acdw-org.el)294
-rw-r--r--lisp/+setup.el105
-rw-r--r--lisp/+util.el81
-rw-r--r--lisp/acdw-apheleia.el25
-rw-r--r--lisp/acdw-autoinsert.el58
-rw-r--r--lisp/acdw-bell.el28
-rw-r--r--lisp/acdw-browse-url.el129
-rw-r--r--lisp/acdw-circe.el167
-rw-r--r--lisp/acdw-compat.el555
-rw-r--r--lisp/acdw-consult.el93
-rw-r--r--lisp/acdw-cus-edit.el32
-rw-r--r--lisp/acdw-erc.el228
-rw-r--r--lisp/acdw-eww.el38
-rw-r--r--lisp/acdw-fonts.el176
-rw-r--r--lisp/acdw-frame.el36
-rw-r--r--lisp/acdw-irc.el72
-rw-r--r--lisp/acdw-lisp.el16
-rw-r--r--lisp/acdw-modeline.el232
-rw-r--r--lisp/acdw-re.el151
-rw-r--r--lisp/acdw-reading.el100
-rw-r--r--lisp/acdw-setup.el103
-rw-r--r--lisp/acdw-ytel.el75
-rw-r--r--lisp/acdw.el895
-rw-r--r--lisp/chd.el76
-rw-r--r--lisp/titlecase.el157
40 files changed, 1348 insertions, 6801 deletions
diff --git a/.gitignore b/.gitignore index 13a372e..7aed89c 100644 --- a/.gitignore +++ b/.gitignore
@@ -12,4 +12,6 @@ racket-mode/
12server/ 12server/
13straight/ 13straight/
14transient/ 14transient/
15var/ \ No newline at end of file 15var/
16.etc/
17old/
diff --git a/README.org b/README.org deleted file mode 100644 index 44b3f6c..0000000 --- a/README.org +++ /dev/null
@@ -1,30 +0,0 @@
1#+TITLE: My Emacs configuration
2#+AUTHOR: Case Duckworth
3
4This is my Emacs configuration. There are many like it, but this one is mine.
5
6* Files of interest
7
8- {early-,}init.el :: … why we're here
9- gnus.el :: not used any more
10- eshell.el :: like gnus.el, but for eshell. Might be really stupid.
11- lisp/*.el :: my extras.
12
13At /some/ point, I'll move my bespoke stuff from lisp/ to acdw/, and add a
14compat/ directory for compatibility files (i.e., repeat.el). Until then,
15bleh. It works.
16
17* License
18
19Unless otherwise specified, all files under this directory are licensed under
20my own /Good Choices License/, the entire text of which is copied here.
21
22#+begin_example
23Everyone is permitted to do whatever with this software, without
24limitation. This software comes without any warranty whatsoever,
25but with two pieces of advice:
26
27- Be kind to yourself.
28
29- Make good choices.
30#+end_example
diff --git a/TODO.org b/TODO.org deleted file mode 100644 index bd146a8..0000000 --- a/TODO.org +++ /dev/null
@@ -1,230 +0,0 @@
1#+TITLE: TODO stuff for emacs config
2#+SUBTITLE: Yes I have one of these…
3#+AUTHOR: Case Duckworth
4
5* Packages
6
7** DONE insert-kaomoji
8
9- [X] Add =(¬‿¬)═ɜ ɛ═(⌐‿⌐ )= to list
10- [X] and =▬▬▬▬▬▬▬▋ Ò╭╮Ó=
11- [X] Clean up code and package it properly
12
13*** DONE FIX the damn thing Ò╭╮Ó
14
15I just have to make sure it's loading correctly in my own config… bleh
16
17- and add:
18 - [X] =ヽ(°〇°)ノ=
19 - [X] =୧((#Φ益Φ#))୨=
20 - [X] =(╥﹏╥)=
21 - [X] =Σ ◕ ◡ ◕=
22 - [X] =╭∩╮(︶_︶)╭∩╮=
23 - [X] =(งツ)ว=
24 - [X] =ʕ ᴖᴥᴖʔ=
25
26** TODO =append-scratch= mode or something
27
28- save the scratch buffer at times (see [[https://github.com/Fanael/persistent-scratch][GitHub - Fanael/persistent-scratch]],
29 [[https://umarahmad.xyz/blog/quick-scratch-buffers/][Quick persistent scratch buffers]]), but *IMPORTANTLY*
30 + append-only to persistent file
31 + have a keybinding to save buffer to file, then clear buffer
32 + =persistent-scratch-save-to-file= ?
33
34- *NO WAIT* just add a function to interface with the previous scratch buffers.
35
36** TODO keep-acs (name?)
37
38- keepassxc-cli
39- interface with emacs
40- plug into =auth-sources=
41
42** TODO banish-mouse-x
43
44allow more configuration of where the mouse goes:
45
46- '(banish . corner)
47- '(banish . (x . y))
48- …
49
50** TODO add functionality to =electric-cursor-mode=
51
52- Enable idle cursor changing, dependent on mode
53- see [[https://www.emacswiki.org/emacs/cursor-chg.el][cursor-chg.el]]
54
55* Configuring
56
57** DONE Install =el-patch=?
58
59** DONE Look at [[https://gitlab.com/ideasman42/emacs-mode-line-idle][ideasman42 / emacs-mode-line-idle]]
60
61** TODO Look into =which-key= [[https://github.com/justbur/emacs-which-key#2017-12-13-added-which-key-enable-extended-define-key][bind naming]]
62
63** TODO Look at [[https://github.com/karthink/.emacs.d/blob/master/lisp/setup-icomplete.el#L768][embark-complete setup]]
64
65from karthink (and prot)
66
67** TODO [[https://github.com/ahungry/md4rd][md4rd]]
68
69** DONE [[https://github.com/gRastello/ytel][ytel]]
70
71** TODO [[https://passionsplay.com/blog/create-minimal-emacs-environments-with-a-shell-script/][Create Minimal Emacs Environments with a Shell Script]]
72
73** DONE Twitch IRC
74
75- [[https://gist.github.com/hunterbridges/ab095066d40f2e1a243e][How to connect to Twitch with an IRC client (As of Oct 2015) · GitHub]]
76- irc.twitch.tv
77
78** TODO Figuire out “boring”-aware =consult-buffer=
79
80- call boring-aware with =C-x b=
81- call normal with =C-u C-x b=
82- look at =consult--source-buffer= and define one there
83
84** TODO Fix =title-case= to work with “hard” spaces
85
86e.g., “A gold watch” title-cases to “A gold Watch”
87
88* Productivity
89
90** TODO LOOK AT [[https://github.com/odeke-em/drive][DRIVE]]
91
92- google drive go client
93- can pull to txt/docx/whatev
94- can =drive push -convert= to docs format
95- :OOOOOO this would be HOUGHE
96
97** TODO Set up Org Capture
98
99*** Inspo: From wsinatra
100
101#+begin_src emacs-lisp
102 ;; Custom capture templates
103 (setq org-capture-templates
104 '(("t" "Todo" entry (file org-default-notes-file)
105 "* TODO %?\n%u\n%a\n"
106 :clock-in t :clock-resume t)
107 ("e" "Event" entry (file org-default-notes-file)
108 "* EVENT %? :EVENT:\n%t"
109 :clock-in t :clock-resume t)
110 ("i" "Idea" entry (file org-default-notes-file)
111 "* %? :IDEA: \n%t"
112 :clock-in t :clock-resume t)
113 ("p" "Project"
114 entry (file org-default-notes-file)
115 "* PROJ %?\n%u\n%a\n"
116 :clock-in t :clock-resume t)
117 ("n" "Next Task"
118 entry (file+headline org-default-notes-file "Tasks")
119 "** NEXT %? \nDEADLINE: %t")))
120 #+end_src
121
122*** Also cf. [[https://blog.jethro.dev/posts/org_mode_workflow_preview/][Org-mode Workflow: A Preview · Jethro Kuan]]
123
124* Buffer display stuff
125
126#+begin_src emacs-lisp
127 ;; from alphapapa
128 (cl-defun ap/display-buffer-in-side-window (&optional (buffer (current-buffer)))
129 "Display BUFFER in dedicated side window."
130 (interactive)
131 (let ((display-buffer-mark-dedicated t))
132 (display-buffer-in-side-window buffer
133 '((side . right)
134 (window-parameters
135 (no-delete-other-windows . t))))))
136 #+end_src
137
138- [[https://old.reddit.com/r/emacs/comments/pka1sm/my_first_package_aside_for_easier_configuration/][My first package: Aside, for easier configuration and use of side windows :
139 emacs]]
140- [[https://github.com/alphapapa/burly.el][GitHub - alphapapa/burly.el: Save and restore frames and windows with their
141 buffers in Emacs]]
142- [[https://depp.brause.cc/shackle/][shackle: Enforce rules for popup windows]]
143 - [[https://github.com/kaushalmodi/.emacs.d/blob/master/setup-files/setup-shackle.el][.emacs.d/setup-shackle.el at master · kaushalmodi/.emacs.d · GitHub]]
144 - [[https://www.reddit.com/r/emacs/comments/3icpv8/help_with_shackle_configuration/][help with shackle configuration : emacs]]
145 - [[https://mullikine.github.io/posts/making-shackle-split-sensibly/][Sensible Splits: Extending shackle.el // Bodacious Blog]]
146 - [[https://news.ycombinator.com/item?id=18598863][Oh man, your link led me to shackle[1] to make transient buffers behave and
147 I ha... | Hacker News]]
148 - [[https://emacsninja.com/posts/design-is-hard.html][Emacs Ninja - Design Is Hard]]
149- Alternatively: [[https://web.archive.org/web/20160409014815/https://www.lunaryorn.com/2015/04/29/the-power-of-display-buffer-alist.html][Emacs Spotlight: Configure buffer display - Emacs. What else?]]
150
151* Random shit
152
153** A way to map over buffers
154
155#+begin_src emacs-lisp
156 (dolist (buf (mapcan
157 (lambda (buf)
158 (with-current-buffer buf
159 (circe-server-chat-buffers)))
160 (circe-server-buffers)))
161 (with-current-buffer buf ;; whatever u wanna do on each buffer goes here
162 (lui-set-prompt (concat
163 (propertize
164 (acdw-irc/margin-format (buffer-name)
165 ""
166 ">")
167 'face 'circe-prompt-face
168 'read-only t
169 'intangible t
170 'cursor-intangible t)
171 " "))
172 (setq-local fringes-outside-margins t
173 right-margin-width 5
174 scroll-margin 0
175 word-wrap t
176 wrap-prefix (repeat-string acdw-irc/left-margin " ")
177 line-number-mode nil)))
178#+end_src
179
180** ZNC Connecting (from #systemcrafters)
181
182#+begin_quote
183daviwil | minikN: I connect to the hostname/port of my ZNC server, but the
184 trick is that the username is the nick you want to use on the
185 server and the password is your znc username and password joined
186 with a colon, like daviwil:b4dp4ssw0rd
187 minikN | so you don't specify the network in your password? like
188 user/network:password?
189benoitj | daviwil: nice password you have there
190daviwil | minikN: nope, I only have one network anyway
191- acdw > daviwil: I just see *******
192benoitj | I use two networks
193#+end_quote
194
195** Teach =link-hint= about =lui-buttons=
196
197See =lui-next-button-or-complete=, etc. Also possibly:
198- [[https://github.com/abo-abo/avy/issues/255][Feature request: ability to select objects in overlays · Issue #255 · abo-abo/avy · GitHub]]
199- [[https://github.com/noctuid/link-hint.el/issues/24][Enhancement: Detect links in overlays · Issue #24 · noctuid/link-hint.el ·
200 GitHub]]
201
202
203(I /think/ a button is an overlay….)
204
205** Write =self-promote-shamelessly= function
206
207Link to the line of a file on a git forge with a command, for linking.
208
209https://tildegit.org/acdw/emacs/src/branch/main/init.el#L1166, e.g.
210
211- *OR* install this: [[https://github.com/sshaw/git-link][GitHub - sshaw/git-link: Emacs package to get the GitHub/Bitbucket/GitLab/... URL for a buffer location]]
212
213** DONE Fix =acdw-org/count-words-stupidly=
214
215It adds one for blank lines.
216
217** TODO [[https://stackoverflow.com/questions/25161792/emacs-org-mode-how-can-i-fold-everything-but-the-current-headline][Org mode hide all but current heading]]
218
219** Work around =C-m=, =RET=, etc
220
221#+begin_src emacs-lisp
222 ;; from artefact
223
224 (define-key key-translation-map (kbd "<return>") nil)
225 (define-key key-translation-map (kbd "C-m") nil)
226 (define-key key-translation-map (kbd "RET") nil)
227 (global-set-key (kbd "<return>") 'newline)
228 (define-key erc-mode-map (kbd "<return>") 'erc-send-current-line)
229 (global-set-key (kbd "C-m") (lambda () (interactive) (message "hello from C-m")))
230#+end_src
diff --git a/early-init.el b/early-init.el index 64bf3cc..ccd1ff4 100644 --- a/early-init.el +++ b/early-init.el
@@ -1,135 +1,76 @@
1;;; early-init.el -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; early-init.el -*- lexical-binding: t; coding: utf-8-unix -*-
2;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> 2
3;; Author: Case Duckworth <acdw@acdw.net>
3;; Created: Sometime during Covid-19, 2020 4;; Created: Sometime during Covid-19, 2020
4;; Keywords: configuration 5;; Keywords: configuration
5;; URL: https://tildegit.org/acdw/emacs 6;; URL: https://tildegit.org/acdw/emacs
6 7
7;; This file is NOT part of GNU Emacs.
8
9;;; License: 8;;; License:
10;; Everyone is permitted to do whatever with this software, without 9
11;; limitation. This software comes without any warranty whatsoever, 10;; Everyone is permitted to do whatever they like with this software
12;; but with two pieces of advice: 11;; without limitation. This software comes without any warranty
13;; - Don't hurt yourself. 12;; whatsoever, but with two pieces of advice:
13;; - Be kind to yourself.
14;; - Make good choices. 14;; - Make good choices.
15 15
16;;; Comentary: 16;;; Commentary:
17;; Starting with Emacs 27.1, `early-init' is sourced before `package' 17
18;; or any frames. So those are the settings I run in this file. 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.
19 21
20;;; Code: 22;;; Code:
21 23
22;;; Add `acdw.el' 24(push (locate-user-emacs-file "lisp") load-path)
23(push (expand-file-name "lisp/" user-emacs-directory) 25(add-to-list 'load-path (locate-user-emacs-file "lisp/compat") :append)
24 load-path) 26
25(require 'acdw) 27(require 'acdw)
26(require 'acdw-frame) 28
27 29(+define-dir .etc (locate-user-emacs-file ".etc")
28;;; Frame settings 30 "Directory for all of Emacs's various files.
29(when (acdw/system :home) 31See `no-littering' for examples.")
30 (setq initial-frame-alist '((fullscreen . maximized)))) 32
31 33(+define-dir sync/ (expand-file-name "~/Sync")
32(setq default-frame-alist 34 "My Syncthing directory.")
33 `((tool-bar-lines . 0) 35
34 (menu-bar-lines . 0) 36;;; Default frame settings
35 (vertical-scroll-bars . nil) 37
36 (horizontal-scroll-bars . nil) 38(setq default-frame-alist '((tool-bar-lines . 0)
37 ;; (width . 84) 39 (menu-bar-lines . 0)
38 ;; (height . 30) 40 (vertical-scroll-bars)
39 (left-fringe . 8) 41 (horizontal-scroll-bars))
40 (right-fringe . 8)
41 (font . ,(acdw/system
42 (:home "DejaVu Sans Mono 10")
43 (:work "Consolas 12")
44 (:other "monospace 10"))))
45 frame-inhibit-implied-resize t 42 frame-inhibit-implied-resize t
46 frame-resize-pixelwise t 43 frame-resize-pixelwise t
47 inhibit-x-resources t) 44 window-resize-pixelwise t
48 45 inhibit-x-resources t
49(add-hook 'after-init-hook 46 indicate-empty-lines nil
50 (defun after-init@disable-ui-modes () 47 indicate-buffer-boundaries '((top . right)
51 "Disable UI modes after init. 48 (bottom . right)))
52I already disable them from the `default-frame-alist' for speed 49
53and anti-flickering reasons, but this function allows running, 50;; Fonts
54say, `tool-bar-mode' once to toggle the tool bar back on." 51(let ((font-name "Go Mono")
55 (dolist (mode ;; each mode is of the form (MODE . FRAME-ALIST-VAR) 52 (font-size 105))
56 '((tool-bar-mode . tool-bar-lines) 53 (set-face-attribute 'default nil :family font-name
57 (menu-bar-mode . menu-bar-lines) 54 :height font-size :weight 'book)
58 (scroll-bar-mode . vertical-scroll-bars) 55 (set-face-attribute 'italic nil :family font-name
59 (horizontal-scroll-bar-mode . horizontal-scroll-bars))) 56 :height font-size :slant 'italic))
60 (let ((setting (alist-get (cdr mode) default-frame-alist))) 57
61 (when (or (not setting) 58;;; Packages
62 (zerop setting)) 59
63 (funcall (car mode) -1))))))
64
65(add-hook 'after-make-frame-functions
66 (defun after-make-frame@setup (&rest args)
67 (ignore args)
68 (let ((fixed-pitch-faces
69 '((:font "Fantasque Sans Mono" :height 115)
70 (:font "Go Mono" :height 110)
71 (:font "DejaVu Sans Mono" :height 110)
72 (:font "monospace" :height 100)))
73 (variable-pitch-faces
74 '((:font "Inter" :height 120)
75 (:font "Go" :height 120)
76 (:font "sans-serif" :height 100))))
77 (acdw/set-first-face-attribute 'default
78 fixed-pitch-faces)
79 (acdw/set-first-face-attribute 'fixed-pitch
80 fixed-pitch-faces)
81 (acdw/set-first-face-attribute 'variable-pitch
82 variable-pitch-faces))
83 (acdw/set-emoji-fonts "Noto Color Emoji"
84 "Noto Emoji"
85 "Segoe UI Emoji"
86 "Apple Color Emoji"
87 "FreeSans"
88 "FreeMono"
89 "FreeSerif"
90 "Unifont"
91 "Symbola")
92 (acdw/set-fringes '((left-curly-arrow [#b01100000
93 #b00110000
94 #b00011000
95 #b00001100]
96 4 8 center)
97 (right-curly-arrow [#b00000011
98 #b00000110
99 #b00001100
100 #b00011000]
101 4 8 center)
102 (left-arrow [#b01100000
103 #b01010000]
104 2 8 (top t))
105 (right-arrow [#b00000011
106 #b00000101]
107 2 8 (top t))))
108 (setq indicate-empty-lines nil
109 indicate-buffer-boundaries '((top . right)
110 (bottom . right)))
111 (custom-set-faces '(fringe ((t (:foreground "dim gray")))))))
112(add-hook 'server-after-make-frame-hook #'after-make-frame@setup)
113
114;; I have this here because ... the first frame doesn't ? run ? the hook ???
115(add-function :after after-focus-change-function
116 (defun after-focus-change@first-frame-setup (&rest args)
117 (ignore args)
118 (after-make-frame@setup)
119 (remove-function after-focus-change-function
120 #'after-focus-change@first-frame-setup)))
121
122;;; Bootstrap package manager (`straight.el')
123
124;; Set `package' and `straight' variables.
125(setq package-enable-at-startup nil 60(setq package-enable-at-startup nil
126 package-quickstart nil 61 package-quickstart nil
127 straight-host-usernames '((github . "duckwork") 62 straight-host-usernames '((github . "duckwork")
128 (gitlab . "acdw")) 63 (gitlab . "acdw"))
129 straight-base-dir (acdw/dir) 64 straight-check-for-modifications '(check-on-save
130 straight-check-for-modifications '(check-on-save find-when-checking)) 65 find-when-checking))
66
67(setq no-littering-etc-directory .etc
68 no-littering-var-directory .etc
69 straight-base-dir .etc)
70
71;; Bootstrap straight.el
72;; https://github.com/raxod502/straight.el
131 73
132;; Bootstrap `straight'.
133(defvar bootstrap-version) 74(defvar bootstrap-version)
134(let ((bootstrap-file 75(let ((bootstrap-file
135 (expand-file-name 76 (expand-file-name
@@ -146,44 +87,30 @@ say, `tool-bar-mode' once to toggle the tool bar back on."
146 (eval-print-last-sexp))) 87 (eval-print-last-sexp)))
147 (load bootstrap-file nil 'nomessage)) 88 (load bootstrap-file nil 'nomessage))
148 89
149;; Helper package, good commands here. 90;; Early-loaded packages -- those that, for some reason or another,
91;; need to be ensured to be loaded first.
92
150(require 'straight-x) 93(require 'straight-x)
151 94
152;; Appendix. Get rid of a dumb alias. 95(dolist (pkg '(el-patch
153;; straight-ಠ_ಠ-mode really slows down all minibuffer completion functions. 96 no-littering
154;; Since it's a (rarely-used, even) alias anyway, I just define it back to nil. 97 setup))
155;; By the way, the alias is `straight-package-neutering-mode'. 98 (straight-use-package pkg)
156(defalias 'straight-ಠ_ಠ-mode nil) 99 (require pkg)
100 (require (intern (format "+%s" pkg)) nil :noerror))
157 101
158;;; Message startup time for profiling 102;;; Appendix
159;; This just redefines the Emacs function
160;; `display-startup-echo-area-message', so no hooks needed.
161(defun display-startup-echo-area-message ()
162 "Show Emacs's startup time in the message buffer. For profiling."
163 (message "Emacs ready in %s with %d garbage collections."
164 (format "%.2f seconds"
165 (float-time (time-subtract after-init-time
166 before-init-time)))
167 gcs-done))
168
169;;; Early-loaded packages
170;; These packages are here because they need to be loaded /before/
171;; everything else in init.el.
172
173(straight-use-package '(setup
174 :host nil
175 :repo "https://git.sr.ht/~pkal/setup"))
176(require 'setup)
177(require 'acdw-setup)
178
179(setup (:straight no-littering)
180 (:option no-littering-etc-directory (acdw/dir)
181 no-littering-var-directory (acdw/dir))
182 (require 'no-littering))
183
184(setup (:straight el-patch))
185
186;; My private variables and stuff
187(require 'private (acdw/sync-dir "private") :noerror)
188 103
104;; I've patched setup to look at `setup-ensure-function-inhibit' to decide
105;; whether to ensure functions or not with local macros.
106(setq setup-ensure-function-inhibit t)
107
108;; Get rid of a dumb alias. straight-ಠ_ಠ-mode really slows down all
109;; minibuffer completion functions. Since it's a (rarely-used, even)
110;; alias anyway, I just define it back to nil. By the way, the alias
111;; is `straight-package-neutering-mode'.
112(defalias 'straight-ಠ_ಠ-mode nil)
113
114(provide 'early-init)
189;;; early-init.el ends here 115;;; early-init.el ends here
116
diff --git a/eshell.el b/eshell.el deleted file mode 100644 index c6d8e16..0000000 --- a/eshell.el +++ /dev/null
@@ -1,83 +0,0 @@
1;;; eshell.el --- eshell-specific configuration -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Case Duckworth
4
5;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
6
7;;; Commentary:
8
9;; Much like ~/.emacs.d/gnus.el, this is eshell-specific configuration that's
10;; loaded whenever `eshell' is loaded.
11
12;;; Code:
13
14(require 'setup)
15(require 'eshell)
16(require 'em-alias)
17
18;;; Environment
19(setenv "PAGER" "cat")
20
21;;; Aliases
22
23(dolist (definition '(("e" . "find-file $1")
24 ("ff" . "find-file $1")
25 ("emacs" . "find-file $1")
26 ("ee" . "find-file-other-window $1")))
27 (cl-letf (((symbol-function 'eshell-write-aliases-list) #'ignore))
28 (eshell/alias (car definition) (cdr definition))))
29(eshell-write-aliases-list)
30
31;;; Functions
32
33;; https://karthinks.com/software/jumping-directories-in-eshell/
34(defun eshell/z (&optional regexp)
35 "Navigate to a previously visited directory in eshell, or to
36any directory proferred by `consult-dir'."
37 (let ((eshell-dirs (delete-dups
38 (mapcar 'abbreviate-file-name
39 (ring-elements eshell-last-dir-ring)))))
40 (cond
41 ((and (not regexp) (featurep 'consult-dir))
42 (let* ((consult-dir--source-eshell `(:name "Eshell"
43 :narrow ?e
44 :category file
45 :face consult-file
46 :items ,eshell-dirs))
47 (consult-dir-sources (cons consult-dir--source-eshell
48 consult-dir-sources)))
49 (eshell/cd (substring-no-properties
50 (consult-dir--pick "Switch directory: ")))))
51 (t (eshell/cd (if regexp (eshell-find-previous-directory regexp)
52 (completing-read "cd: " eshell-dirs)))))))
53
54;;; Extra eshell packages
55
56(setup (:straight esh-autosuggest)
57 (:hook-into eshell-mode))
58
59(setup (:straight eshell-syntax-highlighting)
60 (eshell-syntax-highlighting-global-mode +1))
61
62(setup (:straight-when fish-completion
63 (executable-find "fish"))
64 (:autoload global-fish-completion-mode)
65 (global-fish-completion-mode +1))
66
67(setup (:straight-when eshell-vterm
68 (require 'vterm nil :noerror))
69 (eshell-vterm-mode +1)
70 (defalias 'eshell/v 'eshell-exec-visual))
71
72;;; Miscellaneous
73
74;; Fix modeline
75(when (boundp 'simple-modeline--mode-line)
76 (setq mode-line-format '(:eval simple-modeline--mode-line)))
77
78(provide 'eshellrc)
79;;; eshell.el ends here
80
81;; Local Variables:
82;; flymake-inhibit: t
83;; End:
diff --git a/gnus.el b/gnus.el deleted file mode 100644 index 7a2cdc7..0000000 --- a/gnus.el +++ /dev/null
@@ -1,156 +0,0 @@
1;;; gnus.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Created: Sometime during Covid-19, 2020
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;; This file is NOT part of GNU Emacs.
9
10;;; License:
11;; Everyone is permitted to do whatever with this software, without
12;; limitation. This software comes without any warranty whatsoever,
13;; but with two pieces of advice:
14;; - Don't hurt yourself.
15;; - Make good choices.
16
17;;; Code:
18
19;;; Private files
20(acdw/require-private)
21
22;;; Select Methods
23(setq gnus-select-method '(nnnil ""))
24
25(add-hook 'gnus-started-hook
26 (defun gnus-startup@feed-setup ()
27 (cond ((fboundp #'gnus/init-feed-list)
28 (gnus/init-feed-list))
29 ((and (fboundp #'gnus/import-feed-list)
30 (file-exists-p (expand-file-name
31 "feeds.txt" user-emacs-directory)))
32 (gnus/import-feed-list (expand-file-name
33 "feeds.txt" user-emacs-directory)))
34 (t (message "Oops, no feeds :/")))))
35
36;;; Gnus cloud
37(setq gnus-cloud-storage-method nil ; Don't always have GPG or gzip
38 gnus-cloud-covered-servers '("nntp:news.tilde.club"
39 "nntp:news.gwene.org"
40 "nntp:news.gmane.io"))
41(add-hook 'gnus-started-hook #'gnus-cloud-download-all-data)
42(add-hook 'gnus-exit-gnus-hook #'gnus-cloud-upload-all-data)
43
44;;; Gnus behavior options
45(setq gnus-gcc-mark-as-read t
46 message-signature (or (file-exists-p message-signature-file)
47 "~ acdw")
48 gnus-startup-file (expand-file-name "newsrc" gnus-home-directory)
49 gnus-save-newsrc-file nil
50 gnus-read-newsrc-file nil
51 gnus-read-active-file 'some
52 gnus-always-read-dribble-file t
53 gnus-interactive-exit nil
54 gnus-use-cache t)
55
56;; Keybindings
57(define-key gnus-group-mode-map (kbd "q")
58 (defun gnus-cloud-upload-and-bury-buffer ()
59 (interactive)
60 (gnus-cloud-upload-all-data)
61 (bury-buffer)))
62(define-key gnus-group-mode-map (kbd "Q") #'gnus-group-exit)
63(define-key gnus-group-mode-map (kbd "C-q") #'gnus-group-quit)
64
65;;; Other parameters
66(setq gnus-parameters
67 '(("fastmail.com:.*"
68 (display . 200)
69 (expiry-wait . immediate)
70 (expiry-target . "nnimap+fastmail.com:Archive"))))
71
72;;; Gnus UI options
73(setq gnus-thread-sort-functions '(gnus-thread-sort-by-most-recent-date
74 (not gnus-thread-sort-by-number))
75 gnus-use-cache t
76 gnus-summary-thread-gathering-function #'gnus-gather-threads-by-subject
77 gnus-thread-hide-subtree t
78 gnus-thread-ignore-subject t
79 gnus-html-frame-width fill-column)
80
81(when window-system
82 (setq gnus-sum-thread-tree-indent " ")
83 (setq gnus-sum-thread-tree-root "● ")
84 (setq gnus-sum-thread-tree-false-root "○ ")
85 (setq gnus-sum-thread-tree-single-indent "◎ ")
86 (setq gnus-sum-thread-tree-vertical "│")
87 (setq gnus-sum-thread-tree-leaf-with-other "├─ ")
88 (setq gnus-sum-thread-tree-single-leaf "╰─ "))
89
90(setq gnus-summary-line-format
91 (concat
92 "%0{%U%R%z%}"
93 "%3{│%}" "%1{%d%}" "%3{│%}" ; date
94 " "
95 "%4{%-20,20f%}" ; name
96 " "
97 "%3{│%}"
98 " "
99 "%1{%B%}"
100 "%s\n"))
101
102(setq gnus-summary-display-arrow t)
103
104(add-hook 'gnus-group-mode-hook #'hl-line-mode)
105(add-hook 'gnus-article-mode-hook #'acdw/reading-mode)
106
107;;; MIME types
108(setq mm-discouraged-alternatives '("text/html"
109 "text/richtext"))
110
111(with-eval-after-load 'mailcap
112 (cond ((eq system-type 'darwin))
113 ((eq system-type 'windows-nt))
114 (t (mailcap-parse-mailcaps))))
115
116;;; Composing mail
117(add-hook 'message-mode-hook
118 (defun message-mode@setup ()
119 (flyspell-mode +1)
120 (local-set-key (kbd "TAB") #'bbdb-complete-mail)))
121
122;;; Packages
123
124;; searching (?)
125(require 'nnir)
126
127;; contacts
128(setup (:straight bbdb)
129 (require 'bbdb)
130 (bbdb-initialize 'message 'gnus 'mail)
131 (bbdb-insinuate-message)
132 (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
133 (:option bbdb/gnus-summary-prefer-real-names t
134 bbdb/mail-auto-create-p t
135 bbdb/news-auto-create-p t
136 bbdb-use-pop-up t
137 bbdb-offer-save 1
138 bbdb-update-records-p t))
139
140;;; Functions
141;; see https://wpc.io/blog/posts/bulk-import-rss-feeds-to-gnus-via-gwene.html
142(defun gnus/slurp (file)
143 "Read FILE into a string."
144 (with-temp-buffer
145 (insert-file-contents file)
146 (buffer-substring-no-properties
147 (point-min)
148 (point-max))))
149
150(defun gnus/import-feed-list (path)
151 "Import list of NNTP feeds from file at PATH."
152 (interactive "F")
153 (let ((feeds (split-string (gnus/slurp path) "\n" t)))
154 (cl-loop for feed in feeds
155 do (with-message (format "Subscribing to %s" feed)
156 (gnus-subscribe-group feed)))))
diff --git a/init.el b/init.el index c2fbadf..abd40fe 100644 --- a/init.el +++ b/init.el
@@ -1,262 +1,47 @@
1;;; init.el -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; init.el --- Emacs initiation file -*- lexical-binding: t -*-
2 2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")> 3;; Author: Case Duckworth <acdw@acdw.net>
4;; Created: Sometime during Covid-19, 2020 4;; Created: Sometime during Covid-19, 2020
5;; Keywords: configuration 5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs 6;; URL: https://tildegit.org/acdw/emacs
7;; Bankruptcy: 7 7;; Bankruptcy: 8
8
9;; This file is NOT part of GNU Emacs.
10 8
11;;; License: 9;;; License:
12 10
13;; Everyone is permitted to do whatever with this software, without 11;; Everyone is permitted to do whatever they like with this software
14;; limitation. This software comes without any warranty whatsoever, 12;; without limitation. This software comes without any warranty
15;; but with two pieces of advice: 13;; whatsoever, but with two pieces of advice:
16
17;; - Be kind to yourself. 14;; - Be kind to yourself.
18
19;; - Make good choices. 15;; - Make good choices.
20 16
21;;; Commentary:
22
23;; Some of the names in these `setup' forms are arbitrary.
24
25;;; Code: 17;;; Code:
26 18
27(setup (:require auth-source) 19;; Require early-init.el just in case it hasn't been yet.
28 (:option auth-sources (list (acdw/sync-dir "authinfo") 20(require 'early-init (locate-user-emacs-file "early-init.el") :noerror)
29 (acdw/sync-dir "authinfo.gpg") 21;; Requre my private stuff
30 "~/.authinfo" 22(require 'private)
31 "~/.authinfo.gpg")))
32
33(setup (:require goto-addr)
34 (if (fboundp #'global-goto-address-mode)
35 (global-goto-address-mode)
36 (add-hook 'after-change-major-mode-hook #'goto-address-mode)))
37
38(setup (:require recentf)
39 (:option recentf-save-file (acdw/dir "recentf.el")
40 recentf-max-menu-items 100
41 recentf-max-saved-items nil
42 recentf-auto-cleanup 'mode
43 (append recentf-exclude) (acdw/dir))
44
45 (:advise dired-rename-file :after #'rjs/recentf-rename-notify)
46
47 (recentf-mode +1))
48
49(setup (:require savehist)
50 (:option history-length t
51 history-delete-duplicates t
52 savehist-autosave-interval 60
53 savehist-file (acdw/dir "savehist.el"))
54
55 (dolist (var '(extended-command-history
56 global-mark-ring
57 kill-ring
58 regexp-search-ring
59 search-ring
60 mark-ring))
61 (:option (append savehist-additional-variables) var))
62
63 (savehist-mode +1))
64
65(setup (:require server)
66 (unless (server-running-p)
67 (server-start)))
68
69(setup (:require tramp)
70 ;; thanks Irreal! https://irreal.org/blog/?p=895
71 (add-to-list 'tramp-default-proxies-alist
72 '(nil "\\`root\\'" "/ssh:%h:"))
73 (add-to-list 'tramp-default-proxies-alist
74 '((regexp-quote (system-name)) nil nil)))
75
76(setup Info
77 (:hook #'variable-pitch-mode
78 #'reading-mode))
79
80(setup abbrev
81 (:option abbrev-file-name "~/Sync/abbrev.el"
82 save-abbrevs 'silent)
83 (:hook-into text-mode
84 circe-chat-mode))
85
86(setup acdw
87 (:also-load acdw-compat
88 acdw-lisp
89 acdw-reading)
90
91 (:option user-full-name "Case Duckworth"
92 user-mail-address (rot13-string "npqj@npqj.arg"))
93
94 (when-let ((default-directory
95 (expand-file-name-exists-p "pkg/" user-emacs-directory)))
96 (normal-top-level-add-subdirs-to-load-path)))
97
98(setup auto-fill
99 (:hook (defun auto-fill@truncate-lines ()
100 (setq-local truncate-lines t))))
101
102(setup autoinsert
103 (require 'acdw-autoinsert)
104 (acdw/define-auto-insert '(:replace t)
105 ;; This is my custom auto-insert for elisp files.
106 '("\\.el\\'" . "Emacs Lisp header (acdw)")
107 '("Short description: " ";;; "
108 (file-name-nondirectory (buffer-file-name))
109 " --- " str
110 (make-string (max 2 ( - fill-column (current-column) 27)) 32)
111 "-*- lexical-binding: t; -*-"
112 '(setq lexical-binding t)
113 "\n\n;; Copyright (C) " (format-time-string "%Y")
114 " " (getenv "ORGANIZATION") | (progn user-full-name)
115 "\n\n;; Author: " (user-full-name)
116 '(if (search-backward "&" (line-beginning-position) t)
117 (replace-match (capitalize (user-login-name)) t t))
118 '(end-of-line 1)
119 " <" (progn user-mail-address) ">"
120 & -2
121 "\n\n;;; License:"
122 "\n\n;; Everyone is permitted to do whatever with this software, without"
123 "\n;; limitation. This software comes without any warranty whatsoever,"
124 "\n;; but with two pieces of advice:"
125 "\n\n;; - Be kind to yourself."
126 "\n\n;; - Make good choices."
127 "\n\n;;; Commentary:"
128 "\n\n;; " _
129 "\n\n;;; Code:"
130 "\n\n\n\n(provide '" (file-name-base (buffer-file-name)) ")"
131 "\n;;; " (file-name-nondirectory (buffer-file-name)) " ends here\n"))
132 (auto-insert-mode +1))
133
134(setup autorevert
135 (:option global-auto-revert-non-file-buffers t
136 auto-revert-verbose nil)
137 (global-auto-revert-mode +1))
138 23
139(setup browse-url 24(setup (:require +defaults))
140 (:require acdw-browse-url)
141
142 (:option browse-url-secondary-browser-function
143 (if (executable-find "firefox") ; prefer Firefox
144 #'browse-url-firefox
145 #'browse-url-default-browser)
146 browse-url-new-window-flag nil ; for eww
147 browse-url-firefox-arguments '("--new-tab") ; for firefox
148 browse-url-firefox-new-window-is-tab t)
149
150 (acdw/browse-url-set-handlers
151 (list
152 (cons (rx (seq "." (or "jpeg" "jpg" ; images
153 "png")
154 eos))
155 (lambda (&rest args)
156 (apply
157 (cond ((executable-find "feh") #'browse-url-feh)
158 ((executable-find "mpv")
159 (defun browse-image-url-mpv (url &rest _args)
160 "View an image URL in mpv."
161 (let ((url (browse-url-encode-url url))
162 (process-environment
163 (browse-url-process-environment)))
164 (message "Viewing %s in mpv..." url)
165 (apply #'start-process
166 (concat "mpv " url) nil
167 "mpv"
168 (append browse-url-mpv-arguments
169 (list "--image-display-duration=inf"
170 url))))))
171 (t #'eww-browse-url))
172 args)))
173 (cons (rx (or "youtube.com" ; videos
174 "youtu.be"
175 (seq "." (or "mp4"
176 "gif"
177 "mov" "MOV")
178 eos)))
179 (lambda (&rest args)
180 (apply (if (executable-find "mpv")
181 #'browse-url-mpv
182 browse-url-secondary-browser-function)
183 args)))
184 (cons (rx (or "google.com" ; websites that don't work with eww
185 "reddit.com"
186 "twitter.com"
187 "imgur.com"
188 "pixelfed"
189 "taskiq"))
190 browse-url-secondary-browser-function)
191 (cons "." ; everything else
192 #'eww-browse-url)))
193
194 ;; Buttonize gemini:// links.
195 (acdw/add-button-url-regexp-protocol "gemini"))
196 25
197(setup buffers 26(setup (:require +init)
198 (:global "C-x k" #'acdw/kill-a-buffer) 27 (:bind "C-c s" (lambda ()
199 ;; Set the right major mode based on buffer name, if not visiting a file. 28 (interactive)
200 ;; http://ruzkuku.com/emacs.d.html#orgeab93c3 29 (+init-sort)
201 (setq-default major-mode (lambda () 30 (save-buffer)))
202 (unless buffer-file-name 31 (:hook '+init-add-setup-to-imenu))
203 (let ((buffer-file-name (buffer-name)))
204 (set-auto-mode))))))
205 32
206(setup calendar 33(setup calendar
207 (:option calendar-week-start-day 1)) 34 (require '_location)
208 35 (:option calendar-location-name _location-name
209(setup completion 36 calendar-latitude _location-latitude
210 (:option completion-ignore-case t 37 calendar-longitude _location-longitude))
211 read-buffer-completion-ignore-case t
212 completion-styles '(substring partial-completion)
213 completion-category-defaults nil
214 completion-category-overrides
215 '((file (styles . (partial-completion)))))
216
217 (:global "M-/" #'hippie-expand))
218
219(setup css-mode
220 (:bind "C-c C-h" #'css-lookup-symbol))
221
222(setup cursor
223 (:option cursor-type 'bar
224 cursor-in-non-selected-windows 'hollow
225 blink-cursor-blinks 1)
226 (blink-cursor-mode +1))
227
228(setup cus-edit
229 (:also-load acdw-cus-edit)
230 (:option custom-file (acdw/dir "custom.el")
231 custom-magic-show nil
232 custom-magic-show-button t
233 custom-raised-buttons nil
234 custom-unlispify-tag-names nil
235 custom-variable-default-form 'lisp)
236
237 ;; I need this to save `safe-local-variables' between Emacs invocations. For
238 ;; now, of course .... I would /love/ a better solution.
239 (when (file-exists-p custom-file)
240 ;; Don't load faces, since those are all set in init.el
241 (cl-letf (((symbol-function 'custom-set-faces) #'ignore))
242 (load custom-file nil nil)))
243
244 ;; `Custom-mode-hook' fires /before/ the widgets are built, so I have to
245 ;; install advice after the widgets are made.
246 (:advise custom-buffer-create-internal :after #'acdw-cus/expand-widgets)
247
248 (:with-mode Custom-mode
249 (:local-set imenu-generic-expression acdw-cus/imenu-generic-expression)))
250
251(setup debugger
252 (:hook visual-line-mode))
253 38
254(setup dired 39(setup dired
255 (:also-load dired-x) 40 (:also-load dired-x)
256 (:straight dired-subtree 41 (:also-straight dired-subtree
257 dired-collapse 42 dired-collapse
258 dired-git-info) 43 dired-git-info
259 44 dired+)
260 (:option dired-recursive-copies 'top 45 (:option dired-recursive-copies 'top
261 dired-recursive-deletes 'top 46 dired-recursive-deletes 'top
262 dired-create-destination-dirs 'ask 47 dired-create-destination-dirs 'ask
@@ -269,1248 +54,255 @@
269 hardlink load move 54 hardlink load move
270 shell touch symlink) 55 shell touch symlink)
271 dired-dwim-target t) 56 dired-dwim-target t)
272 57 (:bind "TAB" 'dired-subtree-cycle
273 (:bind "TAB" #'dired-subtree-cycle 58 "i" 'dired-subtree-toggle
274 "i" #'dired-subtree-toggle 59 ")" 'dired-git-info-mode)
275 ")" #'dired-git-info-mode) 60 (:hook 'dired-collapse-mode
276 61 'dired-hide-details-mode
277 (:hook dired-collapse-mode 62 'hl-line-mode)
278 dired-hide-details-mode 63 (:global "C-x C-j" 'dired-jump)
279 hl-line-mode)
280
281 (:global "C-x C-j" #'dired-jump)
282
283 (with-eval-after-load 'dired 64 (with-eval-after-load 'dired
284 (acdw/system 65 (pcase system-type
285 (:work (:straight w32-browser) 66 ((or 'ms-dos 'windows-nt)
286 (autoload #'dired-w32-browser "w32-browser" nil t) 67 (:straight w32-browser))
287 (:bind "RET" #'dired-w32-browser)) 68 ((or 'gnu/linux)
288 (:home (:straight dired-open) 69 (:straight dired-open)
289 (autoload #'dired-find-alternate-file "dired-open" nil t) 70 (:option dired-listing-switches
290 (:bind "RET" #'dired-find-alternate-file))))) 71 (concat dired-listing-switches " -F")))))
291 72 (with-eval-after-load 'frowny
292(setup disabled 73 (add-to-list 'frowny-inhibit-modes 'dired-mode)))
293 ;; While this stuff is defined in novice.el, I'm using 'disabled' as the name
294 ;; for easy finding.
295
296 ;; Enable all disabled commands.
297 ;; This is an option, but I'm going to try /enabling/ just the ones that I
298 ;; use instead.
299 ;; (mapatoms (lambda (symbol)
300 ;; (when (get symbol 'disabled)
301 ;; (put symbol 'disabled nil))))
302
303 ;; Enable /some/ disabled commands
304 (dolist (enable-sym '(narrow-to-region
305 dired-find-alternate-file
306 narrow-to-page))
307 (put enable-sym 'disabled nil))
308
309 ;; Now, disable symbols as I wish.
310 (dolist (disable-sym '(view-hello-file
311 suspend-frame
312 scroll-left
313 scroll-right
314 comment-set-column
315 set-fill-column))
316 (put disable-sym 'disabled t))
317
318 ;; And set the disabled function to something better than the default.
319 ;; Now, I can run any disabled command, but I have to use M-x to do it.
320 (:option disabled-command-function #'acdw/disabled-command-function))
321
322(setup ediff
323 (:option ediff-diff-options "-w" ; ignore whitespace
324 ediff-window-setup-function #'ediff-setup-windows-plain
325 ediff-split-window-function #'split-window-horizontally)
326 ;; https://oremacs.com/2015/01/17/setting-up-ediff/
327 (add-hook 'ediff-after-quit-hook-internal #'winner-undo))
328
329(setup eldoc
330 (:option eldoc-idle-delay 0.1
331 eldoc-echo-area-use-multiline-p nil))
332
333(setup elec-pair
334 (electric-pair-mode +1))
335
336(setup elisp-mode
337 (:with-mode emacs-lisp-mode ;; -_-
338 (:option eval-expression-print-length nil
339 eval-expression-print-level nil
340 print-length nil
341 print-level nil
342 lisp-indent-function #'lisp-indent-function)
343
344 (:local-set (append imenu-generic-expression)
345 `("Setup"
346 ,(rx (seq
347 (group bol (* space) "(setup" (+ space))
348 (? (group "(:" (+ graph) (* space) (? "(")))
349 (group (+ (any word ?+ ?-)))))
350 3))
351
352 (:hook #'checkdoc-minor-mode
353 #'turn-on-eldoc-mode)
354
355 ;; Emulate slime's eval binds
356 (:bind "C-c C-c" #'eval-defun
357 "C-c C-k" #'acdw/eval-region-or-buffer
358 "C-c C-z" #'ielm)
359
360 ;; Add advice to pulse evaluated regions
361 (:advise eval-region :around
362 (defun eval-region@pulse (fn beg end &rest args)
363 (let ((pulse-flag t))
364 (pulse-momentary-highlight-region beg end))
365 (apply fn beg end args))))
366
367 (:with-mode lisp-interaction-mode ;; -___-
368 (:bind "C-c C-c" #'eval-defun
369 "C-c C-k" #'acdw/eval-region-or-buffer
370 "C-c C-z" #'ielm)))
371
372(setup emacs
373 ;; "Et cetera" settings
374 ;; This should stay as /minimal/ as possible. Anything that can go somewhere
375 ;; else /should/ go there.
376 (:option
377 async-shell-command-display-buffer nil
378 async-shell-command-buffer #'new-buffer
379 attempt-orderly-shutdown-on-fatal-signal nil
380 auto-hscroll-mode 'current-line
381 attempt-stack-overflow-recovery nil
382 echo-keystrokes 0.01
383 find-function-C-source-directory (acdw/find-emacs-source)
384 image-use-external-converter (and (not (version< emacs-version "27"))
385 (or (executable-find "magick")
386 (executable-find "convert")))
387 kill-read-only-ok t
388 kill-ring-max 500 ; RAM is cheap, right?
389 mark-ring-max 50
390 kmacro-ring-max 20
391 search-ring-max 200
392 global-mark-ring-max 100
393 regexp-search-ring-max 100
394 load-prefer-newer t
395 native-comp-async-report-warnings-errors nil
396 password-cache t
397 password-cache-expiry (* 60 5) ; seconds
398 set-mark-command-repeat-pop t
399 hscroll-step 1
400 scroll-step 1)
401
402 (when (fboundp 'command-completion-default-include-p)
403 (setq read-extended-command-predicate
404 #'command-completion-default-include-p))
405
406 (defvar case-map (make-sparse-keymap)
407 "A keymap for setting case in various ways.")
408 (global-set-key (kbd "C-c c") case-map)
409
410 (defvar lookup-map (make-sparse-keymap)
411 "A keymap for looking up things.")
412 (global-set-key (kbd "C-c l") lookup-map)
413
414 (:global "M-=" #'count-words
415 "C-M-;" #'comment-or-uncomment-sexp
416 "C-w" #'kill-region-or-backward-word
417 "C-c d" #'acdw/insert-iso-date
418 "M-`" nil
419 "C-x o" #'acdw/other-window-or-switch-buffer
420 "C-x O" #'acdw/other-window-or-switch-buffer-backward
421 "C-c _" #'add-file-local-variable
422 "C-x C-c" #'acdw/fat-finger-exit)
423
424 (global-set-key (kbd "M-n") (kbd "C-u 1 C-v"))
425 (global-set-key (kbd "M-p") (kbd "C-u 1 M-v"))
426
427 ;; inspo: https://github.com/zaeph/.emacs.d/blob/master/init.el#L479
428 (defvar toggle-map (make-sparse-keymap)
429 "A keymap for toggling!")
430 (global-set-key (kbd "C-c t") toggle-map)
431
432 (:with-map toggle-map
433 (:bind "c" #'column-number-mode
434 "l" #'display-line-numbers-mode
435 "d" #'toggle-debug-on-error
436 "s" #'so-long-mode
437 "S" #'scroll-bar-mode))
438
439 ;; Toggle
440 (:with-map toggle-map
441 (:bind "b" (defun acdw/toggle-lexical-binding ()
442 "Toggle `lexical-binding' in the current buffer."
443 (interactive)
444 (setq lexical-binding (not lexical-binding))
445 (message "Lexical-binding is %sabled."
446 (if lexical-binding "en" "dis"))
447 (force-mode-line-update))))
448
449
450 (:with-map case-map
451 (require 'titlecase)
452 (require 'acdw)
453 (:bind "c" #'capitalize-dwim
454 "t" #'titlecase-dwim
455 "u" #'upcase-dwim
456 "l" #'downcase-dwim))
457
458 (column-number-mode +1))
459
460(setup encoding
461 (:option locale-coding-system 'utf-8-unix
462 coding-system-for-read 'utf-8-unix
463 coding-system-for-write 'utf-8-unix
464 buffer-file-coding-system 'utf-8-unix
465 default-process-coding-system '(utf-8-unix . utf-8-unix)
466 x-select-request-type '(UTF8_STRING
467 COMPOUND_TEXT
468 TEXT
469 STRING))
470
471 (set-charset-priority 'unicode)
472 (set-language-environment "UTF-8")
473 (prefer-coding-system 'utf-8-unix)
474 (set-default-coding-systems 'utf-8-unix)
475 (set-terminal-coding-system 'utf-8-unix)
476 (set-keyboard-coding-system 'utf-8-unix)
477
478 (acdw/system
479 (:work (set-clipboard-coding-system 'utf-16-le)
480 (set-selection-coding-system 'utf-16-le))
481 (_ (set-selection-coding-system 'utf-8)
482 (set-clipboard-coding-system 'utf-8))))
483 74
484(setup eshell 75(setup eshell
485 (:also-load acdw-eshell 76 (:also-load +eshell
486 em-smart 77 em-smart
487 em-tramp) 78 em-tramp)
488 79 (:option eshell-aliases-file (.etc "eshell/aliases" t)
489 (:option eshell-aliases-file (acdw/dir "eshell/aliases" t)
490 eshell-destroy-buffer-when-process-dies t 80 eshell-destroy-buffer-when-process-dies t
491 eshell-directory-name (acdw/dir "eshell/" t) 81 eshell-directory-name (.etc "eshell/" t)
492 eshell-error-if-no-glob t 82 eshell-error-if-no-glob t
493 eshell-hist-ignore-dups t 83 eshell-hist-ignore-dups t
494 eshell-kill-on-exit nil 84 eshell-kill-on-exit nil
495 eshell-prefer-lisp-functions t ; I want to try using eshell 85 eshell-prefer-lisp-functions t
496 eshell-prefer-lisp-variables t ; as much as possible. 86 eshell-prefer-lisp-variables t
497 eshell-review-quick-commands nil 87 eshell-review-quick-commands nil
498 eshell-save-history-on-exit t 88 eshell-save-history-on-exit t
499 eshell-scroll-to-bottom-on-input 'all 89 eshell-scroll-to-bottom-on-input 'all
500 eshell-smart-space-goes-to-end t 90 eshell-smart-space-goes-to-end t
501 eshell-where-to-jump 'begin) 91 eshell-where-to-jump 'begin)
502
503 (:local-set outline-regexp eshell-prompt-regexp 92 (:local-set outline-regexp eshell-prompt-regexp
504 page-delimiter eshell-prompt-regexp) 93 page-delimiter eshell-prompt-regexp)
505 94 (:bind "C-d" '+eshell-quit-or-delete-char)
506 (:hook #'eshell-arg-hist-mode 95 (:when-loaded
507 (defun eshell-mode@setup () 96 (setenv "PAGER" "cat")))
508 (require 'eshellrc (locate-user-emacs-file "eshell") :noerror) 97
509 (:bind "C-d" #'eshell-quit-or-delete-char)))) 98(setup magit
510 99 ;; This setup is weird because of dependency issues
511(setup eww 100 (:straight (transient :host github :repo "magit/transient" :branch "master")
512 (:also-load acdw-eww) 101 (magit :host github :repo "magit/magit")
513 (defvar-local eww-readable-p nil 102 (git-modes :host github :repo "magit/git-modes"))
514 "Whether current buffer is in readable-mode.") 103 (when (eq system-type 'gnu/linux)
515 (:option eww-search-prefix "https://duckduckgo.com/html?q=" 104 (:straight (forge :host github :repo "magit/forge"))
516 url-privacy-level '(email agent cookies lastloc)) 105 (with-eval-after-load 'magit
517 106 (require 'forge)
518 (defun eww@is-readable (&rest _) 107 (add-to-list 'forge-alist
519 (setq-local eww-readable-p t)) 108 '("tildegit.org" "tildegit.org/api/v1" "tildegit.org"
520 (defun eww@is-not-readable (&rest _) 109 forge-gitea-repository)))))
521 (setq-local eww-readable-p nil)) 110
522 111(setup (:straight 0x0)
523 (advice-add 'eww-readable :after #'eww@is-readable) 112 (:option 0x0-default-server 'ttm)
524 (advice-add 'eww-render :after #'eww@is-not-readable) 113 (with-eval-after-load 'embark
525 (advice-add 'eww-back-url :after #'eww@is-not-readable) 114 (define-key embark-region-map (kbd "U") '0x0-dwim)))
526 115
527 (:hook #'reading-mode 116(setup (:straight acme-theme)
528 (defun bookmark-eww--setup () 117 ;; (load-theme 'acme t)
529 "Setup eww bookmark integration."
530 (setq-local bookmark-make-record-function #'bookmark-eww--make)))
531
532 (:bind "RET" (defun eww/browse-url (arg)
533 (interactive "P")
534 (if-let ((url (thing-at-point 'url)))
535 (browse-url url)
536 (call-interactively #'acdw/link-hint-open-link)))
537 "b" #'bookmark-set
538 "B" #'bookmark-jump
539 "M-n" nil
540 "M-p" nil))
541
542(setup executable
543 (:option executable-prefix-env t)
544 (add-hook 'after-save-hook
545 #'executable-make-buffer-file-executable-if-script-p))
546
547(setup files
548 (:option auto-save-file-name-transforms `((".*" ,(acdw/dir "auto-save/" t) t))
549 auto-save-list-file-prefix (acdw/dir "auto-save-list/.saves-" t)
550 auto-save-interval 60
551 auto-save-timeout 60
552 auto-save-visited-interval auto-save-timeout
553 backup-by-copying t
554 backup-directory-alist `((".*" . ,(acdw/dir "backup/" t)))
555 delete-old-versions t
556 mode-require-final-newline 'visit-save
557 tramp-backup-directory-alist backup-directory-alist
558 vc-make-backup-files t
559 version-control t)
560 (auto-save-visited-mode +1))
561
562(setup find-func
563 (:global "C-c l f" #'find-function
564 "C-c l l" #'find-library
565 "C-c l v" #'find-variable))
566
567(setup flymake
568 ;; TODO: look at flycheck for ideas around `flycheck-disabled-checkers' and
569 ;; `flycheck-emacs-lisp-load-path'... there must be a way to get flymake to
570 ;; recognize new values in the load path.
571 (defvar-local flymake-inhibit nil
572 "Buffer-local variable to inhibit `flymake'.")
573 (add-to-list 'safe-local-variable-values '(flymake-inhibit . t))
574 (add-to-list 'safe-local-variable-values '(flymake-inhibit . nil))
575
576 (defvar flymake-inhibit-major-modes nil
577 "Which major-modes NOT to enable `flymake' in.")
578
579 (defvar flymake-inhibit-file-name-regexps '("init\\.el\\'"
580 "early-init\\.el\\'")
581 "List of file regexps NOT to enable `flymake' in.")
582
583 (defvar flymake-inhibit-buffer-name-regexps (list (rx "*scratch*"))
584 "List of buffer-name regexps NOT to enable `flymake' in.")
585
586 (defun list-string-match-p (string regexp-list)
587 "Return t if at least one regex in RETGEXP-LIST matches STRING, else nil."
588 ;; FINE alphapapa ;P
589 (seq-some (lambda (regexp)
590 (string-match regexp (or string "")))
591 regexp-list))
592
593 (defun flymake-unless ()
594 "Turn on `flymake-mode', UNLESS it's inhibited.
595There are three methods to inhibit flymake in a file. From most
596specific to most general, they are these:
597
598- `flymake-inhibit': a file-local-variable
599
600- `flymake-inhibit-buffer-name-regexps': a list of regexps to
601 match the buffer name against. If one of them matches, inhibit
602 `flymake-mode'.
603
604- `flymake-inhibit-file-name-regexps': a list of regexps to match
605 the filename against. If one of them matches, inhibit
606 `flymake-mode'.
607
608- `flymake-inhibit-major-modes': a list of major-modes in which
609 to inhibit `flymake-mode'. Really only useful if you want to
610 generally add `flymake-mode' to `prog-mode-hook'."
611 ;; The name of this hook tells you pretty much everything you need to know
612 ;; for this little thing right here.
613 (add-hook 'hack-local-variables-hook
614 (defun flymake-unless@hack-local-variables ()
615 (unless (or (cdr (assoc 'flymake-inhibit
616 file-local-variables-alist))
617 (list-string-match-p
618 (buffer-name)
619 flymake-inhibit-buffer-name-regexps)
620 (list-string-match-p
621 (buffer-file-name)
622 flymake-inhibit-file-name-regexps)
623 (apply #'derived-mode-p
624 flymake-inhibit-major-modes))
625 (flymake-mode-on)))))
626
627 (add-hook 'prog-mode-hook #'flymake-unless)
628
629 (:bind "M-n" #'flymake-goto-next-error
630 "M-p" #'flymake-goto-prev-error))
631
632(setup flyspell
633 (:hook-into text-mode))
634
635(setup frames
636 (:option frame-title-format '("%b@"
637 (:eval
638 (or (file-remote-p default-directory 'host)
639 system-name))
640 " %+%* GNU Emacs"
641 (:eval (when (frame-parameter nil 'client)
642 " Client")))
643 window-resize-pixelwise t))
644
645(setup ibuffer
646 (:also-load ibuf-ext)
647 (:option ibuffer-expert t
648 ibuffer-show-empty-filter-groups nil
649 ibuffer-saved-filter-groups
650 '(("default"
651 ("dired" (mode . dired-mode))
652 ("customize" (mode . Custom-mode))
653 ("emacs" (or (name . "^\\*scratch\\*$")
654 (name . "^\\*Messages\\*$")
655 (name . "^\\*Warnings\\*$")
656 (name . "^\\*straight-process\\*$")
657 (name . "^\\*Calendar\\*$")))
658 ("git" (or (name . "^\*magit")
659 (name . "^\magit")))
660 ("help" (or (mode . help-mode)
661 (mode . Info-mode)
662 (mode . helpful-mode)))
663 ("messaging" (or (mode . message-mode)
664 (mode . bbdb-mode)
665 (mode . mail-mode)
666 (mode . gnus-group-mode)
667 (mode . gnus-summary-mode)
668 (mode . gnus-article-mode)
669 (name . "^\\.bbdb$")
670 (name . "^\\.newsrc-dribble")
671 (mode . erc-mode)
672 (mode . circe-server-mode)
673 (mode . circe-channel-mode)))
674 ("shell" (or (mode . eshell-mode)
675 (mode . shell-mode)
676 (mode . vterm-mode)))
677 ("web" (or (mode . elpher-mode)
678 (mode . gemini-mode)
679 (mode . eww-mode))))))
680
681 (:global "C-x C-b" #'ibuffer)
682
683 (:hook (defun ibuffer@filter-to-default ()
684 (ibuffer-switch-to-saved-filter-groups "default"))))
685
686(setup ielm
687 (:hook #'turn-on-eldoc-mode))
688
689(setup imenu
690 (:option imenu-auto-rescan t))
691
692(setup isearch
693 (:option search-default-mode t))
694
695(setup lines
696 (:option fill-column 79
697 word-wrap t
698 truncate-lines nil)
699
700 (global-display-fill-column-indicator-mode -1)
701 (global-so-long-mode +1)
702
703 (add-hook 'visual-line-mode-hook
704 (defun acdw/disable-fill-column-indicator ()
705 (display-fill-column-indicator-mode
706 (if visual-line-mode -1 +1))))
707
708 ;; `acdw/kill-line-and-join-advice' cribs from `crux-kill-and-join-forward'.
709 ;; I can't simply advise `kill-line' with an override from crux because crux
710 ;; itself calls `kill-line', leading to a infinite nesting situation.
711 (advice-add 'kill-line :around
712 (defun kill-line@join (fn &rest args)
713 (if (and (eolp)
714 (not (bolp)))
715 (delete-indentation 1)
716 (apply fn args)))))
717
718(setup minibuffer
719 (:option enable-recursive-minibuffers t
720 file-name-shadow-properties '(invisible t intangible t)
721 minibuffer-eldef-shorten-default t
722 minibuffer-prompt-properties
723 '(read-only t cursor-intangible t face minibuffer-prompt)
724 read-answer-short t
725 read-extended-command-predicate ; used on >28
726 #'command-completion-default-include-p)
727
728 (add-hook 'minibuffer-setup-hook #'cursor-intangible-mode)
729
730 (add-hook 'minibuffer-setup-hook #'acdw/gc-disable)
731 (add-hook 'minibuffer-exit-hook #'acdw/gc-enable)
732
733 (minibuffer-depth-indicate-mode +1)
734 (file-name-shadow-mode +1)
735 (minibuffer-electric-default-mode +1)
736
737 (if (version< emacs-version "28")
738 (fset 'yes-or-no-p #'y-or-n-p)
739 (setq use-short-answers t)))
740
741(setup mouse
742 ;; Unconditionally follow links when clicked.
743 ;; This is because mouse-1 usually sets point.
744 ;; Other options:
745 ;; +[ms] -> perform mouse-2 until held for [ms], then mouse-1
746 ;; -[ms] -> perform mouse-1 until held for [ms], then mouse-2
747 ;; 'double -> mouse-2 on double click
748 ;; nil -> mouse-1 never follows link
749 ;; <anything> -> mouse-1 /always/ follows link
750 (:option mouse-1-click-follows-link t))
751
752(setup mu4e
753 (:load-from "/usr/share/emacs/site-lisp/mu4e")
754 (:autoload (mu4e :interactive t)
755 make-mu4e-context)
756 (:option message-kill-buffer-on-exit t
757 message-send-mail-function #'smtpmail-send-it
758 mu4e-change-filenames-when-moving t
759 mu4e-completing-read-function 'completing-read
760 mu4e-compose-context-policy 'ask-if-none
761 mu4e-context-policy 'ask-if-none
762 mu4e-contexts
763 (list
764 ;; Work
765 (make-mu4e-context
766 :name "Work"
767 :match-func (lambda (msg)
768 (when msg
769 (string-prefix-p
770 work-mail-dir
771 (mu4e-message-field msg :maildir))))
772 :vars `((user-mail-address . ,work-email)
773 (smtpmail-smtp-server . ,work-smtp-server)
774 (mu4e-compose-format-flowed . nil)
775 (mu4e-drafts-folder
776 . ,(concat work-mail-dir "/[Gmail]/Drafts"))
777 (mu4e-sent-folder
778 . ,(concat work-mail-dir "/[Gmail]/Sent Mail"))
779 (mu4e-refile-dir
780 . ,(concat work-mail-dir "/[Gmail]/All Mail"))
781 (mu4e-trash-folder
782 . ,(concat work-mail-dir "/[Gmail]/Trash"))
783 (mu4e-maildir-shortcuts
784 . ,(mapcar (lambda (cell)
785 (let ((dir (car cell))
786 (char (cdr cell)))
787 (cons (concat work-mail-dir dir) char)))
788 '(("/Inbox" . ?i)
789 ("/[Gmail]/All Mail" . ?a)
790 ("/[Gmail]/Sent" . ?s)
791 ("/[Gmail]/Drafts" . ?d)
792 ("/[Gmail]/Trash" . ?t))))))
793 ;; Home
794 (make-mu4e-context
795 :name "Home"
796 :match-func (lambda (msg)
797 (when msg
798 (string-prefix-p
799 home-mail-dir
800 (mu4e-message-field msg :maildir))))
801 :vars `((user-mail-address . ,home-email)
802 (smtpmail-smtp-server . ,home-smtp-server)
803 (mu4e-compose-signature . "~ Case")
804 (mu4e-compose-format-flowed . nil)
805 (mu4e-drafts-folder
806 . ,(concat home-mail-dir "/Drafts"))
807 (mu4e-sent-folder
808 . ,(concat home-mail-dir "/Sent"))
809 (mu4e-refile-folder
810 . ,(concat home-mail-dir "/Archive"))
811 (mu4e-trash-folder
812 . ,(concat home-mail-dir "/Trash"))
813 (mu4e-maildir-shortcuts
814 . ,(mapcar (lambda (cell)
815 (let ((dir (car cell))
816 (char (cdr cell)))
817 (cons (concat home-mail-dir dir) char)))
818 '(("/INBOX" . ?i)
819 ("/Archive" . ?a)
820 ("/Sent" . ?s)
821 ("/Drafts" . ?d)
822 ("/Trash" . ?t)))))))
823 mu4e-get-mail-command "mbsync -a"
824 mu4e-maildir "~/mail"
825 mu4e-update-interval (unless
826 ;; I just realized... there is probably a
827 ;; /much/ better way to do this.
828 (file-exists-p
829 (expand-file-name
830 "systemd/user/mbsync.timer"
831 (getenv "XDG_CONFIG_HOME")))
832 (* 60 5))
833 sendmail-program (seq-some #'executable-find
834 '("msmtp"
835 "sendmail"))
836 message-sendmail-f-is-evil t
837 message-sendmail-extra-arguments '("--read-envelope-from")
838 message-send-mail-function #'smtpmail-send-it
839 send-mail-function #'smtpmail-send-it
840 smtpmail-smtp-service 465
841 smtpmail-stream-type 'ssl)
842
843 (:with-mode mu4e-view-mode
844 (:hook #'reading-mode)))
845
846(setup page
847 (:option page-delimiter
848 (rx bol (or "\f" ";;;")
849 (not (any "#")) (* not-newline) "\n"
850 (* (* blank) (opt ";" (* not-newline)) "\n")))
851
852 (defun recenter-to-top (&rest _)
853 "Recenter the cursor to the top of the window."
854 (when (called-interactively-p 'any)
855 (recenter (if (or (null scroll-margin)
856 (zerop scroll-margin))
857 3
858 scroll-margin))))
859
860 (:advise forward-page :after #'recenter-to-top
861 backward-page :after #'recenter-to-top)
862
863 ;; I'm not sure where this is in /my/ version of Emacs
864 ;; (defvar page-navigation-repeat-map
865 ;; (let ((map (make-sparse-keymap)))
866 ;; (define-key map "]" #'forward-page)
867 ;; (define-key map "[" #'backward-page)
868 ;; map)
869 ;; "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.")
870
871 ;; (put 'forward-page 'repeat-map 'page-navigation-repeat-map)
872 ;; (put 'backward-page 'repeat-map 'page-navigation-repeat-map)
873 )
874
875(setup prog
876 (:option show-paren-delay 0
877 show-paren-style 'mixed
878 show-paren-when-point-inside-paren t
879 show-paren-when-point-in-periphery t
880 smie-indent-basic tab-width)
881
882 (:hook #'show-paren-mode
883 #'prettify-symbols-mode
884 ;; #'electric-pair-local-mode
885 #'acdw/setup-fringes
886 #'display-fill-column-indicator-mode
887
888 (defun prog-mode@auto-fill ()
889 (setq-local comment-auto-fill-only-comments t)
890 (turn-on-auto-fill))))
891
892(setup pulse
893 (:option pulse-flag nil
894 pulse-delay 0.5
895 pulse-iterations 1)
896
897 ;; XXX: this doesn't work yet. I only want to pulse the line in the active
898 ;; window, so when I have the same buffer viewed in multiple windows I can
899 ;; still see where my cursor is. To see the issue, C-x 2 then C-x o a few
900 ;; times.
901 (defun pulse-line-current-window (&rest _)
902 "Pulse the current line, but only if this window is active."
903 (pulse-momentary-highlight-one-line (window-point (selected-window))))
904
905 (dolist (func '(scroll-up-command
906 scroll-down-command
907 recenter-top-bottom
908 other-window
909 switch-to-buffer
910 redraw-frame))
911 (advice-add func :after #'pulse-line-current-window)))
912
913(setup re-builder
914 (require 'acdw-re)
915 (:global "C-M-5" #'re-builder
916 "C-M-%" #'re-builder)
917 (:with-map reb-mode-map
918 (:bind "C-c C-k" #'reb-quit
919 "RET" #'reb-replace-regexp))
920 (:with-map reb-lisp-mode-map
921 (:bind "RET" #'reb-replace-regexp)))
922
923(setup repeat
924 ;; new for Emacs 28!
925 (:only-if (fboundp #'repeat-mode))
926
927 (:option repeat-exit-key "g"
928 repeat-exit-timeout 5)
929
930 (repeat-mode +1))
931
932(setup saveplace
933 (:option save-place-file (acdw/dir "places.el")
934 save-place-forget-unreadable-files (acdw/system :home))
935
936 (save-place-mode +1))
937
938(setup scratch
939 (:option inhibit-startup-screen t
940 initial-buffer-choice t
941 initial-major-mode #'lisp-interaction-mode
942 lexical-binding t
943 initial-scratch-message
944 (concat ";; Howdy, "
945 (nth 0 (split-string
946 user-full-name))
947 "! "
948 "Welcome to GNU Emacs.\n\n"))
949
950 (add-hook 'kill-buffer-query-functions
951 (defun kill-buffer-query@immortal-scratch ()
952 (if (eq (current-buffer) (get-buffer "*scratch*"))
953 (progn (bury-buffer)
954 nil)
955 t))))
956
957(setup scrolling
958 (:option auto-window-vscroll nil
959 fast-but-imprecise-scrolling t
960 scroll-margin 3
961 scroll-conservatively 101
962 scroll-preserve-screen-position 1))
963
964(setup selection
965 (:option save-interprogram-paste-before-kill t
966 yank-pop-change-selection t
967 x-select-enable-clipboard t
968 x-select-enable-primary t
969 mouse-drag-copy-region t
970 kill-do-not-save-duplicates t)
971
972 (delete-selection-mode +1))
973
974(setup sh-mode
975 (:option sh-basic-offset tab-width
976 sh-indent-after-case 0
977 sh-indent-for-case-alt '+
978 sh-indent-for-case-label 0)
979
980 (:local-set indent-tabs-mode t)
981
982 (when (executable-find "shfmt")
983 (with-eval-after-load 'apheleia
984 (:option (append apheleia-formatters) '(shfmt . ("shfmt"))
985 (append apheleia-mode-alist) '(sh-mode . shfmt))))
986
987 (when (executable-find "shellcheck")
988 (:straight flymake-shellcheck)
989 (:hook flymake-mode
990 flymake-shellcheck-load)))
991
992(setup shell-command
993 (:option shell-command-switch (acdw/system
994 ;; I should be testing on some variable
995 (:home "-csi")
996 (:work "-c"))
997 shell-command-prompt-show-cwd t
998 shell-command-default-error-buffer "*shell-command-errors*"))
999
1000(setup shr
1001 (:option shr-width fill-column
1002 shr-max-image-proportion 0.6
1003 shr-image-animate t
1004 shr-discard-aria-hidden t))
1005
1006(setup text
1007 (:hook turn-on-auto-fill
1008 tildify-mode
1009 acdw/setup-fringes))
1010
1011(setup uniquify
1012 (:option uniquify-buffer-name-style 'forward
1013 uniquify-separator path-separator
1014 uniquify-after-kill-buffer-p t
1015 uniquify-ignore-buffers-re "^\\*"))
1016
1017(setup variable-pitch-mode
1018 ;; I might want to change this to `buffer-face-mode-hook'...
1019 (:advise variable-pitch-mode :after
1020 (defun variable-pitch-mode@setup (&rest _)
1021 "Set up `variable-pitch-mode' with my customizations."
1022 (display-fill-column-indicator-mode
1023 (if buffer-face-mode -1 +1)))))
1024
1025(setup view
1026 (:option view-read-only t)
1027
1028 (:hook (defun acdw/read-view-mode ()
1029 (reading-mode (if view-mode +1 -1)))))
1030
1031(setup w32
1032 (:option w32-allow-system-shell t
1033 w32-pass-lwindow-to-system nil
1034 w32-lwindow-modifier 'super
1035 w32-pass-rwindow-to-system nil
1036 w32-rwindow-modifier 'super
1037 w32-pass-apps-to-system nil
1038 w32-apps-modifier 'hyper))
1039
1040(setup whitespace
1041 (:option whitespace-style '(empty
1042 indentation
1043 space-before-tab
1044 space-after-tab)
1045 indent-tabs-mode nil
1046 tab-width 4
1047 backward-delete-char-untabify-method 'hungry)
1048
1049 (:global "M-SPC" #'cycle-spacing)
1050 ;; http://ruzkuku.com/emacs.d.html#orgc62eb58
1051 (:advise cycle-spacing :around
1052 (defun cycle-spacing@newlines-by-default (old arg &rest _)
1053 (funcall old (if (numberp arg) (- arg) arg)))))
1054
1055(setup windmove
1056 (:option windmove-wrap-around t)
1057 (:global
1058 ;; moving
1059 "C-x 4 <left>" #'windmove-left
1060 "C-x 4 <right>" #'windmove-right
1061 "C-x 4 <up>" #'windmove-up
1062 "C-x 4 <down>" #'windmove-down
1063 ;; swapping
1064 "C-x 4 S-<left>" #'windmove-swap-states-left
1065 "C-x 4 S-<right>" #'windmove-swap-states-right
1066 "C-x 4 S-<up>" #'windmove-swap-states-up
1067 "C-x 4 S-<down>" #'windmove-swap-states-down)
1068
1069 ;; (when (fboundp 'repeat-mode)
1070 ;; (defvar windmove-repeat-map
1071 ;; (let ((map (make-sparse-keymap)))
1072 ;; ;; moving
1073 ;; (define-key map [left] #'windmove-left)
1074 ;; (define-key map [right] #'windmove-right)
1075 ;; (define-key map [up] #'windmove-up)
1076 ;; (define-key map [down] #'windmove-down)
1077 ;; ;; swapping
1078 ;; (define-key map [S-left] #'windmove-swap-states-left)
1079 ;; (define-key map [S-right] #'windmove-swap-states-right)
1080 ;; (define-key map [S-up] #'windmove-swap-states-up)
1081 ;; (define-key map [S-down] #'windmove-swap-states-down)
1082 ;; map)
1083 ;; "Keymap to repeat various `windmove' sequences. Used in `repeat-mode'.")
1084
1085 ;; (dolist (sym '(windmove-left
1086 ;; windmove-right
1087 ;; windmove-up
1088 ;; windmove-down
1089 ;; windmove-swap-states-left
1090 ;; windmove-swap-states-right
1091 ;; windmove-swap-states-up
1092 ;; windmove-swap-states-down))
1093 ;; (put sym 'repeat-map 'windmove-repeat-map)))
1094 ) 118 )
1095 119
1096(setup window 120(setup (:straight anzu)
1097 ;; (require 'acdw-bell) 121 (:global [remap query-replace] 'anzu-query-replace-regexp
1098 (:option 122 [remap query-replace-regexp] 'anzu-query-replace-regexp)
1099 ;; Man-notify-method 'pushy 123 (global-anzu-mode +1)
1100 ;; display-buffer-alist ; from FrostyX 124 (:bind-into isearch
1101 ;; '(("shell.*" (display-buffer-same-window) ()) 125 [remap isearch-query-replace]
1102 ;; (".*" (display-buffer-reuse-window 126 'anzu-isearch-query-replace
1103 ;; display-buffer-same-window) 127 [remap isearch-query-replace-regexp]
1104 ;; (reusable-frames . t))) 128 'anzu-isearch-query-replace-regexp))
1105 recenter-positions '(top middle bottom)
1106 ;; ring-bell-function
1107 ;; (lambda ()
1108 ;; (acdw-bell/flash-mode-line
1109 ;; (acdw/system :home)))
1110 use-dialog-box nil
1111 use-file-dialog nil
1112 visible-bell nil)
1113
1114 (tooltip-mode -1))
1115
1116(setup winner
1117 ;; see https://lists.gnu.org/archive/html/emacs-devel/2021-08/msg00888.html
1118 (:global "C-x 4 C-/" #'winner-undo
1119 "C-x 4 /" #'winner-undo
1120 "C-x 4 C-?" #'winner-redo
1121 "C-x 4 ?" #'winner-redo)
1122
1123 ;; add `winner-undo' and `winner-redo' to `repeat-mode'
1124 ;; (when (fboundp 'repeat-mode)
1125 ;; (defvar winner-mode-repeat-map
1126 ;; (let ((map (make-sparse-keymap)))
1127 ;; (define-key map "/" #'winner-undo)
1128 ;; (define-key map "?" #'winner-redo)
1129 ;; map)
1130 ;; "Keymap to repeat `winner-mode' sequences. Used in `repeat-mode'.")
1131
1132 ;; (put 'winner-undo 'repeat-map 'winner-mode-repeat-map)
1133 ;; (put 'winner-redo 'repeat-map 'winner-mode-repeat-map))
1134
1135 (winner-mode +1))
1136
1137(setup (:straight (0x0
1138 :host gitlab
1139 :repo "willvaughn/emacs-0x0"))
1140 (:option 0x0-default-server 'ttm))
1141
1142(setup (:straight (actually-selected-window
1143 :host github
1144 :repo "duckwork/actually-selected-window.el"))
1145 (actually-selected-window-mode +1))
1146
1147(setup (:straight-when affe
1148 (and (or (executable-find "fd")
1149 (executable-find "find"))
1150 (executable-find "rg")))
1151 ;; Keys are bound in `acdw/sensible-grep' and `acdw/sensible-find'
1152 (:option affe-regexp-compiler
1153 (defun affe-orderless-regexp-compiler (input _type)
1154 (setq input (orderless-pattern-compiler input))
1155 (cons input (lambda (str) (orderless--highlight input str))))))
1156
1157(setup (:straight-when ahk-mode
1158 (acdw/system :work)))
1159
1160(setup (:straight alert)
1161 (:option alert-default-style (acdw/system
1162 (:home 'libnotify)
1163 (_ 'message))))
1164
1165(setup (:straight (apheleia
1166 :host github
1167 :repo "raxod502/apheleia"))
1168
1169 (require 'acdw-apheleia)
1170 (add-hook 'before-save-hook #'apheleia-dumb-auto-format)
1171
1172 ;; Aphelia can't find prettier on Windows (though I
1173 ;; installed it, I think), and it keeps trying to start
1174 ;; new processes until Emacs runs out of subprocess space.
1175 ;; So I just enable it at home.
1176 (unless (acdw/system :work)
1177 (apheleia-global-mode +1)))
1178
1179(setup (:straight async)
1180 (dired-async-mode +1))
1181 129
1182(setup (:straight avy) 130(setup (:straight avy)
1183 (:global "M-j" #'avy-goto-char-timer 131 (:also-load +avy)
1184 "C-c C-j" #'avy-resume) 132 (:global "M-j" 'avy-goto-char-timer)
133 (:bind-into isearch
134 "M-j" 'avy-isearch)
135 (:when-loaded
136 (setf (alist-get ?. avy-dispatch-alist) 'avy-action-embark)))
1185 137
1186 (:with-feature isearch 138(setup (:straight (capf-autosuggest
1187 (:bind "M-j" #'avy-isearch))) 139 :repo "https://repo.or.cz/emacs-capf-autosuggest.git"))
140 (:hook-into eshell-mode
141 comint-mode))
1188 142
1189(setup (:straight circe) 143(setup (:straight circe)
1190 (require 'circe) 144 (:require _circe)
1191 (require 'acdw-irc) 145 (:require +circe)
1192 (:also-load acdw-circe) 146 (autoload '+irc "+circe" "Connect to IRC." t)
1193
1194 (defun acdw-circe/format-meta (string)
1195 "Return a format string for `lui-format'."
1196 (format "{nick:%1$d.%1$ds} *** %s" (- acdw-irc/left-margin 3) string))
1197 147
1198 (:option acdw-irc/left-margin 20 148 ;; Formatting options
1199 circe-channel-killed-confirmation nil 149 (:option circe-format-action (format (format "%%%ds* {nick} {body}"
1200 circe-color-nicks-everywhere t 150 (- +circe-left-margin 2))
1201 circe-default-nick "acdw" 151 " ")
1202 circe-default-part-message "See You, Space Cowpokes . . ." 152 circe-format-say (format "{nick:%1$d.%1$ds} | {body}"
1203 circe-default-user "acdw" 153 (- +circe-left-margin 3))
1204 circe-format-action (format
1205 (format "%%%ds* {nick} {body}"
1206 (- acdw-irc/left-margin 2)) " ")
1207 circe-format-say (format
1208 "{nick:%1$d.%1$ds} | {body}"
1209 (- acdw-irc/left-margin 3))
1210 circe-format-self-action circe-format-action 154 circe-format-self-action circe-format-action
1211 circe-format-self-say (format 155 circe-format-self-say (replace-regexp-in-string "|" ">"
1212 "{nick:%1$d.%1$ds} > {body}" 156 circe-format-say)
1213 (- acdw-irc/left-margin 3)) 157 circe-format-server-part (+circe-format-meta
1214 circe-format-server-part (acdw-circe/format-meta
1215 "PART {channel}: {reason}") 158 "PART {channel}: {reason}")
1216 circe-format-server-quit (acdw-circe/format-meta "QUIT: {reason}") 159 circe-format-server-quit (+circe-format-meta "QUIT: {reason}")
1217 circe-format-server-quit-channel (acdw-circe/format-meta 160 circe-format-server-quit-channel (+circe-format-meta
1218 "QUIT {channel}: {reason}") 161 "QUIT {channel}: {reason}")
1219 circe-format-server-join (acdw-circe/format-meta "JOIN: {userinfo}") 162 circe-format-server-join (+circe-format-meta "JOIN: {userinfo}")
1220 circe-format-server-rejoin (acdw-circe/format-meta 163 circe-format-server-rejoin (+circe-format-meta
1221 (concat "REJOIN: {userinfo}" 164 (concat "REJOIN: {userinfo} "
1222 " after {departuredelta}")) 165 "after {departuredelta}"))
1223 circe-format-server-topic (acdw-circe/format-meta 166 circe-format-server-topic (+circe-format-meta
1224 "TOPIC: {new-topic}") 167 "TOPIC: {new-topic}")
1225 circe-prompt-string (format (format "%%%ds> " 168 circe-prompt-string (format (format "%%%ds> "
1226 (- acdw-irc/left-margin 2)) 169 (- +circe-left-margin 2))
1227 " ") 170 " "))
171
172 (:option +circe-network-inhibit-autoconnect _circe-network-inhibit-autoconnect
173 circe-network-options _circe-network-options
174 circe-color-nicks-everywhere t
175 circe-default-part-message "See You, Space Cowpokes . . ."
176 circe-default-user user-real-login-name
1228 circe-reduce-lurker-spam t 177 circe-reduce-lurker-spam t
1229 circe-server-auto-join-default-type :after-auth 178 circe-server-auto-join-default-type :after-auth)
1230 circe-server-buffer-action (lambda (buf) 179 (:bind "C-c C-p" 'circe-command-PART
1231 (message "Connected to %s" buf))) 180 "C-c C-t" '+circe-current-topic
1232 181 "C-l" 'lui-track-jump-to-indicator
1233 (with-eval-after-load 'circe 182 "C-<return>" '+circe-chat@set-prompt)
1234 (:face circe-nick-highlight-face
1235 ((t (:inherit (modus-themes-hl-line modus-themes-bold))))
1236 ;; circe-my-message-face
1237 ;; ((t (:inherit (modus-themes-slant))))
1238 ))
1239 183
1240 (with-eval-after-load 'topsy 184 (advice-add 'circe-command-PART :after '+circe-kill-buffer)
1241 (:option (append topsy-mode-functions) 185 (advice-add 'circe-command-QUIT :after '+circe-quit@kill-buffer)
1242 '(circe-channel-mode . circe-current-topic))) 186 (advice-add 'circe-command-GQUIT :after '+circe-gquit@kill-buffer)
1243 187
1244 (:bind "C-c C-p" #'circe-command-PART
1245 "C-c C-t" #'circe-current-topic ; in acdw-circe.el
1246 "C-l" #'lui-track-jump-to-indicator
1247 "<C-return>" #'circe-chat@set-prompt)
1248
1249 (:advise circe-command-PART :after #'circe-part@kill-buffer
1250 circe-command-QUIT :after #'circe-quit@kill-buffer
1251 circe-command-GQUIT :after #'circe-gquit@kill-buffer)
1252
1253 (:with-mode circe-chat-mode 188 (:with-mode circe-chat-mode
1254 (:hook #'acdw/stop-paren-annoyances 189 (:hook 'enable-circe-color-nicks
1255 #'enable-circe-color-nicks 190 'enable-circe-new-day-notifier
1256 ;; #'enable-circe-display-images 191 '+circe-chat@set-prompt)
1257 #'enable-circe-new-day-notifier 192 (:bind "C-c C-s" 'circe-command-SLAP))
1258 #'circe-chat@set-prompt
1259 #'topsy-mode))
1260 (:bind "C-c C-s" #'circe-command-SLAP)
1261
1262 (autoload 'circe-nick-color-reset "circe-color-nicks")
1263 (add-hook 'modus-themes-after-theme-hook
1264 #'circe-nick-color-reset)
1265 193
1266 (:with-mode lui-mode 194 (:with-mode lui-mode
1267 (:option lui-fill-column (+ fill-column acdw-irc/left-margin) 195 (:option lui-fill-column (+ fill-column +circe-left-margin)
1268 lui-fill-type nil ;;(repeat-string acdw-irc/left-margin " ") 196 lui-fill-type nil
1269 lui-time-stamp-position 'right-margin 197 lui-time-stamp-position 'right-margin
1270 lui-time-stamp-format "%H:%M" 198 lui-time-stamp-format "[ %H:%M"
1271 lui-track-behavior 'before-switch-to-buffer 199 lui-track-behavior 'before-switch-to-buffer
1272 lui-track-indicator 'fringe 200 lui-track-indicator 'fringe
1273 lui-fill-remove-face-from-newline nil) 201 lui-fill-remove-face-from-newline nil)
1274 202 (:hook 'visual-line-mode
1275 (:hook #'visual-fill-column-mode 203 'enable-lui-track
1276 #'visual-line-mode 204 'visual-fill-column-mode)
1277 #'enable-lui-track) 205 (:local-set fringes-outside-margins t
1278 206 right-margin-width (length lui-time-stamp-format)
1279 (:face lui-time-stamp-face
1280 ((t :inherit font-lock-comment-face)))
1281
1282 (:local-set visual-fill-column-extra-text-width
1283 (cons acdw-irc/left-margin 0)
1284 fringes-outside-margins t
1285 right-margin-width 5
1286 scroll-margin 0 207 scroll-margin 0
1287 word-wrap t 208 word-wrap t
1288 wrap-prefix (repeat-string acdw-irc/left-margin " ") 209 wrap-prefix (+string-repeat +circe-left-margin " ")
1289 nyan-mode nil
1290 line-number-mode nil 210 line-number-mode nil
1291 column-number-mode nil 211 column-number-mode nil
1292 file-percentage-mode nil)) 212 file-percentage-mode nil
213 visual-fill-column-extra-text-width
214 (cons +circe-left-margin 0)))
1293 215
1294 (add-hook 'kill-emacs-hook 216 (add-hook 'kill-emacs-hook
1295 (defun circe-quit-all () 217 (defun circe-quit-all ()
1296 (ignore-errors 218 (ignore-errors
1297 (advice-remove 'circe-command-GQUIT 'circe-gquit@kill-buffer) 219 (advice-remove 'circe-command-GQUIT
220 'circe-gquit@kill-buffer)
1298 (circe-command-GQUIT "Quitting Emacs, bye!"))))) 221 (circe-command-GQUIT "Quitting Emacs, bye!")))))
1299 222
1300(setup (:straight (command-log-mode 223(setup (:straight consult)
1301 :host github 224 (:also-load +consult)
1302 :repo "positron-solutions/command-log-mode")) 225 ;; from Consult wiki
1303 ;; I have many ideas as to how to change this.
1304 (:option clm-window-text-scale 0
1305 clm-logging-shows-buffer t
1306 clm-log-globally t
1307 clm-exceptions '(self-insert-command)
1308 clm-window-size 0.25)
1309 (el-patch-feature command-log-mode)
1310 (with-eval-after-load 'command-log-mode
1311 (el-patch-defun clm--show-buffer (&optional clear)
1312 "Displays the command log buffer in a window.
1313CLEAR will clear the buffer if it exists before returning it."
1314 (let ((buffer (clm--setup-buffer clear)))
1315 (let ((win (get-buffer-window buffer)))
1316 (unless (windowp win)
1317 (let ((new-win (el-patch-swap
1318 (split-window-horizontally
1319 (- 0 clm-window-size))
1320 (if (< (window-pixel-width) (window-pixel-height))
1321 (split-window-vertically
1322 (- (if (floatp clm-window-size)
1323 (floor (* (window-height) clm-window-size))
1324 clm-window-size)))
1325 (split-window-horizontally
1326 (- (if (floatp clm-window-size)
1327 (floor (* (window-width) clm-window-size))
1328 clm-window-size)))))))
1329 (set-window-buffer new-win buffer)
1330 (set-window-dedicated-p new-win t)
1331 (el-patch-add
1332 (with-current-buffer buffer
1333 (setq-local mode-line-format nil)))))
1334 buffer)))))
1335
1336(setup (:straight (consult
1337 :host github
1338 :repo "minad/consult"))
1339
1340 (:require acdw-consult)
1341 (:autoload consult-register-preview)
1342
1343 ;; Bindings
1344 (:global
1345 ;; C-c bindings (`mode-specific-map')
1346 ;; I don't use any of these right now.
1347 ;; "C-c h" #'consult-history
1348 ;; "C-c m" #'consult-mode-command
1349 ;; "C-c b" #'consult-bookmark
1350 ;; "C-c k" #'consult-kmacro
1351 ;; C-x bindings (`ctl-x-map')
1352 "C-x M-:" #'consult-complex-command
1353 "C-x b" #'consult-buffer
1354 "C-x 4 b" #'consult-buffer-other-window
1355 "C-x 5 b" #'consult-buffer-other-frame
1356 ;; Custom M-# bindings for fast register access
1357 "M-#" #'consult-register-load
1358 "M-'" #'consult-register-store
1359 "C-M-#" #'consult-register
1360 ;; M-g bindings (`goto-map')
1361 "M-g e" #'consult-compile-error
1362 "M-g g" #'consult-goto-line
1363 "M-g M-g" #'consult-goto-line
1364 "M-g o" #'consult-outline
1365 "M-g m" #'consult-mark
1366 "M-g k" #'consult-global-mark
1367 "M-g i" #'consult-imenu
1368 "M-g I" #'consult-project-imenu
1369 ;; M-s bindings (`search-map')
1370 "M-s g" #'acdw-consult/sensible-grep
1371 "M-s f" #'acdw-consult/sensible-find
1372 "M-s l" #'consult-line
1373 "M-s m" #'consult-multi-occur
1374 "M-s k" #'consult-keep-lines
1375 "M-s u" #'consult-focus-lines
1376 ;; Other bindings
1377 "M-y" #'consult-yank-pop
1378 "<help> a" #'consult-apropos
1379 ;; Isearch integration
1380 "M-s e" #'consult-isearch)
1381
1382 (:with-map isearch-mode-map
1383 (:bind "M-e" #'consult-isearch
1384 "M-s e" #'consult-isearch
1385 "M-s l" #'consult-line))
1386
1387 (:option (append consult-buffer-sources) #'circe-buffer-source)
1388
1389 (consult-history-to-modes ((minibuffer-local-map . nil)
1390 (shell-mode-map . shell-mode-hook)
1391 (term-mode-map . term-mode-hook)
1392 (term-raw-map . term-mode-hook)
1393 (comint-mode-map . comint-mode-hook)
1394 (sly-mrepl-mode-map . sly-mrepl-hook)))
1395
1396 (:option register-preview-delay 0 226 (:option register-preview-delay 0
1397 register-preview-function #'consult-register-format 227 register-preview-function 'consult-register-format
1398 xref-show-xrefs-function #'consult-xref 228 xref-show-xrefs-function 'consult-xref
1399 xref-show-definitions-function #'consult-xref 229 xref-show-definitions-function 'consult-xref
1400 consult-project-root-function #'vc-root-dir 230 tab-always-indent 'complete
1401 completion-in-region-function #'acdw-consult/complete-in-region 231 completion-in-region-function 'consult-completion-in-region)
1402 completion-cycle-threshold 3 232 (advice-add 'register-preview :override 'consult-register-window)
1403 consult-preview-key (kbd "M-.") 233 (advice-add 'completing-read-multiple :override
1404 tab-always-indent 'complete) 234 'consult-completing-read-multiple)
1405 235 (dolist (binding '(;; C-c bindings (mode-specific-map)
1406 (:advise register-preview :override #'consult-register-window) 236 ("C-c h" . consult-history)
1407 237 ("C-c m" . consult-mode-command)
1408 ;; Completing-read-multple 238 ("C-c b" . consult-bookmark)
1409 (if (fboundp #'consult-completing-read-multiple) 239 ("C-c k" . consult-kmacro)
1410 (:advise completing-read-multple :override 240 ;; C-x bindings (ctl-x-map)
1411 #'consult-completing-read-multiple) 241 ("C-x M-:" . consult-complex-command)
1412 (:advise completing-read-multiple :filter-args 242 ("C-x b" . consult-buffer)
1413 (defun crm-indicator (args) 243 ("C-x 4 b" . consult-buffer-other-window)
1414 (cons (concat "[CRM] " (car args)) (cdr args))))) 244 ("C-x 5 b" . consult-buffer-other-frame)
1415 245 ;; Custom M-# bindings for fast register access
1416 (with-eval-after-load 'orderless 246 ("M-#" . consult-register-load)
1417 (:option consult--regexp-compiler 247 ("M-'" . consult-register-store)
1418 #'consult--orderless-regexp-compiler)) 248 ("C-M-#" . consult-register)
1419 249 ;; Other custom bindings
1420 (with-eval-after-loads (vertico consult) 250 ("M-y" . consult-yank-pop)
1421 (:with-map consult-crm-map 251 ("<help> a" . consult-apropos)
1422 (:bind "RET" (defun +vertico-crm-exit () 252 ;; M-g bindings (goto-map)
1423 (interactive) 253 ("M-g e" . consult-compile-error)
1424 (run-at-time 0 nil #'vertico-exit) 254 ("M-g f" . consult-flymake) ; or consult-flycheck
1425 (funcall #'vertico-exit)) 255 ("M-g g" . consult-goto-line)
1426 "TAB" #'vertico-exit)))) 256 ("M-g M-g" . consult-goto-line)
1427 257 ("M-g o" . consult-outline) ; or consult-org-heading
1428(setup (:straight consult-dir) 258 ("M-g m" . consult-mark)
1429 (:with-feature project 259 ("M-g k" . consult-global-mark)
1430 (:autoload project--read-project-list)) 260 ("M-g i" . consult-imenu)
1431 (:global "C-x C-d" #'consult-dir) 261 ("M-g I" . consult-imenu-multi)
1432 (with-eval-after-load 'vertico 262 ;; M-s bindings (search-map)
1433 (:with-map vertico-map 263 ("M-s f" . consult-find)
1434 (:bind "C-x C-d" #'consult-dir 264 ("M-s F" . consult-locate)
1435 "C-x C-j" #'consult-dir-jump-file)))) 265 ("M-s g" . consult-grep)
1436 266 ("M-s G" . consult-git-grep)
1437(setup (:straight crux) 267 ("M-s r" . consult-ripgrep)
1438 (:global "C-o" #'crux-smart-open-line 268 ("M-s l" . consult-line)
1439 "M-o" #'open-paragraph 269 ("M-s L" . consult-line-multi)
1440 "C-M-\\" #'crux-cleanup-buffer-or-region 270 ("M-s m" . consult-multi-occur)
1441 "C-x 4 t" #'crux-transpose-windows) 271 ("M-s k" . consult-keep-lines)
1442 272 ("M-s u" . consult-focus-lines)
1443 (el-patch-feature crux) 273 ;; Isearch integration
1444 (with-eval-after-load 'crux 274 ("M-s e" . consult-isearch-history)))
1445 (el-patch-defun crux-reopen-as-root () 275 (global-set-key (kbd (car binding)) (cdr binding)))
1446 "Find file as root if necessary. 276 (with-eval-after-load 'isearch-mode
1447 277 (dolist (binding '(("M-e" . consult-isearch-history)
1448Meant to be used as `find-file-hook'. 278 ("M-s e" . consult-isearch-history)
1449See also `crux-reopen-as-root-mode'." 279 ("M-s l" . consult-line)
1450 (unless (or 280 ("M-s L" . consult-line-multi)))
1451 ;; This helps fix for `nov-mode', and possibly others. 281 (define-key isearch-mode-map (car binding) (cdr binding))))
1452 (el-patch-add (null buffer-file-name)) 282 (with-eval-after-load 'org-mode
1453 (tramp-tramp-file-p buffer-file-name) 283 (define-key org-mode-map "M-g o" 'consult-org-heading))
1454 (equal major-mode 'dired-mode) 284 (with-eval-after-load 'consult
1455 (not (file-exists-p (file-name-directory buffer-file-name))) 285 (:option consult-narrow-key "<"
1456 (file-writable-p buffer-file-name) 286 consult-project-root-function '+consult-project-root)
1457 (crux-file-owned-by-user-p buffer-file-name)) 287 (consult-customize
1458 (crux-find-alternate-file-as-root buffer-file-name)))) 288 consult-theme
1459 289 :preview-key '(:debounce 0.2 any)
1460 (crux-reopen-as-root-mode +1)) 290 consult-ripgrep consult-git-grep consult-grep
1461 291 consult-bookmark consult-recent-file consult-xref
1462;; (setup (:straight-when 292 consult--source-file consult--source-project-file
1463;; (define-repeat-map 293 consult--source-bookmark
1464;; :host nil 294 :preview-key (kbd "M-."))
1465;; :repo "https://tildegit.org/acdw/define-repeat-map.el") 295 (consult-history-to-modes ((minibuffer-local-map . nil)
1466;; (acdw/system :home)) 296 (shell-mode-map . shell-mode-hook)
1467 297 (term-mode-map . term-mode-hook)
1468;; (require 'define-repeat-map ; just for me 298 (term-raw-map . term-mode-hook)
1469;; (acdw/dir 299 (comint-mode-map . comint-mode-hook)
1470;; "straight/build/define-repeat-map/define-repeat-map.el")) 300 (sly-mrepl-mode-map . sly-mrepl-hook)))
1471 301 (with-eval-after-load 'orderless
1472;; (defun acdw/other-window-or-switch-buffer-backward () 302 (:option consult--regexp-compiler 'consult--orderless-regexp-compiler))))
1473;; (interactive)
1474;; (setq repeat-map 'other-window-repeat-map)
1475;; (acdw/other-window-or-switch-buffer -1))
1476
1477;; (define-repeat-map other-window
1478;; ("o" acdw/other-window-or-switch-buffer
1479;; "O" acdw/other-window-or-switch-buffer-backward))
1480
1481;; (define-repeat-map case
1482;; ("c" capitalize-word
1483;; "u" upcase-dwim
1484;; "l" downcase-dwim)
1485;; (:continue "f" forward-word
1486;; "b" backward-word)
1487;; (:enter capitalize-dwim
1488;; upcase-dwim
1489;; downcase-dwim))
1490
1491;; (define-repeat-map page-navigation
1492;; ("]" forward-page
1493;; "[" backward-page))
1494
1495;; (define-repeat-map windmove
1496;; (;; moving
1497;; "<left>" windmove-left
1498;; "<right>" windmove-right
1499;; "<up>" windmove-up
1500;; "<down>" windmove-down
1501;; ;; swapping
1502;; "<S-left>" windmove-swap-states-left
1503;; "<S-right>" windmove-swap-states-right
1504;; "<S-up>" windmove-swap-states-up
1505;; "<S-down>" windmove-swap-states-down))
1506
1507;; (define-repeat-map winner-mode
1508;; ("/" winner-undo
1509;; "?" winner-redo)))
1510 303
1511(setup (:straight dictionary) 304(setup (:straight dictionary)
1512 (:option dictionary-use-single-buffer t) 305 (:option dictionary-use-single-buffer t)
1513
1514 (autoload 'dictionary-search "dictionary" 306 (autoload 'dictionary-search "dictionary"
1515 "Ask for a word and search it in all dictionaries" t) 307 "Ask for a word and search it in all dictionaries" t)
1516 (autoload 'dictionary-match-words "dictionary" 308 (autoload 'dictionary-match-words "dictionary"
@@ -1526,226 +318,29 @@ See also `crux-reopen-as-root-mode'."
1526 (autoload 'dictionary-tooltip-mode "dictionary" 318 (autoload 'dictionary-tooltip-mode "dictionary"
1527 "Display tooltips for the current word" t) 319 "Display tooltips for the current word" t)
1528 (autoload 'global-dictionary-tooltip-mode "dictionary" 320 (autoload 'global-dictionary-tooltip-mode "dictionary"
1529 "Enable/disable dictionary-tooltip-mode for all buffers" t) 321 "Enable/disable dictionary-tooltip-mode for all buffers" t))
1530
1531 (define-key lookup-map "d" #'dictionary-search)
1532
1533 (:hook #'reading-mode))
1534
1535(setup (:straight (dogears
1536 :host github
1537 :repo "alphapapa/dogears.el"
1538 :files (:defaults
1539 (:exclude "helm-dogears.el"))))
1540 (:option (append savehist-additional-variables) 'dogears-list)
1541 (with-eval-after-load 'dogears
1542 (dolist (mode '(magit-status-mode
1543 elfeed-show-mode
1544 elfeed-search-mode))
1545 (:option (append dogears-ignore-modes) mode)))
1546 (:global "M-g d" dogears-go)
1547 (:autoload dogears-mode)
1548 (dogears-mode +1))
1549
1550(setup (:straight edit-indirect))
1551 322
1552;; requires extension: 323(setup (:straight electric-cursor)
1553;; https://addons.mozilla.org/en-US/firefox/addon/edit-with-emacs1/
1554(setup (:straight edit-server)
1555 (:require edit-server)
1556 (edit-server-start)
1557
1558 (:option edit-server-default-major-mode 'text-mode
1559 edit-server-url-major-mode-alist
1560 (list (cons (rx (| "reddit.com"
1561 "tildes.net"))
1562 'markdown-mode)
1563 (cons (rx "github.com")
1564 'gfm-mode)
1565 (cons "." 'text-mode)))
1566
1567 (:advise edit-server-make-frame :before
1568 (defun edit-server@set-a-variable (&rest _)
1569 (setq-local edit-server-frame-p t))))
1570
1571(setup (:straight (electric-cursor
1572 :host github
1573 :repo "duckwork/electric-cursor"))
1574 (electric-cursor-mode +1)) 324 (electric-cursor-mode +1))
1575 325
1576(setup (:straight (elfeed 326(setup (:straight electric-cursor)
1577 :host github 327 (electric-cursor-mode +1))
1578 :repo "skeeto/elfeed")
1579 elfeed-protocol)
1580 (:option elfeed-use-curl t
1581 elfeed-curl-extra-arguments '("--insecure")
1582 elfeed-feeds `(("fever+https://acdw@mf.acdw.net"
1583 :api-url "https://mf.acdw.net/fever/"
1584 :password ,(acdw/make-password-fetcher
1585 :host "mf.acdw.net")
1586 :autotags ; do I want to use elfeed-org ?
1587 '(("r/emacs" reddit social emacs)
1588 ("protesilaos.com/codelog.xml" emacs)
1589 ("tildes.net" social)
1590 ("catandgirl.com" comics)
1591 ("qwantz.com" comics)
1592 ("emacsninja.com" emacs)
1593 ("falseknees.com" comics)
1594 ("emacslife.com" emacs)
1595 ("lisp.org" lisp programming)
1596 ("scheme.org" scheme programming)
1597 ("smbc-comics.com" comics)
1598 ("youtube.com" video)
1599 ("tilde.news" social)
1600 ("xkcd.com" comics))))
1601 elfeed-show-unique-buffers t)
1602 (:autoload elfeed-set-timeout)
1603 (elfeed-set-timeout 3600)
1604 (elfeed-protocol-enable)
1605 (:advise elfeed :after
1606 (defun elfeed@protocol-update (&rest _)
1607 (elfeed-search-fetch nil)))
1608 (:with-mode elfeed-search-mode
1609 (:bind "G" (defun elfeed-protocol|update-first (arg)
1610 (interactive "P")
1611 (let ((first-proto (caar elfeed-feeds)))
1612 (if arg
1613 (call-interactively #'elfeed-protocol-fever-reinit)
1614 (with-temp-message (format "Updating %s" first-proto)
1615 (elfeed-protocol-fever-reinit first-proto)))))))
1616 (:with-mode elfeed-show-mode
1617 (:hook #'reading-mode)
1618 (:local-set shr-max-image-proportion 0.9
1619 visual-fill-column-width (+ fill-column 5))
1620 ;; see https://irreal.org/blog/?p=8885
1621 (:bind "SPC" (defun elfeed-scroll-up-command (&optional arg)
1622 "Scroll up or go to next feed item in Elfeed"
1623 (interactive "^P")
1624 (let ((scroll-error-top-bottom nil))
1625 (condition-case-unless-debug nil
1626 (scroll-up-command arg)
1627 (error (elfeed-show-next)))))
1628 "S-SPC" (defun elfeed-scroll-down-command (&optional arg)
1629 "Scroll up or go to next feed item in Elfeed"
1630 (interactive "^P")
1631 (let ((scroll-error-top-bottom nil))
1632 (condition-case-unless-debug nil
1633 (scroll-down-command arg)
1634 (error (elfeed-show-prev))))))))
1635
1636(setup (:straight elisp-slime-nav)
1637 (:hook-into emacs-lisp-mode
1638 ielm-mode))
1639
1640(setup (:straight (elpher
1641 :host nil
1642 :repo "git://thelambdalab.xyz/elpher.git"))
1643 (:option elpher-ipv4-always t
1644 elpher-certificate-directory (acdw/dir "elpher/")
1645 elpher-gemini-max-fill-width fill-column)
1646
1647 (:bind "n" #'elpher-next-link
1648 "p" #'elpher-prev-link
1649 "o" #'elpher-follow-current-link
1650 "G" #'elpher-go-current)
1651
1652 (:hook #'reading-mode)
1653
1654 (:autoload (elpher-bookmarks :interactive t)
1655 (elpher-go :interactive t))
1656
1657 ;; Make `eww' gemini/gopher aware. From Emacswiki.
1658 ;; (define-advice eww-browse-url (:around (fn url &rest args) gemini-elpher)
1659 ;; (cond ((string-match-p "\\`\\(gemini\\|gopher\\)://" url)
1660 ;; (require 'elpher)
1661 ;; (elpher-go url))
1662 ;; (t (apply fn url args))))
1663 )
1664
1665(setup (:straight-when emacs-everywhere
1666 (and (executable-find "xclip")
1667 (executable-find "xdotool")
1668 (executable-find "xprop")
1669 (executable-find "xwininfo"))))
1670
1671(setup (:straight (embark ; gotta git that fresh fresh
1672 :host github
1673 :repo "oantolin/embark"))
1674 (:global "C-." #'embark-act)
1675 (:option prefix-help-command #'embark-prefix-help-command
1676 (append display-buffer-alist)
1677 `(,(rx (seq bos "*Embark Collect "
1678 (group (| "Live" "Completions"))
1679 "*"))
1680 nil
1681 (window-parameters (mode-line-format . none)))
1682 embark-prompter #'embark-keymap-prompter
1683 embark-verbose-indicator-display-action
1684 '(display-buffer-at-bottom (window-height . fit-window-to-buffer))
1685 embark-action-indicator
1686 (lambda (map _target)
1687 (which-key--show-keymap "Embark" map nil nil 'no-paging)
1688 #'which-key--hide--ignore-command)
1689 embark-become-indicator embark-action-indicator)
1690
1691 (with-eval-after-loads (embark consult)
1692 (:straight embark-consult)
1693 (add-hook 'embark-collect-mode-hook
1694 #'consult-preview-at-point-mode)))
1695 328
1696(setup (:straight epithet) 329(setup (:straight embark)
1697 (dolist (hook '(Info-selection-hook 330 (:option prefix-help-command 'embark-prefix-help-command)
1698 eww-after-render-hook 331 (:global "C-." 'embark-act
1699 help-mode-hook 332 "M-." 'embark-dwim
1700 occur-mode-hook)) 333 "C-h B" 'embark-bindings))
1701 (add-hook hook #'epithet-rename-buffer)))
1702 334
1703;; TODO: look into emms or something related for this 335(setup (:straight embark-consult)
1704(setup (:straight-when eradio 336 (:load-after consult embark)
1705 (executable-find "mpv")) 337 (add-hook 'embark-collect-mode-hook 'consult-preview-at-point-mode))
1706 (:option
1707 eradio-player '("mpv" "--no-video" "--no-terminal")
1708 eradio-channels `(("KLSU" .
1709 "http://130.39.238.143:8010/stream.mp3")
1710 ("Soma FM Synphaera" .
1711 "https://somafm.com/synphaera256.pls")
1712 ("SomaFM BAGel Radio" .
1713 "https://somafm.com/bagel.pls")
1714 ("SomaFM Boot Liquor" .
1715 "https://somafm.com/bootliquor320.pls")
1716 ("SomaFM Deep Space One" .
1717 "https://somafm.com/deepspaceone.pls")
1718 ("SomaFM Fluid" .
1719 "https://somafm.com/fluid.pls")
1720 ("SomaFM Underground 80s" .
1721 "https://somafm.com/u80s256.pls")
1722 ("WBRH: Jazz & More" .
1723 "http://wbrh.streamguys1.com/wbrh-mp3")
1724 ("KBRH Blues & Rhythm Hits" .
1725 "http://wbrh.streamguys1.com/kbrh-mp3")
1726 ("WRKF HD-2" .
1727 ,(concat "https://playerservices.streamtheworld.com/"
1728 "api/livestream-redirect/WRKFHD2.mp3"))
1729 ("WRKF: NPR for the Capital Region" .
1730 ,(concat "https://playerservices.streamtheworld.com/"
1731 "api/livestream-redirect/WRKFFM.mp3"))
1732 ("BadRadio: 24/7 PHONK" .
1733 "https://s2.radio.co/s2b2b68744/listen")
1734 ("tilderadio" .
1735 "https://azuracast.tilderadio.org/radio/8000/radio.ogg")
1736 ("vantaradio" .
1737 "https://vantaa.black/radio")))
1738 (:global "C-c r r" #'eradio-play ; mnemonic: radio
1739 "C-c r s" #'eradio-stop ; mnemonic: stop
1740 "C-c r p" #'eradio-toggle ; mnemonic: play/pause
1741 ))
1742 338
1743(setup (:straight eros) 339(setup (:straight eshell-syntax-highlighting)
1744 (:hook-into emacs-lisp-mode 340 (:hook-into eshell-mode))
1745 lisp-interaction-mode))
1746 341
1747(setup (:straight-when exec-path-from-shell 342(setup (:straight-when exec-path-from-shell
1748 (acdw/system :home)) 343 (eq system-type 'gnu/linux))
1749 (when (daemonp) 344 (when (daemonp)
1750 (exec-path-from-shell-initialize)) 345 (exec-path-from-shell-initialize))
1751 (exec-path-from-shell-copy-envs '("XDG_CONFIG_HOME" 346 (exec-path-from-shell-copy-envs '("XDG_CONFIG_HOME"
@@ -1755,250 +350,83 @@ See also `crux-reopen-as-root-mode'."
1755 "XDG_CACHE_HOME"))) 350 "XDG_CACHE_HOME")))
1756 351
1757(setup (:straight expand-region) 352(setup (:straight expand-region)
1758 (:global "C-=" #'er/expand-region)) 353 (:global "C-=" 'er/expand-region))
1759
1760(setup (:straight-when fennel-mode
1761 (executable-find "fennel"))
1762 (:autoload (fennel-repl :interactive t))
1763 (:file-match (rx ".fnl" eos)))
1764
1765(setup (:straight flyspell-correct)
1766 (:option flyspell-correct-interface #'flyspell-correct-completing-read
1767 flyspell-correct--cr-key ";")
1768 354
1769 (:with-feature flyspell 355(setup (:straight (filldent
1770 (:bind "C-." #'flyspell-correct-wrapper 356 :host github
1771 "<f7>" (defun acdw/flyspell-correct-f7 () 357 :repo "duckwork/filldent.el"))
1772 "Run a full spell correction on the current buffer." 358 (:global "M-q" 'filldent-dwim))
1773 (interactive)
1774 (save-mark-and-excursion
1775 (flyspell-correct-move 0 :forward :rapid))))
1776 (:unbind "C-;" "C-," "C-." "C-M-i")))
1777
1778(setup (:straight-when forge
1779 (acdw/system :home))
1780 ;; make sure to read Info manual with Forge (and Ghub) for setup
1781 ;; instructions.
1782 (with-eval-after-load 'magit
1783 (require 'forge)
1784 (add-to-list 'forge-alist ; tildegit is a gitea server
1785 '("tildegit.org" "tildegit.org/api/v1" "tildegit.org"
1786 forge-gitea-repository))))
1787 359
1788(setup (:straight (frowny 360(setup (:straight (frowny
1789 :host github 361 :host github
1790 :repo "duckwork/frowny.el")) 362 :repo "duckwork/frowny.el"))
1791 (:option frowny-eyes (rx (| ":" ":-" ":'" "="))
1792 frowny-eyes-looking-back-limit 2)
1793 (global-frowny-mode +1)) 363 (global-frowny-mode +1))
1794 364
1795(setup (:straight gcmh) 365(setup (:straight gcmh)
1796 (:option gcmh-idle-delay 'auto) 366 (:option gcmh-idle-delay 'auto)
1797 (gcmh-mode +1)) 367 (gcmh-mode +1))
1798 368
1799(setup (:straight-when geiser
1800 (progn
1801 (defvar acdw/schemes
1802 (let (schemes)
1803 (dolist (scheme '(("scheme" . geiser-chez) ; chez
1804 ("petite" . geiser-chez) ; petite
1805 ("csi" . geiser-chez) ; chicken
1806 ("gsi" . geiser-gambit)
1807 ("gosh" . geiser-gauche)
1808 ("guile" . geiser-guile)
1809 ("kawa" . geiser-kawa)
1810 ("mit-scheme" . geiser-mit)
1811 ("racket" . geiser-racket)
1812 ("stklos" . geiser-stklos)))
1813 (when-let (binary (executable-find (car scheme)))
1814 (push binary schemes)
1815 ;; and install the proper helper package
1816 (straight-use-package (cdr scheme))))
1817 (nreverse schemes)))
1818 acdw/schemes))
1819 (:file-match (rx ".rkt" eos)
1820 (rx ".scm" eos)))
1821
1822(setup (:straight (gemini-mode
1823 :host nil
1824 :repo "https://git.carcosa.net/jmcbray/gemini.el.git"))
1825 (:file-match (rx (seq "." (or "gemini" "gmi") eos)))
1826 (:hook turn-off-auto-fill))
1827
1828(setup (:straight (gemini-write
1829 :host nil
1830 :repo "https://alexschroeder.ch/cgit/gemini-write"
1831 :branch "main"))
1832 (with-eval-after-load 'elpher
1833 (require 'gemini-write)))
1834
1835(setup (:straight git-modes))
1836
1837(setup (:straight helpful) 369(setup (:straight helpful)
1838 (:require-after 3) 370 (:global "<help> f" 'helpful-callable
1839 (:global "<help> f" #'helpful-callable 371 "<help> v" 'helpful-variable
1840 "<help> v" #'helpful-variable 372 "<help> k" 'helpful-key
1841 "<help> k" #'helpful-key 373 "C-c C-d" 'helpful-at-point))
1842 "<help> o" #'helpful-symbol)) 374
1843 375
1844(setup (:straight (hippie-completing-read 376(setup (:straight (hippie-completing-read
1845 :host github 377 :host github
1846 :repo "duckwork/hippie-completing-read")) 378 :repo "duckwork/hippie-completing-read"))
1847 (:global "M-/" #'hippie-completing-read)) 379 (:global "M-/" 'hippie-completing-read))
1848 380
1849(setup (:straight hungry-delete) 381(setup (:straight hungry-delete)
1850 (:option hungry-delete-chars-to-skip " \t" 382 (:option hungry-delete-chars-to-skip " \t"
1851 hungry-delete-join-reluctantly nil) 383 hungry-delete-join-reluctantly nil)
1852 384 (:bind-into paredit
1853 (global-hungry-delete-mode +1) 385 [remap paredit-backward-delete]
1854 386 (defun acdw/paredit-hungry-delete-backward (arg)
1855 (:with-feature paredit 387 (interactive "P")
1856 (:bind [remap paredit-backward-delete] 388 (if (looking-back "[ \t]" 1)
1857 (defun acdw/paredit-hungry-delete-backward (arg) 389 (hungry-delete-backward (or arg 1))
1858 (interactive "P") 390 (paredit-backward-delete arg)))
1859 (if (looking-back "[ \t]" 1) 391 [remap paredit-forward-delete]
1860 (hungry-delete-backward (or arg 1)) 392 (defun acdw/paredit-hungry-delete-forward (arg)
1861 (paredit-backward-delete arg))) 393 (interactive "P")
1862 394 (if (looking-at "[ \t]")
1863 [remap paredit-forward-delete] 395 (hungry-delete-forward (or arg 1))
1864 (defun acdw/paredit-hungry-delete-forward (arg) 396 (paredit-forward-delete arg))))
1865 (interactive "P") 397 (global-hungry-delete-mode +1))
1866 (if (looking-at "[ \t]") 398
1867 (hungry-delete-forward (or arg 1)) 399(setup (:straight isearch-mb)
1868 (paredit-forward-delete arg)))))) 400 ;; This complicatedness is an attempt to make it easier to add and
1869 401 ;; subtract `isearch-mb' bindings using the suggestions in the
1870(setup (:straight iscroll) 402 ;; project's README.
1871 (define-globalized-minor-mode global-iscroll-mode iscroll-mode 403 (with-eval-after-load 'isearch-mb
1872 (lambda () (iscroll-mode +1))) 404 (dolist (spec '((isearch-mb--with-buffer
1873 405 ("M-e" . consult-isearch)
1874 (global-iscroll-mode +1)) 406 ("C-o" . loccur-isearch))
1875 407 (isearch-mb--after-exit
1876(setup (:straight (kaomoji-insert 408 ("M-%" . anzu-isearch-query-replace)
1877 :host nil 409 ("M-s l" . consult-line))))
1878 :repo "https://tildegit.org/acdw/kaomoji-insert")) 410 (let ((isearch-mb-list (car spec))
1879 (require 'kaomoji-insert) 411 (isearch-mb-binds (cdr spec)))
1880 (dolist (km '(("(Ծ‸ Ծ)" "suspicious") 412 (dolist (cell isearch-mb-binds)
1881 ("(¬‿¬)═ɜ ɛ═(⌐‿⌐ )" "pound it" "fist bump") 413 (let ((key (car cell))
1882 ("▬▬▬▬▬▬▬▋ Ò╭╮Ó" "hammer") 414 (command (cdr cell)))
1883 ("👁👄👁" "lewk") 415 (when (fboundp command)
1884 ("( ͡~ ͜ʖ ͡°)" "wink") 416 (add-to-list isearch-mb-list command)
1885 (" (づ ̄ ³ ̄)づ " "party") 417 (define-key isearch-mb-minibuffer-map (kbd key) command)))))))
1886 ("⊙﹏⊙" "uhhh" "unsure"))) 418 (isearch-mb-mode +1))
1887 (add-to-list 'kaomoji-insert-alist km))
1888 (:global "C-x 8 k" #'kaomoji-insert))
1889
1890;; (setup (:straight wrap-region)
1891;; (:hook-into org-mode)
1892;; (with-eval-after-load 'org
1893;; (dolist (punc '("=" "*" "/" "_" "+"))
1894;; (wrap-region-add-wrapper punc punc nil 'org-mode))))
1895 419
1896(setup (:straight lacarte) 420(setup (:straight lacarte)
1897 (:global "<f10>" #'lacarte-execute-menu-command)) 421 (:global "<f10>" 'lacarte-execute-menu-command))
1898
1899(setup (:straight-when ledger-mode
1900 (executable-find "ledger")))
1901
1902(setup (:straight link-hint)
1903 ;; Browse web URLs with a browser with a prefix argument.
1904 (dolist (type '(gnus-w3m-image-url
1905 gnus-w3m-url
1906 markdown-link
1907 mu4e-attachment
1908 mu4e-url
1909 notmuch-hello
1910 nov-link
1911 org-link
1912 shr-url
1913 text-url
1914 w3m-link
1915 w3m-message-link))
1916 (link-hint-define-type type
1917 :open-secondary browse-url-secondary-browser-function
1918 :open-secondary-multiple t))
1919
1920 (defun acdw/link-hint-open-all-links (prefix)
1921 "Open all visible links.
1922When PREFIX is non-nil, open links with
1923`browse-url-secondary-browser-function'."
1924 (interactive "P")
1925 (avy-with link-hint-open-all-links
1926 (link-hint--all (if prefix :open-secondary :open))))
1927
1928 (defun acdw/link-hint-open-multiple-links (prefix)
1929 "Use `avy' to open multiple visible links at once.
1930When PREFIX is non-nil, open links with
1931`browse-url-secondary-browser-function'."
1932 (interactive "P")
1933 (avy-with link-hint-open-multiple-links
1934 (link-hint--multiple (if prefix :open-secondary :open))))
1935
1936 (:option link-hint-avy-style 'at-full)
1937 (:global "C-j"
1938 (defun acdw/link-hint-open-link (arg)
1939 "Open a link using `link-hint-open-link', prefix-aware.
1940That is, a prefix argument (\\[universal-argument]) will open the
1941browser defined in `browse-url-secondary-browser-function'."
1942 (interactive "P")
1943 (avy-with link-hint-open-link
1944 (link-hint--one (if arg :open-secondary :open))))))
1945
1946(setup (:straight lua-mode)
1947 (:file-match (rx ".lua" eos)))
1948
1949(setup (:straight macrostep)
1950 (define-key emacs-lisp-mode-map (kbd "C-c e") #'macrostep-expand)
1951 (define-key lisp-interaction-mode-map (kbd "C-c e") #'macrostep-expand))
1952
1953(setup (:straight magit)
1954 (:global "C-x g" #'magit-status)
1955
1956 (:option magit-display-buffer-function
1957 (defun magit-display-buffer-same-window (buffer)
1958 "Display BUFFER in the selected window like God intended."
1959 (display-buffer buffer '(display-buffer-same-window)))
1960 magit-popup-display-buffer-action '((display-buffer-same-window))
1961 magit-refresh-status-buffer nil))
1962 422
1963(setup (:straight marginalia) 423(setup (:straight marginalia)
1964 (:option marginalia-annotators '(marginalia-annotators-heavy
1965 marginalia-annotators-light))
1966 (marginalia-mode +1)) 424 (marginalia-mode +1))
1967 425
1968(setup (:straight markdown-mode) 426(setup (:straight minions)
1969 (:file-match (rx ".md" eos) 427 (:option minions-prominent-modes
1970 (rx ".markdown" eos)) 428 '(tracking-mode))
1971 (:hook #'variable-pitch-mode 429 (minions-mode +1))
1972 #'visual-fill-column-mode)
1973
1974 (:with-mode gfm-mode
1975 (:file-match (rx "README.md" eos))
1976 (:hook #'variable-pitch-mode))
1977
1978 (when (executable-find "markdownfmt")
1979 (with-eval-after-load 'apheleia
1980 (:option (append apheleia-formatters) '(markdownfmt . ("markdownfmt"))
1981 (append apheleia-mode-alist) '(markdown-mode . markdownfmt)
1982 (append apheleia-mode-alist) '(gfm-mode . markdownfmt)))))
1983
1984(setup (:straight (mastodon
1985 :host github
1986 :repo "mooseyboots/mastodon.el"))
1987 (:option mastodon-instance-url "https://writing.exchange"
1988 mastodon-auth-source-file (car auth-sources)
1989 mastodon-client--token-file (acdw/dir "mastodon.plstore")
1990 mastodon-tl--enable-proportional-fonts t
1991 mastodon-tl--enable-relative-timestamps nil)
1992
1993 (:hook #'hl-line-mode
1994 #'reading-mode)
1995
1996 (defun mastodon-goto-toot@recenter ()
1997 "Recenter the current toot."
1998 (recenter -1))
1999
2000 (:advise mastodon-tl--goto-next-toot :after #'mastodon-goto-toot@recenter
2001 mastodon-tl--goto-prev-toot :after #'mastodon-goto-toot@recenter))
2002 430
2003(setup (:straight mode-line-bell) 431(setup (:straight mode-line-bell)
2004 (:option mode-line-bell-flash-time 0.1) 432 (:option mode-line-bell-flash-time 0.1)
@@ -2007,164 +435,14 @@ browser defined in `browse-url-secondary-browser-function'."
2007(setup (:straight (modus-themes 435(setup (:straight (modus-themes
2008 :host gitlab 436 :host gitlab
2009 :repo "protesilaos/modus-themes")) 437 :repo "protesilaos/modus-themes"))
2010 (:option modus-themes-slanted-constructs t 438 (load-theme 'modus-operandi t))
2011 modus-themes-bold-constructs t
2012 modus-themes-fringes nil
2013 modus-themes-mode-line '(borderless)
2014 modus-themes-region '(bg-only)
2015 modus-themes-org-blocks 'gray-background
2016 modus-themes-headings '((t . (background)))
2017 modus-themes-lang-checkers '(straight-underline)
2018 modus-themes-scale-headings nil)
2019
2020 (acdw/sunrise-sunset #'modus-themes-load-operandi
2021 #'modus-themes-load-vivendi)
2022
2023 (add-hook 'modus-themes-after-load-theme-hook
2024 (defun modus-themes@customize-faces ()
2025 "Customize faces of modus-themes."
2026 ;; (dolist (face '(font-lock-builtin-face
2027 ;; ;; font-lock-comment-delimiter-face
2028 ;; ;; font-lock-coment-face
2029 ;; font-lock-constant-face
2030 ;; ;; font-lock-doc-face
2031 ;; font-lock-function-name-face
2032 ;; font-lock-keyword-face
2033 ;; font-lock-negation-char-face
2034 ;; font-lock-preprocessor-face
2035 ;; font-lock-regexp-grouping-backslash
2036 ;; font-lock-regexp-goruping-construct
2037 ;; font-lock-string-face
2038 ;; font-lock-type-face
2039 ;; font-lock-variable-name-face
2040 ;; font-lock-warning-face))
2041 ;; (modus-themes-with-colors
2042 ;; (custom-set-faces
2043 ;; `(,face
2044 ;; ((,class :foreground ,fg-main
2045 ;; :weight normal
2046 ;; :slant normal))))))
2047 ;; Other faces
2048 (modus-themes-with-colors
2049 (custom-set-faces
2050 `(org-level-1
2051 ((,class :inherit (modus-themes-heading-1 fixed-pitch)
2052 :extend t)))
2053 `(org-level-2
2054 ((,class :inherit (modus-themes-heading-2 fixed-pitch)
2055 :extend t)))
2056 `(org-level-3
2057 ((,class :inherit (modus-themes-heading-3 fixed-pitch)
2058 :extend t)))
2059 `(org-level-4
2060 ((,class :inherit (modus-themes-heading-4 fixed-pitch)
2061 :extend t)))
2062 `(org-level-5
2063 ((,class :inherit (modus-themes-heading-5 fixed-pitch)
2064 :extend t)))
2065 `(org-level-6
2066 ((,class :inherit (modus-themes-heading-6 fixed-pitch)
2067 :extend t)))
2068 `(org-level-7
2069 ((,class :inherit (modus-themes-heading-7 fixed-pitch)
2070 :extend t)))
2071 `(org-level-8
2072 ((,class :inherit (modus-themes-heading-8 fixed-pitch)
2073 :extend t))))))))
2074 439
2075(setup (:straight mwim) 440(setup (:straight mwim)
2076 (:global "C-a" #'mwim-beginning 441 (:global "C-a" #'mwim-beginning
2077 "C-e" #'mwim-end)) 442 "C-e" #'mwim-end))
2078 443
2079(setup (:straight nov) 444(setup (:straight orderless)
2080 (:option nov-text-width fill-column) 445 (:option completion-styles '(orderless)))
2081 (:file-match (rx ".epub" eos)))
2082
2083(setup (:straight (nyan-mode
2084 :host github :repo "TeMPOraL/nyan-mode"
2085 :fork (:host github :repo "duckwork/nyan-mode")
2086 :files ("nyan-mode.el" "img")))
2087 (:option nyan-animate-nyancat nil
2088 nyan-bar-length 20
2089 nyan-minimum-window-width (+ fill-column (/ nyan-bar-length 2)))
2090 (nyan-mode +1)
2091 (defun disable-nyan-mode ()
2092 "Disable `nyan-mode' in current buffer."
2093 (setq-local nyan-mode -1))
2094 (dolist (mode '(eshell-mode
2095 comint-mode))
2096 (add-hook mode #'disable-nyan-mode)))
2097
2098;; (setup (:straight olivetti)
2099;; (:option olivetti-body-width (+ fill-column 4)
2100;; olivetti-minimum-body-width fill-column)
2101
2102;; (:hook (defun olivetti-mode@setup ()
2103;; (if olivetti-mode
2104;; (setq-local indicate-empty-lines nil
2105;; indicate-buffer-boundaries nil)
2106;; (acdw/setup-fringes)))))
2107
2108(setup (:straight (orderless
2109 :host github
2110 :repo "oantolin/orderless"))
2111 (require 'orderless)
2112
2113 (:option (append completion-styles) 'orderless
2114 orderless-component-separator #'orderless-escapable-split-on-space
2115 orderless-matching-styles '(orderless-literal
2116 orderless-regexp
2117 ;; orderless-flex
2118 )
2119 orderless-style-dispatchers '(acdw/orderless-dispatch))
2120
2121 (:advise orderless-regexp :filter-args
2122 (defun fix-dollar (args)
2123 (if (string-suffix-p "$" (car args))
2124 (list (concat (substring (car args) 0 -1)
2125 "[\x100000-\x10FFFD]*$"))
2126 args)))
2127
2128 (defun acdw/orderless-dispatch (pattern _index _total)
2129 "My custom dispatcher for `orderless'."
2130 (cond
2131 ;; Ensure that $ works with Consult commands, which add disambiguation
2132 ;; suffixes -- see `fix-dollar'
2133 ((string-suffix-p "$" pattern)
2134 `(orderless-regexp . ,(concat (substring pattern 0 -1)
2135 "[\x100000-\x10FFFD]*$")))
2136 ;; File extensions
2137 ((string-match-p "\\`\\.." pattern)
2138 `(orderless-regexp . ,(concat "\\." (substring pattern 1)
2139 "[\x100000-\x10FFFD]*$")))
2140 ;; Ignore single !
2141 ((string= "!" pattern)
2142 `(orderless-literal . ""))
2143 ;; Character folding
2144 ((string-prefix-p "%" pattern)
2145 `(char-fold-to-regexp . ,(substring pattern 1)))
2146 ((string-suffix-p "%" pattern)
2147 `(char-fold-to-regexp . ,(substring pattern 0 -1)))
2148 ;; Without literal
2149 ((string-prefix-p "!" pattern)
2150 `(orderless-without-literal . ,(substring pattern 1)))
2151 ((string-suffix-p "!" pattern)
2152 `(orderless-without-literal . ,(substring pattern 0 -1)))
2153 ;; Initialism matching
2154 ((string-prefix-p "`" pattern)
2155 `(orderless-initialism . ,(substring pattern 1)))
2156 ((string-suffix-p "`" pattern)
2157 `(orderless-initialism . ,(substring pattern 0 -1)))
2158 ;; Literal matching
2159 ((string-prefix-p "=" pattern)
2160 `(orderless-literal . ,(substring pattern 1)))
2161 ((string-suffix-p "=" pattern)
2162 `(orderless-literal . ,(substring pattern 0 -1)))
2163 ;; Flex matching
2164 ((string-prefix-p "~" pattern)
2165 `(orderless-flex . ,(substring pattern 1)))
2166 ((string-suffix-p "~" pattern)
2167 `(orderless-flex . ,(substring pattern 0 -1))))))
2168 446
2169(setup (:straight (org 447(setup (:straight (org
2170 :type git 448 :type git
@@ -2179,10 +457,13 @@ browser defined in `browse-url-secondary-browser-function'."
2179 (org-contrib 457 (org-contrib
2180 :type git 458 :type git
2181 :repo "https://git.sr.ht/~bzg/org-contrib")) 459 :repo "https://git.sr.ht/~bzg/org-contrib"))
2182 (:also-load acdw-org) 460 ;; DO NOT load system-installed org !!!
2183 (require 'chd nil 'noerror) 461 (setq load-path (cl-remove-if (lambda (path)
462 (string-match-p "lisp/org\\'" path))
463 load-path))
464 (:also-load +org
465 ox-md)
2184 (:option org-adapt-indentation nil 466 (:option org-adapt-indentation nil
2185 ;; org-agenda-files nil ; only until I set this up
2186 org-catch-invisible-edits 'show-and-error 467 org-catch-invisible-edits 'show-and-error
2187 org-clock-clocked-in-display 'mode-line 468 org-clock-clocked-in-display 'mode-line
2188 org-clock-frame-title-format (cons 469 org-clock-frame-title-format (cons
@@ -2194,7 +475,7 @@ browser defined in `browse-url-secondary-browser-function'."
2194 org-confirm-babel-evaluate nil 475 org-confirm-babel-evaluate nil
2195 org-cycle-separator-lines 0 476 org-cycle-separator-lines 0
2196 org-directory "~/org" 477 org-directory "~/org"
2197 org-ellipsis " …" 478 org-ellipsis "…"
2198 org-export-coding-system 'utf-8-unix 479 org-export-coding-system 'utf-8-unix
2199 org-export-headline-levels 8 480 org-export-headline-levels 8
2200 org-export-with-section-numbers nil 481 org-export-with-section-numbers nil
@@ -2206,7 +487,8 @@ browser defined in `browse-url-secondary-browser-function'."
2206 org-fontify-whole-heading-line t 487 org-fontify-whole-heading-line t
2207 org-hide-emphasis-markers t 488 org-hide-emphasis-markers t
2208 org-html-coding-system 'utf-8-unix 489 org-html-coding-system 'utf-8-unix
2209 org-image-actual-width '(300) 490 org-image-actual-width (list (* (window-font-width)
491 (- fill-column 8)))
2210 org-imenu-depth 3 492 org-imenu-depth 3
2211 org-list-demote-modify-bullet '(("-" . "+") 493 org-list-demote-modify-bullet '(("-" . "+")
2212 ("+" . "*") 494 ("+" . "*")
@@ -2224,116 +506,16 @@ browser defined in `browse-url-secondary-browser-function'."
2224 org-startup-truncated nil 506 org-startup-truncated nil
2225 org-startup-with-inline-images t 507 org-startup-with-inline-images t
2226 org-tags-column (- (- fill-column (length org-ellipsis)))) 508 org-tags-column (- (- fill-column (length org-ellipsis))))
2227 509 (:bind "RET" '+org-return-dwim
2228 (:bind "RET" #'acdw-org/return-dwim 510 "<S-return>" '+org-table-copy-down
2229 "<S-return>" #'acdw-org/org-table-copy-down 511 "C-c C-l" '+org-insert-link-dwim
2230 ;; "M-SPC M-SPC" #'insert-zero-width-space 512 "C-c C-n" '+org-next-heading-widen
2231 "C-c C-l" #'org-insert-link-dwim 513 "C-c C-p" '+org-previous-heading-widen)
2232 "C-c w" #'chd/do-the-thing 514 (:local-set unfill-fill-function 'org-fill-paragraph)
2233 "C-c C-n" #'acdw/org-next-heading-widen 515 (:local-hook before-save-hook '+org-before-save@prettify-buffer)
2234 "C-c C-p" #'acdw/org-previous-heading-widen 516 (advice-add 'org-delete-backward-char :override '+org-delete-backward-char)
2235 "C-x n t" #'org-narrow-to-task)
2236
2237 (:unbind "C-j" ; org-return-and-maybe-indent
2238 "M-j")
2239
2240 (:local-set unfill-fill-function #'org-fill-paragraph
2241 wc-count-words-function
2242 (lambda (start end) "Count words stupidly with a limit."
2243 (acdw-org/count-words-stupidly start
2244 end
2245 999)))
2246
2247 (with-eval-after-load 'org-export
2248 (:option (append org-export-filter-final-output-functions)
2249 #'org-export-remove-zero-width-spaces))
2250
2251 (:local-hook before-save-hook
2252 (defun org/before-save@prettify-buffer ()
2253 (save-mark-and-excursion
2254 (mark-whole-buffer)
2255 (org-fill-paragraph nil t))
2256 (acdw-org/fix-blank-lines t)
2257 (org-align-tags :all)))
2258
2259 (with-eval-after-load 'org 517 (with-eval-after-load 'org
2260 (org-clock-persistence-insinuate)) 518 (org-clock-persistence-insinuate)))
2261
2262 (with-eval-after-load 'consult
2263 (defun consult-clock-in (&optional match scope resolve)
2264 "Clock into an Org heading."
2265 (interactive (list nil nil current-prefix-arg))
2266 (require 'org-clock)
2267 (org-clock-load)
2268 (save-window-excursion
2269 (consult-org-heading
2270 match
2271 (or scope
2272 (thread-last org-clock-history
2273 (mapcar 'marker-buffer)
2274 (mapcar 'buffer-file-name)
2275 (delete-dups)
2276 (delq nil))
2277 (user-error "No recent clocked tasks")))
2278 (org-clock-in nil (when resolve
2279 (org-resolve-clocks)
2280 (org-read-date t t)))))
2281
2282 (consult-customize consult-clock-in
2283 :prompt "Clock in: "
2284 :preview-key (kbd "M-.")
2285 :group
2286 (lambda (cand transform)
2287 (if transform
2288 (substring
2289 cand
2290 (next-single-property-change
2291 0 'consult-org--buffer cand))
2292 (let ((m (car (get-text-property
2293 0 'consult-org--heading cand))))
2294 (if (member m org-clock-history)
2295 "*Recent*"
2296 (buffer-name (marker-buffer m))))))))
2297
2298 (:advise org-delete-backward-char :override #'acdw-org/delete-backward-char)
2299
2300 (el-patch-feature org)
2301 (with-eval-after-load 'org
2302 (el-patch-defun org-format-outline-path (path &optional
2303 width prefix separator)
2304 "Format the outline path PATH for display.
2305WIDTH is the maximum number of characters that is available.
2306PREFIX is a prefix to be included in the returned string,
2307such as the file name.
2308SEPARATOR is inserted between the different parts of the path,
2309the default is \"/\"."
2310 (setq width (or width 79))
2311 (setq path (delq nil path))
2312 (unless (> width 0)
2313 (user-error "Argument `width' must be positive"))
2314 (setq separator (or separator "/"))
2315 (let* ((org-odd-levels-only nil)
2316 (fpath (concat
2317 prefix (and prefix path separator)
2318 (mapconcat
2319 (lambda (s) (replace-regexp-in-string "[ \t]+\\'" "" s))
2320 (cl-loop for head in path
2321 for n from 0
2322 collect
2323 (el-patch-swap
2324 (org-add-props
2325 head nil 'face
2326 (nth (% n org-n-level-faces)
2327 org-level-faces))
2328 head))
2329 separator))))
2330 (when (> (length fpath) width)
2331 (if (< width 7)
2332 ;; It's unlikely that `width' will be this small, but don't
2333 ;; waste characters by adding ".." if it is.
2334 (setq fpath (substring fpath 0 width))
2335 (setf (substring fpath (- width 2)) "..")))
2336 fpath))))
2337 519
2338(setup (:straight org-appear) 520(setup (:straight org-appear)
2339 (:option org-appear-autoemphasis t 521 (:option org-appear-autoemphasis t
@@ -2344,24 +526,10 @@ the default is \"/\"."
2344 org-appear-delay 0) 526 org-appear-delay 0)
2345 (:hook-into org-mode)) 527 (:hook-into org-mode))
2346 528
2347(setup (:straight org-sticky-header)
2348 (:hook-into org-mode))
2349
2350(setup (:straight package-lint
2351 package-lint-flymake))
2352
2353(setup (:straight page-break-lines)
2354 (global-page-break-lines-mode +1))
2355
2356(setup (:straight paredit) 529(setup (:straight paredit)
2357 (:bind "DEL" #'paredit-backward-delete 530 (:bind "DEL" 'paredit-backward-delete
2358 "C-<backspace>" #'paredit-backward-kill-word 531 "C-<backspace>" 'paredit-backward-kill-word)
2359 "M-w" #'paredit-copy-as-kill
2360 "RET" #'paredit-newline)
2361 (:unbind "C-j" ; paredit-newline
2362 )
2363 (:hook-into emacs-lisp-mode lisp-interaction-mode 532 (:hook-into emacs-lisp-mode lisp-interaction-mode
2364 ielm-mode sly-repl-mode
2365 lisp-mode scheme-mode) 533 lisp-mode scheme-mode)
2366 (:also-load eldoc) 534 (:also-load eldoc)
2367 (eldoc-add-command 'paredit-backward-delete 'paredit-close-round)) 535 (eldoc-add-command 'paredit-backward-delete 'paredit-close-round))
@@ -2373,163 +541,28 @@ the default is \"/\"."
2373 lisp-interaction-mode 541 lisp-interaction-mode
2374 scheme-mode)) 542 scheme-mode))
2375 543
2376(setup (:straight-when (pdf-tools
2377 :host github
2378 :repo "vedang/pdf-tools")
2379 (acdw/system :home))
2380 (:file-match (rx ".pdf" eos))
2381 (pdf-loader-install))
2382
2383(setup (:straight popper)
2384 (:option popper-reference-buffers
2385 `(,(rx "*Messages*")
2386 ,(rx "Output*" eol)
2387 ,(rx "*Async Shell Command*")
2388 help-mode helpful-mode
2389 compilation-mode)
2390 popper-mode-line nil
2391 popper-display-control t
2392 popper-display-function
2393 (defun popper/select-popup-smartly (buffer &optional _alist)
2394 (let* ((widep (> (frame-pixel-width) (frame-pixel-height)))
2395 (window (display-buffer-in-side-window
2396 buffer
2397 `((side . ,(if widep 'right 'bottom))
2398 (slot . 1)
2399 ,(if widep
2400 (cons 'window-width
2401 popper-window-height)
2402 (cons 'window-height
2403 popper-window-height))))))
2404 (select-window window)))
2405 popper-window-height
2406 (defun popper/figure-window-height (window)
2407 (let* ((widep (> (frame-pixel-width) (frame-pixel-height)))
2408 (fit-window-to-buffer-horizontally widep))
2409 (fit-window-to-buffer
2410 window
2411 (floor (frame-pixel-height) 2)
2412 (floor (frame-pixel-height) 4)
2413 fill-column
2414 fill-column))))
2415 (:global "M-`" #'popper-toggle-latest
2416 "C-`" #'popper-cycle)
2417 (popper-mode +1)
2418 (when (fboundp 'popper-echo-mode)
2419 (popper-echo-mode +1)))
2420
2421(setup (:straight-when (powershell
2422 :host github
2423 :repo "jschaf/powershell.el")
2424 (acdw/system :work)))
2425
2426(setup (:straight (shell-command+ 544(setup (:straight (shell-command+
2427 :host nil 545 :host nil
2428 :repo "https://git.sr.ht/~pkal/shell-command-plus")) 546 :repo "https://git.sr.ht/~pkal/shell-command-plus"))
2429 (:option shell-command-prompt "$ ") 547 (:option shell-command-prompt "$ ")
2430 (:with-feature dired 548 (:bind-into dired
2431 (:bind "M-!" shell-command+)) 549 "M-!" 'shell-command+)
2432 (:global "M-!" shell-command+)) 550 (:global "M-!" 'shell-command+))
2433
2434(setup (:straight sicp))
2435 551
2436(setup (:straight simple-modeline 552(setup (:straight (sophomore
2437 minions)
2438 (:also-load acdw-modeline)
2439 (:option simple-modeline-segments
2440 ;; Yeah this is laid out like poo. It's so I can easily change
2441 ;; things around if need be.
2442 '((;; left
2443 acdw-modeline/winum
2444 acdw-modeline/modified
2445 acdw-modeline/buffer-name
2446 acdw-modeline/vc-branch
2447 acdw-modeline/wc
2448 acdw-modeline/nyan-cat
2449 acdw-modeline/position
2450 ) (;; right
2451 acdw-modeline/track
2452 simple-modeline-segment-misc-info
2453 acdw-modeline/text-scale
2454 simple-modeline-segment-process
2455 acdw-modeline/god-mode-indicator
2456 acdw-modeline/minions
2457 acdw-modeline/reading-mode
2458 acdw-modeline/narrowed
2459 acdw-modeline/major-mode
2460 )))
2461
2462 (:option tab-bar-mode t
2463 tab-bar-show 1)
2464
2465 ;; I've put in a pull request to add the (- 0 right-margin) bit here.
2466 (el-patch-feature simple-modeline)
2467 (with-eval-after-load 'simple-modeline
2468 (el-patch-defun simple-modeline--format (left-segments right-segments)
2469 "Return a string of `window-width' length containing LEFT-SEGMENTS and RIGHT-SEGMENTS, aligned respectively."
2470 (let* ((left (simple-modeline--format-segments left-segments))
2471 (right (simple-modeline--format-segments right-segments))
2472 (reserve (length right)))
2473 (concat
2474 left
2475 (propertize " "
2476 'display (el-patch-swap
2477 `((space :align-to (- right ,reserve)))
2478 `((space :align-to
2479 (- right
2480 (- 1 right-fringe right-margin)
2481 ,reserve))))
2482 'face '(:inherit simple-modeline-space))
2483 right))))
2484
2485 (simple-modeline-mode +1))
2486
2487(setup (:straight-when sly
2488 (progn
2489 (defvar acdw/lisps
2490 (let (lisps)
2491 (dolist (lisp '("sbcl" ; TODO: add more lisps
2492 "clisp"))
2493 (when-let (binary (executable-find lisp))
2494 (push binary lisps)))
2495 (nreverse lisps)))
2496 acdw/lisps))
2497 (:also-load sly-autoloads)
2498 (:straight clhs)
2499
2500 (:option inferior-lisp-program acdw/lisp-bin
2501 sly-kill-without-query-p t)
2502
2503 (:with-feature sly-mrepl
2504 (defun sly-mrepl-return-at-end ()
2505 (interactive)
2506 (if (<= (point-max) (point))
2507 (sly-mrepl-return)
2508 (if (bound-and-true-p paredit-mode)
2509 (paredit-newline)
2510 (electric-newline-and-maybe-indent))))
2511
2512 (dolist (key '("RET" "<return>"))
2513 (:bind key #'sly-mrepl-return-at-end))
2514
2515 (:bind "C-c C-c" #'sly-mrepl-return)))
2516
2517(setup (:straight (spongebob-case
2518 :host github 553 :host github
2519 :repo "duckwork/spongebob-case.el")) 554 :repo "duckwork/sophomore.el"))
2520 (:global "C-c c s" #'spongebob-case-dwim)) 555 (:option disabled-command-function 'sophomore-dispatch
556 sophomore-dispatch-alist '((fatfinger . sophomore-fat-finger)))
557 (put 'save-buffers-kill-terminal 'disabled 'fatfinger))
2521 558
2522(setup (:straight ssh-config-mode) 559(setup (:straight ssh-config-mode)
2523 (:file-match (rx "/.ssh/config" eos) 560 (:file-match (rx "/.ssh/config" eos)
2524 (rx "/ssh" (? "d") "_config" eos)) 561 (rx "/ssh" (? "d") "_config" eos))
2525
2526 (:with-mode ssh-known-hosts-mode 562 (:with-mode ssh-known-hosts-mode
2527 (:file-match (rx "/knownhosts" eos))) 563 (:file-match (rx "/knownhosts" eos)))
2528
2529 (:with-mode ssh-authorized-keys-mode 564 (:with-mode ssh-authorized-keys-mode
2530 (:file-match (rx "/authorized_keys" (? "2") eos))) 565 (:file-match (rx "/authorized_keys" (? "2") eos))))
2531
2532 (:hook #'turn-on-font-lock))
2533 566
2534(setup (:straight super-save) 567(setup (:straight super-save)
2535 (:option auto-save-default nil 568 (:option auto-save-default nil
@@ -2540,72 +573,9 @@ the default is \"/\"."
2540 (auto-save-visited-mode -1) 573 (auto-save-visited-mode -1)
2541 (super-save-mode +1)) 574 (super-save-mode +1))
2542 575
2543(setup (:straight-when system-packages
2544 (seq-some #'executable-find
2545 ;; I can't use `system-packages-supported-package-managers'
2546 ;; because, well, the package isn't installed yet. So
2547 ;; ... update this list if any package managers are added.
2548 '("guix" "nix"
2549 "brew" "macports"
2550 "pacman" "emerge"
2551 "zypper" "dnf"
2552 "apt" "aptitude"
2553 "xbps"))))
2554
2555(setup (:straight-when systemd
2556 (executable-find "systemd")))
2557
2558(setup (:straight (topsy
2559 :host github
2560 :repo "alphapapa/topsy.el"))
2561 (:hook-into prog-mode)
2562 (:when-loaded
2563 (:option topsy-header-line-format
2564 `(:eval
2565 (list
2566 (propertize " "
2567 'display
2568 `((space
2569 :align-to
2570 ,(unless
2571 (bound-and-true-p visual-fill-column-mode)
2572 0))))
2573 (funcall topsy-fn))))))
2574
2575(setup (:straight trashed) 576(setup (:straight trashed)
2576 (:option trashed-action-confirmer #'y-or-n-p)) 577 (:option trashed-action-confirmer #'y-or-n-p))
2577 578
2578(setup (:straight typo)
2579
2580 ;; Enable C-c 8 map in all buffers
2581 (typo-global-mode +1)
2582
2583 (add-hook 'text-mode-hook
2584 (defun text-mode@typo-unless ()
2585 "Start `typo-mode' UNLESS the buffer matches a predicate."
2586 ;; I implement this instead of using
2587 ;; `typo-disable-electricity-functions' because the latter checks
2588 ;; on every pertinent keypress. I know I want /no/ typo-ing in
2589 ;; these certain buffers, so I won't even turn on the mode.
2590 (unless (or ; predicates here
2591 (string-match-p "COMMIT_EDITMSG"
2592 (or (buffer-name) "")))
2593 (typo-mode +1))))
2594
2595 ;; jlf & cvandusen on #emacs make a great point: ’ (RIGHT SINGLE QUOTATION
2596 ;; MARK) is /not/ an apostrophe. Making it curly is a typographical
2597 ;; consideration, not an input consideration. (I suppose you could make
2598 ;; the argument that all of these are typographical considerations, but
2599 ;; .. bleh.)
2600 (:bind "'" (define-typo-cycle typo-cycle-apostrophe
2601 "Cycle through apostrophe-like graphemes.
2602If used with a numeric prefix argument N, N apostrophes will be inserted."
2603 ("'" "′" "″" "’"))
2604 "`" (define-typo-cycle typo-cycle-backtick
2605 "Cycle through backtick and left single quotation mark.
2606If used with a numeric prefix argument N, N backticks will be inserted."
2607 ("`" "‘"))))
2608
2609(setup (:straight undo-fu) 579(setup (:straight undo-fu)
2610 (:global "C-/" #'undo-fu-only-undo 580 (:global "C-/" #'undo-fu-only-undo
2611 "C-?" #'undo-fu-only-redo)) 581 "C-?" #'undo-fu-only-redo))
@@ -2613,146 +583,40 @@ If used with a numeric prefix argument N, N backticks will be inserted."
2613(setup (:straight undo-fu-session) 583(setup (:straight undo-fu-session)
2614 (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'" 584 (:option undo-fu-session-incompatible-files '("/COMMIT_EDITMSG\\'"
2615 "/git-rebase-todo\\'") 585 "/git-rebase-todo\\'")
2616 undo-fu-session-directory (acdw/dir "undo/" t) 586 undo-fu-session-directory (.etc "undo/" t)
2617 undo-fu-session-compression (acdw/system :home)) 587 undo-fu-session-compression (eq system-type 'gnu/linux))
2618
2619 (global-undo-fu-session-mode +1)) 588 (global-undo-fu-session-mode +1))
2620 589
2621(setup (:straight (unfill :host github :repo "purcell/unfill" 590(setup (:straight (unfill :host github :repo "purcell/unfill"
2622 :fork (:host github :repo "duckwork/unfill"))) 591 :fork (:host github :repo "duckwork/unfill")))
2623 (:global "M-q" #'unfill-toggle)) 592 (:global "M-q" #'unfill-toggle))
2624 593
2625(setup (:straight (unfocused
2626 :host github
2627 :repo "duckwork/unfocused"))
2628 (unfocused-mode +1)
2629
2630 (:with-hook unfocused-hook
2631 (:hook #'garbage-collect)))
2632
2633(setup (:straight (vertico 594(setup (:straight (vertico
2634 :host github 595 :host github
2635 :repo "minad/vertico" 596 :repo "minad/vertico"
2636 :files ("*" "extensions/*" 597 :files ("*" "extensions/*"
2637 (:exclude ".git")))) 598 (:exclude ".git"))))
2638
2639 (:option resize-mini-windows 'grow-only 599 (:option resize-mini-windows 'grow-only
2640 vertico-count-format nil 600 vertico-count-format nil
2641 vertico-cycle t) 601 vertico-cycle t)
2642
2643 (when (boundp 'native-comp-deferred-compilation-deny-list) 602 (when (boundp 'native-comp-deferred-compilation-deny-list)
2644 (add-to-list 'native-comp-deferred-compilation-deny-list "vertico")) 603 (add-to-list 'native-comp-deferred-compilation-deny-list "vertico"))
2645
2646 (vertico-mode +1) 604 (vertico-mode +1)
2647 605 ;; Extensions
2648 ;; Extensions! 606 (:also-load vertico-directory)
2649 (:also-load vertico-mouse
2650 vertico-directory)
2651 (vertico-mouse-mode +1)
2652 (:with-map vertico-map 607 (:with-map vertico-map
2653 (:bind "RET" #'vertico-directory-enter 608 (:bind "RET" 'vertico-directory-enter
2654 "DEL" #'vertico-directory-delete-char 609 "DEL" 'vertico-directory-delete-char
2655 "M-DEL" #'vertico-directory-delete-word)) 610 "M-DEL" 'vertico-directory-delete-word))
2656 (add-hook 'rfn-eshadow-update-overlay-hook #'vertico-directory-tidy)) 611 (add-hook 'rfn-eshadow-update-overlay-hook 'vertico-directory-tidy))
2657 612
2658(setup (:straight visual-fill-column) 613(setup (:straight visual-fill-column)
2659 (:option visual-fill-column-width (1+ fill-column) 614 (:option visual-fill-column-center-text t)
2660 visual-fill-column-center-text t
2661 (append reading-modes) '(visual-fill-column-mode . +1)
2662 (append reading-modes) '(visual-line-mode . +1)
2663 (append reading-vars) '(fill-column . 0))
2664 (:hook-into org-mode) 615 (:hook-into org-mode)
2665 (:hook (defun visual-fill-column@setup () 616 (with-eval-after-load 'visual-fill-column
2666 (if visual-fill-column-mode 617 (advice-add 'text-scale-adjust :after 'visual-fill-column-adjust)))
2667 (setq-local indicate-empty-lines nil
2668 indicate-buffer-boundaries nil)
2669 (acdw/setup-fringes))))
2670 (:advise text-scale-adjust :after #'visual-fill-column-adjust)
2671 ;; Fix bindings
2672 (when (bound-and-true-p mouse-wheel-mode)
2673 (with-eval-after-load 'visual-fill-column
2674 (dolist (margin '(right-margin left-margin))
2675 (dolist (event '(wheel-down wheel-up))
2676 (define-key visual-fill-column-mode-map
2677 (vector margin event)
2678 #'mwheel-scroll))))))
2679
2680(setup (:straight visual-regexp)
2681 (:global "M-%" #'vr/query-replace))
2682
2683(setup (:straight-when vterm
2684 (acdw/system :home))
2685 (:straight (eshell-vterm
2686 :host github
2687 :repo "iostapyshyn/eshell-vterm"))
2688 (eshell-vterm-mode +1)
2689 (defalias 'eshell/v 'eshell-exec-visual))
2690
2691(setup (:straight wc-mode)
2692 (:option wc-modeline-format "[%tww]"
2693 wc-idle-wait 2)
2694 (:hook-into text-mode)
2695 (:unbind "C-c C-w a"
2696 "C-c C-w c"
2697 "C-c C-w l"
2698 "C-c C-w w"
2699 "C-c C-w"))
2700
2701(setup (:straight web-mode)
2702 (:option css-level-offset 2
2703 js-indent-level 2
2704 sgml-indent-offset 2)
2705
2706 (:file-match (rx ".htm" (? "l") eos)
2707 (rx "." (? "tpl.") "php" eos)
2708 (rx "." (| "asp" "gsp" "jsp") eos)
2709 (rx "." (| "ascx" "aspx") eos)
2710 (rx ".erb" eos)
2711 (rx ".mustache" eos)))
2712
2713(setup (:straight wgrep)
2714 (wgrep-setup))
2715
2716;; (setup (:straight which-key)
2717;; (:option which-key-show-early-on-C-h t
2718;; which-key-idle-delay 1
2719;; which-key-idle-secondary-delay 0.5
2720;; which-key-sort-order 'which-key-prefix-then-key-order)
2721
2722;; (:global "C-h m" #'which-key-show-major-mode)
2723
2724;; (which-key-setup-side-window-right-bottom)
2725;; (which-key-mode +1))
2726 618
2727(setup (:straight whitespace-cleanup-mode) 619(setup (:straight whitespace-cleanup-mode)
620 (:option whitespace-cleanup-mode-preserve-point t)
621 (remove-hook 'before-save-hook 'whitespace-cleanup)
2728 (global-whitespace-cleanup-mode +1)) 622 (global-whitespace-cleanup-mode +1))
2729
2730(setup (:straight winum)
2731 (:option winum-scope 'frame-local
2732 winum-auto-setup-mode-line nil
2733 winum-ignored-buffers '(" *which-key*")
2734 winum-format " %s")
2735
2736 (winum-mode +1))
2737
2738(setup (:straight xr))
2739
2740(setup (:straight-when ytdious
2741 (executable-find "mpv"))
2742 (:also-load acdw-ytel) ; so named because I used ytel first
2743 (:option ytdious-invidious-api-url "https://invidious.snopyta.org")
2744 (:hook #'hl-line-mode)
2745 (:global "C-c y" #'ytdious)
2746 (:bind "v" #'acdw/ytdious-watch
2747 "w" #'acdw/ytdious-copy-link
2748 "q" #'acdw/ytdious-quit))
2749
2750(setup (:straight zzz-to-char)
2751
2752 (:global "M-z"
2753 (defun acdw/zzz-up-to-char (prefix)
2754 "Call `zzz-up-to-char' or `zzz-to-char', PREFIX-depending."
2755 (interactive "P")
2756 (if prefix
2757 (call-interactively #'zzz-up-to-char)
2758 (call-interactively #'zzz-to-char)))))
diff --git a/lisp/+avy.el b/lisp/+avy.el new file mode 100644 index 0000000..5010e95 --- /dev/null +++ b/lisp/+avy.el
@@ -0,0 +1,21 @@
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(provide '+avy)
21;;; avy.el ends here
diff --git a/lisp/+circe.el b/lisp/+circe.el new file mode 100644 index 0000000..1403af8 --- /dev/null +++ b/lisp/+circe.el
@@ -0,0 +1,148 @@
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(defun +circe-current-topic (&optional message)
49 "Return the topic of the current channel.
50When called with optional MESSAGE non-nil, or interactively, also
51message the current topic.")
52
53;;; Formatting messages
54
55(defun +circe-format-meta (string)
56 "Return a format string for `lui-format' for metadata messages."
57 (format "{nick:%1$d.%1$ds} *** %s" (- +circe-left-margin 3) string))
58
59;;; Hooks & Advice
60
61(defun +circe-chat@set-prompt ()
62 "Set the prompt to the (shortened) buffer name."
63 (interactive)
64 (lui-set-prompt (propertize (+string-align (buffer-name) +circe-left-margin
65 :after " > "
66 :ellipsis "~"
67 :alignment 'right))))
68
69(defun +circe-kill-buffer (&rest _)
70 "Kill a circe buffer without confirmation, and after a delay."
71 (let ((circe-channel-killed-confirmation nil)
72 (circe-server-killed-confirmation nil))
73 (run-with-timer 0.25 nil 'kill-buffer)))
74
75(defun +circe-quit@kill-buffer (&rest _)
76 "ADVICE: kill all buffers of a server after `circe-command-QUIT'."
77 (with-circe-server-buffer
78 (dolist (buf (circe-server-buffers))
79 (with-current-buffer buf
80 (+circe-kill-buffer)))
81 (+circe-kill-buffer)))
82
83(defun +circe-gquit@kill-buffer (&rest _)
84 "ADVICE: kill all Circe buffers after `circe-command-GQUIT'."
85 (dolist (buf (circe-server-buffers))
86 (with-current-buffer buf
87 (+circe-quit@kill-buffer))))
88
89;;; Patches
90
91(require 'el-patch)
92
93(el-patch-feature circe)
94(defvar circe-server-buffer-action 'pop-to-buffer-same-window
95 "What to do with `circe-server' buffers when created.")
96
97(el-patch-defun circe (network-or-server &rest server-options)
98 "Connect to IRC.
99
100Connect to the given network specified by NETWORK-OR-SERVER.
101
102When this function is called, it collects options from the
103SERVER-OPTIONS argument, the user variable
104`circe-network-options', and the defaults found in
105`circe-network-defaults', in this order.
106
107If NETWORK-OR-SERVER is not found in any of these variables, the
108argument is assumed to be the host name for the server, and all
109relevant settings must be passed via SERVER-OPTIONS.
110
111All SERVER-OPTIONS are treated as variables by getting the string
112\"circe-\" prepended to their name. This variable is then set
113locally in the server buffer.
114
115See `circe-network-options' for a list of common options."
116 (interactive (circe--read-network-and-options))
117 (let* ((options (circe--server-get-network-options network-or-server
118 server-options))
119 (buffer (circe--server-generate-buffer options)))
120 (with-current-buffer buffer
121 (circe-server-mode)
122 (circe--server-set-variables options)
123 (circe-reconnect))
124 (el-patch-swap (pop-to-buffer-same-window buffer)
125 (funcall circe-server-buffer-action buffer))))
126
127;;; Chat commands
128
129(defun circe-command-SHORTEN (url)
130 "Shorten URL using `0x0-shorten-uri'.")
131
132(defun circe-command-SLAP (nick)
133 "Slap NICK around a bit with a large trout.")
134
135;;; Pure idiocy
136
137(define-minor-mode circe-cappy-hour-mode
138 "ENABLE CAPPY HOUR IN CIRCE!"
139 :lighter "CAPPY HOUR"
140 (when (derived-mode-p 'circe-chat-mode)
141 (if circe-cappy-hour-mode
142 (setq-local lui-input-function
143 (lambda (input) (circe--input (upcase input))))
144 ;; XXX: It'd be better if this were more general, but whatever.
145 (setq-local lui-input-function #'circe--input))))
146
147(provide '+circe)
148;;; +circe.el ends here
diff --git a/lisp/+consult.el b/lisp/+consult.el new file mode 100644 index 0000000..7b6a20f --- /dev/null +++ b/lisp/+consult.el
@@ -0,0 +1,47 @@
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)
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/+defaults.el b/lisp/+defaults.el new file mode 100644 index 0000000..ee49480 --- /dev/null +++ b/lisp/+defaults.el
@@ -0,0 +1,239 @@
1;;; +defaults.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
16;;; Code:
17
18(require 'early-init (locate-user-emacs-file "early-init.el"))
19
20(defun +set-major-mode-from-buffer-name (&optional buf)
21 "Set the major mode for BUF from the buffer's name.
22Do this only if the buffer is not visiting a file."
23 (unless buffer-file-name
24 (let ((buffer-file-name (buffer-name buf)))
25 (set-auto-mode))))
26
27;;; General settings
28
29(setq-default
30 apropos-do-all t
31 async-shell-command-buffer 'new-buffer
32 async-shell-command-display-buffer nil
33 auto-hscroll-mode 'current-line
34 auto-revert-verbose nil
35 auto-save-file-name-transforms `((".*" ,(.etc "auto-save/" t) t))
36 auto-save-interval 60
37 auto-save-list-file-prefix (.etc "auto-save/.saves-" t)
38 auto-save-timeout 60
39 auto-save-visited-interval 60
40 auto-window-vscroll nil
41 backup-by-copying t
42 backup-directory-alist `((".*" . ,(.etc "backup/" t)))
43 blink-cursor-blinks 1
44 completion-category-defaults nil
45 completion-category-overrides '((file (styles . (partial-completion))))
46 completion-ignore-case t
47 completion-styles '(substring partial-completion)
48 cursor-in-non-selected-windows 'hollow
49 cursor-type 'bar
50 custom-file (.etc "custom.el")
51 delete-old-versions t
52 echo-keystrokes 0.1
53 ediff-window-setup-function 'ediff-setup-windows-plain
54 eldoc-echo-area-use-multiline-p nil
55 eldoc-idle-delay 0.1
56 enable-recursive-minibuffers t
57 executable-prefix-env t
58 fast-but-imprecise-scrolling t
59 file-name-shadow-properties '(invisible t intangible t)
60 frame-resize-pixelwise t
61 global-auto-revert-non-file-buffers t
62 global-mark-ring-max 100
63 hscroll-step 1
64 imenu-auto-rescan t
65 indent-tabs-mode nil
66 inhibit-startup-screen t
67 initial-buffer-choice t
68 kill-do-not-save-duplicates t
69 kill-read-only-ok t
70 kill-ring-max 500
71 kmacro-ring-max 20
72 load-prefer-newer t
73 major-mode '+set-major-mode-from-buffer-name
74 mark-ring-max 50
75 minibuffer-eldef-shorten-default t
76 minibuffer-prompt-properties '(read-only t
77 cursor-intangible t
78 face minibuffer-prompt)
79 mode-require-final-newline 'visit-save
80 mouse-drag-copy-region t
81 mouse-yank-at-point t
82 native-comp-async-report-warnings-errors 'silent
83 read-answer-short t
84 read-buffer-completion-ignore-case t
85 read-extended-command-predicate (when
86 (fboundp
87 'command-completion-default-include-p)
88 'command-completion-default-include-p)
89 recenter-positions '(top middle bottom)
90 regexp-search-ring-max 100
91 regexp-search-ring-max 200
92 save-interprogram-paste-before-kill t
93 scroll-conservatively 101
94 scroll-preserve-screen-position 1
95 scroll-step 1
96 search-ring-max 200
97 search-ring-max 200
98 sentence-end-double-space t
99 set-mark-command-repeat-pop t
100 show-paren-delay 0
101 show-paren-style 'mixed
102 show-paren-when-point-in-periphery t
103 show-paren-when-point-inside-paren t
104 tramp-backup-directory-alist backup-directory-alist
105 use-dialog-box nil
106 use-file-dialog nil
107 use-short-answers t
108 vc-follow-symlinks t
109 vc-make-backup-files t
110 version-control t
111 view-read-only t
112 visible-bell nil
113 window-resize-pixelwise t
114 x-select-enable-clipboard t
115 x-select-enable-primary t
116 yank-pop-change-selection t
117 )
118
119(when (version< emacs-version "28")
120 (fset 'yes-or-no-p 'y-or-n-p))
121
122;; Encoding -- UTF-8 everywhere
123(setq-default locale-coding-system 'utf-8-unix
124 coding-system-for-read 'utf-8-unix
125 coding-system-for-write 'utf-8-unix
126 buffer-file-coding-system 'utf-8-unix
127 default-process-coding-system '(utf-8-unix . utf-8-unix)
128 x-select-request-type '(UTF8_STRING
129 COMPOUND_TEXT
130 TEXT
131 STRING))
132
133(set-charset-priority 'unicode)
134(set-language-environment "UTF-8")
135(prefer-coding-system 'utf-8-unix)
136(set-default-coding-systems 'utf-8-unix)
137(set-terminal-coding-system 'utf-8-unix)
138(set-keyboard-coding-system 'utf-8-unix)
139
140(pcase system-type
141 ((or 'ms-dos 'windows-nt)
142 (set-clipboard-coding-system 'utf-16-le)
143 (set-selection-coding-system 'utf-16-le))
144 (_
145 (set-selection-coding-system 'utf-8)
146 (set-clipboard-coding-system 'utf-8)))
147
148;;; Modes
149
150(dolist (enable-mode '(global-auto-revert-mode
151 blink-cursor-mode
152 electric-pair-mode
153 show-paren-mode
154 global-so-long-mode
155 minibuffer-depth-indicate-mode
156 file-name-shadow-mode
157 minibuffer-electric-default-mode
158 delete-selection-mode
159 column-number-mode))
160 (when (fboundp enable-mode)
161 (funcall enable-mode +1)))
162
163(dolist (disable-mode '(tooltip-mode
164 tool-bar-mode
165 menu-bar-mode
166 scroll-bar-mode
167 horizontal-scroll-bar-mode))
168 (when (fboundp disable-mode)
169 (funcall disable-mode -1)))
170
171;;; Hooks
172
173(add-hook 'after-save-hook 'executable-make-buffer-file-executable-if-script-p)
174(add-hook 'minibuffer-setup-hook 'cursor-intangible-mode)
175
176;;; Bindings
177
178(global-set-key (kbd "M-/") 'hippie-expand)
179(global-set-key (kbd "M-=") 'count-words)
180(global-set-key (kbd "C-x C-b") 'ibuffer)
181(global-set-key (kbd "C-s") 'isearch-forward-regexp)
182(global-set-key (kbd "C-r") 'isearch-backward-regexp)
183(global-set-key (kbd "C-M-s") 'isearch-forward)
184(global-set-key (kbd "C-M-r") 'isearch-backward)
185
186;;; Required libraries
187
188(when (require 'uniquify nil :noerror)
189 (setq-default uniquify-buffer-name-style 'forward
190 uniquify-separator path-separator
191 uniquify-after-kill-buffer-p t
192 uniquify-ignore-buffers-re "^\\*"))
193
194(when (require 'goto-addr)
195 (if (fboundp 'global-goto-address-mode)
196 (global-goto-address-mode +1)
197 (add-hook 'after-change-major-mode-hook 'goto-address-mode)))
198
199(when (require 'recentf nil :noerror)
200 (setq-default recentf-save-file (.etc "recentf.el")
201 recentf-max-menu-items 100
202 recentf-max-saved-items nil
203 recentf-auto-cleanup 'mode)
204 (add-to-list 'recentf-exclude .etc)
205 (recentf-mode +1))
206
207(when (require 'repeat nil :noerror)
208 (setq-default repeat-exit-key "g"
209 repeat-exit-timeout 5)
210 (repeat-mode +1))
211
212(when (require 'savehist nil :noerror)
213 (setq-default history-length t
214 history-delete-duplicates t
215 history-autosave-interval 60
216 savehist-file (.etc "savehist.el"))
217 (dolist (var '(extended-command-history
218 global-mark-ring
219 kill-ring
220 regexp-search-ring
221 search-ring
222 mark-ring))
223 (add-to-list 'savehist-additional-variables var))
224 (savehist-mode +1))
225
226(when (require 'saveplace nil :noerror)
227 (setq-default save-place-file (.etc "places.el")
228 save-place-forget-unreadable-files (eq system-type 'gnu/linux))
229 (save-place-mode +1))
230
231(when (require 'tramp)
232 ;; thanks Irreal! https://irreal.org/blog/?p=895
233 (add-to-list 'tramp-default-proxies-alist
234 '(nil "\\`root\\'" "/ssh:%h:"))
235 (add-to-list 'tramp-default-proxies-alist
236 '((regexp-quote (system-name)) nil nil)))
237
238(provide '+defaults)
239;;; +defaults.el ends here
diff --git a/lisp/+dired.el b/lisp/+dired.el new file mode 100644 index 0000000..7decec1 --- /dev/null +++ b/lisp/+dired.el
@@ -0,0 +1,8 @@
1;;; +dired.el -*- lexical-binding: t -*-
2
3;;; Code:
4
5
6
7(provide '+dired)
8;;; +dired.el ends here
diff --git a/lisp/acdw-eshell.el b/lisp/+eshell.el index eedcc8b..bd92b03 100644 --- a/lisp/acdw-eshell.el +++ b/lisp/+eshell.el
@@ -1,44 +1,37 @@
1;;; acdw-eshell.el -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; +eshell.el -*- lexical-binding: t; -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Keywords: configuration
5;; URL: https://tildegit.org/acdw/emacs
6
7;; This file is NOT part of GNU Emacs.
8
9;;; License:
10;; Everyone is permitted to do whatever with this software, without
11;; limitation. This software comes without any warranty whatsoever,
12;; but with two pieces of advice:
13;; - Don't hurt yourself.
14;; - Make good choices.
15
16;;; Commentary:
17 2
18;;; Code: 3;;; Code:
19 4
20(require 'cl-lib) 5;; https://karthinks.com/software/jumping-directories-in-eshell/
21 6(defun eshell/z (&optional regexp)
22 7 "Navigate to a previously visited directory in eshell, or to
23;;; Eshell starting and quitting 8any directory proferred by `consult-dir'."
24 9 (let ((eshell-dirs (delete-dups
25(defun eshell-quit-or-delete-char (arg) 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(defun +eshell-quit-or-delete-char (arg)
26 "Delete the character to the right, or quit eshell on an empty line." 29 "Delete the character to the right, or quit eshell on an empty line."
27 (interactive "p") 30 (interactive "p")
28 (if (and (eolp) (looking-back eshell-prompt-regexp)) 31 (if (and (eolp) (looking-back eshell-prompt-regexp))
29 (eshell-life-is-too-much) 32 (eshell-life-is-too-much)
30 (delete-forward-char arg))) 33 (delete-forward-char arg)))
31 34
32;;;###autoload
33(defun eshell-pop-or-quit (&optional buffer-name)
34 "Pop open an eshell buffer, or if in an eshell buffer, bury it."
35 (interactive)
36 (if (eq (current-buffer) (get-buffer (or buffer-name "*eshell*")))
37 (eshell-life-is-too-much)
38 (with-message "Starting eshell"
39 (eshell))))
40
41
42;;; Insert previous arguments 35;;; Insert previous arguments
43;; Record arguments 36;; Record arguments
44 37
@@ -72,12 +65,6 @@
72 (insert (cl-first eshell-arg-history)) 65 (insert (cl-first eshell-arg-history))
73 (setq eshell-arg-history-index 1))) 66 (setq eshell-arg-history-index 1)))
74 67
75(add-hook 'eshell-mode-hook
76 (lambda ()
77 (add-hook 'eshell-post-command-hook
78 #'eshell-record-args nil t)
79 (local-set-key (kbd "M-.") #'eshell-insert-prev-arg)))
80
81;;;###autoload 68;;;###autoload
82(define-minor-mode eshell-arg-hist-mode 69(define-minor-mode eshell-arg-hist-mode
83 "Minor mode to enable argument history, like bash/zsh with M-." 70 "Minor mode to enable argument history, like bash/zsh with M-."
@@ -89,5 +76,5 @@
89 (add-hook 'eshell-post-command-hook #'eshell-record-args nil t) 76 (add-hook 'eshell-post-command-hook #'eshell-record-args nil t)
90 (remove-hook 'eshell-post-command-hook #'eshell-record-args t))) 77 (remove-hook 'eshell-post-command-hook #'eshell-record-args t)))
91 78
92(provide 'acdw-eshell) 79(provide '+eshell)
93;;; acdw-eshell.el ends here 80;;; +eshell.el ends here
diff --git a/lisp/+init.el b/lisp/+init.el new file mode 100644 index 0000000..3ab0486 --- /dev/null +++ b/lisp/+init.el
@@ -0,0 +1,92 @@
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.
6
7;;; Code:
8
9(require '+lisp)
10
11;;; Sort `setup' forms
12
13(defun +init--sexp-setup-p (sexp-str &optional head)
14 "Is SEXP-STR a `setup' form, optionally with a HEAD form?"
15 (let ((head (if (and head (symbolp head))
16 (symbol-name head)
17 head)))
18 (and (string-match-p (rx (: bos (* whitespace) "(setup")) sexp-str)
19 (if head
20 (string-match-p (concat "\\`.*" head) sexp-str)
21 t))))
22
23(defun +init-sort ()
24 "Sort init.el.
25Sort based on the following heuristic: `setup' forms (the
26majority of my init.el) are sorted after everything else, and
27within that group, forms with a HEAD of `:require' are sorted
28first, and `:straight' HEADs are sorted last. All other forms
29are sorted lexigraphically."
30 (interactive)
31 (save-excursion
32 (save-restriction
33 (widen)
34 (+lisp-sort-sexps
35 (point-min) (point-max)
36 ;; Key function
37 nil
38 ;; Sort function
39 (lambda (s1 s2)
40 (let ((s1 (cdr s1)) (s2 (cdr s2)))
41 (cond
42 ;; Sort everything /not/ `setup' /before/ `setup'
43 ((and (+init--sexp-setup-p s1)
44 (not (+init--sexp-setup-p s2)))
45 nil)
46 ((and (+init--sexp-setup-p s2)
47 (not (+init--sexp-setup-p s1)))
48 t)
49 ;; otherwise...
50 (t (let ((s1-straight (+init--sexp-setup-p s1 :straight))
51 (s2-straight (+init--sexp-setup-p s2 :straight))
52 (s1-require (+init--sexp-setup-p s1 :require))
53 (s2-require (+init--sexp-setup-p s2 :require)))
54 (cond
55 ;; `:straight' setups have extra processing
56 ((and s1-straight s2-straight)
57 (let* ((r (rx (: ":straight" (? "-when") (* space) (? "("))))
58 (s1 (replace-regexp-in-string r "" s1))
59 (s2 (replace-regexp-in-string r "" s2)))
60 (string< s1 s2)))
61 ;; `:require' setups go first
62 ((and s1-require (not s2-require)) t)
63 ((and s2-require (not s1-require)) nil)
64 ;; `:straight' setups go last
65 ((and s1-straight (not s2-straight)) nil)
66 ((and s2-straight (not s1-straight)) t)
67 ;; otherwise, sort lexigraphically
68 (t (string< s1 s2))))))))))))
69
70;;; Add `setup' forms to `imenu-generic-expression'
71
72(defun +init-add-setup-to-imenu ()
73 "Recognize `setup' forms in `imenu'."
74 ;; `imenu-generic-expression' automatically becomes buffer-local when set
75 (setf (alist-get "Setup" imenu-generic-expression nil nil 'string-equal)
76 (list
77 (rx (: bol (* space)
78 "(setup" (+ space)
79 (group (? "(") (* nonl))))
80 1)))
81
82;;; Major mode
83
84;;;###autoload
85(define-derived-mode +init-mode emacs-lisp-mode "Init.el"
86 "`emacs-lisp-mode', but with a few specialized bits and bobs for init.el.")
87
88;;;###autoload
89(add-to-list 'auto-mode-alist '("/init\\.el\\'" . +init-mode))
90
91(provide '+init)
92;;; +init.el ends here
diff --git a/lisp/+lisp.el b/lisp/+lisp.el new file mode 100644 index 0000000..3267fd9 --- /dev/null +++ b/lisp/+lisp.el
@@ -0,0 +1,71 @@
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(provide '+lisp)
71;;; +lisp.el ends here
diff --git a/lisp/acdw-org.el b/lisp/+org.el index f0a1d49..a4ce230 100644 --- a/lisp/acdw-org.el +++ b/lisp/+org.el
@@ -1,70 +1,29 @@
1;;; acdw-org.el --- org extras -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; +org.el -*- lexical-binding: t; -*-
2;; Author: Various
3;; URL: https://tildegit.org/acdw/emacs
4
5;; This file is NOT part of GNU Emacs.
6
7;;; License:
8
9;; Everyone is permitted to do whatever with this software, without
10;; limitation. This software comes without any warranty whatsoever,
11;; but with two pieces of advice:
12;; - Don't hurt yourself.
13;; - Make good choices.
14
15;;; Commentary:
16
17;; This file is for the weird little `org-mode' functions that just take up
18;; space in my main init file. I've tried to give credit where credit is due.
19
20;; 2021-09-13 Hi readers of "Emacs News!" I just saw that Sacha decided to
21;; include this in her weekly newsletter. Thanks for the gold kind stranger,
22;; etc. If you're looking for stuff in here that /isn't/ just ripped
23;; wholesale from something else on the internet, you'll want the following
24;; (updated as I write more/remember to update them):
25
26;; `acdw-org/fix-blank-lines-in-buffer'
27;; `acdw-org/count-words-stupidly'
28;; `acdw/org-next-heading-widen'
29;; `acdw/org-previous-heading-widen'
30;; `acdw-org/work-month-headings'
31
32;; To be honest, I could easily (and probably should) extract some of these out
33;; into their own /real/ libraries.
34
35;; Until then, just require this file /after/ you require org -- i.e.,
36;; (with-eval-after-load 'org (require 'acdw-org)) -- or else it'll load every
37;; time you start up Emacs.
38 2
39;;; Code: 3;;; Code:
40 4
41(require 'dom)
42(require 'org) 5(require 'org)
43(require 'org-element) 6(require 'org-element)
44(require 'ox) 7(require 'ox)
45(require 'subr-x)
46(require 'calendar)
47 8
48 9;;; org-return-dwim - https://github.com/alphapapa/unpackaged.el
49;;; unpackaged.el: https://github.com/alphapapa/unpackaged.el 10;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
50 11
51(defun acdw-org/element-descendant-of (type element) 12(defun +org-element-descendant-of (type element)
52 "Return non-nil if ELEMENT is a descendant of TYPE. 13 "Return non-nil if ELEMENT is a descendant of TYPE.
53TYPE should be an element type, like `item' or `paragraph'. 14TYPE should be an element type, like `item' or `paragraph'.
54ELEMENT should be a list like that returned by `org-element-context'." 15ELEMENT should be a list like that returned by `org-element-context'."
55 ;; MAYBE: Use `org-element-lineage'. 16 ;; MAYBE: Use `org-element-lineage'.
56 (when-let* ((parent (org-element-property :parent element))) 17 (when-let* ((parent (org-element-property :parent element)))
57 (or (eq type (car parent)) 18 (or (eq type (car parent))
58 (acdw-org/element-descendant-of type parent)))) 19 (+org-element-descendant-of type parent))))
59 20
60(defun acdw-org/return-dwim (&optional prefix) 21(defun +org-return-dwim (&optional prefix)
61 "A helpful replacement for `org-return'. With PREFIX, call `org-return'. 22 "A helpful replacement for `org-return'. With PREFIX, call `org-return'.
62 23
63On headings, move point to position after entry content. In 24On headings, move point to position after entry content. In
64lists, insert a new item or end the list, with checkbox if 25lists, insert a new item or end the list, with checkbox if
65appropriate. In tables, insert a new row or end the table." 26appropriate. In tables, insert a new row or end the table."
66 ;; Inspired by John Kitchin:
67 ;; http://kitchingroup.cheme.cmu.edu/blog/2017/04/09/A-better-return-in-org-mode/
68 (interactive "P") 27 (interactive "P")
69 ;; Auto-fill if enabled 28 ;; Auto-fill if enabled
70 (when auto-fill-function 29 (when auto-fill-function
@@ -124,7 +83,7 @@ appropriate. In tables, insert a new row or end the table."
124 (emptyp (eq (org-element-property :contents-begin context) 83 (emptyp (eq (org-element-property :contents-begin context)
125 (org-element-property :contents-end context))) 84 (org-element-property :contents-end context)))
126 (item-child-p 85 (item-child-p
127 (acdw-org/element-descendant-of 'item context))) 86 (+org-element-descendant-of 'item context)))
128 ;; The original function from unpackaged just tested the (or ...) test 87 ;; The original function from unpackaged just tested the (or ...) test
129 ;; in this cond, in an if. However, that doesn't auto-end nested 88 ;; in this cond, in an if. However, that doesn't auto-end nested
130 ;; lists. So I made this form a cond and added the (and...) test in 89 ;; lists. So I made this form a cond and added the (and...) test in
@@ -165,7 +124,17 @@ appropriate. In tables, insert a new row or end the table."
165 ;; All other cases: call `org-return'. 124 ;; All other cases: call `org-return'.
166 (org-return))))) 125 (org-return)))))
167 126
168(defun acdw-org/fix-blank-lines (&optional prefix) 127(defun +org-table-copy-down (n)
128 "Call `org-table-copy-down', or `org-return' outside of a table.
129N is passed to the functions."
130 (interactive "p")
131 (if (org-table-check-inside-data-field 'noerror)
132 (org-table-copy-down n)
133 (+org-return-dwim n)))
134
135;;; org-fix-blank-lines - unpackaged.el
136
137(defun +org-fix-blank-lines (&optional prefix)
169 "Ensure blank lines around headings. 138 "Ensure blank lines around headings.
170Optional PREFIX argument operates on the entire buffer. 139Optional PREFIX argument operates on the entire buffer.
171Drawers are included with their headings." 140Drawers are included with their headings."
@@ -203,78 +172,9 @@ Drawers are included with their headings."
203 nil 172 nil
204 'tree))) 173 'tree)))
205 174
206 175;;; org-count-words
207;;; Generate custom IDs:
208;; https://amitp.blogspot.com/2021/04/automatically-generate-ids-for-emacs.html
209
210(defun acdw-org/generate-custom-ids ()
211 "Generate CUSTOM_ID for any headings that are missing one."
212 (let ((existing-ids (org-map-entries (lambda ()
213 (org-entry-get nil "CUSTOM_ID")))))
214 (org-map-entries
215 (lambda ()
216 (let* ((custom-id (org-entry-get nil "CUSTOM_ID"))
217 (heading (org-heading-components))
218 (level (nth 0 heading))
219 (todo (nth 2 heading))
220 (headline (nth 4 heading))
221 (slug (acdw-org/title-to-filename headline))
222 (duplicate-id (member slug existing-ids)))
223 (when (and (not custom-id)
224 (< level 4)
225 (not todo)
226 (not duplicate-id))
227 (message "Adding entry '%s' to '%s'" slug headline)
228 (org-entry-put nil "CUSTOM_ID" slug)))))))
229
230(defun acdw-org/title-to-filename (title)
231 "Convert TITLE to a reasonable filename."
232 ;; Based on the slug logic in `org-roam', but `org-roam' also uses a
233 ;; timestamp, and I only use the slug.
234 (setq title (downcase title))
235 (setq title (replace-regexp-in-string "[^a-zA-Z0-9]+" "-" title))
236 (setq title (replace-regexp-in-string "-+" "-" title))
237 (setq title (replace-regexp-in-string "^-" "" title))
238 (setq title (replace-regexp-in-string "-$" "" title))
239 title)
240
241
242;;; ADVICE AND TWEAKS
243
244;; I definitely got this from somewhere.
245;; Correct `org-delete-backward-char' to use `backward-delete-char-untabify'
246(defun acdw-org/delete-backward-char (N)
247 "Keep tables aligned while deleting N characters backward.
248When deleting backwards, in tables this function will insert
249whitespace in front of the next \"|\" separator, to keep the
250table aligned. The table will still be marked for re-alignment
251if the field did fill the entire column, because, in this case
252the deletion might narrow the column."
253 (interactive "p")
254 (save-match-data
255 (org-check-before-invisible-edit 'delete-backward)
256 (if (and (= N 1)
257 (not overwrite-mode)
258 (not (org-region-active-p))
259 (not (eq (char-before) ?|))
260 (save-excursion (skip-chars-backward " \t") (not (bolp)))
261 (looking-at-p ".*?|")
262 (org-at-table-p))
263 (progn (forward-char -1) (org-delete-char 1))
264 (backward-delete-char-untabify N)
265 (org-fix-tags-on-the-fly))))
266 176
267;; Same here. 177(defun +org-count-words-stupidly (start end &optional limit)
268(defun acdw-org/org-table-copy-down (n)
269 "Call `org-table-copy-down', or `org-return' outside of a table.
270N is passed to the functions."
271 (interactive "p")
272 (if (org-table-check-inside-data-field 'noerror)
273 (org-table-copy-down n)
274 (acdw-org/return-dwim n)))
275
276;; This isn't the best code, but it'll do.
277(defun acdw-org/count-words-stupidly (start end &optional limit)
278 "Count words between START and END, ignoring a lot. 178 "Count words between START and END, ignoring a lot.
279 179
280Since this function is, for some reason, pricy, the optional 180Since this function is, for some reason, pricy, the optional
@@ -334,7 +234,7 @@ instead of the true count."
334 (assoc :keyword contexts) 234 (assoc :keyword contexts)
335 (assoc :checkbox contexts)) 235 (assoc :checkbox contexts))
336 (forward-word-strictly)) 236 (forward-word-strictly))
337 237
338 (t (setq words (1+ words)) 238 (t (setq words (1+ words))
339 (if (and limit 239 (if (and limit
340 (> words limit)) 240 (> words limit))
@@ -344,32 +244,16 @@ instead of the true count."
344 words)) 244 words))
345 ((use-region-p) 245 ((use-region-p)
346 (message "%d words in region" 246 (message "%d words in region"
347 (acdw-org/count-words-stupidly (region-beginning) 247 (+org-count-words-stupidly (region-beginning)
348 (region-end)))) 248 (region-end))))
349 (t 249 (t
350 (message "%d words in buffer" 250 (message "%d words in buffer"
351 (acdw-org/count-words-stupidly (point-min) 251 (+org-count-words-stupidly (point-min)
352 (point-max)))))) 252 (point-max))))))
353 253
354 254;;; org-insert-link-dwim - https://xenodium.com/emacs-dwim-do-what-i-mean/
355;;; Zero-width spaces
356;; https://blog.tecosaur.com/tmio/2021-05-31-async.html#easy-zero-width
357
358(defun insert-zero-width-space ()
359 "Insert a zero-width space."
360 (interactive)
361 (insert "\u200b"))
362
363(defun org-export-remove-zero-width-spaces (text _backend _info)
364 "Remove zero-width spaces from TEXT."
365 (unless (org-export-derived-backend-p 'org)
366 (replace-regexp-in-string "\u200b" "" text)))
367
368
369;;; Insert links .. DWIM
370;; https://xenodium.com/emacs-dwim-do-what-i-mean/
371 255
372(defun org-insert-link-dwim () 256(defun +org-insert-link-dwim ()
373 "Like `org-insert-link' but with personal dwim preferences." 257 "Like `org-insert-link' but with personal dwim preferences."
374 (interactive) 258 (interactive)
375 (let* ((point-in-link (org-in-regexp org-link-any-re 1)) 259 (let* ((point-in-link (org-in-regexp org-link-any-re 1))
@@ -402,9 +286,9 @@ instead of the true count."
402 (t 286 (t
403 (call-interactively 'org-insert-link))))) 287 (call-interactively 'org-insert-link)))))
404 288
405 289;;; Navigate headings with widening
406;;; Next and previous heading, with widening 290
407(defun acdw/org-next-heading-widen (arg) 291(defun +org-next-heading-widen (arg)
408 "Find the ARGth next org heading, widening if necessary." 292 "Find the ARGth next org heading, widening if necessary."
409 (interactive "p") 293 (interactive "p")
410 (let ((current-point (point)) 294 (let ((current-point (point))
@@ -418,100 +302,40 @@ instead of the true count."
418 (widen) 302 (widen)
419 (org-next-visible-heading arg)))) 303 (org-next-visible-heading arg))))
420 304
421(defun acdw/org-previous-heading-widen (arg) 305(defun +org-previous-heading-widen (arg)
422 "Find the ARGth previous org heading, widening if necessary." 306 "Find the ARGth previous org heading, widening if necessary."
423 (interactive "p") 307 (interactive "p")
424 (acdw/org-next-heading-widen (- arg))) 308 (+org-next-heading-widen (- arg)))
425
426
427;;; Add headings for every day of the work month
428;; Gets rid of weekends.
429
430(defun acdw-org/work-month-headings (&optional month year)
431 "Create headings for every workday in MONTH and YEAR, or this month.
432Workdays are Monday through Friday. This function inserts a new
433heading with an inactive timestamp for each workday of MONTH in YEAR.
434
435I use this function to attempt to organize my work month. I'll
436probably abandon it at some point for a better solution (see:
437`org-agenda')."
438 (interactive (list
439 (read-number "Month: " (car (calendar-current-date)))
440 (read-number "Year: " (nth 2 (calendar-current-date)))))
441 (let ((month (or month
442 (car (calendar-current-date))))
443 (year (or year
444 (car (last (calendar-current-date))))))
445 (dotimes (day (calendar-last-day-of-month month year))
446 (let* ((day (1+ day))
447 (day-of-week (calendar-day-of-week (list month day year))))
448 (unless (memq day-of-week '(0 6)) ; weekend
449 (end-of-line)
450 (org-insert-heading nil t t)
451 (insert (concat "[" (mapconcat (lambda (n)
452 (format "%02d" n))
453 (list year month day)
454 "-")
455 " "
456 (nth day-of-week '("Sun" "Mon" "Tue" "Wed" "Thu"
457 "Fri" "Sat"))
458 "]")))))))
459
460;;; Org task stuff
461
462(defun org-narrow-to-task ()
463 "Narrow buffer to the nearest task and its subtree."
464 (interactive)
465 (save-excursion
466 (save-match-data
467 (widen)
468 (while (not (or (org-entry-is-todo-p)
469 (org-entry-is-done-p)))
470 ;; TODO: need a better error message
471 (org-previous-visible-heading 1))
472 (org-narrow-to-subtree))))
473 309
474 310;;; Hooks & Advice
475;;; Hide everything but the current headline
476;; https://stackoverflow.com/questions/25161792/
477 311
478(defun acdw-org/show-next-heading-tidily () 312(defun +org-before-save@prettify-buffer ()
479 "Show next entry, keeping other entries closed." 313 (save-mark-and-excursion
480 (interactive) 314 (mark-whole-buffer)
481 (if (save-excursion (end-of-line) (outline-invisible-p)) 315 ;;(org-fill-paragraph nil t)
482 (progn (org-show-entry) (outline-show-children)) 316 (+org-fix-blank-lines t)
483 (outline-next-heading) 317 (org-align-tags t)))
484 (unless (and (bolp) (org-at-heading-p))
485 (org-up-heading-safe)
486 (outline-hide-subtree)
487 (error "Boundary reached"))
488 (org-overview)
489 (org-reveal t)
490 (org-show-entry)
491 (recenter-top-bottom)
492 (outline-show-children)
493 (recenter-top-bottom)))
494
495(defun acdw-org/show-previous-heading-tidily ()
496 "Show previous entry, keeping other entries closed."
497 (interactive)
498 (let ((pos (point)))
499 (outline-previous-heading)
500 (unless (and (< (point) pos) (bolp) (org-at-heading-p))
501 (goto-char pos)
502 (outline-hide-subtree)
503 (error "Boundary reached"))
504 (org-overview)
505 (org-reveal t)
506 (org-show-entry)
507 (recenter-top-bottom)
508 (outline-show-children)
509 (recenter-top-bottom)))
510 318
511 319(defun +org-delete-backward-char (N)
512(provide 'acdw-org) 320 "Keep tables aligned while deleting N characters backward.
513;;; acdw-org.el ends here 321When deleting backwards, in tables this function will insert
322whitespace in front of the next \"|\" separator, to keep the
323table aligned. The table will still be marked for re-alignment
324if the field did fill the entire column, because, in this case
325the deletion might narrow the column."
326 (interactive "p")
327 (save-match-data
328 (org-check-before-invisible-edit 'delete-backward)
329 (if (and (= N 1)
330 (not overwrite-mode)
331 (not (org-region-active-p))
332 (not (eq (char-before) ?|))
333 (save-excursion (skip-chars-backward " \t") (not (bolp)))
334 (looking-at-p ".*?|")
335 (org-at-table-p))
336 (progn (forward-char -1) (org-delete-char 1))
337 (backward-delete-char-untabify N)
338 (org-fix-tags-on-the-fly))))
514 339
515;; Local Variables: 340(provide '+org)
516;; flymake-inhibit: t 341;;; +org.el ends here
517;; End:
diff --git a/lisp/+setup.el b/lisp/+setup.el new file mode 100644 index 0000000..dce5d7b --- /dev/null +++ b/lisp/+setup.el
@@ -0,0 +1,105 @@
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
27;; I don't like the "magic" `setup' performs to ensure a symbol is a
28;; function in `:global', `:bind', `:hook', `:hook-into', and others.
29;; So here, I'll just make it return the symbol unmodified.
30(el-patch-feature setup)
31(with-eval-after-load 'setup
32 (el-patch-defvar
33 (el-patch-add setup-ensure-function-inhibit nil
34 "Whether to inhibit `setup-ensure-function'."))
35 (el-patch-defun setup-ensure-function (sexp)
36 (el-patch-concat
37 "Attempt to return SEXP as a quoted function name."
38 (el-patch-add
39 "\nIf `setup-ensure-function-inhibit' is non-nil, just return SEXP."))
40 (el-patch-wrap 3 0
41 (if (and setup-ensure-function-inhibit
42 (not (eq sexp (setup-get 'mode))))
43 sexp
44 (cond ((eq (car-safe sexp) 'function)
45 sexp)
46 ((eq (car-safe sexp) 'quote)
47 `#',(cadr sexp))
48 ((symbolp sexp)
49 `#',sexp)
50 (sexp))))))
51
52(setup-define :face
53 (lambda (face spec)
54 `(custom-set-faces '(,face ,spec 'now "Customized by `setup'.")))
55 :documentation "Customize FACE with SPEC using `custom-set-faces'."
56 :repeatable t)
57
58(setup-define :load-after
59 (lambda (&rest features)
60 (let ((body `(require ',(setup-get 'feature))))
61 (dolist (feature (nreverse features))
62 (setq body `(with-eval-after-load ',feature ,body)))
63 body))
64 :documentation "Load the current feature after FEATURES.")
65
66(setup-define :also-straight
67 (lambda (recipe) `(setup (:straight ,recipe)))
68 :documentation
69 "Install RECIPE with `straight-use-package', after loading FEATURE."
70 :repeatable t
71 :after-loaded t)
72
73(setup-define :straight
74 (lambda (recipe)
75 `(unless (straight-use-package ',recipe)
76 ,(setup-quit)))
77 :documentation
78 "Install RECIPE with `straight-use-package'.
79This macro can be used as HEAD, and will replace itself with the
80first RECIPE's package."
81 :repeatable t
82 :shorthand (lambda (sexp)
83 (let ((recipe (cadr sexp)))
84 (if (consp recipe)
85 (car recipe)
86 recipe))))
87
88(setup-define :straight-when
89 (lambda (recipe condition)
90 `(unless (and ,condition
91 (straight-use-package ',recipe))
92 ,(setup-quit)))
93 :documentation
94 "Install RECIPE with `straight-use-package' when CONDITION is met.
95If CONDITION is false, or if `straight-use-package' fails, stop
96evaluating the body. This macro can be used as HEAD, and will
97replace itself with the RECIPE's package."
98 :repeatable 2
99 :indent 1
100 :shorthand (lambda (sexp)
101 (let ((recipe (cadr sexp)))
102 (if (consp recipe) (car recipe) recipe))))
103
104(provide '+setup)
105;;; +setup.el ends here
diff --git a/lisp/+util.el b/lisp/+util.el new file mode 100644 index 0000000..0870a71 --- /dev/null +++ b/lisp/+util.el
@@ -0,0 +1,81 @@
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 \"...\".
38
39ALIGNMENT defaults to `+string-default-alignment'."
40 (declare (pure t)
41 (side-effect-free t))
42 (let ((ellipsis (or 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 "...")
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
63ALIGNMENT can be one of these:
64- nil: align to `+string-default-alignment'
65- `left': align left
66- `right': align right"
67 (let* ((s-length (length s))
68 (before-length (length before))
69 (after-length (length after))
70 (max-length (- len (+ before-length after-length)))
71 (left-over (max 0 (- max-length s-length)))
72 (filler (+string-repeat left-over fill)))
73 (format "%s%s%s%s%s"
74 before
75 (if (eq alignment 'left) "" filler)
76 (+string-truncate s max-length ellipsis alignment)
77 (if (eq alignment 'right) "" filler)
78 after)))
79
80(provide '+util)
81;;; +util.el ends here
diff --git a/lisp/acdw-apheleia.el b/lisp/acdw-apheleia.el deleted file mode 100644 index 1b646ef..0000000 --- a/lisp/acdw-apheleia.el +++ /dev/null
@@ -1,25 +0,0 @@
1;;; acdw-apheleia.el --- bespoke apheleia junk -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;;; Code:
6
7(require 'apheleia)
8
9(defcustom apheleia-stupid-modes '(makefile-mode
10 org-mode)
11 "List of stupid modes to not use `apheleia-global-mode' on."
12 :type '(repeat function)
13 :group 'apheleia)
14
15(defun apheleia-dumb-auto-format ()
16 "Format a buffer dumbly."
17 ;; If there's no apheleia formatter for the mode, just indent the
18 ;; buffer.
19 (unless (or (apply #'derived-mode-p apheleia-stupid-modes)
20 (and (fboundp 'apheleia--get-formatter-command)
21 (apheleia--get-formatter-command)))
22 (indent-region (point-min) (point-max))))
23
24(provide 'acdw-apheleia)
25;;; acdw-apheleia ends here
diff --git a/lisp/acdw-autoinsert.el b/lisp/acdw-autoinsert.el deleted file mode 100644 index bc0810a..0000000 --- a/lisp/acdw-autoinsert.el +++ /dev/null
@@ -1,58 +0,0 @@
1;;; acdw-autoinsert.el --- autoinsert.el -*- lexical-binding: t; -*-
2
3;; Copyright (C) 2021 Case Duckworth
4
5;; Author: Case Duckworth <acdw@acdw.ne
6
7;;; License:
8
9;; Everyone is permitted to do whatever with this software, without
10;; limitation. This software comes without any warranty whatsoever,
11;; but with two pieces of advice:
12
13;; - Be kind to yourself.
14
15;; - Make good choices.
16
17;;; Commentary:
18
19;; These are my bespoke changes to the `autoinsert' library.
20
21;;; Code:
22
23(require 'autoinsert)
24(require 'cl-lib)
25
26(defun acdw/define-auto-insert (options condition action)
27 "Associate CONDITION with ACTION in `auto-insert-alist'.
28This function differs from `define-auto-insert' in that it won't
29allow more than one duplicate entry in `auto-insert-alist'.
30
31OPTIONS is a plist with three optional arguments:
32
33- `:testfn' takes a function to test the given CONDITION against
34 the already-existing ones in `auto-insert-alist'. It defaults
35 to testing the cdr of CONDITION against the cdar of each entry
36 in `auto-insert-alist'.
37
38- `:replace', if non-nil, will replace the matching entry with
39 the given one. Default: nil.
40
41- `:after' is the third, optional argument to `define-auto-insert'."
42 (declare (indent 1))
43 (let ((testfn (or (plist-get options :testfn)
44 (lambda (a b)
45 (string= (cdr-safe a) (cdar b)))))
46 (replace (or (plist-get options :replace) nil))
47 (after (or (plist-get options :after) nil)))
48 (if replace
49 (progn (setq auto-insert-alist
50 (assoc-delete-all (list condition)
51 auto-insert-alist
52 testfn))
53 (define-auto-insert condition action after))
54 (unless (assoc (list condition) auto-insert-alist testfn)
55 (define-auto-insert condition action after)))))
56
57(provide 'acdw-autoinsert)
58;;; acdw-autoinsert.el ends here
diff --git a/lisp/acdw-bell.el b/lisp/acdw-bell.el deleted file mode 100644 index 514be1f..0000000 --- a/lisp/acdw-bell.el +++ /dev/null
@@ -1,28 +0,0 @@
1;;; acdw-bell.el --- flash mode-line on error -*- lexical-binding: t; -*-
2
3;; cribbed pretty heavily from doom-themes-ext-visual-bell.el ...
4
5(require 'face-remap)
6
7(defface acdw-bell '((t (:inherit mode-line-highlight)))
8 "Face to use for the mode-line when `doom-themes-visual-bell-config' is used."
9 :group 'mode-line)
10
11;;;###autoload
12(defun acdw-bell/flash-mode-line (&optional beep-p)
13 "Blink the mode-line red briefly. Set `ring-bell-function' to this to use it.
14If BEEP-P is non-nil, beep too."
15 (let ((acdw-bell//cookie
16 (face-remap-add-relative 'mode-line 'acdw-bell)))
17 (force-mode-line-update)
18 (when beep-p (beep))
19 (run-with-timer 0.15 nil
20 (lambda (cookie buf)
21 (with-current-buffer buf
22 (face-remap-remove-relative cookie)
23 (force-mode-line-update)))
24 acdw-bell//cookie
25 (current-buffer))))
26
27(provide 'acdw-bell)
28;;; acdw-bell.el ends here
diff --git a/lisp/acdw-browse-url.el b/lisp/acdw-browse-url.el deleted file mode 100644 index 9f8e484..0000000 --- a/lisp/acdw-browse-url.el +++ /dev/null
@@ -1,129 +0,0 @@
1;;; acdw-browse-url.el -*- lexical-binding: t; coding: utf-8-unix -*-
2;;
3;; Add-ons to `browse-url'.
4
5(defvar browse-url-mpv-arguments nil
6 "Arguments to pass to mpv in `browse-url-mpv'.")
7
8(defun browse-url-mpv (url &optional new-window)
9 "Play URL in mpv."
10 (interactive (browse-url-interactive-arg "Video URL: "))
11 (ignore new-window) ;; mpv always opens a new window
12 (let* ((url (browse-url-encode-url url))
13 (process-environment (browse-url-process-environment)))
14 (message "Playing %s in mpv..." url)
15 (apply #'start-process
16 (concat "mpv " url) nil
17 "mpv"
18 (append
19 browse-url-mpv-arguments
20 (list url)))))
21
22(defvar browse-url-feh-arguments '("--auto-zoom"
23 "--geometry" "800x600")
24 "Arguments to pass to feh in `browse-url-feh'.")
25
26(defun browse-url-feh (url &optional new-window)
27 "Open `URL' in feh."
28 (interactive (browse-url-interactive-arg "Video URL: "))
29 (ignore new-window) ;; mpv always opens a new window
30 (let* ((url (browse-url-encode-url url))
31 (process-environment (browse-url-process-environment)))
32 (message "Opening %s in feh..." url)
33 (apply #'start-process
34 (concat "feh " url) nil
35 "feh"
36 (append
37 browse-url-feh-arguments
38 (list url)))))
39
40(defun acdw/browse-url-set-handlers (handlers)
41 "Set handlers for `browse-url'.
42If Emacs' version is 28 or higher, set `browse-url-handlers'.
43Else, set `browse-url-browser-function'; it's deprecated in 28+."
44 (set-default (if (version< emacs-version "28")
45 #'browse-url-browser-function
46 #'browse-url-handlers)
47 handlers))
48
49;;; URL regexp
50;; really, I just want to add gemini:// protocol, but I'm going to do some
51;; reverse-engineering here.
52(defvar acdw/button-protocols '("http"
53 "https"
54 "shttp"
55 "shttps"
56 "ftp"
57 "file"
58 "gopher"
59 "nntp"
60 "news"
61 "telnet"
62 "wais"
63 "mailto"
64 "info")
65 "The list of protocols to splice into `browse-url-button-regexp'.")
66
67(defun acdw/build-button-url-regexp ()
68 "Build `browse-url-button-regexp' from `acdw/button-protocols'.
69I used `xr' (not included in Emacs) to get the RX form of the
70default, so I can easily splice the list into it. THIS IS
71BRITTLE AF!!!"
72 (rx-to-string ; thanks wgreenhouse!
73 `(seq word-boundary
74 (group
75 (group
76 (or "www."
77 (seq
78 (group (or ,@acdw/button-protocols))
79 ":")))
80 (opt
81 (group "//"
82 (one-or-more
83 (any "0-9a-z" "._-"))
84 ":"
85 (zero-or-more
86 (any "0-9"))))
87 (or
88 (seq
89 (one-or-more
90 (any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
91 "("
92 (one-or-more
93 (any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
94 (zero-or-more
95 (any "0-9a-z" "#$%&*+/=@\\_~-" word))
96 ")"
97 (opt
98 (one-or-more
99 (any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
100 (any "0-9a-z" "#$%&*+/=@\\_~-" word)))
101 (seq
102 (one-or-more
103 (any "0-9a-z" "!#$%&*+,./:;=?@\\_~-" word))
104 (any "0-9a-z" "#$%&*+/=@\\_~-" word)))))))
105
106(defun acdw/add-button-url-regexp-protocol (proto)
107 "Add PROTO to `browse-url-button-regexp'
108First, add PROTO to `acdw/button-protocols'.
109Then, build `browse-url-button-regexp' with the new protocol."
110 (add-to-list 'acdw/button-protocols proto)
111 (setq-default browse-url-button-regexp (acdw/build-button-url-regexp)))
112
113;;; Browse-URL tweaks
114
115;; convert reddit.com to teddit
116(defun acdw/eww-browse-reddit-url (url &rest args)
117 "Browse a Reddit.com URL using Teddit."
118 (let* ((teddit "teddit.com")
119 (url (replace-regexp-in-string "reddit\\.com" teddit url)))
120 (eww-browse-url url args)))
121
122;; convert twitter.com to nitter
123(defun acdw/eww-browse-twitter-url (url &rest args)
124 "Browse a Twitter.com URL using Nitter."
125 (let* ((nitter "nitter.snopyta.org")
126 (url (replace-regexp-in-string "twitter\\.com" nitter url)))
127 (eww-browse-url url args)))
128
129(provide 'acdw-browse-url)
diff --git a/lisp/acdw-circe.el b/lisp/acdw-circe.el deleted file mode 100644 index 73b1cdf..0000000 --- a/lisp/acdw-circe.el +++ /dev/null
@@ -1,167 +0,0 @@
1;;; acdw-circe.el --- bespoke circe customizations -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; Besoke Circe customizations.
6
7;;; Code:
8
9(require 'circe)
10(require 'el-patch)
11
12;;; Functions
13
14(defun irc ()
15 "Connect to all IRC networks in `circe-network-options'."
16 (interactive)
17 (dolist (network (mapcar #'car circe-network-options))
18 (unless (member network circe-network-inhibit-autoconnect)
19 (circe-maybe-connect network))))
20
21(defun circe-network-connected-p (network)
22 "Return whether circe is connected to NETWORK."
23 (catch 'return
24 (dolist (buffer (circe-server-buffers))
25 (with-current-buffer buffer
26 (if (string= network circe-server-network)
27 (throw 'return t))))))
28
29(defun circe-maybe-connect (network)
30 "Connect to NETWORK, asking for confirmation to reconnect."
31 (interactive "sNetwork: ")
32 (if (or (not (circe-network-connected-p network))
33 (y-or-n-p (format "Already connected to %s, reconnect? " network)))
34 (circe network)))
35
36(defun circe-current-topic (&optional message)
37 "Return the topic of the current channel.
38When called with MESSAGE set to non-nil (or interactively), also
39message the current topic."
40 (interactive "p")
41 (let ((topic
42 (save-excursion
43 (goto-char (point-max))
44 (or (re-search-backward
45 (rx (group "*** Topic" (+ (not ":")) ": ")
46 (group (+ nonl)))))
47 (buffer-substring-no-properties
48 (match-beginning 2) (match-end 2)))))
49 (when message
50 (message "%s" topic))
51 topic))
52
53;;; Chat commands
54
55(defun circe-command-SHORTEN (url)
56 "Shorten URL using `0x0-shorten-uri'."
57 (interactive "sURL to shorten: ")
58 (require '0x0)
59 ;; TODO: enable /shorten URL comment syntax
60 (let ((short-url (0x0-shorten-uri (0x0--choose-server) url)))
61 (circe-command-SAY short-url)))
62
63(defun circe-command-SLAP (nick)
64 "Slap NICK around a bit with a large trout."
65 (interactive "sWho we slappin' today, boss? ")
66 (circe-command-ME (concat "slaps "
67 (string-trim nick)
68 " around a bit with a large trout")))
69
70;;; Hooks
71
72(defun circe-chat@set-prompt ()
73 "Set the prompt to the buffer name, shortening it."
74 (interactive) ; set interactive to unfuck the prompt when need be
75 (lui-set-prompt
76 (propertize
77 (concat
78 (acdw-irc/margin-format (buffer-name) "" ">")
79 " ")
80 'face 'circe-prompt-face
81 'read-only t
82 'intangible t
83 'cursor-intangible t)))
84
85;;; Advices
86
87(defun circe-part@kill-buffer (&rest _)
88 "Advice to kill the channel buffer after PART."
89 (let ((circe-channel-killed-confirmation nil))
90 (kill-buffer)))
91
92(defun circe-quit@kill-buffer (&rest _)
93 "Advice to kill all buffers of a server after QUIT."
94 ;; `circe-server-killed-confirmation' set to nil, and manually
95 ;; deleting all chat buffers, pending Github issue #402
96 ;; (https://github.com/emacs-circe/circe/issues/402)
97 (let ((circe-server-killed-confirmation nil))
98 (with-circe-server-buffer
99 (dolist (buf (circe-server-chat-buffers))
100 (let ((circe-channel-killed-confirmation nil))
101 (run-with-timer 0.1 nil #'kill-buffer buf)))
102 (run-with-timer 0.1 nil #'kill-buffer))))
103
104(defun circe-gquit@kill-buffer (&rest _)
105 "Advice to kill all Circe related buffers after GQUIT."
106 ;; `circe-server-killed-confirmation' set to nil, and manually
107 ;; deleting all chat buffers, pending Github issue #402
108 ;; (https://github.com/emacs-circe/circe/issues/402)
109 (let ((circe-server-killed-confirmation nil))
110 (dolist (buf (circe-server-buffers))
111 (with-current-buffer buf
112 (dolist (buf (circe-server-chat-buffers))
113 (let ((circe-channel-killed-confirmation nil))
114 (run-with-timer 0.1 nil #'kill-buffer buf)))
115 (run-with-timer 0.1 nil #'kill-buffer)))))
116
117;;; Patches
118
119(el-patch-feature circe)
120(with-eval-after-load 'circe
121 (defvar circe-server-buffer-action 'pop-to-buffer-same-window
122 "What to do with `circe-server' buffers when created.")
123
124 (el-patch-defun circe (network-or-server &rest server-options)
125 "Connect to IRC.
126
127Connect to the given network specified by NETWORK-OR-SERVER.
128
129When this function is called, it collects options from the
130SERVER-OPTIONS argument, the user variable
131`circe-network-options', and the defaults found in
132`circe-network-defaults', in this order.
133
134If NETWORK-OR-SERVER is not found in any of these variables, the
135argument is assumed to be the host name for the server, and all
136relevant settings must be passed via SERVER-OPTIONS.
137
138All SERVER-OPTIONS are treated as variables by getting the string
139\"circe-\" prepended to their name. This variable is then set
140locally in the server buffer.
141
142See `circe-network-options' for a list of common options."
143 (interactive (circe--read-network-and-options))
144 (let* ((options (circe--server-get-network-options network-or-server
145 server-options))
146 (buffer (circe--server-generate-buffer options)))
147 (with-current-buffer buffer
148 (circe-server-mode)
149 (circe--server-set-variables options)
150 (circe-reconnect))
151 (el-patch-swap (pop-to-buffer-same-window buffer)
152 (funcall circe-server-buffer-action buffer)))))
153
154;;; Dumb modes
155
156(define-minor-mode circe-cappy-hour-mode
157 "ENABLE CAPPY HOUR IN CIRCE!"
158 :lighter "CAPPY HOUR"
159 (when (derived-mode-p 'circe-chat-mode)
160 (if circe-cappy-hour-mode
161 (setq-local lui-input-function
162 (lambda (input) (circe--input (upcase input))))
163 ;; XXX: It'd be better if this were more general, but whatever.
164 (setq-local lui-input-function #'circe--input))))
165
166(provide 'acdw-circe)
167;;; acdw-circe.el ends here
diff --git a/lisp/acdw-compat.el b/lisp/acdw-compat.el deleted file mode 100644 index 3221191..0000000 --- a/lisp/acdw-compat.el +++ /dev/null
@@ -1,555 +0,0 @@
1;;; acdw-compat.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Created: 2021-08-11
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;; This file is NOT part of GNU Emacs.
9
10;;; License:
11;; Everyone is permitted to do whatever with this software, without
12;; limitation. This software comes without any warranty whatsoever,
13;; but with two pieces of advice:
14;; - Don't hurt yourself.
15;; - Make good choices.
16
17;;; Commentary:
18
19;; This file contains functions, variables, and other code that might not be in
20;; every version of Emacs I use.
21
22;;; Code:
23
24;; Convenience macro
25(defmacro safely (&rest defines)
26 "Wrap DEFINES in tests to make sure they're not already defined.
27Is it necessary? Who knows!!"
28 (let (output)
29 (dolist (form defines)
30 ;; this is one part where elisp being a lisp-2 bites us...
31 (push (cond ((memq (car form)
32 '(;; makes functions
33 define-global-minor-mode
34 define-globalized-minor-mode
35 define-minor-mode
36 defmacro
37 defsubst
38 defun))
39 `(unless (fboundp ',(cadr form))
40 ,form))
41 ((memq (car form)
42 '(;; makes variables
43 defcustom
44 defvar
45 defvar
46 defvar-local
47 defvar-mode-local
48 defvaralias))
49 `(unless (boundp ',(cadr form))
50 ,form))
51 (t form))
52 output))
53 `(progn ,@(nreverse output))))
54
55
56;;; Functions for changing capitalization that Do What I Mean
57;; Defined in EMACS/lisp/simple.el
58(safely
59 (defun upcase-dwim (arg)
60 "Upcase words in the region, if active; if not, upcase word at point.
61If the region is active, this function calls `upcase-region'.
62Otherwise, it calls `upcase-word', with prefix argument passed to it
63to upcase ARG words."
64 (interactive "*p")
65 (if (use-region-p)
66 (upcase-region (region-beginning) (region-end) (region-noncontiguous-p))
67 (upcase-word arg)))
68
69 (defun downcase-dwim (arg)
70 "Downcase words in the region, if active; if not, downcase word at point.
71If the region is active, this function calls `downcase-region'.
72Otherwise, it calls `downcase-word', with prefix argument passed to it
73to downcase ARG words."
74 (interactive "*p")
75 (if (use-region-p)
76 (downcase-region (region-beginning) (region-end) (region-noncontiguous-p))
77 (downcase-word arg)))
78
79 (defun capitalize-dwim (arg)
80 "Capitalize words in the region, if active; if not, capitalize word at point.
81If the region is active, this function calls `capitalize-region'.
82Otherwise, it calls `capitalize-word', with prefix argument passed to it
83to capitalize ARG words."
84 (interactive "*p")
85 (if (use-region-p)
86 (capitalize-region (region-beginning) (region-end) (region-noncontiguous-p))
87 (capitalize-word arg))))
88
89
90;;; Repeat.el
91;; Defined in EMACS/lisp/repeat.el
92
93(safely
94 (defcustom repeat-too-dangerous '(kill-this-buffer)
95 "Commands too dangerous to repeat with \\[repeat]."
96 :group 'convenience
97 :type '(repeat function))
98
99 (defvar repeat-message-function nil
100 "If non-nil, function used by `repeat' command to say what it's doing.
101Message is something like \"Repeating command glorp\".
102A value of `ignore' will disable such messages. To customize
103display, assign a function that takes one string as an arg and
104displays it however you want.
105If this variable is nil, the normal `message' function will be
106used to display the messages.")
107
108 (defcustom repeat-on-final-keystroke t
109 "Allow `repeat' to re-execute for repeating lastchar of a key sequence.
110If this variable is t, `repeat' determines what key sequence
111it was invoked by, extracts the final character of that sequence, and
112re-executes as many times as that final character is hit; so for example
113if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command
1143 times. If this variable is a sequence of characters, then re-execution
115only occurs if the final character by which `repeat' was invoked is a
116member of that sequence. If this variable is nil, no re-execution occurs."
117 :group 'convenience
118 :type '(choice (const :tag "Repeat for all keys" t)
119 (const :tag "Don't repeat" nil)
120 (sexp :tag "Repeat for specific keys")))
121
122 (defvar repeat-num-input-keys-at-repeat -1
123 "# key sequences read in Emacs session when `repeat' last invoked.")
124
125 (defsubst repeat-is-really-this-command ()
126 "Return t if this command is happening because user invoked `repeat'.
127Usually, when a command is executing, the Emacs builtin variable
128`this-command' identifies the command the user invoked. Some commands modify
129that variable on the theory they're doing more good than harm; `repeat' does
130that, and usually does do more good than harm. However, like all do-gooders,
131sometimes `repeat' gets surprising results from its altruism. The value of
132this function is always whether the value of `this-command' would've been
133'repeat if `repeat' hadn't modified it."
134 (= repeat-num-input-keys-at-repeat num-input-keys))
135
136 (defvar repeat-previous-repeated-command nil
137 "The previous repeated command.")
138
139 (defun repeat (repeat-arg)
140 "Repeat most recently executed command.
141If REPEAT-ARG is non-nil (interactively, with a prefix argument),
142supply a prefix argument to that command. Otherwise, give the
143command the same prefix argument it was given before, if any.
144
145If this command is invoked by a multi-character key sequence, it
146can then be repeated by repeating the final character of that
147sequence. This behavior can be modified by the global variable
148`repeat-on-final-keystroke'.
149
150`repeat' ignores commands bound to input events. Hence the term
151\"most recently executed command\" shall be read as \"most
152recently executed command not bound to an input event\"."
153 ;; The most recently executed command could be anything, so surprises could
154 ;; result if it were re-executed in a context where new dynamically
155 ;; localized variables were shadowing global variables in a `let' clause in
156 ;; here. (Remember that GNU Emacs 19 is dynamically localized.)
157 ;; To avoid that, I tried the `lexical-let' of the Common Lisp extensions,
158 ;; but that entails a very noticeable performance hit, so instead I use the
159 ;; "repeat-" prefix, reserved by this package, for *local* variables that
160 ;; might be visible to re-executed commands, including this function's arg.
161 (interactive "P")
162 (when (eq last-repeatable-command 'repeat)
163 (setq last-repeatable-command repeat-previous-repeated-command))
164 (cond
165 ((null last-repeatable-command)
166 (error "There is nothing to repeat"))
167 ((eq last-repeatable-command 'mode-exit)
168 (error "last-repeatable-command is mode-exit & can't be repeated"))
169 ((memq last-repeatable-command repeat-too-dangerous)
170 (error "Command %S too dangerous to repeat automatically"
171 last-repeatable-command)))
172 (setq this-command last-repeatable-command
173 repeat-previous-repeated-command last-repeatable-command
174 repeat-num-input-keys-at-repeat num-input-keys)
175 (when (null repeat-arg)
176 (setq repeat-arg last-prefix-arg))
177 ;; Now determine whether to loop on repeated taps of the final character
178 ;; of the key sequence that invoked repeat. The Emacs global
179 ;; last-command-event contains the final character now, but may not still
180 ;; contain it after the previous command is repeated, so the character
181 ;; needs to be saved.
182 (let ((repeat-repeat-char
183 (if (eq repeat-on-final-keystroke t)
184 last-command-event
185 ;; Allow only specified final keystrokes.
186 (car (memq last-command-event
187 (listify-key-sequence
188 repeat-on-final-keystroke))))))
189 (if (eq last-repeatable-command (caar command-history))
190 (let ((repeat-command (car command-history)))
191 (repeat-message "Repeating %S" repeat-command)
192 (eval repeat-command))
193 (if (null repeat-arg)
194 (repeat-message "Repeating command %S" last-repeatable-command)
195 (setq current-prefix-arg repeat-arg)
196 (repeat-message
197 "Repeating command %S %S" repeat-arg last-repeatable-command))
198 (when (eq last-repeatable-command 'self-insert-command)
199 ;; We used to use a much more complex code to try and figure out
200 ;; what key was used to run that self-insert-command:
201 ;; (if (<= (- num-input-keys
202 ;; repeat-num-input-keys-at-self-insert)
203 ;; 1)
204 ;; repeat-last-self-insert
205 ;; (let ((range (nth 1 buffer-undo-list)))
206 ;; (condition-case nil
207 ;; (setq repeat-last-self-insert
208 ;; (buffer-substring (car range)
209 ;; (cdr range)))
210 ;; (error (error "%s %s %s" ;Danger, Will Robinson!
211 ;; "repeat can't intuit what you"
212 ;; "inserted before auto-fill"
213 ;; "clobbered it, sorry")))))
214 (setq last-command-event (char-before)))
215 (let ((indirect (indirect-function last-repeatable-command)))
216 (if (or (stringp indirect)
217 (vectorp indirect))
218 ;; Bind last-repeatable-command so that executing the macro does
219 ;; not alter it.
220 (let ((last-repeatable-command last-repeatable-command))
221 (execute-kbd-macro last-repeatable-command))
222 (call-interactively last-repeatable-command))))
223 (when repeat-repeat-char
224 (set-transient-map
225 (let ((map (make-sparse-keymap)))
226 (define-key map (vector repeat-repeat-char)
227 (if (null repeat-message-function) 'repeat
228 ;; If repeat-message-function is let-bound, preserve it for the
229 ;; next "iterations of the loop".
230 (let ((fun repeat-message-function))
231 (lambda ()
232 (interactive)
233 (let ((repeat-message-function fun))
234 (setq this-command 'repeat)
235 ;; Beware: messing with `real-this-command' is *bad*, but we
236 ;; need it so `last-repeatable-command' can be recognized
237 ;; later (bug#12232).
238 (setq real-this-command 'repeat)
239 (call-interactively 'repeat))))))
240 map)))))
241
242 (defun repeat-message (format &rest args)
243 "Like `message' but displays with `repeat-message-function' if non-nil."
244 (let ((message (apply 'format format args)))
245 (if repeat-message-function
246 (funcall repeat-message-function message)
247 (message "%s" message))))
248
249 (defcustom repeat-exit-key nil
250 "Key that stops the modal repeating of keys in sequence.
251For example, you can set it to <return> like `isearch-exit'."
252 :type '(choice (const :tag "No special key to exit repeating sequence" nil)
253 (key-sequence :tag "Key that exits repeating sequence"))
254 :group 'convenience
255 :version "28.1")
256
257 (defcustom repeat-exit-timeout nil
258 "Break the repetition chain of keys after specified timeout.
259When a number, exit the repeat mode after idle time of the specified
260number of seconds."
261 :type '(choice (const :tag "No timeout to exit repeating sequence" nil)
262 (number :tag "Timeout in seconds to exit repeating"))
263 :group 'convenience
264 :version "28.1")
265
266 (defvar repeat-exit-timer nil
267 "Timer activated after the last key typed in the repeating key sequence.")
268
269 (defcustom repeat-keep-prefix t
270 "Keep the prefix arg of the previous command."
271 :type 'boolean
272 :group 'convenience
273 :version "28.1")
274
275 (defcustom repeat-echo-function #'repeat-echo-message
276 "Function to display a hint about available keys.
277Function is called after every repeatable command with one argument:
278a repeating map, or nil after deactivating the repeat mode."
279 :type '(choice (const :tag "Show hints in the echo area"
280 repeat-echo-message)
281 (const :tag "Show indicator in the mode line"
282 repeat-echo-mode-line)
283 (const :tag "No visual feedback" ignore)
284 (function :tag "Function"))
285 :group 'convenience
286 :version "28.1")
287
288 (defvar repeat-in-progress nil
289 "Non-nil when the repeating map is active.")
290
291 (defvar repeat-map nil
292 "The value of the repeating map for the next command.
293A command called from the map can set it again to the same map when
294the map can't be set on the command symbol property `repeat-map'.")
295
296 (define-minor-mode repeat-mode
297 "Toggle Repeat mode.
298When Repeat mode is enabled, and the command symbol has the property named
299`repeat-map', this map is activated temporarily for the next command."
300 :global t :group 'convenience
301 (if (not repeat-mode)
302 (remove-hook 'post-command-hook 'repeat-post-hook)
303 (add-hook 'post-command-hook 'repeat-post-hook)
304 (let* ((keymaps nil)
305 (commands (all-completions
306 "" obarray (lambda (s)
307 (and (commandp s)
308 (get s 'repeat-map)
309 (push (get s 'repeat-map) keymaps))))))
310 (message "Repeat mode is enabled for %d commands and %d keymaps; see `describe-repeat-maps'."
311 (length commands)
312 (length (delete-dups keymaps))))))
313
314 (defun repeat-post-hook ()
315 "Function run after commands to set transient keymap for repeatable keys."
316 (let ((was-in-progress repeat-in-progress))
317 (setq repeat-in-progress nil)
318 (when repeat-mode
319 (let ((rep-map (or repeat-map
320 (and (symbolp real-this-command)
321 (get real-this-command 'repeat-map)))))
322 (when rep-map
323 (when (boundp rep-map)
324 (setq rep-map (symbol-value rep-map)))
325 (let ((map (copy-keymap rep-map)))
326
327 ;; Exit when the last char is not among repeatable keys,
328 ;; so e.g. `C-x u u' repeats undo, whereas `C-/ u' doesn't.
329 (when (and (zerop (minibuffer-depth)) ; avoid remapping in prompts
330 (or (lookup-key map (this-command-keys-vector))
331 prefix-arg))
332
333 ;; Messaging
334 (unless prefix-arg
335 (funcall repeat-echo-function map))
336
337 ;; Adding an exit key
338 (when repeat-exit-key
339 (define-key map repeat-exit-key 'ignore))
340
341 (when (and repeat-keep-prefix (not prefix-arg))
342 (setq prefix-arg current-prefix-arg))
343
344 (setq repeat-in-progress t)
345 (let ((exitfun (set-transient-map map)))
346
347 (when repeat-exit-timer
348 (cancel-timer repeat-exit-timer)
349 (setq repeat-exit-timer nil))
350
351 (when repeat-exit-timeout
352 (setq repeat-exit-timer
353 (run-with-idle-timer
354 repeat-exit-timeout nil
355 (lambda ()
356 (setq repeat-in-progress nil)
357 (funcall exitfun)
358 (funcall repeat-echo-function nil)))))))))))
359
360 (setq repeat-map nil)
361 (when (and was-in-progress (not repeat-in-progress))
362 (when repeat-exit-timer
363 (cancel-timer repeat-exit-timer)
364 (setq repeat-exit-timer nil))
365 (funcall repeat-echo-function nil))))
366
367 (defun repeat-echo-message-string (keymap)
368 "Return a string with a list of repeating keys."
369 (let (keys)
370 (map-keymap (lambda (key _) (push key keys)) keymap)
371 (format-message "Repeat with %s%s"
372 (mapconcat (lambda (key)
373 (key-description (vector key)))
374 keys ", ")
375 (if repeat-exit-key
376 (format ", or exit with %s"
377 (key-description repeat-exit-key))
378 ""))))
379
380 (defun repeat-echo-message (keymap)
381 "Display available repeating keys in the echo area."
382 (if keymap
383 (let ((mess (repeat-echo-message-string keymap)))
384 (if (current-message)
385 (message "%s [%s]" (current-message) mess)
386 (message mess)))
387 (and (current-message)
388 (string-search "Repeat with " (current-message))
389 (message nil))))
390
391 (defvar repeat-echo-mode-line-string
392 (propertize "[Repeating...] " 'face 'mode-line-emphasis)
393 "String displayed in the mode line in repeating mode.")
394
395 (defun repeat-echo-mode-line (keymap)
396 "Display the repeat indicator in the mode line."
397 (if keymap
398 (unless (assq 'repeat-in-progress mode-line-modes)
399 (add-to-list 'mode-line-modes (list 'repeat-in-progress
400 repeat-echo-mode-line-string)))
401 (force-mode-line-update t)))
402
403 (defun describe-repeat-maps ()
404 "Describe mappings of commands repeatable by symbol property `repeat-map'."
405 (interactive)
406 (help-setup-xref (list #'describe-repeat-maps)
407 (called-interactively-p 'interactive))
408 (let ((keymaps nil))
409 (all-completions
410 "" obarray (lambda (s)
411 (and (commandp s)
412 (get s 'repeat-map)
413 (push s (alist-get (get s 'repeat-map) keymaps)))))
414 (with-help-window (help-buffer)
415 (with-current-buffer standard-output
416 (princ "A list of keymaps used by commands with the symbol property `repeat-map'.\n\n")
417
418 (dolist (keymap (sort keymaps (lambda (a b) (string-lessp (car a) (car b)))))
419 (princ (format-message "`%s' keymap is repeatable by these commands:\n"
420 (car keymap)))
421 (dolist (command (sort (cdr keymap) 'string-lessp))
422 (princ (format-message " `%s'\n" command)))
423 (princ "\n"))))))
424
425;;; Bindings!
426 (defvar undo-repeat-map
427 (let ((map (make-sparse-keymap)))
428 (define-key map "u" 'undo)
429 map)
430 "Keymap to repeat undo key sequences `C-x u u'. Used in `repeat-mode'.")
431 (put 'undo 'repeat-map 'undo-repeat-map)
432
433 (defvar next-error-repeat-map
434 (let ((map (make-sparse-keymap)))
435 (define-key map "n" 'next-error)
436 (define-key map "\M-n" 'next-error)
437 (define-key map "p" 'previous-error)
438 (define-key map "\M-p" 'previous-error)
439 map)
440 "Keymap to repeat next-error key sequences. Used in `repeat-mode'.")
441 (put 'next-error 'repeat-map 'next-error-repeat-map)
442 (put 'previous-error 'repeat-map 'next-error-repeat-map)
443
444 (defvar page-navigation-repeat-map
445 (let ((map (make-sparse-keymap)))
446 (define-key map "]" #'forward-page)
447 (define-key map "[" #'backward-page)
448 map)
449 "Keymap to repeat page navigation key sequences. Used in `repeat-mode'.")
450 (put 'forward-page 'repeat-map 'page-navigation-repeat-map)
451 (put 'backward-page 'repeat-map 'page-navigation-repeat-map)
452
453 (defvar tab-bar-switch-repeat-map
454 (let ((map (make-sparse-keymap)))
455 (define-key map "o" 'tab-next)
456 (define-key map "O" 'tab-previous)
457 map)
458 "Keymap to repeat tab switch key sequences `C-x t o o O'.
459Used in `repeat-mode'.")
460 (put 'tab-next 'repeat-map 'tab-bar-switch-repeat-map)
461 (put 'tab-previous 'repeat-map 'tab-bar-switch-repeat-map)
462
463 (defvar tab-bar-move-repeat-map
464 (let ((map (make-sparse-keymap)))
465 (define-key map "m" 'tab-move)
466 (define-key map "M" (lambda ()
467 (interactive)
468 (setq repeat-map 'tab-bar-move-repeat-map)
469 (tab-move -1)))
470 map)
471 "Keymap to repeat tab move key sequences `C-x t m m M'.
472Used in `repeat-mode'.")
473 (put 'tab-move 'repeat-map 'tab-bar-move-repeat-map)
474
475 (defvar other-window-repeat-map
476 (let ((map (make-sparse-keymap)))
477 (define-key map "o" 'other-window)
478 (define-key map "O" (lambda ()
479 (interactive)
480 (setq repeat-map 'other-window-repeat-map)
481 (other-window -1)))
482 map)
483 "Keymap to repeat other-window key sequences. Used in `repeat-mode'.")
484 (put 'other-window 'repeat-map 'other-window-repeat-map)
485
486 (defvar resize-window-repeat-map
487 (let ((map (make-sparse-keymap)))
488 ;; Standard keys:
489 (define-key map "^" 'enlarge-window)
490 (define-key map "}" 'enlarge-window-horizontally)
491 (define-key map "{" 'shrink-window-horizontally)
492 ;; Additional keys:
493 (define-key map "v" 'shrink-window)
494 map)
495 "Keymap to repeat window resizing commands. Used in `repeat-mode'.")
496 (put 'enlarge-window 'repeat-map 'resize-window-repeat-map)
497 (put 'enlarge-window-horizontally 'repeat-map 'resize-window-repeat-map)
498 (put 'shrink-window-horizontally 'repeat-map 'resize-window-repeat-map)
499 (put 'shrink-window 'repeat-map 'resize-window-repeat-map)
500
501 (defvar outline-navigation-repeat-map
502 (let ((map (make-sparse-keymap)))
503 (define-key map (kbd "C-b") #'outline-backward-same-level)
504 (define-key map (kbd "b") #'outline-backward-same-level)
505 (define-key map (kbd "C-f") #'outline-forward-same-level)
506 (define-key map (kbd "f") #'outline-forward-same-level)
507 (define-key map (kbd "C-n") #'outline-next-visible-heading)
508 (define-key map (kbd "n") #'outline-next-visible-heading)
509 (define-key map (kbd "C-p") #'outline-previous-visible-heading)
510 (define-key map (kbd "p") #'outline-previous-visible-heading)
511 (define-key map (kbd "C-u") #'outline-up-heading)
512 (define-key map (kbd "u") #'outline-up-heading)
513 map))
514
515 (defvar outline-editing-repeat-map
516 (let ((map (make-sparse-keymap)))
517 (define-key map (kbd "C-v") #'outline-move-subtree-down)
518 (define-key map (kbd "v") #'outline-move-subtree-down)
519 (define-key map (kbd "C-^") #'outline-move-subtree-up)
520 (define-key map (kbd "^") #'outline-move-subtree-up)
521 (define-key map (kbd "C->") #'outline-demote)
522 (define-key map (kbd ">") #'outline-demote)
523 (define-key map (kbd "C-<") #'outline-promote)
524 (define-key map (kbd "<") #'outline-promote)
525 map))
526
527 (with-eval-after-load 'outline
528 (dolist (command '(outline-backward-same-level
529 outline-forward-same-level
530 outline-next-visible-heading
531 outline-previous-visible-heading
532 outline-up-heading))
533 (put command 'repeat-map 'outline-navigation-repeat-map))
534
535 (dolist (command '(outline-move-subtree-down
536 outline-move-subtree-up
537 outline-demote
538 outline-promote))
539 (put command 'repeat-map 'outline-editing-repeat-map))))
540
541
542;;; goto-address-mode
543(safely
544 (defvar global-address-mode nil)
545
546 (define-globalized-minor-mode global-goto-address-mode
547 goto-address-mode goto-addr-mode--turn-on
548 :version "28.1")
549
550 (defun goto-addr-mode--turn-on ()
551 (when (not goto-address-mode)
552 (goto-address-mode 1))))
553
554(provide 'acdw-compat)
555;;; acdw-compat.el ends here
diff --git a/lisp/acdw-consult.el b/lisp/acdw-consult.el deleted file mode 100644 index 84a7fea..0000000 --- a/lisp/acdw-consult.el +++ /dev/null
@@ -1,93 +0,0 @@
1;;; acdw-consult.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;; Customization for consult.
4
5(require 'consult)
6
7(defun acdw-consult/sensible-grep (&optional arg)
8 "Perform `consult-git-grep' if in a git project, otherwise `consult-ripgrep'
9if ripgrep is installed, otherwise `consult-grep'."
10 (interactive "P")
11 (call-interactively
12 (cond ((executable-find "rg")
13 (if (fboundp 'affe-grep)
14 #'affe-grep
15 #'consult-ripgrep))
16 ((string-equal (vc-backend buffer-file-name) "Git")
17 #'consult-git-grep)
18 (t #'consult-grep))))
19
20(defun acdw-consult/sensible-find (&optional arg)
21 "Peform `consult-locate' if locate is installed, otehrwise `consult-find'."
22 (interactive "P")
23 (call-interactively
24 (cond ((executable-find "locate")
25 #'consult-locate)
26 ((fboundp 'affe-find)
27 (when (executable-find "fd")
28 (setq affe-find-command "fd -HI -t f"))
29 #'affe-find)
30 (t #'consult-find))))
31
32;; Orderless Regexp Compiler! -- from Consult Wiki
33(defun consult--orderless-regexp-compiler (input type)
34 (setq input (orderless-pattern-compiler input))
35 (cons
36 (mapcar (lambda (r) (consult--convert-regexp r type)) input)
37 (lambda (str) (orderless--highlight input str))))
38
39(defun acdw-consult/complete-in-region (&rest args)
40 (apply (if vertico-mode
41 #'consult-completion-in-region
42 #'completion--in-region)
43 args))
44
45(defmacro consult-history-to-modes (map-hook-alist)
46 (let (defuns)
47 (dolist (map-hook map-hook-alist)
48 (let ((map-name (symbol-name (car map-hook)))
49 (key-defs `(progn (define-key
50 ,(car map-hook)
51 (kbd "M-r")
52 (function consult-history))
53 (define-key ,(car map-hook)
54 (kbd "M-s") nil))))
55 (push (if (cdr map-hook)
56 `(add-hook ',(cdr map-hook)
57 (defun
58 ,(intern (concat map-name
59 "@consult-history-bind"))
60 nil
61 ,(concat
62 "Bind `consult-history' to M-r in "
63 map-name ".\n"
64 "Defined by `consult-history-to-modes'.")
65 ,key-defs))
66 key-defs)
67 defuns)))
68 `(progn ,@ (nreverse defuns))))
69
70;;; Circe buffers source
71
72(require 'cl-lib)
73(autoload 'circe-server-buffers "circe")
74(autoload 'circe-server-chat-buffers "circe")
75
76(defun circe-all-buffers ()
77 (cl-loop with servers = (circe-server-buffers)
78 for server in servers
79 collect server
80 nconc
81 (with-current-buffer server
82 (cl-loop for buf in (circe-server-chat-buffers)
83 collect buf))))
84
85(defvar circe-buffer-source
86 `(:name "circe"
87 :hidden t
88 :narrow ?c
89 :category buffer
90 :state ,#'consult--buffer-state
91 :items ,(lambda () (mapcar #'buffer-name (circe-all-buffers)))))
92
93(provide 'acdw-consult)
diff --git a/lisp/acdw-cus-edit.el b/lisp/acdw-cus-edit.el deleted file mode 100644 index 89273f0..0000000 --- a/lisp/acdw-cus-edit.el +++ /dev/null
@@ -1,32 +0,0 @@
1;;; acdw-cus-edit.el -*- lexical-binding: t -*-
2
3(defun acdw-cus/expand-widgets (&rest _)
4 "Expand descriptions in `Custom-mode' buffers."
5 (interactive)
6 ;; "More/Hide" widgets (thanks alphapapa!)
7 (widget-map-buttons (lambda (widget _)
8 (pcase (widget-get widget :off)
9 ("More" (widget-apply-action widget)))
10 nil))
11 ;; "Show Value" widgets (the little triangles)
12 (widget-map-buttons (lambda (widget _)
13 (pcase (widget-get widget :off)
14 ("Show Value"
15 (widget-apply-action widget)))
16 nil)))
17
18(defvar acdw-cus/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'.")
30
31(provide 'acdw-cus-edit)
32;;; acdw-cus-edit.el ends here
diff --git a/lisp/acdw-erc.el b/lisp/acdw-erc.el deleted file mode 100644 index beea24b..0000000 --- a/lisp/acdw-erc.el +++ /dev/null
@@ -1,228 +0,0 @@
1;;; acdw-erc.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Created: 24 May 2021
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;; This file is NOT part of GNU Emacs.
9
10;;; License:
11;; Everyone is permitted to do whatever with this software, without
12;; limitation. This software comes without any warranty whatsoever,
13;; but with two pieces of advice:
14;; - Don't hurt yourself.
15;; - Make good choices.
16
17;;; Commentary:
18;; `acdw-erc' is a dumping ground for functions and stuff for ERC, so they
19;; don't clutter up `init.el'.
20
21;;; Code:
22
23(defgroup acdw-erc nil
24 "Customizations for ERC."
25 :group 'erc)
26
27
28;;; Show a different header-line face when ERC is disconnected.
29;; https://www.emacswiki.org/emacs/ErcModeline#h5o-1
30
31(defface erc/header-line-disconnected
32 '((t (:foreground "black" :background "indianred")))
33 "Face to use when ERC has been disconnected.")
34
35(defun erc/update-header-line-show-disconnected ()
36 "Use a different face in the header-line when disconnected."
37 (erc-with-server-buffer
38 (cond ((erc-server-process-alive) 'erc-header-line)
39 (t 'erc/header-line-disconnected))))
40
41
42;;; Convenience functions
43;; from Prelude:
44;; https://github.com/bbatsov/prelude/blob/master/modules/prelude-erc.el#L114
45
46(defcustom erc/servers nil
47 "The list of IRC servers to connect to with `erc/connect'."
48 :type '(list string))
49
50(defcustom erc/bye-message "See You Space Cowpokes."
51 "Quit message sent when calling `erc/disconnect'."
52 :type 'string)
53
54(defun connect-to-erc (server &optional use-tls port nick)
55 "Connects to IRC SERVER at PORT with NICK.
56If USE-TLS is non-nil, use TLS."
57 (let* ((use-tls (or use-tls t))
58 (erc-fn (if use-tls #'erc-tls #'erc))
59 (port (or port (if use-tls 6697 6667)))
60 (nick (or nick erc-nick)))
61 (funcall erc-fn
62 :server server
63 :port port
64 :nick nick)))
65
66(defun erc/connect ()
67 "Connect to all the servers in `erc/servers'."
68 (interactive)
69 (require 'erc)
70 (mapcar #'connect-to-erc erc/servers))
71
72(defun filter-server-buffers ()
73 (delq nil (mapcar (lambda (x)
74 (and (erc-server-buffer-p x) x))
75 (buffer-list))))
76
77(defun erc/reconnect ()
78 "Reconnect to all IRC servers."
79 (interactive)
80 (dolist (buffer (filter-server-buffers))
81 (with-current-buffer buffer
82 (ignore-errors
83 (erc-cmd-RECONNECT)))))
84
85(defun erc/disconnect ()
86 "Disconnect from all IRC servers."
87 (interactive)
88 (dolist (buffer (filter-server-buffers))
89 (with-message (format "Killing server buffer: %s" (buffer-name buffer))
90 (with-current-buffer buffer
91 (erc-quit-server erc/bye-message))))
92 ;; TODO: kill all channel buffers
93 (force-mode-line-update))
94
95(defun acdw-erc/prompt ()
96 "The prompt to show for ERC."
97 ;; Rewrite s-truncate to avoid dependency.
98 (let ((name (buffer-name))
99 (ellipsis "~")
100 (len erc-fill-static-center))
101 (if (and len (> (length name) (- len 2)))
102 (format "%s%s>"
103 (substring name 0 (- len 2 (length ellipsis)))
104 ellipsis)
105 (propertize
106 (format "%s%s>"
107 name
108 (let ((ss) ; Rewrite s-repeat to avoid dependency.
109 (num (- len 2 (length name))))
110 (while (> num 0)
111 (setq ss (cons " " ss))
112 (setq num (1- num)))
113 (apply #'concat ss)))
114 'read-only t
115 'intangible t
116 'cursor-intangible t))))
117
118(defcustom erc-nick-truncate nil
119 "The width at which to truncate a nick with `erc-format-truncate-@nick'."
120 :group 'erc
121 :type 'integer)
122
123(defalias 'erc-propertize 'propertize) ; I guess...taken out in 28 ?
124
125(defun erc-format-truncate-@nick (&optional user channel-data)
126 "Format the nickname of USER as in `erc-format-@nick', with truncation.
127Truncation is customized using the `erc-nick-truncate' variable.
128See also `erc-format-nick-function'."
129 (when user
130 (let* ((nick (erc-server-user-nickname user))
131 (prefix (erc-get-user-mode-prefix nick))
132 (ellipsis "~")
133 (max-len (- erc-nick-truncate 2 ; one each for < and >
134 (length ellipsis)
135 (length prefix))))
136 (concat (erc-propertize
137 prefix
138 'font-lock-face 'erc-nick-prefix-face)
139 (if (and max-len (> (length nick) max-len))
140 (format "%s%s" (substring nick 0 max-len)
141 ellipsis)
142 nick)))))
143
144
145;;; Uh
146
147(defun acdw-erc/erc-switch-to-buffer (&optional arg)
148 "Prompt for ERC buffer to switch to.
149Reverse prefix argument from `erc-switch-to-buffer'."
150 (interactive "P")
151 (erc-switch-to-buffer (not arg)))
152
153
154;;; ERC-Bar
155;; NEEDS MUCH WORK
156
157(defun erc-bar-move-back (n)
158 "Moves back n message lines. Ignores wrapping, and server messages."
159 (interactive "nHow many lines ? ")
160 (re-search-backward "^.*<.*>" nil t n))
161
162(defun erc-bar-update-overlay ()
163 "Update the overlay for current buffer, based on the content of
164erc-modified-channels-alist. Should be executed on window change."
165 (interactive)
166 (let* ((info (assq (current-buffer) erc-modified-channels-alist))
167 (count (cadr info)))
168 (if (and info (> count erc-bar-threshold))
169 (save-excursion
170 (end-of-buffer)
171 (when (erc-bar-move-back count)
172 (let ((inhibit-field-text-motion t))
173 (move-overlay erc-bar-overlay
174 (line-beginning-position)
175 (line-end-position)
176 (current-buffer)))))
177 (delete-overlay erc-bar-overlay))))
178
179(defvar erc-bar-threshold 0
180 "Display bar when there are more than erc-bar-threshold unread messages.")
181
182(defvar erc-bar-overlay nil
183 "Overlay used to set bar")
184
185(setq erc-bar-overlay (make-overlay 0 0))
186(overlay-put erc-bar-overlay 'face '(:overline "gray"))
187
188(with-eval-after-load 'erc-track
189 ;;put the hook before erc-modified-channels-update
190 (defadvice erc-track-mode (after erc-bar-setup-hook
191 (&rest args) activate)
192 (add-hook 'window-configuration-change-hook 'erc-bar-update-overlay -90))
193
194 (add-hook 'erc-send-completed-hook (lambda (str)
195 (erc-bar-update-overlay))))
196
197
198;;; ZNC babeee
199;; needed variables are stored in private.el
200(defun znc/connect (znc-server znc-port znc-nick irc-servers)
201 (interactive (let ((zserv (or znc/server
202 (read-string "ZNC Server: ")))
203 (zport (or znc/port
204 (read-number "ZNC Port: ")))
205 (znick (or znc/nick
206 (read-string "ZNC Nick: ")))
207 (servers (or znc/irc-servers
208 (list
209 (cons
210 (read-string "IRC Server to connect to: ")
211 (read-passwd "Password: "))))))
212 (list zserv zport znick servers)))
213 (let ((si 0))
214 (dolist (server irc-servers)
215 (run-at-time si nil
216 (lambda ()
217 (erc-tls :server znc-server
218 :port znc-port
219 :nick znc-nick
220 :password (format "%s/%s:%s"
221 znc-nick
222 (car server)
223 (cdr server)))))
224 (setq si (1+ si)))))
225
226
227(provide 'acdw-erc)
228;;; acdw-erc.el ends here
diff --git a/lisp/acdw-eww.el b/lisp/acdw-eww.el deleted file mode 100644 index 8e7f42d..0000000 --- a/lisp/acdw-eww.el +++ /dev/null
@@ -1,38 +0,0 @@
1;;; acdw-eww.el --- EWW customizations -*- lexical-binding: t -*-
2
3(require 'bookmark)
4(require 'eww)
5
6(defun bookmark-eww--make ()
7 "Make eww bookmark record."
8 `((filename . ,(plist-get eww-data :url))
9 (title . ,(plist-get eww-data :title))
10 (time . ,(current-time-string))
11 (handler . ,#'bookmark-eww-handler)
12 (defaults . (,(concat
13 ;; url without the https and path
14 (replace-regexp-in-string
15 "/.*" ""
16 (replace-regexp-in-string
17 "\\`https?://" ""
18 (plist-get eww-data :url)))
19 " - "
20 ;; page title
21 (replace-regexp-in-string
22 "\\` +\\| +\\'" ""
23 (replace-regexp-in-string
24 "[\n\t\r ]+" " "
25 (plist-get eww-data :title))))))))
26
27
28
29(defun bookmark-eww-handler (bm)
30 "Handler for eww bookmarks."
31 (eww-browse-url (alist-get 'filename bm)))
32
33(defun bookmark-eww--setup ()
34 "Setup eww bookmark integration."
35 (setq-local bookmark-make-record-function #'bookmark-eww--make))
36
37(provide 'acdw-eww)
38;;; acdw-eww.el ends here
diff --git a/lisp/acdw-fonts.el b/lisp/acdw-fonts.el deleted file mode 100644 index 0fce172..0000000 --- a/lisp/acdw-fonts.el +++ /dev/null
@@ -1,176 +0,0 @@
1;;; acdw-fonts.el -- font setup -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Created: Sometime during Covid-19, 2020
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;; This file is NOT part of GNU Emacs.
9
10;; Everyone is permitted to do whatever with this software, without
11;; limitation. This software comes without any warranty whatsoever,
12;; but with two pieces of advice:
13;; - Don't hurt yourself.
14;; - Make good choices.
15
16;;; Commentary:
17;; This code is based heavily on (and in fact, until I am able to tweak it,
18;; will be a copy of) Oliver Taylor's code, available here:
19;; https://github.com/olivertaylor/olivertaylor.github.io
20;; /blob/master/notes/20210324_emacs-optical-font-adjustment.org
21
22;;; Code:
23
24
25;; Variables
26
27(defvar acdw-fonts/monospace nil
28 "Monospace font to be used for `default' and `fixed-pitch' faces.")
29
30(defvar acdw-fonts/variable nil
31 "Variable font to be used for the `variable-pitch' face.")
32
33(defvar acdw-fonts/monospace-size 11
34 "Font size, an integer, to be used for the `default' and `fixed-pitch' faces.
35
36This value is multiplied by 10, so 12 becomes 120, in order to
37comply with Emacs's `set-face-attribute' requirements.")
38
39(defvar acdw-fonts/variable-size 12
40 "Font size, an integer, to be used for the `variable-pitch' face.
41
42This value will be used to determine a relative (float) size
43based on the default size. So if your default size is 12 and
44your variable size is 14, the computed relative size will be
451.16.")
46
47
48;; Functions
49
50(defun acdw-fonts/set ()
51 "Set fonts according to `acdw-fonts' variables."
52 (interactive)
53 (set-face-attribute 'default nil
54 :family acdw-fonts/monospace
55 :height (* acdw-fonts/monospace-size 10))
56 (set-face-attribute 'fixed-pitch nil
57 :family acdw-fonts/monospace
58 :height 1.0)
59 (set-face-attribute 'variable-pitch nil
60 :family acdw-fonts/variable
61 :height 1.0))
62
63
64;;; Larger Variable Pitch Mode
65
66
67;; A minor mode to scale the variable-pitch face up to the height defined in
68;; `acdw-fonts/variable-size' and the fixed-pitch face down to the height
69;; defined in `acdw-fonts/monospace-size', buffer locally. This mode should
70;; be enabled wherever you want to adjust face sizes, perhaps with a hook.
71
72(make-variable-buffer-local
73 (defvar larger-variable-pitch-mode-status nil
74 "Status of the larger-variable-pitch-mode"))
75
76(make-variable-buffer-local
77 (defvar variable-pitch-remapping nil
78 "variable-pitch remapping cookie for larger-variable-pitch-mode."))
79
80(make-variable-buffer-local
81 (defvar fixed-pitch-remapping nil
82 "fixed-pitch remapping cookie for larger-variable-pitch-mode"))
83
84(defun larger-variable-pitch-mode-toggle ()
85 (setq larger-variable-pitch-mode-status
86 (not larger-variable-pitch-mode-status))
87 (if larger-variable-pitch-mode-status
88 (progn
89 (setq variable-pitch-remapping
90 (face-remap-add-relative
91 'variable-pitch :height (/ (float acdw-fonts/variable-size)
92 (float acdw-fonts/monospace-size))))
93 (setq fixed-pitch-remapping
94 (face-remap-add-relative
95 'fixed-pitch :height (/ (float acdw-fonts/monospace-size)
96 (float acdw-fonts/variable-size))))
97 (force-window-update (current-buffer)))
98 (progn
99 (face-remap-remove-relative variable-pitch-remapping)
100 (face-remap-remove-relative fixed-pitch-remapping))))
101
102(define-minor-mode larger-variable-pitch-mode
103 "Minor mode to scale the variable- and fixed-pitch faces up and down."
104 :init-value nil
105 :lighter " V+"
106 (larger-variable-pitch-mode-toggle))
107
108(defun acdw-fonts/buffer-face-hook ()
109 "Activate and deactivate larger-variable-pitch-mode minor mode."
110 (if buffer-face-mode
111 (larger-variable-pitch-mode 1)
112 (larger-variable-pitch-mode -1)))
113
114(add-hook 'buffer-face-mode-hook #'acdw-fonts/buffer-face-hook)
115
116
117;;; Emoji fonts
118;; from https://old.reddit.com/r/emacs/comments/mvlid5/
119
120(defun acdw-fonts/setup-emoji-fonts (&rest emoji-fonts)
121 "For all EMOJI-FONTS that exist, add them to the symbol fontset.
122
123This is for emoji fonts."
124 (let ((ffl (font-family-list)))
125 (dolist (font emoji-fonts)
126 (when (member font ffl)
127 (set-fontset-font t 'symbol
128 (font-spec :family font) nil 'append)))))
129
130
131;;; Variable-pitch
132;; from https://github.com/turbana/emacs-config#variable-pitch
133
134(defcustom acdw-fonts/fixed-pitch-faces '(linum
135 org-block
136 org-block-begin-line
137 org-block-end-line
138 org-checkbox
139 org-code
140 org-date
141 org-document-info-keyword
142 org-hide
143 org-indent
144 org-link
145 org-meta-line
146 org-special-keyword
147 org-table
148 whitespace-space)
149 "Faces to keep fixed-pitch in `acdw/variable-pitch-mode'."
150 :type 'sexp
151 :group 'faces)
152
153(defun acdw-fonts//variable-pitch-add-inherit (attrs parent)
154 "Add `:inherit PARENT' to ATTRS unless already present.
155Handles cases where `:inherit' is already specified."
156 (let ((current-parent (plist-get attrs :inherit)))
157 (unless (or (eq parent current-parent)
158 (and (listp current-parent)
159 (member parent current-parent)))
160 (plist-put attrs :inherit (if current-parent
161 (list current-parent parent)
162 parent)))))
163
164(defun acdw-fonts/adapt-variable-pitch ()
165 "Adapt `variable-pitch-mode' to keep some fonts fixed-pitch."
166 (when variable-pitch-mode
167 (mapc (lambda (face)
168 (when (facep face)
169 (apply #'set-face-attribute
170 face nil (acdw-fonts//variable-pitch-add-inherit
171 (face-attr-construct face)
172 'fixed-pitch))))
173 acdw-fonts/fixed-pitch-faces)))
174
175(provide 'acdw-fonts)
176;;; acdw-fonts.el ends here
diff --git a/lisp/acdw-frame.el b/lisp/acdw-frame.el deleted file mode 100644 index 753fd14..0000000 --- a/lisp/acdw-frame.el +++ /dev/null
@@ -1,36 +0,0 @@
1;;; acdw-frame.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3;;; Fonts
4
5(defun acdw/set-first-face-attribute (face font-list)
6 "Set FACE to the first font found in FONT-LIST.
7FONT-LIST is a list of `font-spec' plists to be passed to
8`set-face-attribute'."
9 (cond
10 ((or (null window-system)
11 (null font-list))
12 nil)
13 ((x-list-fonts (or (plist-get (car font-list) :font)
14 (plist-get (car font-list) :family)))
15 (apply #'set-face-attribute face nil (car font-list)))
16 (t (acdw/set-first-face-attribute face (cdr font-list)))))
17
18(defun acdw/set-emoji-fonts (&rest emoji-fonts)
19 "Add all installed EMOJI-FONTS to the symbol fontset."
20 (let ((ffl (font-family-list)))
21 (dolist (font emoji-fonts)
22 (when (member font ffl)
23 (set-fontset-font t 'symbol
24 (font-spec :family font) nil 'append)))))
25
26;;; Fringes
27
28(defun acdw/set-fringes (bitmap-list)
29 "Apply multiple fringes at once.
30BITMAP-LIST is a list of arglists passed directly to
31`define-fringe-bitmap', which see."
32 (dolist (bitmap bitmap-list)
33 (apply #'define-fringe-bitmap bitmap))
34 (redraw-frame))
35
36(provide 'acdw-frame)
diff --git a/lisp/acdw-irc.el b/lisp/acdw-irc.el deleted file mode 100644 index 4427a4d..0000000 --- a/lisp/acdw-irc.el +++ /dev/null
@@ -1,72 +0,0 @@
1;;; acdw-irc.el -*- lexical-binding: t; coding: utf-8-unix -*-
2
3(require 's nil :noerror)
4
5(defgroup acdw-irc nil
6 "Customizations for IRC."
7 :group 'applications)
8
9(defcustom acdw-irc/left-margin 16
10 "The size of the margin for nicks, etc. on the left."
11 :type 'integer)
12
13(defcustom acdw-irc/pre-nick ""
14 "What to show before a nick."
15 :type 'string)
16
17(defcustom acdw-irc/post-nick " | "
18 "What to show after a nick."
19 :type 'string)
20
21(defcustom acdw-irc/pre-my-nick "-"
22 "What to show before the current user's nick."
23 :type 'string)
24
25(defcustom acdw-irc/post-my-nick "-> "
26 "What to show after the current user's nick."
27 :type 'string)
28
29(defcustom acdw-irc/ellipsis "~"
30 "The ellipsis for when a string is too long."
31 :type 'string)
32
33
34;;; Convenience functions (I don't want to /depend/ on s.el)
35
36(if (fboundp 's-repeat)
37 (defalias 'repeat-string 's-repeat)
38 (defun repeat-string (num s)
39 "Make a string of STR repeated NUM times.
40Stolen from s.el."
41 (declare (pure t) (side-effect-free t))
42 (let (ss)
43 (while (> num 0)
44 (setq ss (cons s ss))
45 (setq num (1- num)))
46 (apply 'concat ss))))
47
48
49;;; IRC stuff
50
51(defun acdw-irc/margin-format (str &optional before after alignment)
52 "Print STR to fit in `acdw-irc/left-margin'.
53Optional arguments BEFORE and AFTER specify strings to go
54... before and after the string. ALIGNMENT aligns left on nil
55and right on t."
56 (let* ((before (or before ""))
57 (after (or after ""))
58 (str-length (length str))
59 (before-length (length before))
60 (after-length (length after))
61 (max-length (- acdw-irc/left-margin 1 (+ before-length after-length)))
62 (left-over (max 0 (- max-length str-length))))
63 (format "%s%s%s%s%s"
64 before
65 (if alignment (repeat-string left-over " ") "")
66 (truncate-string max-length str acdw-irc/ellipsis)
67 (if alignment "" (repeat-string left-over " "))
68 after)))
69
70
71(provide 'acdw-irc)
72;;; acdw-irc.el ends here
diff --git a/lisp/acdw-lisp.el b/lisp/acdw-lisp.el deleted file mode 100644 index 92fe62e..0000000 --- a/lisp/acdw-lisp.el +++ /dev/null
@@ -1,16 +0,0 @@
1;;; acdw-lisp.el -*- lexical-binding: t; coding: utf-8-unix -*-
2;;
3;; Extras for Lisp modes.
4
5(defun acdw/eval-region-or-buffer ()
6 (interactive)
7 (if (region-active-p)
8 (let ((begin (region-beginning))
9 (end (region-end)))
10 (with-message (format "Evaluating %S -> %S" begin end)
11 (eval-region begin end)))
12 (with-message "Evaluating buffer"
13 (eval-buffer))))
14
15(provide 'acdw-lisp)
16;;; acdw-lisp.el ends here
diff --git a/lisp/acdw-modeline.el b/lisp/acdw-modeline.el deleted file mode 100644 index 0dc23ff..0000000 --- a/lisp/acdw-modeline.el +++ /dev/null
@@ -1,232 +0,0 @@
1;;; acdw-modeline.el -*- lexical-binding: t; coding: utf-8-unix -*-
2;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
3;; Created: Sometime during Covid-19, 2020
4;; Keywords: configuration
5;; URL: https://tildegit.org/acdw/emacs
6
7;; This file is NOT part of GNU Emacs.
8
9;;; License:
10;; Everyone is permitted to do whatever with this software, without
11;; limitation. This software comes without any warranty whatsoever,
12;; but with two pieces of advice:
13;; - Don't hurt yourself.
14;; - Make good choices.
15
16;;; Commentary:
17;; `acdw-modeline' is a dumping ground for extra modeline functions, so they
18;; don't clutter up `init.el'.
19
20;;; Code:
21
22(require 'simple-modeline)
23(require 'minions)
24
25(defcustom acdw-modeline/word-count-modes
26 (mapcar (lambda (m) (cons m nil)) simple-modeline-word-count-modes)
27 "Alist of modes to functions that `acdw-modeline/word-count' should dispatch.
28If the cdr of the cons cell is nil, use the default function (`count-words').
29Otherwise, cdr should be a function that takes two points (see `count-words')."
30 :type '(alist :key-type (symbol :tag "Major-Mode")
31 :value-type function)
32 :group 'simple-modeline)
33
34(defun acdw-modeline/buffer-name () ; gonsie
35 "Display the buffer name in a face reflecting its modified status."
36 (propertize
37 (concat
38 (format " %-20s"
39 (truncate-string 20
40 (string-trim (buffer-name) "*" "*")
41 "~")))
42 'face 'bold
43 ;; (if (buffer-modified-p)
44 ;; 'font-lock-warning-face
45 ;; 'font-lock-type-face)
46 'help-echo (or (buffer-file-name)
47 (buffer-name))))
48
49(defun acdw-modeline/erc ()
50 "ERC indicator for the modeline."
51 (when (and (bound-and-true-p erc-track-mode)
52 (boundp 'erc-modified-channels-object))
53 (format-mode-line erc-modified-channels-object)))
54
55(defun acdw-modeline/god-mode-indicator ()
56 "Display an indicator if `god-local-mode' is active."
57 (when (bound-and-true-p god-local-mode)
58 " Ω"))
59
60(defun acdw-modeline/major-mode ()
61 "Displays the current major mode in the mode-line."
62 (propertize
63 (concat " "
64 (or (and (boundp 'delighted-modes)
65 (cadr (assq major-mode delighted-modes)))
66 (format-mode-line mode-name)))
67 'face 'bold
68 'keymap mode-line-major-mode-keymap
69 'mouse-face 'mode-line-highlight))
70
71(defun acdw-modeline/minions () ; by me
72 "Display a button for `minions-minor-modes-menu'."
73 (concat
74 " "
75 (propertize
76 "&"
77 'help-echo (format
78 "Minor modes menu\nmouse-1: show menu.")
79 'local-map (purecopy (simple-modeline-make-mouse-map
80 'mouse-1
81 (lambda (event)
82 (interactive "e")
83 (with-selected-window (posn-window
84 (event-start event))
85 (minions-minor-modes-menu)))))
86 'mouse-face 'mode-line-highlight)))
87
88(defun acdw-modeline/nyan-cat ()
89 "Display the nyan cat from function `nyan-mode' in the mode-line."
90 (when (bound-and-true-p nyan-mode)
91 (if (eq (bound-and-true-p actually-selected-window)
92 (get-buffer-window))
93 '(" " (:eval (list (nyan-create))))
94 `(:propertize " "
95 display
96 (space ;; pixel perfect babeeeee
97 . (:width (,(+ 9 (* 8 (or
98 (bound-and-true-p nyan-bar-length)
99 20))))))))))
100
101(defun acdw-modeline/modified () ; modified from `simple-modeline'
102 "Displays a color-coded buffer modification/read-only
103indicator in the mode-line."
104 (let* ((read-only (and buffer-read-only (buffer-file-name)))
105 (modified (buffer-modified-p)))
106 (propertize
107 (concat " "
108 (cond
109 ((string-match-p "\\*.*\\*" (buffer-name))
110 "*")
111 ((derived-mode-p 'special-mode
112 'lui-mode)
113 "~")
114 (read-only "=")
115 (modified "+")
116 (t "-")))
117 'help-echo (format
118 (concat "Buffer is %s and %smodified\n"
119 "mouse-1: Toggle read-only status.")
120 (if read-only "read-only" "writable")
121 (if modified "" "not "))
122 'local-map (purecopy (simple-modeline-make-mouse-map
123 'mouse-1
124 (lambda (event)
125 (interactive "e")
126 (with-selected-window
127 (posn-window (event-start event))
128 (read-only-mode 'toggle)))))
129 'mouse-face 'mode-line-highlight)))
130
131(defun acdw-modeline/narrowed ()
132 "Display an indication if the buffer is narrowed."
133 (when (buffer-narrowed-p)
134 (concat
135 ""
136 (propertize
137 "N"
138 'help-echo (format "%s\n%s"
139 "Buffer is narrowed"
140 "mouse-2: widen buffer.")
141 'local-map (purecopy (simple-modeline-make-mouse-map
142 'mouse-2 #'mode-line-widen))
143 'mouse-face 'mode-line-highlight))))
144
145(define-minor-mode file-percentage-mode
146 "Toggle the percentage display in the mode line (File Percentage Mode)."
147 :init-value t :global t :group 'mode-line)
148
149(defun acdw-modeline/position ()
150 "Displays the current cursor position in the mode-line.
151
152Unlike `simple-modeline-segment-position', this changes the first
153character from '+' to '-' if the region goes 'backward' -- that
154is, if point < mark."
155 `((line-number-mode
156 ((column-number-mode
157 (column-number-indicator-zero-based
158 (9 " %l/%c")
159 (9 " %l/%C"))
160 (6 " L%l")))
161 ((column-number-mode
162 (column-number-indicator-zero-based
163 (5 " C%c")
164 (5 " C%C")))
165 " "))
166 (file-percentage-mode
167 ((-3 "%p") "%% "))
168 ,(if (region-active-p)
169 (propertize (format "%s%-5d"
170 (if (and (mark)
171 (< (point) (mark)))
172 "-"
173 "+")
174 (apply #'+ (mapcar
175 (lambda (pos)
176 (- (cdr pos)
177 (car pos)))
178 (region-bounds))))
179 'font-lock-face 'font-lock-variable-name-face))))
180
181(defun acdw-modeline/reading-mode ()
182 "Display an indicator if currently in reading mode, mine or EWW's."
183 (concat (if reading-mode "R" "") (if eww-readable-p "w" "")))
184
185(defun acdw-modeline/text-scale ()
186 "Display the text scaling from the modeline, if scaled."
187 ;; adapted from https://github.com/seagle0128/doom-modeline
188 (when (and (boundp 'text-scale-mode-amount)
189 (/= text-scale-mode-amount 0))
190 (format
191 (if (> text-scale-mode-amount 0)
192 " (%+d)"
193 " (%-d)")
194 text-scale-mode-amount)))
195
196(defun acdw-modeline/track ()
197 "Display `tracking-mode' information."
198 '(tracking-mode
199 tracking-mode-line-buffers))
200
201(defun acdw-modeline/vc-branch ()
202 "Display the version control branch of the current buffer in the modeline."
203 ;; from https://www.gonsie.com/blorg/modeline.html, from Doom
204 (if-let ((backend (vc-backend buffer-file-name)))
205 (concat " " (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)))))
206
207(defun acdw-modeline/wc ()
208 "Display current `wc-buffer-stats'."
209 (when (bound-and-true-p wc-mode)
210 (format "%8s" (or (cadr wc-buffer-stats) "[w]"))))
211
212(defun acdw-modeline/winum ()
213 "Show the `winum' number of the current window in the modeline.
214Only shows if there is more than one window."
215 (when (and (bound-and-true-p winum-mode)
216 (> winum--window-count 1))
217 (format winum-format (winum-get-number-string))))
218
219(defun acdw-modeline/word-count ()
220 "Display a buffer word count, depending on the major mode.
221Uses `acdw-modeline/word-count-modes' to determine which function to use."
222 (when-let ((modefun
223 (assoc major-mode acdw-modeline/word-count-modes #'equal)))
224 (let* ((fn (or (cdr modefun)
225 #'count-words))
226 (r (region-active-p))
227 (min (if r (region-beginning) (point-min)))
228 (max (if r (region-end) (point-max))))
229 (format " %s%dW" (if r "+" "") (funcall fn min max)))))
230
231(provide 'acdw-modeline)
232;;; acdw-modeline.el ends here
diff --git a/lisp/acdw-re.el b/lisp/acdw-re.el deleted file mode 100644 index eff61e1..0000000 --- a/lisp/acdw-re.el +++ /dev/null
@@ -1,151 +0,0 @@
1;;; acdw-re.el -*- lexical-binding: t; coding: utf-8-unix -*-
2;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
3;; Created: 2021-04-29
4;; Keywords: configuration
5;; URL: https://tildegit.org/acdw/emacs
6
7;; This file is NOT part of GNU Emacs.
8
9;;; License:
10;; Everyone is permitted to do whatever with this software, without
11;; limitation. This software comes without any warranty whatsoever,
12;; but with two pieces of advice:
13;; - Don't hurt yourself.
14;; - Make good choices.
15
16;;; Commentary:
17;; Pulled mostly from karthinks:
18;; https://karthinks.com/software/bridging-islands-in-emacs-1/
19
20;; UPDATED CODE:
21;; https://github.com/karthink/.emacs.d/blob/master/init.el#L981
22;; https://github.com/karthink/.emacs.d/blob/master/lisp/reb-fix.el
23
24;;; Code:
25
26(require 're-builder)
27
28(defvar my/re-builder-positions nil
29 "Store point and region bounds before calling `re-builder'.")
30
31(defun my/re-builder-save-state (&rest _)
32 "Save the point and region before calling `re-builder'."
33 (setq my/re-builder-positions
34 (cons (point)
35 (when (region-active-p)
36 (list (region-beginning)
37 (region-end))))))
38
39(defun reb-replace-regexp (&optional delimited)
40 "Run `query-replace-regexp' with the contents of `re-builder'.
41With non-nil optional argument DELIMITED, only replace matches
42surrounded by word boundaries."
43 (interactive "P")
44 (reb-update-regexp)
45 (let* ((re (reb-target-binding reb-regexp))
46 (replacement (query-replace-read-to
47 re
48 (concat "Query replace"
49 (if current-prefix-arg
50 (if (eq current-prefix-arg '-)
51 " backward"
52 " word")
53 "")
54 " regexp"
55 (if (with-selected-window reb-target-window
56 (region-active-p))
57 " in region"
58 ""))
59 t))
60 (pnt (car my/re-builder-positions))
61 (beg (cadr my/re-builder-positions))
62 (end (caddr my/re-builder-positions)))
63 (with-selected-window reb-target-window
64 (goto-char (or pnt 0))
65 (setq my/re-builder-positions nil)
66 (reb-quit)
67 (query-replace-regexp re replacement delimited beg end))))
68
69;; Restrict re-builder matches to region
70
71(defun reb-update-overlays (&optional subexp)
72 "Switch to `reb-target-buffer' and mark all matches of `reb-regexp'.
73If SUBEXP is non-nil mark only the corresponding sub-expressions."
74 (let* ((re (reb-target-binding reb-regexp))
75 (subexps (reb-count-subexps re))
76 (matches 0)
77 (submatches 0)
78 firstmatch
79 here
80 start end
81 firstmatch-after-here)
82 (with-current-buffer reb-target-buffer
83 (setq here
84 (if reb-target-window
85 (with-selected-window reb-target-window (window-point))
86 (point))
87 start
88 (if (region-active-p)
89 (nth 1 my/re-builder-positions)
90 (nth 0 my/re-builder-positions))
91 end
92 (if (region-active-p)
93 (nth 2 my/re-builder-positions)
94 (point-max)))
95 (reb-delete-overlays)
96 (goto-char (or start 0))
97 (while (and (not (eobp))
98 (re-search-forward re end t)
99 (or (not reb-auto-match-limit)
100 (< matches reb-auto-match-limit)))
101 (when (and (= 0 (length (match-string 0)))
102 (not (eobp)))
103 (forward-char 1))
104 (let ((i 0)
105 suffix max-suffix)
106 (setq matches (1+ matches))
107 (while (<= i subexps)
108 (when (and (or (not subexp) (= subexp i))
109 (match-beginning i))
110 (let ((overlay (make-overlay (match-beginning i)
111 (match-end i)))
112 ;; When we have exceeded the number of provided faces,
113 ;; cycle thru them where `max-suffix' denotes the maximum
114 ;; suffix for `reb-match-*' that has been defined and
115 ;; `suffix' the suffix calculated for the current match.
116 (face
117 (cond
118 (max-suffix
119 (if (= suffix max-suffix)
120 (setq suffix 1)
121 (setq suffix (1+ suffix)))
122 (intern-soft (format "reb-match-%d" suffix)))
123 ((intern-soft (format "reb-match-%d" i)))
124 ((setq max-suffix (1- i))
125 (setq suffix 1)
126 ;; `reb-match-1' must exist.
127 'reb-match-1))))
128 (unless firstmatch (setq firstmatch (match-data)))
129 (unless firstmatch-after-here
130 (when (> (point) here)
131 (setq firstmatch-after-here (match-data))))
132 (setq reb-overlays (cons overlay reb-overlays)
133 submatches (1+ submatches))
134 (overlay-put overlay 'face face)
135 (overlay-put overlay 'priority i)))
136 (setq i (1+ i))))))
137 (let ((count (if subexp submatches matches)))
138 (message "%s %smatch%s%s"
139 (if (= 0 count) "No" (int-to-string count))
140 (if subexp "subexpression " "")
141 (if (= 1 count) "" "es")
142 (if (and reb-auto-match-limit
143 (= reb-auto-match-limit count))
144 " (limit reached)" "")))
145 (when firstmatch
146 (store-match-data (or firstmatch-after-here firstmatch))
147 (reb-show-subexp (or subexp 0)))))
148
149(provide 'acdw-re)
150
151;;; acdw-re.el ends here
diff --git a/lisp/acdw-reading.el b/lisp/acdw-reading.el deleted file mode 100644 index ff4f0c2..0000000 --- a/lisp/acdw-reading.el +++ /dev/null
@@ -1,100 +0,0 @@
1;;; acdw-reading.el --- minor mode for reading -*- lexical-binding: t -*-
2
3;; Copyright 2021 Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; This file is NOT part of GNU Emacs.
5
6;;; License:
7
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;; here is my attempt at a reading mode.
17
18;;; Code:
19
20;;; Customizations
21
22(defgroup reading nil
23 "Group for Reading mode customizations."
24 :prefix "reading-"
25 :group 'convenience) ; i need to figure this out
26
27(defcustom reading-vars '((indicate-empty-lines . nil)
28 (indicate-buffer-boundaries . nil))
29 "Alist of variables to set in function `reading-mode'.
30The car of each cell is the variable name, and the cdr is the
31value to set it to."
32 :type '(alist :key-type variable
33 :value-type sexp))
34
35(defcustom reading-modes '((display-fill-column-indicator-mode . -1)
36 (blink-cursor-mode . -1))
37 "Alist of modes to set in function `reading-mode'.
38The car of each cell is the function name, and the cdr is the
39value to call it with."
40 :type '(alist :key-type function
41 :value-type sexp))
42
43;;; Internal
44
45(defvar reading--remembered-template "reading--remembered-%s-value"
46 "The template passed to `format' for remembered modes and variables.")
47
48(defun reading--remember (things func)
49 "Apply FUNC to THINGS, remembering their previous value for later."
50 (declare (indent 1))
51 (unless (listp things)
52 (setq things (list things)))
53 (dolist (thing things)
54 (set (make-local-variable
55 (intern (format reading--remembered-template thing)))
56 (and (boundp thing)
57 (symbol-value thing)))
58 (funcall func thing)))
59
60(defun reading--recall (things func)
61 "Recall previously remembered THINGS by applying FUNC to them.
62FUNC should be a function with the signature (THING REMEMBERED-SETTING)."
63 (declare (indent 1))
64 (unless (listp things)
65 (setq things (list things)))
66 (dolist (thing things)
67 (with-demoted-errors "reading--recall: %S"
68 (let ((value (symbol-value
69 (intern
70 (format reading--remembered-template thing)))))
71 (funcall func thing value)))))
72
73;;; Mode
74
75;;;###autoload
76(define-minor-mode reading-mode
77 "A mode for reading."
78 :init-value nil
79 :lighter " Read"
80 :keymap (make-sparse-keymap)
81 (if reading-mode
82 ;; turn on
83 (progn
84 (reading--remember (mapcar #'car reading-vars)
85 (lambda (var)
86 (set (make-local-variable var)
87 (cdr (assoc var reading-vars)))))
88 (reading--remember (mapcar #'car reading-modes)
89 (lambda (mode)
90 (funcall mode (cdr (assoc mode reading-modes))))))
91 ;; turn off
92 (reading--recall (mapcar #'car reading-vars)
93 (lambda (var orig-val)
94 (set (make-local-variable var) orig-val)))
95 (reading--recall (mapcar #'car reading-modes)
96 (lambda (mode orig-setting)
97 (funcall mode (if orig-setting +1 -1))))))
98
99(provide 'acdw-reading)
100;;; acdw-reading.el ends here
diff --git a/lisp/acdw-setup.el b/lisp/acdw-setup.el deleted file mode 100644 index 33ab835..0000000 --- a/lisp/acdw-setup.el +++ /dev/null
@@ -1,103 +0,0 @@
1;;; acdw-setup.el -- my `setup' commands -*- lexical-binding: t -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
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.el makes defining local macros for `setup' forms quite simple, at
17;; least to my mind. Here are some of the ones I've defined.
18
19;;; Code:
20
21(require 'setup)
22
23(setup-define :autoload
24 (lambda (func)
25 (if (listp func)
26 (let ((plist (cdr func)))
27 `(autoload ',(car func)
28 ,(symbol-name (setup-get 'feature))
29 ,(plist-get plist :docstring)
30 ,(plist-get plist :interactive)
31 ,(plist-get plist :type)))
32 `(autoload ',func ,(symbol-name (setup-get 'feature)))))
33 :documentation "Autoload FUNC from FEATURE.
34`:autoload' can be passed a list with keywords:
35:docstring - The DOCSTRING to give the autoloaded function.
36:interactive - Whether the function is INTERACTIVE or not.
37:type - Either `nil', `keymap', or `macro': see `autoload' for details."
38 :repeatable t)
39
40(setup-define :require-after
41 (lambda (seconds)
42 `(run-with-idle-timer ,seconds nil
43 #'require ',(setup-get 'feature) nil t))
44 :documentation "Requre FEATURE, after SECONDS idle time.")
45
46(setup-define :face
47 (lambda (face spec)
48 `(custom-set-faces '(,face ,spec 'now "Customized by `setup'.")))
49 :documentation "Customize FACE with SPEC using `custom-set-faces'."
50 :repeatable t)
51
52(setup-define :file-match
53 ;; Hotfix; patch here: https://github.com/phikal/setup.el/pull/1
54 (lambda (pat)
55 `(add-to-list 'auto-mode-alist (cons ,pat ',(setup-get 'mode))))
56 :documentation "Associate the current mode with files that match PAT."
57 :debug '(form)
58 :repeatable t)
59
60(setup-define :straight
61 (lambda (recipe)
62 `(unless (straight-use-package ',recipe)
63 ,(setup-quit)))
64 :documentation
65 "Install RECIPE with `straight-use-package'.
66This macro can be used as HEAD, and will replace itself with the
67first RECIPE's package."
68 :repeatable t
69 :shorthand (lambda (sexp)
70 (let ((recipe (cadr sexp)))
71 (if (consp recipe)
72 (car recipe)
73 recipe))))
74
75(setup-define :straight-when
76 (lambda (recipe condition)
77 `(if ,condition
78 (straight-use-package ',recipe)
79 ,(setup-quit)))
80 :documentation
81 "Install RECIPE with `straight-use-package' when CONDITION is met.
82If CONDITION is false, stop evaluating the body. This macro can
83be used as HEAD, and will replace itself with the RECIPE's
84package. This macro is not repeatable."
85 :repeatable nil
86 :indent 1
87 :shorthand (lambda (sexp)
88 (let ((recipe (cadr sexp)))
89 (if (consp recipe) (car recipe) recipe))))
90
91;; https://www.emacswiki.org/emacs/SetupEl
92(setup-define :load-after
93 (lambda (&rest features)
94 (let ((body `(require ',(setup-get 'feature))))
95 (dolist (feature (if (listp features)
96 (nreverse features)
97 (list features)))
98 (setq body `(with-eval-after-load ',feature ,body)))
99 body))
100 :documentation "Load the current feature after FEATURES.")
101
102(provide 'acdw-setup)
103;;; acdw-setup.el ends here
diff --git a/lisp/acdw-ytel.el b/lisp/acdw-ytel.el deleted file mode 100644 index 276323d..0000000 --- a/lisp/acdw-ytel.el +++ /dev/null
@@ -1,75 +0,0 @@
1;;; acdw-ytel.el --- bespoke functions for ytel -*- lexical-binding: t -*-
2
3;;; Commentary:
4
5;; Extra code for the ytel package:
6;; https://github.com/gRastello/ytel
7
8;;; Code:
9
10(require 'ytel nil t)
11
12(defun acdw/ytel-current-video-link ()
13 "Get the link of the video at point."
14 (let* ((video (ytel-get-current-video))
15 (id (ytel-video-id video)))
16 (concat "https://www.youtube.com/watch?v=" id)))
17
18(defun acdw/ytel-watch () ; This could possibly use `browse-url'.
19 "Stream video at point in mpv."
20 (interactive)
21 (start-process "ytel mpv" nil
22 "mpv"
23 (acdw/ytel-current-video-link)
24 "--ytdl-format=bestvideo[height<=?720]+bestaudio/best")
25 (message "Starting streaming..."))
26
27(defun acdw/ytel-copy-link ()
28 "Copy link of the video at point."
29 (interactive)
30 (let ((link (acdw/ytel-current-video-link)))
31 (kill-new link)
32 (message "Copied %s to kill-ring" link)))
33
34
35;;; YTDIOUS: https://github.com/spiderbit/ytdious
36;; a fork of ytel that uses table-view or w/e. looks nicer
37
38(require 'ytdious nil t)
39
40(defun acdw/ytdious-current-video-link ()
41 "Get the link of the video at point."
42 (let* ((video (ytdious-get-current-video))
43 (id (ytdious-video-id-fun video)))
44 (concat "https://www.youtube.com/watch?v=" id)))
45
46(defun acdw/ytdious-watch () ; This could possibly use `browse-url'.
47 "Stream video at point in mpv."
48 (interactive)
49 (let ((link (acdw/ytdious-current-video-link)))
50 (start-process "ytdious mpv" nil
51 "mpv"
52 link
53 "--ytdl-format=bestvideo[height<=?720]+bestaudio/best")
54 (message "Streaming %s..." link)))
55
56(defun acdw/ytdious-copy-link ()
57 "Copy link of the video at point."
58 (interactive)
59 (let ((link (acdw/ytdious-current-video-link)))
60 (kill-new link)
61 (message "Copied %s to kill-ring" link)))
62
63(defun acdw/ytdious-quit ()
64 "Quit ytdious."
65 ;; This corrects an error with `ytdious-quit' where it doesn't have the right
66 ;; buffer setup.
67 (interactive)
68 (quit-window))
69
70;;; Ignore `ytdious-show-image-asyncron' because it's buggy.
71
72(defalias 'ytdious-show-image-asyncron #'ignore)
73
74(provide 'acdw-ytel)
75;;; acdw-ytel.el ends here
diff --git a/lisp/acdw.el b/lisp/acdw.el index 56b661f..b13c9b6 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -1,869 +1,46 @@
1;;; acdw.el --- miscellaneous -*- lexical-binding: t; coding: utf-8-unix -*- 1;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*-
2
3;; Author: Case Duckworth <(rot13-string "npqj@npqj.arg")>
4;; Created: Sometime during Covid-19, 2020
5;; Keywords: configuration
6;; URL: https://tildegit.org/acdw/emacs
7
8;; This file is NOT part of GNU Emacs.
9
10;;; License:
11;; Everyone is permitted to do whatever with this software, without
12;; limitation. This software comes without any warranty whatsoever,
13;; but with two pieces of advice:
14;; - Don't hurt yourself.
15;; - Make good choices.
16 2
17;;; Commentary: 3;;; Commentary:
18;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life
19;; functions for me, acdw.
20
21;;; Code:
22
23(require 'cl-lib)
24(require 'auth-source)
25(require 'recentf)
26
27;;; Variables
28
29(defconst acdw/system
30 (pcase system-type
31 ('gnu/linux :home)
32 ((or 'msdos 'windows-nt) :work)
33 (_ :other))
34 "Which computer system is currently being used.")
35
36(defmacro acdw/system (&rest args)
37 "Macro for interfacing, depending on ARGS, with symbol `acdw/system'.
38
39When called without arguments, it returns symbol `acdw/system'. When
40called with one (symbol) argument, it returns (eq acdw/system
41ARG). When called with multiple arguments or a list, it returns
42`pcase' over each argument."
43 (cond
44 ((null args) acdw/system)
45 ((atom (car args))
46 `(when (eq acdw/system ,(car args))
47 ,(car args)))
48 (t
49 `(pcase acdw/system
50 ,@args))))
51
52
53;;; Utility functions
54;; I don't prefix these because ... reasons. Honestly I probably should prefix
55;; them.
56
57(defun truncate-string (len str &optional ellipsis)
58 "If STR is longer than LEN, cut it down and add ELLIPSIS to the end.
59When not specified, ELLIPSIS defaults to '...'."
60 (declare (pure t) (side-effect-free t))
61 (unless ellipsis
62 (setq ellipsis "..."))
63 (if (> (length str) len)
64 (format "%s%s" (substring str 0 (- len (length ellipsis))) ellipsis)
65 str))
66
67;; Why isn't this a thing???
68(defmacro fbound-and-true-p (func)
69 "Return the value of function FUNC if it is bound, else nil."
70 `(and (fboundp ,func) ,func))
71
72(defmacro when-unfocused (name &rest forms)
73 "Define a function NAME, executing FORMS, for when Emacs is unfocused."
74 (declare (indent 1))
75 (let ((func-name (intern (concat "when-unfocused-" (symbol-name name)))))
76 `(progn
77 (defun ,func-name () "Defined by `when-unfocused'."
78 (when (seq-every-p #'null
79 (mapcar #'frame-focus-state (frame-list)))
80 ,@forms))
81 (add-function :after after-focus-change-function #',func-name))))
82
83(defmacro with-eval-after-loads (features &rest body)
84 "Execute BODY after FEATURES are loaded.
85This macro simplifies `with-eval-after-load' for multiple nested
86features."
87 (declare (indent 1)
88 (debug (form def-body)))
89 (unless (listp features)
90 (setq features (list features)))
91 (if (null features)
92 (macroexp-progn body)
93 (let* ((this (car features))
94 (rest (cdr features)))
95 `(with-eval-after-load ',this
96 (with-eval-after-loads ,rest ,@body)))))
97
98(defmacro with-message (message &rest body)
99 "Execute BODY, messaging 'MESSAGE...' before and 'MESSAGE... Done.' after."
100 (declare (indent 1))
101 ;; Wrap a progn inside a prog1 to return the return value of the body.
102 `(prog1
103 (progn (message "%s..." ,message)
104 ,@body)
105 (message "%s... Done." ,message)))
106
107(defun clone-buffer-write-file (filename &optional confirm)
108 "Clone current buffer to a file named FILENAME and switch.
109FILENAME and CONFIRM are passed directly to `write-file'."
110 (interactive ; stolen from `write-file'
111 (list (if buffer-file-name
112 (read-file-name "Write file: "
113 nil nil nil nil)
114 (read-file-name "Write file: " default-directory
115 (expand-file-name
116 (file-name-nondirectory (buffer-name))
117 default-directory)
118 nil nil))
119 (not current-prefix-arg)))
120 (let ((buf (clone-buffer nil nil)))
121 (with-current-buffer buf
122 (write-file filename confirm))
123 (switch-to-buffer buf)))
124
125;; https://old.reddit.com/r/emacs/comments/pjwkts
126(defun acdw/goto-last-row ()
127 "Move point to last row of buffer, but save the column."
128 (interactive)
129 (let ((col (current-column)))
130 (goto-char (point-max))
131 (move-to-column col t)))
132
133(defun acdw/goto-first-row ()
134 "Move point to first row of buffer, but save the column."
135 (interactive)
136 (let ((col (current-column)))
137 (goto-char (point-min))
138 (move-to-column col t)))
139
140(defun dos2unix (buffer)
141 "Replace \r\n with \n in BUFFER."
142 (interactive "*b")
143 (save-excursion
144 (with-current-buffer buffer
145 (goto-char (point-min))
146 (while (search-forward (string ?\C-m ?\C-j) nil t)
147 (replace-match (string ?\C-j) nil t)))))
148
149(defun expand-file-name-exists-p (&rest args)
150 "Return `expand-file-name' ARGS if it exists, or nil."
151 (let ((file (apply #'expand-file-name args)))
152 (if (file-exists-p file)
153 file
154 nil)))
155
156(defun kill-region-or-backward-word (arg)
157 "If region is active, kill; otherwise kill word backward with ARG."
158 (interactive "p")
159 (if (region-active-p)
160 (kill-region (region-beginning) (region-end))
161 (if (bound-and-true-p paredit-mode)
162 (paredit-backward-kill-word)
163 (backward-kill-word arg))))
164
165(defun unfill-buffer (&optional buffer-or-name)
166 "Unfill entire contents of BUFFER-OR-NAME."
167 (with-current-buffer (or buffer-or-name (current-buffer))
168 (save-excursion
169 (save-restriction
170 (unfill-region (point-min) (point-max))))))
171
172(defun waterfall-list (car list rest)
173 "Cons CAR with each element in LIST in a waterfall fashion, end with REST.
174For use with the `with-eval-after-loads' function."
175 (cond ((atom list) `(,car ',list ,@rest))
176 ((= 1 (length list)) `(,car ',(car list) ,@rest))
177 (t
178 `(,car ',(car list)
179 ,(waterfall-list car (cdr list) rest)))))
180
181
182;;; Comment-or-uncomment-sexp
183;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
184
185(defun uncomment-sexp (&optional n)
186 "Uncomment N sexps around point."
187 (interactive "P")
188 (let* ((initial-point (point-marker))
189 (inhibit-field-text-motion t)
190 (p)
191 (end (save-excursion
192 (when (elt (syntax-ppss) 4)
193 (re-search-backward comment-start-skip
194 (line-beginning-position)
195 t))
196 (setq p (point-marker))
197 (comment-forward (point-max))
198 (point-marker)))
199 (beg (save-excursion
200 (forward-line 0)
201 (while (and (not (bobp))
202 (= end (save-excursion
203 (comment-forward (point-max))
204 (point))))
205 (forward-line -1))
206 (goto-char (line-end-position))
207 (re-search-backward comment-start-skip
208 (line-beginning-position)
209 t)
210 (ignore-errors
211 (while (looking-at-p comment-start-skip)
212 (forward-char -1)))
213 (point-marker))))
214 (unless (= beg end)
215 (uncomment-region beg end)
216 (goto-char p)
217 ;; Indentify the "top-level" sexp inside the comment.
218 (while (and (ignore-errors (backward-up-list) t)
219 (>= (point) beg))
220 (skip-chars-backward (rx (syntax expression-prefix)))
221 (setq p (point-marker)))
222 ;; Re-comment everything before it.
223 (ignore-errors
224 (comment-region beg p))
225 ;; And everything after it.
226 (goto-char p)
227 (forward-sexp (or n 1))
228 (skip-chars-forward "\r\n[:blank:]")
229 (if (< (point) end)
230 (ignore-errors
231 (comment-region (point) end))
232 ;; If this is a closing delimiter, pull it up.
233 (goto-char end)
234 (skip-chars-forward "\r\n[:blank:]")
235 (when (eq 5 (car (syntax-after (point))))
236 (delete-indentation))))
237 ;; Without a prefix, it's more useful to leave point where
238 ;; it was.
239 (unless n
240 (goto-char initial-point))))
241
242(defun comment-sexp--raw ()
243 "Comment the sexp at point or ahead of point."
244 (pcase (or (bounds-of-thing-at-point 'sexp)
245 (save-excursion
246 (skip-chars-forward "\r\n[:blank:]")
247 (bounds-of-thing-at-point 'sexp)))
248 (`(,l . ,r)
249 (goto-char r)
250 (skip-chars-forward "\r\n[:blank:]")
251 (save-excursion
252 (comment-region l r))
253 (skip-chars-forward "\r\n[:blank:]"))))
254
255(defun comment-or-uncomment-sexp (&optional n)
256 "Comment the sexp at point and move past it.
257If already inside (or before) a comment, uncomment instead.
258With a prefix argument N, (un)comment that many sexps."
259 (interactive "P")
260 (if (or (elt (syntax-ppss) 4)
261 (< (save-excursion
262 (skip-chars-forward "\r\n[:blank:]")
263 (point))
264 (save-excursion
265 (comment-forward 1)
266 (point))))
267 (uncomment-sexp n)
268 (dotimes (_ (or n 1))
269 (comment-sexp--raw))))
270
271
272;;; Sort sexps
273;; from https://github.com/alphapapa/unpackaged.el#sort-sexps
274;; and https://github.com/alphapapa/unpackaged.el/issues/20
275
276(defun sort-sexps (beg end &optional key-fn sort-fn)
277 "Sort sexps between BEG and END.
278Comments stay with the code below.
279
280Optional argument KEY-FN will determine where in each sexp to
281start sorting. e.g. (lambda (sexp) (symbol-name (car sexp)))
282
283Optional argument SORT-FN will determine how to sort two sexps'
284strings. It's passed to `sort'. By default, it sorts the sexps
285with `string<' starting with the key determined by KEY-FN."
286 (interactive "r")
287 (cl-flet ((skip-whitespace () (while (looking-at (rx (1+ (or space "\n"))))
288 (goto-char (match-end 0))))
289 (skip-both () (while (cond ((or (nth 4 (syntax-ppss))
290 (ignore-errors
291 (save-excursion
292 (forward-char 1)
293 (nth 4 (syntax-ppss)))))
294 (forward-line 1))
295 ((looking-at (rx (1+ (or space "\n"))))
296 (goto-char (match-end 0)))))))
297 (save-excursion
298 (save-restriction
299 (narrow-to-region beg end)
300 (goto-char beg)
301 (skip-both)
302 (cl-destructuring-bind (sexps markers)
303 (cl-loop do (skip-whitespace)
304 for start = (point-marker)
305 for sexp = (ignore-errors
306 (read (current-buffer)))
307 for end = (point-marker)
308 while sexp
309 ;; Collect the real string, then one used for sorting.
310 collect (cons (buffer-substring (marker-position start)
311 (marker-position end))
312 (save-excursion
313 (goto-char (marker-position start))
314 (skip-both)
315 (if key-fn
316 (funcall key-fn sexp)
317 (buffer-substring
318 (point)
319 (marker-position end)))))
320 into sexps
321 collect (cons start end)
322 into markers
323 finally return (list sexps markers))
324 (setq sexps (sort sexps (if sort-fn sort-fn
325 (lambda (a b)
326 (string< (cdr a) (cdr b))))))
327 (cl-loop for (real . sort) in sexps
328 for (start . end) in markers
329 do (progn
330 (goto-char (marker-position start))
331 (insert-before-markers real)
332 (delete-region (point) (marker-position end)))))))))
333
334(defun acdw/sort-setups ()
335 "Sort `setup' forms in the current buffer.
336Actually sorts all forms, but based on the logic of `setup'.
337In short, DO NOT USE THIS FUNCTION!!!"
338 (save-excursion
339 (sort-sexps
340 (point-min) (point-max)
341 ;; Key function
342 nil
343 ;; Sort function
344 (lambda (s1 s2) ; oh god, this is worse.
345 (let* ((s1 (cdr s1)) (s2 (cdr s2)) ; for the strings themselves
346 (require-regexp (rx bos (* nonl) ":require"))
347 (straight-regexp (rx bos (* nonl) ":straight"))
348 (s1-require (string-match require-regexp s1))
349 (s2-require (string-match require-regexp s2))
350 (s1-straight (string-match straight-regexp s1))
351 (s2-straight (string-match straight-regexp s2)))
352 (cond
353 ;; Straight forms require some weirdness
354 ((and s1-straight s2-straight)
355 (let* ((r (rx ":straight" (? "-when") (* space) (? "(")))
356 (s1 (replace-regexp-in-string r "" s1))
357 (s2 (replace-regexp-in-string r "" s2)))
358 (string< s1 s2)))
359 ;; requires should go first
360 ((and s1-require (not s2-require)) t)
361 ((and (not s1-require) s2-require) nil)
362 ;; straights should go last
363 ((and s1-straight (not s2-straight)) nil)
364 ((and (not s1-straight) s2-straight) t)
365 ;; else, just sort em.
366 (t (string< s1 s2))))))))
367
368
369;;; Emacs configuration functions
370
371(defun emacs-git-pull-config (&optional remote branch)
372 "`git-pull' Emacs' configuration from REMOTE and BRANCH.
373REMOTE defaults to 'origin', BRANCH to 'main'."
374 (let ((remote (or remote "origin"))
375 (branch (or branch "main")))
376 (with-message (format "Pulling Emacs's configuration from %s" branch)
377 (shell-command (concat "git -C "
378 "\"" (expand-file-name user-emacs-directory) "\""
379 " pull " remote " " branch)
380 (get-buffer-create "*emacs-git-pull-config-output*")
381 (get-buffer-create "*emacs-git-pull-config-error*")))))
382
383(defun emacs-reload (&optional git-pull-first)
384 "Reload Emacs's configuration files.
385With a prefix argument GIT-PULL-FIRST, run git pull on the repo
386first."
387 (interactive "P")
388 (when git-pull-first
389 (emacs-git-pull-config))
390 (let ((init-files (append
391 ;; Load lisp libraries first, in case their functionality
392 ;; is used by {early-,}init.el
393 (let* ((dir (expand-file-name "lisp/"
394 user-emacs-directory))
395 (full-name (lambda (f)
396 (concat
397 (file-name-as-directory dir) f))))
398 (mapcar full-name (directory-files dir nil "\\.el\\'")))
399 ;; Load regular init files
400 (list (locate-user-emacs-file "early-init.el")
401 (locate-user-emacs-file "init.el" ".emacs"))))
402 (debug-on-error t))
403 (with-message "Saving init files"
404 (save-some-buffers :no-confirm (lambda () (member (buffer-file-name)
405 init-files))))
406 (dolist (file init-files)
407 (with-message (format "Loading %s" file)
408 (when (file-exists-p file)
409 (load-file file))))))
410
411
412;;; Specialized functions
413
414(defun acdw/copy-region-plain (beg end)
415 "Copy a region from BEG to END to clipboard, removing all Org formatting."
416 (interactive "r")
417 (let ((s (buffer-substring-no-properties beg end))
418 (extracted-heading (when (derived-mode-p 'org-mode)
419 (acdw/org-extract-heading-text))))
420 (with-temp-buffer
421 (insert s)
422 (let ((sentence-end-double-space nil))
423 ;; Remove org stuff
424 (when extracted-heading ; Replace org heading with plaintext
425 (goto-char (point-min))
426 (kill-line)
427 (insert extracted-heading))
428 ;; Delete property drawers
429 (replace-regexp org-property-drawer-re "")
430 ;; Delete logbook drawers
431 (replace-regexp org-logbook-drawer-re "")
432 ;; Replace list items with their contents, paragraphed
433 (replace-regexp org-list-full-item-re "
434\4")
435 ;; Delete comment lines
436 (replace-regexp (concat org-comment-regexp ".*$") "")
437 ;; Re-fill text for clipboard
438 (unfill-region (point-min) (point-max))
439 (flush-lines "^$" (point-min) (point-max)))
440 ;; Copy buffer
441 (copy-region-as-kill (point-min) (point-max))))
442 (when (called-interactively-p 'interactive)
443 (indicate-copied-region))
444 (setq deactivate-mark t)
445 nil)
446 4
447;; https://emacs.stackexchange.com/questions/36366/ 5;; What's that saying about how the hardest things in computer science
448(defun html-body-id-filter (output backend info) 6;; are naming and off-by-one errors? Well, the naming one I know very
449 "Remove random ID attributes generated by Org." 7;; well. I've been trying to figure out a good way to prefix my
450 (when (eq backend 'html) 8;; bespoke functions, other stuff I found online, and various emacs
451 (replace-regexp-in-string 9;; lisp detritus for quite some time (I reckon at over a year, as of
452 " id=\"[[:alpha:]-]*org[[:alnum:]]\\{7\\}\"" 10;; 2021-11-02). Finally, I found the answer in the writings of Daniel
453 "" 11;; Mendler: I'll prefix everything with a `+' !
454 output t)))
455 12
456(defun html-body-div-filter (output backend info) 13;; To that end, pretty much everything in lisp/ will have a filename
457 "Remove wrapping divs generated by Org." 14;; like "+org.el", except of course this file, and maybe a few
458 (when (eq backend 'html) 15;; /actually original/ libraries I haven't had the wherewithal to
459 (replace-regexp-in-string 16;; package out properly yet.
460 "</?div[^>]*>\n*" ""
461 output t)))
462 17
463(defun org-demote-headings (backend) 18;; Is it perfect? No. Is it fine? Yes. Here it is.
464 (while (/= (point) (point-max))
465 (org-next-visible-heading 1)
466 (org-demote-subtree)))
467 19
468(defun acdw/org-export-copy-html () 20;;; Code:
469 "Copy a tree as HTML."
470 (interactive)
471 (require 'ox-html)
472 (org-export-with-buffer-copy
473 ;; (add-hook 'org-export-before-parsing-hook #'org-demote-headings nil t)
474 (let ((extracted-heading (acdw/org-extract-heading-text))
475 (org-export-show-temporary-export-buffer nil)
476 (org-export-filter-final-output-functions
477 '(html-body-id-filter html-body-div-filter)))
478 (insert "* ORG IS STUPID SOMETIMES\n")
479 (goto-char (point-min))
480 (org-html-export-as-html nil t nil t
481 (list :with-smart-quotes nil
482 :with-special-strings t))
483 (with-current-buffer "*Org HTML Export*"
484 (goto-char (point-min))
485 (replace-regexp "<h2>.*</h2>" "")
486 (insert "<h2>" extracted-heading "</h2>")
487 (flush-lines "^$" (point-min) (point-max))
488 (let ((sentence-end-double-space nil))
489 (unfill-region (point-min) (point-max)))
490 (replace-regexp "<h" "\n<h" nil (1+ (point-min)) (point-max))
491 (replace-regexp "<p" "\n<p" nil (point-min) (point-max))
492 (replace-regexp "<p> +" "<p>" nil (point-min) (point-max))
493 (replace-regexp " +</p>" "</p>" nil (point-min) (point-max))
494 (copy-region-as-kill (point-min) (point-max)))))
495 (when (called-interactively-p 'interactive)
496 (indicate-copied-region))
497 (setq deactivate-mark t)
498 nil)
499
500(defun acdw/org-export-copy ()
501 "Copy a tree as ASCII."
502 (interactive)
503 (require 'ox-ascii)
504 (let ((extracted-heading (acdw/org-extract-heading-text)))
505 ;; Export to ASCII - not async, subtree only, visible-only, body-only
506 (let ((org-export-show-temporary-export-buffer nil))
507 (org-ascii-export-as-ascii nil t nil t
508 (list :with-smart-quotes t
509 :with-special-strings t)))
510 (with-current-buffer "*Org ASCII Export*"
511 (goto-char (point-min))
512 (insert extracted-heading)
513 (newline 2)
514
515 (replace-regexp org-list-full-item-re "\n\4")
516
517 (let ((sentence-end-double-space nil))
518 (unfill-region (point-min) (point-max)))
519 (flush-lines "^$" (point-min) (point-max))
520
521 (copy-region-as-kill (point-min) (point-max)))
522
523 (when (called-interactively-p 'interactive)
524 (indicate-copied-region))
525 (setq deactivate-mark t)
526 nil))
527
528(defun acdw/org-extract-heading-text ()
529 "Extract the heading text from an `org-mode' heading."
530 (let ((heading (org-no-properties (org-get-heading t t t t))))
531 (message
532 (replace-regexp-in-string org-link-bracket-re
533 (lambda (match)
534 (match-string-no-properties 2 match))
535 heading))))
536
537(defun acdw/sync-dir (&optional file make-directory)
538 "Return FILE from ~/Sync.
539Optional argument MAKE-DIRECTORY makes the directory.
540Logic is as in `acdw/dir', which see."
541 (let ((dir (expand-file-name (convert-standard-filename "~/Sync/"))))
542 (if file
543 (let ((file-name (expand-file-name (convert-standard-filename file)
544 dir)))
545 (when make-directory
546 (make-directory (file-name-directory file-name) 'parents))
547 file-name)
548 dir)))
549
550(defun acdw/dir (&optional file make-directory)
551 "Place Emacs files in one place.
552
553If called without parameters, `acdw/dir' expands to
554~/.emacs.d/var or similar. If called with FILE, `acdw/dir'
555expands FILE to ~/.emacs.d/var, optionally making its directory
556if MAKE-DIRECTORY is non-nil."
557 (let ((dir (expand-file-name (convert-standard-filename "var/")
558 user-emacs-directory)))
559 (if file
560 (let ((file-name (expand-file-name (convert-standard-filename file)
561 dir)))
562 (when make-directory
563 (make-directory (file-name-directory file-name) 'parents))
564 file-name)
565 dir)))
566
567(defun acdw/find-emacs-source () ;; doesn't work right now
568 "Find where Emacs' source tree is."
569 (acdw/system
570 (:work (expand-file-name
571 (concat "~/src/emacs-" emacs-version "/src")))
572 (:home (expand-file-name "~/src/pkg/emacs/src/emacs-git/src"))
573 (:other nil)))
574
575(defun acdw/gc-disable ()
576 "Functionally disable the Garbage collector."
577 (setq gc-cons-threshold most-positive-fixnum
578 gc-cons-percentage 0.8))
579
580(defun acdw/gc-enable ()
581 "Enable the Garbage collector."
582 (setq gc-cons-threshold (* 800 1024 1024)
583 gc-cons-percentage 0.1))
584
585(defun acdw/insert-iso-date (arg)
586 "Insert the ISO-8601-formatted date, optionally including time (pass ARG)."
587 (interactive "P")
588 (let ((format (if arg "%FT%T%z" "%F")))
589 (insert (format-time-string format (current-time)))))
590
591(defun acdw/kill-a-buffer (&optional prefix)
592 "Kill this buffer, or other buffers, depending on PREFIX.
593
594\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window
595\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window
596\\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows
597
598Prompt only if there are unsaved changes."
599 (interactive "P")
600 (pcase (or (car prefix) 0)
601 (0 (kill-current-buffer)
602 (unless (one-window-p) (delete-window)))
603 (4 (other-window 1)
604 (kill-current-buffer)
605 (unless (one-window-p) (delete-window)))
606 (16 (mapc 'kill-buffer (delq (current-buffer) (buffer-list)))
607 (delete-other-windows))))
608
609(defun acdw/sunrise-sunset (sunrise-command sunset-command)
610 "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset."
611 (let* ((times-regex (rx (* nonl)
612 (: (any ?s ?S) "unrise") " "
613 (group (repeat 1 2 digit) ":"
614 (repeat 1 2 digit)
615 (: (any ?a ?A ?p ?P) (any ?m ?M)))
616 (* nonl)
617 (: (any ?s ?S) "unset") " "
618 (group (repeat 1 2 digit) ":"
619 (repeat 1 2 digit)
620 (: (any ?a ?A ?p ?P) (any ?m ?M)))
621 (* nonl)))
622 (ss (acdw/supress-messages #'sunrise-sunset))
623 (_m (string-match times-regex ss))
624 (sunrise-time (match-string 1 ss))
625 (sunset-time (match-string 2 ss)))
626 (run-at-time sunrise-time (* 60 60 24) sunrise-command)
627 (run-at-time sunset-time (* 60 60 24) sunset-command)
628 (run-at-time "12:00am" (* 60 60 24) sunset-command)))
629
630(defun acdw/supress-messages (oldfn &rest args) ; from pkal
631 "Advice wrapper for suppressing `message'.
632OLDFN is the wrapped function, that is passed the arguments
633ARGS."
634 (let ((msg (current-message)))
635 (prog1
636 (let ((inhibit-message t))
637 (apply oldfn args))
638 (when msg
639 (message "%s" msg)))))
640
641(defun acdw/setup-fringes ()
642 "Set up fringes how I likes 'em."
643 (define-fringe-bitmap 'left-curly-arrow
644 [#b01100000
645 #b00110000
646 #b00011000
647 #b00001100]
648 4 8 'center)
649 (define-fringe-bitmap 'right-curly-arrow
650 [#b00000011
651 #b00000110
652 #b00001100
653 #b00011000]
654 4 8 'center)
655 (define-fringe-bitmap 'left-arrow
656 [#b01100000
657 #b01010000]
658 2 8 '(top t))
659 (define-fringe-bitmap 'right-arrow
660 [#b00000011
661 #b00000101]
662 2 8 '(top t))
663 (setq-local indicate-empty-lines nil
664 indicate-buffer-boundaries '((top . right)
665 (bottom . right)))
666 (custom-set-faces '(fringe
667 ((t (:foreground "dim gray"))))))
668
669
670;;; Recentf renaming with dired
671;; from ... somewhere. 'rjs', apparently?
672;; I'm throwing these here because they look better here than in init.el.
673;; Comments are "rjs"'s.
674
675;; Magic advice to rename entries in recentf when moving files in
676;; dired.
677(defun rjs/recentf-rename-notify (oldname newname &rest _args)
678 "Magically rename files from OLDNAME to NEWNAME when moved in `dired'."
679 (if (file-directory-p newname)
680 (rjs/recentf-rename-directory oldname newname)
681 (rjs/recentf-rename-file oldname newname)))
682
683(defun rjs/recentf-rename-file (oldname newname)
684 "Rename a file from OLDNAME to NEWNAME in `recentf-list'."
685 (setq recentf-list
686 (mapcar (lambda (name)
687 (if (string-equal name oldname)
688 newname
689 oldname))
690 recentf-list)))
691
692(defun rjs/recentf-rename-directory (oldname newname)
693 "Rename directory from OLDNAME to NEWNAME in `recentf-list'."
694 ;; oldname, newname and all entries of recentf-list should already
695 ;; be absolute and normalised so I think this can just test whether
696 ;; oldname is a prefix of the element.
697 (setq recentf-list
698 (mapcar (lambda (name)
699 (if (string-prefix-p oldname name)
700 (concat newname (substring name (length oldname)))
701 name))
702 recentf-list)))
703
704
705;;; Sort setq...
706;; https://emacs.stackexchange.com/questions/33039/
707
708(defun sort-setq ()
709 "Sort a setq. Must be a defun."
710 (interactive)
711 (save-excursion
712 (save-restriction
713 (let ((sort-end (progn (end-of-defun)
714 (backward-char)
715 (point-marker)))
716 (sort-beg (progn (beginning-of-defun)
717 (re-search-forward "[ \\t]*(" (point-at-eol))
718 (forward-sexp)
719 (re-search-forward "\\_<" (point-at-eol))
720 (point-marker))))
721 (narrow-to-region (1- sort-beg) (1+ sort-end))
722 (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record)))))
723
724(defun sort-setq-next-record ()
725 "Sort the next record of a `setq' form."
726 (condition-case nil
727 (progn
728 (forward-sexp 1)
729 (backward-sexp))
730 ('scan-error (goto-char (point-max)))))
731
732(defun sort-setq-end-record ()
733 "Sort the end of a `setq' record."
734 (condition-case nil
735 (forward-sexp 2)
736 ('scan-error (goto-char (point-max)))))
737
738
739;;; Crux tweaks
740
741;; `crux-other-window-or-switch-buffer' doesn't take an argument.
742(defun acdw/other-window-or-switch-buffer (&optional arg)
743 "Call `other-window' with ARG or switch buffers, depending on window count."
744 (interactive "P")
745 (if (one-window-p)
746 (switch-to-buffer nil)
747 (other-window (or arg 1))))
748
749(defun acdw/other-window-or-switch-buffer-backward ()
750 "Do `acdw/other-window-or-switch-buffer', but backward."
751 (interactive)
752 (acdw/other-window-or-switch-buffer -1))
753
754
755;;; Auth-sources
756;; https://github.com/emacs-circe/circe/wiki/Configuration
757(defun acdw/fetch-password (&rest params)
758 "Fetch a password from `auth-source' using PARAMS.
759This function is internal. Use `acdw/make-password-fetcher' instead."
760 (let ((match (car (apply #'auth-source-search params))))
761 (if match
762 (let ((secret (plist-get match :secret)))
763 (if (functionp secret)
764 (funcall secret)
765 secret))
766 (message "Password not found for %S" params))))
767
768(defun acdw/make-password-fetcher (&rest params)
769 "Make a function that will call `acdw/fetch-password' with PARAMS."
770 (lambda (&rest _)
771 (apply #'acdw/fetch-password params)))
772
773
774;;; Paren annoyances
775(defun acdw/stop-paren-annoyances (&optional buffer)
776 "Locally turn off paren-checking functions in BUFFER."
777 (with-current-buffer (or buffer (current-buffer))
778 (setq-local blink-matching-paren nil
779 show-paren-mode nil)))
780
781
782;;; 💩
783(defun 💩 (&optional n)
784 "💩 x N."
785 (interactive "p")
786 (let ((n (or n 1)))
787 (while (> n 0)
788 (insert "💩")
789 (setq n (1- n)))))
790
791
792;;; Fat finger solutions
793(defun acdw/fat-finger-exit (&optional prefix)
794 "Delete a frame, or kill Emacs with confirmation.
795When called with PREFIX, just kill Emacs without confirmation."
796 (interactive "P")
797 (if (or prefix
798 (and (= 1 (length (frame-list)))
799 (yes-or-no-p "This is the last frame! Wanna quit?")))
800 (kill-emacs)
801 (ignore-errors
802 (delete-frame))))
803
804(defun acdw/disabled-command-function (&optional cmd keys)
805 (let ((cmd (or cmd this-command))
806 (keys (or keys (this-command-keys))))
807 ;; this logic stolen from original `disabled-command-function'
808 (if (or (eq (aref keys 0) (if (stringp keys)
809 (aref "\M-x" 0)
810 ?\M-x))
811 (and (>= (length keys) 2)
812 (eq (aref keys 0) meta-prefix-char)
813 (eq (aref keys 1) ?x)))
814 ;; it's been run as an M-x command, we want to do it
815 (call-interactively cmd)
816 ;; else, tell the user it's disabled.
817 (message (substitute-command-keys
818 (concat "Command `%s' has been disabled. "
819 "Run with \\[execute-extended-command]."))
820 cmd))))
821
822
823;;; cribbed
824
825;; https://jao.io/blog/2021-09-08-high-signal-to-noise-emacs-command.html
826(defun jao-buffer-same-mode (&rest modes)
827 "Pop to a buffer with a mode among MODES, or the current one if not given."
828 (interactive)
829 (let* ((modes (or modes (list major-mode)))
830 (pred (lambda (b)
831 (let ((b (get-buffer (if (consp b) (car b) b))))
832 (member (buffer-local-value 'major-mode b) modes)))))
833 (pop-to-buffer (read-buffer "Buffer: " nil t pred))))
834
835;;; BLAH
836
837(defun open-paragraph ()
838 "Open a paragraph after point.
839A paragraph is defined as continguous non-empty lines of text
840surrounded by empty lines, so opening a paragraph means to make
841three blank lines, then place the point on the second one."
842 (interactive)
843 ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because
844 ;; that's weird with org, and I'm guessing other modes too.
845 (while (not (looking-at "^$"))
846 (forward-line 1))
847 (newline)
848 (delete-blank-lines)
849 (newline 2)
850 (forward-line -1))
851 21
852(defun require/ (feature &optional filename noerror) 22;;; Define a directory and an expanding function
853 "If FEATURE is not loaded, load it from FILENAME. 23
854This function works just like `require', with one crucial 24(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
855difference: if the FEATURE name contains a slash, the FILENAME 25 "Define a variable and function NAME expanding to DIRECTORY.
856will as well -- unless, of course, FILENAME is set. This allows 26DOCSTRING is applied to the variable. Ensure DIRECTORY exists in
857for `require/' to require files within subdirectories of 27the filesystem, unless INHIBIT-MKDIR is non-nil."
858directories of `load-path'. Of course, NOERROR isn't affected by 28 (declare (indent 2))
859the change." 29 (unless inhibit-mkdir
860 (let* ((feature-name (if (symbolp feature) 30 (make-directory (eval directory) :parents))
861 (symbol-name feature) 31 `(progn
862 feature)) 32 (defvar ,name ,directory
863 (filename (or filename 33 ,(concat docstring (when docstring "\n")
864 (and (string-match-p "/" feature-name) 34 "Defined by `/define-dir'."))
865 feature-name)))) 35 (defun ,name (file &optional mkdir)
866 (require (intern feature-name) filename noerror))) 36 ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
37 "If MKDIR is non-nil, the directory is created.\n"
38 "Defined by `/define-dir'.")
39 (let ((file-name (expand-file-name (convert-standard-filename file)
40 ,name)))
41 (when mkdir
42 (make-directory (file-name-directory file-name) :parents))
43 file-name))))
867 44
868(provide 'acdw) 45(provide 'acdw)
869;;; acdw.el ends here 46;;; acdw.el ends here
diff --git a/lisp/chd.el b/lisp/chd.el deleted file mode 100644 index c6efad0..0000000 --- a/lisp/chd.el +++ /dev/null
@@ -1,76 +0,0 @@
1;;; chd.el --- CHD customizations -*- lexical-binding: t -*-
2
3(require 'acdw-org)
4(require 'org)
5
6(defvar chd/dir (acdw/sync-dir "Click Here Digital/")
7 "Where Click Here stuff is stored.")
8
9(defun chd/dir (file &optional make-directory)
10 "Expand FILE relative to variable `chd/dir'.
11If MAKE-DIRECTORY is non-nil, ensure the file's
12containing directory exists."
13 (let ((file-name (expand-file-name (convert-standard-filename file)
14 chd/dir)))
15 (when make-directory
16 (make-directory (file-name-directory file-name) :parents))
17 file-name))
18
19(defun chd/narrow-to-task (&optional point)
20 "Narrow the buffer to the task POINT is in."
21 (interactive "d")
22 (when point (goto-char point))
23 (if (called-interactively-p 'interactive)
24 (save-excursion
25 (while (not (org-entry-is-todo-p))
26 (acdw/org-previous-heading-widen 1))
27 (org-narrow-to-subtree))
28 ;; well this is dumb...
29 (while (not (org-entry-is-todo-p))
30 (acdw/org-previous-heading-widen 1))
31 (org-narrow-to-subtree)))
32
33(defun chd/clock-in ()
34 "Clock in to the current task."
35 (save-excursion
36 (chd/narrow-to-task)
37 (org-clock-in)))
38
39(defun chd/do-the-thing ()
40 "Copy the plain version of the current task and open its link."
41 (interactive)
42 (chd/narrow-to-task)
43 (save-excursion
44 ;; Prepare buffer
45 (acdw/flyspell-correct-f7) ; This is defined... elsewhere.
46
47 ;; Export the buffer and copy it
48 (pcase (org-entry-get (point-min) "EXPORTAS" t)
49 ("html" (acdw/org-export-copy-html))
50 (_ (acdw/org-export-copy)))
51
52 ;; Open the link to the doc
53 (org-back-to-heading)
54 (org-open-at-point)))
55
56(defun chd/insert-client ()
57 "Insert the current client at point."
58 (interactive)
59 (if-let ((client (org-entry-get nil "CLIENT" :inherit)))
60 (insert client)
61 (beep)
62 (user-error "No client found in current subtree")))
63
64;;; Click Bits!
65(require 'acdw-autoinsert)
66(require 'acdw)
67(require 'private (acdw/sync-dir "private"))
68(acdw/define-auto-insert '(:replace t)
69 (cons (chd/dir "Click Bits" t) "Click Bits!")
70 chd/click-bits-skeleton)
71
72;;; NOTES
73;; org-protocol: https://orgmode.org/worg/org-contrib/org-protocol.html
74;; the bit i wanna pull from TaskIQ: 'document.getElementById("preview")
75(provide 'chd)
76;;; chd.el ends here
diff --git a/lisp/titlecase.el b/lisp/titlecase.el deleted file mode 100644 index 64da5b4..0000000 --- a/lisp/titlecase.el +++ /dev/null
@@ -1,157 +0,0 @@
1;;; titlecase.el -*- lexical-binding: t; -*-
2
3;; https://hungyi.net/posts/programmers-way-to-title-case/
4
5(require 'cl-lib)
6(require 'subr-x)
7
8;;;###autoload
9(defun titlecase-string (str)
10 "Convert string STR to title case and return the resulting string."
11 (let* ((case-fold-search nil)
12 (str-length (length str))
13 ;; A list of markers that indicate start of a new phrase within the
14 ;; title, e.g. "The Lonely Reindeer: A Christmas Story"
15 ;; must be followed by one of word-boundary-chars
16 (new-phrase-chars '(?: ?. ?? ?\; ?\n ?\r))
17 ;; immediately triggers new phrase behavior without waiting for word
18 ;; boundary
19 (immediate-new-phrase-chars '(?\n ?\r))
20 ;; A list of characters that indicate "word boundaries"; used to split
21 ;; the title into processable segments
22 (word-boundary-chars (append '(? ?– ?— ?- ?‑ ?/)
23 immediate-new-phrase-chars))
24 ;; A list of small words that should not be capitalized (in the right
25 ;; conditions)
26 (small-words '("a" "an" "and" "as" "at" "but" "by" "en" "for" "if"
27 "in" "of" "on" "or" "the" "to" "v" "v." "vs" "vs."
28 "via"))
29 ;; Fix if str is ALL CAPS
30 (str (if (string-match-p "[a-z]" str) str (downcase str)))
31 ;; Reduce over a state machine to do title casing
32 (final-state
33 (cl-reduce
34 (lambda (state char)
35 (let* ((result (aref state 0))
36 (last-segment (aref state 1))
37 (first-word-p (aref state 2))
38 (was-in-path-p (aref state 3))
39 (last-char (car last-segment))
40 (in-path-p (or (and (eq char ?/)
41 (or (not last-segment)
42 (member last-char '(?. ?~))))
43 (and was-in-path-p
44 (not
45 (or (eq char ? )
46 (member
47 char
48 immediate-new-phrase-chars))))))
49 (end-p
50 ;; are we at the end of the input string?
51 (eq (+ (length result) (length last-segment) 1)
52 str-length))
53 (pop-p
54 ;; do we need to pop a segment onto the output result?
55 (or end-p (and (not in-path-p)
56 (member char word-boundary-chars))))
57 (segment
58 ;; add the current char to the current segment
59 (cons char last-segment))
60 (segment-string
61 ;; the readable version of the segment
62 (apply #'string (reverse segment)))
63 (small-word-p
64 ;; was the last segment a small word?
65 (member (downcase (substring segment-string 0 -1))
66 small-words))
67 (capitalize-p
68 ;; do we need to capitalized this segment or lowercase it?
69 (or end-p first-word-p (not small-word-p)))
70 (ignore-segment-p
71 ;; ignore explicitly capitalized segments
72 (or (string-match-p "[a-zA-Z].*[A-Z]" segment-string)
73 ;; ignore URLs
74 (string-match-p "^https?:" segment-string)
75 ;; ignore hostnames and namespaces.like.this
76 (string-match-p "\\w\\.\\w" segment-string)
77 ;; ignore windows filesystem paths
78 (string-match-p "^[A-Za-z]:\\\\" segment-string)
79 ;; ignore unix filesystem paths
80 was-in-path-p
81 ;; ignore email addresses and user handles with @ symbol
82 (member ?@ segment)))
83 (next-result
84 (if pop-p
85 (concat result
86 (if ignore-segment-p
87 ;; pop segment onto the result without
88 ;; processing
89 segment-string
90 ;; titlecase the segment before popping onto
91 ;; result
92 (titlecase--segment
93 segment-string capitalize-p)))
94 result))
95 (next-segment
96 (unless pop-p segment))
97 (will-be-first-word-p
98 (if pop-p
99 (or (not last-segment)
100 (member last-char new-phrase-chars)
101 (member char immediate-new-phrase-chars))
102 first-word-p)))
103 (vector
104 next-result next-segment will-be-first-word-p in-path-p)))
105 str
106 :initial-value
107 (vector nil ; result stack
108 nil ; current working segment
109 t ; is it the first word of a phrase?
110 nil)))) ; are we inside of a filesystem path?
111 (aref final-state 0)))
112
113(defun titlecase--segment (segment capitalize-p)
114 "Convert a title's inner SEGMENT to capitalized or lower case
115depending on CAPITALIZE-P, then return the result."
116 (let* ((case-fold-search nil)
117 (ignore-chars '(?' ?\" ?\( ?\[ ?‘ ?“ ?’ ?” ?_))
118 (final-state
119 (cl-reduce
120 (lambda (state char)
121 (let ((result (aref state 0))
122 (downcase-p (aref state 1)))
123 (cond
124 (downcase-p
125 ;; already upcased start of segment, so lowercase the rest
126 (vector (cons (downcase char) result) t))
127 ((member char ignore-chars)
128 ;; check if start char of segment needs to be ignored
129 (vector (cons char result) downcase-p))
130 (t
131 ;; haven't upcased yet, and we can, so do it
132 (vector (cons (upcase char) result) t)))))
133 segment
134 :initial-value (vector nil (not capitalize-p)))))
135 (thread-last (aref final-state 0)
136 (reverse)
137 (apply #'string))))
138
139;;;###autoload
140(defun titlecase-region (begin end)
141 "Convert text in region from BEGIN to END to title case."
142 (interactive "*r")
143 (let ((pt (point)))
144 (insert (titlecase-string (delete-and-extract-region begin end)))
145 (goto-char pt)))
146
147;;;###autoload
148(defun titlecase-dwim ()
149 "Convert the region or current line to title case.
150If Transient Mark Mode is on and there is an active region, convert
151the region to title case. Otherwise, work on the current line."
152 (interactive)
153 (if (and transient-mark-mode mark-active)
154 (titlecase-region (region-beginning) (region-end))
155 (titlecase-region (point-at-bol) (point-at-eol))))
156
157(provide 'titlecase)