Setup a bare minimum defcube macro
This commit is contained in:
parent
369775318c
commit
1ea2e700ec
|
@ -33,13 +33,8 @@
|
|||
(package-as-cube paredit)
|
||||
|
||||
|
||||
(defcube fg42/elisp-cube ()
|
||||
:requires '(paredit)
|
||||
;;:modes '((emacs-lisp-mode . f42/elisp-cube-after-load))
|
||||
:hooks '((emacs-lisp-mode-hook . fg42/elisp-hook-handler))
|
||||
;;:auto-modes (list (lambda (system) '("\\.el\\'" . fg42/elisp-cube-mmm)))
|
||||
;;:init #'iii
|
||||
:dependencies '((:name rainbow-delimiters :version :latest)))
|
||||
(defcube fg42/elisp-cube
|
||||
(depends-on 'blah))
|
||||
|
||||
|
||||
(provide 'cubes/elisp)
|
||||
|
|
|
@ -25,85 +25,23 @@
|
|||
;; way. Cubes are composable and a composition of cubes creates an editor.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'seq)
|
||||
(require 'fg42/utils)
|
||||
(require 'fg42/system/dependencies)
|
||||
(require 'fg42/system/modes)
|
||||
(require 'fg42/system/keys)
|
||||
|
||||
|
||||
(defmacro defcube (name params &rest body)
|
||||
"Define a cube with the given NAME, PARAMS and BODY."
|
||||
(declare (indent defun))
|
||||
`(defun ,name ,params
|
||||
(lambda (system)
|
||||
(cons
|
||||
system
|
||||
(list
|
||||
:name ',name
|
||||
,@body)))))
|
||||
|
||||
|
||||
(defmacro package-as-cube (name &rest body)
|
||||
"Define a cube based on a package with the given NAME and BODY."
|
||||
`(defun ,name (&optional __version__)
|
||||
(lambda (system)
|
||||
(cons
|
||||
system
|
||||
(list
|
||||
:name ',name
|
||||
:dependencies (list (list :name ',name :version (or __version__ :latest)))
|
||||
,@body)))))
|
||||
|
||||
|
||||
(defmacro active-cube? (name &rest body)
|
||||
"Run the BODY if the given cube NAME is activated."
|
||||
(declare (indent defun))
|
||||
(when (fg42/system-get-cube fg42/system name)
|
||||
`(progn ,@body)))
|
||||
|
||||
|
||||
(defun fg42/cube-run (cube system)
|
||||
"Run the given CUBE with the given SYSTEM.
|
||||
|
||||
Returns a pair of new system and the cube vlaue."
|
||||
(funcall cube system))
|
||||
|
||||
|
||||
(defun fg42/cube-compose (&rest cubes)
|
||||
"Compose the given CUBES."
|
||||
(lambda (system)
|
||||
(cond
|
||||
((null cubes) (cons system '()))
|
||||
(t
|
||||
(seq-reduce
|
||||
(lambda (s cube)
|
||||
(fg42/cube-apply (fg42/cube-run cube s)))
|
||||
cubes
|
||||
system)))))
|
||||
|
||||
|
||||
|
||||
(defun fg42/cube--apply (system cube)
|
||||
"Apply thie given CUBE to given SYSTEM."
|
||||
(if cube
|
||||
(let ((name (plist-get cube :name)))
|
||||
(-> system
|
||||
;; insert the cube into the state
|
||||
(fg42/system-register-cube name cube)
|
||||
;; Add the dependencies of the cube to the state
|
||||
(fg42/system-merge-dependencies name (plist-get cube :dependencies))
|
||||
;; Merge the modes configuration of the cubes
|
||||
(fg42/system-merge-modes name (plist-get cube :modes))
|
||||
;; Add the keybindings of the cube to the state
|
||||
(fg42/system-merge-keys name (plist-get cube :keys))))
|
||||
system))
|
||||
|
||||
|
||||
(defun fg42/cube-apply (system-cube-pair)
|
||||
"Apply the cube in the given SYSTEM-CUBE-PAIR to the system inside of it."
|
||||
(fg42/cube--apply (car system-cube-pair) (cdr system-cube-pair)))
|
||||
(defmacro defcube (cube-name props &rest body)
|
||||
"Define a cube with the given CUBE-NAME, a list of PROPS and a BODY."
|
||||
(let ((params-var (intern (format "%s-params" cube-name)))
|
||||
(active-var (intern (format "%s-active-p" cube-name))))
|
||||
`(progn
|
||||
(defvar ,params-var nil
|
||||
,(format "Parameters for the '%s' cube." cube-name))
|
||||
(defun ,cube-name (&rest params)
|
||||
(when (not (boundp ,active-var))
|
||||
(progn
|
||||
(setq ,active-var t)
|
||||
(setq ,params-var params)
|
||||
,@body))))))
|
||||
|
||||
|
||||
(provide 'fg42/cube)
|
||||
|
|
|
@ -24,7 +24,6 @@
|
|||
;; Each system has to have a `start' function to start the setup process.
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
(autoload 'seq-partition "seq")
|
||||
|
|
56
core/fpkg.el
56
core/fpkg.el
|
@ -38,57 +38,11 @@
|
|||
:type 'string)
|
||||
|
||||
|
||||
(defun fpkg/->package-el-version (version)
|
||||
"Convert the given FG42 package VERSION to package.el compatible version."
|
||||
(cond
|
||||
((null version) '(0))
|
||||
((eq version :latest) '(0))
|
||||
(t version)))
|
||||
|
||||
|
||||
(defun fpkg/package-installed-via-package-el (pkg)
|
||||
"Return non-nil if the given package PKG is installed."
|
||||
(package-installed-p (plist-get pkg :name)
|
||||
(fpkg/->package-el-version (plist-get pkg :version))))
|
||||
|
||||
|
||||
|
||||
(defun fpkg/package-installed? (pkg)
|
||||
"Return non-nil if the given package PKG is installed."
|
||||
(let* ((source (or (plist-get pkg :source) "package-el"))
|
||||
(func-name (concat "fpkg/package-installed-via-" source))
|
||||
(f (symbol-function (intern func-name))))
|
||||
(funcall f pkg)))
|
||||
|
||||
|
||||
(defun fpkg/install--package-via-package-el (pkg)
|
||||
"Install the given package PKG via package.el."
|
||||
;; TODO: Install packages using the package-desc to fetch
|
||||
;; packages with version
|
||||
;; (let ((package (package-desc-create :name (plist-get pkg :name)
|
||||
;; :version (fpkg/->package-el-version (plist-get pkg :version))
|
||||
;; :kind 'tar)))
|
||||
;; (package-install package)))
|
||||
(package-install (plist-get pkg :name)))
|
||||
|
||||
|
||||
(defun fpkg/install-package (pkg)
|
||||
"Intall the package PKG via its propreate source."
|
||||
(let* ((source (or (plist-get pkg :source) "package-el"))
|
||||
(func-name (concat "fpkg/install--package-via-" source))
|
||||
(install-func (symbol-function (intern func-name))))
|
||||
(funcall install-func pkg)))
|
||||
|
||||
|
||||
(defun fpkg/initialize1 (system)
|
||||
"Initilize the `package.el' for the given SYSTEM."
|
||||
;; TODO: Grap any extra repo from the system (sympol-plist)
|
||||
(add-to-list 'package-archives
|
||||
'("melpa" . "http://melpa.org/packages/") t)
|
||||
|
||||
;; Initialize package.el
|
||||
(package-initialize))
|
||||
|
||||
(defmacro depends-on (pkg)
|
||||
"Install the given package PKG via straight."
|
||||
(if (list-p pkg)
|
||||
`(straight-use-package ,@pkg)
|
||||
`(straight-use-package ,pkg)))
|
||||
|
||||
|
||||
(defun fpkg/initialize ()
|
||||
|
|
Loading…
Reference in New Issue