about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-11-21 23:57:41 -0600
committerCase Duckworth2021-11-21 23:57:41 -0600
commita2657993bad828af6743c68931a0e848bfcdec53 (patch)
tree1e9220389184a0c68bc9f6bfe08edca3f2a362e6 /lisp
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.
Diffstat (limited to 'lisp')
-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
33 files changed, 934 insertions, 3681 deletions
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)