From 2c72fd14cd1bdab0cd5bead7aad6b87e6f721dcd Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Mon, 8 Mar 2021 16:58:18 -0600 Subject: Add functions --- lisp/acdw.el | 116 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 114 insertions(+), 2 deletions(-) (limited to 'lisp') diff --git a/lisp/acdw.el b/lisp/acdw.el index 03e4a62..7f0145c 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -35,7 +35,7 @@ directory." (let ((f (expand-file-name (convert-standard-filename file) acdw/dir))) (when make-directory - (make-directory (file-name-directory) 'parents)) + (make-directory (file-name-directory file) 'parents)) f)) ;;; Settings @@ -45,7 +45,7 @@ directory." ASSIGNMENTS is a list where each element is of the form (VARIABLE VALUE [COMMENT])." - (dolist (assn assignments) + (dolist (assignment assignments) (customize-set-variable (car assignment) (cadr assignment) (if (and (caddr assignment) @@ -53,6 +53,118 @@ ASSIGNMENTS is a list where each element is of the form (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 + +;; XXX NOT WORKING +(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)))) + +(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))) + +;; Utilities +(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 "-")))) + +;;; 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 `read-kbd-macro'. + +The following keywords are recognized: + +:autoload 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 ((autoload (when-let (sym (plist-get args :autoload)) + (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 autoload + (push `(autoload ,command ,@autoload) command-list)) + `(progn + ,@command-list))) + +;; convenience +(defmacro acdw/bind-after-map (file keymap &rest bindings) + "Wrap multiple calls of `acdw/bind' after FILE and with KEYMAP. +KEYMAP can be nil." + (declare (indent 2)) + (let (bind-list) + (dolist (binding bindings) + (if keymap + (push `(acdw/bind ,@binding :after ,file :map ,keymap) bind-list) + (push `(acdw/bind ,@binding :after ,file) bind-list))) + `(progn + ,@bind-list))) + ;;; Keymap & Mode (defvar acdw/map (make-sparse-keymap) -- cgit 1.4.1-21-gabe81