FG42/core/fg42/cube.el

;;; Cube --- Cube library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2022 Sameer Rahmani & Contributors
;;
;; Author: Sameer Rahmani <lxsameer@gnu.org>
;; URL: https://devheroes.codes/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)
(require 'fg42/themes)

(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 need 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.")

(defvar fg42/-cubes-body-hook nil
  "A Hook that is internal to FG42 and will be used to run the cub bodies.
The execution happens after Emacs is initialized.")


(defun fg42/extract-props (body-list &optional acc)
  "Extract the props pairs from BODY-LIST with an optional accumulator ACC.

It will returen a pair in form of (body . props)."
  (let ((k (car body-list))
        (rest (cdr body-list)))

    (if (and k (keywordp k))
        (fg42/extract-props
         (cdr rest)
         (cons (cdr rest) (plist-put (cdr acc) k (car rest))))
      (cons body-list (cdr acc)))))


(defun fg42/run-cube-after-initialization (f)
  "Run the given Cube body function F after FG42's initialization.
If FG42 is already initialized, just run F."
  (if (null fg42/initialized)
      (add-hook 'fg42/-cubes-body-hook f)
    (funcall f)))


(defmacro defcube (cube-name docs &rest props-n-body)
  "Define a cube with the given CUBE-NAME, DOCS and a PROPS-N-BODY.

TODO: Docs"
  (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))

  (let* ((parsed-body (fg42/extract-props props-n-body))
         (body (car parsed-body))
         (props (cdr parsed-body)))

    (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)))
          ;; prop hooks
          (init-hook (plist-get props :init-hook))
          (ui-hook (plist-get props :ui-hook))

          (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
         ;; cube's 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)
           (let ((fg42/---f-sym
                  (lambda ()
                    (when (not (null ,ui-hook))
                      (add-hook 'fg42/ui-hook #',ui-hook))

                    (when (not (null ,init-hook))
                      (funcall #',init-hook params))

                    ;; Run the cube internal after initialization or
                    ;; if Emacs is already up, just run it.
                    (fg42/run-cube-after-initialization
                     (lambda ()
                       (,cube-name-internal params))))))

             (if ,no-flag?
                 ;; If no flag is need to control this cube
                 (funcall fg42/---f-sym)
               ;; Otherwise check for the flag to be active
               (if-flag ,flag-var
                 (funcall fg42/---f-sym)
                 (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)))


(defmacro ->cube (pkg docs &rest body)
  "A wrapper to create a cube that use only a PKG.
It passes the BODY to `fpkg/use'.
And passes DOCS to `defcube' as the cube documentation."
  (declare (indent defun) (doc-string 2))
  `(defcube ,(intern (format "fg42/%s-cube" pkg))
     ,docs
     :title ,(format "%s cube" pkg)
     :flag ,pkg
     :flag-default t
     (fpkg/use ,pkg ,@body)))


(provide 'fg42/cube)
;;; cube.el ends here