diff options
Diffstat (limited to 'lisp')
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. | ||
50 | When called with optional MESSAGE non-nil, or interactively, also | ||
51 | message 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 | |||
100 | Connect to the given network specified by NETWORK-OR-SERVER. | ||
101 | |||
102 | When this function is called, it collects options from the | ||
103 | SERVER-OPTIONS argument, the user variable | ||
104 | `circe-network-options', and the defaults found in | ||
105 | `circe-network-defaults', in this order. | ||
106 | |||
107 | If NETWORK-OR-SERVER is not found in any of these variables, the | ||
108 | argument is assumed to be the host name for the server, and all | ||
109 | relevant settings must be passed via SERVER-OPTIONS. | ||
110 | |||
111 | All SERVER-OPTIONS are treated as variables by getting the string | ||
112 | \"circe-\" prepended to their name. This variable is then set | ||
113 | locally in the server buffer. | ||
114 | |||
115 | See `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. | ||
22 | Do 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 | 8 | any 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. | ||
25 | Sort based on the following heuristic: `setup' forms (the | ||
26 | majority of my init.el) are sorted after everything else, and | ||
27 | within that group, forms with a HEAD of `:require' are sorted | ||
28 | first, and `:straight' HEADs are sorted last. All other forms | ||
29 | are 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. | ||
24 | Comments stay with the code below. | ||
25 | |||
26 | Optional argument KEY-FN will determine where in each sexp to | ||
27 | start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) | ||
28 | |||
29 | Optional argument SORT-FN will determine how to sort two sexps' | ||
30 | strings. It's passed to `sort'. By default, it sorts the sexps | ||
31 | with `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. |
53 | TYPE should be an element type, like `item' or `paragraph'. | 14 | TYPE should be an element type, like `item' or `paragraph'. |
54 | ELEMENT should be a list like that returned by `org-element-context'." | 15 | ELEMENT 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 | ||
63 | On headings, move point to position after entry content. In | 24 | On headings, move point to position after entry content. In |
64 | lists, insert a new item or end the list, with checkbox if | 25 | lists, insert a new item or end the list, with checkbox if |
65 | appropriate. In tables, insert a new row or end the table." | 26 | appropriate. 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. | ||
129 | N 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. |
170 | Optional PREFIX argument operates on the entire buffer. | 139 | Optional PREFIX argument operates on the entire buffer. |
171 | Drawers are included with their headings." | 140 | Drawers 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. | ||
248 | When deleting backwards, in tables this function will insert | ||
249 | whitespace in front of the next \"|\" separator, to keep the | ||
250 | table aligned. The table will still be marked for re-alignment | ||
251 | if the field did fill the entire column, because, in this case | ||
252 | the 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. | ||
270 | N 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 | ||
280 | Since this function is, for some reason, pricy, the optional | 180 | Since 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. | ||
432 | Workdays are Monday through Friday. This function inserts a new | ||
433 | heading with an inactive timestamp for each workday of MONTH in YEAR. | ||
434 | |||
435 | I use this function to attempt to organize my work month. I'll | ||
436 | probably 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 | 321 | When deleting backwards, in tables this function will insert |
322 | whitespace in front of the next \"|\" separator, to keep the | ||
323 | table aligned. The table will still be marked for re-alignment | ||
324 | if the field did fill the entire column, because, in this case | ||
325 | the 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'. | ||
79 | This macro can be used as HEAD, and will replace itself with the | ||
80 | first 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. | ||
95 | If CONDITION is false, or if `straight-use-package' fails, stop | ||
96 | evaluating the body. This macro can be used as HEAD, and will | ||
97 | replace 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 | |||
37 | ELLIPSIS defaults to \"...\". | ||
38 | |||
39 | ALIGNMENT 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. | ||
56 | Optional arguments BEFORE and AFTER specify strings to go on | ||
57 | either side of S. | ||
58 | |||
59 | FILL is the string to fill extra space with (default \" \"). | ||
60 | |||
61 | ELLIPSIS is the string to show when S is too long to fit (default \"...\"). | ||
62 | |||
63 | ALIGNMENT 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'. | ||
28 | This function differs from `define-auto-insert' in that it won't | ||
29 | allow more than one duplicate entry in `auto-insert-alist'. | ||
30 | |||
31 | OPTIONS 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. | ||
14 | If 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'. | ||
42 | If Emacs' version is 28 or higher, set `browse-url-handlers'. | ||
43 | Else, 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'. | ||
69 | I used `xr' (not included in Emacs) to get the RX form of the | ||
70 | default, so I can easily splice the list into it. THIS IS | ||
71 | BRITTLE 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' | ||
108 | First, add PROTO to `acdw/button-protocols'. | ||
109 | Then, 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. | ||
38 | When called with MESSAGE set to non-nil (or interactively), also | ||
39 | message 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 | |||
127 | Connect to the given network specified by NETWORK-OR-SERVER. | ||
128 | |||
129 | When this function is called, it collects options from the | ||
130 | SERVER-OPTIONS argument, the user variable | ||
131 | `circe-network-options', and the defaults found in | ||
132 | `circe-network-defaults', in this order. | ||
133 | |||
134 | If NETWORK-OR-SERVER is not found in any of these variables, the | ||
135 | argument is assumed to be the host name for the server, and all | ||
136 | relevant settings must be passed via SERVER-OPTIONS. | ||
137 | |||
138 | All SERVER-OPTIONS are treated as variables by getting the string | ||
139 | \"circe-\" prepended to their name. This variable is then set | ||
140 | locally in the server buffer. | ||
141 | |||
142 | See `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. | ||
27 | Is 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. | ||
61 | If the region is active, this function calls `upcase-region'. | ||
62 | Otherwise, it calls `upcase-word', with prefix argument passed to it | ||
63 | to 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. | ||
71 | If the region is active, this function calls `downcase-region'. | ||
72 | Otherwise, it calls `downcase-word', with prefix argument passed to it | ||
73 | to 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. | ||
81 | If the region is active, this function calls `capitalize-region'. | ||
82 | Otherwise, it calls `capitalize-word', with prefix argument passed to it | ||
83 | to 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. | ||
101 | Message is something like \"Repeating command glorp\". | ||
102 | A value of `ignore' will disable such messages. To customize | ||
103 | display, assign a function that takes one string as an arg and | ||
104 | displays it however you want. | ||
105 | If this variable is nil, the normal `message' function will be | ||
106 | used 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. | ||
110 | If this variable is t, `repeat' determines what key sequence | ||
111 | it was invoked by, extracts the final character of that sequence, and | ||
112 | re-executes as many times as that final character is hit; so for example | ||
113 | if `repeat' is bound to C-x z, typing C-x z z z repeats the previous command | ||
114 | 3 times. If this variable is a sequence of characters, then re-execution | ||
115 | only occurs if the final character by which `repeat' was invoked is a | ||
116 | member 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'. | ||
127 | Usually, when a command is executing, the Emacs builtin variable | ||
128 | `this-command' identifies the command the user invoked. Some commands modify | ||
129 | that variable on the theory they're doing more good than harm; `repeat' does | ||
130 | that, and usually does do more good than harm. However, like all do-gooders, | ||
131 | sometimes `repeat' gets surprising results from its altruism. The value of | ||
132 | this 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. | ||
141 | If REPEAT-ARG is non-nil (interactively, with a prefix argument), | ||
142 | supply a prefix argument to that command. Otherwise, give the | ||
143 | command the same prefix argument it was given before, if any. | ||
144 | |||
145 | If this command is invoked by a multi-character key sequence, it | ||
146 | can then be repeated by repeating the final character of that | ||
147 | sequence. 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 | ||
152 | recently 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. | ||
251 | For 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. | ||
259 | When a number, exit the repeat mode after idle time of the specified | ||
260 | number 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. | ||
277 | Function is called after every repeatable command with one argument: | ||
278 | a 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. | ||
293 | A command called from the map can set it again to the same map when | ||
294 | the map can't be set on the command symbol property `repeat-map'.") | ||
295 | |||
296 | (define-minor-mode repeat-mode | ||
297 | "Toggle Repeat mode. | ||
298 | When 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'. | ||
459 | Used 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'. | ||
472 | Used 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' | ||
9 | if 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. | ||
56 | If 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. | ||
127 | Truncation is customized using the `erc-nick-truncate' variable. | ||
128 | See 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. | ||
149 | Reverse 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 | ||
164 | erc-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 | |||
36 | This value is multiplied by 10, so 12 becomes 120, in order to | ||
37 | comply 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 | |||
42 | This value will be used to determine a relative (float) size | ||
43 | based on the default size. So if your default size is 12 and | ||
44 | your variable size is 14, the computed relative size will be | ||
45 | 1.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 | |||
123 | This 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. | ||
155 | Handles 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. | ||
7 | FONT-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. | ||
30 | BITMAP-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. | ||
40 | Stolen 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'. | ||
53 | Optional arguments BEFORE and AFTER specify strings to go | ||
54 | ... before and after the string. ALIGNMENT aligns left on nil | ||
55 | and 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. | ||
28 | If the cdr of the cons cell is nil, use the default function (`count-words'). | ||
29 | Otherwise, 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 | ||
103 | indicator 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 | |||
152 | Unlike `simple-modeline-segment-position', this changes the first | ||
153 | character from '+' to '-' if the region goes 'backward' -- that | ||
154 | is, 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. | ||
214 | Only 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. | ||
221 | Uses `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'. | ||
41 | With non-nil optional argument DELIMITED, only replace matches | ||
42 | surrounded 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'. | ||
73 | If 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'. | ||
30 | The car of each cell is the variable name, and the cdr is the | ||
31 | value 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'. | ||
38 | The car of each cell is the function name, and the cdr is the | ||
39 | value 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. | ||
62 | FUNC 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'. | ||
66 | This macro can be used as HEAD, and will replace itself with the | ||
67 | first 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. | ||
82 | If CONDITION is false, stop evaluating the body. This macro can | ||
83 | be used as HEAD, and will replace itself with the RECIPE's | ||
84 | package. 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 | |||
39 | When called without arguments, it returns symbol `acdw/system'. When | ||
40 | called with one (symbol) argument, it returns (eq acdw/system | ||
41 | ARG). 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. | ||
59 | When 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. | ||
85 | This macro simplifies `with-eval-after-load' for multiple nested | ||
86 | features." | ||
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. | ||
109 | FILENAME 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. | ||
174 | For 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. | ||
257 | If already inside (or before) a comment, uncomment instead. | ||
258 | With 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. | ||
278 | Comments stay with the code below. | ||
279 | |||
280 | Optional argument KEY-FN will determine where in each sexp to | ||
281 | start sorting. e.g. (lambda (sexp) (symbol-name (car sexp))) | ||
282 | |||
283 | Optional argument SORT-FN will determine how to sort two sexps' | ||
284 | strings. It's passed to `sort'. By default, it sorts the sexps | ||
285 | with `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. | ||
336 | Actually sorts all forms, but based on the logic of `setup'. | ||
337 | In 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. | ||
373 | REMOTE 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. | ||
385 | With a prefix argument GIT-PULL-FIRST, run git pull on the repo | ||
386 | first." | ||
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. | ||
539 | Optional argument MAKE-DIRECTORY makes the directory. | ||
540 | Logic 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 | |||
553 | If called without parameters, `acdw/dir' expands to | ||
554 | ~/.emacs.d/var or similar. If called with FILE, `acdw/dir' | ||
555 | expands FILE to ~/.emacs.d/var, optionally making its directory | ||
556 | if 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 | |||
598 | Prompt 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'. | ||
632 | OLDFN is the wrapped function, that is passed the arguments | ||
633 | ARGS." | ||
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. | ||
759 | This 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. | ||
795 | When 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. | ||
839 | A paragraph is defined as continguous non-empty lines of text | ||
840 | surrounded by empty lines, so opening a paragraph means to make | ||
841 | three 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 | |
854 | This function works just like `require', with one crucial | 24 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) |
855 | difference: if the FEATURE name contains a slash, the FILENAME | 25 | "Define a variable and function NAME expanding to DIRECTORY. |
856 | will as well -- unless, of course, FILENAME is set. This allows | 26 | DOCSTRING is applied to the variable. Ensure DIRECTORY exists in |
857 | for `require/' to require files within subdirectories of | 27 | the filesystem, unless INHIBIT-MKDIR is non-nil." |
858 | directories of `load-path'. Of course, NOERROR isn't affected by | 28 | (declare (indent 2)) |
859 | the 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'. | ||
11 | If MAKE-DIRECTORY is non-nil, ensure the file's | ||
12 | containing 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 | ||
115 | depending 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. | ||
150 | If Transient Mark Mode is on and there is an active region, convert | ||
151 | the 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) | ||