277 lines
11 KiB
EmacsLisp
277 lines
11 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)
|
|
|
|
;;; 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))
|
|
(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 +sunrise-sunset--encode (time)
|
|
"Encode diary-style time string into a time.
|
|
This is stolen from `run-at-time'."
|
|
(let ((hhmm (diary-entry-time time))
|
|
(now (decode-time)))
|
|
(encode-time (list 0 (% hhmm 100) (/ hhmm 100)
|
|
(decoded-time-day now)
|
|
(decoded-time-month now)
|
|
(decoded-time-year now)
|
|
nil -1
|
|
(decoded-time-zone now)))))
|
|
|
|
(defun +sunrise-sunset (sunrise-command sunset-command &optional reset)
|
|
"Run SUNRISE-COMMAND at sunrise, and SUNSET-COMMAND at sunset.
|
|
With RESET, this function will call itself with its own
|
|
arguments. That's really only useful within this function
|
|
itself."
|
|
(let* ((times-regex (rx (* nonl)
|
|
(: (any ?s ?S) "unrise") " "
|
|
(group (repeat 1 2 digit) ":"
|
|
(repeat 1 2 digit)
|
|
(: (any ?a ?A ?p ?P) (any ?m ?M)))
|
|
(* nonl)
|
|
(: (any ?s ?S) "unset") " "
|
|
(group (repeat 1 2 digit) ":"
|
|
(repeat 1 2 digit)
|
|
(: (any ?a ?A ?p ?P) (any ?m ?M)))
|
|
(* nonl)))
|
|
(ss (+suppress-messages #'sunrise-sunset))
|
|
(_m (string-match times-regex ss))
|
|
(sunrise (match-string 1 ss))
|
|
(sunset (match-string 2 ss))
|
|
(sunrise-time (+sunrise-sunset--encode sunrise))
|
|
(sunset-time (+sunrise-sunset--encode sunset)))
|
|
(cond
|
|
((time-less-p nil sunrise-time)
|
|
;; If it isn't sunrise yet, it's still dark---and so we need to run the
|
|
;; sunset-command.
|
|
(funcall sunset-command)
|
|
(run-at-time sunrise nil sunrise-command))
|
|
((time-less-p nil sunset-time)
|
|
;; If it isn't sunset yet, it's still light---so we need to run the
|
|
;; sunrise-command.
|
|
(funcall sunrise-command)
|
|
(run-at-time sunset nil sunset-command))
|
|
(t (run-at-time "12:00am" nil sunset-command)))
|
|
;; Reset everything at midnight
|
|
(unless reset
|
|
(run-at-time "12:00am" (* 60 60 24)
|
|
#'+sunrise-sunset sunrise-command sunset-command t))))
|
|
|
|
(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))
|
|
`(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))
|
|
(unwind-protect (progn (message "%s..." ,msg)
|
|
,@body)
|
|
(message "%s...done" ,msg)))))
|
|
|
|
(defun +mapc-some-buffers (func &optional predicate)
|
|
"Perform FUNC on all buffers satisfied by PREDICATE.
|
|
By default, act on all buffers.
|
|
|
|
PREDICATE is a function called with one argument, the current
|
|
buffer. FUNC is called with no arguments. Both are called
|
|
within a `with-current-buffer' form."
|
|
(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 buf)
|
|
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 ()
|
|
"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."
|
|
(interactive "*")
|
|
(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.
|
|
(while (and (not (looking-at "^$"))
|
|
(< (point) (point-max)))
|
|
(forward-line 1))
|
|
(newline)
|
|
(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)))))
|
|
|
|
(provide 'acdw)
|
|
;;; acdw.el ends here
|