diff options
Diffstat (limited to 'lisp/acdw.el')
-rw-r--r-- | lisp/acdw.el | 595 |
1 files changed, 90 insertions, 505 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 99ab733..1c6f826 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,28 +1,10 @@ | |||
1 | ;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*- | 1 | ;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- |
2 | 2 | ;; by C. Duckworth <acdw@acdw.net> | |
3 | ;;; Commentary: | 3 | (provide 'acdw) |
4 | |||
5 | ;; What's that saying about how the hardest things in computer science | ||
6 | ;; are naming and off-by-one errors? Well, the naming one I know very | ||
7 | ;; well. I've been trying to figure out a good way to prefix my | ||
8 | ;; bespoke functions, other stuff I found online, and various emacs | ||
9 | ;; lisp detritus for quite some time (I reckon at over a year, as of | ||
10 | ;; 2021-11-02). Finally, I found the answer in the writings of Daniel | ||
11 | ;; Mendler: I'll prefix everything with a `+' ! | ||
12 | |||
13 | ;; To that end, pretty much everything in lisp/ will have a filename | ||
14 | ;; like "+org.el", except of course this file, and maybe a few | ||
15 | ;; /actually original/ libraries I haven't had the wherewithal to | ||
16 | ;; package out properly yet. | ||
17 | |||
18 | ;; Is it perfect? No. Is it fine? Yes. Here it is. | ||
19 | |||
20 | ;;; Code: | ||
21 | 4 | ||
22 | (require 'diary-lib) | 5 | (require 'cl-lib) |
23 | (require 'solar) ; for +sunrise-sunset | ||
24 | 6 | ||
25 | ;;; Define a directory and an expanding function | 7 | ;;; Define both a directory and a function expanding to a file in that directory |
26 | 8 | ||
27 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) | 9 | (defmacro +define-dir (name directory &optional docstring inhibit-mkdir) |
28 | "Define a variable and function NAME expanding to DIRECTORY. | 10 | "Define a variable and function NAME expanding to DIRECTORY. |
@@ -46,488 +28,91 @@ the filesystem, unless INHIBIT-MKDIR is non-nil." | |||
46 | (make-directory (file-name-directory file-name) :parents)) | 28 | (make-directory (file-name-directory file-name) :parents)) |
47 | file-name)))) | 29 | file-name)))) |
48 | 30 | ||
49 | (defun +suppress-messages (oldfn &rest args) ; from pkal | 31 | ;;; Convenience macros |
50 | "Advice wrapper for suppressing `message'. | ||
51 | OLDFN is the wrapped function, that is passed the arguments | ||
52 | ARGS." | ||
53 | (let ((msg (current-message))) | ||
54 | (prog1 | ||
55 | (let ((inhibit-message t)) | ||
56 | (apply oldfn args)) | ||
57 | (when msg | ||
58 | (message "%s" msg))))) | ||
59 | 32 | ||
60 | (defun +ensure-after-init (function) | 33 | (defun eval-after-init (fn) |
61 | "Ensure FUNCTION runs after init, or now if already initialized. | 34 | "Evaluate FN after inititation, or now if Emacs is initialized. |
62 | If Emacs is already started, run FUNCTION. Otherwise, add it to | 35 | FN is called with no arguments." |
63 | `after-init-hook'. FUNCTION is called with no arguments." | ||
64 | (if after-init-time | 36 | (if after-init-time |
65 | (funcall function) | 37 | (funcall fn) |
66 | (add-hook 'after-init-hook function))) | 38 | (add-hook 'after-init-hook fn))) |
67 | 39 | ||
68 | (defmacro +with-ensure-after-init (&rest body) | 40 | (defmacro eval-after (features &rest body) |
69 | "Ensure BODY forms run after init. | 41 | "Evaluate BODY, but only after loading FEATURES. |
70 | Convenience macro wrapper around `+ensure-after-init'." | 42 | FEATURES can be an atom or a list; as an atom it works like |
71 | (declare (indent 0) (debug (def-body))) | 43 | `with-eval-after-load'. The special feature `init' will evaluate |
72 | `(+ensure-after-init (lambda () ,@body))) | 44 | BODY after Emacs is finished initializing." |
73 | 45 | (declare (indent 1) | |
74 | (defun +remember-prefix-arg (p-arg P-arg) | 46 | (debug (form def-body))) |
75 | "Display prefix ARG, in \"p\" and \"P\" `interactive' types. | 47 | (if (eq features 'init) |
76 | I keep forgetting how they differ." | 48 | `(eval-after-init (lambda () ,@body)) |
77 | (interactive "p\nP") | 49 | (unless (listp features) |
78 | (message "p: %S P: %S" p-arg P-arg)) | 50 | (setq features (list features))) |
79 | 51 | (if (null features) | |
80 | (defmacro +defvar (var value &rest _) | 52 | (macroexp-progn body) |
81 | "Quick way to `setq' a variable from a `defvar' form." | 53 | (let* ((this (car features)) |
82 | (declare (doc-string 3) (indent 2)) | 54 | (rest (cdr features))) |
83 | `(setq ,var ,value)) | 55 | `(with-eval-after-load ',this |
84 | 56 | (eval-after ,rest ,@body)))))) | |
85 | (defmacro +with-message (message &rest body) | 57 | |
86 | "Execute BODY, with MESSAGE. | 58 | ;;; Convenience functions |
87 | If body executes without errors, MESSAGE...Done will be displayed." | 59 | |
88 | (declare (indent 1)) | 60 | (defun define-keys (maps &rest keydefs) |
89 | (let ((msg (gensym))) | 61 | "Define KEYDEFS in MAPS. |
90 | `(let ((,msg ,message)) | 62 | Convenience wrapper around `define-key'." |
91 | (condition-case e | 63 | (unless (zerop (mod (length keydefs) 2)) |
92 | (progn (message "%s..." ,msg) | 64 | (user-error "Wrong number of arguments: %S" (length keydefs))) |
93 | ,@body) | 65 | (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) |
94 | (:success (message "%s...done" ,msg)) | 66 | (list maps) |
95 | (t (signal (car e) (cdr e))))))) | 67 | maps)) |
96 | 68 | (cl-loop for (key def) on keydefs by #'cddr | |
97 | (defun +mapc-some-buffers (func &optional predicate-or-modes) | 69 | do (let ((key (if (stringp key) (kbd key) key))) |
98 | "Perform FUNC on all buffers satisfied by PREDICATE-OR-MODES. | 70 | (define-key (if (symbolp map) |
99 | By default, act on all buffers. | 71 | (symbol-value map) |
100 | 72 | map) | |
101 | Both PREDICATE-OR-MODES and FUNC are called with no arguments, | 73 | key def))))) |
102 | but within a `with-current-buffer' form on the currently-active | 74 | |
103 | buffer. | 75 | (defmacro setq-local-hook (hook &rest args) |
104 | 76 | "Run `setq-local' on ARGS when running HOOK." | |
105 | As a special case, if PREDICATE-OR-MODES is a list, it will be | ||
106 | interpreted as a list of major modes. In this case, FUNC will | ||
107 | only be called on buffers derived from one of the modes in | ||
108 | PREDICATE-OR-MODES." | ||
109 | (let ((pred (or predicate-or-modes t))) | ||
110 | (dolist (buf (buffer-list)) | ||
111 | (with-current-buffer buf | ||
112 | (when (cond ((functionp pred) | ||
113 | (funcall pred)) | ||
114 | ((listp pred) | ||
115 | (apply #'derived-mode-p pred)) | ||
116 | (t pred)) | ||
117 | (funcall func)))))) | ||
118 | |||
119 | ;; https://github.com/cstby/emacs.d/blob/main/init.el#L67 | ||
120 | (defun +clean-empty-lines (&optional begin end) | ||
121 | "Remove duplicate empty lines from BEGIN to END. | ||
122 | Called interactively, this function acts on the region, if | ||
123 | active, or else the entire buffer." | ||
124 | (interactive "*r") | ||
125 | (unless (region-active-p) | ||
126 | (setq begin (point-min) | ||
127 | end (save-excursion | ||
128 | (goto-char (point-max)) | ||
129 | (skip-chars-backward "\n[:space:]") | ||
130 | (point)))) | ||
131 | (save-excursion | ||
132 | (save-restriction | ||
133 | (narrow-to-region begin end) | ||
134 | (goto-char (point-min)) | ||
135 | (while (re-search-forward "\n\n\n+" nil :move) | ||
136 | (replace-match "\n\n")) | ||
137 | ;; Insert a newline at the end. | ||
138 | (goto-char (point-max)) | ||
139 | (unless (or (buffer-narrowed-p) | ||
140 | (= (line-beginning-position) (line-end-position))) | ||
141 | (insert "\n"))))) | ||
142 | |||
143 | (defcustom +open-paragraph-ignore-modes '(special-mode lui-mode comint-mode) | ||
144 | "Modes in which `+open-paragraph' makes no sense." | ||
145 | :type '(repeat function)) | ||
146 | |||
147 | (defun +open-paragraph (&optional arg) | ||
148 | "Open a paragraph after paragraph at point. | ||
149 | A paragraph is defined as continguous non-empty lines of text | ||
150 | surrounded by empty lines, so opening a paragraph means to make | ||
151 | three blank lines, then place the point on the second one. | ||
152 | |||
153 | Called with prefix ARG, open a paragraph before point." | ||
154 | ;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down. | ||
155 | (interactive "*P") | ||
156 | ;; TODO: add `+open-paragraph-ignore-modes' | ||
157 | (unless (apply #'derived-mode-p +open-paragraph-ignore-modes) | ||
158 | ;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because | ||
159 | ;; that's weird with org, and I'm guessing other modes too. | ||
160 | (unless (looking-at "^$") (forward-line (if arg -1 +1))) | ||
161 | (while (and (not (looking-at "^$")) | ||
162 | (= 0 (forward-line (if arg -1 +1))))) | ||
163 | (newline) | ||
164 | (when arg (newline) (forward-line -2)) | ||
165 | (delete-blank-lines) | ||
166 | (newline 2) | ||
167 | (previous-line))) | ||
168 | |||
169 | (defun +split-window-then (&optional where arg) | ||
170 | "Split the window into a new buffer. | ||
171 | With non-nil ARG (\\[universal-argument] interactively), don't | ||
172 | prompt for a buffer to switch to. This function will split the | ||
173 | window using `split-window-sensibly', or open the new window in | ||
174 | the direction specified by WHERE. WHERE is ignored when called | ||
175 | interactively; if you want specific splitting, use | ||
176 | `+split-window-right-then' or `+split-window-below-then'." | ||
177 | (interactive "i\nP") | ||
178 | ;; TODO: Canceling at the switching phase leaves the point in the other | ||
179 | ;; window. Ideally, the user would see this as one action, meaning a cancel | ||
180 | ;; would return to the original window. | ||
181 | (pcase where | ||
182 | ;; These directions are 'backward' to the OG Emacs split-window commands, | ||
183 | ;; because by default Emacs leaves the cursor in the original window. Most | ||
184 | ;; users probably expect a switch to the new window, at least I do. | ||
185 | ((or 'right :right) (split-window-right) (other-window 1)) | ||
186 | ((or 'left :left) (split-window-right)) | ||
187 | ((or 'below :below) (split-window-below) (other-window 1)) | ||
188 | ((or 'above :above) (split-window-below)) | ||
189 | ((pred null) | ||
190 | (or (split-window-sensibly) | ||
191 | (if (< (window-height) (window-width)) | ||
192 | (split-window-below) | ||
193 | (split-window-right))) | ||
194 | (other-window 1)) | ||
195 | (_ (user-error "Unknown WHERE paramater: %s" where))) | ||
196 | (unless arg | ||
197 | (condition-case nil | ||
198 | (call-interactively | ||
199 | (pcase (read-char "(B)uffer or (F)ile?") | ||
200 | (?b (if (fboundp #'consult-buffer) | ||
201 | #'consult-buffer | ||
202 | #'switch-to-buffer)) | ||
203 | (?f #'find-file) | ||
204 | (_ #'ignore))) | ||
205 | (quit (delete-window))))) | ||
206 | |||
207 | (defun +split-window-right-then (&optional arg) | ||
208 | "Split window right, then prompt for a new buffer. | ||
209 | With optional ARG (\\[universal-argument]), just split." | ||
210 | (interactive "P") | ||
211 | (+split-window-then :right arg)) | ||
212 | |||
213 | (defun +split-window-below-then (&optional arg) | ||
214 | "Split window below, then prompt for a new buffer. | ||
215 | With optional ARG (\\[universal-argument]), just split." | ||
216 | (interactive "P") | ||
217 | (+split-window-then :below arg)) | ||
218 | |||
219 | (defun +bytes (number unit) | ||
220 | "Convert NUMBER UNITs to bytes. | ||
221 | UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib, | ||
222 | :tib, :pib, :eib, :zib, :yib." | ||
223 | (* number (pcase unit | ||
224 | ;; Base 10 units | ||
225 | (:kb 1000) | ||
226 | (:mb (* 1000 1000)) | ||
227 | (:gb (* 1000 1000 1000)) | ||
228 | (:tb (* 1000 1000 1000 1000)) | ||
229 | (:pb (* 1000 1000 1000 1000 1000)) | ||
230 | (:eb (* 1000 1000 1000 1000 1000 1000)) | ||
231 | (:zb (* 1000 1000 1000 1000 1000 1000 1000)) | ||
232 | (:yb (* 1000 1000 1000 1000 1000 1000 1000 1000)) | ||
233 | ;; Base 2 units | ||
234 | (:kib 1024) | ||
235 | (:mib (* 1024 1024)) | ||
236 | (:gib (* 1024 1024 1024)) | ||
237 | (:tib (* 1024 1024 1024 1024)) | ||
238 | (:pib (* 1024 1024 1024 1024 1024)) | ||
239 | (:eib (* 1024 1024 1024 1024 1024 1024)) | ||
240 | (:zib (* 1024 1024 1024 1024 1024 1024 1024)) | ||
241 | (:yib (* 1024 1024 1024 1024 1024 1024 1024 1024))))) | ||
242 | |||
243 | ;;; Font lock TODO keywords | ||
244 | |||
245 | (defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG") | ||
246 | "Keywords to highlight with `font-lock-todo-face'.") | ||
247 | |||
248 | (defface font-lock-todo-face '((t :inherit font-lock-comment-face | ||
249 | :background "yellow")) | ||
250 | ;; TODO: XXX: FIXME: BUG: testing :) | ||
251 | "Face for TODO keywords.") | ||
252 | |||
253 | (defun font-lock-todo-insinuate () | ||
254 | (let ((keyword-regexp | ||
255 | (rx bow (group (eval (let ((lst '(or))) | ||
256 | (dolist (kw font-lock-todo-keywords) | ||
257 | (push kw lst)) | ||
258 | (nreverse lst)))) | ||
259 | ":"))) | ||
260 | (font-lock-add-keywords | ||
261 | nil | ||
262 | `((,keyword-regexp 1 'font-lock-todo-face prepend))))) | ||
263 | |||
264 | ;; I don't use this much but I always forget the exact implementation, so this | ||
265 | ;; is more to remember than anything else. | ||
266 | (defmacro setc (&rest vars-and-vals) | ||
267 | "Set VARS-AND-VALS by customizing them or using set-default. | ||
268 | Use like `setq'." | ||
269 | `(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr | ||
270 | if (null val) return (user-error "Not enough arguments") | ||
271 | collecting `(funcall (or (get ',var 'custom-get) | ||
272 | #'set-default) | ||
273 | ',var ',val) | ||
274 | into ret | ||
275 | finally return ret))) | ||
276 | |||
277 | (defun +set-faces (specs) | ||
278 | "Set fonts to SPECS. | ||
279 | Specs is an alist: its cars are faces and its cdrs are the plist | ||
280 | passed to `set-face-attribute'. Note that the FRAME argument is | ||
281 | always nil; this function is mostly intended for use in init." | ||
282 | (dolist (spec specs) | ||
283 | (apply #'set-face-attribute (car spec) nil (cdr spec)))) | ||
284 | |||
285 | (defcustom chat-functions '(+irc | ||
286 | jabber-connect-all | ||
287 | ;; slack-start | ||
288 | ) | ||
289 | "Functions to start when calling `chat'." | ||
290 | :type '(repeat function) | ||
291 | :group 'applications) | ||
292 | |||
293 | (defun +string-repeat (n str) | ||
294 | "Repeat STR N times." | ||
295 | (let ((r "")) | ||
296 | (dotimes (_ n) | ||
297 | (setq r (concat r str))) | ||
298 | r)) | ||
299 | |||
300 | ;; (defun chat-disconnect () | ||
301 | ;; "Disconnect from all chats." | ||
302 | ;; (interactive) | ||
303 | ;; (+with-progress "Quitting circe..." | ||
304 | ;; (ignore-errors | ||
305 | ;; (circe-command-GQUIT "peace love bread") | ||
306 | ;; (cancel-timer (irc-connection-get conn :flood-timer)))) | ||
307 | ;; (+with-progress "Quitting jabber..." | ||
308 | ;; (ignore-errors | ||
309 | ;; (jabber-disconnect))) | ||
310 | ;; (when (boundp '+slack-teams) | ||
311 | ;; (+with-progress "Quitting-slack..." | ||
312 | ;; (dolist (team +slack-teams) | ||
313 | ;; (ignore-errors | ||
314 | ;; (slack-team-disconnect team))) | ||
315 | ;; (ignore-errors (slack-ws-close)))) | ||
316 | ;; (+with-progress "Killing buffers..." | ||
317 | ;; (ignore-errors | ||
318 | ;; (+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally." | ||
319 | ;; (let ((kill-buffer-query-functions nil)) | ||
320 | ;; (tracking-remove-buffer (current-buffer)) | ||
321 | ;; (kill-buffer))) | ||
322 | ;; (lambda () "Return t if derived from the following modes." | ||
323 | ;; (derived-mode-p 'lui-mode | ||
324 | ;; 'jabber-chat-mode | ||
325 | ;; 'jabber-roster-mode | ||
326 | ;; 'jabber-browse-mode | ||
327 | ;; 'slack-mode)))))) | ||
328 | |||
329 | ;; I can never remember all the damn chat things I run, so this just does all of em. | ||
330 | ;; (defun chat (&optional arg) | ||
331 | ;; "Initiate all chat functions. | ||
332 | ;; With optional ARG, kill all chat-related buffers first." | ||
333 | ;; (interactive "P") | ||
334 | ;; (when arg (chat-disconnect)) | ||
335 | ;; (dolist-with-progress-reporter (fn chat-functions) | ||
336 | ;; "Connecting to chat..." | ||
337 | ;; (call-interactively fn))) | ||
338 | |||
339 | (defun +forward-paragraph (arg) | ||
340 | "Move forward ARG (simple) paragraphs. | ||
341 | A paragraph here is simply defined: it's a block of buffer that's | ||
342 | separated from others by two newlines." | ||
343 | (interactive "p") | ||
344 | (let ((direction (/ arg (abs arg)))) | ||
345 | (forward-line direction) | ||
346 | (while (not (or (bobp) | ||
347 | (eobp) | ||
348 | (= arg 0))) | ||
349 | (if (looking-at "^[ \f\t]*$") | ||
350 | (setq arg (- arg direction)) | ||
351 | (forward-line direction))))) | ||
352 | |||
353 | (defun +backward-paragraph (arg) | ||
354 | "Move backward ARG (simple) paragraphs. | ||
355 | See `+forward-paragraph' for the behavior." | ||
356 | (interactive "p") | ||
357 | (+forward-paragraph (- arg))) | ||
358 | |||
359 | (defun +concat (&rest strings) | ||
360 | "Concat STRINGS separated by SEPARATOR. | ||
361 | Each item in STRINGS is either a string or a list or strings, | ||
362 | which is concatenated without any separator. | ||
363 | |||
364 | SEPARATOR defaults to the newline (\\n)." | ||
365 | (let (ret | ||
366 | ;; I don't know why a `cl-defun' with | ||
367 | ;; (&rest strings &key (separator "\n")) doesn't work | ||
368 | (separator (or (cl-loop for i from 0 upto (length strings) | ||
369 | if (eq (nth i strings) :separator) | ||
370 | return (nth (1+ i) strings)) | ||
371 | "\n"))) | ||
372 | (while strings | ||
373 | (let ((string (pop strings))) | ||
374 | (cond ((eq string :separator) (pop strings)) | ||
375 | ((listp string) (push (apply #'concat string) ret)) | ||
376 | ((stringp string) (push string ret))))) | ||
377 | (mapconcat #'identity (nreverse ret) separator))) | ||
378 | |||
379 | (defun +file-string (file) | ||
380 | "Fetch the contents of FILE and return its string." | ||
381 | (with-current-buffer (find-file-noselect file) | ||
382 | (buffer-string))) | ||
383 | |||
384 | (defmacro +with-progress (pr-args &rest body) | ||
385 | "Perform BODY wrapped in a progress reporter. | ||
386 | PR-ARGS is the list of arguments to pass to | ||
387 | `make-progress-reporter'; it can be a single string for the | ||
388 | message, as well. If you want to use a formatted string, wrap | ||
389 | the `format' call in a list." | ||
390 | (declare (indent 1)) | 77 | (declare (indent 1)) |
391 | (let ((reporter (gensym)) | 78 | (let ((fn (intern (format "%s-setq-local" hook)))) |
392 | (pr-args (if (listp pr-args) pr-args (list pr-args)))) | 79 | (when (and (fboundp fn) |
393 | `(let ((,reporter (make-progress-reporter ,@pr-args))) | 80 | (functionp fn)) |
394 | (prog1 (progn ,@body) | 81 | (setq args (append (function-get fn 'setq-local-hook-settings) args))) |
395 | (progress-reporter-done ,reporter))))) | 82 | (unless (and (< 0 (length args)) |
396 | 83 | (zerop (mod (length args) 2))) | |
397 | (defmacro +with-eval-after-loads (features &rest body) | 84 | (user-error "Wrong number of arguments: %S" (length args))) |
398 | "Execute BODY after all FEATURES are loaded." | 85 | `(progn |
399 | (declare (indent 1) (debug (form def-body))) | 86 | (defun ,fn () |
400 | (unless (listp features) | 87 | ,(format "Set local variables after `%s'." hook) |
401 | (setq features (list features))) | 88 | (setq-local ,@args)) |
402 | (if (null features) | 89 | (function-put ',fn 'setq-local-hook-settings ',args) |
403 | (macroexp-progn body) | 90 | (add-hook ',hook #',fn)))) |
404 | (let* ((this (car features)) | 91 | |
405 | (rest (cdr features))) | 92 | (unless (fboundp 'ensure-list) |
406 | `(with-eval-after-load ',this | 93 | ;; Just in case we're using an old version of Emacs. |
407 | (+with-eval-after-loads ,rest ,@body))))) | 94 | (defun ensure-list (object) |
408 | 95 | "Return OBJECT as a list. | |
409 | (defun +scratch-buffer (&optional nomode) | 96 | If OBJECT is already a list, return OBJECT itself. If it's |
410 | "Create a new scratch buffer and switch to it. | 97 | not a list, return a one-element list containing OBJECT." |
411 | If the region is active, paste its contents into the scratch | 98 | (if (listp object) |
412 | buffer. The scratch buffer inherits the mode of the current | 99 | object |
413 | buffer unless NOMODE is non-nil. When called interactively, | 100 | (list object)))) |
414 | NOMODE will be set when called with \\[universal-argument]." | 101 | |
415 | (interactive "P") | 102 | (defun add-to-list* (lists &rest things) |
416 | (let* ((mode major-mode) | 103 | "Add THINGS to LISTS. |
417 | (bufname (generate-new-buffer-name (format "*scratch (%s)*" mode))) | 104 | LISTS can be one list variable or a list. |
418 | (paste (and (region-active-p) | 105 | Each thing of THINGS can be either a variablel (the thing), or a list of the form |
419 | (prog1 | 106 | (ELEMENT &optional APPEND COMPARE-FN), which is passed to |
420 | (buffer-substring (mark t) (point)) | 107 | `add-to-list'." |
421 | (deactivate-mark))))) | 108 | (dolist (l (ensure-list lists)) |
422 | (when (and (not nomode) | 109 | (dolist (thing things) |
423 | (bound-and-true-p ess-dialect)) ; Not sure what `ess-dialect' is | 110 | (apply #'add-to-list l (ensure-list thing))))) |
424 | (setq mode (intern-soft (concat ess-dialect "-mode")))) | 111 | |
425 | ;; Set up buffer | 112 | (defun add-hook* (hooks &rest functions) |
426 | (switch-to-buffer (get-buffer-create bufname)) | 113 | "Add FUNCTIONS to HOOKS. |
427 | (when (and (not nomode) mode) | 114 | Each function in FUNCTIONS can be a singleton or a list of the |
428 | (ignore-errors (funcall mode))) | 115 | form (FUNCTION &optional DEPTH LOCAL)." |
429 | (insert (format "%s Scratch buffer for %s%s\n\n" | 116 | (dolist (hook (ensure-list hooks)) |
430 | comment-start mode comment-end)) | 117 | (dolist (fn functions) |
431 | (when paste (insert paste)) | 118 | (apply #'add-hook hook (ensure-list fn))))) |
432 | (get-buffer bufname))) | ||
433 | |||
434 | (defun +indent-rigidly (arg &optional interactive) | ||
435 | "Indent all lines in the region, or the current line. | ||
436 | This calls `indent-rigidly' and passes ARG to it." | ||
437 | (interactive "P\np") | ||
438 | (unless (region-active-p) | ||
439 | (push-mark) | ||
440 | (push-mark (line-beginning-position) nil t) | ||
441 | (goto-char (line-end-position))) | ||
442 | (call-interactively #'indent-rigidly)) | ||
443 | |||
444 | (defun +sort-lines (reverse beg end) | ||
445 | "Sort lines in region, ignoring leading whitespace. | ||
446 | REVERSE non-nil means descending order; interactively, REVERSE is | ||
447 | the prefix argument, and BEG and END are the region. The | ||
448 | variable `sort-fold-case' determines whether case affects the | ||
449 | sort order." | ||
450 | (interactive "P\nr") | ||
451 | (save-excursion | ||
452 | (save-restriction | ||
453 | (narrow-to-region beg end) | ||
454 | (goto-char (point-min)) | ||
455 | (let ((inhibit-field-text-motion t)) | ||
456 | (sort-subr reverse | ||
457 | #'forward-line | ||
458 | #'end-of-line | ||
459 | #'beginning-of-line-text))))) | ||
460 | |||
461 | (defun +crm-indicator (args) | ||
462 | "AROUND advice for `completing-read-multiple'." | ||
463 | ;; [[https://github.com/minad/vertico/blob/8ab2cddf3a1fb8799611b1d35118bf579aaf3154/README.org][from vertico's README]] | ||
464 | (cons (format "[CRM%s] %s" | ||
465 | (replace-regexp-in-string | ||
466 | "\\`\\[.*?]\\*\\|\\[.*?]\\*\\'" "" | ||
467 | crm-separator) | ||
468 | (car args)) | ||
469 | (cdr args))) | ||
470 | |||
471 | |||
472 | ;;; Timers! | ||
473 | ;; inspired by [[https://git.sr.ht/~protesilaos/tmr/tree/main/item/tmr.el][prot's tmr.el package]] | ||
474 | |||
475 | (defvar +timer-string nil) | ||
476 | (defvar +timer-timer nil) | ||
477 | |||
478 | (defcustom +timer-running-string "⏰" | ||
479 | "What to display when the timer is running." | ||
480 | :type 'string) | ||
481 | (defcustom +timer-done-string "❗" | ||
482 | "What to display when the timer is done." | ||
483 | :type 'string) | ||
484 | |||
485 | (defun +timer (time) | ||
486 | "Set a timer for TIME." | ||
487 | (interactive (list (read-string "Set a timer for how long? "))) | ||
488 | (let ((secs (cond ((natnump time) (* time 60)) | ||
489 | ((and (stringp time) | ||
490 | (string-match-p "[0-9]\\'" time)) | ||
491 | (* (string-to-number time) 60)) | ||
492 | (t (let ((secs 0) | ||
493 | (time time)) | ||
494 | (save-match-data | ||
495 | (while (string-match "\\([0-9.]+\\)\\([hms]\\)" time) | ||
496 | (cl-incf secs | ||
497 | (* (string-to-number (match-string 1 time)) | ||
498 | (pcase (match-string 2 time) | ||
499 | ("h" 3600) | ||
500 | ("m" 60) | ||
501 | ("s" 1)))) | ||
502 | (setq time (substring time (match-end 0))))) | ||
503 | secs))))) | ||
504 | (message "Setting timer for \"%s\" (%S seconds)..." time secs) | ||
505 | (setq +timer-string +timer-running-string) | ||
506 | (setq +timer-timer (run-with-timer secs nil | ||
507 | (lambda () | ||
508 | (message "%S-second timer DONE!" secs) | ||
509 | (setq +timer-string +timer-done-string) | ||
510 | (let ((visible-bell t) | ||
511 | (ring-bell-function nil)) | ||
512 | (ding)) | ||
513 | (ding)))))) | ||
514 | |||
515 | (defun +timer-cancel () | ||
516 | "Cancel the running timer." | ||
517 | (interactive) | ||
518 | (cond ((not +timer-timer) | ||
519 | (message "No timer found!")) | ||
520 | (t | ||
521 | (cancel-timer +timer-timer) | ||
522 | (message "Timer canceled."))) | ||
523 | (setq +timer-string nil)) | ||
524 | |||
525 | |||
526 | |||
527 | (defun +switch-to-last-buffer () | ||
528 | "Switch to the last-used buffer in this window." | ||
529 | (interactive) | ||
530 | (switch-to-buffer nil)) | ||
531 | |||
532 | (provide 'acdw) | ||
533 | ;;; acdw.el ends here | ||