43b17192d9
Deliver the unified View and Component model with retained Runtime, reactive scopes, Context, Behaviors, events, Actions, styles, Resources, Data, official UI Components, and Playground examples.\n\nVerification: make check and make load pass in the independent repository; sibling Ebox core tests pass 544/544.
212 lines
8.0 KiB
EmacsLisp
212 lines
8.0 KiB
EmacsLisp
;;; etaf-component.el --- ETAF Component definitions -*- lexical-binding: t; -*-
|
|
|
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
|
|
|
;;; Commentary:
|
|
|
|
;; Components have one public definition boundary. A stateless Component
|
|
;; declares `:view'; a stateful Component declares `:setup' which runs once
|
|
;; per retained instance and returns a render function. Both forms produce
|
|
;; the same normalized View tree and share props, slots, styles, and Context.
|
|
|
|
;;; Code:
|
|
|
|
(require 'cl-lib)
|
|
(require 'etaf-view)
|
|
|
|
(define-error 'etaf-component-definition-error
|
|
"Invalid ETAF Component definition"
|
|
'etaf-view-error)
|
|
|
|
(defun etaf--component-definition-error (format-string &rest arguments)
|
|
"Signal a Component definition error from FORMAT-STRING and ARGUMENTS."
|
|
(signal 'etaf-component-definition-error
|
|
(list (apply #'format format-string arguments))))
|
|
|
|
(defun etaf--parse-component-props (arguments)
|
|
"Return prop names from Component argument declaration ARGUMENTS."
|
|
(unless (proper-list-p arguments)
|
|
(etaf--component-definition-error
|
|
"Component prop declaration must be a proper list: %S" arguments))
|
|
(let ((tail arguments)
|
|
prop-names)
|
|
(when tail
|
|
(unless (eq (pop tail) '&key)
|
|
(etaf--component-definition-error
|
|
"Component props must use (&key NAME ...), got %S" arguments)))
|
|
(dolist (entry tail)
|
|
(unless (symbolp entry)
|
|
(etaf--component-definition-error
|
|
"Component props must be symbols without defaults: %S" entry))
|
|
(when (or (keywordp entry) (memq entry '(nil t)))
|
|
(etaf--component-definition-error
|
|
"Component prop name must be an ordinary symbol: %S" entry))
|
|
(when (memq entry prop-names)
|
|
(etaf--component-definition-error
|
|
"Duplicate Component prop: %S" entry))
|
|
(push entry prop-names))
|
|
(nreverse prop-names)))
|
|
|
|
(defun etaf--component-prop-key (name)
|
|
"Return the public keyword used to pass prop NAME."
|
|
(if (keywordp name)
|
|
name
|
|
(intern (concat ":" (symbol-name name)))))
|
|
|
|
(defun etaf-current-prop (name)
|
|
"Return current Component prop NAME.
|
|
|
|
NAME is normally an ordinary symbol used by the `:setup' lexical shorthand.
|
|
The function is also useful to code that deliberately avoids that shorthand."
|
|
(plist-get etaf--current-component-props
|
|
(etaf--component-prop-key name)))
|
|
|
|
(defun etaf-current-slots ()
|
|
"Return the current Component's normalized slot alist."
|
|
etaf--current-component-slots)
|
|
|
|
(defun etaf-current-slot (name &optional fallback)
|
|
"Return the child list for slot NAME, or FALLBACK when it is absent."
|
|
(let ((entry (assq name etaf--current-component-slots)))
|
|
(if entry (cdr entry) fallback)))
|
|
|
|
(defun etaf--component-prop-bindings (props)
|
|
"Return lexical bindings for stateless Component PROPS."
|
|
(mapcar (lambda (prop)
|
|
`(,prop
|
|
(etaf--resolve-property-value
|
|
(plist-get etaf--component-props
|
|
,(etaf--component-prop-key prop)))))
|
|
props))
|
|
|
|
(defun etaf--component-prop-symbol-macros (props)
|
|
"Return symbol macros that read current Component PROPS."
|
|
(mapcar (lambda (prop)
|
|
`(,prop (etaf-current-prop ',prop)))
|
|
props))
|
|
|
|
(defun etaf--validate-styles-form (form name)
|
|
"Validate static Component styles FORM for Component NAME."
|
|
(when form
|
|
(unless (and (consp form) (eq (car form) 'styles))
|
|
(etaf--component-definition-error
|
|
"Component %S :styles must be a (styles RULE ...) form" name))
|
|
(dolist (rule (cdr form))
|
|
(unless (and (consp rule) (stringp (car rule)))
|
|
(etaf--component-definition-error
|
|
"Component %S style rules need string selectors: %S" name rule))
|
|
(let ((attributes (cdr rule)))
|
|
(unless (zerop (% (length attributes) 2))
|
|
(etaf--component-definition-error
|
|
"Component %S style rule has an incomplete property pair: %S"
|
|
name rule))
|
|
(while attributes
|
|
(let ((key (pop attributes)))
|
|
(pop attributes)
|
|
(unless (keywordp key)
|
|
(etaf--component-definition-error
|
|
"Component %S style properties must be keywords: %S"
|
|
name key)))))))
|
|
form)
|
|
|
|
;;;###autoload
|
|
(defmacro etaf-define-component (name arguments &rest clauses)
|
|
"Define Component NAME from prop ARGUMENTS and CLAUSES.
|
|
|
|
The definition boundary is intentionally small:
|
|
|
|
(etaf-define-component NAME (&key PROPS)
|
|
:view VIEW
|
|
:styles (styles (SELECTOR ATTR ...)))
|
|
|
|
or:
|
|
|
|
(etaf-define-component NAME (&key PROPS)
|
|
:setup SETUP
|
|
:styles (styles (SELECTOR ATTR ...)))
|
|
|
|
`:view' is rendered for every update. `:setup' runs once per retained
|
|
Component instance and must return a zero-argument render function. View
|
|
forms do not use quote; ordinary Elisp belongs in `expr :value'."
|
|
(declare (indent 2) (debug defun))
|
|
(unless (symbolp name)
|
|
(etaf--component-definition-error
|
|
"Component name must be a symbol: %S" name))
|
|
(let ((docstring (when (stringp (car clauses)) (pop clauses)))
|
|
view-form
|
|
setup-form
|
|
styles-form
|
|
saw-view
|
|
saw-setup
|
|
saw-styles)
|
|
(while clauses
|
|
(let ((keyword (pop clauses)))
|
|
(unless (keywordp keyword)
|
|
(etaf--component-definition-error
|
|
"Expected a Component definition keyword, got %S" keyword))
|
|
(unless clauses
|
|
(etaf--component-definition-error
|
|
"Component %S keyword %S has no value" name keyword))
|
|
(pcase keyword
|
|
(:view
|
|
(when saw-view
|
|
(etaf--component-definition-error
|
|
"Component %S has duplicate :view" name))
|
|
(setq view-form (pop clauses) saw-view t))
|
|
(:setup
|
|
(when saw-setup
|
|
(etaf--component-definition-error
|
|
"Component %S has duplicate :setup" name))
|
|
(setq setup-form (pop clauses) saw-setup t))
|
|
(:styles
|
|
(when saw-styles
|
|
(etaf--component-definition-error
|
|
"Component %S has duplicate :styles" name))
|
|
(setq styles-form (pop clauses) saw-styles t))
|
|
(_
|
|
(etaf--component-definition-error
|
|
"Unknown Component definition keyword %S" keyword)))))
|
|
(when (and saw-view saw-setup)
|
|
(etaf--component-definition-error
|
|
"Component %S must choose :view or :setup, not both" name))
|
|
(unless (or saw-view saw-setup)
|
|
(etaf--component-definition-error
|
|
"Component %S requires exactly one of :view or :setup" name))
|
|
(let* ((props (etaf--parse-component-props arguments))
|
|
(styles-form (etaf--validate-styles-form styles-form name))
|
|
(definition-symbol
|
|
(intern (format "%s--etaf-component-definition" name)))
|
|
(render-lambda
|
|
(when saw-view
|
|
`(lambda (etaf--component-props etaf--component-slots)
|
|
(let ((etaf--current-component-props etaf--component-props)
|
|
(etaf--current-component-slots etaf--component-slots)
|
|
(etaf--current-component-instance
|
|
etaf--current-component-instance))
|
|
(let ,(etaf--component-prop-bindings props)
|
|
,(etaf--compile-view-form view-form :projection))))))
|
|
(setup-lambda
|
|
(when saw-setup
|
|
`(lambda (etaf--component-props etaf--component-slots)
|
|
(let ((etaf--current-component-props etaf--component-props)
|
|
(etaf--current-component-slots etaf--component-slots))
|
|
(cl-symbol-macrolet
|
|
,(etaf--component-prop-symbol-macros props)
|
|
,setup-form))))))
|
|
`(progn
|
|
(defconst ,definition-symbol
|
|
(etaf--component-spec-create
|
|
:name ',name
|
|
:props ',props
|
|
:render ,render-lambda
|
|
:setup ,setup-lambda
|
|
:styles ',styles-form)
|
|
,(or docstring
|
|
(format "Definition of ETAF Component `%s'." name)))
|
|
(etaf--register-component ',name ,definition-symbol)
|
|
',name))))
|
|
|
|
(provide 'etaf-component)
|
|
|
|
;;; etaf-component.el ends here
|