Skip to content

Instantly share code, notes, and snippets.

@karlbright

karlbright/wad.el

Last active January 29, 2021 03:02
Show Gist options
  • Save karlbright/d1cfc541a950f0bfb6189a88f9350868 to your computer and use it in GitHub Desktop.
Save karlbright/d1cfc541a950f0bfb6189a88f9350868 to your computer and use it in GitHub Desktop.
Download ZIP
Raw
wad.el
;;; wad.el --- Bring your own modules -*- lexical-binding: t; -*-
;; Copyright (C) 2020-2021 Karl Brightman
;; Author: Karl Brightman <karl@karlbright.org>
;; Maintainer: Karl Brightman <karl@karlbright.org>
;; Created: 13 December 2020
;; Version: 0.0.1
;; URL: https://github.com/karlbright/wad.el
;; This is free and unencumbered software released into the public domain.
;; Anyone is free to copy, modify, publish, use, compile, sell, or
;; distribute this software, either in source code form or as a compiled
;; binary, for any purpose, commercial or non-commercial, and by any
;; means.
;; In jurisdictions that recognize copyright laws, the author or authors
;; of this software dedicate any and all copyright interest in the
;; software to the public domain. We make this dedication for the benefit
;; of the public at large and to the detriment of our heirs and
;; successors. We intend this dedication to be an overt act of
;; relinquishment in perpetuity of all present and future rights to this
;; software under copyright law.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
;; EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF
;; MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.
;; IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR
;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;; OTHER DEALINGS IN THE SOFTWARE.
;; For more information, please refer to <https://unlicense.org>
;;; Commentary:
;; wad.el is an opinionated emacs configuration library. There are
;; already enough of these out there, but like many people out there,
;; I enjoy digging into what makes emacs configurations tick and trying
;; to craft my own personal emacs environment. I really enjoyed looking
;; into the fantastic Doom Emacs from Henrik Lissner, and highly
;; recommend it to anyone looking to get started with Emacs. The work
;; done by Henrik and others to ensure that your environment feels fast,
;; loads quickly, and can be customised is fantastic. It has served as
;; the inspiration for the majority of what wad.el provides. Including
;; the name.
;; The idea behind wad.el is simple. Understand and implement a version
;; of the modules structure used within Doom Emacs and provide that
;; functionality for people to use within their own bootstrapped emacs
;; configurations/frameworks/etc.
;; To be clear, when I say that wad.el is inspired by Doom Emacs. I
;; really do mean it. This project has acted as an exercise for me to
;; write and learn Emacs Lisp a little better and feel better about
;; writing my own packages, instead of hoping that someone out there
;; has decided that their customisation to a package are exactly the
;; same as what I would wish for.
;; There are some differences to what wad.el aims to do compared to
;; what Doom Emacs does out of the box. Most important of these is the
;; process of using `doom sync' etc via CLI to handle the package
;; installation and configuration process. wad.el is much more
;; "traditional" in the sense of running these steps when emacs is
;; started, regardless of if the session is interactive or not.
;; Please see https://github.com/karlbright/wad.el for more information.
;;; Code:
;; To see the outline of this file, run M-x outline-minor-mode and
;; then press C-c @ C-t. To also show the top-level functions and
;; variable declarations in each section, run M-x occur with the
;; following query: ^;;;;* \|^(
;; An effort has been made to follow the Emacs Lisp Style Guide
;; found at https://github.com/bbatsov/emacs-lisp-style-guide.
;;;; Libraries
(require 'cl-lib)
(require 'subr-x)
;;;; State
(defconst wad-version "0.0.1"
"Current version of wad.el")
(defvar wad-init-p nil
"Non-nil if wad.el has been initialised.")
(defconst wad-interactive-p (not noninteractive)
"If non-nil, Emacs is in interactive mode.")
(defvar wad-debug-p (or t (getenv-internal "DEBUG") init-file-debug)
"If non-nil, Emacs is in interactive mode.")
(defconst wad-mac-p (eq system-type 'darwin))
(defconst wad-linux-p (eq system-type 'gnu/linux))
(defconst wad-windows-p (memq system-type '(cygwin windows-nt ms-dos)))
(defconst wad-bsd-p (or wad-mac-p (eq system-type 'berkeley-unix)))
(defconst wad-inhibit-alias-functions nil
"If non-nil, wad.el will alias `wad-package!' to `package!'")
;;;; Custom Error Types
(define-error 'wad-error "Error in wad.el")
;;;; Directory Variables
(defconst wad-base-directory user-emacs-directory
"The base for `wad.el' directory variables. Must end with a slash.")
(defconst wad-local-directory (concat wad-base-directory "local/")
"Root directory for local storage. Used primarily for this systems installation of Emacs.")
(defconst wad-etc-directory (concat wad-local-directory "etc/")
"Directory for non-volatile local storage.")
(defconst wad-cache-directory (concat wad-local-directory "cache/")
"Directory for volatile local storage.")
(defvar wad-modules-directories ()
"A list of directories to search for modules in. Ordered by priority.")
;;;; Hooks
(defvar wad-first-input-hook nil
"Transient hooks run before first user input.")
(defvar wad-first-file-hook nil
"Transient hooks run before the first interactively opened file.")
(defvar wad-first-buffer-hook nil
"Transient hooks run before the first interatctively opened buffer.")
(defvar wad-interface-hook nil
"List of hooks to run when interface has been initialized.")
(defvar wad-before-hook nil
"List of hooks to run before wad.el has started it's work.")
(defvar wad-after-hook nil
"List of hooks to run once wad.el has completed it's work.")
(defvar wad-modules-before-init-hook nil
"A list of hooks to run before all module `wad-init-file' files are
loaded.")
(defvar wad-modules-after-init-hook nil
"A list of hooks to run after all module `wad-init-file' files are
loaded.")
(defvar wad-modules-before-init-packages-hook nil
"A list of hooks to run before all module `wad-package-file' filebs are
loaded.")
(defvar wad-modules-after-init-packages-hook nil
"A list of hooks to run after all module `wad-package-file' files are
loaded.")
(defvar wad-modules-before-ensure-packages-hook nil
"A list of hooks to run before all module packages are checked, and if
they do not exist, installed.")
(defvar wad-modules-after-ensure-packages-hook nil
"A list of hooks to run after all module packages are checked, and if
they do not exist, installed.")
(defvar wad-modules-before-config-hook nil
"A list of hooks to run before all modules `wad-config-file' files are
loaded.")
(defconst wad-modules-after-config-hook nil
"A list of hooks to run after all modules `wad-config-file' files are
loaded.")
(define-error 'wad-hook-error "Error running wad hook" 'wad-error)
(defvar wad--transient-counter 0)
;;; Public hook functions
(defmacro wad-add-transient-hook! (hook-or-function &rest forms)
"Attach a self-removing function to HOOK-OR-FUNCTION.
Forms are evaluated once, when that function/hook is first invoked,
then never again.
HOOK-OR-FUNCTION can be a quoted hooks or a sharp-quoted function,
which will be advised."
(declare (indent 1))
(let ((append (if (eq (car forms) :after) (pop forms)))
(fn (intern (format "wad--transient-%d-h"
(cl-incf wad--transient-counter)))))
`(let ((sym ,hook-or-function))
(defun ,fn (&rest _)
,(format "Transient hook for %S"
(wad--unquote hook-or-function))
,@forms
(let ((sym ,hook-or-function))
(cond ((functionp sym) (advice-remove sym #',fn))
((symbolp sym) (remove-hook sym #',fn))))
(unintern ',fn nil))
(cond ((functionp sym)
(advice-add ,hook-or-function
,(if append :after :before)
#',fn))
((symbolp sym)
(put ',fn 'permanent-local-hook t)
(add-hook sym #',fn ,append))))))
(defmacro wad-add-hook! (hooks &rest rest)
"A convenience macro for adding N functiosn to M hooks.
This macro accepts, in order:
1. The mode(s) or hook(s) to add to. This is either an unquoted mode, an
unquoted list of modes, a quoted hook variable or a quoted list of hook
variables.
2. Optional properties :local and/or :append, which will make the hook
buffer-local or append to the list of hooks (respectively),
3. The function(s) to be added: this can be one function, a quoted list
thereof, a list of `defun's, or body forms (implicitly wrapped in a
lambda).
\(fn HOOKS [:append :local] FUNCTIONS)"
(declare (indent (lambda (indent-point state)
(goto-char indent-point)
(when (looking-at-p "\\s-*(")
(lisp-indent-defform state indent-point))))
(debug t))
(let* ((hook-forms (wad--resolve-hook-forms hooks))
(func-forms ())
(defn-forms ())
append-p
local-p
remove-p
forms)
(while (keywordp (car rest))
(pcase (pop rest)
(:append (setq append-p t))
(:local (setq local-p t))
(:remove (setq remove-p t))))
(let ((first (car-safe (car rest))))
(cond ((null first)
(setq func-forms rest))
((eq first 'defun)
(setq func-forms (mapcar #'cadr rest)
defn-forms rest))
((memq first '(quote function))
(setq func-forms
(if (cdr rest)
(mapcar #'wad--unquote rest)
(wad--ensure-list (wad--unquote (car rest))))))
((setq func-forms (list `(lambda (&rest _) ,@rest)))))
(dolist (hook hook-forms)
(dolist (func func-forms)
(push (if remove-p
`(remove-hook ',hook #',func ,local-p)
`(add-hook ',hook #',func ,append-p ,local-p))
forms)))
(macroexp-progn
(append defn-forms
(if append-p
(nreverse forms)
forms))))))
;;; Private hook helpers
(defun wad--try-run-hook (hook)
"Run HOOK (a hook function) with better error handling.
Meant to be used with `run-hook-wrapped'."
(wad--log "Running hook: %s" hook)
(condition-case e
(funcall hook)
((debug error)
(signal 'wad-hook-error (list hook e))))
nil)
(defun wad--resolve-hook-forms (hooks)
"Converts a list of modes into a list of hook symbols.
If a mode is quoted, it is left as is. If the entire HOOKS list is
quoted, the list is returned as-is."
(declare (pure t) (side-effect-free t))
(let ((hook-list (wad--ensure-list (wad--unquote hooks))))
(if (eq (car-safe hooks) 'quote)
hook-list
(cl-loop for hook in hook-list
if (eq (car-safe hook) 'quote)
collect (cadr hook)
else collect (intern (format "%s-hook" (symbol-name hook)))))))
;;;; Modules
;; wad.el is based around the idea of bundling related packages,
;; configuration, and commands. Allowing the user to enable or disable
;; units as they wish. A module consists of at least one or more of the
;; following files:
;; - packages.el: Declares the packages associated with the
;; module. These packages should only be initialised and configured
;; via the module they are defined in. See `Packages' for more
;; information on how packages are declared, along with the keywords
;; available for use.
;; - init.el: Acts similarly to the `:init' keyword in something
;; like `use-package'. Used to execute code before a module and it's
;; associated packages are loaded, and configured.
;; - config.el: Used to execute code after a modules packages have
;; been loaded. Similar to the `:config' keyword found in
;; `use-package'.
(defvar wad-modules (make-hash-table :test 'equal)
"A table of enabled modules being handled by wad.el.
It is highly discouraged to mutate wad-modules directly, and should
only be used via the associated `wad-modules-set' and
`wad-modules-get' functions.
The key is a cons of (category . module) and the value is a plist of
metadata related to the module.")
(defvar wad-modules-init-p ()
"List of initialised modules.")
(defvar wad-modules-ensure-packages-p ()
"List of modules whose packages have been installed.")
(defvar wad-modules-config-p ()
"List of configured modules.")
(defvar wad-module-init-file "init"
"Basename of init file for a module.")
(defvar wad-module-config-file "config"
"Basename of config file for a module.")
(defvar wad--current-module nil)
(define-error 'wad-modules-error "Error in wad.el modules" 'wad-error)
(define-error 'wad-module-error "Error in wad.el module" 'wad-error)
;;; Public Accessors
(defmacro wad! (&rest modules)
"Bootstrap wad.el modules.
If the first item in MODULES doesn't satisfy `keywordp', MODULES is
evaluated, otherwise, MODULES is a multiple-property list.
The bootstrap process involves:
- Adding each module to `wad-modules', replacing any existing module
matching the same name.
- Check if a module has a `packages.el' provided. If so, then
evaulate the package declarations provided. Linking the packages to
the modules they were defined in. This ensures that future modules can
use predicate functions correctly.
- Initialise the modules in the order they were provided to
`wad!'. This ensures that any predicate used in other modules will be
correctly evaluated based on it's previous modules etc. Note, that if
a predicate is used as part of the module `init.el', that it should
not assume a package is installed at this point.
- Ensure that the packages declared at correctly installed and
available to the modules and user.
- Finally, if a module has a provided `config.el' then ensure we
load and evaluate the file for any module configuration.
Module load order is determined by your `wad!' block. Order defines
precedence (from most to least)."
`(progn
(run-hook-wrapped 'wad-before-hook #'wad--try-run-hook)
(wad--modules-list-map
(lambda (category module &rest plist)
(if (plist-member plist :path)
(apply #'wad-module-set category module plist)
(wad--log "Skipping missing module %s/%s" category module)))
,@(if (keywordp (car modules))
(list (list 'quote modules))
modules))
(wad--module-step! init)
(wad--module-step! init-packages)
(wad--module-step! ensure-packages)
(wad--module-step! config)
(run-hook-wrapped 'wad-after-hook #'wad--try-run-hook)))
(defun wad-module-get (category module &optional property)
(declare (pure t) (side-effect-free t))
(when-let ((key (wad--module-key category module))
(plist (gethash key wad-modules)))
(if property
(plist-get plist property)
plist)))
(defun wad-module-set (category module &rest plist)
"Adds a module by adding it to `wad-modules'.
CATEGORY is a keyword, MODULE is a symbol, and PLIST is a plist that
accepts the following properties:
:path [STRING] path to category root directory"
(let ((key (wad--module-key category module)))
(puthash key plist wad-modules)))
(defun wad-module-init-packages (category module &rest plist)
"Loads `wad-packages-file' for given module with CATEGORY and MODULE."
(funcall (wad--module-file-loader wad-packages-file)
category module plist))
(defun wad-module-init (category module &rest plist)
"Loads `wad-module-init-file' for given module with CATEGORY and MODULE."
(funcall (wad--module-file-loader wad-module-init-file)
category module plist))
(defun wad-module-ensure-packages (category module &rest plist)
"Ensures all packages for a given module with CATEGORY and MODULE
are installed correctly."
(wad--module-packages-map #'wad--package-ensure
(wad--module-key category module)))
(defun wad-module-config (category module &rest plist)
"Loads `wad-config-file' for given module with CATEGORY and
MODULE"
(funcall (wad--module-file-loader wad-module-config-file)
category
module
plist))
(defun wad-append-module-directory! (path)
"Append PATH to `wad-modules-directories'."
(setq wad-modules-directories
(cons (wad-path path) wad-modules-directories)))
;;; Predicates
(defun wad-module-p (category module)
"Returns t if CATEGORY MODULE is enabled."
(declare (pure t) (side-effect-free t))
(when-let ((key (wad--module-key category module))
(plist (gethash key wad-modules)))
(not (nil plist))))
(defun wad-module-init-p (category module)
"Returns t if CATEGORY MODULE has been initialised via
`wad-init-file' in the associated module path."
(if (member (wad--module-key category module)
wad-modules-init-p)
t))
(defun wad-module-ensure-packages-p (category module)
"Returns t if CATEGORY MODULE have had their packages installed via
`wad-packages-file' in the associated module path."
(if (member (wad--module-key category module)
wad-modules-ensure-packages-p)
t))
(defun wad-module-config-p (category module)
"Returns t if CATEGORY MODULE has been configured via
`wad-module-config-file' in the associated module path."
(if (member (wad--module-key category module)
wad-modules-config-p)
t))
;;; Helpers
(defmacro wad--module-step! (step)
(let ((predicate (intern (format "wad-module-%s-p" step)))
(fn (intern (format "wad-module-%s" step)))
(before (intern (format "wad-modules-before-%s-hook" step)))
(after (intern (format "wad-modules-after-%s-hook" step))))
`(wad--modules-map
(lambda (category module plist)
(if (and (boundp ',predicate) (functionp ',predicate))
(unless (funcall (function ,predicate) category module)
(run-hook-wrapped ,before #'wad--try-run-hook)
(apply (function ,fn) category module plist)
(run-hook-wrapped ,after #'wad--try-run-hook))
(progn
(run-hook-wrapped ,before #'wad--try-run-hook)
(apply (function ,fn) category module plist)
(run-hook-wrapped ,after #'wad--try-run-hook)))))))
(defun wad--module-key (category module)
"Returns a cons cell of (CATEGORY . MODULE). CATEGORY is a keyword,
and MODULE is a symbol."
(when (and (keywordp category) (symbolp module))
(cons category module)))
(defun wad--modules-list-map (fn modules)
"Apply FN to each module in MODULES list."
(let ((modules (copy-sequence modules))
result
category
curr)
(while modules
(setq curr (pop modules))
(cond
;; Update category when the item is a keyword.
((keywordp curr)
(setq category curr))
;; Signal error when the item is not a keyword and no category
;; has been specified from a previous item.
((null category)
(wad--modules-missing-category curr)))
(when-let* ((module curr)
(path (wad--module-locate-path category module)))
(push (funcall fn category module
:flags nil
:path path)
result)))
(nreverse result)))
(defun wad--modules-map (fn)
"Apply FN to each module in `wad-modules'."
(maphash (lambda (module plist)
(let ((category (car module))
(module (cdr module)))
(funcall fn category module plist)))
wad-modules))
(defun wad--module-locate-path (category &optional module file)
"Searches `wad-modules-directories' to find the path to a module.
CATEGORY is a keyword and MODULE is a symbol. Optionally, a FILE can
be provided that will be appended to the resulting path. If no path
exists, his returns nil, otherwise an absolute path."
(when (keywordp category)
(setq category (wad--keyword-to-string category)))
(when (and module (symbolp module))
(setq module (symbol-name module)))
(cl-loop with file-name-handler-alist = nil
for default-directory in wad-modules-directories
for path = (concat category "/" module "/" file)
if (file-exists-p path)
return (file-truename path)))
(defun wad--module-file-loader (file)
"Returns a closure that loads FILE from module.
The closure takes three arguments - the CATEGORY which is a keyword, a
MODULE name which is a symbol, and the matching module PLIST."
(declare (pure t) (side-effect-free t))
(lambda (category module plist)
(let ((wad--current-module (list (wad--module-key category module) (wad-module-get category module))))
(wad-load file (plist-get plist :path) t))))
(defun wad--module-packages-map (fn module)
"Apply FN to each package declared in MODULE."
(cl-loop for package in wad-packages
for name = (car package)
for modules = (wad-package-get name :modules)
when (member module modules)
do (funcall fn name (cdr package))))
(defun wad--module-from-path (&optional path enabled-only)
"Returns a cons cell (CATEGORY . MODULE) via `wad--module-key' derived from
PATH (a file path). If ENABLED-ONLY, return nil if the containing module
isn't enabled."
(if (null path)
(if wad--current-module
(if enabled-only
(and (wad-module-p (caar wad--current-module)
(cdar wad--current-module))
(car wad--current-module))
(car wad--current-module)))
(ignore-errors
(wad--module-from-path (wad-file-name))))
(let* ((file-name-handler-alist nil)
(path (file-truename (or path (wad-file-name)))))
(save-match-data
(cond ((string-match "/modules/\\([^/]+\\)/\\([^/]+\\)\\(?:/.*\\)?$" path)
(when-let* ((category (wad--string-to-keyword (match-string 1 path)))
(module (intern (match-string 2 path))))
(and (or (null enabled-only)
(wad-module-p category module))
(wad--module-key category module))))))))
;;; Errors
(defun wad--modules-missing-category (item)
(signal 'wad-modules-error
(cons 'wad--modules-list-map
(format "No category specified for %s" item))))
;;;; Packages
;; wad.el modules have the option to provide an associated
;; `wad-package-file' file. Containing one or more `wad-package!'
;; declarations, which in turn populate the list of packages that
;; wad.el will ensure available when a module is enabled. A
;; `wad-package!' does not install a package, but simply defines how
;; to install it.
(defvar wad-packages ()
"A list of enabled packages defined via wad.el.
It is highly discouraged to mutate wad-packages directly, and should
only be used via the associated `wad-packages-set' and
`wad-packages-get' functions.
Each element in `wad-packages' is a sublist, whose CAR is the package
name as a symbol, and whose CDR is the plist, initially supplied via
the `wad-package!' declaration.")
(defvar wad-disabled-packages ()
"A list of disabled packages that should be ignored during
initialisation.
Packages can be disabled using the `:disabled' keyword as part of the
`wad-package!' declaration.")
(defvar wad-package-handlers ()
"A list of package handlers. Package handlers can be used to override any
existing package handler when installing a given package.
Each element in `wad-package-handlers' is a sublist, whose CAR is the package
name as a symbol, and whos CDR is the handler itself, which is supplied using
the `wad-ensure-package-handler!' function.
A package handler is called by `wad--package-ensure' with the associated
package's plist and recipe. It is the responsibility of the package handler to
correctly install and ensure the package is available to the user.")
(defvar wad-packages-file "packages"
"The basename of package files for a module.
Package files are read whenever wad.el requires a manifest of all
desired packages for the provided modules.")
(define-error 'wad-packages-error "Error in wad.el modules" 'wad-error)
(define-error 'wad-ensure-package-error "Error in wad-ensure-package" 'wad-error)
(define-error 'wad-handler-error "Missing handler" 'wad-error)
;;; Public Accessors
(cl-defmacro wad-package! (name &rest plist
&key type recipe ignore
_pin _disable _shadow)
"Declares a package and how to install it (if applicable).
This macro is declarative and does not load nor install packages. It is used to
populate `wad-packages' with metadata about the packages defined by the users
enabled modules. You should only be using this macro within a module
`wad-package-file' file.
Accepts the following properties:
:type built-in|virtual
Specifies what kind of package this is. Can be a symbol or a list thereof.
`built-in' = this package is already built-in. Should not be installed.
`virtual' = should not be tracked by wad.el. Will not be installed
or uninstalled.
:recipe RECIPE|FUNCTION
Specifies a recipe on how to acquire package from external sources. There
are no requirements on what the RECIPE should or should not be. The contents
of the recipe will differ depending on which package manager is being used.
When it is a FUNCTION, the function will be run and it is assumed that the
function should install the package correctly. This should not be used
outside of installing a package manager to handle future :recipe props.
:disable BOOL
Do not install or update this package AND disable all its `use-package!' and
`after!' blocks.
:ignore FORM
Do not install this package.
:pin STR|nil
Pin this package to commit hash STR. Setting this to nil will unpin this
package if previously pinned.
:built-in BOOL|'prefer
Same as :ignore if the package is a built-in Emacs package.
:shadow PACKAGE
Informs wad.el that this package is shadowing a built-in PACKAGE; the
original package will be removed from `load-path' to mitigate conflicts, and
this new package will satisfy any dependencies on PACKAGE in the future.
Returns t if package is successfully registered, and nil if it was disabled
elsewhere."
(declare (indent defun))
(when (and recipe (keywordp (car-safe recipe)))
(wad--plist-put! plist :recipe `(quote ,recipe)))
(when (equal type :built-in)
(when (and (not ignore)
(equal built-in '(quote prefer)))
(setq built-in `(locate-library ,(symbol-name name) nil
wad-initial-load-path)))
(wad--plist-delete! plist :built-in)
(wad--plist-put! plist :ignore built-in))
`(let* ((name ',name)
(plist (cdr (assq name wad-packages))))
;; Record the module that this declaration was made in
(let ((package-modules (or (plist-get plist :modules) '()))
(module ',(wad--module-from-path)))
(unless (member module package-modules)
(progn
(wad--plist-put! plist :modules
(setf package-modules
(append package-modules (list module)))))))
;; Merge any given plist with pre-existing one
(wad--loop-plist! ((prop val) (list ,@plist) plist)
(unless (null val)
(wad--plist-put! plist prop val)))
;; Add declaration to `wad-packages' or `wad-disabled-packages'
;; if :disable keyword is non-nil.
(setf (alist-get name wad-packages) plist)
(if (plist-get plist :disable)
(add-to-list 'wad-disabled-packages name)
(with-no-warnings (cons name plist)))))
(defmacro wad-use-package! (name &rest plist)
"Declare and configure a package."
(declare (indent 1))
(unless (memq name wad-disabled-packages)
`(progn (wad--package-load ',name)
(wad--package-use ,name ,@plist))))
(defmacro after! (package &rest body)
"Evaluate BODY after PACKAGE has loaded.
PACKAGE is a symbol or list of them. These are package names, not modes,
functions, or variables. It can be: ..."
(declare (indent 1))
(if (null wad-package-use-hook)
(add-hook 'wad-package-use-hook
#'wad--default-package-use-handler))
(unless (memq name wad-disabled-packages)
`(run-hook-with-args-until-success
'wad-package-use-hook ',name ,@plist)))
(defun wad-package-get (package &optional property nil-value)
"Returns package plist matching PACKAGE. Optionally, if a PROPERTY has
been provided, and is a member of the package plist, it will be
returned.
Returns nil if the package does not exist, is disabled, or the property does not
exist on the package plist, if provided."
(let ((plist (cdr (assq package wad-packages))))
(if property
(if (plist-member plist property)
(plist-get plist property)
nil-value)
plist)))
(defun wad-pinned-packages ()
"Returns an alist mapping package names to pinned commits."
(let (alist)
(dolist (package wad-packages alist)
(cl-destructuring-bind (name &key disable ignore pin unpin &allow-other-keys)
package
(when (and (not ignore)
(not disable)
(or pin unpin))
(setf (alist-get (format "%s" name) alist
nil 'remove #'equal)
(unless unpin pin)))))))
;;; Private Modifiers
(defun wad--package-add (package plist)
"Add package to `wad-packages'. Will replace any existing package."
(setf (alist-get package wad-packages)
(if (listp plist) plist (list plist))))
(defun wad--package-set (package property value)
"Sets property of package plist in `wad-packages'."
(wad--plist-put! (wad-package-get package) property value))
(defun wad--package-add-handler (package fn)
(setf (alist-get package wad-package-handlers) fn))
(defun wad--reset-packages ()
"Reset `wad-packages' to initial state."
(setq wad-packages ()))
;;; Ensure package
(defun wad--package-ensure-fn (package plist recipe))
(defun wad--package-ensure (package &optional plist)
"Ensure that package is installed. By default `wad' makes no
decision on how a package is installed."
(if-let ((plist (or plist (wad-package-get package))))
(let ((recipe (plist-get plist :recipe)))
(if-let ((fn (alist-get package wad-package-handlers)))
(funcall fn package plist recipe)
(wad--package-ensure-fn package plist recipe)))))
;;; Load package
(defun wad--package-load-fn (package plist &optional recipe))
(defun wad--package-load (package &optional plist)
"Ensure package is loaded and ready for use. By default `wad' makes no
decision on how a package should be loaded."
(if-let ((plist (or plist (wad-package-get package))))
(let ((recipe (plist-get plist :recipe)))
(wad--package-load-fn package plist recipe))))
;;; Use package
(defun wad--package-use-fn (package &rest plist))
(defmacro wad--package-use (package &rest plist)
"Load and configure a package. By default `wad' makes no decision on how a
package should be made available for use."
`(wad--package-use-fn ,package ,@plist))
;;; Predicates
(defun wad-package-installed-p (package)
"Return non-nil if NAME (a symbol) is installed.")
;;;; Public Library Helpers
(defun wad-directory-name ()
"Returns the directory of the emacs lisp file this macro is called
from."
(when-let (path (wad-file-name))
(directory-file-name (file-name-directory path))))
(defun wad-file-name ()
"Returns path to the emacs lisp file this macro is called from."
(cond ((bound-and-true-p byte-compile-current-file))
(load-file-name)
((stringp (car-safe current-load-list))
(car current-load-list))
(buffer-file-name)
((error "wad-file-name failed to retrieve file path"))))
(defun wad-path (path &optional base)
"Return a path relative to base path, where PATH is a string and
BASE is a string for the initial base path."
(let ((base (or base (wad-directory-name)))
default-directory)
(expand-file-name path base)))
(defmacro wad-load (filename &optional path noerror)
"Load a file relative to the current executing file."
(let* ((path (or path (wad-directory-name)))
(file (if path
`(expand-file-name ,filename ,path)
filename)))
`(condition-case-unless-debug e
(let (filename-handler-alist)
(load ,file ,noerror 'nomessage))
(error "wad-load failed to load %s" file))))
(defun wad-process (command &rest args)
"Execute COMMANd with ARGS synchronoulsy. Delegates to `wad--exec-process'
when `wad-debug-p' is non-nil value, and `wad--call-process when it is nil."
(apply (if wad-debug-p #'wad--exec-process #'wad--call-process)
command
args))
(defmacro defadvice! (sym arglist &optional docstring &rest body)
"Define an advice called SYM and add it to functions."
(declare (doc-string 3) (indent defun))
(unless (stringp docstring)
(push docstring body)
(setq docstring nil))
(let (where-alist)
(while (keywordp (car body))
(push `(cons ,(pop body) (wad--ensure-list ,(pop body)))
where-alist))
`(progn
(defun ,sym ,arglist ,docstring ,@body)
(dolist (targets (list ,@(nreverse where-alist)))
(dolist (target (cdr targets))
(advice-add target (car targets) #',sym))))))
;;;; Private Library Helpers
(defun wad--string-to-keyword (string)
"Converts STRING to keyword."
(declare (pure t) (side-effect-free t))
(cl-check-type string string)
(intern (concat ":" string)))
(defun wad--keyword-to-string (keyword)
"Returns string of KEYWORD minus the leading colon."
(declare (pure t) (side-effect-free t))
(cl-check-type keyword keyword)
(substring (symbol-name keyword) 1))
(defun wad--unquote (exp)
"Return EXP unquoted."
(declare (pure t) (side-effect-free t))
(while (memq (car-safe exp) '(quote function))
(setq exp (cadr exp)))
exp)
(defmacro wad--log (format-string &rest args)
"Log to *Messages if `wad--debug-p is enabled.'"
`(when wad-debug-p
(let ((inhibit-message (active-minibuffer-window)))
(message ,format-string ,@args))))
(cl-defmacro wad--loop-plist! ((arglist plist &optional retval) &body
body)
"Loop over a PLIST (property value) pairs and return RETVAL.
Evaluate BODY with either ARGLIST bound to (cons PROPERTY VALUE) or,
if ARGLIST is a list, the pair is destructured into (CAR . CDR)."
(declare (indent 1))
(let ((plist-var (make-symbol "plist")))
`(let ((,plist-var (copy-sequence ,plist)))
(while ,plist-var
(let ,(if (listp arglist)
`((,(pop arglist) (pop ,plist-var))
(,(pop arglist) (pop ,plist-var)))
`((,arglist (cons (pop ,plist-var)
(pop ,plist-var)))))
,@body))
,retval)))
(defmacro wad--plist-put! (plist &rest rest)
"Set each property value pair in REST to PLIST in-place."
`(cl-loop for (prop value)
on (list ,@rest) by #'cddr
do ,(if (symbolp plist)
`(setq ,plist (plist-put ,plist prop value))
`(plist-put ,plist prop value))))
(defmacro wad--plist-delete! (plist prop)
"Delete PROP from PLIST in-place."
`(setq ,plist (wad--plist-delete ,plist ,prop)))
(defun wad--plist-delete (plist &rest props)
"Delete PROPS from a copy of PLIST."
(let (p)
(while plist
(if (not (memq (car plist) props))
(wad--plist-put! p (car plist) (nth 1 plist)))
(setq plist (cddr plist)))
p))
(defun wad--rpartial (fn &rest args)
"Return a function that is a partial application of FUN to right hand ARGS.
ARGS is a list of the last N arguments to pass to FUN. The result is a new
function which does the same as FUN, except that the last N arguments are fixed
at the values with which this function was called."
(declare (side-effect-free t))
(lambda (&rest pre-args)
(apply fn (append pre-args args))))
(defun wad--ensure-list (exp)
"Return EXP wrapped in a list, or as-is if already a list."
(declare (pure t) (side-effect-free t))
(if (listp exp) exp (list exp)))
(defun wad--http (host path &optional force-http-p)
"Return url for HOST and PATH, defaulting to https, if possible.
Can force use of http:// when using non-nil value for FORCE-HTTP-P."
(concat "http" (if (or force-http-p gnutls-verify-error) "s") "://"
host "/" path))
(defun wad--github-url (path)
"Return github host prefixed path."
(wad--http "github.com" path))
(defun wad--call-process (command &rest args)
"Execute COMMAND with ARGS synchronously.
Returns (STATUS . OUTPUT) when it is done, where STATUS is the returned error
code of the process and OUTPUT is its stdout output."
(with-temp-buffer
(cons (or (apply #'call-process command nil t nil (remq nil args)) -1)
(string-trim (buffer-string)))))
(defun wad--exec-process (command &rest args)
"Execute COMMAND with ARGS synchronously.
Unlike `wad--call-process', this pipes output to `standard-output' on the fly to
simulate `exec' in the shell, so batch scripts could run external programs
synchronously without sacrificing their output."
(with-temp-buffer
(cons (let ((process
(make-process :name "wad-process"
:buffer (current-buffer)
:command (cons command (remq nil args))
:connection-type 'pipe))
done-p)
(set-process-filter
process (lambda (_process output)
(princ output (current-buffer))
(princ output)))
(set-process-sentinel
process (lambda (process _event)
(when (memq (process-status process) '(exit stop))
(setq done-p t))))
(while (not done-p)
(sit-for 0.1))
(process-exit-status process))
(string-trim (buffer-string)))))
;;;; Aliasing
;; Provides aliases for most common public methods such as `wad-package!' by
;; removing the `wad-' prefix, resulting in `package!' etc.
(unless wad-inhibit-alias-functions
(defalias 'package! #'wad-package!)
(defalias 'use-package! #'wad-use-package!))
;;;; Bootstrap
;; wad.el aims to be provide flexibility for a user to determine how a
;; package should be installed. In order to do this, defaults around
;; package.el are disabled by default, with the idea that they can be
;; enabled again by a module or by the user, if they wish.
;;; Predicate Variables
(defvar wad--skip-package-bootstrap-p nil
"If non-nil, will not modify any package.el modifications as part of
the wad.el bootstrap process.")
;;; Package.el
(unless wad--skip-package-bootstrap-p
(setq package-enable-at-startup nil))
;;; Scratch
(if wad-debug-p
(setq initial-scratch-message "wad.el is here"))
;;; Create related directories
(mapc (wad--rpartial #'make-directory 'parents)
(list wad-local-directory
wad-etc-directory
wad-cache-directory))
;;; We're done here
(provide 'wad)
;;; wad.el ends here
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment