379 lines
14 KiB
EmacsLisp
379 lines
14 KiB
EmacsLisp
;;; acdw.el --- various meta-whatevers -*- lexical-binding: t -*-
|
|
|
|
;;; Commentary:
|
|
|
|
;; What's that saying about how the hardest things in computer science
|
|
;; are naming and off-by-one errors? Well, the naming one I know very
|
|
;; well. I've been trying to figure out a good way to prefix my
|
|
;; bespoke functions, other stuff I found online, and various emacs
|
|
;; lisp detritus for quite some time (I reckon at over a year, as of
|
|
;; 2021-11-02). Finally, I found the answer in the writings of Daniel
|
|
;; Mendler: I'll prefix everything with a `+' !
|
|
|
|
;; To that end, pretty much everything in lisp/ will have a filename
|
|
;; like "+org.el", except of course this file, and maybe a few
|
|
;; /actually original/ libraries I haven't had the wherewithal to
|
|
;; package out properly yet.
|
|
|
|
;; Is it perfect? No. Is it fine? Yes. Here it is.
|
|
|
|
;;; Code:
|
|
|
|
(require 'diary-lib)
|
|
(require 'solar) ; for +sunrise-sunset
|
|
|
|
;;; Define a directory and an expanding function
|
|
|
|
(defmacro +define-dir (name directory &optional docstring inhibit-mkdir)
|
|
"Define a variable and function NAME expanding to DIRECTORY.
|
|
DOCSTRING is applied to the variable. Ensure DIRECTORY exists in
|
|
the filesystem, unless INHIBIT-MKDIR is non-nil."
|
|
(declare (indent 2)
|
|
(doc-string 3))
|
|
(unless inhibit-mkdir
|
|
(make-directory (eval directory) :parents))
|
|
`(progn
|
|
(defvar ,name ,directory
|
|
,(concat docstring (when docstring "\n")
|
|
"Defined by `/define-dir'."))
|
|
(defun ,name (file &optional mkdir)
|
|
,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n"
|
|
"If MKDIR is non-nil, the directory is created.\n"
|
|
"Defined by `/define-dir'.")
|
|
(let ((file-name (expand-file-name (convert-standard-filename file)
|
|
,name)))
|
|
(when mkdir
|
|
(make-directory (file-name-directory file-name) :parents))
|
|
file-name))))
|
|
|
|
(defun +suppress-messages (oldfn &rest args) ; from pkal
|
|
"Advice wrapper for suppressing `message'.
|
|
OLDFN is the wrapped function, that is passed the arguments
|
|
ARGS."
|
|
(let ((msg (current-message)))
|
|
(prog1
|
|
(let ((inhibit-message t))
|
|
(apply oldfn args))
|
|
(when msg
|
|
(message "%s" msg)))))
|
|
|
|
(defun +ensure-after-init (function)
|
|
"Ensure FUNCTION runs after init, or now if already initialized.
|
|
If Emacs is already started, run FUNCTION. Otherwise, add it to
|
|
`after-init-hook'. FUNCTION is called with no arguments."
|
|
(if after-init-time
|
|
(funcall function)
|
|
(add-hook 'after-init-hook function)))
|
|
|
|
(defmacro +with-ensure-after-init (&rest body)
|
|
"Ensure BODY forms run after init.
|
|
Convenience macro wrapper around `+ensure-after-init'."
|
|
(declare (indent 0) (debug (def-body)))
|
|
`(+ensure-after-init (lambda () ,@body)))
|
|
|
|
(defun +remember-prefix-arg (p-arg P-arg)
|
|
"Display prefix ARG, in \"p\" and \"P\" `interactive' types.
|
|
I keep forgetting how they differ."
|
|
(interactive "p\nP")
|
|
(message "p: %S P: %S" p-arg P-arg))
|
|
|
|
(defmacro +defvar (var value &rest _)
|
|
"Quick way to `setq' a variable from a `defvar' form."
|
|
(declare (doc-string 3) (indent 2))
|
|
`(setq ,var ,value))
|
|
|
|
(defmacro +with-message (message &rest body)
|
|
"Execute BODY, with MESSAGE.
|
|
If body executes without errors, MESSAGE...Done will be displayed."
|
|
(declare (indent 1))
|
|
(let ((msg (gensym)))
|
|
`(let ((,msg ,message))
|
|
(condition-case e
|
|
(progn (message "%s..." ,msg)
|
|
,@body)
|
|
(:success (message "%s...done" ,msg))
|
|
(t (signal (car e) (cdr e)))))))
|
|
|
|
(defun +mapc-some-buffers (func &optional predicate)
|
|
"Perform FUNC on all buffers satisfied by PREDICATE.
|
|
By default, act on all buffers.
|
|
|
|
Both PREDICATE and FUNC are called with no arguments, but within
|
|
a `with-current-buffer' form on the currently-active buffer."
|
|
(let ((pred (or predicate t)))
|
|
(dolist (buf (buffer-list))
|
|
(with-current-buffer buf
|
|
(when (if (or (eq (car-safe pred) 'closure)
|
|
(fboundp pred))
|
|
(funcall pred)
|
|
pred)
|
|
(funcall func))))))
|
|
|
|
;; https://github.com/cstby/emacs.d/blob/main/init.el#L67
|
|
(defun +clean-empty-lines (&optional begin end)
|
|
"Remove duplicate empty lines from BEGIN to END.
|
|
Called interactively, this function acts on the region, if
|
|
active, or else the entire buffer."
|
|
(interactive "*r")
|
|
(unless (region-active-p)
|
|
(setq begin (point-min)
|
|
end (save-excursion
|
|
(goto-char (point-max))
|
|
(skip-chars-backward "\n[:space:]")
|
|
(point))))
|
|
(save-excursion
|
|
(save-restriction
|
|
(narrow-to-region begin end)
|
|
(goto-char (point-min))
|
|
(while (re-search-forward "\n\n\n+" nil :move)
|
|
(replace-match "\n\n"))
|
|
;; Insert a newline at the end.
|
|
(goto-char (point-max))
|
|
(unless (or (buffer-narrowed-p)
|
|
(= (line-beginning-position) (line-end-position)))
|
|
(insert "\n")))))
|
|
|
|
(defun +open-paragraph (&optional arg)
|
|
"Open a paragraph after paragraph at point.
|
|
A paragraph is defined as continguous non-empty lines of text
|
|
surrounded by empty lines, so opening a paragraph means to make
|
|
three blank lines, then place the point on the second one.
|
|
|
|
Called with prefix ARG, open a paragraph before point."
|
|
;; TODO: Take an integer as ARG, allowing for skipping paragraphs up and down.
|
|
(interactive "*P")
|
|
;; TODO: add `+open-paragraph-ignore-modes'
|
|
(unless (derived-mode-p 'special-mode 'lui-mode 'comint-mode)
|
|
;; Go to next blank line. This /isn't/ `end-of-paragraph-text' because
|
|
;; that's weird with org, and I'm guessing other modes too.
|
|
(unless (looking-at "^$") (forward-line (if arg -1 +1)))
|
|
(while (and (not (looking-at "^$"))
|
|
(= 0 (forward-line (if arg -1 +1)))))
|
|
(newline)
|
|
(when arg (newline) (forward-line -2))
|
|
(delete-blank-lines)
|
|
(newline 2)
|
|
(previous-line)))
|
|
|
|
(defun +split-window-then (&optional where arg)
|
|
"Split the window into a new buffer.
|
|
With non-nil ARG (\\[universal-argument] interactively), don't
|
|
prompt for a buffer to switch to. This function will split the
|
|
window using `split-window-sensibly', or open the new window in
|
|
the direction specified by WHERE. WHERE is ignored when called
|
|
interactively; if you want specific splitting, use
|
|
`+split-window-right-then' or `+split-window-below-then'."
|
|
(interactive "i\nP")
|
|
;; TODO: Canceling at the switching phase leaves the point in the other
|
|
;; window. Ideally, the user would see this as one action, meaning a cancel
|
|
;; would return to the original window.
|
|
(pcase where
|
|
;; These directions are 'backward' to the OG Emacs split-window commands,
|
|
;; because by default Emacs leaves the cursor in the original window. Most
|
|
;; users probably expect a switch to the new window, at least I do.
|
|
((or 'right :right) (split-window-right) (other-window 1))
|
|
((or 'left :left) (split-window-right))
|
|
((or 'below :below) (split-window-below) (other-window 1))
|
|
((or 'above :above) (split-window-below))
|
|
((pred null)
|
|
(or (split-window-sensibly)
|
|
(if (< (window-height) (window-width))
|
|
(split-window-below)
|
|
(split-window-right)))
|
|
(other-window 1))
|
|
(_ (user-error "Unknown WHERE paramater: %s" where)))
|
|
(unless arg
|
|
(condition-case nil
|
|
(call-interactively
|
|
(pcase (read-char "(B)uffer or (F)ile?")
|
|
(?b (if (fboundp #'consult-buffer)
|
|
#'consult-buffer
|
|
#'switch-to-buffer))
|
|
(?f #'find-file)
|
|
(_ #'ignore)))
|
|
(quit (delete-window)))))
|
|
|
|
(defun +split-window-right-then (&optional arg)
|
|
"Split window right, then prompt for a new buffer.
|
|
With optional ARG (\\[universal-argument]), just split."
|
|
(interactive "P")
|
|
(+split-window-then :right arg))
|
|
|
|
(defun +split-window-below-then (&optional arg)
|
|
"Split window below, then prompt for a new buffer.
|
|
With optional ARG (\\[universal-argument]), just split."
|
|
(interactive "P")
|
|
(+split-window-then :below arg))
|
|
|
|
(defun +bytes (number unit)
|
|
"Convert NUMBER UNITs to bytes.
|
|
UNIT can be one of :kb, :mb, :gb, :tb, :pb, :eb, :zb, :yb; :kib, :mib, :gib,
|
|
:tib, :pib, :eib, :zib, :yib."
|
|
(* number (pcase unit
|
|
;; Base 10 units
|
|
(:kb 1000)
|
|
(:mb (* 1000 1000))
|
|
(:gb (* 1000 1000 1000))
|
|
(:tb (* 1000 1000 1000 1000))
|
|
(:pb (* 1000 1000 1000 1000 1000))
|
|
(:eb (* 1000 1000 1000 1000 1000 1000))
|
|
(:zb (* 1000 1000 1000 1000 1000 1000 1000))
|
|
(:yb (* 1000 1000 1000 1000 1000 1000 1000 1000))
|
|
;; Base 2 units
|
|
(:kib 1024)
|
|
(:mib (* 1024 1024))
|
|
(:gib (* 1024 1024 1024))
|
|
(:tib (* 1024 1024 1024 1024))
|
|
(:pib (* 1024 1024 1024 1024 1024))
|
|
(:eib (* 1024 1024 1024 1024 1024 1024))
|
|
(:zib (* 1024 1024 1024 1024 1024 1024 1024))
|
|
(:yib (* 1024 1024 1024 1024 1024 1024 1024 1024)))))
|
|
|
|
;;; Font lock TODO keywords
|
|
|
|
(defcustom font-lock-todo-keywords '("TODO" "XXX" "FIXME" "BUG")
|
|
"Keywords to highlight with `font-lock-todo-face'.")
|
|
|
|
(defface font-lock-todo-face '((t :inherit font-lock-comment-face
|
|
:background "yellow"))
|
|
;; TODO: XXX: FIXME: BUG: testing :)
|
|
"Face for TODO keywords.")
|
|
|
|
(defun font-lock-todo-insinuate ()
|
|
(let ((keyword-regexp
|
|
(rx bow (group (eval (let ((lst '(or)))
|
|
(dolist (kw font-lock-todo-keywords)
|
|
(push kw lst))
|
|
(nreverse lst))))
|
|
":")))
|
|
(font-lock-add-keywords
|
|
nil
|
|
`((,keyword-regexp 1 'font-lock-todo-face prepend)))))
|
|
|
|
;; I don't use this much but I always forget the exact implementation, so this
|
|
;; is more to remember than anything else.
|
|
(defmacro setc (&rest vars-and-vals)
|
|
"Set VARS-AND-VALS by customizing them or using set-default.
|
|
Use like `setq'."
|
|
`(progn ,@(cl-loop for (var val) on vars-and-vals by #'cddr
|
|
if (null val) return (user-error "Not enough arguments")
|
|
collecting `(funcall (or (get ',var 'custom-get)
|
|
#'set-default)
|
|
',var ',val)
|
|
into ret
|
|
finally return ret)))
|
|
|
|
(defun +set-faces (specs)
|
|
"Set fonts to SPECS.
|
|
Specs is an alist: its cars are faces and its cdrs are the plist
|
|
passed to `set-face-attribute'. Note that the FRAME argument is
|
|
always nil; this function is mostly intended for use in init."
|
|
(dolist (spec specs)
|
|
(apply #'set-face-attribute (car spec) nil (cdr spec))))
|
|
|
|
(defcustom chat-functions '(+irc
|
|
jabber-connect-all
|
|
slack-start)
|
|
"Functions to start when calling `chat'."
|
|
:type '(repeat function)
|
|
:group 'applications)
|
|
|
|
(defun chat-disconnect ()
|
|
"Disconnect from all chats."
|
|
(interactive)
|
|
(+with-progress "Quitting circe..."
|
|
(ignore-errors
|
|
(circe-command-GQUIT "☮ 🫀 🍞")
|
|
(cancel-timer (irc-connection-get conn :flood-timer))))
|
|
(+with-progress "Quitting jabber..."
|
|
(ignore-errors
|
|
(jabber-disconnect)))
|
|
(+with-progress "Quitting-slack..."
|
|
(dolist (team +slack-teams)
|
|
(ignore-errors
|
|
(slack-team-disconnect team)))
|
|
(ignore-errors (slack-ws-close)))
|
|
(+with-progress "Killing buffers..."
|
|
(ignore-errors
|
|
(+mapc-some-buffers (lambda () "Remove the buffer from tracking and kill it unconditionally."
|
|
(let ((kill-buffer-query-functions nil))
|
|
(tracking-remove-buffer (current-buffer))
|
|
(kill-buffer)))
|
|
(lambda () "Return t if derived from the following modes."
|
|
(derived-mode-p 'lui-mode
|
|
'jabber-chat-mode
|
|
'jabber-roster-mode
|
|
'jabber-browse-mode
|
|
'slack-mode))))))
|
|
|
|
;; I can never remember all the damn chat things I run, so this just does all of em.
|
|
(defun chat (&optional arg)
|
|
"Initiate all chat functions.
|
|
With optional ARG, kill all chat-related buffers first."
|
|
(interactive "P")
|
|
(when arg (chat-disconnect))
|
|
(dolist-with-progress-reporter (fn chat-functions)
|
|
"Connecting to chat..."
|
|
(call-interactively fn)))
|
|
|
|
(defun +forward-paragraph (arg)
|
|
"Move forward ARG (simple) paragraphs.
|
|
A paragraph here is simply defined: it's a block of buffer that's
|
|
separated from others by two newlines."
|
|
(interactive "p")
|
|
(let ((direction (/ arg (abs arg))))
|
|
(forward-line direction)
|
|
(while (not (or (bobp)
|
|
(eobp)
|
|
(= arg 0)))
|
|
(if (looking-at "^[ \f\t]*$")
|
|
(setq arg (- arg direction))
|
|
(forward-line direction)))))
|
|
|
|
(defun +backward-paragraph (arg)
|
|
"Move backward ARG (simple) paragraphs.
|
|
See `+forward-paragraph' for the behavior."
|
|
(interactive "p")
|
|
(+forward-paragraph (- arg)))
|
|
|
|
(defun +concat (&rest strings)
|
|
"Concat STRINGS separated by SEPARATOR.
|
|
Each item in STRINGS is either a string or a list or strings,
|
|
which is concatenated without any separator.
|
|
|
|
SEPARATOR defaults to the newline (\\n)."
|
|
(let (ret
|
|
;; I don't know why a `cl-defun' with
|
|
;; (&rest strings &key (separator "\n")) doesn't work
|
|
(separator (or (cl-loop for i from 0 upto (length strings)
|
|
if (eq (nth i strings) :separator)
|
|
return (nth (1+ i) strings))
|
|
"\n")))
|
|
(while strings
|
|
(let ((string (pop strings)))
|
|
(cond ((eq string :separator) (pop strings))
|
|
((listp string) (push (apply #'concat string) ret))
|
|
((stringp string) (push string ret)))))
|
|
(mapconcat #'identity (nreverse ret) separator)))
|
|
|
|
(defun +file-string (file)
|
|
"Fetch the contents of FILE and return its string."
|
|
(with-current-buffer (find-file-noselect file)
|
|
(buffer-string)))
|
|
|
|
(defmacro +with-progress (pr-args &rest body)
|
|
"Perform BODY wrapped in a progress reporter.
|
|
PR-ARGS is the list of arguments to pass to
|
|
`make-progress-reporter'; it can be a single string for the
|
|
message, as well. If you want to use a formatted string, wrap
|
|
the `format' call in a list."
|
|
(declare (indent 1))
|
|
(let ((reporter (gensym))
|
|
(pr-args (if (listp pr-args) pr-args (list pr-args))))
|
|
`(let ((,reporter (make-progress-reporter ,@pr-args)))
|
|
(prog1 (progn ,@body)
|
|
(progress-reporter-done ,reporter)))))
|
|
|
|
(provide 'acdw)
|
|
;;; acdw.el ends here
|