355 lines
13 KiB
EmacsLisp
355 lines
13 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)))
|
|
|
|
;;; Garbage collection hacks
|
|
|
|
(defconst acdw/gc-cons-threshold-basis (* 800 1024 1024)
|
|
"Basis value for `gc-cons-threshold' to return to after jumping.
|
|
800 KB is Emacs's default.")
|
|
|
|
(defconst acdw/gc-cons-percentage-basis 0.1
|
|
"Basis value for `gc-cons-percentage' to return to after jumping.
|
|
0.1 is Emacs's default.")
|
|
|
|
(defun acdw/gc-disable ()
|
|
"Disable garbage collection by setting relevant variables to their maxima."
|
|
(setq gc-cons-threshold most-positive-fixnum
|
|
gc-cons-percentage 0.8))
|
|
|
|
(defun acdw/gc-enable ()
|
|
"Re-enable garbage collection by setting relevant variables back to bases."
|
|
(setq gc-cons-threshold acdw/gc-cons-threshold-basis
|
|
gc-cons-percentage acdw/gc-cons-percentage-basis))
|
|
|
|
;;; 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)))
|
|
|
|
;;; Reading mode
|
|
|
|
(define-minor-mode acdw/reading-mode
|
|
"A mode for reading."
|
|
:init-value t
|
|
:lighter " Read"
|
|
(if acdw/reading-mode
|
|
(progn ;; turn on
|
|
(display-fill-column-indicator-mode -1)
|
|
(dolist (mode '(visual-fill-column-mode
|
|
iscroll-mode))
|
|
(when (fboundp mode)
|
|
(funcall mode +1))))
|
|
;; turn off
|
|
(display-fill-column-indicator-mode +1)
|
|
(dolist (mode '(visual-fill-column-mode
|
|
iscroll-mode))
|
|
(when (fboundp mode)
|
|
(funcall mode -1)))))
|
|
|
|
;;; 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 "-"))))
|