FG42/core/fg42/cube.el

171 lines
6.9 KiB
EmacsLisp

;;; Cube --- Cube library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2022 Sameer Rahmani & Contributors
;;
;; Author: Sameer Rahmani <lxsameer@gnu.org>
;; 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 <http://www.gnu.org/licenses/>.
;;
;;; Commentary:
;; Cubes are the building blocks of any `FG42' editor. Each `cube' is a
;; unit which defines different abilities in a deterministic and idempotent
;; way. Cubes are composable and a composition of cubes creates an editor.
;;
;;; Code:
(require 'seq)
(require 'fg42/utils)
(defvar fg42/after-cubes-setup-hook nil
"A hook that will be run after all the active cubes got setup.
This hook is dedicated for the codes that needs to do stuff based on other cubes
presence. With this hook we eliminate the need for cube ordering.
It will be called in the `fg42-config' and the proper way to use
it is to use `fg42/after-cubes' macro.")
(defvar fg42/available-cubes '()
"A list of all the registered cubes.")
(defmacro defcube (cube-name docs props &rest body)
"Define a cube with the given CUBE-NAME, a list of PROPS, DOCS and a BODY."
(declare (indent defun) (doc-string 2))
;; Make sure that props is a plist and contains the `:docs' key
;; TODO: Maybe use `cl-check-type' here
(when (not (stringp docs))
(error "Missing docstring for '%s' cube" cube-name))
(when (not (plist-get props :title))
(error "Missing :titel key for '%s' cube" cube-name))
(let ((complete-props (plist-put props :docs docs))
(cube-name-internal (intern (format "%s-internal" cube-name)))
(params-var (intern (format "%s-params" cube-name)))
(active-var (intern (format "%s-active-p" cube-name)))
(pre-lang-server-up-hook (intern (format "%s-pre-lang-server-up-hook" cube-name)))
(post-lang-server-up-hook (intern (format "%s-post-lang-server-up-hook" cube-name)))
(pre-lang-server-down-hook (intern (format "%s-pre-lang-server-down-hook" cube-name)))
(post-lang-server-down-hook (intern (format "%s-post-lang-server-down-hook" cube-name)))
(pre-init-hook (intern (format "%s-pre-init-hook" cube-name)))
(post-init-hook (intern (format "%s-post-init-hook" cube-name)))
(post-init-hook (intern (format "%s-post-init-hook" cube-name)))
(flag-var (or (plist-get props :flag) cube-name))
(flag-docstring-var (or (plist-get props :flag-doc)
(format "The flag to enable/disable the '%s' cube." cube-name)))
(flag-default (plist-get props :flag-default))
(flag-conflict (plist-get props :conflicts-with))
(no-flag? (or (plist-get props :no-flag) ())))
(add-to-list 'fg42/available-cubes cube-name)
`(progn
;; Create a new flag for each cube to control the cubes systemwide.
(when (not ,no-flag?)
(defflag ,flag-var ,flag-docstring-var ,flag-default))
;; Params variable contains the list of params the is passed to
;; the current cube call
(defvar ,params-var nil
,(format "Parameters for the '%s' cube." cube-name))
;; * Hooks
;; This hook can be used by others to run code just before running that
;; code body
(defvar ,pre-init-hook nil
,(format "The hook that runs befor the '%s' cube initialization." cube-name))
;; This hook can be used by others to run code just after the body of
;; the cube
(defvar ,post-init-hook nil
,(format "The hook that runs after the '%s' cube initialization." cube-name))
;; TODO: Move language server related hooks to lang-server
;; TODO: Provide a way to let different parts of the
;; codebase to create cube hooks
;; ** Language Server
;;; The hook that enables users to change the language server configuration
;;; of the current cube before activating the server
(defvar ,pre-lang-server-up-hook nil
,(format "The hook that runs befor the '%s' cube's language server activates ." cube-name))
;;; The hook to do any post configuration for the lang server of the cube
(defvar ,post-lang-server-up-hook nil
,(format "The hook that runs after the '%s' cube's language server activates." cube-name))
;;; The hook to run code just before the language server is about to shutdown
(defvar ,pre-lang-server-down-hook nil
,(format "The hook that runs befor the '%s' cube's language server shuts down." cube-name))
;;; The hook to run code after the language server successfully shuts down
(defvar ,post-lang-server-down-hook nil
,(format "The hook that runs after the '%s' cube's language server shuts down." cube-name))
;; This way we can bypass the flag system if we really really want to.
(defun ,cube-name-internal (params)
(if (or (not (boundp (quote ,active-var)))
(not ,active-var))
(progn
;; Mark this cube as active
(setq ,active-var t)
;; Set the parameters in CUBE-NAME-params to be accessable
;; in the body
(setq ,params-var params)
;; Run the pre init hook
(run-hooks (quote ,pre-init-hook))
(fg42/info "Initializing '%s' cube." (quote ,cube-name))
;; Run the body
(let ((result (progn ,@body)))
;; Run the post init hook
(run-hooks (quote ,post-init-hook))
result))
(fg42/info "The '%s' cube is already active." ',cube-name)))
(defun ,cube-name (&rest params)
(interactive)
(if ,no-flag?
;; If no flag is need to control this cube
(,cube-name-internal params)
;; Otherwise check for the flag to be active
(if-flag ,flag-var
(,cube-name-internal params)
(fg42/info "The flag for '%s' cube is disabled. Skiping." ,(symbol-name cube-name)))))
;; Set the symbol-plist of the cube-name to its props
(setplist ',cube-name ',complete-props))))
(defmacro fg42/after-cubes (&rest body)
"Add the BODY to `fg42/after-cubes-setup-hook' hook."
(declare (indent defun))
`(add-hook 'fg42/after-cubes-setup-hook
(lambda ()
,@body)))
(provide 'fg42/cube)
;;; cube.el ends here