about summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
authorCase Duckworth2021-09-08 08:43:36 -0500
committerCase Duckworth2021-09-08 08:43:36 -0500
commit9ea6107997d2fb1ccb03175a9bb52da6f551a516 (patch)
treede58aa520122e5cd08c6104a72911b68f68a554b /lisp
parentAdd to TODO (diff)
parentblep (diff)
downloademacs-9ea6107997d2fb1ccb03175a9bb52da6f551a516.tar.gz
emacs-9ea6107997d2fb1ccb03175a9bb52da6f551a516.zip
Merge branch 'main' of tildegit.org:acdw/emacs
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw.el122
1 files changed, 65 insertions, 57 deletions
diff --git a/lisp/acdw.el b/lisp/acdw.el index 5bb53e2..1a7e7f2 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
@@ -103,24 +104,39 @@ FILENAME and CONFIRM are passed directly to `write-file'."
103 (write-file filename confirm)) 104 (write-file filename confirm))
104 (switch-to-buffer buf))) 105 (switch-to-buffer buf)))
105 106
107;; https://old.reddit.com/r/emacs/comments/pjwkts
108(defun acdw/goto-last-row ()
109 "Move point to last row of buffer, but save the column."
110 (interactive)
111 (let ((col (current-column)))
112 (goto-char (point-max))
113 (move-to-column col t)))
114
115(defun acdw/goto-first-row ()
116 "Move point to first row of buffer, but save the column."
117 (interactive)
118 (let ((col (current-column)))
119 (goto-char (point-min))
120 (move-to-column col t)))
121
106(defun dos2unix (buffer) 122(defun dos2unix (buffer)
107 "Replace \r\n with \n in BUFFER." 123 "Replace \r\n with \n in BUFFER."
108 (interactive "*b") 124 (interactive "*b")
109 (save-excursion 125 (save-excursion
110 (goto-char (point-min)) 126 (with-current-buffer buffer
111 (while (search-forward (string ?\C-m ?\C-j) nil t) 127 (goto-char (point-min))
112 (replace-match (string ?\C-j) nil t)))) 128 (while (search-forward (string ?\C-m ?\C-j) nil t)
113 129 (replace-match (string ?\C-j) nil t)))))
114(defun expand-file-name-exists-p (&rest expand-file-name-args) 130
115 "Call `expand-file-name' on EXPAND-FILE-NAME-ARGS, returning 131(defun expand-file-name-exists-p (&rest args)
116 its name if it exists, or NIL otherwise." 132 "Return `expand-file-name' ARGS if it exists, or nil."
117 (let ((file (apply #'expand-file-name expand-file-name-args))) 133 (let ((file (apply #'expand-file-name args)))
118 (if (file-exists-p file) 134 (if (file-exists-p file)
119 file 135 file
120 nil))) 136 nil)))
121 137
122(defun kill-region-or-backward-word (arg) 138(defun kill-region-or-backward-word (arg)
123 "Kill region if active, or backward word if not." 139 "If region is active, kill; otherwise kill word backward with ARG."
124 (interactive "p") 140 (interactive "p")
125 (if (region-active-p) 141 (if (region-active-p)
126 (kill-region (region-beginning) (region-end)) 142 (kill-region (region-beginning) (region-end))
@@ -129,19 +145,12 @@ FILENAME and CONFIRM are passed directly to `write-file'."
129 (backward-kill-word arg)))) 145 (backward-kill-word arg))))
130 146
131(defun unfill-buffer (&optional buffer-or-name) 147(defun unfill-buffer (&optional buffer-or-name)
148 "Unfill entire contents of BUFFER-OR-NAME."
132 (with-current-buffer (or buffer-or-name (current-buffer)) 149 (with-current-buffer (or buffer-or-name (current-buffer))
133 (save-excursion 150 (save-excursion
134 (save-restriction 151 (save-restriction
135 (unfill-region (point-min) (point-max)))))) 152 (unfill-region (point-min) (point-max))))))
136 153
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) 154(defun waterfall-list (car list rest)
146 "Cons CAR with each element in LIST in a waterfall fashion, end with REST. 155 "Cons CAR with each element in LIST in a waterfall fashion, end with REST.
147For use with the `with-eval-after-loads' function." 156For use with the `with-eval-after-loads' function."
@@ -156,7 +165,7 @@ For use with the `with-eval-after-loads' function."
156;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html 165;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html
157 166
158(defun uncomment-sexp (&optional n) 167(defun uncomment-sexp (&optional n)
159 "Uncomment a sexp around point." 168 "Uncomment N sexps around point."
160 (interactive "P") 169 (interactive "P")
161 (let* ((initial-point (point-marker)) 170 (let* ((initial-point (point-marker))
162 (inhibit-field-text-motion t) 171 (inhibit-field-text-motion t)
@@ -192,7 +201,7 @@ For use with the `with-eval-after-loads' function."
192 (>= (point) beg)) 201 (>= (point) beg))
193 (skip-chars-backward (rx (syntax expression-prefix))) 202 (skip-chars-backward (rx (syntax expression-prefix)))
194 (setq p (point-marker))) 203 (setq p (point-marker)))
195 ;; Re-comment everything before it. 204 ;; Re-comment everything before it.
196 (ignore-errors 205 (ignore-errors
197 (comment-region beg p)) 206 (comment-region beg p))
198 ;; And everything after it. 207 ;; And everything after it.
@@ -247,7 +256,7 @@ With a prefix argument N, (un)comment that many sexps."
247;; and https://github.com/alphapapa/unpackaged.el/issues/20 256;; and https://github.com/alphapapa/unpackaged.el/issues/20
248 257
249(defun sort-sexps (beg end &optional key) 258(defun sort-sexps (beg end &optional key)
250 "Sort sexps in region. 259 "Sort sexps between BEG and END.
251Comments stay with the code below. KEY is a function to sort by, 260Comments stay with the code below. KEY is a function to sort by,
252e.g. (lambda (sexp) (symbol-name (car sexp)))" 261e.g. (lambda (sexp) (symbol-name (car sexp)))"
253 (interactive "r") 262 (interactive "r")
@@ -301,8 +310,7 @@ e.g. (lambda (sexp) (symbol-name (car sexp)))"
301;;; Emacs configuration functions 310;;; Emacs configuration functions
302 311
303(defun emacs-git-pull-config (&optional remote branch) 312(defun emacs-git-pull-config (&optional remote branch)
304 "`git-pull' emacs configuration from REMOTE and BRANCH. 313 "`git-pull' Emacs' configuration from REMOTE and BRANCH.
305
306REMOTE defaults to 'origin', BRANCH to 'main'." 314REMOTE defaults to 'origin', BRANCH to 'main'."
307 (let ((remote (or remote "origin")) 315 (let ((remote (or remote "origin"))
308 (branch (or branch "main"))) 316 (branch (or branch "main")))
@@ -315,8 +323,8 @@ REMOTE defaults to 'origin', BRANCH to 'main'."
315 323
316(defun emacs-reload (&optional git-pull-first) 324(defun emacs-reload (&optional git-pull-first)
317 "Reload Emacs's configuration files. 325 "Reload Emacs's configuration files.
318 326With a prefix argument GIT-PULL-FIRST, run git pull on the repo
319With a prefix argument, run git pull on the repo first." 327first."
320 (interactive "P") 328 (interactive "P")
321 (when git-pull-first 329 (when git-pull-first
322 (emacs-git-pull-config)) 330 (emacs-git-pull-config))
@@ -344,10 +352,10 @@ With a prefix argument, run git pull on the repo first."
344 352
345;;; Specialized functions 353;;; Specialized functions
346 354
347(defun acdw/copy-region-plain (start end) 355(defun acdw/copy-region-plain (beg end)
348 "Copy a region to clipboard, removing all Org formatting." 356 "Copy a region from BEG to END to clipboard, removing all Org formatting."
349 (interactive "r") 357 (interactive "r")
350 (let ((s (buffer-substring-no-properties start end)) 358 (let ((s (buffer-substring-no-properties beg end))
351 (extracted-heading (when (derived-mode-p 'org-mode) 359 (extracted-heading (when (derived-mode-p 'org-mode)
352 (acdw/org-extract-heading-text)))) 360 (acdw/org-extract-heading-text))))
353 (with-temp-buffer 361 (with-temp-buffer
@@ -373,6 +381,7 @@ With a prefix argument, run git pull on the repo first."
373 nil) 381 nil)
374 382
375(defun acdw/org-extract-heading-text () 383(defun acdw/org-extract-heading-text ()
384 "Extract the heading text from an `org-mode' heading."
376 (let ((heading (org-no-properties (org-get-heading t t t t)))) 385 (let ((heading (org-no-properties (org-get-heading t t t t))))
377 (message 386 (message
378 (replace-regexp-in-string org-link-bracket-re 387 (replace-regexp-in-string org-link-bracket-re
@@ -397,16 +406,8 @@ if MAKE-DIRECTORY is non-nil."
397 file-name) 406 file-name)
398 dir))) 407 dir)))
399 408
400(defun acdw/find-emacs-dotfiles () 409(defun acdw/find-emacs-source () ;; doesn't work right now
401 "Finds lisp files in `user-emacs-directory' and passes them to 410 "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 411 (acdw/system
411 (:work (expand-file-name 412 (:work (expand-file-name
412 (concat "~/src/emacs-" emacs-version "/src"))) 413 (concat "~/src/emacs-" emacs-version "/src")))
@@ -423,18 +424,18 @@ if MAKE-DIRECTORY is non-nil."
423 (setq gc-cons-threshold (* 800 1024 1024) 424 (setq gc-cons-threshold (* 800 1024 1024)
424 gc-cons-percentage 0.1)) 425 gc-cons-percentage 0.1))
425 426
426(defun acdw/insert-iso-date (with-time) 427(defun acdw/insert-iso-date (arg)
427 "Insert the ISO-8601-formatted date, with optional time." 428 "Insert the ISO-8601-formatted date, optionally including time (pass ARG)."
428 (interactive "P") 429 (interactive "P")
429 (let ((format (if with-time "%FT%T%z" "%F"))) 430 (let ((format (if arg "%FT%T%z" "%F")))
430 (insert (format-time-string format (current-time))))) 431 (insert (format-time-string format (current-time)))))
431 432
432(defun acdw/kill-a-buffer (&optional prefix) 433(defun acdw/kill-a-buffer (&optional prefix)
433 "Kill a buffer based on the following rules: 434 "Kill this buffer, or other buffers, depending on PREFIX.
434 435
435C-x k => Kill CURRENT buffer and window 436\\[acdw/kill-a-buffer] : Kill CURRENT buffer and window
436C-u C-x k => Kill OTHER buffer and window 437\\[universal-argument] \\[acdw/kill-a-buffer] : Kill OTHER buffer and window
437C-u C-u C-x k => Kill ALL OTHER buffers and windows 438\\[universal-argument] \\[universal-argument] \\[acdw/kill-a-buffer] : Kill ALL OTHER buffers and windows
438 439
439Prompt only if there are unsaved changes." 440Prompt only if there are unsaved changes."
440 (interactive "P") 441 (interactive "P")
@@ -448,7 +449,7 @@ Prompt only if there are unsaved changes."
448 (delete-other-windows)))) 449 (delete-other-windows))))
449 450
450(defun acdw/sunrise-sunset (sunrise-command sunset-command) 451(defun acdw/sunrise-sunset (sunrise-command sunset-command)
451 "Run commands at sunrise and sunset." 452 "Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset."
452 (let* ((times-regex (rx (* nonl) 453 (let* ((times-regex (rx (* nonl)
453 (: (any ?s ?S) "unrise") " " 454 (: (any ?s ?S) "unrise") " "
454 (group (repeat 1 2 digit) ":" 455 (group (repeat 1 2 digit) ":"
@@ -510,12 +511,14 @@ It's called 'require-private' for historical reasons."
510 511
511;; Magic advice to rename entries in recentf when moving files in 512;; Magic advice to rename entries in recentf when moving files in
512;; dired. 513;; dired.
513(defun rjs/recentf-rename-notify (oldname newname &rest args) 514(defun rjs/recentf-rename-notify (oldname newname &rest _args)
515 "Magically rename files from OLDNAME to NEWNAME when moved in `dired'."
514 (if (file-directory-p newname) 516 (if (file-directory-p newname)
515 (rjs/recentf-rename-directory oldname newname) 517 (rjs/recentf-rename-directory oldname newname)
516 (rjs/recentf-rename-file oldname newname))) 518 (rjs/recentf-rename-file oldname newname)))
517 519
518(defun rjs/recentf-rename-file (oldname newname) 520(defun rjs/recentf-rename-file (oldname newname)
521 "Rename a file from OLDNAME to NEWNAME in `recentf-list'."
519 (setq recentf-list 522 (setq recentf-list
520 (mapcar (lambda (name) 523 (mapcar (lambda (name)
521 (if (string-equal name oldname) 524 (if (string-equal name oldname)
@@ -524,6 +527,7 @@ It's called 'require-private' for historical reasons."
524 recentf-list))) 527 recentf-list)))
525 528
526(defun rjs/recentf-rename-directory (oldname newname) 529(defun rjs/recentf-rename-directory (oldname newname)
530 "Rename directory from OLDNAME to NEWNAME in `recentf-list'."
527 ;; oldname, newname and all entries of recentf-list should already 531 ;; oldname, newname and all entries of recentf-list should already
528 ;; be absolute and normalised so I think this can just test whether 532 ;; be absolute and normalised so I think this can just test whether
529 ;; oldname is a prefix of the element. 533 ;; oldname is a prefix of the element.
@@ -539,6 +543,7 @@ It's called 'require-private' for historical reasons."
539;; https://emacs.stackexchange.com/questions/33039/ 543;; https://emacs.stackexchange.com/questions/33039/
540 544
541(defun sort-setq () 545(defun sort-setq ()
546 "Sort a setq. Must be a defun."
542 (interactive) 547 (interactive)
543 (save-excursion 548 (save-excursion
544 (save-restriction 549 (save-restriction
@@ -554,29 +559,32 @@ It's called 'require-private' for historical reasons."
554 (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record))))) 559 (sort-subr nil #'sort-setq-next-record #'sort-setq-end-record)))))
555 560
556(defun sort-setq-next-record () 561(defun sort-setq-next-record ()
562 "Sort the next record of a `setq' form."
557 (condition-case nil 563 (condition-case nil
558 (progn 564 (progn
559 (forward-sexp 1) 565 (forward-sexp 1)
560 (backward-sexp)) 566 (backward-sexp))
561 ('scan-error (end-of-buffer)))) 567 ('scan-error (goto-char (point-max)))))
562 568
563(defun sort-setq-end-record () 569(defun sort-setq-end-record ()
570 "Sort the end of a `setq' record."
564 (condition-case nil 571 (condition-case nil
565 (forward-sexp 2) 572 (forward-sexp 2)
566 ('scan-error (end-of-buffer)))) 573 ('scan-error (goto-char (point-max)))))
567 574
568 575
569;;; Crux tweaks 576;;; Crux tweaks
570 577
571;; `crux-other-window-or-switch-buffer' doesn't take an argument. 578;; `crux-other-window-or-switch-buffer' doesn't take an argument.
572(defun acdw/other-window-or-switch-buffer (&optional arg) 579(defun acdw/other-window-or-switch-buffer (&optional arg)
573 "Call `other-window' or switch buffers, depending on window count." 580 "Call `other-window' with ARG or switch buffers, depending on window count."
574 (interactive "P") 581 (interactive "P")
575 (if (one-window-p) 582 (if (one-window-p)
576 (switch-to-buffer nil) 583 (switch-to-buffer nil)
577 (other-window (or arg 1)))) 584 (other-window (or arg 1))))
578 585
579(defun acdw/other-window-or-switch-buffer-backward () 586(defun acdw/other-window-or-switch-buffer-backward ()
587 "Do `acdw/other-window-or-switch-buffer', but backward."
580 (interactive) 588 (interactive)
581 (acdw/other-window-or-switch-buffer -1)) 589 (acdw/other-window-or-switch-buffer -1))
582 590
@@ -584,8 +592,8 @@ It's called 'require-private' for historical reasons."
584;;; Auth-sources 592;;; Auth-sources
585;; https://github.com/emacs-circe/circe/wiki/Configuration 593;; https://github.com/emacs-circe/circe/wiki/Configuration
586(defun acdw/fetch-password (&rest params) 594(defun acdw/fetch-password (&rest params)
587 "Fetch a password from `auth-source'." 595 "Fetch a password from `auth-source' using PARAMS.
588 (require 'auth-source) 596This function is internal. Use `acdw/make-password-fetcher' instead."
589 (let ((match (car (apply #'auth-source-search params)))) 597 (let ((match (car (apply #'auth-source-search params))))
590 (if match 598 (if match
591 (let ((secret (plist-get match :secret))) 599 (let ((secret (plist-get match :secret)))
@@ -595,7 +603,7 @@ It's called 'require-private' for historical reasons."
595 (message "Password not found for %S" params)))) 603 (message "Password not found for %S" params))))
596 604
597(defun acdw/make-password-fetcher (&rest params) 605(defun acdw/make-password-fetcher (&rest params)
598 "Make a function that will fetch a password using `acdw/fetch-password'." 606 "Make a function that will call `acdw/fetch-password' with PARAMS."
599 (lambda (&rest _) 607 (lambda (&rest _)
600 (apply #'acdw/fetch-password params))) 608 (apply #'acdw/fetch-password params)))
601 609