Add a bare minimum system implementation for V3

Signed-off-by: Sameer Rahmani <lxsameer@gnu.org>
This commit is contained in:
Sameer Rahmani 2020-04-14 20:09:47 +01:00
parent 1088b8e943
commit f17dd3984e
10 changed files with 565 additions and 0 deletions

39
core/fg42.el Normal file
View File

@ -0,0 +1,39 @@
;;; FG42 --- The mighty editor for the emacsians -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;;; Code:
(require 'fg42/system/utils)
(autoload 'fg42-system/start "fg42/system"
"Starts the given SYSTEM.")
(defun fg42/start! (system)
"Start the given SYSTEM description."
(fg42-system/set-system! system)
(add-hook 'window-setup-hook
(lambda () (fg42-system/start))))
(provide 'fg42)
;;; fg42.el ends here

91
core/fg42/extensions.el Normal file
View File

@ -0,0 +1,91 @@
;;; extensions --- Extension library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;;; Code:
;; This library provides some basic means to create a new FG42 extensions
(require 'fg42/utils)
(require 'fg42/extensions/core)
(defun fg42-extensions/load-index (system ext-name ext-path)
"Load the extension EXT-NAME which is in EXT-PATH using SYSTEM.
It will load the main file of the extension and return the `fg42-extension'
instance of the extension and nil otherwise."
(let ((is-loaded? (require ext-name ext-path t)))
(when is-loaded?
(symbol-value ext-name))))
(defun fg42-extensions/load-extension (system ext)
"Setup the given extension EXT against the given SYSTEM.
At this stage we will install/load the main file of the extensions
and call the `on-initialize'function of extensions in order to setup
the autoloads and hooks."
(cond
((symbolp ext)
(fg42-extensions/load-index system ext (fg42-extension/path system ext)))
((listp ext)
(fg42-extensions/load-index system (car ext) (cadr ext)))
(t
;; TODO: instead of throwing and error, inject the error into the system
(throw 'load-extension-failed
(format "Can't load extension %s" (str ext))))))
(defun fg42-extensions/load-system-extensions (system)
"Load the extensions defined in the given SYSTEM.
SYSTEM should be an instance of `fg42-system' which contains a list
of extension names on the `extensions' field. This function finds and
loads the index file of those extensions and returns a new system
containing the `fg42-extension' instances."
(let ((exts (mapcar (lambda (ext)
(fg42-extensions/load-extension system ext))
(fg42-system-extensions system))))
(setf (fg42-system-extensions system)
exts))
system)
(defun fg42-extensions/initialize (system ext)
"Initialize the given extension EXT aginst the given SYSTEM."
(funcall (fg42-extension-on-initialize ext) system))
(defun fg42-extensions/initialize-extensions (system)
"Initialize the extensions within SYSTEM and return a new system."
(mapcar
(lambda (ext) (fg42-extensions/initialize system ext))
(fg42-system-extensions system))
system)
(defun fg42-setup-extensions (system)
"Setup the preloads for the given SYSTEM."
(funcall (comp #'fg42-extensions/initialize-extensions
#'fg42-extensions/load-system-extensions) system))
(provide 'fg42/extensions)
;;; extensions.el ends here

View File

@ -0,0 +1,91 @@
;;; extensions --- Extension library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;;; Code:
(require 'cl-lib)
(require 'fg42/system/core)
(cl-defstruct fg42-extension
"Each FG42 extension should implement a copy of this structure."
name
;; Let's keep this field for backward compatiblity for a while
docs
;; Each extension should expose a info page.
doc-index
;; To be used with `describe-extension'
(docstring nil)
;; Projectile provides a project type that we can use to
;; activate/load the extensions based on their registered
;; type.
project-types
(version nil)
;; An instance of fg42-actions structure that describe the
;; different actions of the given extension
(actions nil)
(path nil)
;; Callbacks
(on-initialize nil)
(on-load)
(on-unload))
(defun fg42-extensions/build-path (system ext)
"Build a path for the given EXT name (symbol) via SYSTEM info."
;; TODO: should we extract variables such as `fg42-home' to their
;; dedicated ns in order to avoid the warning ?
(let ((ext-name (symbol-name ext)))
(concat (fg42-system-root)
"/extensions/" ext-name "/" ext-name ".el")))
(defun fg42-extension/path (system ext)
"Return the path to the given extension EXT in the given SYSTEM."
(cond
((symbolp ext) (fg42-extension/build-path system ext))
((fg42-extension-p ext)
(or (fg42-extension-path ext)
(fg42-extension/build-path system
(intern (fg42-extension-name ext)))))))
(defmacro defextension (name docstring &rest args)
"A simple DSL to define new fg42 extension by given NAME, DOCSTRING and ARGS."
(declare (doc-string 2) (indent 1))
;; TODO: Inject the docstring to the current `system' in order
;; to collect it later for `describe-extension' function.
(when (not (stringp docstring))
(throw 'extention-error
"`docstring' is mandatory and it should be a string."))
`(setq ,name (apply 'make-fg42-extension
:name ,(symbol-name name)
:docstring ,docstring
(quote ,args))))
(provide 'fg42/extensions/core)
;;; core.el ends here

61
core/fg42/system.el Normal file
View File

@ -0,0 +1,61 @@
;;; system --- System library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;; `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 'fg42/utils)
(require 'fg42/system/core)
(require 'fg42/system/utils)
(defun fg42-system/start ()
"Start the system from `fg42-get-current-system'."
(debug-message "Starting the default system.")
(let ((sys (fg42-system/get-active-system)))
(funcall (fg42-system-start sys) sys)))
(comment
(macroexpand-1 '(defsystem testsystem
"docstring"
:preloads '(2 43 4)
:packages '(('elisp-extension :version "1.3.3"))
:abilities '()))
(defsystem testsystem
"docstring1"
:packages '(('elisp-extension :version "1.3.3"))
:abilities '())
(make-fg42-system :name "asd" :preloads '(213 452) :abilities '(x y))
(aset testsystem 2 "sam")
(setf (fg42-system-abilities testsystem) '(3 3 3 3 3))
(fg42-set-current-system! testsystem)
(fg42-system-preloads testsystem)
(start-system)
(fg42-system-start testsystem))
(provide 'fg42/system)
;;; system.el ends here

72
core/fg42/system/core.el Normal file
View File

@ -0,0 +1,72 @@
;;; system --- System library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;; `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 'cl-lib)
(require 'fg42/utils)
(cl-defstruct fg42-system
"A `system' describes a FG42 instance. Everything that is needed
to load FG42."
name
;; We will use this value for `describe-system' as a short
;; documentation.
docstring
;; TODO: guess the system root based on the `name' field
;; as the default value
(root (concat (getenv "HOME") "/.fg42"))
;; The directory to store all sort of temporary files including
;; backups, flycheck temps and stuff like that.
(tmp-path "~/.tmp")
(packages '())
;; ;; A list of preloads to setup extensions which are not loaded yet.
;; ;; For more information on preloads checkout `fg42/extension'
;; (preloads '())
(extensions '())
(abilities '())
;; A function which takes the `system' and starts it.
(start (lambda (system) system))
(stop nil))
(defmacro defsystem (name &optional docstring &rest body)
"Define a system with the given NAME, DOCSTRING and BODY."
(declare (doc-string 2) (indent 1))
(let ((form (if (boundp (intern (format "%s" name))) 'setq 'defvar)))
`(,form ,name (make-fg42-system
:name ,(symbol-name name)
:docstring ,docstring
,@body))))
(provide 'fg42/system/core)
;;; core.el ends here

47
core/fg42/system/utils.el Normal file
View File

@ -0,0 +1,47 @@
;;; system --- System library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;; `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:
(defvar fg42-system/active--system nil
"A private variable to store the active system.
Use `fg42-get-current-system' instead")
(defun fg42-system/get-active-system ()
"Return the current active system of FG42."
fg42-system/active--system)
(defun fg42-system/set-system! (system)
"Set the current system to the given SYSTEM."
;; TODO: In the future when we moved to parallel boot
;; we need to make sure that this funciton
;; sets the state safely.
(setq fg42-system/active--system system))
(provide 'fg42/system/utils)
;;; utils.el ends here

115
core/fg42/utils.el Normal file
View File

@ -0,0 +1,115 @@
;;; Utils --- Utils library of FG42 -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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:
;; `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 'cl-lib)
;;; Buffer helpers ------------------------------------------------------------
(defun buffer-mode (buffer-or-string)
"Return the major mode associated with a the given BUFFER-OR-STRING."
(with-current-buffer buffer-or-string
major-mode))
(defun ->buffer (buffer-name data &optional fn)
"Insert the given DATA into the given buffer provided by BUFFER-NAME.
It will create a the buffer if it doesn't exist. It will call the given FN
at the end in context of the buffer. This function accepts only one argument
with is the buffer."
(let ((buf (get-buffer-create buffer-name)))
(with-current-buffer buf
(insert data)
(when fn
(funcall fn buf)))))
(defmacro inspect-expression (&rest body)
"Pretty prints the result of the given BODY."
`(pp-display-expression ,@body (get-buffer-create fg42/inspect-buffer)))
(defun inspect-data-append (data)
"Append the given DATA to the inspection buffer with padding."
;; TODO: Move 'fg42/inspect-buffer' to the somewhere propriate
;; possiblly the system.
(->buffer
"fg42/inspect-buffer"
(format
"\n;; START ======================================================\n%s%s"
(pp-to-string data)
";; END.\n")))
(defun apply-face (face-symbol text)
"Apply the given FACE-SYMBOL to the given TEXT."
(put-text-property 0 (length text) 'face face-symbol text))
(defmacro comment (&rest body)
"A macro similar to Clojure's comment macro that ignore the BODY."
(declare (indent 0))
`nil)
(defmacro debug-message (&rest params)
"Print out the given PARAMS only if debug mode is on."
(if debug-on-error
`(message ,@params)
nil))
(defmacro deprecated (msg &rest form)
"Mark the given FORM as deprecated with the given MSG."
(declare (indent 0))
`(progn
(warn (format "[DEPRECATED]: %s" ,msg))
,@form))
;; TODO: A good candidate for an inline function
(defun find-value-for (lst key)
"Return the value of the given KEY in the given LST.
For example for a list like (list :x 4 :y 5) we can find the value of
`:x' by doing `(get-value-for lst :x)'."
(let ((pairs (seq-partition lst 2)))
(when-let (pair (assq key pairs))
(cadr pair))))
(defun comp (&rest fns)
"Compose the given list of FNS into one function that accepts multiple values.
For example:
(funcall (compose (lambda (x) (+ 1 x)) (lambda (x) (* x s))) 5)
or
(funcall (compose #'some-fn #'message) some-value)"
(lambda (&rest values)
(reduce 'funcall (butlast fns)
:from-end t
:initial-value (apply (car (last fns)) values))))
(provide 'fg42/utils)
;;; utils.el ends here

1
extensions/fg42-elisp Submodule

@ -0,0 +1 @@
Subproject commit 721da6e0a242eb6630dd476f2d8e1146d67d2e40

9
fg42-new Executable file
View File

@ -0,0 +1,9 @@
#! /bin/sh
export FG42_HOME=/home/lxsameer/.fg42
FG42_WM=false /home/lxsameer/src/emacs/build/bin/emacs --name FG42 \
--no-site-file --no-site-lisp --no-splash --title FG42 \
-L $FG42_HOME/core \
-L $FG42_HOME/extensions \
-l $FG42_HOME/core/fg42.el \
-l ~/.v3.el "$@"

39
system.el Normal file
View File

@ -0,0 +1,39 @@
;;; FG42 --- The mighty editor for the emacsians -*- lexical-binding: t; -*-
;;
;; Copyright (c) 2010-2020 Sameer Rahmani <lxsameer@gnu.org>
;;
;; 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/>.
;;
;;; Acknoledgement:
;; Thanks to all the people who contributed to FG42.
;;
;;; Commentary:
;;; Code:
(require 'fg42)
(require 'fg42/system/core)
(defsystem FG42
"FG42 implemented in term of systems and this is the default system."
:start (lambda (system) (message "hooray!"))
:extensions '(fg42-elisp))
(provide 'system)
;;; system.el ends here