315 lines
10 KiB
EmacsLisp
315 lines
10 KiB
EmacsLisp
:;;; acdw.el -*- lexical-binding: t; coding: utf-8-unix -*-
|
|
;; Author: Case Duckworth <acdw@acdw.net>
|
|
;; Created: Sometime during Covid-19, 2020
|
|
;; Keywords: configuration
|
|
;; URL: https://tildegit.org/acdw/emacs
|
|
|
|
;; This file is NOT part of GNU Emacs.
|
|
|
|
;;; License:
|
|
;; Everyone is permitted to do whatever with this software, without
|
|
;; limitation. This software comes without any warranty whatsoever,
|
|
;; but with two pieces of advice:
|
|
;; - Don't hurt yourself.
|
|
;; - Make good choices.
|
|
|
|
;;; Commentary:
|
|
;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life
|
|
;; functions for me, acdw.
|
|
|
|
;;; Code:
|
|
|
|
;;; Utilities
|
|
|
|
(defconst acdw/system (pcase system-type
|
|
('gnu/linux :home)
|
|
((or 'msdos 'windows-nt) :work)
|
|
(_ :other))
|
|
"Which system is currently being used.")
|
|
|
|
(defun acdw/when-unfocused (func &rest args)
|
|
"Call FUNC, with ARGS, iff all Emacs frames are out of focus.
|
|
|
|
Ready for use with `after-focus-change-function'."
|
|
(when (seq-every-p #'null (mapcar #'frame-focus-state (frame-list)))
|
|
(apply func args)))
|
|
|
|
(defun acdw/sunrise-sunset (sunrise-command sunset-command)
|
|
"Run commands at sunrise and sunset."
|
|
(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 (sunrise-sunset))
|
|
(_m (string-match times-regex ss))
|
|
(sunrise-time (match-string 1 ss))
|
|
(sunset-time (match-string 2 ss)))
|
|
(run-at-time sunrise-time (* 60 60 24) sunrise-command)
|
|
(run-at-time sunset-time (* 60 60 24) sunset-command)
|
|
(run-at-time "12:00am" (* 60 60 24) sunset-command)))
|
|
|
|
;;; Directories (think `no-littering')
|
|
|
|
(defvar acdw/dir (expand-file-name
|
|
(convert-standard-filename "var/")
|
|
user-emacs-directory)
|
|
"A directory to hold extra configuration and emacs data.")
|
|
|
|
(defun acdw/in-dir (file &optional make-directory)
|
|
"Expand FILE relative to `acdw/dir', optionally creating its
|
|
directory."
|
|
(let ((f (expand-file-name (convert-standard-filename file)
|
|
acdw/dir)))
|
|
(when make-directory
|
|
(make-directory (file-name-directory f) 'parents))
|
|
f))
|
|
|
|
;;; Settings
|
|
|
|
(defun acdw/set (assignments)
|
|
"Perform `customize-set-variable' on each of ASSIGNMENTS.
|
|
|
|
ASSIGNMENTS is a list where each element is of the form
|
|
(VARIABLE VALUE [COMMENT])."
|
|
(let (setting) ; for return value
|
|
(dolist (assignment assignments setting)
|
|
(customize-set-variable (car assignment)
|
|
(cadr assignment)
|
|
(if (and (caddr assignment)
|
|
(stringp (caddr assignment)))
|
|
(caddr assignment)
|
|
"Customized by `acdw/set'."))
|
|
(setq setting (car assignment)))))
|
|
|
|
;;; Faces
|
|
|
|
(defun acdw/set-face (face spec)
|
|
"Customize FACE according to SPEC, and register it with `customize'.
|
|
SPEC is as for `defface'."
|
|
(put face 'customized-face spec)
|
|
(face-spec-set face spec))
|
|
|
|
(defmacro acdw/set-faces (face-specs)
|
|
"Run `acdw/set-face' over each face in FACE-SPECS."
|
|
(let (face-list)
|
|
(dolist (face face-specs)
|
|
(push `(acdw/set-face ',(car face) ',(cdr face)) face-list))
|
|
`(progn
|
|
,@face-list)))
|
|
|
|
;;; Hooks
|
|
(defmacro acdw/hooks (hook-specs &rest args)
|
|
"Add functions to hooks, according to HOOK-SPECS.
|
|
|
|
Each HOOK-SPEC is of the following format: (HOOKS FUNCS [DEPTH] [LOCAL]).
|
|
Either HOOKS or FUNCS can also be a list, in which case `add-hook' is called
|
|
over the Cartesian product of HOOKS and FUNCS. In each HOOK-SPEC, DEPTH and
|
|
LOCAL apply to all hooks defined; if finer control is needed, either pass the
|
|
same hooks and functions in different HOOK-SPECs, or just use `add-hook'.
|
|
|
|
ARGS accept the following keywords:
|
|
|
|
:after FEATURE .. `autoload' all functions after FEATURE."
|
|
(let ((after (plist-get args :after))
|
|
(command-list))
|
|
(dolist (spec hook-specs)
|
|
(let* ((hooks (car spec))
|
|
(funcs (cadr spec))
|
|
(depth (or (caddr spec) 0))
|
|
(local (cadddr spec)))
|
|
(when (not (listp hooks)) (setq hooks (list hooks)))
|
|
(when (not (listp funcs)) (setq funcs (list funcs)))
|
|
(dolist (hook hooks)
|
|
(dolist (func funcs)
|
|
(push `(add-hook ',hook #',func ,depth ,local) command-list)
|
|
(when after
|
|
(push `(autoload #',func ,after) command-list))))))
|
|
`(progn
|
|
,@command-list)))
|
|
|
|
;;; Keybindings
|
|
|
|
(defvar acdw/bind-default-map 'acdw/map
|
|
"The default keymap to use with `acdw/bind'.")
|
|
|
|
(defmacro acdw/bind (key command &rest args)
|
|
"A simple key-binding macro to take care of the repetitive stuff
|
|
automatically.
|
|
|
|
If KEY is a vector, it's passed directly to `define-key',
|
|
otherwise it's wrapped in `kbd'.
|
|
|
|
The following keywords are recognized:
|
|
|
|
:after ARGS .. call `autoload' on COMMAND using ARGS before
|
|
binding the key. ARGS can be just the filename to
|
|
load; in that case it's wrapped in a list.
|
|
|
|
:map KEYMAP .. define KEY in KEYMAP instead of the
|
|
default `acdw/bind-default-map'. If `:after' is also supplied,
|
|
run `autoload' on KEYMAP (except when using `:map-after', see).
|
|
|
|
:map-after FILE .. run the underlying `define-key' command in an
|
|
`with-eval-after-load'. For the rare occasion when the keymap is
|
|
defined in a different file than the command it binds (looking
|
|
at you, `org-mode')."
|
|
(let ((after (when-let (sym (plist-get args :after))
|
|
(if (not (listp sym))
|
|
(list sym)
|
|
sym)))
|
|
(map-after (plist-get args :map-after))
|
|
(keymap (or (plist-get args :map) acdw/bind-default-map))
|
|
(keycode (if (vectorp key) key (kbd key)))
|
|
(command-list))
|
|
(let ((define-key-command `(define-key ,keymap ,keycode ',command)))
|
|
(if map-after
|
|
(push `(with-eval-after-load ,map-after
|
|
,define-key-command)
|
|
command-list)
|
|
(push define-key-command command-list)))
|
|
(when after
|
|
(unless (fboundp command)
|
|
(push `(autoload ',command ,@after) command-list))
|
|
(unless (or map-after
|
|
(eq keymap acdw/bind-default-map))
|
|
(push `(autoload ',keymap ,(car after) nil nil 'keymap) command-list)))
|
|
`(progn
|
|
,@command-list)))
|
|
|
|
(defmacro acdw/binds (bindings)
|
|
"Bind multiple keys at once."
|
|
(let (bind-list)
|
|
(dolist (bind bindings)
|
|
(push `(acdw/bind ,@bind) bind-list))
|
|
`(progn
|
|
,@bind-list)))
|
|
|
|
;; convenience
|
|
(defmacro acdw/bind-after-map (file keymap bindings)
|
|
"Wrap multiple calls of `acdw/bind' after FILE and with KEYMAP.
|
|
KEYMAP can be nil."
|
|
(declare (indent 2))
|
|
(let ((bind-list)
|
|
(extra-args (if keymap
|
|
`(:after ,file :map ,keymap)
|
|
`(:after ,file))))
|
|
(dolist (binding bindings)
|
|
(push `(acdw/bind ,@binding ,@extra-args) bind-list))
|
|
`(progn
|
|
,@bind-list)))
|
|
|
|
;;; Packages
|
|
|
|
(defmacro acdw/pkg (package &rest args)
|
|
"Set up a package using `straight.el'.
|
|
|
|
ARGS can include the following keywords:
|
|
|
|
:local BOOL .. if BOOL is non-nil, don't run `straight-use-package' on
|
|
PACKAGE. Good for using `acdw/pkg' on local features.
|
|
:require BOOL .. if BOOL is non-nil, run `require' on PACKAGE before anything.
|
|
:now FORMS .. run FORMS immediately.
|
|
:then FORMS .. run FORMS after loading PACKAGE, using `with-eval-after-load'.
|
|
:set SETTINGS .. pass SETTINGS to `acdw/set', right after `:now' forms.
|
|
SETTINGS should be properly quoted, just like they'd be passed
|
|
to the function.
|
|
:binds BINDS .. run `acdw/bind-after-map' on BINDS.
|
|
:hooks HOOKS .. run `acdw/hooks' on HOOKS."
|
|
(declare (indent 1))
|
|
(let ((local-pkg (plist-get args :local))
|
|
(require-pkg (plist-get args :require))
|
|
(now-forms (plist-get args :now))
|
|
(settings (plist-get args :set))
|
|
(binds (plist-get args :binds))
|
|
(hooks (plist-get args :hooks))
|
|
(then-forms (plist-get args :then))
|
|
(requirement (if (listp package)
|
|
(car package)
|
|
package))
|
|
(final-form))
|
|
(when then-forms
|
|
(push `(with-eval-after-load ',requirement ,@then-forms) final-form))
|
|
(when hooks
|
|
(push `(acdw/hooks ,hooks :after ,(symbol-name requirement)) final-form))
|
|
(when binds
|
|
(push `(acdw/bind-after-map ,(symbol-name requirement) nil ,binds)
|
|
final-form))
|
|
(when settings
|
|
(push `(acdw/set ,settings) final-form))
|
|
(when now-forms
|
|
(push `(progn ,@now-forms) final-form))
|
|
(unless local-pkg
|
|
(push `(straight-use-package ',package) final-form))
|
|
(when require-pkg
|
|
(push `(require ',requirement) final-form))
|
|
`(progn
|
|
,@final-form)))
|
|
|
|
;;; Keymap & Mode
|
|
|
|
(defvar acdw/map (make-sparse-keymap)
|
|
"A keymap for my custom bindings.")
|
|
|
|
(define-minor-mode acdw/mode
|
|
"A mode for `acdw/map'."
|
|
:init-value t
|
|
:lighter " acdw"
|
|
:keymap acdw/map)
|
|
(define-globalized-minor-mode acdw/global-mode acdw/mode acdw/mode)
|
|
|
|
;; Disable `acdw/mode' in the minibuffer
|
|
(defun acdw/mode--disable ()
|
|
"Disable `acdw/mode'."
|
|
(acdw/mode -1))
|
|
(add-hook 'minibuffer-setup-hook #'acdw/mode--disable)
|
|
|
|
;; Set up a leader key for `acdw/mode'
|
|
(defvar acdw/leader
|
|
(let ((map (make-sparse-keymap))
|
|
(c-z (global-key-binding "\C-z")))
|
|
(define-key acdw/map "\C-z" map)
|
|
(define-key map "\C-z" c-z)
|
|
map))
|
|
|
|
(provide 'acdw)
|
|
;;; acdw.el ends here
|
|
|
|
;;; Elephant graveyard
|
|
|
|
;; XXX NOT WORKING -- And is this even necessary?
|
|
;; (defmacro acdw/defun-hook (hook docstring &optional depth local &rest forms)
|
|
;; "Add FORMS to a function described by DOCSTRING, then add that
|
|
;; function to HOOK. DOCSTRING is converted to a function name by
|
|
;; calling `docstring-to-symbol', if it's a string, or used as-is
|
|
;; otherwise. The optional DEPTH and LOCAL are passed to
|
|
;; `add-hook', if they're present (i.e., not a list).
|
|
|
|
;; This macro aims to split the difference between the syntax of
|
|
;; lambdas in hooks and the ability to easily disable hooks."
|
|
;; (declare (indent 2))
|
|
;; (let ((name (if (stringp docstring)
|
|
;; (docstring-to-symbol docstring "hook-")
|
|
;; docstring)))
|
|
;; (when (listp local) (push local forms) (setq local nil))
|
|
;; (when (listp depth) (push depth forms) (setq depth 0))
|
|
;; `(progn
|
|
;; (defun ,name () ,@forms)
|
|
;; (add-hook ,hook #',name ,depth ,local))))
|
|
|
|
;; Utilities XXX related to `acdw/defun-hook'
|
|
;; (defun docstring-to-symbol (docstring &optional prefix)
|
|
;; "Convert a DOCSTRING to a symbol by lowercasing the string,
|
|
;; converting non-symbol-safe characters to '-', and calling
|
|
;; `intern'. Returns the created symbol."
|
|
;; (let ((str (split-string (downcase docstring) "[ \f\t\n\r\v'\"`,]+"
|
|
;; :omit-nulls)))
|
|
;; (when prefix (push prefix str))
|
|
;; (intern (mapconcat #'identity str "-"))))
|