diff options
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/acdw.el | 89 |
1 files changed, 41 insertions, 48 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 5bb53e2..4f91e24 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el | |||
@@ -1,4 +1,4 @@ | |||
1 | ;;; acdw.el -*- lexical-binding: t; coding: utf-8-unix -*- | 1 | ;;; acdw.el --- miscellaneous -*- lexical-binding: t; coding: utf-8-unix -*- |
2 | 2 | ||
3 | ;; Author: Case Duckworth <acdw@acdw.net> | 3 | ;; Author: Case Duckworth <acdw@acdw.net> |
4 | ;; Created: Sometime during Covid-19, 2020 | 4 | ;; Created: Sometime during Covid-19, 2020 |
@@ -21,6 +21,8 @@ | |||
21 | ;;; Code: | 21 | ;;; Code: |
22 | 22 | ||
23 | (require 'cl-lib) | 23 | (require 'cl-lib) |
24 | (require 'auth-source) | ||
25 | (require 'recentf) | ||
24 | 26 | ||
25 | ;;; Variables | 27 | ;;; Variables |
26 | 28 | ||
@@ -32,9 +34,9 @@ | |||
32 | "Which computer system is currently being used.") | 34 | "Which computer system is currently being used.") |
33 | 35 | ||
34 | (defmacro acdw/system (&rest args) | 36 | (defmacro acdw/system (&rest args) |
35 | "Convenience macro for interfacing with `acdw/system'. | 37 | "Macro for interfacing, depending on ARGS, with symbol `acdw/system'. |
36 | 38 | ||
37 | When called without arguments, it returns `acdw/system'. When | 39 | When called without arguments, it returns symbol `acdw/system'. When |
38 | called with one (symbol) argument, it returns (eq acdw/system | 40 | called with one (symbol) argument, it returns (eq acdw/system |
39 | ARG). When called with multiple arguments or a list, it returns | 41 | ARG). When called with multiple arguments or a list, it returns |
40 | `pcase' over each argument." | 42 | `pcase' over each argument." |
@@ -58,8 +60,7 @@ ARG). When called with multiple arguments or a list, it returns | |||
58 | `(and (fboundp ,func) ,func)) | 60 | `(and (fboundp ,func) ,func)) |
59 | 61 | ||
60 | (defmacro when-unfocused (name &rest forms) | 62 | (defmacro when-unfocused (name &rest forms) |
61 | "Define a function NAME, executing FORMS, that fires when Emacs | 63 | "Define a function NAME, executing FORMS, for when Emacs is unfocused." |
62 | is unfocused." | ||
63 | (declare (indent 1)) | 64 | (declare (indent 1)) |
64 | (let ((func-name (intern (concat "when-unfocused-" (symbol-name name))))) | 65 | (let ((func-name (intern (concat "when-unfocused-" (symbol-name name))))) |
65 | `(progn | 66 | `(progn |
@@ -129,19 +130,12 @@ FILENAME and CONFIRM are passed directly to `write-file'." | |||
129 | (backward-kill-word arg)))) | 130 | (backward-kill-word arg)))) |
130 | 131 | ||
131 | (defun unfill-buffer (&optional buffer-or-name) | 132 | (defun unfill-buffer (&optional buffer-or-name) |
133 | "Unfill entire contents of BUFFER-OR-NAME." | ||
132 | (with-current-buffer (or buffer-or-name (current-buffer)) | 134 | (with-current-buffer (or buffer-or-name (current-buffer)) |
133 | (save-excursion | 135 | (save-excursion |
134 | (save-restriction | 136 | (save-restriction |
135 | (unfill-region (point-min) (point-max)))))) | 137 | (unfill-region (point-min) (point-max)))))) |
136 | 138 | ||
137 | ;; https://www.emacswiki.org/emacs/UnfillRegion | ||
138 | (defun unfill-region (start end) | ||
139 | "Unfill a region defined by START and END positions." | ||
140 | (interactive "*r") | ||
141 | (let ((fill-column (point-max)) | ||
142 | (emacs-lisp-docstring-fill-column t)) | ||
143 | (fill-region start end))) | ||
144 | |||
145 | (defun waterfall-list (car list rest) | 139 | (defun waterfall-list (car list rest) |
146 | "Cons CAR with each element in LIST in a waterfall fashion, end with REST. | 140 | "Cons CAR with each element in LIST in a waterfall fashion, end with REST. |
147 | For use with the `with-eval-after-loads' function." | 141 | For use with the `with-eval-after-loads' function." |
@@ -156,7 +150,7 @@ For use with the `with-eval-after-loads' function." | |||
156 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html | 150 | ;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html |
157 | 151 | ||
158 | (defun uncomment-sexp (&optional n) | 152 | (defun uncomment-sexp (&optional n) |
159 | "Uncomment a sexp around point." | 153 | "Uncomment N sexps around point." |
160 | (interactive "P") | 154 | (interactive "P") |
161 | (let* ((initial-point (point-marker)) | 155 | (let* ((initial-point (point-marker)) |
162 | (inhibit-field-text-motion t) | 156 | (inhibit-field-text-motion t) |
@@ -192,7 +186,7 @@ For use with the `with-eval-after-loads' function." | |||
192 | (>= (point) beg)) | 186 | (>= (point) beg)) |
193 | (skip-chars-backward (rx (syntax expression-prefix))) | 187 | (skip-chars-backward (rx (syntax expression-prefix))) |
194 | (setq p (point-marker))) | 188 | (setq p (point-marker))) |
195 | ;; Re-comment everything before it. | 189 | ;; Re-comment everything before it. |
196 | (ignore-errors | 190 | (ignore-errors |
197 | (comment-region beg p)) | 191 | (comment-region beg p)) |
198 | ;; And everything after it. | 192 | ;; And everything after it. |
@@ -247,7 +241,7 @@ With a prefix argument N, (un)comment that many sexps." | |||
247 | ;; and https://github.com/alphapapa/unpackaged.el/issues/20 | 241 | ;; and https://github.com/alphapapa/unpackaged.el/issues/20 |
248 | 242 | ||
249 | (defun sort-sexps (beg end &optional key) | 243 | (defun sort-sexps (beg end &optional key) |
250 | "Sort sexps in region. | 244 | "Sort sexps between BEG and END. |
251 | Comments stay with the code below. KEY is a function to sort by, | 245 | Comments stay with the code below. KEY is a function to sort by, |
252 | e.g. (lambda (sexp) (symbol-name (car sexp)))" | 246 | e.g. (lambda (sexp) (symbol-name (car sexp)))" |
253 | (interactive "r") | 247 | (interactive "r") |
@@ -301,8 +295,7 @@ e.g. (lambda (sexp) (symbol-name (car sexp)))" | |||
301 | ;;; Emacs configuration functions | 295 | ;;; Emacs configuration functions |
302 | 296 | ||
303 | (defun emacs-git-pull-config (&optional remote branch) | 297 | (defun emacs-git-pull-config (&optional remote branch) |
304 | "`git-pull' emacs configuration from REMOTE and BRANCH. | 298 | "`git-pull' Emacs' configuration from REMOTE and BRANCH. |
305 | |||
306 | REMOTE defaults to 'origin', BRANCH to 'main'." | 299 | REMOTE defaults to 'origin', BRANCH to 'main'." |
307 | (let ((remote (or remote "origin")) | 300 | (let ((remote (or remote "origin")) |
308 | (branch (or branch "main"))) | 301 | (branch (or branch "main"))) |
@@ -315,8 +308,8 @@ REMOTE defaults to 'origin', BRANCH to 'main'." | |||
315 | 308 | ||
316 | (defun emacs-reload (&optional git-pull-first) | 309 | (defun emacs-reload (&optional git-pull-first) |
317 | "Reload Emacs's configuration files. | 310 | "Reload Emacs's configuration files. |
318 | 311 | With a prefix argument GIT-PULL-FIRST, run git pull on the repo | |
319 | With a prefix argument, run git pull on the repo first." | 312 | first." |
320 | (interactive "P") | 313 | (interactive "P") |
321 | (when git-pull-first | 314 | (when git-pull-first |
322 | (emacs-git-pull-config)) | 315 | (emacs-git-pull-config)) |
@@ -344,10 +337,10 @@ With a prefix argument, run git pull on the repo first." | |||
344 | 337 | ||
345 | ;;; Specialized functions | 338 | ;;; Specialized functions |
346 | 339 | ||
347 | (defun acdw/copy-region-plain (start end) | 340 | (defun acdw/copy-region-plain (beg end) |
348 | "Copy a region to clipboard, removing all Org formatting." | 341 | "Copy a region from BEG to END to clipboard, removing all Org formatting." |
349 | (interactive "r") | 342 | (interactive "r") |
350 | (let ((s (buffer-substring-no-properties start end)) | 343 | (let ((s (buffer-substring-no-properties beg end)) |
351 | (extracted-heading (when (derived-mode-p 'org-mode) | 344 | (extracted-heading (when (derived-mode-p 'org-mode) |
352 | (acdw/org-extract-heading-text)))) | 345 | (acdw/org-extract-heading-text)))) |
353 | (with-temp-buffer | 346 | (with-temp-buffer |
@@ -373,6 +366,7 @@ With a prefix argument, run git pull on the repo first." | |||
373 | nil) | 366 | nil) |
374 | 367 | ||
375 | (defun acdw/org-extract-heading-text () | 368 | (defun acdw/org-extract-heading-text () |
369 | "Extract the heading text from an `org-mode' heading." | ||
376 | (let ((heading (org-no-properties (org-get-heading t t t t)))) | 370 | (let ((heading (org-no-properties (org-get-heading t t t t)))) |
377 | (message | 371 | (message |
378 | (replace-regexp-in-string org-link-bracket-re | 372 | (replace-regexp-in-string org-link-bracket-re |
@@ -397,16 +391,8 @@ if MAKE-DIRECTORY is non-nil." | |||
397 | file-name) | 391 | file-name) |
398 | dir))) | 392 | dir))) |
399 | 393 | ||
400 | (defun acdw/find-emacs-dotfiles () | 394 | (defun acdw/find-emacs-source () ;; doesn't work right now |
401 | "Finds lisp files in `user-emacs-directory' and passes them to | 395 | "Find where Emacs' source tree is." |
402 | `completing-read'." | ||
403 | (interactive) | ||
404 | (find-file (completing-read ".emacs: " | ||
405 | (directory-files-recursively | ||
406 | user-emacs-directory "\.el$")))) | ||
407 | |||
408 | (defun acdw/find-emacs-source () | ||
409 | "Find where Emacs keeps its source tree." | ||
410 | (acdw/system | 396 | (acdw/system |
411 | (:work (expand-file-name | 397 | (:work (expand-file-name |
412 | (concat "~/src/emacs-" emacs-version "/src"))) | 398 | (concat "~/src/emacs-" emacs-version "/src"))) |
@@ -423,18 +409,18 @@ if MAKE-DIRECTORY is non-nil." | |||
423 | (setq gc-cons-threshold (* 800 1024 1024) | 409 | (setq gc-cons-threshold (* 800 1024 1024) |
424 | gc-cons-percentage 0.1)) | 410 | gc-cons-percentage 0.1)) |
425 | 411 | ||
426 | (defun acdw/insert-iso-date (with-time) | 412 | (defun acdw/insert-iso-date (arg) |
427 | "Insert the ISO-8601-formatted date, with optional time." | 413 | "Insert the ISO-8601-formatted date, optionally including time (pass ARG)." |
428 | (interactive "P") | 414 | (interactive "P") |
429 | (let ((format (if with-time "%FT%T%z" "%F"))) | 415 | (let ((format (if arg "%FT%T%z" "%F"))) |
430 | (insert (format-time-string format (current-time))))) | 416 | (insert (format-time-string format (current-time))))) |
431 | 417 | ||
432 | (defun acdw/kill-a-buffer (&optional prefix) | 418 | (defun acdw/kill-a-buffer (&optional prefix) |
433 | "Kill a buffer based on the following rules: | 419 | "Kill this buffer, or other buffers, depending on PREFIX. |
434 | 420 | ||
435 | C-x k => Kill CURRENT buffer and window | 421 | \\[acdw/kill-a-buffer] : Kill CURRENT buffer and window |
436 | C-u C-x k => Kill OTHER buffer and window | 422 | \\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window |
437 | C-u C-u C-x k => Kill ALL OTHER buffers and windows | 423 | \\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows |
438 | 424 | ||
439 | Prompt only if there are unsaved changes." | 425 | Prompt only if there are unsaved changes." |
440 | (interactive "P") | 426 | (interactive "P") |
@@ -448,7 +434,7 @@ Prompt only if there are unsaved changes." | |||
448 | (delete-other-windows)))) | 434 | (delete-other-windows)))) |
449 | 435 | ||
450 | (defun acdw/sunrise-sunset (sunrise-command sunset-command) | 436 | (defun acdw/sunrise-sunset (sunrise-command sunset-command) |
451 | "Run commands at sunrise and sunset." | 437 | "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset." |
452 | (let* ((times-regex (rx (* nonl) | 438 | (let* ((times-regex (rx (* nonl) |
453 | (: (any ?s ?S) "unrise") " " | 439 | (: (any ?s ?S) "unrise") " " |
454 | (group (repeat 1 2 digit) ":" | 440 | (group (repeat 1 2 digit) ":" |
@@ -510,12 +496,14 @@ It's called 'require-private' for historical reasons." | |||
510 | 496 | ||
511 | ;; Magic advice to rename entries in recentf when moving files in | 497 | ;; Magic advice to rename entries in recentf when moving files in |
512 | ;; dired. | 498 | ;; dired. |
513 | (defun rjs/recentf-rename-notify (oldname newname &rest args) | 499 | (defun rjs/recentf-rename-notify (oldname newname &rest _args) |
500 | "Magically rename files from OLDNAME to NEWNAME when moved in `dired'." | ||
514 | (if (file-directory-p newname) | 501 | (if (file-directory-p newname) |
515 | (rjs/recentf-rename-directory oldname newname) | 502 | (rjs/recentf-rename-directory oldname newname) |
516 | (rjs/recentf-rename-file oldname newname))) | 503 | (rjs/recentf-rename-file oldname newname))) |
517 | 504 | ||
518 | (defun rjs/recentf-rename-file (oldname newname) | 505 | (defun rjs/recentf-rename-file (oldname newname) |
506 | "Rename a file from OLDNAME to NEWNAME in `recentf-list'." | ||
519 | (setq recentf-list | 507 | (setq recentf-list |
520 | (mapcar (lambda (name) | 508 | (mapcar (lambda (name) |
521 | (if (string-equal name oldname) | 509 | (if (string-equal name oldname) |
@@ -524,6 +512,7 @@ It's called 'require-private' for historical reasons." | |||
524 | recentf-list))) | 512 | recentf-list))) |
525 | 513 | ||
526 | (defun rjs/recentf-rename-directory (oldname newname) | 514 | (defun rjs/recentf-rename-directory (oldname newname) |
515 | "Rename directory from OLDNAME to NEWNAME in `recentf-list'." | ||
527 | ;; oldname, newname and all entries of recentf-list should already | 516 | ;; oldname, newname and all entries of recentf-list should already |
528 | ;; be absolute and normalised so I think this can just test whether | 517 | ;; be absolute and normalised so I think this can just test whether |
529 | ;; oldname is a prefix of the element. | 518 | ;; oldname is a prefix of the element. |
@@ -539,6 +528,7 @@ It's called 'require-private' for historical reasons." | |||
539 | ;; https://emacs.stackexchange.com/questions/33039/ | 528 | ;; https://emacs.stackexchange.com/questions/33039/ |
540 | 529 | ||
541 | (defun sort-setq () | 530 | (defun sort-setq () |
531 | "Sort a setq. Must be a defun." | ||
542 | (interactive) | 532 | (interactive) |
543 | (save-excursion | 533 | (save-excursion |
544 | (save-restriction | 534 | (save-restriction |
@@ -554,29 +544,32 @@ It's called 'require-private' for historical reasons." | |||
554 | (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record))))) | 544 | (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record))))) |
555 | 545 | ||
556 | (defun sort-setq-next-record () | 546 | (defun sort-setq-next-record () |
547 | "Sort the next record of a `setq' form." | ||
557 | (condition-case nil | 548 | (condition-case nil |
558 | (progn | 549 | (progn |
559 | (forward-sexp 1) | 550 | (forward-sexp 1) |
560 | (backward-sexp)) | 551 | (backward-sexp)) |
561 | ('scan-error (end-of-buffer)))) | 552 | ('scan-error (goto-char (point-max))))) |
562 | 553 | ||
563 | (defun sort-setq-end-record () | 554 | (defun sort-setq-end-record () |
555 | "Sort the end of a `setq' record." | ||
564 | (condition-case nil | 556 | (condition-case nil |
565 | (forward-sexp 2) | 557 | (forward-sexp 2) |
566 | ('scan-error (end-of-buffer)))) | 558 | ('scan-error (goto-char (point-max))))) |
567 | 559 | ||
568 | 560 | ||
569 | ;;; Crux tweaks | 561 | ;;; Crux tweaks |
570 | 562 | ||
571 | ;; `crux-other-window-or-switch-buffer' doesn't take an argument. | 563 | ;; `crux-other-window-or-switch-buffer' doesn't take an argument. |
572 | (defun acdw/other-window-or-switch-buffer (&optional arg) | 564 | (defun acdw/other-window-or-switch-buffer (&optional arg) |
573 | "Call `other-window' or switch buffers, depending on window count." | 565 | "Call `other-window' with ARG or switch buffers, depending on window count." |
574 | (interactive "P") | 566 | (interactive "P") |
575 | (if (one-window-p) | 567 | (if (one-window-p) |
576 | (switch-to-buffer nil) | 568 | (switch-to-buffer nil) |
577 | (other-window (or arg 1)))) | 569 | (other-window (or arg 1)))) |
578 | 570 | ||
579 | (defun acdw/other-window-or-switch-buffer-backward () | 571 | (defun acdw/other-window-or-switch-buffer-backward () |
572 | "Do `acdw/other-window-or-switch-buffer', but backward." | ||
580 | (interactive) | 573 | (interactive) |
581 | (acdw/other-window-or-switch-buffer -1)) | 574 | (acdw/other-window-or-switch-buffer -1)) |
582 | 575 | ||
@@ -584,8 +577,8 @@ It's called 'require-private' for historical reasons." | |||
584 | ;;; Auth-sources | 577 | ;;; Auth-sources |
585 | ;; https://github.com/emacs-circe/circe/wiki/Configuration | 578 | ;; https://github.com/emacs-circe/circe/wiki/Configuration |
586 | (defun acdw/fetch-password (&rest params) | 579 | (defun acdw/fetch-password (&rest params) |
587 | "Fetch a password from `auth-source'." | 580 | "Fetch a password from `auth-source' using PARAMS. |
588 | (require 'auth-source) | 581 | This function is internal. Use `acdw/make-password-fetcher' instead." |
589 | (let ((match (car (apply #'auth-source-search params)))) | 582 | (let ((match (car (apply #'auth-source-search params)))) |
590 | (if match | 583 | (if match |
591 | (let ((secret (plist-get match :secret))) | 584 | (let ((secret (plist-get match :secret))) |
@@ -595,7 +588,7 @@ It's called 'require-private' for historical reasons." | |||
595 | (message "Password not found for %S" params)))) | 588 | (message "Password not found for %S" params)))) |
596 | 589 | ||
597 | (defun acdw/make-password-fetcher (&rest params) | 590 | (defun acdw/make-password-fetcher (&rest params) |
598 | "Make a function that will fetch a password using `acdw/fetch-password'." | 591 | "Make a function that will call `acdw/fetch-password' with PARAMS." |
599 | (lambda (&rest _) | 592 | (lambda (&rest _) |
600 | (apply #'acdw/fetch-password params))) | 593 | (apply #'acdw/fetch-password params))) |
601 | 594 | ||