about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw.el89
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
37When called without arguments, it returns `acdw/system'. When 39When called without arguments, it returns symbol `acdw/system'. When
38called with one (symbol) argument, it returns (eq acdw/system 40called with one (symbol) argument, it returns (eq acdw/system
39ARG). When called with multiple arguments or a list, it returns 41ARG). 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."
62is 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.
147For use with the `with-eval-after-loads' function." 141For 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.
251Comments stay with the code below. KEY is a function to sort by, 245Comments stay with the code below. KEY is a function to sort by,
252e.g. (lambda (sexp) (symbol-name (car sexp)))" 246e.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
306REMOTE defaults to 'origin', BRANCH to 'main'." 299REMOTE 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 311With a prefix argument GIT-PULL-FIRST, run git pull on the repo
319With a prefix argument, run git pull on the repo first." 312first."
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
435C-x k => Kill CURRENT buffer and window 421\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window
436C-u C-x k => Kill OTHER buffer and window 422\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window
437C-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
439Prompt only if there are unsaved changes." 425Prompt 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) 581This 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