;;; wonderland.el --- declarative configuration for Emacsen -*- lexical-binding: t -*- ;; Copyright (c) 2013 Christina Whyte ;; Version: 0.1.1 ;; Package-Requires: ((dash "2.0.0") (dash-functional "1.0.0") (multi "2.0.0") (emacs "24")) ;; Keywords: configuration profile wonderland ;; Author: Christina Whyte ;; URL: http://github.com/kurisuwhyte/emacs-wonderland ;; This file is not part of GNU Emacs. ;; Permission is hereby granted, free of charge, to any person obtaining ;; a copy of this software and associated documentation files (the ;; "Software"), to deal in the Software without restriction, including ;; without limitation the rights to use, copy, modify, merge, publish, ;; distribute, sublicense, and/or sell copies of the Software, and to ;; permit persons to whom the Software is furnished to do so, subject to ;; the following conditions: ;; ;; The above copyright notice and this permission notice shall be ;; included in all copies or substantial portions of the Software. ;; ;; 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 OR COPYRIGHT HOLDERS ;; 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. ;;; Commentary ;; ;; See README.md (or http://github.com/kurisuwhyte/emacs-wonderland#readme) ;;; Installation ;; ( TODO: ... ) ;;; Code: (eval-when-compile (require 'cl)) (require 'dash) (require 'dash-functional) (require 'multi) ;;;; State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar wonderland/features (make-hash-table) "An map of Features registered for Wonderland.") ;;;; API ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defmacro wonderland/defeature (name &rest forms) (let ((feature (gensym))) `(let ((,feature (wonderland/-feature-from-forms ',name ',forms))) (puthash ',name ,feature wonderland/features) ,feature))) (defun wonderland/load-feature (name) (let* ((feature (gethash name wonderland/features)) (full-profile (wonderland/-resolving-dependencies feature)) (packages (wonderland-feature-packages full-profile)) (state (wonderland-feature-state full-profile)) (keymaps (wonderland-feature-keymaps full-profile)) (modes (wonderland-feature-modes full-profile)) (hooks (wonderland-feature-hooks full-profile))) (-each packages 'wonderland/-package-load) (-each state 'wonderland/-define-state) (-each keymaps 'wonderland/-execute-keymap) (-each modes 'wonderland/-execute-pattern) (-each hooks 'wonderland/-attach-hook) full-profile)) ;;;; Structs ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (cl-defstruct wonderland-feature name dependencies packages keymaps state modes hooks) (cl-defstruct wonderland-dependency id) (cl-defstruct wonderland-package id method url) (cl-defstruct wonderland-state name value) (cl-defstruct wonderland-mode-pattern pattern mode) (cl-defstruct wonderland-hook name action) (cl-defstruct wonderland-keymap mode keymap) ;;;; Dependencies ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-dependency? (form) (eq (car form) 'need)) (defun wonderland/-dependency-from-form (id) (make-wonderland-dependency :id id)) (defun wonderland/-resolving-dependencies (feature) (let ((deplist (-map 'wonderland/-feature-with-resolved-dependencies (wonderland-feature-dependencies feature)))) (-reduce-from 'wonderland/-merge-dependency feature deplist))) (defun wonderland/-feature-with-resolved-dependencies (dependency) (wonderland/-resolving-dependencies (gethash (wonderland-dependency-id dependency) wonderland/features))) (defun wonderland/-merge-dependency (feature dependency) (make-wonderland-feature :name (wonderland-feature-name feature) :dependencies nil :packages (-concat (wonderland-feature-packages dependency) (wonderland-feature-packages feature)) :keymaps (-concat (wonderland-feature-keymaps dependency) (wonderland-feature-keymaps feature)) :state (-concat (wonderland-feature-state dependency) (wonderland-feature-state feature)) :modes (-concat (wonderland-feature-modes dependency) (wonderland-feature-modes feature)) :hooks (-concat (wonderland-feature-hooks dependency) (wonderland-feature-hooks feature)))) ;;;; Packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-package? (form) (eq (car form) 'package)) (defun wonderland/-package-schema (name) (let ((pair (split-string name ":"))) (cond ((= (length pair) 1) (list 'elpa name)) (:t pair)))) (defun wonderland/-package-from-form (id &optional url) (let ((schema (wonderland/-package-schema (or url "")))) (make-wonderland-package :id id :method (car schema) :url (cadr schema)))) (defmulti wonderland/-package-load (pkg) (wonderland-package-method pkg)) (defmulti-method wonderland/-package-load 'elpa (pkg) (let ((id (wonderland-package-id pkg))) (unless (package-installed-p id) (package-install id) (require id)))) ;;;; State ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-var? (form) (eq (car form) 'def)) (defun wonderland/-state-from-form (name value) (make-wonderland-state :name name :value value)) (defun wonderland/-define-state (state) (set (wonderland-state-name state) (wonderland-state-value state))) ;;;; Hooks ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-hook? (form) (eq (car form) 'hook)) (defun wonderland/-hook-from-form (name action) (make-wonderland-hook :name name :action action)) (defun wonderland/-attach-hook (hook) (add-hook (wonderland-hook-name hook) (wonderland-hook-action hook))) ;;;; Mode patterns ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-pattern? (form) (eq (car form) 'mode)) (defun wonderland/-pattern-from-form (mode pattern) (make-wonderland-mode-pattern :mode mode :pattern pattern)) (defun wonderland/-execute-pattern (pattern) (add-to-list 'auto-mode-alist (cons (wonderland-mode-pattern-pattern pattern) (wonderland-mode-pattern-mode pattern)))) ;;;; Keymap functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-is-form-a-keymap? (form) (eq (car form) 'keymap)) (defun wonderland/-keymap-from-form (mode &rest keymap) (make-wonderland-keymap :mode mode :keymap keymap)) (defun wonderland/-execute-keymap (keymap) (let ((map (wonderland-keymap-keymap keymap)) (mode (wonderland-keymap-mode keymap))) (if (eq mode 'global) (wonderland/-define-global-keymap map) (wonderland/-define-mode-keymap mode map)))) (defun wonderland/-define-global-keymap (keymap) (-each keymap (lambda (item) (global-set-key (kbd (car item)) (cdr item))))) (defun wonderland/-define-mode-keymap (mode keymap) (add-hook (concatenate-symbols mode '-hook) (lambda () (-each keymap (lambda (item) (local-set-key (kbd (car item)) (cdr item))))))) ;;;; Helper functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun wonderland/-feature-from-forms (name forms) (make-wonderland-feature :name name :dependencies (wonderland/-dependencies-from-forms forms) :packages (wonderland/-packages-from-forms forms) :keymaps (wonderland/-keymaps-from-forms forms) :state (wonderland/-vars-from-forms forms) :modes (wonderland/-modes-from-forms forms) :hooks (wonderland/-hooks-from-forms forms))) (defun wonderland/-extract-forms-with (forms filter-fn factory-fn) (->> forms (-filter filter-fn) (-map (lambda (xs) (apply factory-fn (cdr xs)))))) (defun wonderland/-dependencies-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-dependency? 'wonderland/-dependency-from-form)) (defun wonderland/-packages-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-package? 'wonderland/-package-from-form)) (defun wonderland/-vars-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-var? 'wonderland/-state-from-form)) (defun wonderland/-hooks-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-hook? 'wonderland/-hook-from-form)) (defun wonderland/-modes-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-pattern? 'wonderland/-pattern-from-form)) (defun wonderland/-keymaps-from-forms (forms) (wonderland/-extract-forms-with forms 'wonderland/-is-form-a-keymap? 'wonderland/-keymap-from-form)) ;;;; General utility functions ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defun concatenate-symbols (&rest symbols) (intern (-reduce-from (lambda (result item) (concat result (symbol-name item))) "" symbols))) ;;;; Emacs syntax/indentation, etc ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (put 'wonderland/defeature 'lisp-indent-function 1) (eval-after-load "lisp-mode" '(progn (font-lock-add-keywords 'emacs-lisp-mode '(("\\<\\(wonderland/defeature\\)\\>" . 'font-lock-keyword-face))) (--each (buffer-list) (with-current-buffer it (when (and (eq major-mode 'emacs-lisp-mode) (boundp 'font-lock-mode) font-lock-mode) (font-lock-refresh-defaults)))))) (provide 'wonderland) ;;; wonderland.el ends here