;;; system --- System library of FG42 -*- lexical-binding: t; -*- ;; ;; Copyright (c) 2010-2021 Sameer Rahmani & Contributors ;; ;; Author: Sameer Rahmani ;; URL: https://gitlab.com/FG42/FG42 ;; Version: 3.0.0 ;; ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;; ;;; Commentary: ;; `System' is just a state monad which holds the state of the editor. ;; Each system has to have a `start' function to start the setup process. ;; ;;; Code: (require 'seq) (require 'fg42/system/core) (defun fg42/system-get-cube (system cube-name) "Return the cube with CUBE-NAME ins the SYSTEM." ;; car is the name cdr is the cube itself (cdr (assoc cube-name (fg42/system-get system :cubes)))) (defun fg42/system-get-cube-property (system cube-name prop) "Return the value of the given property PROP of CUBE-NAME in SYSTEM." (let ((cube (fg42/system-get-cube system cube-name))) (plist-get cube prop))) (defun fg42/system-set-cube-property (system cube-name prop v) "Set the given property PROP of CUBE-NAME to V in SYSTEM." (let ((cube (append (list prop v) (fg42/system-get-cube system cube-name)))) (fg42/system-register-cube system cube-name cube))) (defun fg42/system-setup-cube (system cube-name) "Setup the given CUBE-NAME using the given SYSTEM." (if (eq t (fg42/system-get-cube-property system cube-name :setup-finished)) system (let ((cube (fg42/system-get-cube system cube-name))) (when (null cube) (error "Can't find cube '%s' in the system" cube-name)) (message "Setting up '%s' cube..." cube-name) (let ((updated-system (seq-reduce (lambda (sys requirement) (fg42/system-setup-cube sys requirement)) (plist-get cube :requires) system))) ;; Run the init function the cube. ;; The init function is just for setup, the return value of it ;; and the changes that it might make to the system will be discarded. (funcall (or (plist-get cube :init) (lambda () ()))) ;; Setup the automods (fg42/system-cube-auto-modes system cube) ;; Setup the hooks (fg42/system-cube-hooks system cube) (fg42/system-set-cube-property updated-system cube-name :setup-finished t))))) (defun fg42/system-setup-cubes (system) "Setup the cubes in the given SYSTEM by creating a dependency tree." (let ((cubes (fg42/system-get system :cubes))) (seq-reduce (lambda (sys cube-pair) (fg42/system-setup-cube sys (car cube-pair))) cubes system))) (defun fg42/system-cube-auto-modes (system cube) "Setup the auto modes of the given CUBE using the given SYSTEM." (dolist (automod (plist-get cube :auto-modes)) (when automod (add-to-list 'auto-mode-alist automod)))) (defun fg42/system-cube-hooks (system cube) "Setup the auto modes of the given CUBE using the given SYSTEM." (dolist (hook (plist-get cube :hooks)) (when hook (add-hook (car hook) (cdr hook))))) (provide 'fg42/system/cubes) ;;; cubes.el ends here