path: root/lisp/acdw.el

:;;; 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

(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])."
  (dolist (assignment assignments)
    (customize-set-variable (car assignment)
			    (cadr assignment)
			    (if (and (caddr assignment)
				     (stringp (caddr assignment)))
				(caddr assignment)
			      "Customized by `acdw/set'."))))

;;; 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 (hooks funcs &optional depth local)
  "Add FUNCS to HOOKS.

Either HOOKS or FUNCS can be a list, in which case they're mapped
over to add all FUNCS to all HOOKS.  They can also be singletons,
in which case `acdw/hooks' acts pretty much like `add-hook'.

DEPTH and LOCAL apply to all HOOKS defined here.  If you need
more fine-grained control, just use `add-hook'."
  (let ((hooks (if (listp hooks) hooks (list hooks)))
	(funcs (if (listp funcs) funcs (list funcs)))
	(depth (if depth depth 0))
	(hook-list))
    (dolist (hook hooks)
      (dolist (func funcs)
	(push `(add-hook ',hook #',func ,depth ,local) hook-list)))
    `(progn
       ,@hook-list)))

(defmacro acdw/hooks-after (file hooks funcs &optional depth local)
  "Add FUNCS, from FILE, to HOOKS."
  (let ((funcs (if (listp funcs) funcs (list funcs)))
	(autoload-list))
    (dolist (func funcs)
      (add-to-list 'autoload-list `(autoload #',func ,file)))
    `(progn
       ,@autoload-list
       (acdw/hooks ,hooks ,funcs ,depth ,local))))

;;; 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'."
  (let ((after (when-let (sym (plist-get args :after))
		    (if (not (listp sym))
			(list sym)
		      sym)))
	(keymap (or (plist-get args :map) acdw/bind-default-map))
	(keycode (if (vectorp key) key (kbd key)))
	(command-list))
    (push `(define-key ,keymap ,keycode ',command) command-list)
    (when after
      (push `(autoload ',command ,@after) command-list))
    `(progn
       ,@command-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:

:now FORMS   .. run forms immediately.  
		Good for settings and auxiliary functions.
:then FORMS  .. run forms after loading PACKAGE, using `with-eval-after-load'.
:binds BINDS .. run `acdw/bind-after-map' on BINDS.
:hooks HOOKS .. run `acdw/hooks-after' on HOOKS."
  (declare (indent 1))
  (let ((now-forms (plist-get args :now))
	(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-after ,(symbol-name requirement) ,@hooks) final-form))
    (when binds
      (push `(acdw/bind-after-map ,(symbol-name requirement) nil ,binds)
	    final-form))
    (when now-forms
      (push `(progn ,@now-forms) final-form))
    (push `(straight-use-package ',package) 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 "-"))))