;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- ;; by C. Duckworth (provide 'acdw) (require 'cl-lib) ;;; Define both a directory and a function expanding to a file in that directory (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) (doc-string 3)) (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)))) ;;; Convenience functions (defun define-keys (maps &rest keydefs) "Define KEYDEFS in MAPS. Convenience wrapper around `define-key'." (unless (zerop (mod (length keydefs) 2)) (user-error "Wrong number of arguments: %S" (length keydefs))) (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) (list maps) maps)) (cl-loop for (key def) on keydefs by #'cddr do (let ((key (if (stringp key) (kbd key) key))) (define-key (if (symbolp map) (symbol-value map) map) key def))))) (unless (fboundp 'ensure-list) ;; Just in case we're using an old version of Emacs. (defun ensure-list (object) "Return OBJECT as a list. If OBJECT is already a list, return OBJECT itself. If it's not a list, return a one-element list containing OBJECT." (if (listp object) object (list object)))) (defun add-to-list* (lists &rest things) "Add THINGS to LISTS. LISTS can be one list variable or a list. Each thing of THINGS can be either a variablel (the thing), or a list of the form (ELEMENT &optional APPEND COMPARE-FN), which is passed to `add-to-list'." (dolist (l (ensure-list lists)) (dolist (thing things) (apply #'add-to-list l (ensure-list thing))))) (defun add-hook* (hooks &rest functions) "Add FUNCTIONS to HOOKS. Each function in FUNCTIONS can be a singleton or a list of the form (FUNCTION &optional DEPTH LOCAL)." (dolist (hook (ensure-list hooks)) (dolist (fn functions) (apply #'add-hook hook (ensure-list fn))))) ;;; Convenience macros (defmacro setq-local-hook (hook &rest args) "Run `setq-local' on ARGS when running HOOK." (declare (indent 1)) (let ((fn (intern (format "%s-setq-local" hook)))) (when (and (fboundp fn) (functionp fn)) (setq args (append (function-get fn 'setq-local-hook-settings) args))) (unless (and (< 0 (length args)) (zerop (mod (length args) 2))) (user-error "Wrong number of arguments: %S" (length args))) `(progn (defun ,fn () ,(format "Set local variables after `%s'." hook) (setq-local ,@args)) (function-put ',fn 'setq-local-hook-settings ',args) (add-hook ',hook #',fn)))) (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)) (condition-case e (progn (message "%s..." ,msg) ,@body) (:success (message "%s...done" ,msg)) (t (signal (car e) (cdr e)))))))