geekinney/etaf
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

feat: implement unified etaf architecture

Browse Source 
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.
This commit is contained in:
Kinneyzhang 2026-08-05 02:56:13 +08:00
parent 0185c4e05a
commit 43b17192d9
29 changed files with 6300 additions and 473 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

26
Makefile
View File

@ -1,18 +1,30 @@
EMACS ?= emacs
LOAD_PATH = -L . -L ../emacs-box
SOURCES = etaf-view.el etaf-component.el etaf-renderer.el etaf.el
SOURCES = etaf-view.el etaf-component.el etaf-reactive.el etaf-context.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf.el etaf-ui.el etaf-playground.el
TESTS = tests/etaf-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-ui-tests.el tests/etaf-playground-tests.el
.PHONY: test compile check clean
.PHONY: test compile load checkdoc docs-check check clean
test:
$(EMACS) -Q --batch $(LOAD_PATH) -l tests/etaf-tests.el \
test: compile
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" -l tests/etaf-tests.el -l tests/etaf-resource-tests.el -l tests/etaf-data-tests.el -l tests/etaf-ui-tests.el -l tests/etaf-playground-tests.el \
-f ert-run-tests-batch-and-exit
compile:
compile: clean
$(EMACS) -Q --batch $(LOAD_PATH) \
--eval "(dolist (file '(\"etaf-view.el\" \"etaf-component.el\" \"etaf-renderer.el\" \"etaf.el\")) (byte-compile-file file))"
--eval "(load-file \"etaf.el\")" \
--eval "(dolist (file '(\"etaf-view.el\" \"etaf-component.el\" \"etaf-reactive.el\" \"etaf-context.el\" \"etaf-resource.el\" \"etaf-data.el\" \"etaf-renderer.el\" \"etaf-runtime.el\" \"etaf-behavior.el\" \"etaf-actions.el\" \"etaf-events.el\" \"etaf.el\" \"etaf-ui.el\" \"etaf-playground.el\")) (byte-compile-file file))"
check: compile test
load: compile
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" --eval "(require 'etaf)" --eval "(princ \"ETAF load OK\\n\")"
docs-check:
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" -l tests/etaf-docs-tests.el \
-f ert-run-tests-batch-and-exit
checkdoc:
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (directory-files "." t)) (when (string-suffix-p ".el" file) (checkdoc-file file))))'
check: checkdoc compile test docs-check
clean:
rm -f *.elc tests/*.elc

43
README.md
View File

@ -1,29 +1,31 @@
# ETAF
ETAF is the text-application framework built above the independent Ebox layout and rendering engine.
ETAF is a small text-application framework built above the independent [Ebox](../emacs-box) layout and rendering engine.
The public model is intentionally small:
Its complete public model is:
- `View` describes Hosts and Component calls.
- `Component` turns props into a View.
- `Ebox` measures, lays out, paints, and publishes the result.
```text
Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
```
Every structural form uses one shape:
Every visible structure uses one form:
```elisp
(name :property value ... child ...)
```
Properties come first and children come last. Property values are ordinary Elisp expressions. `expr` is the only executable child bridge:
The only child computation bridge is `expr :value`; attribute values are ordinary Elisp expressions.
```elisp
(etaf-view
(column
(text :face 'bold "Hello")
(text (expr :value (if ready "Ready" "Waiting")))))
(text
:color "#687386"
(expr :value (if ready "Ready" "Waiting")))))
```
Define a stateless Component with `:view`:
Define a Component:
```elisp
(etaf-define-component status-label (&key label)
@ -33,13 +35,18 @@ Define a stateless Component with `:view`:
(etaf-mount
"*etaf-demo*"
(etaf-view
(status-label :label "Connected")))
(etaf-view (status-label :label "Connected")))
```
`etaf-view` is the sole public View construction entry. View forms and Component `:view` forms do not use quote. Quote remains ordinary Elisp data syntax, for example `'bold` as a face symbol. A Renderable returned by ordinary Elisp must be constructed with an unquoted `(etaf-view ...)` inside `expr`.
`etaf-view` is the single public View constructor. Structural forms do not use quote; quote remains ordinary Elisp data syntax, such as `'bold`. A View returned from ordinary Elisp is explicitly constructed with `(etaf-view ...)` inside `expr`.
## Development checkout
## Documentation
- [Architecture](docs/architecture.en.md) · [中文架构](docs/architecture.zh.md)
- [User guide](docs/user-guide.en.md) · [中文用户指南](docs/user-guide.zh.md)
- [Implementation plan](docs/implementation-plan.en.md) · [中文实施计划](docs/implementation-plan.zh.md)
## Load and verify
During development, load the sibling Ebox checkout before ETAF:
@ -49,16 +56,10 @@ During development, load the sibling Ebox checkout before ETAF:
(require 'etaf)
```
The package metadata declares Ebox `1.0.1` as the runtime dependency. ETAF never calls Ebox private functions.
## Scope of this first slice
The repository currently establishes and tests the P0 grammar, `etaf-view`, `expr`, stateless `:view` Components, core Hosts (`text`, `fragment`, `container`, `row`, `column`, `stack`, `flex`, and `spacer`), and the Ebox mount bridge. Stateful `:setup`, slots, styles, Context, Behaviors, events, actions, data, and incremental Component reconciliation are subsequent implementation milestones; unsupported clauses fail explicitly.
Run the focused checks with:
Run the complete local gate:
```sh
make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
```
The target architecture and the sequenced implementation work are documented in [`docs/architecture.en.md`](docs/architecture.en.md) and [`docs/implementation-plan.en.md`](docs/implementation-plan.en.md). Chinese versions are kept beside them.
The gate byte-compiles the implementation, runs the core/Data/Resource/UI/Playground tests, and checks documentation/API boundaries. `etaf-ui` and `etaf-playground` are optional modules and are not loaded by the core facade.

45
README.zh-CN.md
View File

@ -1,29 +1,31 @@
# ETAF
ETAF 是构建在独立 Ebox 布局与渲染引擎之上的文本应用框架。
ETAF 是构建在独立 [Ebox](../emacs-box) 布局与渲染引擎之上的小型文本应用框架。
公共模型刻意保持很小：
完整的公共模型是：
- `View` 描述 Host 和 Component 调用。
- `Component` 根据 props 产生 View。
- `Ebox` 负责测量、布局、绘制和发布结果。
```text
Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
```
所有结构都使用同一种形状：
所有可见结构都使用一种形式：
```elisp
(name :property value ... child ...)
```
属性必须全部位于前面，子节点必须全部位于后面。属性值就是普通 Elisp 表达式；子节点中唯一的可执行桥接是 `expr`：
子节点中唯一的计算桥接是 `expr :value`；属性值则是普通 Elisp 表达式。
```elisp
(etaf-view
(column
(text :face 'bold "Hello")
(text (expr :value (if ready "Ready" "Waiting")))))
(text
:color "#687386"
(expr :value (if ready "Ready" "Waiting")))))
```
使用 `:view` 定义无状态 Component：
定义 Component：
```elisp
(etaf-define-component status-label (&key label)
@ -33,15 +35,20 @@ ETAF 是构建在独立 Ebox 布局与渲染引擎之上的文本应用框架。
(etaf-mount
"*etaf-demo*"
(etaf-view
(status-label :label "Connected")))
(etaf-view (status-label :label "Connected")))
```
`etaf-view` 是唯一公共 View 构造入口。View 结构和 Component 的 `:view` 都不需要 quote；quote 仍然是普通 Elisp 数据语法，例如用 `'bold` 表示 face 符号。普通 Elisp 表达式返回 Renderable 时，必须在 `expr` 中使用未 quote 的 `(etaf-view ...)` 构造它。
`etaf-view` 是唯一的公共 View 构造入口。结构 form 不使用 quote；quote 仍然是普通 Elisp 数据语法，例如 `'bold`。普通 Elisp 返回 View 时，必须在 `expr` 中显式使用 `(etaf-view ...)` 构造它。
## 开发检出
## 文档
开发时先把同级的 Ebox 检出目录加入 `load-path`：
- [English Architecture](docs/architecture.en.md) · [中文架构](docs/architecture.zh.md)
- [English User Guide](docs/user-guide.en.md) · [中文用户指南](docs/user-guide.zh.md)
- [English Implementation Plan](docs/implementation-plan.en.md) · [中文实施计划](docs/implementation-plan.zh.md)
## 加载与验证
开发时先把同级 Ebox 检出目录加入 `load-path`：
```elisp
(add-to-list 'load-path "/path/to/github/emacs-box")
@ -49,16 +56,10 @@ ETAF 是构建在独立 Ebox 布局与渲染引擎之上的文本应用框架。
(require 'etaf)
```
包元数据声明 Ebox `1.0.1` 为运行时依赖。ETAF 不调用 Ebox 私有函数。
## 第一阶段范围
当前仓库建立并测试 P0 语法、`etaf-view`、`expr`、无状态 `:view` Component、核心 Host（`text`、`fragment`、`container`、`row`、`column`、`stack`、`flex`、`spacer`）以及 Ebox 挂载桥接。状态型 `:setup`、slot、styles、Context、Behavior、事件、Action、数据和增量 Component 协调将在后续里程碑实现；暂未实现的子句会显式报错。
运行聚焦检查：
运行完整本地门禁：
```sh
make check EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
```
目标架构和分阶段开发工作分别见 [`docs/architecture.zh.md`](docs/architecture.zh.md) 与 [`docs/implementation-plan.zh.md`](docs/implementation-plan.zh.md)，英文版本与中文版本并列维护。
门禁会编译实现、运行 core/Data/Resource/UI/Playground 测试，并检查文档和 API 边界。`etaf-ui` 与 `etaf-playground` 是可选模块，不会被 core facade 自动加载。

448
docs/architecture.en.md
View File

@ -1,160 +1,428 @@
# ETAF Architecture
This document defines the target architecture. It is a contract for public concepts and ownership, not a changelog.
This document is the normative architecture contract for ETAF. It defines the concepts, ownership, public grammar, and lowering path. Implementation status and follow-up work belong in [`implementation-plan.en.md`](implementation-plan.en.md); user-facing recipes belong in [`user-guide.en.md`](user-guide.en.md).
## 1. The one lowering path
## 1. Design result
ETAF is one View and Component layer for text applications. Elisp remains the complete computation language, while Ebox remains the measurable layout and text-rendering engine.
```text
Application
→ Runtime / State / Action / Data
→ Component(props, local scope)
→ Runtime / reactive state / Action / Data
→ Component(props, local Scope)
→ View
→ ETAF Renderer
→ Renderer
→ Ebox Node
→ measure → layout → paint → commit
→ Emacs buffer
```
ETAF describes application structure and behavior. Ebox is the lower-level engine that turns a measurable Node tree into text surfaces and atomically publishes those surfaces. A new ETAF feature must have one owner in this path.
The design has five invariants:
## 2. Four concepts users need
- Every visible structure uses the same `NAME + attributes + children` shape.
- Every capability has one owner: View for structure, Component for reuse, Runtime for lifetime, reactive state for invalidation, and Ebox for geometry and publication.
- Upper layers reuse lower-layer contracts instead of introducing parallel concepts.
- Computation is ordinary Elisp in expression positions; it is never disguised as another visual node family.
- A failed render candidate never replaces the last committed buffer.
### View
## 2. The model users learn
View is the structural description of a result. A View can be a Host call, a Component call, a string text leaf, `nil`, or a sequence of those values.
| Concept | What it is | What it owns |
| --- | --- | --- |
| View | A normalized interface description | Hosts, Component calls, text, and child structure |
| Host | A fixed structural View name | Core text or layout meaning |
| Component | A reusable View producer | Props, optional local Scope, slots, and lifecycle |
| Runtime | One mounted application | Rendering, events, scheduling, commit, rollback, and disposal |
| Ebox Node | The lower-level renderable object | Geometry, layout, surfaces, scrolling, and buffer publication |
### Component
These are mechanisms rather than additional visual node types:
Component is the reusable boundary. It receives props, owns optional local scope, and produces a View. A Component is not a second kind of Ebox node and does not require a new renderer branch merely because it is reusable.
- `expr` evaluates one child expression.
- `slot` reads or contributes to the one Component slot collection.
- `Behavior` installs reusable non-visual interaction.
- `Action` names a business mutation entry.
- `Effect` owns subscriptions and external synchronization.
- `watch` observes reactive state.
- `Context` provides inherited dependencies.
- `Data` owns application-data state and source requests.
- `raw-ebox` is the explicit low-level escape at the ETAF/Ebox boundary.
### Node
Node is Ebox's measurable and renderable model. Ebox owns geometry, box model, layout, surface properties, scrolling, runtime identity, and buffer publication. ETAF does not put Component semantics, slots, actions, or events into Ebox properties.
### Runtime
Runtime owns mounting, scheduling, state invalidation, event boundaries, commit coordination, rollback, and disposal. Runtime is an application boundary, not another View node.
## 3. One View grammar
## 3. The unified View grammar
Every Host and Component call has one shape:
```elisp
```text
(NAME ATTRIBUTE* CHILD*)
ATTRIBUTE = :KEY VALUE
```
An attribute is `:KEY VALUE`; a child is a View, string, `nil`, or a sequence produced through `expr`. The attribute region must be complete before the child region begins:
```elisp
(text :face 'bold :color "#F4F6FB" "Hello")
```
This is invalid because the regions are interleaved:
```elisp
(text "Hello" :face 'bold)
```
The same rule applies to core Hosts and public Components. There is no separate positional-content convention for `text`.
## 4. Elisp evaluation boundary
The compiler reads structural View positions. It does not require quote around a View:
```elisp
(etaf-view (text "Hello"))
```
Attribute values are ordinary Elisp expression positions:
Properties must be complete before the first child. A child can be a string, a normalized View, `nil`, or a sequence returned through `expr`.
```elisp
(etaf-view
(text :face (if dark 'light 'dark) "Theme"))
(column
:class "welcome"
(text :face 'bold "Hello")
(text
:color "#687386"
(expr :value (if ready "Ready" "Waiting")))))
```
The child region has one explicit computation bridge:
An attribute appearing after a child is invalid because the two regions may
not be interleaved.
`etaf-view` is the sole public structural constructor. The macro reads View forms structurally and produces a normalized View value; `etaf-render` lowers a pure View, and `etaf-mount` gives a View a retained Runtime and buffer.
### 3.1 Quote and evaluation
The rule is simple:
1. Structural View positions are not quoted. This includes `etaf-view`, Hosts, Component calls, children, slot forms, and static Component styles.
2. Elisp expression positions follow normal Elisp evaluation. This includes attribute values, `:key`, `:on-*`, `:use`, `expr :value`, `:setup`, Context values, Behavior constructors, Actions, and `raw-ebox :value`.
```elisp
(expr :value (if checked "☑" "☐"))
```
(etaf-view
(text
:face (if dark 'light 'dark)
(expr :value label)))
`expr` accepts exactly `:value`. `if`, `when`, `cond`, `let`, `mapcar`, and other Elisp forms remain ordinary Elisp inside that value. ETAF does not add separate `if`, loop, or computation node categories.
An expression that returns a View constructs it explicitly:
```elisp
(expr
(etaf-view
(column
(expr
:value
(when open
(etaf-view (text :face 'bold "Details"))))
(etaf-view
(text :face 'bold "Details"))))))
```
`'(text "Details")` is data, not a View. Quote is therefore neither globally forbidden nor used as a second View compiler.
`'bold` is an ordinary Elisp literal symbol. `'(text "Details")` is ordinary data, not a View; use `(etaf-view (text "Details"))` when an Elisp expression must construct a View. ETAF does not run `eval` on quoted View data and does not add separate literal/eval nodes.
## 5. Components
Attribute values do not need an `expr` wrapper. `expr` exists only because the child region is structural and needs one explicit bridge to arbitrary Elisp.
The public definition model has one beginner form and one advanced form:
### 3.2 Expression semantics
`expr` accepts exactly one property and no children:
```elisp
(expr :value ELISP-EXPRESSION)
```
It evaluates the expression, then accepts a string, View, sequence, or `nil`. It creates no Ebox wrapper, identity, lifecycle, watcher, or effect. `if`, `when`, `cond`, `let`, `mapcar`, `cl-loop`, and other Elisp forms remain ordinary Elisp inside `:value`.
## 4. Components
The public definition macro has exactly three keywords:
```elisp
(etaf-define-component NAME (&key PROPS)
:view VIEW)
DOCSTRING?
:view VIEW
:styles (styles RULE...))
(etaf-define-component NAME (&key PROPS)
:setup SETUP)
DOCSTRING?
:setup SETUP
:styles (styles RULE...))
```
`:view` is structural syntax and needs no quote. `:setup` is ordinary Elisp; it establishes Component Scope and returns a zero-argument render function that uses `etaf-view` when ordinary Elisp produces a View. `:view` and `:setup` are mutually exclusive. Static component styles use the separate definition metadata entry `:styles (styles RULE...)`; styles are not a third rendering model.
`:view` and `:setup` are mutually exclusive. `:styles` is optional and may appear once. Props are the only declared business inputs; ordinary trailing children and named slots are normalized separately into the Component's slot collection.
Props and children have different owners. Props are named inputs declared by the Component. Trailing children and named slots form one slot collection; children are not a hidden second Component argument list. The Component boundary is the place where that collection is normalized and projected.
### 4.1 Stateless and stateful forms
Within View syntax, public Component aliases may omit the `etaf-` package prefix. Ordinary Elisp APIs such as `etaf-value`, `etaf-ref`, and `etaf-mount` keep their prefix. Alias resolution is contextual; a collision receives a semantic alias such as `list-view` rather than shadowing Elisp's `list`.
```elisp
(etaf-define-component status-label (&key label)
"Render a status label."
:view
(text
:face 'bold
(expr :value label)))
```
## 6. Core Hosts and official Components
```elisp
(etaf-define-component disclosure (&key title)
"Render a retained disclosure."
:setup
(let ((open (etaf-ref nil)))
(lambda ()
(etaf-view
(column
(text
:role 'button
:on-press
(lambda ()
(setf (etaf-value open)
(not (etaf-value open))))
(expr :value (if (etaf-value open) "Hide" "Show")))
(expr
:value
(when (etaf-value open)
(etaf-view (text (expr :value title))))))))))
```
ETAF core contains only minimal, unstyled Hosts:
`:setup` runs once for a retained Component instance and must return a zero-argument render function. Re-render reads current props and refs without rerunning setup. Setup is the owner for local refs, computed values, watches, Effects, and cleanup registration.
`:key` is stable identity metadata, not a business prop. On a Component call it selects the retained Component instance within the sibling scope; on a Host or `raw-ebox` it is forwarded as the Ebox node key. If a render candidate fails, the Runtime restores the previous instance, handlers, behaviors, and buffer.
In View syntax, canonical Component names may omit the `etaf-` prefix. If the short name would collide with an Elisp function, special form, or Host, the registry assigns a semantic `-view` alias. Ordinary Elisp APIs such as `etaf-value`, `etaf-ref`, and `etaf-mount` always keep their prefix.
## 5. Children and slots
All Component content is one slot collection:
```text
slots.default = ordinary trailing children
slots.NAME = named slot content
```
Children are the convenient authoring form of the anonymous/default slot; they are not a second content model and do not appear in the business `&key` declaration.
Trailing children fill the default slot:
```elisp
(card
:title "Account"
(text "Card body"))
```
Named content uses the same structural shape:
```elisp
(card
:title "Account"
(slot :name 'header (text :face 'bold "Account settings"))
(text "Card body"))
```
Inside a Component View, the default outlet and its fallback are:
```elisp
(slot)
(slot (text :face 'shadow "No content"))
```
The explicit normalized spelling is:
```elisp
(slot :name 'default (text :face 'shadow "No content"))
```
Named slot names are stable non-keyword symbols. Strings, numbers, variables, and runtime expressions are rejected because a slot name is part of retained structure. A named input may appear only once. An explicitly empty input `(slot :name 'header)` suppresses the outlet fallback. Slot forms do not create Ebox wrappers.
Inside a Component, `slot` projects content. In a Component call's child region, `slot :name` contributes content. The compiler uses the same normalized slot representation for both roles.
## 6. Core Hosts and Ebox
ETAF core intentionally provides only minimal, unstyled Hosts:
```text
text · fragment · container · row · column · stack · flex · spacer
```
These names describe structural layout and text surfaces. Product-ready controls such as Button, Checkbox, Input, Dialog, and DataGrid are ordinary Components supplied by the independent `etaf-ui` package. Core pressability uses semantic properties such as `:role` and `:on-press`; it does not create a competing core Button Host.
Strings are the smallest text View and lower to an Ebox box with content. `text` is the explicit text Host for styling and semantic properties; it is not a separate Ebox node family.
## 7. Non-visual capabilities
These mechanisms extend the same Component/Host boundary without creating parallel visual node categories:
| Mechanism | Owns | Entry |
| Host | Meaning | Lowering direction |
| --- | --- | --- |
| `on-xx` | One local event callback | Host/Component attribute |
| Action | Named, testable business mutation | Action definition and dispatch |
| Effect | External synchronization, subscriptions, cleanup | Effect in Scope |
| Behavior | Reusable non-visual capability bundle | `:use` attribute |
| watch | Reactive invalidation primitive | Reactive API or Behavior |
| Context | Inherited Scope value | Provide / Inject |
| Data | Request, state, cancellation, and error ownership | Core data API |
| `text` | A text surface with optional inline runs | Ebox box/content |
| `fragment` | Children without a visual wrapper | Flattened child sequence |
| `container` | Neutral child container | Ebox column/container path |
| `row` | Horizontal children | Ebox row layout |
| `column` | Vertical children | Ebox column layout |
| `stack` | A structural composition container | Ebox container path |
| `flex` | Flex-distributed children | Ebox flex layout |
| `spacer` | Intentional empty geometry | Ebox spacer |
An `expr` computes a child value. It does not own identity, lifecycle, subscriptions, buffer writes, or effects. A Behavior may use events, refs, Effects, and watches, but it never becomes a View node.
Strings are the smallest text View and lower to Ebox content. Nested `text` Views in a text-compatible position become propertized inline runs; a non-text child falls back to normal layout lowering. Text, View Hosts, Components, and Ebox Nodes are therefore successive representations, not competing element classes.
## 8. Package ownership
ETAF's Renderer is the only framework module that calls Ebox. It uses Ebox public constructors, property readers, host-reference queries, and publication APIs. Ebox does not know about Components, slots, Actions, Context, Behaviors, or Data.
`raw-ebox` is the one deliberate escape:
```elisp
(etaf-view
(raw-ebox
:key 'backend-row
:value (ebox-create :content "Low-level")))
```
It accepts only `:value` and optional `:key`. The returned Ebox Node remains opaque and does not receive Component props, slots, events, or Behaviors. Using it transfers measurement, identity, rollback, and backend responsibility to the caller.
## 7. Runtime and reactive state
Runtime mount is transactional:
```text
create Runtime
→ setup retained Components
→ render View candidate
→ lower and publish Ebox candidate
→ promote handlers, instances, and Behaviors
→ run mounted/updated lifecycle
```
An update follows the same path. Reactive refs and computed values invalidate the render effect; the Runtime scheduler flushes synchronously at the current boundary. A render write is rejected with `etaf-render-write-error`; mutate state from an event, Action, Effect, or watch callback.
Rendering, lowering, and Ebox publication form the rollback boundary. If one of those candidate steps fails, the last committed tree remains active. Lifecycle and cleanup callbacks run after the retained state is promoted and publication has completed; their errors remain visible and do not pretend to roll back an already published Ebox tree.
The reactive API is one model:
```elisp
(let* ((count (etaf-ref 0))
(double (etaf-computed
(lambda () (* 2 (etaf-value count))))))
(etaf-watch count
(lambda (new old)
(message "%s → %s" old new)))
(etaf-watch-effect
(lambda ()
(message "double=%s" (etaf-value double)))))
```
`etaf-effect-scope` owns effects and cleanup. Component setup automatically runs inside a Component Scope; disposing the Component stops child scopes, watchers, and resource cleanup.
## 8. Behavior, events, Actions, and Effects
```text
on-xx = one local callback attribute
Action = one named business mutation entry
Effect = one subscription/external-sync owner
Behavior = a reusable bundle installed on a Host or Component
```
Use a local callback for one interaction:
```elisp
(text
:role 'button
:on-press (lambda () (message "Opened"))
"Open")
```
Use `etaf-action-define` and `etaf-dispatch` when the mutation is named and shared. Use `etaf-define-behavior` or `etaf-behavior-create` when several Hosts need the same non-visual capability. Attach Behaviors with `:use`; a Behavior never becomes a View node and never writes the buffer directly.
`etaf-behavior-create` accepts the reserved `:install` attribute for an optional zero-argument installer. The installer may return a cleanup function; `etaf-current-behavior-context` exposes the current Runtime, structural path, and Host props while it runs. Installer state is disposed when the Behavior is replaced or its owner is unmounted.
Runtime events are dispatched through `etaf-dispatch-event`, and focus/hit testing use public Ebox Host-reference queries through `etaf-activate`, `etaf-focus`, `etaf-focus-next`, `etaf-host-ref-bounds`, and `etaf-host-ref-position`.
## 9. Context, Theme, Data, and Resource
### 9.1 Context and Theme
Context is an inherited Component Scope environment:
```elisp
(etaf-define-component service-provider ()
"Provide a reactive service to descendants."
:setup
(let ((service (etaf-ref "demo-service")))
(etaf-provide 'service service)
(lambda () (etaf-view (slot)))))
(etaf-define-component service-consumer ()
"Read the inherited service."
:setup
(let ((service (etaf-inject 'service nil t)))
(lambda ()
(etaf-view (text (expr :value (etaf-value service)))))))
(etaf-view (service-provider (service-consumer)))
```
Keys are stable ordinary symbols. The nearest ancestor wins; a missing required key signals `etaf-context-error`. Theme is a Context value containing a property plist:
```elisp
(etaf-define-component themed-shell ()
"Provide default text colors to a subtree."
:setup
(progn
(etaf-theme-provide
'(:color "#F4F6FB" :bgcolor "#202634"))
(lambda () (etaf-view (slot)))))
```
Explicit Host props override Component styles, and Component styles override Theme defaults.
### 9.2 Data
Data is a core ETAF capability, not a second framework package. A Data Source is a small capability plist:
```elisp
(etaf-data-source
:load (lambda (query page page-size)
(ignore query page page-size)
(let ((rows '((:id 1 :name "Ada"))))
(list :items rows :total (length rows))))
:mutate (lambda (operation payload)
(ignore operation payload)
t)
:dispose (lambda () t))
```
`:load` is required and receives `QUERY`, `PAGE`, and `PAGE-SIZE`; it returns a plist with `:items` and optional `:total`, `:page`, and `:page-size`. `:mutate` and `:dispose` are optional. The core boundary is synchronous so it does not need a Promise, Task, or Executor concept. External callback-based integrations can publish their result through the same reactive refs or a Resource boundary.
`etaf-data-controller` owns query, pagination, items, total, status, error, selection, request generation, and disposal. `etaf-data-memory-source` is the built-in source used for examples and tests. Storage packages are concrete sources; SQLite is not a core assumption and an ORM, when used, remains outside ETAF's data model.
### 9.3 Resource and error boundary
`etaf-resource` is a Scope-owned synchronous loader with reactive `loading`, `success`, and `error` state:
```elisp
(let* ((filename "README.md")
(resource
(etaf-resource
(lambda ()
(with-temp-buffer
(insert-file-contents filename)
(buffer-string)))))
(stop
(etaf-watch-effect
(lambda ()
(message "resource=%s" (etaf-resource-status resource))))))
(unwind-protect
(etaf-resource-value resource)
(funcall stop)
(etaf-resource-dispose resource)))
```
`etaf-resource-result` adds replacement/disposal cleanup. `etaf-error-boundary-run` is an explicit function boundary: it handles errors raised by its body and leaves unrelated errors visible. Resource and Data state are projected into ordinary `expr` branches rather than special Error or Loading nodes.
## 10. Official UI and package boundaries
There is one formal reusable interface concept: Component.
```text
ebox
└── optional ebox-playground
etaf → ebox
├── reactive / state / action / effect / data / ECSS
└── pure .etaf compiler
├── View / Component / Runtime
├── reactive / Action / Effect / Data
└── Renderer
etaf-ui → etaf
etaf-playground → etaf (+ etaf-ui for official Component examples)
└── official Button, Checkbox, Label, Panel, DataGrid, ... Components
etaf-playground → etaf
└── optionally etaf-ui for catalog examples
```
Ebox knows nothing about Components, slots, Actions, Context, or data. ETAF knows Ebox only through the renderer boundary and its public API. `etaf-data` is a core capability, not a user-required peer package. Database and external integrations use explicit data-source packages such as `etaf-sqlite`; no abstract public `etaf-adapters` layer is needed.
`etaf-ui` is the official ready-made Component catalog. Its public user concept is Component; files are maintainer boundaries. Controls, Widgets, and DataGrid are not parallel runtime types, and DataGrid is simply a compound Component built from the same View, props, slots, events, and Data contracts.
The two Playgrounds are independent optional tools. `ebox-playground` uses Ebox only; `etaf-playground` uses ETAF public APIs and never calls Ebox Playground or Ebox private functions.
The new `etaf-playground` uses ETAF public APIs and does not call Ebox private APIs or depend on `ebox-playground`. The existing `ebox-playground` uses Ebox public APIs only and does not load ETAF. Core packages do not load either Playground automatically.
## 9. Extension rule
Optional storage integrations should use explicit package names such as a concrete SQLite or PostgreSQL source. A generic adapter package would add a name without owning a stable behavior, so it is not part of the public model.
Prefer a Component, Behavior, Action, Effect, Context value, or data source when the feature is application-level. Add an Ebox property or Node only when the feature changes measurement, layout, surface painting, scrolling, or publication and has a complete owner for signature, dirty classification, rendering, rollback, and tests. This keeps the user model small while preserving a Turing-complete Elisp escape through ordinary expression positions and runtime APIs.
## 11. Extension rule
Before adding a new concept, choose the smallest existing owner:
| Need | Owner |
| --- | --- |
| Reusable visual composition | Component or ordinary View helper |
| One computed child | `expr` |
| Local derived value | `etaf-computed` |
| Reusable interaction | Behavior |
| Named mutation | Action |
| Cross-depth dependency | Context |
| Request or mutation state | Data / Resource |
| Geometry or layout algorithm | Ebox |
| Low-level backend escape | `raw-ebox` |
Add a new public concept only when an existing owner cannot express the behavior, the new owner can state identity/lifecycle/error/rollback rules, and a public-path test can prove it. This keeps the model small while retaining full Elisp expressiveness.

451
docs/architecture.zh.md
View File

@ -1,160 +1,427 @@
# ETAF 架构
本文定义目标架构，是公共概念和职责边界的契约，不是变更日志。
本文是 ETAF 的规范性架构契约，定义概念、职责、公共语法和 lowering 路径。实现状态与后续工作写在 [`implementation-plan.zh.md`](implementation-plan.zh.md)，面向用户的使用方式写在 [`user-guide.zh.md`](user-guide.zh.md)。
## 1. 唯一的降级路径
## 1. 设计结果
ETAF 是面向文本应用的统一 View 与 Component 层。Elisp 仍然是完整的计算语言，Ebox 仍然是负责可测量布局和文本渲染的底层引擎。
```text
Application
→ Runtime / State / Action / Data
→ Component(props, local scope)
应用
→ Runtime / 响应式状态 / Action / Data
→ Component(props, 局部 Scope)
→ View
→ ETAF Renderer
→ Renderer
→ Ebox Node
→ measure → layout → paint → commit
→ Emacs buffer
```
ETAF 描述应用结构和行为；Ebox 是底层引擎，负责把可测量的 Node 树转换为文本 surface，并原子地发布这些 surface。每个新的 ETAF 功能都必须在这条路径上拥有唯一职责归属。
设计有五条不变量：
## 2. 用户需要理解的四个概念
- 所有可见结构都使用同一种 `NAME + 属性 + 子节点` 形状。
- 每项能力只有一个 owner：View 负责结构，Component 负责复用，Runtime 负责生命周期，响应式状态负责失效，Ebox 负责几何和发布。
- 上层复用下层契约，不复制下层逻辑，也不引入平行概念。
- 计算在 Elisp 表达式位置中完成，不伪装成另一类视觉节点。
- 渲染候选失败时，绝不会替换上一次已提交的 buffer。
### View
## 2. 用户需要学习的模型
View 是结果的结构描述。View 可以是 Host 调用、Component 调用、字符串文本叶子、`nil`，或者这些值组成的序列。
| 概念 | 它是什么 | 它负责什么 |
| --- | --- | --- |
| View | 规范化后的界面描述 | Host、Component 调用、文本和子结构 |
| Host | 固定的结构性 View 名称 | 核心文本或布局语义 |
| Component | 可复用的 View 生产者 | Props、可选局部 Scope、slot 和生命周期 |
| Runtime | 一次挂载的应用运行 | 渲染、事件、调度、提交、回滚和释放 |
| Ebox Node | 更底层的可渲染对象 | 几何、布局、surface、滚动和 buffer 发布 |
### Component
以下是机制，不是额外的视觉节点类型：
Component 是复用边界。它接收 props，可选地拥有局部 Scope，并产生 View。Component 不是另一种 Ebox Node，也不应因为“可复用”就增加新的 renderer 分支。
- `expr` 计算一个子节点位置的表达式。
- `slot` 读写同一个 Component slot 集合。
- `Behavior` 安装可复用的非视觉交互能力。
- `Action` 命名业务状态变更入口。
- `Effect` 管理订阅和外部同步。
- `watch` 观察响应式状态。
- `Context` 提供继承的依赖。
- `Data` 管理应用数据状态和数据源请求。
- `raw-ebox` 是 ETAF/Ebox 边界上的明确底层出口。
### Node
## 3. 统一 View 语法
Node 是 Ebox 的可测量、可渲染模型。Ebox 负责几何、盒模型、布局、surface 属性、滚动、运行时身份和 buffer 发布。ETAF 不把 Component 语义、slot、Action 或事件塞进 Ebox 属性。
每个 Host 和 Component 调用都使用一种形状：
### Runtime
Runtime 负责挂载、调度、状态失效、事件边界、提交协调、回滚和销毁。Runtime 是应用边界，不是另一种 View 节点。
## 3. 统一的 View 语法
所有 Host 和 Component 调用都使用同一种形状：
```elisp
```text
(NAME ATTRIBUTE* CHILD*)
ATTRIBUTE = :KEY VALUE
```
属性是 `:KEY VALUE`；子节点是 View、字符串、`nil`，或通过 `expr` 产生的序列。属性区必须在子节点区之前完整结束：
```elisp
(text :face 'bold :color "#F4F6FB" "Hello")
```
下面的写法非法，因为属性区和子节点区交错：
```elisp
(text "Hello" :face 'bold)
```
核心 Host 和公共 Component 都遵循同一规则；`text` 没有另一套“位置参数作为内容”的特殊约定。
## 4. Elisp 求值边界
编译器读取结构位置中的 View，不要求对 View 使用 quote：
```elisp
(etaf-view (text "Hello"))
```
属性值是普通 Elisp 表达式位置：
属性必须在第一个子节点之前全部结束。子节点可以是字符串、规范化 View、`nil`，或者由 `expr` 返回的序列。
```elisp
(etaf-view
(text :face (if dark 'light 'dark) "Theme"))
(column
:class "welcome"
(text :face 'bold "Hello")
(text
:color "#687386"
(expr :value (if ready "Ready" "Waiting")))))
```
子节点区只有一个明确的计算桥接：
属性出现在子节点之后时，属性区和子节点区被交错，属于非法结构。
`etaf-view` 是唯一的公共结构构造入口。宏在结构位置读取 View form 并生成规范化 View 值；`etaf-render` 负责纯 View 的 lowering，`etaf-mount` 为 View 建立有状态 Runtime 并发布到 buffer。
### 3.1 quote 与求值
规则只有两条：
1. 结构性 View 位置不需要 quote，包括 `etaf-view`、Host、Component 调用、子节点、slot 和静态 Component styles。
2. Elisp 表达式位置遵循普通 Elisp 求值，包括属性值、`:key`、`:on-*`、`:use`、`expr :value`、`:setup`、Context 值、Behavior 构造器、Action 以及 `raw-ebox :value`。
```elisp
(expr :value (if checked "☑" "☐"))
```
(etaf-view
(text
:face (if dark 'light 'dark)
(expr :value label)))
`expr` 只接受 `:value`。`if`、`when`、`cond`、`let`、`mapcar` 及其他 Elisp 形式仍然是该 value 内的普通 Elisp；ETAF 不增加单独的 `if`、循环或计算节点类别。
表达式要返回 View 时，显式构造它：
```elisp
(expr
(etaf-view
(column
(expr
:value
(when open
(etaf-view (text :face 'bold "Details"))))
(etaf-view
(text :face 'bold "Details"))))))
```
`'(text "Details")` 是数据，不是 View。因此 quote 既不是全局禁止，也不是第二套 View 编译器。
`'bold` 是普通 Elisp 字面量 symbol。`'(text "Details")` 只是普通数据，不是 View；当 Elisp 表达式需要构造 View 时，使用 `(etaf-view (text "Details"))`。ETAF 不会对被 quote 的 View 数据再次 `eval`，也不增加单独的 literal/eval 节点。
## 5. Component
属性值不需要 `expr` 包装。`expr` 只因为子节点区是结构语法，需要一个明确的桥接点来执行任意 Elisp。
公共定义模型只有入门形式和高级形式：
### 3.2 expr 语义
`expr` 只接受一个属性且不能有子节点：
```elisp
(expr :value ELISP-EXPRESSION)
```
它执行表达式，然后接受字符串、View、View 序列或 `nil`。它不创建 Ebox wrapper、identity、生命周期、watch 或 effect。`if`、`when`、`cond`、`let`、`mapcar`、`cl-loop` 等 Elisp 形式仍然只是 `:value` 中的普通 Elisp。
## 4. Component
公共定义宏只有三个关键字：
```elisp
(etaf-define-component NAME (&key PROPS)
:view VIEW)
DOCSTRING?
:view VIEW
:styles (styles RULE...))
(etaf-define-component NAME (&key PROPS)
:setup SETUP)
DOCSTRING?
:setup SETUP
:styles (styles RULE...))
```
`:view` 是结构语法，不需要 quote；`:setup` 是普通 Elisp，用于建立 Component Scope 并返回零参数 render 函数；普通 Elisp 产生 View 时使用 `etaf-view`。`:view` 与 `:setup` 互斥。组件静态样式使用独立的定义元数据入口 `:styles (styles RULE...)`；styles 不是第三种渲染模型。
`:view` 和 `:setup` 互斥；`:styles` 可选且最多出现一次。Props 是唯一需要声明的业务输入；普通尾部子节点和命名 slot 会被规范化为 Component 的 slot 集合。
Props 和 children 的职责不同。Props 是 Component 声明的命名输入；末尾 children 和具名 slot 组成同一个 slot collection，而不是隐藏的第二套 Component 参数表。该 collection 在 Component 边界统一归一化并投影。
### 4.1 无状态与状态型形式
在 View 语法中，公共 Component 可以省略 `etaf-` 前缀；普通 Elisp API，如 `etaf-value`、`etaf-ref`、`etaf-mount`，保留前缀。别名解析只发生在结构位置；发生冲突时使用 `list-view` 这样的语义别名，不覆盖 Elisp 的 `list`。
```elisp
(etaf-define-component status-label (&key label)
"Render a status label."
:view
(text
:face 'bold
(expr :value label)))
```
## 6. 核心 Host 与官方 Component
```elisp
(etaf-define-component disclosure (&key title)
"Render a retained disclosure."
:setup
(let ((open (etaf-ref nil)))
(lambda ()
(etaf-view
(column
(text
:role 'button
:on-press
(lambda ()
(setf (etaf-value open)
(not (etaf-value open))))
(expr :value (if (etaf-value open) "Hide" "Show")))
(expr
:value
(when (etaf-value open)
(etaf-view (text (expr :value title))))))))))
```
ETAF 核心只包含最小的、无样式 Host：
`:setup` 对一个 retained Component instance 只运行一次，并且必须返回零参数 render 函数。重新渲染读取当前 props 和 ref，不重新运行 setup。setup 负责局部 ref、computed、watch、Effect 和 cleanup 的创建。
`:key` 是稳定的 identity metadata，不是业务 prop。放在 Component 调用上时，它选择同级作用域内要保留的 Component instance；放在 Host 或 `raw-ebox` 上时，它会作为 Ebox node key 向下传递。候选渲染失败时，Runtime 恢复旧 instance、handlers、Behaviors 和 buffer。
在 View 语法中，Component 的规范名称可以省略 `etaf-` 前缀。如果短名称会与 Elisp 函数、special form 或 Host 冲突，注册表会分配语义明确的 `-view` alias。普通 Elisp API，例如 `etaf-value`、`etaf-ref` 和 `etaf-mount`，始终保留前缀。
## 5. children 与 slot
所有 Component 内容都是同一个 slot 集合：
```text
slots.default = 普通尾部子节点
slots.NAME = 命名 slot 内容
```
children 只是匿名/默认 slot 的便捷写法，不是第二套内容模型，也不需要出现在业务 `&key` 声明中。
尾部子节点自动填充默认 slot：
```elisp
(card
:title "Account"
(text "Card body"))
```
命名内容使用同样的结构形状：
```elisp
(card
:title "Account"
(slot :name 'header (text :face 'bold "Account settings"))
(text "Card body"))
```
在 Component View 内，默认 outlet 以及 fallback 写法是：
```elisp
(slot)
(slot (text :face 'shadow "No content"))
```
完整的内部规范写法是：
```elisp
(slot :name 'default (text :face 'shadow "No content"))
```
对用户来说，优先使用前两个简写；只有需要明确名字时才写 `:name`。Slot 名称必须是稳定的、非 keyword 的 symbol。字符串、数字、变量和运行时表达式都会被拒绝，因为 slot 名称属于 retained 结构。同名输入只能出现一次。显式空输入 `(slot :name 'header)` 会抑制 outlet fallback。Slot form 不创建 Ebox wrapper。
在 Component 内，`slot` 表示投影；在 Component 调用的子节点区，带 `:name` 的 `slot` 表示贡献内容。编译器对两种位置使用同一个规范化 slot 表示。
## 6. Core Host 与 Ebox
ETAF core 只提供最小且无样式的 Host：
```text
text · fragment · container · row · column · stack · flex · spacer
```
这些名字表达结构布局和文本 surface。Button、Checkbox、Input、Dialog、DataGrid 等产品级控件都是独立 `etaf-ui` 包提供的普通 Component。核心的可按压能力通过 `:role`、`:on-press` 等语义属性表达，不建立与 `etaf-ui` Button 竞争的核心 Button Host。
字符串是最小文本 View，会降级为带 content 的 Ebox box；`text` 是用于样式和语义属性的显式文本 Host，不是另一种 Ebox Node 家族。
## 7. 非视觉能力
这些机制扩展同一个 Component/Host 边界，但不建立平行的视觉节点类别：
| 机制 | 职责 | 入口 |
| Host | 作者看到的含义 | lowering 方向 |
| --- | --- | --- |
| `on-xx` | 一个局部事件回调 | Host/Component 属性 |
| Action | 有名字、可测试的业务变更 | Action 定义和 dispatch |
| Effect | 外部同步、订阅和清理 | Scope 中的 Effect |
| Behavior | 可复用的非视觉能力集合 | `:use` 属性 |
| watch | 响应式失效原语 | Reactive API 或 Behavior |
| Context | 继承的 Scope 值 | Provide / Inject |
| Data | 请求、状态、取消和错误归属 | Core data API |
| `text` | 带可选 inline runs 的文本 surface | Ebox box/content |
| `fragment` | 不增加视觉 wrapper 的子节点集合 | 展平的子节点序列 |
| `container` | 中性的子节点容器 | Ebox container/column 路径 |
| `row` | 水平排列子节点 | Ebox row layout |
| `column` | 垂直排列子节点 | Ebox column layout |
| `stack` | 结构性的组合容器 | Ebox container 路径 |
| `flex` | 通过 flex 分配空间 | Ebox flex layout |
| `spacer` | 有意表达的空几何 | Ebox spacer |
`expr` 负责计算子节点值，不拥有身份、生命周期、订阅、buffer 写入或 Effect。Behavior 可以使用事件、ref、Effect 和 watch，但自身不会变成 View 节点。
字符串是最小的文本 View，会降低为 Ebox content。text 中兼容的嵌套 text 会成为带 text properties 的 inline run；非文本子节点则回到普通布局 lowering。因此 Text、View Host、Component 和 Ebox Node 是连续的表示层，而不是三棵相互竞争的树。
## 8. 包职责
ETAF 的 Renderer 是唯一调用 Ebox 的框架模块，并且只使用 Ebox 公共构造器、属性读取器、Host 引用查询和发布 API。Ebox 不理解 Component、slot、Action、Context、Behavior 或 Data。
`raw-ebox` 是唯一明确的底层出口：
```elisp
(etaf-view
(raw-ebox
:key 'backend-row
:value (ebox-create :content "Low-level")))
```
它只接受 `:value` 和可选的 `:key`。返回的 Ebox Node 保持 opaque，不获得 Component props、slot、事件或 Behavior 语义。使用它意味着调用方承担 measurement、identity、rollback 和 backend 契约。
## 7. Runtime 与响应式状态
Runtime 的挂载是事务性的：
```text
创建 Runtime
→ 建立 retained Component scope
→ 渲染 View 候选
→ lowering 并发布 Ebox 候选
→ 提升 handlers、instances 和 Behaviors
→ 运行 mounted/updated 生命周期
```
更新使用同一条路径。响应式 ref 和 computed 让 render effect 失效；Runtime scheduler 在当前边界同步 flush。渲染阶段写入状态会触发 `etaf-render-write-error`；状态应在事件、Action、Effect 或 watch callback 中改变。
渲染、lowering 和 Ebox 发布构成回滚边界。如果候选步骤之一失败，上一棵已提交的树仍保持 active。生命周期和 cleanup callback 在 retained state 提升且发布完成后运行；它们的错误会保持可见，但不会假装回滚已经发布的 Ebox tree。
响应式 API 只有一套模型：
```elisp
(let* ((count (etaf-ref 0))
(double (etaf-computed
(lambda () (* 2 (etaf-value count))))))
(etaf-watch count
(lambda (new old)
(message "%s → %s" old new)))
(etaf-watch-effect
(lambda ()
(message "double=%s" (etaf-value double)))))
```
`etaf-effect-scope` 负责 effects 和 cleanup。Component setup 自动运行在 Component Scope 内；Component 释放时，会停止子 scope、watcher 和 resource cleanup。
## 8. Behavior、事件、Action 与 Effect
```text
on-xx = 一个局部事件属性
Action = 一个命名的业务变更入口
Effect = 一个订阅/外部同步 owner
Behavior = 安装多个非视觉能力的可复用 bundle
```
一次性的交互直接使用 callback：
```elisp
(text
:role 'button
:on-press (lambda () (message "Opened"))
"Open")
```
当变更需要命名并被多个入口复用时，使用 `etaf-action-define` 和 `etaf-dispatch`。当多个 Host 需要同一套非视觉能力时，使用 `etaf-define-behavior` 或 `etaf-behavior-create`，并通过 `:use` 安装。Behavior 不是 View 节点，也不直接修改 buffer。
`etaf-behavior-create` 接受保留的 `:install` 属性，用于可选的零参数 installer。Installer 可以返回 cleanup；运行期间可通过 `etaf-current-behavior-context` 读取当前 Runtime、结构路径和 Host props。Behavior 被替换或 owner 卸载时，installer 状态会被释放。
Runtime 事件通过 `etaf-dispatch-event` 进入；命中测试和 focus 通过 Ebox Host 引用查询，并由 `etaf-activate`、`etaf-focus`、`etaf-focus-next`、`etaf-host-ref-bounds` 和 `etaf-host-ref-position` 提供公共入口。
## 9. Context、Theme、Data 与 Resource
### 9.1 Context 与 Theme
Context 是继承的 Component Scope 环境：
```elisp
(etaf-define-component service-provider ()
"Provide a reactive service to descendants."
:setup
(let ((service (etaf-ref "demo-service")))
(etaf-provide 'service service)
(lambda () (etaf-view (slot)))))
(etaf-define-component service-consumer ()
"Read the inherited service."
:setup
(let ((service (etaf-inject 'service nil t)))
(lambda ()
(etaf-view (text (expr :value (etaf-value service)))))))
(etaf-view (service-provider (service-consumer)))
```
key 使用稳定的普通 symbol。最近的祖先优先，缺失的 required key 触发 `etaf-context-error`。Theme 是一个 Context value，内容是属性 plist：
```elisp
(etaf-define-component themed-shell ()
"Provide default text colors to a subtree."
:setup
(progn
(etaf-theme-provide
'(:color "#F4F6FB" :bgcolor "#202634"))
(lambda () (etaf-view (slot)))))
```
显式 Host props 覆盖 Component styles，Component styles 覆盖 Theme defaults。
### 9.2 Data
Data 是 ETAF core 能力，不是需要用户额外学习的第二套框架。Data Source 是一个小的 capability plist：
```elisp
(etaf-data-source
:load (lambda (query page page-size)
(ignore query page page-size)
(let ((rows '((:id 1 :name "Ada"))))
(list :items rows :total (length rows))))
:mutate (lambda (operation payload)
(ignore operation payload)
t)
:dispose (lambda () t))
```
`:load` 必选，接收 `QUERY`、`PAGE` 和 `PAGE-SIZE`，返回带 `:items` 的 plist，可选 `:total`、`:page` 和 `:page-size`。`:mutate` 和 `:dispose` 可选。核心边界刻意是同步的，因此不需要 Promise、Task 或 Executor 概念；外部 callback 型集成可以通过同一套响应式 ref 或 Resource 边界发布结果。
`etaf-data-controller` 负责 query、分页、items、total、status、error、selection、request generation 和释放。`etaf-data-memory-source` 是示例和测试使用的内存 source。存储包只是具体 source；SQLite 不是 core 前提，ORM 也保持在 ETAF 数据模型之外。
### 9.3 Resource 与 Error Boundary
`etaf-resource` 是 Scope 所有的同步 loader，拥有响应式的 `loading`、`success` 和 `error` 状态：
```elisp
(let* ((filename "README.md")
(resource
(etaf-resource
(lambda ()
(with-temp-buffer
(insert-file-contents filename)
(buffer-string)))))
(stop
(etaf-watch-effect
(lambda ()
(message "resource=%s" (etaf-resource-status resource))))))
(unwind-protect
(etaf-resource-value resource)
(funcall stop)
(etaf-resource-dispose resource)))
```
`etaf-resource-result` 为替换和释放提供 cleanup。`etaf-error-boundary-run` 是明确的函数边界：它处理 body 抛出的错误，让边界外的错误保持可见。Resource 和 Data 状态通过普通 `expr` 分支投影，不增加专门的 Error 或 Loading 节点。
## 10. 官方 UI 与包边界
正式的可复用界面概念只有 Component：
```text
ebox
└── 可选的 ebox-playground
etaf → ebox
├── reactive / state / action / effect / data / ECSS
└── 纯 .etaf compiler
├── View / Component / Runtime
├── reactive / Action / Effect / Data
└── Renderer
etaf-ui → etaf
etaf-playground → etaf（展示官方 Component 时再依赖 etaf-ui）
└── 官方 Button、Checkbox、Label、Panel、DataGrid 等 Component
etaf-playground → etaf
└── 展示官方 Component 时可选依赖 etaf-ui
```
Ebox 不理解 Component、slot、Action、Context 或 data。ETAF 只通过 renderer 边界和 Ebox 公共 API 使用 Ebox。`etaf-data` 是 core 能力，不是用户必须额外安装的平级包。数据库和外部集成使用明确的数据源包，例如 `etaf-sqlite`；不需要抽象的公共 `etaf-adapters` 层。
`etaf-ui` 是官方现成 Component 目录。用户只需要理解 Component；文件只是维护者边界。Controls、Widgets 和 DataGrid 不是平行的 Runtime 类型，DataGrid 只是由同一套 View、props、slot、事件和 Data 契约构成的复合 Component。
两个 Playground 都是独立的可选工具：`ebox-playground` 只使用 Ebox；`etaf-playground` 使用 ETAF 公共 API，绝不调用 Ebox Playground 或 Ebox 私有函数。
新的 `etaf-playground` 只使用 ETAF 公共 API，不调用 Ebox 私有 API，也不依赖 `ebox-playground`。现有的 `ebox-playground` 只使用 Ebox 公共 API，不加载 ETAF。Core 包不会自动加载任一 Playground。
## 9. 扩展规则
可选存储集成应使用具体名称，例如 SQLite 或 PostgreSQL source。通用 adapter 包无法拥有稳定的行为，只会增加用户需要记忆的名称，因此不属于公共模型。
应用层功能优先使用 Component、Behavior、Action、Effect、Context 值或 data source。只有当功能确实改变测量、布局、surface 绘制、滚动或发布，并且已经定义好 signature、dirty 分类、渲染、回滚和测试责任时，才增加 Ebox 属性或 Node。这样既保持用户模型小而统一，又通过普通表达式位置和 Runtime API 保留 Elisp 的图灵完备能力。
## 11. 拓展规则
增加新能力前，优先选择最小的既有 owner：
| 需求 | Owner |
| --- | --- |
| 可复用的视觉组合 | Component 或普通 View helper |
| 一个子节点计算 | `expr` |
| 局部派生值 | `etaf-computed` |
| 可复用交互 | Behavior |
| 命名变更 | Action |
| 跨层级依赖 | Context |
| 请求或变更状态 | Data / Resource |
| 几何或布局算法 | Ebox |
| 低层 backend 出口 | `raw-ebox` |
只有在现有 owner 无法表达、能够明确 identity/lifecycle/error/rollback 规则，并且可以用公共路径测试证明时，才增加新的公共概念。这样既保留完整的 Elisp 表达能力，又让用户模型保持干净。

167
docs/implementation-plan.en.md
View File

@ -1,63 +1,142 @@
# ETAF Implementation Plan
This document is the working plan for the independent `etaf` repository. The architecture contract lives in [`architecture.en.md`](architecture.en.md); this file records implementation order, verification, and explicit gaps.
This is the maintainer execution document for the independent `etaf` repository. [`architecture.en.md`](architecture.en.md) is the public design contract; [`user-guide.en.md`](user-guide.en.md) is the public usage contract. This document records delivery order, ownership, verification, and deliberately bounded follow-up work.
## 1. Milestones
## 1. Completion rule
| Milestone | Scope | Exit evidence |
A milestone is complete only when:
1. The public path exists, not only a private helper.
2. The public path has a failing-case test and a successful-case test.
3. The affected files compile without warnings.
4. The implementation has a paired English/Chinese documentation update when the public contract changes.
5. A failed candidate does not corrupt the last committed Runtime or buffer.
The repository is complete for the agreed unified architecture when the mandatory milestones below are green. More official Components, concrete storage sources, richer Ebox layouts, and asynchronous integrations are additive work; they must reuse the frozen contracts instead of widening the core vocabulary.
## 2. Milestone status
| Milestone | Delivered responsibility | Evidence |
| --- | --- | --- |
| P0 | Unified grammar, `etaf-view`, `expr`, stateless `:view`, core Hosts, Ebox bridge | Macro-expansion failures, ERT contract tests, byte compilation, mount smoke test |
| P1 | Slot collection, `:setup`, Component Scope, refs, lifecycle, raw Ebox escape | Public Component tests cover setup-once, props, slots, disposal, and rollback |
| P2 | Context, Behavior, focus/event protocol, Actions, Effects, watches | Real mounted event paths, cleanup tests, identity and failure tests |
| P3 | ECSS styles, themes, inline text runs, resource/error boundary | Style ordering, text-surface, async recovery, and buffer publication tests |
| P4 | Data capabilities, `etaf-ui`, data sources, playgrounds, use-case-driven layout extensions | Independent-load scans, package tests, application examples, and CI |
| P0 grammar | Unified View shape, property-first parsing, `etaf-view`, `expr :value`, core Hosts, aliases | `tests/etaf-tests.el` structural and syntax tests |
| P1 Components | `:view`, `:setup`, props, default/named slots, retained instances, lifecycle, `:key`, raw Ebox escape | Component, slot, mount, prop-update, raw-node, and rollback tests |
| P2 Runtime | refs, computed, effects, watches, Scope cleanup, Context, Theme, Behaviors, events, focus, Actions | Mounted event/focus tests, reactive failure rollback, cleanup tests |
| P3 presentation | scoped styles, selector matching, Theme precedence, inline text runs, Resource and error boundary | Style, Theme, text-surface, Resource, and error tests |
| P4 application layer | core Data Controller, memory source, selection, mutation, official UI catalog, DataGrid, ETAF Playground | Data, UI, DataGrid, playground, load-boundary, and static-scan tests |
| Quality gates | independent package entry, warning-free byte compilation, complete test command, documentation contract | `make check`, `make load`, and `docs-check` |
## 2. P0 delivered slice
## 3. Ownership map
- The repository is an independent package at `/Users/geekinney/IPARA/3-RESOURCES/emacs/config/github/etaf`.
- The only dependency is the sibling Ebox package during this checkout phase.
- `etaf-view.el` owns structural parsing and the single `expr :value` bridge.
- `etaf-component.el` owns stateless `:view` definitions and contextual aliases.
- `etaf-renderer.el` is the only module that calls Ebox; it uses public Ebox constructors and publication APIs.
- Core Hosts are minimal and unstyled: `text`, `fragment`, `container`, `row`, `column`, `stack`, `flex`, and `spacer`.
- Attribute/child ordering, ordinary Elisp evaluation boundaries, expression results, Component props, alias collisions, and mounting are covered by `tests/etaf-tests.el`.
| File | Stable responsibility | Must not own |
| --- | --- | --- |
| `etaf-view.el` | Structural grammar, View values, slot normalization, expression boundary, Component registry | Ebox calls, buffer writes, lifecycle, business state |
| `etaf-component.el` | `etaf-define-component`, prop declarations, definition-level styles validation | Runtime scheduling or Ebox lowering |
| `etaf-reactive.el` | refs, computed values, effects, watches, effect scopes, cleanup | View syntax or buffer publication |
| `etaf-context.el` | inherited Context and Theme defaults | global service registry or visual nodes |
| `etaf-runtime.el` | retained instances, candidate reconciliation, commit/rollback, lifecycle, Behavior installation | Ebox private state or business data schemas |
| `etaf-renderer.el` | the single ETAF-to-Ebox public boundary, styles, text lowering, raw escape | Component lifecycle and data requests |
| `etaf-behavior.el` | non-visual `:use` Behavior specs and installers | visual nodes or direct buffer mutation |
| `etaf-events.el` | event dispatch, Host reference hit testing, activation, focus | business mutation policy |
| `etaf-actions.el` | named Action registry and Runtime dispatch | View construction or presentation |
| `etaf-resource.el` | Scope-owned synchronous loader state and error boundary | a second async/task object model |
| `etaf-data.el` | source capability contract, controller state, pagination, mutation, selection | database-specific code or storage assumptions |
| `etaf-ui.el` | one official Component catalog, including compound DataGrid | a second Control/Widget/Component taxonomy |
| `etaf-playground.el` | public-API-only ETAF examples and optional preview entry points | Ebox private APIs or `ebox-playground` dependency |
| `etaf.el` | one core facade and local package load-path preference | loading optional UI or Playground modules |
## 3. P1 sequence
Do not split a file merely to create a shorter name. Split only when a stable responsibility, lifecycle, external boundary, or release boundary moves with the code.
1. Freeze the Component call and slot collection representation.
2. Implement `(slot)` and `(slot FALLBACK...)` as default-slot projection, then named `(slot :name 'NAME CHILD...)`.
3. Make trailing children and named slot declarations normalize into that same collection; reject dynamic, string, numeric, and keyword slot names.
4. Add `:setup` as ordinary Elisp that runs once per retained Component Scope and returns a zero-argument render function.
5. Add refs and computed values with stable identity, then connect props updates without rerunning setup.
6. Add explicit lifecycle and failed-candidate disposal before any stateful application example.
7. Add `raw-ebox :value` as the namespaced backend escape after the normal View path is proven.
## 4. Frozen public contracts
P1 must not add a second Template entry, a Variant definition model, a positional `text` exception, or a quote-based View convention.
### 4.1 View and evaluation
## 4. P2–P4 dependency order
- The only structural form is `(NAME :PROPERTY VALUE ... CHILD ...)`.
- All properties precede children.
- Attribute values are ordinary Elisp expressions.
- The only child computation bridge is `(expr :value ELISP-EXPRESSION)`.
- A dynamic View returned by Elisp is constructed with `(etaf-view ...)` inside `expr`; quoted structural data is never executed.
- Core Hosts are `text`, `fragment`, `container`, `row`, `column`, `stack`, `flex`, and `spacer`.
- `raw-ebox` accepts only `:value` and optional `:key` and remains opaque to ETAF semantics.
- Context depends on retained Component Scope and nearest-ancestor ownership.
- Behaviors depend on stable Host identity, events, refs, Effects, and disposal.
- Actions are business mutations and must not become View nodes or presentation callbacks.
- Effects own external synchronization and cleanup; `watch` remains a reactive primitive that a Behavior or Effect may use.
- ECSS and state styles depend on a frozen Ebox property boundary and text-surface mapping.
- Data remains an ETAF core capability. SQLite, PostgreSQL, MySQL, REST, file, and ORM implementations are optional concrete data-source packages.
- `etaf-ui` is one official Component catalog. Source file splits are maintainer boundaries, not user concepts; DataGrid is an ordinary compound Component.
- `ebox-playground` depends only on Ebox. `etaf-playground` depends on ETAF and optionally `etaf-ui`; neither depends on the other.
### 4.2 Component and slots
## 5. Verification gates
- `etaf-define-component` accepts only `:view`, `:setup`, and optional `:styles`.
- `:view` and `:setup` are mutually exclusive.
- `:setup` runs once per retained identity and returns a zero-argument render function.
- Props update render without rerunning setup.
- Trailing children are `slots.default`; named slot input uses `(slot :name 'NAME CHILD...)`.
- Default outlet shorthand is `(slot)` or `(slot FALLBACK...)`.
- Slot names are stable, non-keyword symbols only.
- `:key` is identity metadata, not a business prop: Component calls use it for retained identity, while Hosts and `raw-ebox` forward it as an Ebox node key.
Every milestone must pass the smallest relevant gate before the next boundary is started:
### 4.3 Runtime and non-visual capabilities
```sh
make compile EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
make test EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
```
- Refs, computed values, watches, Effects, and cleanup use one reactive Scope model.
- Context is inherited through retained Component instances; Theme is a Context property plist.
- `:on-*` is a local callback; Action is a named mutation; Behavior is a reusable `:use` bundle; Effect is the subscription/cleanup owner.
- Events and focus enter through Runtime and public Ebox Host-reference APIs.
- Data is core ETAF capability. A source has required `:load` and optional `:mutate`/`:dispose` capabilities.
- Resource is a Scope-owned synchronous loader; no task/promise abstraction is introduced into core.
P0 additionally requires a clean macro-expansion failure for malformed grammar and a real `etaf-mount` path. P1 adds setup/slot lifecycle tests. P2 adds mounted event and cleanup paths. P3 adds text-surface and publication tests. P4 adds package boundary scans, independent loading, and application smoke tests.
Changing one of these contracts requires an architecture-document review before implementation. Do not add a compatibility spelling to avoid making the decision.
No milestone is complete when only helper functions pass: public macro expansion, Component construction, renderer lowering, and buffer publication must all be exercised.
## 5. Verification matrix
## 6. Stop conditions
| Surface | Command or test | What it proves |
| --- | --- | --- |
| Package load | `make load EMACS=...` | The public facade loads against the sibling Ebox package |
| Byte compile | `make compile EMACS=...` | All distributable implementation files compile without warnings |
| Core behavior | `tests/etaf-tests.el` | Grammar, Component, Runtime, reactive, Context, styles, events, Actions, raw escape |
| Resource behavior | `tests/etaf-resource-tests.el` | Loading, errors, replacement cleanup, Scope disposal, explicit boundary |
| Data behavior | `tests/etaf-data-tests.el` | Query, pagination, normalization, mutation, selection, errors, stop |
| UI behavior | `tests/etaf-ui-tests.el` | Button, Checkbox, Panel slots, reactive DataGrid projection |
| Playground behavior | `tests/etaf-playground-tests.el` | Public ETAF mount and event flow without Ebox internals |
| Documentation | `tests/etaf-docs-tests.el` | Paired files, current names, no stale public entry examples, no private Ebox calls |
| Full gate | `make check EMACS=...` | Compile, all ERT tests, and docs contract together |
Do not introduce `etaf-template`, `Variant`, public Control/Widget categories, `etaf-data` as a required peer package, abstract `etaf-adapters`, or a second public View construction entry. Do not implement Grid, Overlay, or a complete CSS clone before a real application use case supplies a measurement, layout, and publication contract.
The test suite must exercise the public dispatch path for event and Runtime bugs. Pure helper tests do not replace mounted tests.
## 6. Review checklist for changes
Before changing code:
1. Name the owner of the behavior and the data flow from View to Ebox.
2. Search existing tests and sibling modules for the same public path.
3. Write the smallest failing regression test when behavior is wrong or missing.
4. Prefer deleting a redundant abstraction before adding a helper.
During implementation:
- Keep View values pure and keep buffer mutation at Runtime/Ebox publication boundaries.
- Keep cleanup attached to the Scope that created the resource.
- Let internal errors surface; catch only at an explicit loader or application boundary.
- Preserve structural identity for repeated sequences with `:key`.
- Keep Component style precedence and property/child ordering deterministic.
- Keep optional packages out of the core facade.
Before handoff:
- Read the full diff.
- Run `make check` and inspect all output.
- Run a fresh `make load` with only the local ETAF and sibling Ebox paths.
- Scan implementation files for `ebox--` and unrelated private calls.
- Update both language documents when a public contract changes.
- Commit one focused, verified change before starting another milestone.
## 7. Bounded follow-up work
The following are extension lanes, not missing core concepts:
| Extension | Required contract | Safe implementation direction |
| --- | --- | --- |
| Async external data | A concrete source must define callback, generation, cancellation, and error ownership | Add it to a concrete source package or a narrowly specified Data capability; do not add a generic task hierarchy |
| More UI Components | Existing props/children/slots/events/Behavior contract | Add ordinary Components to `etaf-ui` and test them through Runtime |
| Database sources | The frozen `etaf-data-source` capability plist | Use explicit packages such as a concrete SQLite/PostgreSQL source; keep storage out of core |
| Richer layouts | A complete Ebox measurement/layout/publication contract | Extend Ebox first, then expose it through a Host or Component |
| Visual Playground tooling | Public inspection and reporting APIs | Extend `etaf-playground` without coupling it to Ebox Playground |
Each extension must carry its own tests and documentation. If it needs a new public noun, update `architecture.en.md` and `architecture.zh.md` first, then this plan and the user guide.
## 8. Stop conditions
Stop a milestone when its public path, rollback behavior, tests, compile, load, and paired documentation are complete. Do not broaden the core model merely because an optional integration is not yet present. Do not create a second rendering grammar, a second Component model, or a package boundary that users must learn as a new runtime concept.

167
docs/implementation-plan.zh.md
View File

@ -1,63 +1,142 @@
# ETAF 实施计划
本文是独立 `etaf` 仓库的开发计划。架构契约见 [`architecture.zh.md`](architecture.zh.md)；本文记录实施顺序、验证方式和明确的缺口。
本文是独立 `etaf` 仓库的维护者执行文档。[`architecture.zh.md`](architecture.zh.md) 是公共架构契约，[`user-guide.zh.md`](user-guide.zh.md) 是用户使用契约。本文记录交付顺序、职责、验证和有边界的后续工作。
## 1. 里程碑
## 1. 完成规则
| 里程碑 | 范围 | 完成证据 |
只有同时满足以下条件，里程碑才算完成：
1. 公共路径真实存在，而不只是私有 helper。
2. 公共路径同时有成功测试和失败测试。
3. 受影响文件无 warning 地完成 byte compile。
4. 公共契约发生变化时，同步更新中英文文档。
5. 候选渲染失败时，不破坏上一次已经提交的 Runtime 或 buffer。
当下面的强制里程碑全部通过时，统一架构的实施完成。更多官方 Component、具体存储 source、更丰富的 Ebox 布局和异步集成都是增量工作，必须复用已经冻结的契约，不能扩大 core 词汇。
## 2. 里程碑状态
| 里程碑 | 已交付职责 | 证据 |
| --- | --- | --- |
| P0 | 统一语法、`etaf-view`、`expr`、无状态 `:view`、核心 Host、Ebox 桥接 | 宏展开失败测试、ERT 契约测试、字节编译、挂载 smoke test |
| P1 | slot collection、`:setup`、Component Scope、ref、生命周期、raw Ebox escape | 公共 Component 测试覆盖 setup-once、props、slot、销毁和回滚 |
| P2 | Context、Behavior、focus/event 协议、Action、Effect、watch | 真实挂载事件路径、清理测试、身份和失败测试 |
| P3 | ECSS 样式、主题、行内文本、resource/error boundary | 样式顺序、文本 surface、异步恢复和 buffer 发布测试 |
| P4 | Data 能力、`etaf-ui`、数据源、Playground、按用例增加布局能力 | 独立加载扫描、包测试、应用示例和 CI |
| P0 grammar | 统一 View 形状、属性优先解析、`etaf-view`、`expr :value`、核心 Host、alias | `tests/etaf-tests.el` 结构和语法测试 |
| P1 Component | `:view`、`:setup`、props、默认/命名 slot、retained instance、生命周期、`:key`、raw Ebox 出口 | Component、slot、mount、prop 更新、raw node、rollback 测试 |
| P2 Runtime | ref、computed、effect、watch、Scope cleanup、Context、Theme、Behavior、事件、focus、Action | 挂载事件/focus、响应式失败回滚和 cleanup 测试 |
| P3 presentation | 作用域样式、selector、Theme 优先级、inline text runs、Resource 和 error boundary | 样式、Theme、文本 surface、Resource、error 测试 |
| P4 application | core Data Controller、memory source、selection、mutation、官方 UI 目录、DataGrid、ETAF Playground | Data、UI、DataGrid、Playground、加载边界和静态扫描测试 |
| Quality gates | 独立包入口、无 warning 编译、完整测试命令、文档契约 | `make check`、`make load`、`docs-check` |
## 2. P0 已交付切片
## 3. 职责地图
- 独立包仓库位于 `/Users/geekinney/IPARA/3-RESOURCES/emacs/config/github/etaf`。
- 当前 checkout 阶段唯一依赖是同级 Ebox 包。
- `etaf-view.el` 负责结构解析以及唯一的 `expr :value` 桥接。
- `etaf-component.el` 负责无状态 `:view` 定义和上下文别名。
- `etaf-renderer.el` 是唯一调用 Ebox 的模块，只使用 Ebox 公共构造和发布 API。
- 核心 Host 保持最小且无样式：`text`、`fragment`、`container`、`row`、`column`、`stack`、`flex`、`spacer`。
- 属性/子节点顺序、普通 Elisp 求值边界、表达式结果、Component props、别名冲突和挂载都由 `tests/etaf-tests.el` 覆盖。
| 文件 | 稳定职责 | 不应负责 |
| --- | --- | --- |
| `etaf-view.el` | 结构语法、View 值、slot 规范化、表达式边界、Component 注册表 | Ebox 调用、buffer 写入、生命周期、业务状态 |
| `etaf-component.el` | `etaf-define-component`、prop 声明、定义级样式验证 | Runtime 调度或 Ebox lowering |
| `etaf-reactive.el` | ref、computed、effect、watch、effect Scope、cleanup | View 语法或 buffer 发布 |
| `etaf-context.el` | 继承 Context 和 Theme 默认值 | 全局 service 注册表或视觉节点 |
| `etaf-runtime.el` | retained instance、候选协调、提交/回滚、生命周期、Behavior 安装 | Ebox 私有状态或业务数据 schema |
| `etaf-renderer.el` | 唯一 ETAF 到 Ebox 的公共边界、样式、文本 lowering、raw 出口 | Component 生命周期和数据请求 |
| `etaf-behavior.el` | 非视觉 `:use` Behavior spec 和 installer | 视觉节点或直接修改 buffer |
| `etaf-events.el` | 事件 dispatch、Host 引用命中、activate、focus | 业务变更策略 |
| `etaf-actions.el` | 命名 Action 注册表和 Runtime dispatch | View 构造或 presentation |
| `etaf-resource.el` | Scope 所有的同步 loader 状态和 error boundary | 第二套异步/task 对象模型 |
| `etaf-data.el` | source capability、controller 状态、分页、mutation、selection | 数据库专用代码或存储假设 |
| `etaf-ui.el` | 一个官方 Component 目录，包括复合 DataGrid | 第二套 Control/Widget/Component 分类 |
| `etaf-playground.el` | 只使用公共 API 的 ETAF 示例和可选预览入口 | Ebox 私有 API 或 `ebox-playground` 依赖 |
| `etaf.el` | 一个 core facade 和本地包路径优先级 | 自动加载可选 UI 或 Playground |
## 3. P1 顺序
不要为了获得更短的文件名而拆文件。只有稳定职责、生命周期、外部边界或发行边界发生转移时才拆分。
1. 固定 Component 调用和 slot collection 的内部表示。
2. 实现 `(slot)`、`(slot FALLBACK...)` 默认 slot 投影，再实现 `(slot :name 'NAME CHILD...)` 具名 slot。
3. 将末尾 children 和具名 slot 声明归一化为同一个 collection；拒绝动态、字符串、数字和 keyword slot 名称。
4. 将 `:setup` 实现为只执行一次的普通 Elisp，建立 retained Component Scope 并返回零参数 render 函数。
5. 增加具有稳定身份的 ref 和 computed，并支持 props 更新而不重新运行 setup。
6. 在加入状态型应用示例之前，补齐明确的生命周期和失败候选销毁。
7. 在普通 View 路径稳定后，加入带命名空间的 `raw-ebox :value` 后端逃生口。
## 4. 已冻结的公共契约
P1 不得增加第二个 Template 入口、Variant 定义模型、`text` 的位置参数例外或基于 quote 的 View 约定。
### 4.1 View 与求值
## 4. P2–P4 依赖顺序
- 唯一结构形式是 `(NAME :PROPERTY VALUE ... CHILD ...)`。
- 所有属性必须先于所有子节点。
- 属性值是普通 Elisp 表达式。
- 唯一的子节点计算桥接是 `(expr :value ELISP-EXPRESSION)`。
- Elisp 返回动态 View 时，在 `expr` 中用 `(etaf-view ...)` 构造；被 quote 的结构数据永远不会被执行。
- Core Host 是 `text`、`fragment`、`container`、`row`、`column`、`stack`、`flex` 和 `spacer`。
- `raw-ebox` 只接受 `:value` 和可选 `:key`，并且对 ETAF 语义保持 opaque。
- Context 依赖 retained Component Scope 以及最近祖先的所有权规则。
- Behavior 依赖稳定 Host 身份、事件、ref、Effect 和销毁流程。
- Action 是业务变更，不得变成 View 节点或展示回调。
- Effect 负责外部同步和清理；`watch` 仍是 Behavior 或 Effect 可以使用的响应式原语。
- ECSS 和状态样式依赖冻结的 Ebox 属性边界以及文本 surface 映射。
- Data 是 ETAF core 能力；SQLite、PostgreSQL、MySQL、REST、文件和 ORM 都是可选的具体数据源包。
- `etaf-ui` 是一个官方 Component catalog；源码拆分只是维护边界，不是用户概念；DataGrid 是普通复合 Component。
- `ebox-playground` 只依赖 Ebox；`etaf-playground` 依赖 ETAF，并可选依赖 `etaf-ui`；二者互不依赖。
### 4.2 Component 与 slot
## 5. 验证门禁
- `etaf-define-component` 只接受 `:view`、`:setup` 和可选 `:styles`。
- `:view` 与 `:setup` 互斥。
- `:setup` 对每个 retained identity 只运行一次，返回零参数 render 函数。
- Props 更新只重新 render，不重新运行 setup。
- 尾部 children 是 `slots.default`；命名 slot 输入使用 `(slot :name 'NAME CHILD...)`。
- 默认 outlet 简写是 `(slot)` 或 `(slot FALLBACK...)`。
- Slot name 只能是稳定的、非 keyword 的 symbol。
- `:key` 是 identity metadata，不是业务 prop：Component 调用用它选择 retained identity，Host 和 `raw-ebox` 则把它作为 Ebox node key 向下传递。
每个里程碑都必须先通过最小相关门禁，才能进入下一个边界：
### 4.3 Runtime 与非视觉能力
```sh
make compile EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
make test EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs
```
- ref、computed、watch、Effect 和 cleanup 使用同一套响应式 Scope 模型。
- Context 继承自 retained Component instance；Theme 是 Context 中的属性 plist。
- `:on-*` 是局部 callback；Action 是命名变更；Behavior 是可复用的 `:use` bundle；Effect 是订阅/cleanup owner。
- 事件和 focus 通过 Runtime 以及 Ebox 公共 Host 引用 API 进入。
- Data 是 ETAF core 能力。Source 有必选 `:load` 和可选 `:mutate`/`:dispose`。
- Resource 是 Scope 所有的同步 loader；core 不引入 task/promise 抽象。
P0 还要求对错误语法产生干净的宏展开失败，并走真实的 `etaf-mount` 路径。P1 增加 setup/slot 生命周期测试；P2 增加挂载事件和清理路径；P3 增加文本 surface 和发布测试；P4 增加包边界扫描、独立加载和应用 smoke test。
改变这些契约之一时，必须先审查架构文档，再开始实现。不要为了兼容而增加第二种写法。
只有辅助函数通过不算里程碑完成：必须同时验证公共宏展开、Component 构造、renderer 降级和 buffer 发布。
## 5. 验证矩阵
## 6. 停止条件
| 表面 | 命令或测试 | 证明内容 |
| --- | --- | --- |
| 包加载 | `make load EMACS=...` | 公共 facade 能使用同级 Ebox 包加载 |
| Byte compile | `make compile EMACS=...` | 所有发行实现文件无 warning 编译 |
| Core 行为 | `tests/etaf-tests.el` | grammar、Component、Runtime、reactive、Context、样式、事件、Action、raw 出口 |
| Resource 行为 | `tests/etaf-resource-tests.el` | loading、error、替换 cleanup、Scope 释放、显式边界 |
| Data 行为 | `tests/etaf-data-tests.el` | query、分页、规范化、mutation、selection、error、stop |
| UI 行为 | `tests/etaf-ui-tests.el` | Button、Checkbox、Panel slot、响应式 DataGrid 投影 |
| Playground 行为 | `tests/etaf-playground-tests.el` | 只使用 ETAF 公共 API 的挂载和事件路径 |
| 文档 | `tests/etaf-docs-tests.el` | 成对文件、当前命名、无过时公共入口、无 Ebox 私有调用 |
| 全量门禁 | `make check EMACS=...` | 编译、全部 ERT 和文档契约一起通过 |
不得重新引入 `etaf-template`、Variant、公共 Control/Widget 分类、作为必需平级包的 `etaf-data`、抽象 `etaf-adapters` 或第二个公共 View 构造入口。在真实应用提供测量、布局和发布契约之前，不实现 Grid、Overlay 或完整 CSS 克隆。
事件和 Runtime 问题必须用真实公共 dispatch 路径测试。纯 helper 测试不能替代挂载测试。
## 6. 代码变更 review 清单
开始改代码前：
1. 写清行为 owner 以及从 View 到 Ebox 的数据流。
2. 搜索已有测试和兄弟模块，确认没有重复的公共路径。
3. 行为缺失或错误时，先写最小的失败回归测试。
4. 增加 helper 前，先尝试删除重复抽象。
实现过程中：
- View 值保持纯，把 buffer 变更放在 Runtime/Ebox 发布边界。
- cleanup 必须挂在创建该 resource 的 Scope 上。
- 让内部错误暴露出来，只在明确的 loader 或应用边界捕获。
- 用 `:key` 保持重复序列的结构 identity。
- 保持样式优先级和属性/子节点顺序确定。
- 可选包不能被 core facade 自动加载。
交付前：
- 阅读完整 diff。
- 运行 `make check` 并检查全部输出。
- 只使用本地 ETAF 和同级 Ebox 路径运行一次全新 `make load`。
- 扫描实现文件中的 `ebox--` 和其他不应跨边界的私有调用。
- 公共契约变化时同步更新两种语言的文档。
- 一个聚焦且已验证的修改完成后再开始下一个里程碑。
## 7. 有边界的后续工作
下面都是扩展路线，不是 core 概念缺失：
| 扩展 | 必须冻结的契约 | 安全的实现方向 |
| --- | --- | --- |
| 外部异步数据 | 具体 source 定义 callback、generation、取消和 error owner | 放在具体 source 包，或增加窄化的 Data capability；不要增加通用 task 层级 |
| 更多 UI Component | 既有 props/children/slot/event/Behavior 契约 | 在 `etaf-ui` 增加普通 Component，并通过 Runtime 测试 |
| 数据库 source | 已冻结的 `etaf-data-source` capability plist | 使用具体 SQLite/PostgreSQL source 包，保持存储在 core 外 |
| 更丰富布局 | 完整的 Ebox measurement/layout/publication 契约 | 先扩展 Ebox，再通过 Host 或 Component 暴露 |
| Playground 可视化工具 | 公共 inspection 和 reporting API | 扩展 `etaf-playground`，不与 Ebox Playground 耦合 |
每个扩展都必须配套测试和文档。如果确实需要新的公共名词，先更新 `architecture.en.md` 与 `architecture.zh.md`，再更新本文和用户指南。
## 8. 停止条件
当一个里程碑的公共路径、回滚行为、测试、编译、加载和成对文档都完成时停止该里程碑。不要因为某个可选集成尚未存在就扩大 core 模型，也不要创建第二套渲染语法、第二种 Component 模型，或让用户必须学习的额外 Runtime 包边界。

524
docs/user-guide.en.md Normal file
View File

@ -0,0 +1,524 @@
# ETAF User Guide
ETAF builds text applications from one small vocabulary: `View`, `Component`, props, children, reactive state, and Ebox rendering. Start with `etaf-view` and `etaf-mount`; add `:setup` only when a Component needs local state or lifecycle.
## 1. Install and load
ETAF depends on the independent Ebox package. During development, put both checkouts on `load-path` and load the one public ETAF entry:
```elisp
(add-to-list 'load-path "/path/to/github/emacs-box")
(add-to-list 'load-path "/path/to/github/etaf")
(require 'etaf)
```
The package entry loads the core View, Component, Runtime, reactive, Context, Data, Resource, event, Behavior, and Action APIs. `etaf-ui` and the Playgrounds are optional modules; loading `etaf` does not load them.
## 2. The first View
Every structural form is:
```elisp
(NAME :property value ... child ...)
```
Properties come first and children come last. `etaf-view` receives an unquoted structural form:
```elisp
(etaf-view
(column
(text :face 'bold "Hello")
(text :color "#687386" "Welcome to ETAF")))
```
Mount it into an Emacs buffer:
```elisp
(etaf-mount
"*etaf-hello*"
(etaf-view
(column
(text :face 'bold "Hello")
(text "This is a text application."))))
```
`etaf-mount` returns the buffer. The same call replaces an existing Runtime mounted in that buffer after disposing it. To dispose it explicitly:
```elisp
(etaf-unmount (etaf-runtime-for-buffer "*etaf-hello*"))
```
`etaf-render` is useful for pure, stateless rendering or tests:
```elisp
(ebox-render
(etaf-render
(etaf-view (text :face 'bold "Pure View"))))
```
Use `etaf-mount` whenever a View contains a stateful Component, reactive data, events, or lifecycle.
## 3. Properties and children
Attribute values are ordinary Elisp expressions. They do not need an extra `expr` wrapper:
```elisp
(let ((dark t)
(label "Theme"))
(etaf-view
(text
:face (if dark 'light 'dark)
:color "#F4F6FB"
(expr :value label))))
```
The child region is structural. `expr` is the one explicit bridge for ordinary Elisp computation:
```elisp
(etaf-view
(column
(expr :value (if loading "Loading..." "Ready"))
(expr
:value
(when open
(etaf-view (text :face 'italic "Details"))))))
```
`expr` accepts exactly `:value` and no children. Its result can be a string, View, sequence, or `nil`. `if`, `when`, `cond`, `let`, `mapcar`, and `cl-loop` remain normal Elisp inside the value.
Quote has one ordinary Elisp meaning:
- Do not quote structural View forms.
- Quote literal symbols and data lists when Elisp requires data.
- Use `(etaf-view ...)` inside an expression when the expression must construct a View.
For example, `'bold` is the face symbol, while `'(text "data")` is only data and will not render. A dynamic View must be written as `(etaf-view (text "data"))`.
## 4. Define a Component
The beginner form is a stateless `:view` Component:
```elisp
(etaf-define-component status-label (&key label)
"Render a status label."
:view
(text
:face 'bold
(expr :value label)))
(etaf-mount
"*etaf-status*"
(etaf-view
(status-label :label "Connected")))
```
The canonical Component name may include the `etaf-` prefix:
```elisp
(etaf-view (etaf-status-label :label "Connected"))
```
In a View position, ETAF also registers the short alias `status-label`. If a short name conflicts with Elisp, the registry uses a semantic alias ending in `-view`. This alias rule applies only to View names; ordinary functions remain prefixed.
The definition macro accepts only these keywords:
| Keyword | Meaning |
| --- | --- |
| `:view` | The stateless View producer; mutually exclusive with `:setup` |
| `:setup` | One-time Component initialization returning a zero-argument render function |
| `:styles` | Optional static scoped style declaration |
There is no separate declaration block for children, slots, events, state, or variants. Props are declared with `(&key ...)`; children and slots are implicit content.
## 5. Local state and lifecycle
Use `:setup` when the Component owns local state:
```elisp
(etaf-define-component counter (&key title)
"Render a retained counter."
:setup
(let ((count (etaf-ref 0)))
(etaf-on-mounted
(lambda () (message "%s mounted" title)))
(etaf-on-unmounted
(lambda () (message "%s unmounted" title)))
(lambda ()
(etaf-view
(column
(text :face 'bold (expr :value title))
(text (expr :value (format "Count: %d" (etaf-value count))))
(text
:role 'button
:on-press (lambda () (cl-incf (etaf-value count)))
"Increment"))))))
```
Setup runs once for the retained instance. Its returned render function runs on each update. `etaf-on-mounted`, `etaf-on-updated`, and `etaf-on-unmounted` register lifecycle callbacks for that Component instance. Scope disposal automatically stops reactive effects and cleanup.
The small reactive API is:
```elisp
(let* ((count (etaf-ref 0))
(double (etaf-computed
(lambda () (* 2 (etaf-value count))))))
(etaf-watch count
(lambda (new old)
(message "%s → %s" old new)))
(setf (etaf-value count) 1)
(etaf-value double))
```
Use `etaf-set-value` when a function form is clearer than `setf`. `etaf-watch-effect` is for a reactive side effect and can return a cleanup function:
```elisp
(etaf-watch-effect
(lambda ()
(message "Count is %s" (etaf-value count))
(lambda () (message "Stop observing count"))))
```
Inside Component setup, effects and watches belong to the Component Scope. Outside a Component, create a Scope explicitly with `etaf-effect-scope` and `etaf-scope-run`.
## 6. Children and slots
Trailing children are the anonymous/default slot:
```elisp
(etaf-define-component panel (&key title)
"Render a titled panel."
:view
(column
(text :face 'bold (expr :value title))
(slot (text :face 'shadow "No content"))))
(etaf-view
(panel
:title "Account"
(text "Account body")))
```
Named slots use `:name` and must use a stable non-keyword symbol:
```elisp
(etaf-define-component card (&key title)
"Render a card with a header slot."
:view
(column
(slot :name 'header
(text :face 'bold (expr :value title)))
(slot (text :face 'shadow "No body"))))
(etaf-view
(card
:title "Account"
(slot :name 'header (text "Account settings"))
(text "Body")))
```
The two default-slot shorthands are `(slot)` and `(slot FALLBACK...)`. The normalized spelling is `(slot :name 'default FALLBACK...)`. At a call site, ordinary children fill `default`; a named input uses `(slot :name 'header CHILD...)`. An explicit empty `(slot :name 'header)` suppresses the fallback. Strings, numbers, variables, and runtime expressions are not valid slot names.
## 7. Styles and themes
Static Component styles use one declaration form:
```elisp
(etaf-define-component styled-card ()
"Render a small styled card."
:styles
(styles
("&"
:padding (1 2)
:border ((1) solid "#687386"))
(".title" :face bold)
(".danger" :color "#FF6B6B"))
:view
(column
:class "card"
(text :class "title" "Title")
(slot)))
```
The outer `styles` form is static Component metadata. Its rules have the shape `("SELECTOR" :PROPERTY VALUE...)`; values such as `(1 2)` and `bold` are style data and do not need quote. In an ordinary View attribute, values still follow Elisp rules, so a literal list would normally be quoted.
Precedence is fixed:
```text
explicit Host properties > Component :styles > inherited Theme defaults
```
Theme is a Context convenience, not another runtime object:
```elisp
(etaf-define-component themed-shell ()
"Provide default text colors to a subtree."
:setup
(progn
(etaf-theme-provide
'(:color "#F4F6FB" :bgcolor "#202634"))
(lambda () (etaf-view (slot)))))
```
## 8. Events, Actions, Behaviors, and focus
One local event uses an `:on-*` property:
```elisp
(text
:ref 'save
:role 'button
:on-press (lambda () (message "Saved"))
"Save")
```
The Runtime stores handlers by Host reference. Tests and integrations can dispatch directly:
```elisp
(let ((runtime (etaf-runtime-for-buffer "*etaf-status*")))
(etaf-dispatch-event runtime 'save 'press))
```
Named business mutations use Actions:
```elisp
(etaf-action-define save-record (runtime record)
"Save RECORD through the application boundary."
(ignore runtime)
(message "Saving %S" record))
(text
:role 'button
:on-press (lambda () (etaf-dispatch 'save-record record))
"Save")
```
The Action function receives Runtime first. `etaf-dispatch` must run inside a mounted Runtime or receive an explicit Runtime as its first argument.
Behaviors package reusable non-visual attributes and cleanup:
```elisp
(text
:use (list (etaf-focusable))
:role 'button
"Focusable text")
```
Define application Behaviors with `etaf-define-behavior`; use a local `:on-*` callback when the interaction is used only once. `etaf-toggleable` is available for controlled value changes. A Behavior never becomes a visual node and never directly edits a buffer.
For a reusable installer, reserve `:install` for the cleanup-producing part of the Behavior:
```elisp
(etaf-define-behavior traced-focus (&rest attributes)
"Install a Behavior with a visible lifecycle trace."
(apply #'etaf-behavior-create
'traced-focus
(append attributes
(list :install
(lambda ()
(message "Behavior installed")
(lambda ()
(message "Behavior removed")))))))
```
The installer can call `etaf-current-behavior-context` when it needs the current Runtime or Host path. Replacing the Behavior runs the old cleanup before the new state becomes current.
Focus and hit testing are Runtime operations:
```elisp
(let ((runtime (etaf-runtime-for-buffer "*etaf-status*")))
(etaf-focus-next runtime)
(etaf-activate runtime))
```
`etaf-host-ref-bounds` and `etaf-host-ref-position` expose the public Ebox hit-test boundary. `etaf-dispatch-event` accepts an optional payload flag when the callback needs one argument.
## 9. Context / Provide / Inject
Use Context for a dependency shared across component depth, not for ordinary props:
```elisp
(etaf-define-component application-shell ()
"Provide a service to descendants."
:setup
(let ((service (etaf-ref "demo-service")))
(etaf-provide 'service service)
(lambda () (etaf-view (slot)))))
(etaf-define-component service-label ()
"Read the inherited service."
:setup
(let ((service (etaf-inject 'service nil t)))
(lambda ()
(etaf-view
(text (expr :value (format "Service: %s" (etaf-value service)))))))
(etaf-mount
"*etaf-context*"
(etaf-view (application-shell (service-label))))
```
Context keys are ordinary stable symbols. The nearest ancestor wins. `etaf-inject` returns its default for an optional dependency and signals `etaf-context-error` for a required missing dependency. A provided ref or computed value keeps its reactive identity.
## 10. Data Controllers and DataGrid
Data is included in ETAF core. A source implements the small source contract:
```elisp
(setq source
(etaf-data-source
:load (lambda (query page page-size)
(ignore query)
(let ((rows '((:id 1 :name "Ada")
(:id 2 :name "Grace"))))
(list :items rows
:total (length rows)
:page page
:page-size page-size)))
:mutate (lambda (operation payload)
(ignore operation payload)
t)
:dispose (lambda () nil)))
```
Official UI Components use the same controlled-prop model as user Components:
```elisp
(require 'etaf-ui)
(let ((done (etaf-ref nil)))
(etaf-mount
"*etaf-checkbox*"
(etaf-view
(etaf-checkbox
:checked (etaf-value done)
:label "Done"
:on-change (lambda (next)
(setf (etaf-value done) next))))))
```
The Component emits the next value; the caller owns the ref and supplies the current value on the next render.
`:load` receives query and page parameters and returns a plist containing `:items`. `:mutate` and `:dispose` are optional. The built-in memory source is convenient for local applications:
```elisp
(setq source
(etaf-data-memory-source
'((:id 1 :name "Ada")
(:id 2 :name "Grace"))
:id-key :id))
(setq controller
(etaf-data-controller source :page-size 10 :auto-load t))
```
The controller exposes reactive refs through `etaf-data-items`, `etaf-data-status`, `etaf-data-error`, `etaf-data-total`, `etaf-data-query`, `etaf-data-page`, `etaf-data-page-size`, and `etaf-data-selection`. Use `etaf-data-load`, `etaf-data-reload`, `etaf-data-mutate`, `etaf-data-set-query`, `etaf-data-next-page`, `etaf-data-previous-page`, `etaf-data-select`, and `etaf-data-stop` for operations.
The official DataGrid is a normal Component:
```elisp
(require 'etaf-ui)
(etaf-mount
"*etaf-grid*"
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID")
(:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id)))))
(etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
```
DataGrid requires `:row-key` to return a non-nil stable scalar for every row. It projects loading, error, empty, header, rows, and footer through ordinary Hosts and slots. It is not a second data or Component model.
Storage is not tied to SQLite. A PostgreSQL, REST, file, or ORM integration should expose a concrete Data Source with the same contract. Such an integration is optional and does not change the ETAF user model.
## 11. Resource and raw Ebox
Use a Resource for a Scope-owned synchronous loader:
```elisp
(let ((resource
(etaf-resource
(lambda ()
(etaf-resource-result
"loaded"
:cleanup (lambda () (message "resource released")))))))
(message "%s: %s"
(etaf-resource-status resource)
(etaf-resource-value resource))
(etaf-resource-dispose resource))
```
Loader errors are stored in `etaf-resource-error`; cleanup/type errors remain visible. `etaf-error-boundary-run` handles only errors raised by its function body:
```elisp
(etaf-error-boundary-run
(lambda ()
(let ((filename "README.md"))
(with-temp-buffer
(insert-file-contents filename)
(buffer-string))))
(lambda (condition)
(message "Read failed: %S" condition)
nil))
```
The only low-level escape is `raw-ebox`:
```elisp
(etaf-view
(raw-ebox
:key 'manual-node
:value (ebox-create :content "Backend node")))
```
Use it only when the normal Host and Component lowering path cannot express a real Ebox requirement. The returned Node is opaque to ETAF semantics.
## 12. Playground
The optional core playground is a complete ETAF application example:
```elisp
(require 'etaf-playground)
(etaf-playground-open)
```
The core playground depends only on ETAF. To include the official catalog:
```elisp
(etaf-playground-open-ui)
```
`etaf-playground-close` unmounts and kills the default playground buffer. It is independent of `ebox-playground`; neither package is loaded by core ETAF.
## 13. Public API map
| API family | Main entry points | Use it when |
| --- | --- | --- |
| View and Runtime | `etaf-view`, `etaf-render`, `etaf-mount`, `etaf-unmount`, `etaf-runtime-flush` | Build, render, mount, or explicitly flush an application |
| Components | `etaf-define-component`, `etaf-current-prop`, `etaf-current-slots` | Share a View or retain local state |
| Reactive state | `etaf-ref`, `etaf-value`, `etaf-set-value`, `etaf-computed` | Store or derive state |
| Reactive effects | `etaf-watch`, `etaf-watch-effect`, `etaf-effect-scope`, `etaf-scope-run` | Observe state or synchronize external resources |
| Lifecycle | `etaf-on-mounted`, `etaf-on-updated`, `etaf-on-unmounted` | Attach Component lifecycle work |
| Context | `etaf-provide`, `etaf-inject`, `etaf-theme-provide` | Share ambient dependencies through depth |
| Events and focus | `etaf-dispatch-event`, `etaf-activate`, `etaf-focus`, `etaf-focus-next` | Enter interactive Runtime behavior |
| Actions | `etaf-action-define`, `etaf-dispatch` | Name and reuse business mutations |
| Behaviors | `etaf-behavior-create`, `etaf-define-behavior`, `etaf-current-behavior-context`, `etaf-focusable`, `etaf-toggleable` | Reuse non-visual interaction bundles |
| Data | `etaf-data-source`, `etaf-data-controller`, `etaf-data-memory-source`, `etaf-data-*` | Query, paginate, mutate, select, and stop data |
| Resource | `etaf-resource`, `etaf-resource-result`, `etaf-error-boundary-run` | Own loader state and cleanup |
| Official UI | `require 'etaf-ui`, `etaf-button`, `etaf-checkbox`, `etaf-label`, `etaf-panel`, `etaf-data-grid` | Use ready-made Components |
| Playground | `etaf-playground-open`, `etaf-playground-open-ui`, `etaf-playground-close` | Explore the framework interactively |
Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`, `etaf-ref`, and event callbacks at first. The remaining APIs are additive capabilities, not prerequisites for understanding the core grammar.
## 14. Common mistakes
- Put every property before the first child.
- Use `:face 'bold`, not `:face :bold`; a face is an Elisp symbol value, not a property keyword.
- Do not quote a structural View form.
- Use `expr :value` for `if`, `when`, `let`, `mapcar`, or a View returned by ordinary Elisp.
- Use `(slot)` or `(slot FALLBACK...)` for the default outlet; use `:name 'header` for named slot content.
- Keep writes out of rendering; use an event, Action, watch callback, or Effect.
- Use `etaf-ui` Components for product controls; core Hosts are the structural foundation.
- Stop a Data Controller and unmount a Runtime when their owner is no longer needed.

524
docs/user-guide.zh.md Normal file
View File

@ -0,0 +1,524 @@
# ETAF 用户使用指南
ETAF 使用一套很小的词汇构建文本应用：`View`、`Component`、props、children、响应式状态和 Ebox 渲染。先学习 `etaf-view` 与 `etaf-mount`；只有 Component 需要局部状态或生命周期时才增加 `:setup`。
## 1. 安装与加载
ETAF 依赖独立的 Ebox 包。开发时把两个检出目录放入 `load-path`，然后只加载 ETAF 的公共入口：
```elisp
(add-to-list 'load-path "/path/to/github/emacs-box")
(add-to-list 'load-path "/path/to/github/etaf")
(require 'etaf)
```
这个入口会加载核心 View、Component、Runtime、reactive、Context、Data、Resource、事件、Behavior 和 Action API。`etaf-ui` 与两个 Playground 都是可选模块；加载 `etaf` 不会自动加载它们。
## 2. 第一个 View
所有结构都使用：
```elisp
(NAME :property value ... child ...)
```
属性在前，子节点在后。`etaf-view` 接收不带 quote 的结构 form：
```elisp
(etaf-view
(column
(text :face 'bold "Hello")
(text :color "#687386" "Welcome to ETAF")))
```
把它挂载到 Emacs buffer：
```elisp
(etaf-mount
"*etaf-hello*"
(etaf-view
(column
(text :face 'bold "Hello")
(text "This is a text application."))))
```
`etaf-mount` 返回 buffer。同一个调用会先释放该 buffer 中已有的 Runtime，再挂载新的 View。需要显式释放时：
```elisp
(etaf-unmount (etaf-runtime-for-buffer "*etaf-hello*"))
```
纯渲染或测试可以使用 `etaf-render`：
```elisp
(ebox-render
(etaf-render
(etaf-view (text :face 'bold "Pure View"))))
```
View 含有状态型 Component、响应式数据、事件或生命周期时，使用 `etaf-mount`。
## 3. 属性与子节点
属性值就是普通 Elisp 表达式，不需要额外的 `expr`：
```elisp
(let ((dark t)
(label "Theme"))
(etaf-view
(text
:face (if dark 'light 'dark)
:color "#F4F6FB"
(expr :value label))))
```
子节点区是结构语法。`expr` 是执行普通 Elisp 的唯一明确桥接：
```elisp
(etaf-view
(column
(expr :value (if loading "Loading..." "Ready"))
(expr
:value
(when open
(etaf-view (text :face 'italic "Details"))))))
```
`expr` 只接受 `:value`，不能有子节点。返回值可以是字符串、View、序列或 `nil`。`if`、`when`、`cond`、`let`、`mapcar` 和 `cl-loop` 仍然是 value 中的普通 Elisp。
quote 只有普通 Elisp 的含义：
- 结构性 View form 不要 quote。
- 字面量 symbol 和数据列表在 Elisp 需要时才 quote。
- Elisp 表达式需要构造 View 时，在其中使用 `(etaf-view ...)`。
例如 `'bold` 是 face symbol，而 `'(text "data")` 只是数据，不会渲染。动态 View 必须写成 `(etaf-view (text "data"))`。
## 4. 定义 Component
入门形式是无状态的 `:view` Component：
```elisp
(etaf-define-component status-label (&key label)
"Render a status label."
:view
(text
:face 'bold
(expr :value label)))
(etaf-mount
"*etaf-status*"
(etaf-view
(status-label :label "Connected")))
```
Component 的规范名称可以带 `etaf-` 前缀：
```elisp
(etaf-view (etaf-status-label :label "Connected"))
```
在 View 位置，ETAF 也会注册短 alias `status-label`。如果短名称会与 Elisp 冲突，注册表会使用以 `-view` 结尾的语义 alias。这个规则只作用于 View 名称；普通函数仍然保留前缀。
定义宏只接受这些关键字：
| 关键字 | 作用 |
| --- | --- |
| `:view` | 无状态 Component 的 View 生产者，与 `:setup` 互斥 |
| `:setup` | 一次性初始化，返回零参数 render 函数 |
| `:styles` | 可选的静态作用域样式声明 |
没有单独的 children、slot、event、state 或 variant 声明块。业务 props 通过 `(&key ...)` 声明，children 和 slot 是隐式内容。
## 5. 局部状态与生命周期
Component 自己拥有状态时使用 `:setup`：
```elisp
(etaf-define-component counter (&key title)
"Render a retained counter."
:setup
(let ((count (etaf-ref 0)))
(etaf-on-mounted
(lambda () (message "%s mounted" title)))
(etaf-on-unmounted
(lambda () (message "%s unmounted" title)))
(lambda ()
(etaf-view
(column
(text :face 'bold (expr :value title))
(text (expr :value (format "Count: %d" (etaf-value count))))
(text
:role 'button
:on-press (lambda () (cl-incf (etaf-value count)))
"Increment"))))))
```
Setup 对 retained instance 只执行一次，返回的 render 函数在更新时重复运行。`etaf-on-mounted`、`etaf-on-updated` 和 `etaf-on-unmounted` 注册该 Component 的生命周期 callback。Scope 释放时会自动停止响应式 effect 并运行 cleanup。
响应式 API 只有一套模型：
```elisp
(let* ((count (etaf-ref 0))
(double (etaf-computed
(lambda () (* 2 (etaf-value count))))))
(etaf-watch count
(lambda (new old)
(message "%s → %s" old new)))
(setf (etaf-value count) 1)
(etaf-value double))
```
如果函数形式更清楚，可以使用 `etaf-set-value`。`etaf-watch-effect` 用于响应式副作用，并且可以返回 cleanup：
```elisp
(etaf-watch-effect
(lambda ()
(message "Count is %s" (etaf-value count))
(lambda () (message "Stop observing count"))))
```
在 Component setup 中，effect 和 watch 属于 Component Scope。在 Component 外部，需要用 `etaf-effect-scope` 和 `etaf-scope-run` 明确创建 Scope。
## 6. children 与 slot
普通尾部子节点就是匿名/默认 slot：
```elisp
(etaf-define-component panel (&key title)
"Render a titled panel."
:view
(column
(text :face 'bold (expr :value title))
(slot (text :face 'shadow "No content"))))
(etaf-view
(panel
:title "Account"
(text "Account body")))
```
命名 slot 使用 `:name`，并且必须是稳定的、非 keyword 的 symbol：
```elisp
(etaf-define-component card (&key title)
"Render a card with a header slot."
:view
(column
(slot :name 'header
(text :face 'bold (expr :value title)))
(slot (text :face 'shadow "No body"))))
(etaf-view
(card
:title "Account"
(slot :name 'header (text "Account settings"))
(text "Body")))
```
默认 slot 的两个用户简写是 `(slot)` 和 `(slot FALLBACK...)`。内部统一形式是 `(slot :name 'default FALLBACK...)`。调用处的普通子节点填充 `default`；命名内容写成 `(slot :name 'header CHILD...)`。显式空的 `(slot :name 'header)` 会抑制 fallback。字符串、数字、变量和运行时表达式都不是合法 slot name。
## 7. 样式与 Theme
静态 Component 样式只有一种声明形式：
```elisp
(etaf-define-component styled-card ()
"Render a small styled card."
:styles
(styles
("&"
:padding (1 2)
:border ((1) solid "#687386"))
(".title" :face bold)
(".danger" :color "#FF6B6B"))
:view
(column
:class "card"
(text :class "title" "Title")
(slot)))
```
外层 `styles` 是静态 Component metadata。每条规则是 `("SELECTOR" :PROPERTY VALUE...)`；`(1 2)` 和 `bold` 在样式中是数据，不需要 quote。普通 View 属性仍遵循 Elisp 规则，字面量列表通常需要 quote。
优先级固定为：
```text
显式 Host 属性 > Component :styles > 继承的 Theme 默认值
```
Theme 是 Context 的便捷形式，不是另一个 Runtime 对象：
```elisp
(etaf-define-component themed-shell ()
"Provide default text colors to a subtree."
:setup
(progn
(etaf-theme-provide
'(:color "#F4F6FB" :bgcolor "#202634"))
(lambda () (etaf-view (slot)))))
```
## 8. 事件、Action、Behavior 与 focus
一次局部事件使用 `:on-*` 属性：
```elisp
(text
:ref 'save
:role 'button
:on-press (lambda () (message "Saved"))
"Save")
```
Runtime 会按 Host 引用保存 handler。测试和集成可以直接 dispatch：
```elisp
(let ((runtime (etaf-runtime-for-buffer "*etaf-status*")))
(etaf-dispatch-event runtime 'save 'press))
```
命名的业务变更使用 Action：
```elisp
(etaf-action-define save-record (runtime record)
"Save RECORD through the application boundary."
(ignore runtime)
(message "Saving %S" record))
(text
:role 'button
:on-press (lambda () (etaf-dispatch 'save-record record))
"Save")
```
Action 函数第一个参数是 Runtime。`etaf-dispatch` 必须在挂载的 Runtime 中运行，或者把 Runtime 作为第一个参数显式传入。
Behavior 用来打包可复用的非视觉属性和 cleanup：
```elisp
(text
:use (list (etaf-focusable))
:role 'button
"Focusable text")
```
使用 `etaf-define-behavior` 定义应用 Behavior；只使用一次的交互不需要定义 Behavior，直接使用 `:on-*`。`etaf-toggleable` 可用于 controlled value。Behavior 不是视觉节点，也不直接编辑 buffer。
如果需要可复用的 installer，可以把产生 cleanup 的部分放到保留的 `:install` 属性中：
```elisp
(etaf-define-behavior traced-focus (&rest attributes)
"Install a Behavior with a visible lifecycle trace."
(apply #'etaf-behavior-create
'traced-focus
(append attributes
(list :install
(lambda ()
(message "Behavior installed")
(lambda ()
(message "Behavior removed")))))))
```
Installer 需要 Runtime 或 Host path 时，可以调用 `etaf-current-behavior-context`。Behavior 被替换时，旧 cleanup 会在新状态成为当前状态前运行。
Focus 和 hit testing 是 Runtime 操作：
```elisp
(let ((runtime (etaf-runtime-for-buffer "*etaf-status*")))
(etaf-focus-next runtime)
(etaf-activate runtime))
```
`etaf-host-ref-bounds` 和 `etaf-host-ref-position` 暴露公共的 Ebox hit-test 边界。`etaf-dispatch-event` 支持可选 payload 标记，用于给 callback 传入一个参数。
## 9. Context / Provide / Inject
Context 适合跨多层共享依赖，不适合普通 label：
```elisp
(etaf-define-component application-shell ()
"Provide a service to descendants."
:setup
(let ((service (etaf-ref "demo-service")))
(etaf-provide 'service service)
(lambda () (etaf-view (slot)))))
(etaf-define-component service-label ()
"Read the inherited service."
:setup
(let ((service (etaf-inject 'service nil t)))
(lambda ()
(etaf-view
(text (expr :value (format "Service: %s" (etaf-value service)))))))
(etaf-mount
"*etaf-context*"
(etaf-view (application-shell (service-label))))
```
Context key 是稳定的普通 symbol，最近的祖先优先。`etaf-inject` 对可选依赖返回 default，对必需但缺失的依赖触发 `etaf-context-error`。注入的 ref 或 computed 保留自身响应式 identity。
## 10. Data Controller 与 DataGrid
Data 已经是 ETAF core 能力。Data Source 实现一个小的 source 契约：
```elisp
(setq source
(etaf-data-source
:load (lambda (query page page-size)
(ignore query)
(let ((rows '((:id 1 :name "Ada")
(:id 2 :name "Grace"))))
(list :items rows
:total (length rows)
:page page
:page-size page-size)))
:mutate (lambda (operation payload)
(ignore operation payload)
t)
:dispose (lambda () nil)))
```
官方 UI Component 使用和用户 Component 相同的 controlled-prop 模型：
```elisp
(require 'etaf-ui)
(let ((done (etaf-ref nil)))
(etaf-mount
"*etaf-checkbox*"
(etaf-view
(etaf-checkbox
:checked (etaf-value done)
:label "Done"
:on-change (lambda (next)
(setf (etaf-value done) next))))))
```
Component 发出 next value；ref 由调用方拥有，并在下一次 render 提供当前值。
`:load` 接收 query 和分页参数，返回带 `:items` 的 plist；`:mutate` 和 `:dispose` 可选。内置 memory source 适合本地示例：
```elisp
(setq source
(etaf-data-memory-source
'((:id 1 :name "Ada")
(:id 2 :name "Grace"))
:id-key :id))
(setq controller
(etaf-data-controller source :page-size 10 :auto-load t))
```
Controller 通过 `etaf-data-items`、`etaf-data-status`、`etaf-data-error`、`etaf-data-total`、`etaf-data-query`、`etaf-data-page`、`etaf-data-page-size` 和 `etaf-data-selection` 暴露响应式 ref。操作使用 `etaf-data-load`、`etaf-data-reload`、`etaf-data-mutate`、`etaf-data-set-query`、`etaf-data-next-page`、`etaf-data-previous-page`、`etaf-data-select` 和 `etaf-data-stop`。
官方 DataGrid 是普通 Component：
```elisp
(require 'etaf-ui)
(etaf-mount
"*etaf-grid*"
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID")
(:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id)))))
(etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
```
DataGrid 要求 `:row-key` 对每一行返回非 nil 的稳定标量。它通过普通 Host 和 slot 投影 loading、error、empty、header、rows 和 footer，不是第二种 data 或 Component 模型。
存储不绑定 SQLite。PostgreSQL、REST、文件或 ORM 集成都应该提供同样契约的具体 Data Source；它们是可选集成，不改变 ETAF 的用户模型。
## 11. Resource 与 raw Ebox
Resource 是 Scope 所有的同步 loader：
```elisp
(let ((resource
(etaf-resource
(lambda ()
(etaf-resource-result
"loaded"
:cleanup (lambda () (message "resource released")))))))
(message "%s: %s"
(etaf-resource-status resource)
(etaf-resource-value resource))
(etaf-resource-dispose resource))
```
Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可见。`etaf-error-boundary-run` 只处理它的 function body 抛出的错误：
```elisp
(etaf-error-boundary-run
(lambda ()
(let ((filename "README.md"))
(with-temp-buffer
(insert-file-contents filename)
(buffer-string))))
(lambda (condition)
(message "Read failed: %S" condition)
nil))
```
唯一的低层出口是 `raw-ebox`：
```elisp
(etaf-view
(raw-ebox
:key 'manual-node
:value (ebox-create :content "Backend node")))
```
只有普通 Host 和 Component lowering 无法表达真实 Ebox 需求时才使用它；返回的 Node 对 ETAF 语义保持 opaque。
## 12. Playground
可选的 core Playground 是一个完整的 ETAF 应用示例：
```elisp
(require 'etaf-playground)
(etaf-playground-open)
```
需要展示官方目录时：
```elisp
(etaf-playground-open-ui)
```
`etaf-playground-close` 会卸载并删除默认 Playground buffer。它与 `ebox-playground` 独立，核心 ETAF 不会自动加载任一 Playground。
## 13. 公共 API 速查
| API 家族 | 主要入口 | 何时使用 |
| --- | --- | --- |
| View 与 Runtime | `etaf-view`、`etaf-render`、`etaf-mount`、`etaf-unmount`、`etaf-runtime-flush` | 构建、渲染、挂载或显式 flush 应用 |
| Component | `etaf-define-component`、`etaf-current-prop`、`etaf-current-slots` | 复用 View 或保留局部状态 |
| 响应式状态 | `etaf-ref`、`etaf-value`、`etaf-set-value`、`etaf-computed` | 保存或派生状态 |
| 响应式 effect | `etaf-watch`、`etaf-watch-effect`、`etaf-effect-scope`、`etaf-scope-run` | 观察状态或同步外部资源 |
| 生命周期 | `etaf-on-mounted`、`etaf-on-updated`、`etaf-on-unmounted` | 绑定 Component 生命周期工作 |
| Context | `etaf-provide`、`etaf-inject`、`etaf-theme-provide` | 跨层级共享依赖 |
| 事件与 focus | `etaf-dispatch-event`、`etaf-activate`、`etaf-focus`、`etaf-focus-next` | 进入交互 Runtime |
| Action | `etaf-action-define`、`etaf-dispatch` | 命名和复用业务变更 |
| Behavior | `etaf-behavior-create`、`etaf-define-behavior`、`etaf-current-behavior-context`、`etaf-focusable`、`etaf-toggleable` | 复用非视觉交互 bundle |
| Data | `etaf-data-source`、`etaf-data-controller`、`etaf-data-memory-source`、`etaf-data-*` | 查询、分页、变更、选择和停止数据 |
| Resource | `etaf-resource`、`etaf-resource-result`、`etaf-error-boundary-run` | 管理 loader 状态和 cleanup |
| 官方 UI | `require 'etaf-ui`、`etaf-button`、`etaf-checkbox`、`etaf-label`、`etaf-panel`、`etaf-data-grid` | 使用现成 Component |
| Playground | `etaf-playground-open`、`etaf-playground-open-ui`、`etaf-playground-close` | 探索框架 |
大多数应用一开始只需要 `etaf-view`、`etaf-mount`、`etaf-define-component`、`etaf-ref` 和事件 callback。其余 API 都是可选能力，不是理解核心语法的前置条件。
## 14. 常见错误
- 所有属性必须放在第一个子节点之前。
- 使用 `:face 'bold`，不要使用 `:face :bold`；face 是 Elisp symbol 值，不是属性 keyword。
- 结构性 View form 不要 quote。
- `if`、`when`、`let`、`mapcar` 或 Elisp 返回 View 时，使用 `expr :value`。
- 默认 outlet 使用 `(slot)` 或 `(slot FALLBACK...)`；命名内容使用 `:name 'header`。
- 不要在 render 中写状态；使用事件、Action、watch callback 或 Effect。
- 产品级控件使用 `etaf-ui` Component；core Host 只是结构基础。
- owner 不再需要时，停止 Data Controller 并卸载 Runtime。

91
etaf-actions.el Normal file
View File

@ -0,0 +1,91 @@
;;; etaf-actions.el --- Named ETAF mutation actions -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; An Action is one named, testable business mutation entry. It is not a
;; View node and does not own rendering; the current Runtime owns the event
;; boundary and reactive values own publication after an action mutates them.
;;; Code:
(require 'cl-lib)
(require 'etaf-runtime)
(defvar etaf--current-runtime)
(define-error 'etaf-action-error "Invalid ETAF Action")
(cl-defstruct (etaf-action-spec
(:constructor etaf--action-spec-create))
"Registered named Action."
name
function)
(defvar etaf--action-registry (make-hash-table :test #'eq)
"Action name -> `etaf-action-spec' table.")
(defun etaf-action-register (name function)
"Register FUNCTION as named Action NAME and return NAME."
(unless (and (symbolp name) (not (keywordp name)) (functionp function))
(signal 'etaf-action-error
(list (format "Invalid Action registration: %S" name))))
(puthash name (etaf--action-spec-create :name name :function function)
etaf--action-registry)
name)
(defmacro etaf-action-define (name arguments &rest body)
"Define and register named Action NAME with ARGUMENTS and BODY.
The generated function receives RUNTIME as its first argument when called
through `etaf-dispatch'."
(declare (indent 2) (debug defun))
(unless (symbolp name)
(signal 'etaf-action-error (list "Action name must be a symbol")))
(let ((docstring (when (stringp (car body)) (pop body)))
(function-symbol (intern (format "%s--etaf-action" name))))
`(progn
(defun ,function-symbol ,arguments
,(or docstring (format "Run ETAF Action `%s'." name))
,@body)
(etaf-action-register ',name #',function-symbol)
',name)))
;;;###autoload
(defun etaf-dispatch (action &rest arguments)
"Dispatch named ACTION through the active Runtime with ARGUMENTS.
An explicit Runtime may be supplied as the first argument: `(etaf-dispatch
RUNTIME ACTION ...)'. Action functions receive Runtime first."
(let* ((explicit-runtime (etaf-runtime-p action))
(runtime (if explicit-runtime
action
(and (boundp 'etaf--current-runtime)
etaf--current-runtime)))
(action (if explicit-runtime
(pop arguments)
action))
(spec (gethash action etaf--action-registry)))
(unless (symbolp action)
(signal 'etaf-action-error
(list "Action name must be a symbol")))
(unless (and runtime (etaf-runtime-p runtime)
(etaf-runtime-mounted-p runtime))
(signal 'etaf-runtime-error
(list "ETAF runtime is not mounted")))
(unless spec
(signal 'etaf-action-error
(list (format "Unknown ETAF Action: %S" action))))
(let ((etaf--current-runtime runtime))
(apply (etaf-action-spec-function spec) runtime arguments))))
;;;###autoload
(defun etaf-action-undefine (name)
"Remove named Action NAME and return NAME."
(remhash name etaf--action-registry)
name)
(provide 'etaf-actions)
;;; etaf-actions.el ends here

132
etaf-behavior.el Normal file
View File

@ -0,0 +1,132 @@
;;; etaf-behavior.el --- Non-visual :use Behaviors -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; A Behavior is a reusable bundle of semantic attributes and optional setup
;; cleanup. It is data attached through `:use', never a View node. Local
;; `:on-*' callbacks remain the simpler choice for one-off interaction.
;;; Code:
(require 'cl-lib)
(require 'etaf-reactive)
(define-error 'etaf-behavior-error "Invalid ETAF Behavior")
(cl-defstruct (etaf-behavior-spec
(:constructor etaf--behavior-spec-create))
"A name-plus-attributes non-visual Behavior specification."
name
attributes
install)
(cl-defstruct (etaf-behavior-context
(:constructor etaf--behavior-context-create))
"Runtime context supplied to an optional Behavior installer."
runtime
path
host-props)
(defvar etaf--current-behavior-context nil
"Behavior context active while one Behavior installs.")
;;;###autoload
(defun etaf-current-behavior-context ()
"Return the Behavior context active during an installer, or nil."
etaf--current-behavior-context)
(defun etaf-behavior-create (name &rest attributes)
"Create a Behavior spec named NAME from keyword ATTRIBUTES.
The reserved `:install' attribute is an optional zero-argument installer that
returns nil or a cleanup function; it is not merged into Host properties."
(unless (and (symbolp name) (not (keywordp name)))
(signal 'etaf-behavior-error
(list (format "Behavior name must be a symbol: %S" name))))
(unless (and (proper-list-p attributes)
(zerop (% (length attributes) 2)))
(signal 'etaf-behavior-error
(list "Behavior attributes must be keyword/value pairs")))
(let ((tail attributes)
(semantic nil)
install
seen)
(while tail
(let ((key (pop tail)))
(unless (keywordp key)
(signal 'etaf-behavior-error
(list (format "Behavior attribute must be a keyword: %S"
key))))
(when (memq key seen)
(signal 'etaf-behavior-error
(list (format "Duplicate Behavior attribute: %S" key))))
(push key seen)
(let ((value (pop tail)))
(if (eq key :install)
(setq install value)
(setq semantic (append semantic (list key value)))))))
(when (and install (not (functionp install)))
(signal 'etaf-behavior-error
(list ":install must be a function or nil")))
(etaf--behavior-spec-create :name name
:attributes semantic
:install install)))
(defmacro etaf-define-behavior (name arguments &rest body)
"Define ordinary Behavior constructor NAME with ARGUMENTS and BODY.
The constructor must return `etaf-behavior-create' data. This is a function
definition convenience, not a second runtime or visual node model."
(declare (indent 2) (debug defun))
(unless (symbolp name)
(signal 'etaf-behavior-error (list "Behavior name must be a symbol")))
`(defun ,name ,arguments
,(if (stringp (car body)) (pop body)
(format "Construct the `%s' ETAF Behavior." name))
,@body))
;;;###autoload
(defun etaf-focusable (&rest attributes)
"Return a focusable Behavior from ATTRIBUTES.
When ATTRIBUTES does not specify `:tab-index', the Behavior supplies the
standard first tab stop, zero. An explicit nil keeps the Host unfocusable."
(unless (plist-member attributes :tab-index)
(setq attributes (append attributes (list :tab-index 0))))
(apply #'etaf-behavior-create 'focusable attributes))
;;;###autoload
(defun etaf-toggleable (&rest attributes)
"Return a Behavior converting ATTRIBUTES into a toggleable press action.
`:value' and `:on-change' configure the action; all other attributes remain
part of the returned Behavior."
(let ((value (plist-get attributes :value))
(on-change (plist-get attributes :on-change)))
(unless (functionp on-change)
(signal 'etaf-behavior-error
(list "toggleable requires a function-valued :on-change")))
(let (remaining)
(while attributes
(let ((key (pop attributes))
(item (pop attributes)))
(unless (memq key '(:value :on-change))
(setq remaining (append remaining (list key item))))))
(apply #'etaf-behavior-create
'toggleable
(append remaining
(list :on-press
(lambda ()
(funcall
on-change
(not
(if (or (etaf-ref-p value)
(etaf-computed-p value))
(etaf-value value)
value))))))))))
(provide 'etaf-behavior)
;;; etaf-behavior.el ends here

155
etaf-component.el
View File

@ -1,13 +1,13 @@
;;; etaf-component.el --- Stateless ETAF Component definitions -*- lexical-binding: t; -*-
;;; etaf-component.el --- ETAF Component definitions -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; This first implementation slice owns only the beginner `:view' Component
;; form. Stateful `:setup', Context, Behaviors, and lifecycle will be added
;; behind the same Component boundary in later milestones; they are rejected
;; here instead of silently receiving different semantics.
;; 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:
@ -19,7 +19,7 @@
'etaf-view-error)
(defun etaf--component-definition-error (format-string &rest arguments)
"Signal a Component definition error formatted from FORMAT-STRING."
"Signal a Component definition error from FORMAT-STRING and ARGUMENTS."
(signal 'etaf-component-definition-error
(list (apply #'format format-string arguments))))
@ -38,88 +38,169 @@
(unless (symbolp entry)
(etaf--component-definition-error
"Component props must be symbols without defaults: %S" entry))
(when (keywordp entry)
(when (or (keywordp entry) (memq entry '(nil t)))
(etaf--component-definition-error
"Component prop names must not be keywords: %S" entry))
(when (memq entry '(nil t))
(etaf--component-definition-error
"Component prop name cannot be a constant: %S" entry))
"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-view-variable-bindings (props)
"Return lexical bindings for Component 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))))
,(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 stateless Component NAME with ARGUMENTS and CLAUSES.
"Define Component NAME from prop ARGUMENTS and CLAUSES.
The implemented P0 form is:
The definition boundary is intentionally small:
(etaf-define-component NAME (&key PROPS)
:view VIEW)
:view VIEW
:styles (styles (SELECTOR ATTR ...)))
VIEW is already structural View syntax and does not need quote. Attribute
values inside VIEW are ordinary Elisp expressions. `:setup', `:styles',
slots, and lifecycle are intentionally rejected until their owning runtime
contracts are implemented."
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
saw-view)
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))
(unless clauses
(etaf--component-definition-error
"Component %S :view has no View" name))
(setq view-form (pop clauses)
saw-view t))
(setq view-form (pop clauses) saw-view t))
(:setup
(when saw-setup
(etaf--component-definition-error
"Component %S :setup is reserved for the stateful milestone"
name))
"Component %S has duplicate :setup" name))
(setq setup-form (pop clauses) saw-setup t))
(:styles
(when saw-styles
(etaf--component-definition-error
"Component %S :styles is reserved for the style milestone"
name))
"Component %S has duplicate :styles" name))
(setq styles-form (pop clauses) saw-styles t))
(_
(etaf--component-definition-error
"Unknown Component definition keyword %S" keyword)))))
(unless saw-view
(when (and saw-view saw-setup)
(etaf--component-definition-error
"Component %S requires exactly one :view clause" name))
"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
`(lambda (etaf--component-props _etaf--children)
(let ,(etaf--component-view-variable-bindings props)
,(etaf--compile-view-form view-form)))))
(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)
:render ,render-lambda
:setup ,setup-lambda
:styles ',styles-form)
,(or docstring
(format "Definition of ETAF Component `%s'." name)))
(etaf--register-component ',name ,definition-symbol)

131
etaf-context.el Normal file
View File

@ -0,0 +1,131 @@
;;; etaf-context.el --- Inherited Component Context -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Context is the one deliberately inherited dependency environment. It is
;; attached to Component instances, not to View nodes or global variables.
;;; Code:
(require 'cl-lib)
(require 'etaf-reactive)
(define-error 'etaf-context-error "Invalid ETAF Context operation")
(cl-defstruct (etaf-context
(:constructor etaf--context-create))
"One inherited Context frame owned by a Component instance."
parent
(values (make-hash-table :test #'eq)))
(defvar etaf--current-context nil
"Context table of the Component currently being evaluated.")
(defconst etaf--context-missing (make-symbol "etaf-context-missing")
"Unique sentinel used to distinguish an absent Context value.")
(defun etaf--context-key (key)
"Validate and normalize Context KEY."
(unless (and (symbolp key) (not (keywordp key)) (not (memq key '(nil t))))
(signal 'etaf-context-error
(list (format "Context keys must be stable symbols: %S" key))))
key)
;;;###autoload
(defun etaf-provide (key value)
"Provide VALUE under stable Context KEY to the current subtree."
(unless (etaf-context-p etaf--current-context)
(error "ETAF provide requires Component setup or render context"))
(puthash (etaf--context-key key) value
(etaf-context-values etaf--current-context))
value)
;;;###autoload
(cl-defun etaf-inject (key &optional default (required-p nil required-p-supplied-p))
"Return the nearest provided value for KEY.
DEFAULT is returned when KEY is absent. When REQUIRED-P is non-nil, absence
signals an error. The optional third argument is explicit so a provided nil
can be distinguished from a missing dependency."
(let ((key (etaf--context-key key))
(context etaf--current-context)
found
value)
(while (and context (not found))
(let ((candidate (gethash key (etaf-context-values context)
etaf--context-missing)))
(unless (eq candidate etaf--context-missing)
(setq value candidate
found t)))
(setq context (etaf-context-parent context)))
(if found
value
(if (and required-p-supplied-p required-p)
(signal 'etaf-context-error
(list (format "Missing ETAF Context dependency: %S" key)))
default))))
(defun etaf--validate-theme-defaults (theme)
"Validate THEME as a property plist and return a defensive copy.
ETAF deliberately keeps Theme as a Context value rather than another runtime
object. The convention is a property plist whose entries are defaults for
Hosts in the inherited subtree."
(unless (and (proper-list-p theme)
(zerop (% (length theme) 2)))
(signal 'etaf-context-error
(list (format "Theme defaults must be keyword/value pairs: %S"
theme))))
(let ((copy nil)
(tail theme))
(while tail
(let ((key (pop tail))
(value (pop tail)))
(unless (keywordp key)
(signal 'etaf-context-error
(list (format "Theme default must use a keyword: %S" key))))
(setq copy (append copy (list key value)))))
copy))
;;;###autoload
(defun etaf-theme-provide (theme)
"Provide THEME property defaults to the current Component subtree.
THEME is a property plist such as `(:color \"#F4F6FB\" :bgcolor \"#202634\")'.
Explicit Host properties and matching Component `:styles' declarations take
precedence over these defaults. A reactive ref containing such a plist is
also accepted and remains tracked by the current render effect."
(etaf-provide 'theme
(if (or (etaf-ref-p theme) (etaf-computed-p theme))
theme
(etaf--validate-theme-defaults theme))))
;;;###autoload
(defun etaf-theme-defaults (&optional default)
"Return inherited Theme property defaults, or DEFAULT when absent."
(let ((theme (etaf-inject 'theme default)))
(cond
((or (etaf-ref-p theme) (etaf-computed-p theme))
(let ((value (etaf-value theme)))
(if (and (proper-list-p value)
(zerop (% (length value) 2)))
(etaf--validate-theme-defaults value)
default)))
((and (proper-list-p theme)
(zerop (% (length theme) 2)))
(etaf--validate-theme-defaults theme))
(t default))))
;;;###autoload
(defun etaf-theme-value (key &optional default)
"Return Theme property KEY from inherited defaults, or DEFAULT."
(let ((theme (etaf-theme-defaults)))
(if (plist-member theme key)
(plist-get theme key)
default)))
(provide 'etaf-context)
;;; etaf-context.el ends here

432
etaf-data.el Normal file
View File

@ -0,0 +1,432 @@
;;; etaf-data.el --- Data controller and sources -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; ETAF Data is a small reactive controller over explicit source capabilities.
;; A source is only a plist of callables; database, HTTP, file, and ORM
;; integrations belong in concrete source packages that provide those
;; callables.
;;; Code:
(require 'cl-lib)
(require 'etaf-reactive)
(define-error 'etaf-data-error "Invalid ETAF data operation")
(define-error 'etaf-data-stopped-error
"ETAF data controller has been stopped"
'etaf-data-error)
(cl-defstruct (etaf-data--controller
(:constructor etaf-data--controller-create)
(:predicate etaf-data-controller-p)
(:conc-name etaf-data--controller-))
"A reactive Data Controller."
source
scope
query
page
page-size
items
total
status
error
selection
request-id
stopped-p
auto-load-p)
(defun etaf-data-source (&rest capabilities)
"Create a Data source from callable CAPABILITIES.
CAPABILITIES is a plist. `:load' is required and receives QUERY, PAGE, and
PAGE-SIZE. It must return a plist containing at least `:items', and may return
`:total', `:page', and `:page-size'. `:mutate' is optional and receives
OPERATION and PAYLOAD. `:dispose' is optional and runs when the owning
controller stops."
(let ((load (plist-get capabilities :load))
(mutate (plist-get capabilities :mutate))
(dispose (plist-get capabilities :dispose)))
(unless (functionp load)
(signal 'wrong-type-argument (list 'functionp load)))
(dolist (entry `((:mutate . ,mutate)
(:dispose . ,dispose)))
(when (and (cdr entry) (not (functionp (cdr entry))))
(signal 'wrong-type-argument (list 'functionp (cdr entry)))))
(append (list :etaf-data-source t) capabilities)))
(defun etaf-data-source-p (value)
"Return non-nil when VALUE is an ETAF Data source."
(and (listp value)
(eq (plist-get value :etaf-data-source) t)
(functionp (plist-get value :load))))
(defun etaf-data--source-function (source key required-p)
"Return SOURCE function KEY, requiring it when REQUIRED-P is non-nil."
(unless (etaf-data-source-p source)
(signal 'wrong-type-argument (list 'etaf-data-source-p source)))
(let ((function (plist-get source key)))
(when (and required-p (not (functionp function)))
(error "ETAF Data source lacks %S capability" key))
function))
(defun etaf-data--record-value (record key)
"Return RECORD value at KEY for plist, alist, or hash table records."
(cond
((hash-table-p record) (gethash key record))
((and (proper-list-p record)
(zerop (% (length record) 2))
(keywordp (car record)))
(plist-get record key))
((listp record) (alist-get key record))
(t nil)))
(defun etaf-data--record-matches-p (record query)
"Return whether RECORD matches memory source QUERY."
(cond
((null query) t)
((functionp query) (funcall query record))
((stringp query)
(string-match-p
(regexp-quote (downcase query))
(downcase (prin1-to-string record))))
((and (listp query) (keywordp (car query)))
(cl-loop for (key value) on query by #'cddr
always (equal (etaf-data--record-value record key) value)))
((listp query)
(cl-loop for (key . value) in query
always (equal (etaf-data--record-value record key) value)))
(t (equal record query))))
(defun etaf-data--slice (items page page-size)
"Return the PAGE and PAGE-SIZE window from ITEMS."
(let* ((safe-page (max 1 (or page 1)))
(safe-page-size (max 1 (or page-size 20)))
(start (* (1- safe-page) safe-page-size))
(end (min (length items) (+ start safe-page-size))))
(if (>= start (length items))
nil
(cl-subseq items start end))))
(defun etaf-data--memory-record-id (record id-key)
"Return RECORD identity using ID-KEY."
(if id-key
(etaf-data--record-value record id-key)
record))
(defun etaf-data--memory-replace (items id-key payload)
"Return ITEMS with the record matching PAYLOAD and ID-KEY replaced."
(let* ((target-id (etaf-data--memory-record-id payload id-key))
(matched-p nil)
(next
(mapcar
(lambda (record)
(if (equal (etaf-data--memory-record-id record id-key) target-id)
(progn
(setq matched-p t)
payload)
record))
items)))
(unless matched-p
(error "No memory source record for id %S" target-id))
next))
;;;###autoload
(cl-defun etaf-data-memory-source (items &key id-key name)
"Create an in-memory Data source over ITEMS.
ID-KEY identifies records for `replace', `update', and `delete' mutations.
NAME optionally labels the source for diagnostics.
Queries may be nil, a predicate, a search string, a plist, an alist, or an
exact value. Supported mutations are `insert', `replace', `update', `delete',
and `reset'."
(let* ((records (etaf-ref (copy-sequence items)
:name (or name 'etaf-data-memory-source)))
(query-function
(lambda (query current)
(cl-remove-if-not
(lambda (record)
(etaf-data--record-matches-p record query))
current))))
(etaf-data-source
:name name
:load (lambda (query page page-size)
(let* ((all (etaf-value records))
(filtered (funcall query-function query all)))
(list :items (etaf-data--slice filtered page page-size)
:total (length filtered)
:page (max 1 (or page 1))
:page-size (max 1 (or page-size 20)))))
:mutate (lambda (operation payload)
(pcase operation
('insert
(setf (etaf-value records)
(append (etaf-value records) (list payload))))
((or 'replace 'update)
(setf (etaf-value records)
(etaf-data--memory-replace
(etaf-value records) id-key payload)))
('delete
(let ((target-id (if id-key
payload
(etaf-data--memory-record-id
payload id-key))))
(setf (etaf-value records)
(cl-remove-if
(lambda (record)
(equal (etaf-data--memory-record-id record id-key)
target-id))
(etaf-value records)))))
('reset
(setf (etaf-value records) (copy-sequence payload)))
(_
(error "Unsupported memory source mutation: %S"
operation)))
(etaf-value records)))))
(defun etaf-data--require-controller (controller)
"Signal unless CONTROLLER is a Data Controller."
(unless (etaf-data-controller-p controller)
(signal 'wrong-type-argument (list 'etaf-data-controller-p controller)))
(when (etaf-data--controller-stopped-p controller)
(signal 'etaf-data-stopped-error (list controller)))
controller)
(defun etaf-data--normalize-result (result)
"Return a normalized source RESULT plist."
(unless (and (listp result)
(or (null result) (keywordp (car result))))
(error "ETAF Data source load must return a plist: %S" result))
(unless (plist-member result :items)
(error "ETAF Data source load result lacks :items"))
result)
(defun etaf-data--apply-load-success (controller request-id result)
"Publish successful RESULT for CONTROLLER when REQUEST-ID is current."
(when (= request-id (etaf-data--controller-request-id controller))
(let ((normalized (etaf-data--normalize-result result))
(auto-load-p (etaf-data--controller-auto-load-p controller)))
(unwind-protect
(progn
(setf (etaf-data--controller-auto-load-p controller) nil)
(setf (etaf-value (etaf-data--controller-items controller))
(plist-get normalized :items))
(setf (etaf-value (etaf-data--controller-total controller))
(or (plist-get normalized :total)
(length (plist-get normalized :items))))
(when (plist-member normalized :page)
(setf (etaf-value (etaf-data--controller-page controller))
(plist-get normalized :page)))
(when (plist-member normalized :page-size)
(setf (etaf-value (etaf-data--controller-page-size controller))
(plist-get normalized :page-size)))
(setf (etaf-value (etaf-data--controller-error controller)) nil)
(setf (etaf-value (etaf-data--controller-status controller))
'success))
(setf (etaf-data--controller-auto-load-p controller) auto-load-p))))
result)
(defun etaf-data--apply-error (controller request-id error-data)
"Publish ERROR-DATA for CONTROLLER when REQUEST-ID is current."
(when (= request-id (etaf-data--controller-request-id controller))
(setf (etaf-value (etaf-data--controller-error controller)) error-data)
(setf (etaf-value (etaf-data--controller-status controller)) 'error)))
;;;###autoload
(cl-defun etaf-data-controller
(source &key query (page 1) (page-size 20) selection auto-load name)
"Create a reactive Data Controller for SOURCE.
QUERY, PAGE, PAGE-SIZE, result ITEMS, TOTAL, STATUS, ERROR, and SELECTION are
stored in refs. When AUTO-LOAD is non-nil, the controller loads immediately
and reloads after query or pagination refs change. NAME optionally labels the
controller for diagnostics."
(unless (etaf-data-source-p source)
(signal 'wrong-type-argument (list 'etaf-data-source-p source)))
(let* ((scope (etaf-effect-scope :detached t :name (or name 'etaf-data)))
(controller
(etaf-data--controller-create
:source source
:scope scope
:query (etaf-ref query :name 'etaf-data-query)
:page (etaf-ref page :name 'etaf-data-page)
:page-size (etaf-ref page-size :name 'etaf-data-page-size)
:items (etaf-ref nil :name 'etaf-data-items)
:total (etaf-ref 0 :name 'etaf-data-total)
:status (etaf-ref 'idle :name 'etaf-data-status)
:error (etaf-ref nil :name 'etaf-data-error)
:selection (etaf-ref (copy-sequence selection)
:name 'etaf-data-selection)
:request-id 0
:auto-load-p auto-load)))
(etaf-scope-run
scope
(lambda ()
(let ((effect
(etaf-reactive-effect-create
(lambda ()
(etaf-value (etaf-data--controller-query controller))
(etaf-value (etaf-data--controller-page controller))
(etaf-value (etaf-data--controller-page-size controller)))
:name 'etaf-data-auto-load
:scheduler
(lambda (_effect)
(when (and (etaf-data--controller-auto-load-p controller)
(not (etaf-data--controller-stopped-p
controller)))
(etaf-data-load controller))))))
(etaf-reactive-effect-run effect))
(etaf-on-scope-dispose
(lambda ()
(when-let ((dispose (etaf-data--source-function
source :dispose nil)))
(funcall dispose))))))
(when auto-load
(etaf-data-load controller))
controller))
;;;###autoload
(defun etaf-data-load (controller)
"Load CONTROLLER from its source and publish loading, success, or error."
(etaf-data--require-controller controller)
(let ((request-id (1+ (etaf-data--controller-request-id controller))))
(setf (etaf-data--controller-request-id controller) request-id)
(setf (etaf-value (etaf-data--controller-status controller)) 'loading)
(setf (etaf-value (etaf-data--controller-error controller)) nil)
(condition-case err
(etaf-data--apply-load-success
controller
request-id
(funcall (etaf-data--source-function
(etaf-data--controller-source controller) :load t)
(etaf-value (etaf-data--controller-query controller))
(etaf-value (etaf-data--controller-page controller))
(etaf-value (etaf-data--controller-page-size controller))))
(error
(etaf-data--apply-error controller request-id err)
(signal (car err) (cdr err))))))
;;;###autoload
(defun etaf-data-reload (controller)
"Reload CONTROLLER and return the source result."
(etaf-data-load controller))
;;;###autoload
(defun etaf-data-mutate (controller operation payload)
"Run source OPERATION with PAYLOAD, then reload CONTROLLER.
Errors are stored in the controller error ref and re-signaled."
(etaf-data--require-controller controller)
(let ((request-id (1+ (etaf-data--controller-request-id controller))))
(setf (etaf-data--controller-request-id controller) request-id)
(setf (etaf-value (etaf-data--controller-status controller)) 'loading)
(setf (etaf-value (etaf-data--controller-error controller)) nil)
(condition-case err
(progn
(funcall (etaf-data--source-function
(etaf-data--controller-source controller) :mutate t)
operation payload)
(etaf-data-load controller))
(error
(etaf-data--apply-error controller request-id err)
(signal (car err) (cdr err))))))
;;;###autoload
(defun etaf-data-stop (controller)
"Stop CONTROLLER, dispose its Scope, and return cleanup errors."
(unless (etaf-data-controller-p controller)
(signal 'wrong-type-argument (list 'etaf-data-controller-p controller)))
(unless (etaf-data--controller-stopped-p controller)
(setf (etaf-data--controller-stopped-p controller) t)
(etaf-scope-stop (etaf-data--controller-scope controller))))
(defun etaf-data-query (controller)
"Return CONTROLLER's query ref."
(etaf-data--controller-query (etaf-data--require-controller controller)))
(defun etaf-data-page (controller)
"Return CONTROLLER's page ref."
(etaf-data--controller-page (etaf-data--require-controller controller)))
(defun etaf-data-page-size (controller)
"Return CONTROLLER's page-size ref."
(etaf-data--controller-page-size
(etaf-data--require-controller controller)))
(defun etaf-data-items (controller)
"Return CONTROLLER's loaded items ref."
(etaf-data--controller-items (etaf-data--require-controller controller)))
(defun etaf-data-total (controller)
"Return CONTROLLER's total matching item count ref."
(etaf-data--controller-total (etaf-data--require-controller controller)))
(defun etaf-data-status (controller)
"Return CONTROLLER's status ref.
The status value is one of `idle', `loading', `success', or `error'."
(etaf-data--controller-status (etaf-data--require-controller controller)))
(defun etaf-data-error (controller)
"Return CONTROLLER's observable error ref."
(etaf-data--controller-error (etaf-data--require-controller controller)))
(defun etaf-data-selection (controller)
"Return CONTROLLER's selected identity list ref."
(etaf-data--controller-selection
(etaf-data--require-controller controller)))
;;;###autoload
(defun etaf-data-set-query (controller query)
"Set CONTROLLER query to QUERY and return QUERY."
(setf (etaf-value (etaf-data-query controller)) query))
;;;###autoload
(defun etaf-data-set-page (controller page)
"Set CONTROLLER page to PAGE and return PAGE."
(setf (etaf-value (etaf-data-page controller)) page))
;;;###autoload
(defun etaf-data-set-page-size (controller page-size)
"Set CONTROLLER page size to PAGE-SIZE and return PAGE-SIZE."
(setf (etaf-value (etaf-data-page-size controller)) page-size))
;;;###autoload
(defun etaf-data-next-page (controller)
"Move CONTROLLER to the next page and return the new page."
(let ((next (1+ (etaf-value (etaf-data-page controller)))))
(etaf-data-set-page controller next)))
;;;###autoload
(defun etaf-data-previous-page (controller)
"Move CONTROLLER to the previous page and return the new page."
(let ((previous (max 1 (1- (etaf-value (etaf-data-page controller))))))
(etaf-data-set-page controller previous)))
;;;###autoload
(cl-defun etaf-data-select (controller identity &optional (selected-p t))
"Select or deselect IDENTITY in CONTROLLER.
When SELECTED-P is nil, remove IDENTITY from the selection."
(let* ((selection-ref (etaf-data-selection controller))
(selection (etaf-value selection-ref)))
(setf (etaf-value selection-ref)
(if selected-p
(cl-adjoin identity selection :test #'equal)
(cl-remove identity selection :test #'equal)))))
;;;###autoload
(defun etaf-data-selected-p (controller identity)
"Return non-nil when IDENTITY is selected in CONTROLLER."
(member identity (etaf-value (etaf-data-selection controller))))
;;;###autoload
(defun etaf-data-clear-selection (controller)
"Clear CONTROLLER selection and return nil."
(setf (etaf-value (etaf-data-selection controller)) nil))
(provide 'etaf-data)
;;; etaf-data.el ends here

152
etaf-events.el Normal file
View File

@ -0,0 +1,152 @@
;;; etaf-events.el --- ETAF event, activation, and focus ports -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Events are Runtime-owned entry points into local `:on-*' callbacks. Ebox
;; supplies live Host reference bounds; ETAF decides which callback to invoke
;; and keeps focus state separate from the visual tree.
;;; Code:
(require 'cl-lib)
(require 'ebox)
(require 'etaf-runtime)
(defvar etaf--current-runtime)
(declare-function etaf-runtime-require-mounted "etaf-runtime" (&optional runtime))
(declare-function etaf-runtime-p "etaf-runtime" (value))
(declare-function etaf-runtime-mounted-p "etaf-runtime" (runtime))
(declare-function etaf-runtime-buffer "etaf-runtime" (runtime))
(declare-function etaf-runtime-handlers "etaf-runtime" (runtime))
(declare-function etaf-runtime-host-props "etaf-runtime" (runtime))
(declare-function etaf-runtime-focus-ref "etaf-runtime" (runtime))
(declare-function etaf-runtime-set-focus-ref "etaf-runtime" (runtime host-ref))
(define-error 'etaf-event-error "Invalid ETAF Event")
(defvar etaf--current-event nil
"Event context active while one Runtime callback runs.")
(defun etaf-event-kind (kind)
"Normalize event KIND to a non-keyword symbol."
(let ((name (cond
((keywordp kind) (substring (symbol-name kind) 1))
((symbolp kind) (symbol-name kind))
((stringp kind) kind)
(t (signal 'etaf-event-error
(list (format "Invalid event kind: %S" kind)))))))
(setq name (if (string-prefix-p "on-" name)
(substring name 3)
name))
(intern name)))
(defun etaf--event-handler (runtime host-ref kind)
"Return callback for HOST-REF and KIND in RUNTIME, or nil."
(cdr (assq (etaf-event-kind kind)
(gethash host-ref (etaf-runtime-handlers runtime)))))
;;;###autoload
(cl-defun etaf-dispatch-event
(runtime host-ref kind &optional payload (payload-p nil))
"Dispatch KIND for HOST-REF through mounted RUNTIME.
When PAYLOAD-P is non-nil, pass PAYLOAD as the callback's only argument;
otherwise call the local callback with no arguments."
(setq runtime (etaf-runtime-require-mounted runtime))
(let ((callback (etaf--event-handler runtime host-ref kind)))
(unless callback
(signal 'etaf-event-error
(list (format "No %S handler for Host reference %S"
(etaf-event-kind kind) host-ref))))
(let ((etaf--current-runtime runtime)
(etaf--current-event
(list :runtime runtime :host-ref host-ref
:kind (etaf-event-kind kind) :payload payload)))
(if payload-p
(funcall callback payload)
(funcall callback)))))
;;;###autoload
(defun etaf-host-ref-bounds (runtime host-ref)
"Return live Ebox bounds for HOST-REF in mounted RUNTIME."
(setq runtime (etaf-runtime-require-mounted runtime))
(ebox-host-ref-bounds (etaf-runtime-buffer runtime) host-ref))
;;;###autoload
(defun etaf-host-ref-position (runtime host-ref)
"Return the first live Ebox position for HOST-REF in RUNTIME."
(setq runtime (etaf-runtime-require-mounted runtime))
(ebox-host-ref-position (etaf-runtime-buffer runtime) host-ref))
;;;###autoload
(defun etaf-activate (&optional runtime)
"Dispatch `press' for the smallest active Host containing point.
RUNTIME is the mounted Runtime to activate, or nil for the current Runtime.
Return the callback result. This command is intentionally a thin adapter;
hit testing remains Ebox's public Host-reference bounds operation."
(setq runtime (etaf-runtime-require-mounted runtime))
(let ((position (point)) candidates)
(maphash
(lambda (host-ref _handlers)
(when-let ((bounds (ebox-host-ref-bounds
(etaf-runtime-buffer runtime) host-ref)))
(when (and (<= (car bounds) position) (< position (cdr bounds)))
(push (cons host-ref (- (cdr bounds) (car bounds))) candidates))))
(etaf-runtime-handlers runtime))
(unless candidates
(user-error "No interactive ETAF Host at point"))
(let* ((ordered (sort candidates
(lambda (left right) (< (cdr left) (cdr right)))))
(host-ref (car (car ordered))))
(etaf-dispatch-event runtime host-ref 'press))))
;;;###autoload
(defun etaf-focus (runtime host-ref)
"Move focus to HOST-REF in mounted RUNTIME and return HOST-REF."
(setq runtime (etaf-runtime-require-mounted runtime))
(unless (etaf-host-ref-bounds runtime host-ref)
(signal 'etaf-event-error
(list (format "Cannot focus an invisible Host reference: %S"
host-ref))))
(etaf-runtime-set-focus-ref runtime host-ref))
;;;###autoload
(defun etaf-focused-host-ref (&optional runtime)
"Return the currently focused Host reference in mounted RUNTIME."
(etaf-runtime-focus-ref (etaf-runtime-require-mounted runtime)))
;;;###autoload
(defun etaf-focus-next (&optional runtime)
"Focus the next visible Host in mounted RUNTIME.
RUNTIME may be nil to use the current Runtime. Hosts need a numeric,
non-negative `:tab-index'."
(setq runtime (etaf-runtime-require-mounted runtime))
(let (candidates)
(maphash
(lambda (host-ref props)
(let ((tab-index (plist-get props :tab-index)))
(when (and (numberp tab-index) (>= tab-index 0)
(etaf-host-ref-bounds runtime host-ref))
(push (cons tab-index host-ref) candidates))))
(etaf-runtime-host-props runtime))
(setq candidates (sort candidates
(lambda (left right)
(< (car left) (car right)))))
(unless candidates
(user-error "No focusable ETAF Host"))
(let* ((current (etaf-runtime-focus-ref runtime))
(ordered (mapcar #'cdr candidates))
(position (cl-position current ordered :test #'equal))
(next (if position
(or (nth (1+ position) ordered) (car ordered))
(car ordered))))
(etaf-focus runtime next))))
(provide 'etaf-events)
;;; etaf-events.el ends here

114
etaf-playground.el Normal file
View File

@ -0,0 +1,114 @@
;;; etaf-playground.el --- Small ETAF application examples -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; The ETAF playground is an optional application example. It exercises only
;; public ETAF APIs; the Ebox playground remains a separate sibling package.
;;; Code:
(require 'cl-lib)
(require 'etaf)
(defconst etaf-playground-buffer-name "*ETAF Playground*"
"Default buffer name used by `etaf-playground-open'.")
;;;###autoload
(etaf-define-component etaf-playground-counter (&key title)
"Render a small stateful counter titled TITLE.
The counter demonstrates a retained `:setup' Scope, reactive state, semantic
Host references, and ordinary `:on-press' callbacks without introducing a
special counter node or a second event model."
:setup
(let ((count (etaf-ref 0 :name 'playground-count)))
(lambda ()
(etaf-view
(column
:class "etaf-playground-counter"
(text :face 'bold (expr :value title))
(text
(expr :value (format "Count: %d" (etaf-value count))))
(row
(text
:ref 'decrement
:role 'button
:tab-index 0
:on-press (lambda () (cl-decf (etaf-value count)))
" - ")
(text
:ref 'increment
:role 'button
:tab-index 0
:on-press (lambda () (cl-incf (etaf-value count)))
" + ")))))))
;;;###autoload
(defun etaf-playground-view ()
"Return the core ETAF playground View.
The returned View has no buffer or global state side effect until it is passed
to `etaf-mount'."
(etaf-view
(column
:class "etaf-playground-root"
(text :face 'bold "ETAF Playground")
(text :color "#687386"
"One grammar: Hosts, Components, props, children, and expr.")
(etaf-playground-counter :title "Reactive counter")
(text :color "#687386"
"Press + or - with `etaf-dispatch-event' or the normal event bridge."))))
;;;###autoload
(defun etaf-playground-ui-view ()
"Return a playground View that also demonstrates the official UI catalog.
Loading this function requires `etaf-ui'; the core playground itself does not
depend on that optional Component catalog."
(require 'etaf-ui)
(etaf-view
(column
(etaf-panel :title "Official Components"
(etaf-button
:label "A public Component"
:on-press (lambda () (message "ETAF UI button pressed")))
(etaf-checkbox
:checked nil
:label "Controlled checkbox"
:on-change (lambda (value)
(message "Checkbox value: %s" value))))
(etaf-playground-counter :title "Core counter"))))
;;;###autoload
(defun etaf-playground-open (&optional buffer-name)
"Mount the core ETAF playground in BUFFER-NAME and return its buffer."
(interactive)
(etaf-mount (or buffer-name etaf-playground-buffer-name)
(etaf-playground-view)))
;;;###autoload
(defun etaf-playground-open-ui (&optional buffer-name)
"Mount the ETAF playground with official UI Components in BUFFER-NAME."
(interactive)
(etaf-mount (or buffer-name etaf-playground-buffer-name)
(etaf-playground-ui-view)))
;;;###autoload
(defun etaf-playground-close (&optional buffer-name)
"Unmount and kill the playground BUFFER-NAME, returning its buffer.
When BUFFER-NAME is nil, use `etaf-playground-buffer-name'."
(interactive)
(let* ((name (or buffer-name etaf-playground-buffer-name))
(buffer (get-buffer name)))
(when-let ((runtime (and buffer (etaf-runtime-for-buffer buffer))))
(etaf-unmount runtime))
(when buffer
(kill-buffer buffer))
buffer))
(provide 'etaf-playground)
;;; etaf-playground.el ends here

433
etaf-reactive.el Normal file
View File

@ -0,0 +1,433 @@
;;; etaf-reactive.el --- Reactive cells and effect scopes -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; ETAF has one reactive model. Refs, computed values, watchers, component
;; renders, and external Effects all use the same dependency graph. This
;; module deliberately knows nothing about Views, Ebox, or buffers.
;;; Code:
(require 'cl-lib)
(require 'gv)
(define-error 'etaf-reactive-error "Invalid ETAF reactive operation")
(define-error 'etaf-render-write-error
"ETAF state cannot be written while rendering"
'etaf-reactive-error)
(cl-defstruct (etaf-ref
(:constructor etaf--ref-create))
"A writable shallow reactive cell."
value
test
(version 0)
subscribers
name)
(cl-defstruct (etaf-computed
(:constructor etaf--computed-create))
"A lazy cached reactive value."
getter
value
test
(version 0)
subscribers
effect
(dirty-p t)
evaluated-p
evaluating-p
name)
(cl-defstruct (etaf-effect
(:constructor etaf--effect-create))
"A dependency-tracked computation owned by a Scope."
function
scheduler
deps
owner-scope
on-stop
name
(active-p t)
running-p)
(cl-defstruct (etaf-effect-scope
(:constructor etaf--effect-scope-create))
"A tree of effects and cleanups with one disposal boundary."
parent
effects
children
cleanups
name
(active-p t))
(defvar etaf--active-effect nil
"The effect currently collecting dependencies.")
(defvar etaf--active-scope nil
"The Scope that owns newly created effects and cleanups.")
(defvar etaf--tracking-enabled-p t
"Whether reactive reads may collect dependencies.")
(defvar etaf--render-phase-p nil
"Whether the current call is producing a View tree.")
(defvar etaf--watch-scheduler nil
"Scheduler for watchers created in the current Scope.
The function receives a zero-argument job and a phase symbol. Outside a
Runtime, watchers run synchronously.")
(defun etaf--reactive-same-p (left right)
"Return whether LEFT and RIGHT are equal under ETAF's shallow rule."
(if (or (consp left) (vectorp left) (hash-table-p left)
(recordp left) (bufferp left) (windowp left)
(markerp left) (overlayp left) (processp left))
(eq left right)
(equal left right)))
(defun etaf--source-test (source)
"Return SOURCE's equality predicate."
(or (and (etaf-ref-p source) (etaf-ref-test source))
(and (etaf-computed-p source) (etaf-computed-test source))
#'etaf--reactive-same-p))
(defun etaf--source-subscribers (source)
"Return the subscriber table of reactive SOURCE."
(cond
((etaf-ref-p source) (etaf-ref-subscribers source))
((etaf-computed-p source) (etaf-computed-subscribers source))
(t (signal 'wrong-type-argument (list 'etaf-reactive-source-p source)))))
(defun etaf--track-source (source)
"Record SOURCE as a dependency of the active effect."
(when (and etaf--tracking-enabled-p etaf--active-effect
(etaf-effect-active-p etaf--active-effect))
(let ((subscribers (etaf--source-subscribers source)))
(unless (gethash etaf--active-effect subscribers)
(puthash etaf--active-effect t subscribers)
(push source (etaf-effect-deps etaf--active-effect))))))
(defun etaf--clear-effect-deps (effect)
"Remove EFFECT from all reactive sources it previously read."
(dolist (source (etaf-effect-deps effect))
(remhash effect (etaf--source-subscribers source)))
(setf (etaf-effect-deps effect) nil))
(defun etaf--stop-effect (effect)
"Stop EFFECT and run its one-time cleanup."
(when (and (etaf-effect-p effect) (etaf-effect-active-p effect))
(setf (etaf-effect-active-p effect) nil)
(etaf--clear-effect-deps effect)
(when-let ((cleanup (etaf-effect-on-stop effect)))
(setf (etaf-effect-on-stop effect) nil)
(funcall cleanup)))
effect)
(cl-defun etaf-reactive-effect-create
(function &key scheduler name scope on-stop)
"Create an effect for FUNCTION.
SCHEDULER receives the effect when a dependency changes. SCOPE defaults to
the current Scope. NAME optionally labels the effect. ON-STOP runs once
when the effect is disposed."
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(let* ((owner (or scope etaf--active-scope))
(effect (etaf--effect-create
:function function
:scheduler scheduler
:owner-scope owner
:on-stop on-stop
:name name)))
(when owner
(unless (etaf-effect-scope-active-p owner)
(error "Cannot create an effect in a stopped ETAF Scope"))
(push effect (etaf-effect-scope-effects owner)))
effect))
(cl-defun etaf-reactive-effect-run (effect &key rendering)
"Run EFFECT and recollect its dependencies.
When RENDERING is non-nil, `etaf-value' writes are rejected for the duration
of the run."
(unless (etaf-effect-p effect)
(signal 'wrong-type-argument (list 'etaf-effect-p effect)))
(cond
((etaf-effect-running-p effect)
(error "Recursive ETAF effect execution: %S"
(or (etaf-effect-name effect) effect)))
((not (etaf-effect-active-p effect))
(funcall (etaf-effect-function effect)))
(t
(let ((old-deps (copy-sequence (etaf-effect-deps effect)))
(completed-p nil)
result)
(etaf--clear-effect-deps effect)
(let ((etaf--active-effect effect)
(etaf--active-scope (etaf-effect-owner-scope effect))
(etaf--tracking-enabled-p t)
(etaf--render-phase-p (or rendering etaf--render-phase-p)))
(setf (etaf-effect-running-p effect) t)
(unwind-protect
(progn
(setq result (funcall (etaf-effect-function effect)))
(setq completed-p t)
result)
(setf (etaf-effect-running-p effect) nil)
(unless completed-p
(etaf--clear-effect-deps effect)
(dolist (source old-deps)
(puthash effect t (etaf--source-subscribers source)))
(setf (etaf-effect-deps effect) old-deps))))))))
(defun etaf--dispatch-source (source)
"Notify every current subscriber of SOURCE once."
(let ((subscribers (copy-hash-table (etaf--source-subscribers source))))
(maphash
(lambda (effect _)
(when (etaf-effect-active-p effect)
(if-let ((scheduler (etaf-effect-scheduler effect)))
(funcall scheduler effect)
(etaf-reactive-effect-run effect))))
subscribers)))
;;;###autoload
(cl-defun etaf-ref (initial-value &key test name)
"Create a writable shallow reactive cell containing INITIAL-VALUE.
TEST optionally compares old and new values. NAME is used in diagnostics."
(when (and test (not (functionp test)))
(signal 'wrong-type-argument (list 'functionp test)))
(etaf--ref-create :value initial-value
:test test
:subscribers (make-hash-table :test #'eq)
:name name))
(defun etaf--computed-value (computed)
"Read COMPUTED, evaluating it when its dependencies are dirty."
(etaf--track-source computed)
(when (etaf-computed-dirty-p computed)
(when (etaf-computed-evaluating-p computed)
(error "Recursive ETAF computed evaluation: %S"
(or (etaf-computed-name computed) computed)))
(setf (etaf-computed-evaluating-p computed) t)
(unwind-protect
(let* ((old (etaf-computed-value computed))
(was-evaluated (etaf-computed-evaluated-p computed))
(new (etaf-reactive-effect-run
(etaf-computed-effect computed))))
(setf (etaf-computed-value computed) new
(etaf-computed-dirty-p computed) nil
(etaf-computed-evaluated-p computed) t)
(when (or (not was-evaluated)
(not (funcall (etaf--source-test computed) old new)))
(cl-incf (etaf-computed-version computed))))
(setf (etaf-computed-evaluating-p computed) nil)))
(etaf-computed-value computed))
;;;###autoload
(cl-defun etaf-computed (getter &key test name)
"Create a lazy cached value computed by zero-argument GETTER.
TEST optionally compares old and new values. NAME optionally labels the
computed value."
(unless (functionp getter)
(signal 'wrong-type-argument (list 'functionp getter)))
(when (and test (not (functionp test)))
(signal 'wrong-type-argument (list 'functionp test)))
(let ((computed (etaf--computed-create
:getter getter :test test :name name
:subscribers (make-hash-table :test #'eq))))
(setf (etaf-computed-effect computed)
(etaf-reactive-effect-create
getter
:name (or name 'computed)
:scheduler
(lambda (_effect)
(unless (etaf-computed-dirty-p computed)
(setf (etaf-computed-dirty-p computed) t)
(etaf--dispatch-source computed)))))
computed))
;;;###autoload
(defun etaf-value (source)
"Read reactive SOURCE and track the read in the current effect."
(cond
((etaf-ref-p source)
(etaf--track-source source)
(etaf-ref-value source))
((etaf-computed-p source) (etaf--computed-value source))
(t (signal 'wrong-type-argument (list 'etaf-reactive-source-p source)))))
(defun etaf-set-value (source new-value)
"Set writable reactive SOURCE to NEW-VALUE and return NEW-VALUE."
(when etaf--render-phase-p
(signal 'etaf-render-write-error
(list (and (etaf-ref-p source) (etaf-ref-name source)))))
(unless (etaf-ref-p source)
(error "ETAF computed values are read-only: %S" source))
(let ((old-value (etaf-ref-value source)))
(unless (funcall (etaf--source-test source) old-value new-value)
(setf (etaf-ref-value source) new-value)
(cl-incf (etaf-ref-version source))
(etaf--dispatch-source source)))
new-value)
(gv-define-setter etaf-value (new-value source)
`(etaf-set-value ,source ,new-value))
(defun etaf--watch-getter (source)
"Return a zero-argument getter for watch SOURCE."
(cond
((or (etaf-ref-p source) (etaf-computed-p source))
(lambda () (etaf-value source)))
((functionp source) source)
(t (error "ETAF watch source must be reactive or callable: %S" source))))
(defun etaf--schedule-watch (job flush)
"Schedule JOB in FLUSH through the active Runtime scheduler."
(if etaf--watch-scheduler
(funcall etaf--watch-scheduler job flush)
(funcall job)))
;;;###autoload
(cl-defun etaf-watch
(source callback &key immediate (flush 'pre) test name)
"Watch SOURCE and call CALLBACK with NEW and OLD values.
IMMEDIATE calls CALLBACK for the initial value. FLUSH is passed to the
current Runtime scheduler. TEST and NAME customize comparison and
diagnostics. Return a stop function."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(let* ((getter (etaf--watch-getter source))
(same-p (or test (and (etaf-ref-p source)
(etaf--source-test source))
(and (etaf-computed-p source)
(etaf--source-test source))
#'etaf--reactive-same-p))
initialized-p
old-value
cleanup
effect
job)
(setq job
(lambda ()
(when (etaf-effect-active-p effect)
(let ((new-value (etaf-reactive-effect-run effect)))
(when (or (not initialized-p)
(not (funcall same-p old-value new-value)))
(let ((previous (and initialized-p old-value)))
(setq old-value new-value initialized-p t)
(when cleanup
(funcall cleanup)
(setq cleanup nil))
(when-let ((result (funcall callback new-value previous)))
(when (functionp result)
(setq cleanup result)))))))))
(setq effect
(etaf-reactive-effect-create
getter
:name (or name 'watch)
:on-stop (lambda () (when cleanup (funcall cleanup)))
:scheduler
(lambda (_effect) (etaf--schedule-watch job flush))))
(if immediate
(funcall job)
(setq old-value (etaf-reactive-effect-run effect)
initialized-p t))
(lambda () (etaf--stop-effect effect))))
;;;###autoload
(cl-defun etaf-watch-effect (function &key (flush 'pre) name)
"Run FUNCTION immediately and again after a reactive dependency change.
FLUSH selects the Runtime scheduler boundary. NAME optionally labels the
effect. If FUNCTION returns a function, it cleans up the previous run."
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(let (cleanup effect job)
(setq job
(lambda ()
(when (etaf-effect-active-p effect)
(when cleanup (funcall cleanup) (setq cleanup nil))
(when-let ((result (etaf-reactive-effect-run effect)))
(when (functionp result) (setq cleanup result))))))
(setq effect
(etaf-reactive-effect-create
function
:name (or name 'watch-effect)
:on-stop (lambda () (when cleanup (funcall cleanup)))
:scheduler
(lambda (_effect) (etaf--schedule-watch job flush))))
(funcall job)
(lambda () (etaf--stop-effect effect))))
;;;###autoload
(cl-defun etaf-effect-scope (&key detached name)
"Create a Scope named NAME, owned by the current Scope unless DETACHED."
(let* ((parent (and (not detached) etaf--active-scope))
(scope (etaf--effect-scope-create :parent parent :name name)))
(when parent
(push scope (etaf-effect-scope-children parent)))
scope))
;;;###autoload
(defun etaf-current-effect-scope ()
"Return the active Scope, or nil outside scoped execution."
etaf--active-scope)
;;;###autoload
(cl-defun etaf-scope-run
(scope function &key (watch-scheduler nil watch-scheduler-p))
"Run FUNCTION with active SCOPE and optional WATCH-SCHEDULER."
(unless (and (etaf-effect-scope-p scope)
(etaf-effect-scope-active-p scope))
(error "Cannot enter an inactive ETAF Scope"))
(let ((etaf--active-scope scope)
(etaf--watch-scheduler
(if watch-scheduler-p watch-scheduler etaf--watch-scheduler)))
(funcall function)))
;;;###autoload
(defun etaf-on-scope-dispose (function)
"Register FUNCTION to run when the current Scope is disposed."
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(unless etaf--active-scope
(error "ETAF cleanup registration requires an active Scope"))
(push function (etaf-effect-scope-cleanups etaf--active-scope))
function)
;;;###autoload
(defun etaf-scope-stop (scope)
"Dispose SCOPE and return cleanup errors collected during teardown."
(when (and (etaf-effect-scope-p scope)
(etaf-effect-scope-active-p scope))
(setf (etaf-effect-scope-active-p scope) nil)
(let (errors)
(dolist (child (copy-sequence (etaf-effect-scope-children scope)))
(setq errors (nconc errors (etaf-scope-stop child))))
(dolist (effect (copy-sequence (etaf-effect-scope-effects scope)))
(condition-case err
(etaf--stop-effect effect)
((error quit) (push err errors))))
(dolist (cleanup (copy-sequence (etaf-effect-scope-cleanups scope)))
(condition-case err
(funcall cleanup)
((error quit) (push err errors))))
(setf (etaf-effect-scope-effects scope) nil
(etaf-effect-scope-children scope) nil
(etaf-effect-scope-cleanups scope) nil)
(when-let ((parent (etaf-effect-scope-parent scope)))
(setf (etaf-effect-scope-children parent)
(delq scope (etaf-effect-scope-children parent))))
(nreverse errors))))
(provide 'etaf-reactive)
;;; etaf-reactive.el ends here

369
etaf-renderer.el
View File

@ -4,33 +4,193 @@
;;; Commentary:
;; The renderer is the only first-slice module that knows Ebox. It accepts
;; normalized View values, resolves `expr', turns semantic ETAF properties into
;; Ebox properties, and delegates measurement, layout, painting, and buffer
;; publication to Ebox's public API.
;; This is ETAF's only Ebox boundary. It lowers normalized View values and
;; delegates measurement, layout, painting, and publication to Ebox. Runtime
;; owns retained Component instances and calls the renderer through the small
;; `etaf--render-value-list' port below.
;;; Code:
(require 'cl-lib)
(require 'ebox)
(require 'etaf-view)
(require 'etaf-context)
(declare-function etaf--runtime-render-component "etaf-runtime" (runtime call path))
(declare-function etaf--runtime-behavior-node "etaf-runtime" (runtime node path))
(declare-function etaf--runtime-register-host "etaf-runtime" (runtime props path))
(declare-function etaf-theme-defaults "etaf-context" (&optional default))
(define-error 'etaf-renderer-error "ETAF rendering error")
(defconst etaf--semantic-props
'(:class :id :role :disabled :tab-index :ref :use
:aria-label :aria-description :on-press :on-key-down :on-mouse-down
:on-mouse-drag :on-wheel :on-input)
'(:class :id :role :disabled :tab-index :ref :use :aria-label
:aria-description :on-press :on-key-down :on-mouse-down :on-mouse-drag
:on-wheel :on-input :on-focus :on-blur)
"ETAF semantic properties that are not Ebox box properties.")
(defvar etaf--render-runtime nil
"Runtime currently lowering a View tree, or nil for a pure render.")
(defvar etaf--render-style-stack nil
"Component style scopes active during View lowering.")
(defun etaf--event-property-p (property)
"Return non-nil when PROPERTY is an ETAF event callback property."
(and (keywordp property)
(string-prefix-p "on-" (substring (symbol-name property) 1))))
(defun etaf--ebox-properties (props)
"Translate ETAF PROPS into a property list accepted by Ebox."
(let (ebox-props surface-properties)
(defun etaf--generated-host-ref (props path)
"Return the explicit or generated opaque host reference for PROPS and PATH."
(or (plist-get props :ref)
(list 'etaf-host (copy-sequence path))))
(defun etaf--merge-property (props key value)
"Return PROPS with KEY set to VALUE, preserving the original order."
(if (plist-member props key)
(let ((copy (copy-sequence props)))
(plist-put copy key value)
copy)
(append props (list key value))))
(defun etaf--style-selector-match-p (selector node &optional root-p)
"Return whether string SELECTOR matches normalized Host NODE.
This small matcher covers the stable core selector vocabulary. The complete
ECSS compiler is layered on top later without changing the View or Ebox
boundaries: `&', `.class', `&.class', and `[role=value]' are enough for core
Component styles and remain deterministic for all text applications.
ROOT-P marks the Component style root."
(let* ((name (symbol-name (etaf--view-node-name node)))
(props (etaf--view-node-props node))
(class (plist-get props :class))
(classes (cond
((stringp class) (split-string class "[[:space:]]+" t))
((symbolp class) (list (symbol-name class)))
((listp class)
(mapcar (lambda (item)
(if (symbolp item)
(symbol-name item)
(format "%s" item)))
class))
(t nil))))
(cond
((string= selector "&") root-p)
((string-prefix-p "." selector)
(member (substring selector 1) classes))
((string-prefix-p "&." selector)
(and root-p (member (substring selector 2) classes)))
((string-match "\\`\\[role=\\([^]]+\\)\\]\\'" selector)
(equal (format "%s" (plist-get props :role))
(match-string 1 selector)))
((string= selector name) t)
(t nil))))
(defun etaf--apply-inline-style-rules (node styles &optional root-p)
"Apply static STYLES to NODE and return a copied normalized node.
Inline View properties win over Component style declarations. Styles are
represented as ordinary static data until this final lowering step; they do
not create another visual node category."
(if (null styles)
node
(let ((props (copy-sequence (etaf--view-node-props node))))
(dolist (rule (cdr styles))
(when (and (consp rule) (stringp (car rule))
(etaf--style-selector-match-p (car rule) node root-p))
(let ((rule-props (cdr rule)))
(while rule-props
(let ((key (pop rule-props))
(value (pop rule-props)))
(unless (keywordp key)
(signal 'etaf-renderer-error
(list (format "Style property must be a keyword: %S"
key))))
(setq value (if (and (consp value) (eq (car value) 'quote))
(cadr value)
value))
(unless (plist-member props key)
(setq props (append props (list key value)))))))))
(etaf--view-node-create
:name (etaf--view-node-name node)
:props props
:children (etaf--view-node-children node)))))
(defun etaf--apply-theme-defaults (node)
"Apply inherited Theme defaults to NODE without overriding props."
(let ((defaults (etaf-theme-defaults)))
(if (null defaults)
node
(let ((props (copy-sequence (etaf--view-node-props node))))
(while defaults
(let ((key (pop defaults))
(value (pop defaults)))
(unless (plist-member props key)
(setq props (append props (list key value))))))
(etaf--view-node-create
:name (etaf--view-node-name node)
:props props
:children (etaf--view-node-children node))))))
(defun etaf--inline-text-surface-properties (props)
"Return text properties represented by inline text PROPS."
(let ((surface (copy-sequence (or (plist-get props :surface-properties) nil))))
(when (plist-member props :face)
(setq surface (append surface (list 'face (plist-get props :face)))))
(when (plist-member props :color)
(setq surface (append surface
(list 'foreground (plist-get props :color)))))
(when (plist-member props :bgcolor)
(setq surface (append surface
(list 'background (plist-get props :bgcolor)))))
surface))
(defun etaf--inline-text-content (value)
"Return `(SUCCESS . STRING)' for inline-compatible text VALUE.
Nested `text' Hosts become propertized runs in one Ebox content surface.
Other View Hosts and Components return a failed result so the caller can use
the ordinary layout lowering path instead."
(cond
((stringp value) (cons t value))
((etaf--expr-p value)
(etaf--inline-text-content (funcall (etaf--expr-thunk value))))
((etaf--view-node-p value)
(if (eq (etaf--view-node-name value) 'text)
(let ((children (etaf--view-node-children value))
(result "")
(valid-p t))
(dolist (child children)
(pcase (etaf--inline-text-content child)
(`(t . ,content) (setq result (concat result content)))
(_ (setq valid-p nil))))
(if valid-p
(let ((surface
(etaf--inline-text-surface-properties
(etaf--resolve-property-plist
(etaf--view-node-props value)))))
(when surface
(setq result (copy-sequence result))
(unless (zerop (length result))
(add-text-properties 0 (length result) surface result)))
(cons t result))
(cons nil nil)))
(cons nil nil)))
((proper-list-p value)
(let ((result "")
(valid-p t))
(dolist (item value)
(pcase (etaf--inline-text-content item)
(`(t . ,content) (setq result (concat result content)))
(_ (setq valid-p nil))))
(cons valid-p (and valid-p result))))
(t (cons nil nil))))
(defun etaf--ebox-properties (props path)
"Translate ETAF PROPS at PATH into Ebox's public property list."
(let* ((source-props (etaf--resolve-property-plist props))
(props (copy-sequence source-props))
ebox-props surface-properties)
(while props
(let ((key (pop props))
(value (pop props)))
@ -50,28 +210,155 @@
nil)
(t
(setq ebox-props (append ebox-props (list key value)))))))
(setq ebox-props
(etaf--merge-property
ebox-props :host-ref (etaf--generated-host-ref source-props path)))
(when surface-properties
(setq ebox-props
(append ebox-props
(list :surface-properties surface-properties))))
ebox-props))
(defun etaf--render-resolved-value (value)
"Render one resolved string or View VALUE to a list of Ebox nodes."
(defun etaf--flatten-view-value (value)
"Flatten VALUE through transparent `expr' and sequence values."
(cond
((stringp value)
(list (ebox-create :content value)))
((etaf--view-node-p value)
(etaf--render-node value))
((null value) nil)
((or (stringp value) (etaf--view-node-p value)
(etaf--component-call-p value) (etaf--slot-projection-p value)
(etaf--raw-ebox-p value))
(list value))
((etaf--expr-p value)
(etaf--flatten-view-value (funcall (etaf--expr-thunk value))))
((proper-list-p value)
(cl-mapcan #'etaf--flatten-view-value value))
(t
(signal 'etaf-renderer-error
(list (format "Unresolved View value reached renderer: %S"
value))))))
(list (format "Invalid View value: %S" value))))))
(defun etaf--render-values (value)
"Resolve and render VALUE to a flat list of Ebox nodes."
(cl-mapcan #'etaf--render-resolved-value
(etaf--resolve-value value)))
(defun etaf--render-slot-projection (projection path)
"Render PROJECTION at PATH using the active Component slot collection."
(let* ((name (etaf--slot-projection-name projection))
(slots etaf--current-component-slots)
(entry (assq name slots))
(fallback (etaf--slot-projection-fallback projection)))
(etaf--render-value-list
(if entry (cdr entry) fallback)
(append path (list :slot name)))))
(defun etaf--render-component-call-pure (call path)
"Render stateless CALL at PATH without a retained Runtime."
(let* ((spec (etaf--component-call-spec call))
(render (etaf--component-spec-render spec)))
(when (etaf--component-spec-setup spec)
(signal 'etaf-renderer-error
(list "Stateful Component requires `etaf-mount'")))
(let ((etaf--current-component-props
(etaf--component-call-props call))
(etaf--current-component-slots
(etaf--component-call-slots call)))
(let ((etaf--render-style-stack
(cons (cons (etaf--component-spec-styles spec)
(append path (list :component
(etaf--component-spec-name spec))))
etaf--render-style-stack)))
(etaf--render-value-list
(funcall render
(etaf--component-call-props call)
(etaf--component-call-slots call))
(append path (list :component (etaf--component-spec-name spec))))))))
(defun etaf--render-value-list (value path)
"Render VALUE at structural PATH into a list of Ebox nodes."
(let* ((items (etaf--flatten-view-value value))
(multiple-p (> (length items) 1)))
(cl-loop for item in items
for index from 0
for item-path = (if multiple-p
(append path (list index))
path)
append
(cond
((stringp item) (list (ebox-create :content item)))
((etaf--view-node-p item)
(etaf--render-node item item-path))
((etaf--component-call-p item)
(if etaf--render-runtime
(list (etaf--runtime-render-component
etaf--render-runtime item item-path))
(etaf--render-component-call-pure item item-path)))
((etaf--slot-projection-p item)
(etaf--render-slot-projection item item-path))
((etaf--raw-ebox-p item)
(let ((node (funcall (etaf--raw-ebox-thunk item)))
(key (and (etaf--raw-ebox-key-thunk item)
(funcall (etaf--raw-ebox-key-thunk item)))))
(unless node
(signal 'etaf-renderer-error
(list "raw-ebox :value returned nil")))
(unless (listp node)
(signal 'etaf-renderer-error
(list "raw-ebox :value must return an Ebox node")))
(when key
(etaf--validate-key key)
(setq node (copy-sequence node))
(plist-put node :key key))
(list node)))
(t
(signal 'etaf-renderer-error
(list (format "Unresolved View item: %S" item))))))))
(defun etaf--render-node (node path)
"Render normalized Host NODE at structural PATH."
(let* ((node (if (and etaf--render-runtime
(fboundp 'etaf--runtime-behavior-node))
(etaf--runtime-behavior-node
etaf--render-runtime node path)
node))
(node (if (fboundp 'etaf--runtime-style-node)
(etaf--runtime-style-node node path)
node))
(node (etaf--apply-theme-defaults node))
(name (etaf--view-node-name node))
(raw-props (etaf--resolve-property-plist
(etaf--view-node-props node)))
(props (etaf--ebox-properties raw-props path))
(children (etaf--view-node-children node)))
(when (and etaf--render-runtime
(fboundp 'etaf--runtime-register-host))
(etaf--runtime-register-host etaf--render-runtime raw-props path))
(pcase name
('text
(let* ((flat (cl-mapcan #'etaf--flatten-view-value children))
(child-path (append path (list :text)))
(inline (etaf--inline-text-content flat))
(rendered (unless (car inline)
(etaf--render-value-list flat child-path))))
(if (car inline)
(list (apply #'ebox-create
:content (cdr inline)
props))
(list (ebox-build
(append (list 'row) props rendered))))))
('spacer
(when children
(signal 'etaf-renderer-error
(list "spacer cannot have children")))
(list (apply #'ebox-spacer props)))
('fragment
(etaf--render-value-list children (append path (list :fragment))))
((or 'row 'column 'container 'stack 'flex)
(let ((nodes nil)
(index 0))
(dolist (child children)
(setq nodes
(nconc nodes
(etaf--render-value-list
child (append path (list index)))))
(cl-incf index))
(list (etaf--layout-node name props nodes))))
(_
(signal 'etaf-renderer-error
(list (format "Unknown Host reached renderer: %S" name)))))))
(defun etaf--layout-node (name props nodes)
"Build layout NAME with Ebox PROPS around child NODES."
@ -90,39 +377,13 @@
(signal 'etaf-renderer-error
(list (format "Not a layout Host: %S" name))))))
(defun etaf--render-node (node)
"Render normalized Host NODE to a list of Ebox nodes."
(let* ((name (etaf--view-node-name node))
(props (etaf--ebox-properties (etaf--view-node-props node)))
(children (etaf--resolve-value (etaf--view-node-children node))))
(pcase name
('text
(unless (cl-every #'stringp children)
(signal 'etaf-renderer-error
(list "text children must resolve to strings")))
(list (apply #'ebox-create
:content (apply #'concat children)
props)))
('spacer
(when children
(signal 'etaf-renderer-error
(list "spacer cannot have children")))
(list (apply #'ebox-spacer props)))
('fragment
(etaf--render-values children))
((or 'row 'column 'container 'stack 'flex)
(list (etaf--layout-node name props (etaf--render-values children))))
(_
(signal 'etaf-renderer-error
(list (format "Unknown Host reached renderer: %S" name)))))))
;;;###autoload
(defun etaf-render (view)
"Lower normalized VIEW to one Ebox node.
Multiple root values are placed in a vertical column. Ebox remains the owner
of all measurement, layout, painting, and identity details."
(let ((nodes (etaf--render-values view)))
This pure entry supports stateless Components. Stateful Components require a
Runtime because their setup Scope must have a lifecycle owner."
(let ((nodes (etaf--render-value-list view '(root))))
(cond
((null nodes) (ebox-spacer))
((null (cdr nodes)) (car nodes))
@ -130,8 +391,10 @@ of all measurement, layout, painting, and identity details."
;;;###autoload
(defun etaf-mount (buffer-or-name view)
"Render VIEW into BUFFER-OR-NAME and return the live buffer."
(ebox-render-to-buffer buffer-or-name (etaf-render view)))
"Mount normalized VIEW into BUFFER-OR-NAME and return its buffer."
(if (fboundp 'etaf-runtime-mount)
(etaf-runtime-mount buffer-or-name view)
(ebox-render-to-buffer buffer-or-name (etaf-render view))))
(provide 'etaf-renderer)

192
etaf-resource.el Normal file
View File

@ -0,0 +1,192 @@
;;; etaf-resource.el --- Resource state and error boundary -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Resources are small Scope-owned data loaders. A synchronous loader updates
;; one reactive state cell to loading, success, or error. Loader failures are
;; represented in that state; unrelated errors still propagate through their
;; ordinary boundary unless explicitly wrapped with `etaf-error-boundary-run'.
;;; Code:
(require 'cl-lib)
(require 'etaf-reactive)
(define-error 'etaf-resource-error "Invalid ETAF Resource operation"
'etaf-reactive-error)
(cl-defstruct (etaf-resource
(:constructor etaf--resource-create))
"A Scope-owned synchronous resource."
loader
state
scope
cleanup
name
(active-p t))
(cl-defstruct (etaf-resource-result
(:constructor etaf--resource-result-create))
"A Resource loader result with VALUE and optional CLEANUP."
value
cleanup)
(defun etaf--resource-state (status value error)
"Return a Resource state plist for STATUS, VALUE, and ERROR."
(list :status status :value value :error error))
(defun etaf--resource-parent-scope (scope)
"Return explicit SCOPE or the current active Scope."
(or scope (etaf-current-effect-scope)))
(defun etaf--resource-child-scope (scope name)
"Create a Resource Scope named NAME under SCOPE when present, otherwise detached."
(if scope
(etaf-scope-run scope
(lambda () (etaf-effect-scope :name name)))
(etaf-effect-scope :detached t :name name)))
(defun etaf--resource-require-active (resource)
"Return active RESOURCE or signal a Resource error."
(unless (and (etaf-resource-p resource)
(etaf-resource-active-p resource))
(signal 'etaf-resource-error
(list "ETAF Resource is not active")))
resource)
(defun etaf--resource-set-state (resource status value error)
"Set RESOURCE state to STATUS, VALUE, and ERROR."
(setf (etaf-value (etaf-resource-state resource))
(etaf--resource-state status value error)))
(defun etaf--resource-run-cleanup (resource)
"Run RESOURCE's current cleanup once."
(when-let ((cleanup (etaf-resource-cleanup resource)))
(setf (etaf-resource-cleanup resource) nil)
(funcall cleanup)))
(defun etaf--resource-normalize-result (result)
"Return (VALUE CLEANUP) from loader RESULT."
(if (etaf-resource-result-p result)
(list (etaf-resource-result-value result)
(etaf-resource-result-cleanup result))
(list result nil)))
;;;###autoload
(cl-defun etaf-resource-result (value &key cleanup)
"Return a Resource loader result containing VALUE and optional CLEANUP.
CLEANUP must be nil or a zero-argument function. It runs before the next
successful load replaces the resource value, and when the Resource is
disposed."
(when (and cleanup (not (functionp cleanup)))
(signal 'wrong-type-argument (list 'functionp cleanup)))
(etaf--resource-result-create :value value :cleanup cleanup))
;;;###autoload
(cl-defun etaf-resource (loader &key (immediate t) scope name)
"Create a Resource backed by synchronous LOADER.
The Resource owns a child Scope under SCOPE, or under the current active Scope
when SCOPE is nil. Without any parent Scope it creates a detached Scope.
When IMMEDIATE is non-nil, load the Resource before returning it."
(unless (functionp loader)
(signal 'wrong-type-argument (list 'functionp loader)))
(let* ((parent (etaf--resource-parent-scope scope))
(owned-scope (etaf--resource-child-scope parent name))
resource)
(setq resource
(etaf--resource-create
:loader loader
:state (etaf-ref (etaf--resource-state 'loading nil nil)
:name name)
:scope owned-scope
:name name))
(etaf-scope-run
owned-scope
(lambda ()
(etaf-on-scope-dispose
(lambda ()
(setf (etaf-resource-active-p resource) nil)
(etaf--resource-run-cleanup resource)))))
(when immediate
(etaf-resource-load resource))
resource))
;;;###autoload
(defun etaf-resource-status (resource)
"Return RESOURCE status: `loading', `success', or `error'."
(plist-get (etaf-value (etaf-resource-state resource)) :status))
;;;###autoload
(defun etaf-resource-value (resource)
"Return RESOURCE's successful value, or nil before success."
(plist-get (etaf-value (etaf-resource-state resource)) :value))
;;;###autoload
(defun etaf-resource-error (resource)
"Return RESOURCE's captured loader error, or nil when not in error."
(plist-get (etaf-value (etaf-resource-state resource)) :error))
;;;###autoload
(defun etaf-resource-load (resource)
"Reload RESOURCE and return it.
Only LOADER errors are captured into Resource state. Cleanup failures and
wrong Resource usage continue to signal normally."
(etaf--resource-require-active resource)
(etaf--resource-run-cleanup resource)
(etaf--resource-set-state resource 'loading nil nil)
(let (result error-data)
(condition-case err
(setq result
(etaf-scope-run
(etaf-resource-scope resource)
(etaf-resource-loader resource)))
(error (setq error-data err)))
(if error-data
(etaf--resource-set-state resource 'error nil error-data)
(pcase-let ((`(,value ,cleanup)
(etaf--resource-normalize-result result)))
(when (and cleanup (not (functionp cleanup)))
(signal 'wrong-type-argument (list 'functionp cleanup)))
(setf (etaf-resource-cleanup resource) cleanup)
(etaf--resource-set-state resource 'success value nil))))
resource)
;;;###autoload
(defun etaf-resource-dispose (resource)
"Dispose RESOURCE and return cleanup errors collected by its Scope."
(unless (etaf-resource-p resource)
(signal 'wrong-type-argument (list 'etaf-resource-p resource)))
(when (etaf-resource-active-p resource)
(setf (etaf-resource-active-p resource) nil)
(etaf-scope-stop (etaf-resource-scope resource))))
;;;###autoload
(defalias 'etaf-resource-cancel #'etaf-resource-dispose
"Cancel RESOURCE and return cleanup errors collected by its Scope.")
;;;###autoload
(cl-defun etaf-error-boundary-run (function handler &key name)
"Run FUNCTION and handle its signaled error with HANDLER.
HANDLER receives the raw condition object and its return value becomes the
boundary result. NAME is accepted for caller diagnostics and does not change
control flow. Errors signaled outside FUNCTION, or by HANDLER itself, are not
swallowed by this boundary."
(ignore name)
(unless (functionp function)
(signal 'wrong-type-argument (list 'functionp function)))
(unless (functionp handler)
(signal 'wrong-type-argument (list 'functionp handler)))
(condition-case err
(funcall function)
(error
(funcall handler err))))
(provide 'etaf-resource)
;;; etaf-resource.el ends here

591
etaf-runtime.el Normal file
View File

@ -0,0 +1,591 @@
;;; etaf-runtime.el --- ETAF retained runtime and publication loop -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; Runtime is the owner of mounted lifetime, retained Component instances,
;; reactive render effects, and the Ebox commit boundary. It does not know
;; Ebox's private tree representation; Renderer is the only lowering port.
;;; Code:
(require 'cl-lib)
(require 'ebox)
(require 'etaf-view)
(require 'etaf-component)
(require 'etaf-reactive)
(require 'etaf-renderer)
(require 'etaf-context)
(require 'etaf-behavior)
(declare-function etaf--render-value-list "etaf-renderer" (value path))
(declare-function etaf--apply-inline-style-rules "etaf-renderer" (node styles &optional root-p))
(declare-function etaf--generated-host-ref "etaf-renderer" (props path))
(defvar etaf--render-runtime)
(defvar etaf--render-style-stack)
(defvar etaf--current-context)
(define-error 'etaf-runtime-error "ETAF runtime error")
(cl-defstruct (etaf--component-instance
(:constructor etaf--component-instance-create))
"Retained state and lifecycle for one logical Component call."
spec
identity
scope
render-function
props
slots
context
mounted-hooks
updated-hooks
unmounted-hooks
(mounted-p nil))
(cl-defstruct (etaf-runtime
(:constructor etaf--runtime-create))
"Mounted ETAF application runtime."
buffer
root-view
root-node
scope
render-effect
instances
handlers
host-props
focus-ref
behaviors
seen
candidate-handlers
candidate-host-props
candidate-behaviors
candidate-created
candidate-snapshots
candidate-old-instances
generation
(mounted-p t)
flushing-p
pending-p)
(defvar etaf--runtime-table (make-hash-table :test #'eq)
"Buffer -> mounted ETAF Runtime table.")
(defvar etaf--current-runtime nil
"Runtime owning the current setup, lifecycle, or event operation.")
(defun etaf-current-runtime ()
"Return the dynamically active Runtime, or nil outside a Runtime."
etaf--current-runtime)
(defun etaf-runtime-set-focus-ref (runtime host-ref)
"Set RUNTIME's focused Host reference to HOST-REF and return it."
(setf (etaf-runtime-focus-ref runtime) host-ref)
host-ref)
(defun etaf-runtime-for-buffer (buffer-or-name)
"Return the live Runtime mounted in BUFFER-OR-NAME, or nil."
(let ((buffer (get-buffer buffer-or-name)))
(and buffer (gethash buffer etaf--runtime-table))))
(defun etaf-runtime-require-mounted (&optional runtime)
"Return mounted RUNTIME or the Runtime in the current buffer.
Signal an ETAF runtime error before any downstream action or renderer lookup
when the requested boundary is no longer mounted."
(let ((runtime (or runtime etaf--current-runtime
(and (derived-mode-p 'special-mode)
(gethash (current-buffer) etaf--runtime-table)))))
(unless (and (etaf-runtime-p runtime)
(etaf-runtime-mounted-p runtime))
(signal 'etaf-runtime-error
(list "ETAF runtime is not mounted")))
runtime))
(defun etaf--runtime-watch-scheduler (runtime job _flush)
"Run watcher JOB while RUNTIME remains mounted."
(when (etaf-runtime-mounted-p runtime)
(funcall job)))
(defun etaf--runtime-event-kind (property)
"Return event symbol represented by callback PROPERTY."
(intern (substring (symbol-name property) 4)))
(defun etaf--runtime-register-host (runtime props path)
"Register callback PROPS for the opaque Host reference in RUNTIME at PATH."
(let ((host-ref (etaf--generated-host-ref props path))
handlers)
(puthash host-ref props (etaf-runtime-candidate-host-props runtime))
(while props
(let ((key (pop props))
(value (pop props)))
(when (and (keywordp key)
(string-prefix-p ":on-" (symbol-name key))
(functionp value))
(push (cons (etaf--runtime-event-kind key) value) handlers))))
(when handlers
(puthash host-ref handlers (etaf-runtime-candidate-handlers runtime)))))
(defun etaf--runtime-behavior-specs (value)
"Normalize `:use' VALUE to a list of Behavior specs."
(setq value (etaf--resolve-property-value value))
(cond
((null value) nil)
((etaf-behavior-spec-p value) (list value))
((proper-list-p value)
(unless (cl-every #'etaf-behavior-spec-p value)
(signal 'etaf-behavior-error
(list "Each :use entry must be a Behavior spec")))
value)
(t
(signal 'etaf-behavior-error
(list ":use must evaluate to a Behavior spec or list")))))
(defun etaf--runtime-install-behavior (runtime spec path props)
"Install Behavior SPEC for RUNTIME at PATH and return its state."
(let ((install (etaf-behavior-spec-install spec))
cleanup)
(when install
(let ((etaf--current-behavior-context
(etaf--behavior-context-create
:runtime runtime :path path :host-props props)))
(setq cleanup (funcall install))))
(unless (or (null cleanup) (functionp cleanup))
(signal 'etaf-behavior-error
(list (format "Behavior %S installer must return cleanup"
(etaf-behavior-spec-name spec)))))
(cons spec cleanup)))
(defun etaf--runtime-behavior-node (runtime node path)
"Install or update NODE's `:use' Behaviors in RUNTIME and return it merged."
(let* ((props (etaf--resolve-property-plist
(etaf--view-node-props node)))
(specs (etaf--runtime-behavior-specs (plist-get props :use)))
(merged (copy-sequence props)))
(dolist (spec specs)
(let* ((identity (list path (etaf-behavior-spec-name spec)))
(old (gethash identity (etaf-runtime-behaviors runtime)))
(state (if (and old
(equal (etaf-behavior-spec-attributes
(car old))
(etaf-behavior-spec-attributes spec)))
old
(etaf--runtime-install-behavior runtime spec path props))))
(puthash identity state (etaf-runtime-candidate-behaviors runtime))
(let ((attributes (etaf-behavior-spec-attributes (car state))))
(while attributes
(let ((key (pop attributes))
(value (pop attributes)))
(unless (plist-member merged key)
(setq merged (append merged (list key value)))))))))
(etaf--view-node-create
:name (etaf--view-node-name node)
:props merged
:children (etaf--view-node-children node))))
(defun etaf--runtime-promote-behaviors (runtime)
"Publish candidate Behavior state for RUNTIME and dispose old state."
(maphash
(lambda (identity old)
(let ((candidate (gethash identity
(etaf-runtime-candidate-behaviors runtime))))
(unless (and candidate (eq candidate old))
(when-let ((cleanup (cdr old)))
(funcall cleanup)))))
(etaf-runtime-behaviors runtime))
(setf (etaf-runtime-behaviors runtime)
(etaf-runtime-candidate-behaviors runtime)
(etaf-runtime-candidate-behaviors runtime) nil))
(defun etaf--runtime-rollback-behaviors (runtime)
"Dispose Behavior installers created by a failed RUNTIME candidate."
(when-let ((candidate (etaf-runtime-candidate-behaviors runtime)))
(maphash
(lambda (identity state)
(unless (eq state (gethash identity (etaf-runtime-behaviors runtime)))
(when-let ((cleanup (cdr state)))
(funcall cleanup))))
candidate)))
(defun etaf--runtime-call-key (call path)
"Return retained identity for CALL at PATH, honoring an optional `:key'."
(let* ((props (etaf--resolve-property-plist
(etaf--component-call-props call)))
(key (plist-get props :key)))
(when key
(etaf--validate-key key))
(if key
(append (butlast path) (list :key key))
path)))
(defun etaf--runtime-snapshot-instance (runtime identity instance)
"Record INSTANCE's pre-candidate fields once for RUNTIME and IDENTITY."
(unless (assoc identity (etaf-runtime-candidate-snapshots runtime))
(push (list identity instance
(etaf--component-instance-props instance)
(etaf--component-instance-slots instance)
(etaf--component-instance-render-function instance))
(etaf-runtime-candidate-snapshots runtime))))
(defun etaf--runtime-new-instance (runtime spec identity props slots)
"Create and register IDENTITY's Component instance for RUNTIME from SPEC."
(let ((instance
(etaf--component-instance-create
:spec spec
:identity identity
:scope (etaf-effect-scope :name identity)
:context (etaf--context-create :parent etaf--current-context)
:props props
:slots slots)))
(push instance (etaf-runtime-candidate-created runtime))
(puthash identity instance (etaf-runtime-instances runtime))
instance))
(defun etaf--runtime-instance-for-call (runtime call path)
"Return retained Component instance for CALL at PATH in RUNTIME."
(let* ((spec (etaf--component-call-spec call))
(identity (list (etaf--component-spec-name spec)
(etaf--runtime-call-key call path)))
(props (etaf--resolve-property-plist
(etaf--component-call-props call)))
(slots (etaf--component-call-slots call))
(old (gethash identity (etaf-runtime-instances runtime)))
(instance (cond
((and old (eq (etaf--component-instance-spec old) spec))
(etaf--runtime-snapshot-instance runtime identity old)
old)
(old
(push (list identity old)
(etaf-runtime-candidate-old-instances runtime))
(etaf--runtime-new-instance runtime spec identity props slots))
(t
(etaf--runtime-new-instance runtime spec identity props slots)))))
(setf (etaf--component-instance-props instance) props
(etaf--component-instance-slots instance) slots)
(puthash identity t (etaf-runtime-seen runtime))
instance))
(defun etaf--run-hooks (hooks)
"Run HOOKS in registration order."
(dolist (hook (reverse hooks))
(funcall hook)))
(defun etaf--runtime-render-component (runtime call path)
"Render CALL through retained RUNTIME at PATH to one Ebox node."
(let* ((instance (etaf--runtime-instance-for-call runtime call path))
(spec (etaf--component-instance-spec instance))
(props (etaf--component-instance-props instance))
(slots (etaf--component-instance-slots instance))
(setup (etaf--component-spec-setup spec)))
(let ((etaf--current-runtime runtime)
(etaf--current-component-instance instance)
(etaf--current-component-props props)
(etaf--current-component-slots slots)
(etaf--current-context
(etaf--component-instance-context instance))
(etaf--render-runtime runtime)
(etaf--render-style-stack
(cons
(cons (etaf--component-spec-styles spec)
(append path (list :view)))
etaf--render-style-stack)))
(when (and setup
(null (etaf--component-instance-render-function instance)))
(let ((render-function
(etaf-scope-run
(etaf--component-instance-scope instance)
(lambda () (funcall setup props slots))
:watch-scheduler
(lambda (job phase)
(etaf--runtime-watch-scheduler runtime job phase)))))
(unless (functionp render-function)
(signal 'etaf-runtime-error
(list (format
"Component %S :setup must return a render function"
(etaf--component-spec-name spec)))))
(setf (etaf--component-instance-render-function instance)
render-function)))
(let* ((render-function
(or (etaf--component-instance-render-function instance)
(etaf--component-spec-render spec)))
(rendered (if setup
(funcall render-function)
(funcall render-function props slots)))
(nodes (etaf--render-value-list
rendered
(append path (list :view)))))
(cond
((null nodes) (ebox-spacer))
((null (cdr nodes)) (car nodes))
(t (apply #'ebox-column nodes)))))))
(defun etaf--runtime-style-node (node path)
"Apply active Component style scopes to NODE at structural PATH."
(let ((result node))
(dolist (scope etaf--render-style-stack result)
(let ((styles (car scope))
(root-path (cdr scope)))
(when (and styles (equal path root-path))
(setq result (etaf--apply-inline-style-rules result styles t)))
(when (and styles (not (equal path root-path)))
(setq result (etaf--apply-inline-style-rules result styles nil)))))))
(defun etaf--runtime-dispose-instance (instance &optional run-hooks-p)
"Dispose INSTANCE, optionally running hooks when RUN-HOOKS-P is non-nil."
(when (etaf--component-instance-p instance)
(when (and run-hooks-p (etaf--component-instance-mounted-p instance))
(let ((etaf--render-phase-p nil))
(etaf--run-hooks (etaf--component-instance-unmounted-hooks instance))))
(setf (etaf--component-instance-mounted-p instance) nil)
(etaf-scope-stop (etaf--component-instance-scope instance))))
(defun etaf--runtime-dispose-created-candidate (runtime)
"Dispose RUNTIME's instances created by an uncommitted candidate."
(dolist (instance (etaf-runtime-candidate-created runtime))
(remhash (etaf--component-instance-identity instance)
(etaf-runtime-instances runtime))
(etaf--runtime-dispose-instance instance nil))
(dolist (entry (etaf-runtime-candidate-old-instances runtime))
(puthash (car entry) (cadr entry) (etaf-runtime-instances runtime)))
(dolist (snapshot (etaf-runtime-candidate-snapshots runtime))
(let ((instance (cadr snapshot)))
(setf (etaf--component-instance-props instance) (nth 2 snapshot)
(etaf--component-instance-slots instance) (nth 3 snapshot)
(etaf--component-instance-render-function instance)
(nth 4 snapshot))))
runtime)
(defun etaf--runtime-clear-candidate (runtime)
"Clear transient candidate bookkeeping in RUNTIME."
(setf (etaf-runtime-candidate-created runtime) nil
(etaf-runtime-candidate-snapshots runtime) nil
(etaf-runtime-candidate-old-instances runtime) nil
(etaf-runtime-seen runtime) nil
(etaf-runtime-candidate-handlers runtime) nil
(etaf-runtime-candidate-host-props runtime) nil
(etaf-runtime-candidate-behaviors runtime) nil))
(defun etaf--runtime-promote (runtime)
"Promote RUNTIME's successful candidate and return its lifecycle groups."
(let (removed added existing)
(maphash
(lambda (identity instance)
(if (gethash identity (etaf-runtime-seen runtime))
(if (etaf--component-instance-mounted-p instance)
(push instance existing)
(push instance added))
(push instance removed)))
(etaf-runtime-instances runtime))
;; Removed descendants are disposed before their parents.
(dolist (instance (sort removed
(lambda (left right)
(> (length (etaf--component-instance-identity left))
(length (etaf--component-instance-identity right))))))
(remhash (etaf--component-instance-identity instance)
(etaf-runtime-instances runtime))
(etaf--runtime-dispose-instance instance t))
(dolist (entry (etaf-runtime-candidate-old-instances runtime))
(etaf--runtime-dispose-instance (cadr entry) t))
(dolist (instance added)
(setf (etaf--component-instance-mounted-p instance) t))
(list
(sort added
(lambda (left right)
(< (length (etaf--component-instance-identity left))
(length (etaf--component-instance-identity right)))))
existing)))
(defun etaf--runtime-run-lifecycle (groups)
"Run mounted and updated lifecycle hooks in GROUPS after publication."
(dolist (instance (car groups))
(let ((etaf--render-phase-p nil))
(etaf--run-hooks (etaf--component-instance-mounted-hooks instance))))
(dolist (instance (cadr groups))
(let ((etaf--render-phase-p nil))
(etaf--run-hooks (etaf--component-instance-updated-hooks instance)))))
(defun etaf--runtime-begin-candidate (runtime)
"Reset candidate bookkeeping before a RUNTIME render."
(setf (etaf-runtime-seen runtime) (make-hash-table :test #'equal)
(etaf-runtime-candidate-created runtime) nil
(etaf-runtime-candidate-snapshots runtime) nil
(etaf-runtime-candidate-old-instances runtime) nil
(etaf-runtime-candidate-handlers runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-host-props runtime)
(make-hash-table :test #'equal)
(etaf-runtime-candidate-behaviors runtime)
(make-hash-table :test #'equal)))
(defun etaf--runtime-render-root (runtime)
"Evaluate and lower RUNTIME's root View."
(let ((root-view (etaf-runtime-root-view runtime)))
(etaf--render-value-list
(if (functionp root-view) (funcall root-view) root-view)
'(root))))
(defun etaf--runtime-render-effect (runtime)
"Build and publish one candidate for RUNTIME."
(etaf--runtime-begin-candidate runtime)
(let (next-root)
(condition-case err
(let* ((etaf--render-runtime runtime)
(nodes (etaf--runtime-render-root runtime)))
(setq next-root
(cond
((null nodes) (ebox-spacer))
((null (cdr nodes)) (car nodes))
(t (apply #'ebox-column nodes))))
(if (etaf-runtime-root-node runtime)
(ebox-commit (etaf-runtime-buffer runtime) next-root)
(ebox-render-to-buffer (etaf-runtime-buffer runtime) next-root))
(setf (etaf-runtime-root-node runtime) next-root
(etaf-runtime-handlers runtime)
(etaf-runtime-candidate-handlers runtime)
(etaf-runtime-host-props runtime)
(etaf-runtime-candidate-host-props runtime)
(etaf-runtime-generation runtime)
(1+ (etaf-runtime-generation runtime))))
((error quit)
(etaf--runtime-dispose-created-candidate runtime)
(etaf--runtime-rollback-behaviors runtime)
(etaf--runtime-clear-candidate runtime)
(signal (car err) (cdr err))))
;; Publication has completed. Lifecycle and cleanup callbacks run after
;; the retained state is promoted; their errors remain visible without
;; incorrectly rolling back an already published Ebox tree.
(unwind-protect
(let ((groups (etaf--runtime-promote runtime)))
(etaf--runtime-promote-behaviors runtime)
(etaf--runtime-run-lifecycle groups))
(etaf--runtime-rollback-behaviors runtime)
(etaf--runtime-clear-candidate runtime))
next-root))
(defun etaf--runtime-request-flush (runtime)
"Synchronously flush RUNTIME, or mark one follow-up flush while busy."
(when (etaf-runtime-mounted-p runtime)
(if (etaf-runtime-flushing-p runtime)
(setf (etaf-runtime-pending-p runtime) t)
(setf (etaf-runtime-flushing-p runtime) t)
(unwind-protect
(progn
(etaf--runtime-render-effect runtime)
(while (etaf-runtime-pending-p runtime)
(setf (etaf-runtime-pending-p runtime) nil)
(etaf--runtime-render-effect runtime)))
(setf (etaf-runtime-flushing-p runtime) nil)))))
;;;###autoload
(defun etaf-runtime-flush (&optional runtime)
"Flush mounted RUNTIME immediately and return its root Ebox node."
(let ((runtime (etaf-runtime-require-mounted runtime)))
(etaf--runtime-request-flush runtime)
(etaf-runtime-root-node runtime)))
;;;###autoload
(defun etaf-runtime-mount (buffer-or-name view)
"Mount VIEW into BUFFER-OR-NAME and return the live buffer."
(let* ((buffer (get-buffer-create buffer-or-name))
(old (gethash buffer etaf--runtime-table)))
(when old
(etaf-runtime-unmount old))
(let* ((scope (etaf-effect-scope :detached t :name buffer))
(runtime (etaf--runtime-create
:buffer buffer
:root-view view
:scope scope
:instances (make-hash-table :test #'equal)
:handlers (make-hash-table :test #'equal)
:host-props (make-hash-table :test #'equal)
:behaviors (make-hash-table :test #'equal)
:generation 0)))
(puthash buffer runtime etaf--runtime-table)
(setf (etaf-runtime-render-effect runtime)
(etaf-scope-run
scope
(lambda ()
(etaf-reactive-effect-create
(lambda ()
(let ((etaf--current-runtime runtime))
(etaf--runtime-render-effect runtime)))
:name 'render
:scheduler
(lambda (_effect)
(etaf--runtime-request-flush runtime))))))
(condition-case err
(etaf-reactive-effect-run
(etaf-runtime-render-effect runtime) :rendering t)
((error quit)
(remhash buffer etaf--runtime-table)
(etaf-scope-stop scope)
(signal (car err) (cdr err))))
buffer)))
;;;###autoload
(defun etaf-runtime-unmount (&optional runtime)
"Unmount RUNTIME and dispose its Component scopes."
(let ((runtime (etaf-runtime-require-mounted runtime)))
(setf (etaf-runtime-mounted-p runtime) nil)
(remhash (etaf-runtime-buffer runtime) etaf--runtime-table)
(let (instances)
(maphash (lambda (_identity instance) (push instance instances))
(etaf-runtime-instances runtime))
(dolist (instance (sort instances
(lambda (left right)
(> (length (etaf--component-instance-identity left))
(length (etaf--component-instance-identity right))))))
(etaf--runtime-dispose-instance instance t)))
(etaf-scope-stop (etaf-runtime-scope runtime))
(maphash
(lambda (_identity state)
(when-let ((cleanup (cdr state)))
(funcall cleanup)))
(etaf-runtime-behaviors runtime))
(clrhash (etaf-runtime-instances runtime))
runtime))
;;;###autoload
(defun etaf-unmount (&optional runtime)
"Unmount RUNTIME, defaulting to the active or `current-buffer' Runtime."
(etaf-runtime-unmount runtime))
;;;###autoload
(defun etaf-on-mounted (callback)
"Run CALLBACK after the current Component is first published."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless etaf--current-component-instance
(error "ETAF-on-mounted requires Component setup"))
(push callback
(etaf--component-instance-mounted-hooks
etaf--current-component-instance))
callback)
;;;###autoload
(defun etaf-on-updated (callback)
"Run CALLBACK after the current Component participates in an update."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless etaf--current-component-instance
(error "ETAF-on-updated requires Component setup"))
(push callback
(etaf--component-instance-updated-hooks
etaf--current-component-instance))
callback)
;;;###autoload
(defun etaf-on-unmounted (callback)
"Run CALLBACK when the current Component is disposed."
(unless (functionp callback)
(signal 'wrong-type-argument (list 'functionp callback)))
(unless etaf--current-component-instance
(error "ETAF-on-unmounted requires Component setup"))
(push callback
(etaf--component-instance-unmounted-hooks
etaf--current-component-instance))
callback)
(provide 'etaf-runtime)
;;; etaf-runtime.el ends here

190
etaf-ui.el Normal file
View File

@ -0,0 +1,190 @@
;;; etaf-ui.el --- Official ETAF Components -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Commentary:
;; This file is the official Component catalog. It deliberately exposes
;; Components, not Control/Widget/DataGrid runtime categories: a DataGrid is
;; a normal compound Component built from the same View, props, events, and
;; reactive Data contracts as every other catalog entry.
;;; Code:
(require 'cl-lib)
(require 'etaf)
(declare-function etaf-data-status "etaf-data" (controller))
(declare-function etaf-data-items "etaf-data" (controller))
(declare-function text "etaf-view" (&rest arguments))
(declare-function row "etaf-view" (&rest arguments))
(declare-function column "etaf-view" (&rest arguments))
(declare-function expr "etaf-view" (&rest arguments))
(declare-function slot "etaf-view" (&rest arguments))
(defun etaf-ui--column-value (column key)
"Return KEY from COLUMN, accepting a plist or alist descriptor."
(if (and (listp column) (keywordp (car column)))
(plist-get column key)
(alist-get key column)))
(defun etaf-ui--grid-cell-value (row key)
"Return KEY from data ROW, accepting a plist, alist, or hash table."
(cond
((hash-table-p row) (gethash key row))
((and (proper-list-p row)
(zerop (% (length row) 2))
(keywordp (car row)))
(plist-get row key))
((listp row) (alist-get key row))
(t nil)))
(defun etaf-ui--grid-header-cell (column)
"Return one header View for COLUMN."
(etaf-view
(text
:face 'bold
:width (etaf-ui--column-value column :width)
(expr :value (format "%s"
(or (etaf-ui--column-value column :label)
(etaf-ui--column-value column :key)))))))
(defun etaf-ui--grid-header (columns)
"Return a View header row for COLUMNS."
(etaf-view
(row
:class "etaf-data-grid-header"
(expr :value (mapcar #'etaf-ui--grid-header-cell columns)))))
(defun etaf-ui--grid-cell (row column)
"Return one data cell View for ROW and COLUMN."
(let ((key (etaf-ui--column-value column :key)))
(etaf-view
(text
:width (etaf-ui--column-value column :width)
(expr :value
(format "%s" (or (etaf-ui--grid-cell-value row key) "")))))))
(defun etaf-ui--grid-cells (row columns)
"Return data cell Views for ROW and COLUMNS."
(mapcar (lambda (column) (etaf-ui--grid-cell row column)) columns))
(defun etaf-ui--grid-row (row columns row-key on-row-press)
"Return a View row for ROW, COLUMNS, ROW-KEY, and ON-ROW-PRESS."
(let ((key (funcall row-key row)))
(unless key
(error "ETAF DataGrid row-key must return a non-nil stable scalar"))
(etaf-view
(row
:key key
:class "etaf-data-grid-row"
:on-press (when on-row-press
(lambda () (funcall on-row-press row)))
(expr :value (etaf-ui--grid-cells row columns))))))
;;;###autoload
(etaf-define-component etaf-button (&key label on-press disabled ref)
"Render a standard pressable button with LABEL and ON-PRESS.
DISABLED removes the callback and the default focus tab index. The Component
has no `variant' or Control type; callers use ordinary props and `:styles'
when they need a product-specific appearance."
:styles
(styles
("&" :padding (0 1) :border ((1) solid "#687386"))
("&.disabled" :color "#8A93A6")
("&.enabled" :face bold))
:view
(text
:class (if disabled "etaf-button disabled" "etaf-button enabled")
:role 'button
:ref ref
:disabled disabled
:tab-index (unless disabled 0)
:on-press (unless disabled on-press)
(expr :value label)))
;;;###autoload
(etaf-define-component etaf-checkbox (&key checked label on-change ref)
"Render a controlled checkbox with CHECKED, LABEL, and ON-CHANGE.
ON-CHANGE receives the next boolean value. State ownership remains with the
caller, so the Component is reusable in both local and Data-backed forms."
:view
(row
:class "etaf-checkbox"
:role 'checkbox
:ref ref
:aria-label label
:on-press (lambda ()
(when on-change
(funcall on-change (not checked))))
(text :face 'bold (expr :value (if checked "☑" "☐")))
(text (expr :value (if label (concat " " label) "")))))
;;;###autoload
(etaf-define-component etaf-label (&key text face)
"Render TEXT as a semantic text label with optional FACE."
:view
(text :face face (expr :value text)))
;;;###autoload
(etaf-define-component etaf-panel (&key title)
"Render a titled panel with header and default slot projections."
:styles
(styles
("&" :padding (1 2) :border ((1) solid "#687386"))
(".etaf-panel-title" :face bold))
:view
(column
:class "etaf-panel"
(expr
:value
(when title
(etaf-view (text :class "etaf-panel-title"
(expr :value title)))))
(slot :name 'header)
(slot)))
;;;###autoload
(etaf-define-component etaf-data-grid
(&key controller columns row-key on-row-press
loading-label error-label empty-label)
"Render rows from reactive DATA CONTROLLER and COLUMNS.
COLUMNS is a list of descriptors such as `(:key :name :label NAME)'.
ROW-KEY is a function receiving each row and must return a non-nil stable
scalar key.
The Data Controller owns loading, errors, pagination, mutation, and selection;
this Component only projects that state into ordinary Hosts."
:view
(column
:class "etaf-data-grid"
(expr :value (etaf-ui--grid-header columns))
(expr
:value
(progn
(unless (functionp row-key)
(error "ETAF DataGrid requires a function-valued :row-key"))
(let ((status (etaf-value (etaf-data-status controller)))
(items (etaf-value (etaf-data-items controller))))
(cond
((eq status 'loading)
(etaf-view (text (expr :value (or loading-label "Loading...")))))
((eq status 'error)
(etaf-view (text :color "#FF6B6B"
(expr :value
(or error-label "Unable to load data.")))))
((null items)
(etaf-view (text (expr :value (or empty-label "No data.")))))
(t
(mapcar
(lambda (item)
(etaf-ui--grid-row item columns row-key
on-row-press))
items))))))
(slot :name 'footer)))
(provide 'etaf-ui)
;;; etaf-ui.el ends here

233
etaf-view.el
View File

@ -33,18 +33,38 @@
(cl-defstruct (etaf--component-spec
(:constructor etaf--component-spec-create))
"Internal definition of one stateless Component."
"Internal definition of one ETAF Component."
name
props
render)
render
setup
styles)
(cl-defstruct (etaf--component-call
(:constructor etaf--component-call-create))
"Internal Component invocation retained until rendering."
spec
props
slots)
(cl-defstruct (etaf--slot-input
(:constructor etaf--slot-input-create))
"Call-site contribution to a named Component slot."
name
children)
(cl-defstruct (etaf--slot-projection
(:constructor etaf--slot-projection-create))
"A Component View request for one slot and its fallback children."
name
fallback)
(cl-defstruct (etaf--raw-ebox
(:constructor etaf--raw-ebox-create))
"Explicit escape carrying an already-built public Ebox node."
thunk
key-thunk)
(defconst etaf--host-names
'(text fragment container row column stack flex spacer)
"Minimal unstyled Hosts implemented by ETAF core.
@ -69,6 +89,15 @@ this list merely to make a demo convenient.")
(defvar etaf--view-registry (make-hash-table :test #'eq)
"Registry of Hosts and Components used by structural View calls.")
(defvar etaf--current-component-props nil
"Dynamic props of the Component currently being evaluated.")
(defvar etaf--current-component-slots nil
"Dynamic slots of the Component currently being evaluated.")
(defvar etaf--current-component-instance nil
"Dynamic Component instance currently being evaluated.")
(defun etaf--syntax-error (format-string &rest arguments)
"Signal a View syntax error formatted from FORMAT-STRING and ARGUMENTS."
(signal 'etaf-view-syntax-error
@ -107,7 +136,11 @@ form, or core Host. A collision receives a semantic `-view' alias."
(let ((existing (gethash name etaf--view-registry)))
(when (eq existing etaf--host-marker)
(etaf--component-error
"Component %S conflicts with a core Host" name)))
"Component %S conflicts with a core Host" name))
(when (and existing (not (eq existing etaf--host-marker))
(not (eq existing spec)))
(etaf--component-error
"Component %S is already registered" name)))
(puthash name spec etaf--view-registry)
(when-let ((alias (etaf--component-alias name)))
(let ((existing (gethash alias etaf--view-registry)))
@ -157,6 +190,41 @@ form, or core Host. A collision receives a semantic `-view' alias."
(setq copy (append copy (list key value)))))
copy))
(defun etaf--resolve-property-value (value)
"Resolve one lazily compiled property VALUE."
(if (etaf--expr-p value)
(etaf--resolve-property-value (funcall (etaf--expr-thunk value)))
value))
(defun etaf--resolve-property-plist (props)
"Resolve all lazy values in PROPS while preserving its keys."
(let ((copy nil)
(tail props))
(while tail
(setq copy (append copy
(list (pop tail)
(etaf--resolve-property-value (pop tail))))))
copy))
(defun etaf--compile-property-value (form)
"Compile property FORM as a constant or a render-time thunk."
(if (or (null form) (numberp form) (stringp form) (characterp form)
(keywordp form) (eq form t)
(and (consp form) (memq (car form) '(quote function))))
form
`(etaf--expr-create :thunk (lambda () ,form))))
(defun etaf--compile-property-plist (props)
"Compile alternating property FORMS in PROPS into a generated property list."
(let (compiled)
(while props
(let ((key (pop props))
(value (pop props)))
(setq compiled
(append compiled
(list key (etaf--compile-property-value value))))))
compiled))
(defun etaf--validate-key (key)
"Validate a Host identity KEY and return it."
(unless (or (null key) (symbolp key) (stringp key)
@ -199,14 +267,59 @@ the generated code."
`expr' intentionally has one property, `:value', and no children."
(let ((parts (etaf--parse-attributes-and-children items)))
(when (cdr parts)
(etaf--syntax-error "expr accepts :value and no children"))
(etaf--syntax-error "Expr accepts :value and no children"))
(let ((props (car parts)))
(unless (and (= (length props) 2)
(eq (car props) :value))
(etaf--syntax-error
"expr accepts exactly one attribute: :value"))
"Expr accepts exactly one attribute: :value"))
(cadr props))))
(defun etaf--constant-slot-name (form)
"Return the static slot symbol represented by FORM, or signal an error."
(unless (and (consp form)
(eq (car form) 'quote)
(null (cddr form)))
(etaf--syntax-error
"Slot names must be quoted stable symbols: %S" form))
(let ((name (cadr form)))
(unless (and (symbolp name) (not (keywordp name))
(not (memq name '(nil t))))
(etaf--syntax-error
"Slot names must be stable non-keyword symbols: %S" form))
name))
(defun etaf--compile-slot-form (items slot-mode)
"Compile a slot form with ITEMS according to SLOT-MODE.
SLOT-MODE is `:projection' while compiling a Component's own View and
`:input' while compiling the children supplied to a Component call. An
input slot must have an explicit `:name'; ordinary trailing children already
belong to the anonymous `default' slot."
(let* ((parts (etaf--parse-attributes-and-children items))
(props (car parts))
(children (cdr parts))
(name-supplied-p (plist-member props :name))
(name (if name-supplied-p
(etaf--constant-slot-name (plist-get props :name))
'default)))
(unless (or (null props)
(and (= (length props) 2) (eq (car props) :name)))
(etaf--syntax-error "Slot accepts only the optional :name attribute"))
(when (and (eq slot-mode :input) (not name-supplied-p))
(etaf--syntax-error
"A named slot input requires :name; ordinary children fill default"))
(let ((compiled (mapcar (lambda (child)
(etaf--compile-child-form child slot-mode))
children)))
(if (eq slot-mode :projection)
`(etaf--slot-projection-create
:name ',name
:fallback (list ,@compiled))
`(etaf--slot-input-create
:name ',name
:children (list ,@compiled))))))
(defun etaf--ordinary-expression-head-p (head)
"Return non-nil when HEAD denotes ordinary Elisp computation."
(or (memq head etaf--ordinary-elisp-heads)
@ -218,18 +331,24 @@ the generated code."
`(etaf--expr-create
:thunk (lambda () ,(etaf--parse-expr-form items))))
(defun etaf--compile-child-form (form)
"Compile structural child FORM into code returning a View value."
(defun etaf--compile-child-form (form &optional slot-mode)
"Compile structural child FORM into code returning a View value.
SLOT-MODE distinguishes Component-owned projections from call-site inputs."
(cond
((null form) nil)
((stringp form) `(quote ,form))
((and (consp form) (eq (car form) 'expr))
(etaf--compile-expr-form (cdr form)))
((and (consp form) (eq (car form) 'slot))
(etaf--compile-slot-form (cdr form) slot-mode))
((and (consp form) (eq (car form) 'raw-ebox))
(etaf--compile-view-form form slot-mode))
((and (consp form) (symbolp (car form)))
(when (etaf--ordinary-expression-head-p (car form))
(etaf--syntax-error
"Elisp expression %S must be inside (expr :value ...)" (car form)))
(etaf--compile-view-form form))
(etaf--compile-view-form form slot-mode))
((consp form)
(etaf--syntax-error "Invalid View child form: %S" form))
(t
@ -237,8 +356,10 @@ the generated code."
"View children must be strings, nil, View forms, or expr results: %S"
form))))
(defun etaf--compile-view-form (form)
"Compile one structural View FORM into runtime construction code."
(defun etaf--compile-view-form (form &optional slot-mode)
"Compile one structural View FORM into runtime construction code.
SLOT-MODE distinguishes Component-owned projections from call-site inputs."
(cond
((null form) nil)
((stringp form) `(quote ,form))
@ -247,18 +368,39 @@ the generated code."
((eq (car form) 'expr)
(etaf--compile-expr-form (cdr form)))
((eq (car form) 'slot)
(etaf--syntax-error
"slot is not implemented in the P0 package; use ordinary children for now"))
;; A render closure returned from `:setup' invokes `etaf-view' later than
;; the Component definition macro, so the public macro defaults to
;; projection mode. An unowned projection simply uses its fallback.
(etaf--compile-slot-form (cdr form) slot-mode))
((eq (car form) 'raw-ebox)
(etaf--syntax-error
"raw-ebox is not implemented in the P0 package"))
(let ((parts (etaf--parse-attributes-and-children (cdr form))))
(when (cdr parts)
(etaf--syntax-error "Raw-ebox accepts :value, optional :key, and no children"))
(let ((props (car parts)))
(unless (and (plist-member props :value)
(cl-every #'keywordp (cl-loop for (key _value) on props by #'cddr collect key)))
(etaf--syntax-error "Raw-ebox requires :value"))
(let ((allowed '(:value :key)))
(dolist (key (cl-loop for (key _value) on props by #'cddr collect key))
(unless (memq key allowed)
(etaf--syntax-error "Raw-ebox does not accept %S" key)))
`(etaf--raw-ebox-create
:thunk (lambda () ,(plist-get props :value))
:key-thunk ,(when (plist-member props :key)
`(lambda () ,(plist-get props :key))))))))
(t
(let* ((parts (etaf--parse-attributes-and-children (cdr form)))
(props (car parts))
(children (cdr parts)))
(children (cdr parts))
(host-view-p (eq (gethash (car form) etaf--view-registry)
etaf--host-marker))
(child-slot-mode (if host-view-p slot-mode :input)))
`(etaf--view-call ',(car form)
(list ,@props)
(list ,@(mapcar #'etaf--compile-child-form children)))))))
(list ,@(etaf--compile-property-plist props))
(list ,@(mapcar (lambda (child)
(etaf--compile-child-form
child child-slot-mode))
children)))))))
;;;###autoload
(defmacro etaf-view (form)
@ -272,7 +414,7 @@ Properties must come first and children must come last. Property values are
ordinary Elisp expressions. `expr' is the only computation bridge in the
child region and accepts only `:value'."
(declare (indent 1) (debug (form)))
(etaf--compile-view-form form))
(etaf--compile-view-form form :projection))
(defun etaf--component-prop-key (name)
"Return the keyword used to pass Component prop NAME."
@ -282,8 +424,9 @@ child region and accepts only `:value'."
(defun etaf--validate-component-props (spec props)
"Validate Component SPEC against evaluated property PLIST PROPS."
(let ((allowed (mapcar #'etaf--component-prop-key
(etaf--component-spec-props spec)))
(let ((allowed (append '(:key)
(mapcar #'etaf--component-prop-key
(etaf--component-spec-props spec))))
(tail (etaf--validate-property-plist props)))
(while tail
(let ((key (pop tail)))
@ -303,47 +446,39 @@ child region and accepts only `:value'."
(cond
((eq entry etaf--host-marker)
(when (plist-member props :key)
(etaf--validate-key (plist-get props :key)))
(etaf--validate-key
(etaf--resolve-property-value (plist-get props :key))))
(etaf--view-node-create
:name (etaf--canonical-host-name name)
:props props
:children children))
((etaf--component-spec-p entry)
(etaf--validate-component-props entry props)
(let (default-children named-slots)
(dolist (child children)
(if (etaf--slot-input-p child)
(progn
(when (assq (etaf--slot-input-name child) named-slots)
(etaf--component-error
"Duplicate Component slot %S" (etaf--slot-input-name child)))
(push (cons (etaf--slot-input-name child)
(etaf--slot-input-children child))
named-slots))
(push child default-children)))
(setq default-children (nreverse default-children)
named-slots (nreverse named-slots))
(when (and default-children (assq 'default named-slots))
(etaf--component-error
"Component default slot has both children and an explicit input"))
(etaf--component-call-create
:spec entry
:props props
:children children))
:slots (if default-children
(cons (cons 'default default-children) named-slots)
named-slots))))
(t
(etaf--component-error "Unknown ETAF Host or Component: %S" name)))))
(defun etaf--resolve-value (value)
"Resolve VALUE to a flat list of string or View leaves.
This is deliberately a value normalizer, not an evaluator. Only `expr'
thunks are executed; a quoted list returned by an expression is treated as a
sequence and each member must already be a valid View value."
(cond
((null value) nil)
((or (stringp value)
(etaf--view-node-p value))
(list value))
((etaf--expr-p value)
(etaf--resolve-value (funcall (etaf--expr-thunk value))))
((etaf--component-call-p value)
(etaf--resolve-value
(funcall (etaf--component-spec-render
(etaf--component-call-spec value))
(etaf--component-call-props value)
(etaf--component-call-children value))))
((proper-list-p value)
(cl-mapcan #'etaf--resolve-value value))
(t
(signal 'etaf-view-error
(list (format
"View values must be strings, nil, Views, or sequences: %S"
value))))))
(provide 'etaf-view)
;;; etaf-view.el ends here

26
etaf.el
View File

@ -10,15 +10,35 @@
;;; Commentary:
;; ETAF is a Component and View layer above the independent Ebox renderer.
;; This package is intentionally starting with the grammar and stateless View
;; path before adding retained state, events, styles, and data capabilities.
;; ETAF is a small Component and View layer above the independent Ebox
;; renderer. Runtime, reactive Scope, and the structural grammar are loaded
;; through this one public package entry.
;;; Code:
(defconst etaf--directory
(file-name-directory (or load-file-name buffer-file-name))
"Directory containing the ETAF implementation files.")
(defun etaf--prefer-local-files ()
"Keep this package's implementation directory first on `load-path'."
(setq load-path (cons etaf--directory
(delete etaf--directory load-path))))
(etaf--prefer-local-files)
(require 'etaf-view)
(require 'etaf-component)
(require 'etaf-reactive)
(require 'etaf-context)
(require 'etaf-resource)
(require 'etaf-data)
(require 'etaf-renderer)
(etaf--prefer-local-files)
(require 'etaf-runtime)
(require 'etaf-behavior)
(require 'etaf-actions)
(require 'etaf-events)
(provide 'etaf)

180
tests/etaf-data-tests.el Normal file
View File

@ -0,0 +1,180 @@
;;; etaf-data-tests.el --- ETAF Data tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'etaf-data)
(defconst etaf-data-test-records
'((:id 1 :name "Ada" :group "compiler")
(:id 2 :name "Grace" :group "systems")
(:id 3 :name "Alan" :group "compiler")
(:id 4 :name "Barbara" :group "compiler"))
"Records shared by ETAF Data tests.")
(defun etaf-data-test--ids (controller)
"Return loaded item ids from CONTROLLER."
(mapcar (lambda (record) (plist-get record :id))
(etaf-value (etaf-data-items controller))))
(ert-deftest etaf-data-controller-loads-query-and-status ()
"Load memory source records through the public controller API."
(let* ((source (etaf-data-memory-source etaf-data-test-records
:id-key :id))
(controller (etaf-data-controller source
:query '(:group "compiler")
:page-size 2)))
(unwind-protect
(progn
(etaf-data-load controller)
(should (equal '(1 3) (etaf-data-test--ids controller)))
(should (= 3 (etaf-value (etaf-data-total controller))))
(should (eq 'success (etaf-value (etaf-data-status controller)))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-loading-state-is-visible-to-source-boundary ()
"Publish loading before invoking the source load capability."
(let (controller seen)
(let ((source (etaf-data-source
:load (lambda (_query _page _page-size)
(push (etaf-value (etaf-data-status controller))
seen)
(list :items '(a b) :total 2)))))
(setq controller (etaf-data-controller source))
(unwind-protect
(progn
(etaf-data-load controller)
(should (equal '(loading) seen))
(should (eq 'success (etaf-value
(etaf-data-status controller)))))
(etaf-data-stop controller)))))
(ert-deftest etaf-data-controller-reloads-for-pagination ()
"Reload when controller pagination refs change."
(let* ((source (etaf-data-memory-source etaf-data-test-records
:id-key :id))
(controller (etaf-data-controller source
:query '(:group "compiler")
:page-size 2
:auto-load t)))
(unwind-protect
(progn
(should (equal '(1 3) (etaf-data-test--ids controller)))
(should (= 2 (etaf-data-next-page controller)))
(should (equal '(4) (etaf-data-test--ids controller)))
(should (= 1 (etaf-data-previous-page controller)))
(should (equal '(1 3) (etaf-data-test--ids controller))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-source-page-normalization-does-not-reload-twice ()
"Avoid a second reload when source results normalize page refs."
(let* ((load-count 0)
(source (etaf-data-source
:load (lambda (_query _page page-size)
(cl-incf load-count)
(list :items '(only)
:total 1
:page 1
:page-size page-size))))
(controller (etaf-data-controller source :auto-load t)))
(unwind-protect
(progn
(should (= 1 load-count))
(etaf-data-set-page controller 99)
(should (= 2 load-count))
(should (= 1 (etaf-value (etaf-data-page controller)))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-memory-source-mutates-and-reloads ()
"Apply source mutations through the controller boundary."
(let* ((source (etaf-data-memory-source etaf-data-test-records
:id-key :id))
(controller (etaf-data-controller source
:page-size 10
:auto-load t)))
(unwind-protect
(progn
(etaf-data-mutate
controller 'insert '(:id 5 :name "Edsger" :group "systems"))
(should (equal '(1 2 3 4 5) (etaf-data-test--ids controller)))
(etaf-data-mutate
controller 'replace '(:id 2 :name "Grace Hopper" :group "navy"))
(should (equal "Grace Hopper"
(plist-get (cadr (etaf-value
(etaf-data-items controller)))
:name)))
(etaf-data-mutate controller 'delete 1)
(should (equal '(2 3 4 5) (etaf-data-test--ids controller))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-memory-source-supports-keyword-alist-records ()
"Query and mutate memory records represented as keyword alists."
(let* ((records '((( :id . 1) (:group . "compiler"))
((:id . 2) (:group . "systems"))))
(source (etaf-data-memory-source records :id-key :id))
(controller (etaf-data-controller source
:query '((:group . "compiler"))
:auto-load t)))
(unwind-protect
(progn
(should (= 1 (length (etaf-value (etaf-data-items controller)))))
(etaf-data-mutate
controller 'replace '((:id . 1) (:group . "language")))
(etaf-data-set-query controller '((:group . "language")))
(should (equal "language"
(alist-get :group
(car (etaf-value
(etaf-data-items controller)))))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-errors-are-observable-and-resignaled ()
"Store source load errors in controller state and re-signal them."
(let* ((source (etaf-data-source
:load (lambda (_query _page _page-size)
(error "boom"))))
(controller (etaf-data-controller source)))
(unwind-protect
(progn
(should-error (etaf-data-load controller) :type 'error)
(should (eq 'error (etaf-value (etaf-data-status controller))))
(should (eq 'error
(car (etaf-value (etaf-data-error controller))))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-selection-is-reactive-state ()
"Select, deselect, and clear identities through the controller API."
(let* ((source (etaf-data-memory-source etaf-data-test-records
:id-key :id))
(controller (etaf-data-controller source)))
(unwind-protect
(progn
(etaf-data-select controller 1)
(etaf-data-select controller 3)
(should (etaf-data-selected-p controller 1))
(should (etaf-data-selected-p controller 3))
(etaf-data-select controller 1 nil)
(should-not (etaf-data-selected-p controller 1))
(etaf-data-clear-selection controller)
(should-not (etaf-value (etaf-data-selection controller))))
(etaf-data-stop controller))))
(ert-deftest etaf-data-stop-disposes-source-and-controller ()
"Stop controller lifecycle resources and reject later operations."
(let* ((dispose-count 0)
(source (etaf-data-source
:load (lambda (_query _page _page-size)
(list :items nil :total 0))
:dispose (lambda ()
(cl-incf dispose-count))))
(controller (etaf-data-controller source :auto-load t)))
(should (eq 'success (etaf-value (etaf-data-status controller))))
(should-not (etaf-data-stop controller))
(should (= 1 dispose-count))
(should-error (etaf-data-load controller)
:type 'etaf-data-stopped-error)
(should-error (etaf-data-set-page controller 2)
:type 'etaf-data-stopped-error)))
;;; etaf-data-tests.el ends here

95
tests/etaf-docs-tests.el Normal file
View File

@ -0,0 +1,95 @@
;;; etaf-docs-tests.el --- ETAF documentation contract tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'cl-lib)
(defconst etaf-docs-test--root
(file-name-directory
(directory-file-name (file-name-directory (or load-file-name
buffer-file-name))))
"Absolute path of the ETAF repository under test.")
(defun etaf-docs-test--read (relative-file)
"Return the contents of RELATIVE-FILE in the repository."
(with-temp-buffer
(insert-file-contents (expand-file-name relative-file etaf-docs-test--root))
(buffer-string)))
(defun etaf-docs-test--elisp-blocks (contents)
"Return the fenced Elisp blocks found in documentation CONTENTS."
(let (blocks)
(with-temp-buffer
(insert contents)
(goto-char (point-min))
(while (re-search-forward "^```elisp[[:space:]]*$" nil t)
(let ((start (line-beginning-position 2)))
(unless (re-search-forward "^```[[:space:]]*$" nil t)
(error "Unclosed Elisp documentation block"))
(push (buffer-substring-no-properties start
(line-beginning-position))
blocks))))
(nreverse blocks)))
(defun etaf-docs-test--read-all (source)
"Read every form in Elisp documentation SOURCE and return its count."
(with-temp-buffer
(insert source)
(goto-char (point-min))
(let ((count 0))
(condition-case err
(while t
(read (current-buffer))
(cl-incf count))
(end-of-file count)
(error (error "Cannot read documentation form: %S" err))))))
(ert-deftest etaf-docs-have-paired-long-lived-files ()
"Keep the public architecture, guide, and plan in both languages."
(dolist (file '("README.md"
"README.zh-CN.md"
"docs/architecture.en.md"
"docs/architecture.zh.md"
"docs/user-guide.en.md"
"docs/user-guide.zh.md"
"docs/implementation-plan.en.md"
"docs/implementation-plan.zh.md"))
(should (file-exists-p (expand-file-name file etaf-docs-test--root)))))
(ert-deftest etaf-docs-user-surface-has-one-current-vocabulary ()
"Reject old public entry names and stale View examples in user docs."
(dolist (file '("README.md" "README.zh-CN.md"
"docs/architecture.en.md" "docs/architecture.zh.md"
"docs/user-guide.en.md" "docs/user-guide.zh.md"
"docs/implementation-plan.en.md"
"docs/implementation-plan.zh.md"))
(let ((contents (etaf-docs-test--read file)))
(should-not (string-match-p "etaf-template\|etaf-create-app" contents))
(should-not (string-match-p "(text \"[^\"]+\" :" contents))))
(let ((guide (etaf-docs-test--read "docs/user-guide.en.md")))
(dolist (token '("etaf-view" "etaf-mount" "etaf-define-component"
"etaf-data-grid" "etaf-resource"))
(should (string-match-p (regexp-quote token) guide)))))
(ert-deftest etaf-docs-elisp-examples-are-readable ()
"Keep fenced Elisp examples syntactically readable by Emacs."
(dolist (file '("README.md" "README.zh-CN.md"
"docs/architecture.en.md" "docs/architecture.zh.md"
"docs/user-guide.en.md" "docs/user-guide.zh.md"
"docs/implementation-plan.en.md"
"docs/implementation-plan.zh.md"))
(dolist (block (etaf-docs-test--elisp-blocks
(etaf-docs-test--read file)))
(should (> (etaf-docs-test--read-all block) 0)))))
(ert-deftest etaf-source-uses-only-public-ebox-names ()
"Keep the ETAF implementation independent of Ebox private functions."
(dolist (file (directory-files etaf-docs-test--root t "\\.el\\'"))
(with-temp-buffer
(insert-file-contents file)
(should-not (re-search-forward "ebox--" nil t)))))
;;; etaf-docs-tests.el ends here

45
tests/etaf-playground-tests.el Normal file
View File

@ -0,0 +1,45 @@
;;; etaf-playground-tests.el --- ETAF playground tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'etaf-playground)
(ert-deftest etaf-playground-mounts-and-dispatches-core-example ()
"Mount the public playground and update its retained counter."
(let ((buffer-name " *etaf-playground-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-playground-view))
(with-current-buffer buffer-name
(should (string-match-p "ETAF Playground" (buffer-string)))
(should (string-match-p "Count: 0" (buffer-string))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-dispatch-event runtime 'increment 'press)
(with-current-buffer buffer-name
(should (string-match-p "Count: 1" (buffer-string))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-playground-ui-keeps-the-catalog-optional ()
"Mount the optional UI catalog through the playground public entry point."
(require 'etaf-ui)
(let ((buffer-name " *etaf-playground-ui-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-playground-ui-view))
(with-current-buffer buffer-name
(let ((contents (buffer-string)))
(should (string-match-p "Official Components" contents))
(should (string-match-p "A public Component" contents))
(should (string-match-p "Controlled checkbox" contents)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
;;; etaf-playground-tests.el ends here

111
tests/etaf-resource-tests.el Normal file
View File

@ -0,0 +1,111 @@
;;; etaf-resource-tests.el --- ETAF Resource tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'etaf-resource)
(ert-deftest etaf-resource-loads-synchronous-value ()
"Expose successful loader output through the public Resource readers."
(let ((resource (etaf-resource (lambda () "ready") :name 'success-test)))
(unwind-protect
(progn
(should (eq 'success (etaf-resource-status resource)))
(should (equal "ready" (etaf-resource-value resource)))
(should-not (etaf-resource-error resource)))
(etaf-resource-dispose resource))))
(ert-deftest etaf-resource-captures-loader-error-state ()
"Capture synchronous loader failures without signaling them."
(let ((resource (etaf-resource (lambda () (error "boom"))
:name 'error-test)))
(unwind-protect
(progn
(should (eq 'error (etaf-resource-status resource)))
(should-not (etaf-resource-value resource))
(should (eq 'error (car (etaf-resource-error resource))))
(should (string-match-p "boom"
(cadr (etaf-resource-error resource)))))
(etaf-resource-dispose resource))))
(ert-deftest etaf-resource-reload-runs-cleanup-and-replaces-value ()
"Run loader cleanup on reload and disposal."
(let ((load-count 0)
(cleanup-count 0)
resource)
(setq resource
(etaf-resource
(lambda ()
(cl-incf load-count)
(etaf-resource-result
load-count
:cleanup (lambda () (cl-incf cleanup-count))))
:name 'reload-test))
(unwind-protect
(progn
(should (= 1 (etaf-resource-value resource)))
(should (= 0 cleanup-count))
(etaf-resource-load resource)
(should (= 2 (etaf-resource-value resource)))
(should (= 1 cleanup-count))
(should-not (etaf-resource-dispose resource))
(should (= 2 cleanup-count))
(should-error (etaf-resource-load resource)
:type 'etaf-resource-error))
(when resource
(etaf-resource-dispose resource)))))
(ert-deftest etaf-resource-parent-scope-disposes-resource-cleanup ()
"Attach Resource cleanup to the active parent Scope."
(let ((scope (etaf-effect-scope :detached t :name 'parent-test))
resource
cleanup-count)
(setq cleanup-count 0)
(setq resource
(etaf-scope-run
scope
(lambda ()
(etaf-resource
(lambda ()
(etaf-resource-result
"scoped"
:cleanup (lambda () (cl-incf cleanup-count))))
:name 'scoped-test))))
(should (equal "scoped" (etaf-resource-value resource)))
(should-not (etaf-scope-stop scope))
(should (= 1 cleanup-count))
(should-error (etaf-resource-load resource)
:type 'etaf-resource-error)))
(ert-deftest etaf-error-boundary-run-handles-body-error ()
"Convert an explicitly wrapped body error into a handler result."
(let ((seen nil))
(should
(equal "handled"
(etaf-error-boundary-run
(lambda () (error "render failed"))
(lambda (condition)
(setq seen condition)
"handled")
:name 'boundary-test)))
(should (eq 'error (car seen)))
(should (string-match-p "render failed" (cadr seen)))))
(ert-deftest etaf-error-boundary-run-preserves-unhandled-errors ()
"Do not swallow errors outside the wrapped body or inside the handler."
(should-error
(progn
(etaf-error-boundary-run
(lambda () "ok")
(lambda (_condition) "unused"))
(error "outside"))
:type 'error)
(should-error
(etaf-error-boundary-run
(lambda () (error "body"))
(lambda (_condition) (error "handler")))
:type 'error))
;;; etaf-resource-tests.el ends here

556
tests/etaf-tests.el
View File

@ -1,4 +1,4 @@
;;; etaf-tests.el --- ETAF P0 contract tests -*- lexical-binding: t; -*-
;;; etaf-tests.el --- ETAF contract tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
@ -7,9 +7,24 @@
(require 'ert)
(require 'etaf)
(defvar etaf-test-state-cell nil)
(defvar etaf-test-setup-count 0)
(defvar etaf-test-mounted-count 0)
(defvar etaf-test-unmounted-count 0)
(defvar etaf-test-theme-cell nil)
(defvar etaf-test-event-count 0)
(defvar etaf-test-behavior-cleanups 0)
(defvar etaf-test-behavior-runtime nil)
(defvar etaf-test-prop-cell nil)
(defvar etaf-test-updated-count 0)
(defvar etaf-test-lifecycle-failure-p nil)
(defun etaf-test--render-text (view)
"Return plain rendered text for VIEW."
(substring-no-properties (ebox-render (etaf-render view))))
(replace-regexp-in-string
"[[:space:]]+$" ""
(substring-no-properties (ebox-render (etaf-render view)))
nil t))
(etaf-define-component etaf-test-badge (&key label)
"Render LABEL as a small semantic test Component."
@ -21,6 +36,134 @@
:view
(text (expr :value label)))
(etaf-define-component etaf-test-slot-card (&key title)
"Render a title with default and named slot projections."
:view
(column
(text (expr :value title))
(slot :name 'header (text :face 'shadow "Default header"))
(slot (text :face 'shadow "Default body"))))
(etaf-define-component etaf-test-named-slot-consumer ()
"Render the named header slot for forwarding tests."
:view
(slot :name 'header))
(etaf-define-component etaf-test-named-slot-forwarder ()
"Forward a named slot through a nested Component call."
:view
(etaf-test-named-slot-consumer
(slot :name 'header (text "Forwarded"))))
(etaf-define-component etaf-test-styled-card ()
"Render style and Theme precedence fixtures."
:styles
(styles
("&" :color "style-root")
(".title" :color "style-title" :bgcolor "title-bg"))
:view
(column
(text :class "title" :color "inline-title" "Title")
(text "Body")))
(etaf-define-component etaf-test-styled-child ()
"Render a child Host for nested style scope tests."
:view
(text :class "nested-child" "Nested"))
(etaf-define-component etaf-test-styled-parent ()
"Apply a style rule through a nested Component boundary."
:styles
(styles
(".nested-child" :color "parent-color"))
:view
(etaf-test-styled-child))
(etaf-define-component etaf-test-themed-text ()
"Provide Theme defaults to one text Host."
:setup
(progn
(etaf-theme-provide '(:color "theme-color" :bgcolor "theme-bg"))
(lambda () (etaf-view (text "Themed")))))
(etaf-define-component etaf-test-stateful (&key label)
"Render a retained counter for Runtime tests."
:setup
(let ((cell (etaf-ref 0)))
(setq etaf-test-state-cell cell)
(cl-incf etaf-test-setup-count)
(etaf-on-mounted (lambda () (cl-incf etaf-test-mounted-count)))
(etaf-on-updated (lambda () (cl-incf etaf-test-updated-count)))
(etaf-on-unmounted (lambda () (cl-incf etaf-test-unmounted-count)))
(lambda ()
(etaf-view
(text
(expr :value (format "%s:%d" label (etaf-value cell))))))))
(etaf-define-component etaf-test-provider ()
"Provide a reactive theme to descendants."
:setup
(let ((theme (etaf-ref 'dark)))
(setq etaf-test-theme-cell theme)
(etaf-provide 'theme theme)
(lambda ()
(etaf-view (column (slot))))))
(etaf-define-component etaf-test-consumer ()
"Render the nearest Context theme."
:setup
(let ((theme (etaf-inject 'theme nil t)))
(lambda ()
(etaf-view (text (expr :value (symbol-name (etaf-value theme))))))))
(etaf-define-component etaf-test-prop-stateful (&key label)
"Render a retained label whose prop can change without rerunning setup."
:setup
(progn
(cl-incf etaf-test-setup-count)
(lambda ()
(etaf-view (text (expr :value label))))))
(etaf-define-component etaf-test-lifecycle-failure (&key label)
"Render LABEL and deliberately fail from an update lifecycle hook."
:setup
(progn
(etaf-on-updated
(lambda ()
(when etaf-test-lifecycle-failure-p
(error "test lifecycle failed"))))
(lambda ()
(etaf-view (text (expr :value label))))))
(etaf-define-component etaf-test-rollback (&key fail)
"Render a candidate that can deliberately fail during reconciliation."
:setup
(let ((cell (etaf-ref 0)))
(setq etaf-test-prop-cell cell)
(lambda ()
(when fail
(signal 'etaf-runtime-error (list "test candidate failed")))
(etaf-view
(text
(expr :value (format "stable:%d" (etaf-value cell))))))))
(etaf-define-behavior etaf-test-cleanup-behavior (&rest attributes)
"Construct a Behavior whose disposal is visible to tests."
(apply #'etaf-behavior-create
'etaf-test-cleanup-behavior
(append attributes
(list :install
(lambda ()
(setq etaf-test-behavior-runtime
(etaf-behavior-context-runtime
(etaf-current-behavior-context)))
(lambda () (cl-incf etaf-test-behavior-cleanups)))))))
(etaf-action-define etaf-test-action (runtime)
"Increment the event counter through a named Action."
(ignore runtime)
(cl-incf etaf-test-event-count))
(ert-deftest etaf-view-property-region-precedes-children ()
"Reject a property that appears after a structural child."
(should-error
@ -133,20 +276,415 @@
(etaf-view (etaf-test-badge :unknown t))
:type 'etaf-component-call-error))
(ert-deftest etaf-component-rejects-unimplemented-definition-forms ()
"Reject future clauses instead of assigning them accidental semantics."
(should-error
(ert-deftest etaf-component-definition-keywords-have-one-owner ()
"Accept the two definition modes and reject ambiguous combinations."
(should
(macroexpand
'(etaf-define-component future-component (&key value)
:setup value))
:type 'etaf-component-definition-error)
(should-error
'(etaf-define-component setup-component (&key value)
:setup (lambda () (etaf-view (text (expr :value value)))))))
(should
(macroexpand
'(etaf-define-component styled-component ()
:styles (styles ("&" :color "red"))
:view (text "x"))))
(should-error
(macroexpand
'(etaf-define-component ambiguous-component (&key value)
:setup value
:view (text "x")))
:type 'etaf-component-definition-error)
(should-error
(macroexpand
'(etaf-define-component invalid-component ()
:behavior value))
:type 'etaf-component-definition-error))
(ert-deftest etaf-component-slots-share-one-default-and-named-model ()
"Render default children and explicit named slot contributions."
(should
(equal "Card\nHeader\nBody"
(etaf-test--render-text
(etaf-view
(etaf-test-slot-card :title "Card"
(slot :name 'header (text "Header"))
(text "Body"))))))
(should
(equal "Card\nDefault header\nDefault body"
(etaf-test--render-text
(etaf-view (etaf-test-slot-card :title "Card")))))
(should
(equal "Card\nDefault body"
(etaf-test--render-text
(etaf-view
(etaf-test-slot-card
:title "Card"
(slot :name 'header))))))
(should-error
(macroexpand '(etaf-view (etaf-test-slot-card (slot "bad"))))
:type 'etaf-view-syntax-error)
(should-error
(macroexpand
'(etaf-view
(etaf-test-slot-card (slot :name header (text "bad")))))
:type 'etaf-view-syntax-error)
(should-error
(macroexpand
'(etaf-view
(etaf-test-slot-card (slot :name nil (text "bad")))))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-component-nested-slot-inputs-stay-named ()
"Treat a nested Component's slot child as input, not as projection."
(should
(equal "Forwarded"
(etaf-test--render-text
(etaf-view (etaf-test-named-slot-forwarder))))))
(ert-deftest etaf-styles-have-root-class-and-inline-precedence ()
"Apply component styles only at matching scope and preserve inline props."
(let* ((node (etaf-render (etaf-view (etaf-test-styled-card))))
(content-node (plist-get node :ebox-content-node))
(children (plist-get content-node :children))
(title (car children))
(body (cadr children)))
(should (equal "inline-title" (ebox-get title :color)))
(should (equal "title-bg" (ebox-get title :bgcolor)))
(should (equal "style-root" (ebox-get node :color)))
(should-not (ebox-get body :color))))
(ert-deftest etaf-styles-continue-through-nested-components ()
"Apply a parent Component selector to a nested Component Host."
(let ((node (etaf-render (etaf-view (etaf-test-styled-parent)))))
(should (equal "parent-color" (ebox-get node :color)))))
(ert-deftest etaf-mounted-styles-continue-through-nested-components ()
"Apply a parent Component selector through the mounted Runtime."
(let ((buffer-name " *etaf-mounted-style-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-styled-parent)))
(should
(equal "parent-color"
(ebox-get
(etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name))
:color))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-defaults-are-inherited-and-overridable ()
"Apply Theme defaults while allowing explicit Host properties to win."
(let ((buffer-name " *etaf-theme-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-themed-text)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(node (etaf-runtime-root-node runtime)))
(should (equal "theme-color" (ebox-get node :color)))
(should (equal "theme-bg" (ebox-get node :bgcolor)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-text-supports-inline-propertized-runs ()
"Lower nested text Hosts to one Ebox content surface with text properties."
(let* ((node (etaf-render
(etaf-view
(text "Hello " (text :face 'bold "world") "!"))))
(content (ebox-get node :content)))
(should (equal "Hello world!" (substring-no-properties content)))
(should (eq 'bold (get-text-property 6 'face content)))
(should-not (get-text-property 0 'face content))))
(ert-deftest etaf-runtime-retains-setup-and-reactively-commits ()
"Run setup once, update through a ref, and dispose on unmount."
(let ((buffer-name " *etaf-runtime-test*"))
(setq etaf-test-state-cell nil
etaf-test-setup-count 0
etaf-test-mounted-count 0
etaf-test-unmounted-count 0
etaf-test-updated-count 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-stateful :label "Count")))
(should (equal "Count:0" (etaf-test--render-text
(etaf-view (text "Count:0")))))
(with-current-buffer buffer-name
(should (equal "Count:0" (buffer-string))))
(should (= etaf-test-setup-count 1))
(should (= etaf-test-mounted-count 1))
(setf (etaf-value etaf-test-state-cell) 1)
(with-current-buffer buffer-name
(should (equal "Count:1" (buffer-string))))
(should (= etaf-test-setup-count 1))
(should (= etaf-test-updated-count 1))
(etaf-unmount (etaf-runtime-for-buffer buffer-name))
(should (= etaf-test-unmounted-count 1)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-context-provide-inject-follows-component-tree ()
"Resolve the nearest Context and react to its provided ref."
(let ((buffer-name " *etaf-context-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(etaf-test-provider
(etaf-test-consumer))))
(with-current-buffer buffer-name
(should (equal "dark" (buffer-string))))
(setf (etaf-value etaf-test-theme-cell) 'light)
(with-current-buffer buffer-name
(should (equal "light" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-behavior-event-and-action-share-runtime-boundary ()
"Install a Behavior, dispatch its Host callback, and dispose it."
(let ((buffer-name " *etaf-event-test*"))
(setq etaf-test-event-count 0
etaf-test-behavior-cleanups 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(text
:ref 'interactive
:use (list (etaf-test-cleanup-behavior))
:on-press (lambda () (etaf-dispatch 'etaf-test-action))
"Press")))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-dispatch-event runtime 'interactive 'press)
(should (= etaf-test-event-count 1))
(should (equal '(press)
(mapcar #'car
(gethash 'interactive
(etaf-runtime-handlers runtime)))))
(etaf-unmount runtime))
(should (= etaf-test-behavior-cleanups 1)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-behavior-replacement-disposes-previous-installer ()
"Dispose a replaced Behavior while retaining the public installer path."
(let ((buffer-name " *etaf-behavior-replace-test*")
(marker (etaf-ref 0)))
(setq etaf-test-behavior-cleanups 0
etaf-test-behavior-runtime nil)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(text
:ref 'behavior-host
:use (list (etaf-test-cleanup-behavior
:class (format "mode-%d" (etaf-value marker))))
"Behavior")))
(should (etaf-runtime-p etaf-test-behavior-runtime))
(setf (etaf-value marker) 1)
(should (= 1 etaf-test-behavior-cleanups)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-toggleable-reads-reactive-value-at-event-time ()
"Use the current reactive value when a toggleable Behavior is pressed."
(let ((value (etaf-ref nil)) received)
(let ((behavior
(etaf-toggleable
:value value
:on-change (lambda (next) (setq received next))
:class "toggle")))
(should (equal "toggle"
(plist-get (etaf-behavior-spec-attributes behavior)
:class)))
(funcall (plist-get (etaf-behavior-spec-attributes behavior) :on-press))
(should (eq t received))
(setf (etaf-value value) t)
(funcall (plist-get (etaf-behavior-spec-attributes behavior) :on-press))
(should (eq nil received)))))
(ert-deftest etaf-focusable-supplies-default-tab-stop ()
"Give a focusable Behavior the standard tab index unless overridden."
(should (= 0 (plist-get (etaf-behavior-spec-attributes (etaf-focusable))
:tab-index)))
(should-not (plist-get
(etaf-behavior-spec-attributes
(etaf-focusable :tab-index nil))
:tab-index)))
(ert-deftest etaf-reactive-computed-watch-and-cleanup-share-one-model ()
"Compute values, watch changes, and dispose watch cleanup deterministically."
(let* ((source (etaf-ref 1))
(computed (etaf-computed (lambda () (* 2 (etaf-value source)))))
(watch-values nil)
(cleanup-count 0)
(stop-watch
(etaf-watch source
(lambda (new old)
(push (list new old) watch-values))
:immediate t))
(stop-effect
(etaf-watch-effect
(lambda ()
(etaf-value source)
(lambda () (cl-incf cleanup-count))))))
(unwind-protect
(progn
(should (= 2 (etaf-value computed)))
(setf (etaf-value source) 2)
(should (= 4 (etaf-value computed)))
(should (equal '((2 1) (1 nil)) watch-values))
(should (= 1 cleanup-count))
(funcall stop-watch)
(funcall stop-effect)
(should (= 2 cleanup-count))
(setf (etaf-value source) 3)
(should (equal '((2 1) (1 nil)) watch-values)))
(funcall stop-watch)
(funcall stop-effect))))
(ert-deftest etaf-reactive-effect-restores-dependencies-after-failure ()
"Keep the previous dependency set when an effect run fails."
(let* ((source (etaf-ref 0))
(runs 0)
(fail-p nil)
(effect (etaf-reactive-effect-create
(lambda ()
(etaf-value source)
(cl-incf runs)
(when fail-p
(error "expected effect failure"))))))
(etaf-reactive-effect-run effect)
(setq fail-p t)
(should-error (setf (etaf-value source) 1))
(should (= 2 runs))
(setq fail-p nil)
(setf (etaf-value source) 2)
(should (= 3 runs))
(etaf--stop-effect effect)))
(ert-deftest etaf-view-raw-ebox-is-an-explicit-backend-escape ()
"Lower a public Ebox node only through the explicit raw escape."
(let ((node
(etaf-render
(etaf-view
(raw-ebox
:key 7
:value (ebox-create :content "Backend"))))))
(should (equal "Backend" (ebox-get node :content)))
(should (= 7 (ebox-get node :key)))))
(ert-deftest etaf-stateful-props-update-without-rerunning-setup ()
"Track a reactive root prop while retaining one Component setup Scope."
(let ((buffer-name " *etaf-prop-update-test*")
(label (etaf-ref "A")))
(setq etaf-test-setup-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-prop-stateful :label (etaf-value label))))
(with-current-buffer buffer-name
(should (equal "A" (buffer-string))))
(setf (etaf-value label) "B")
(with-current-buffer buffer-name
(should (equal "B" (buffer-string))))
(should (= 1 etaf-test-setup-count)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-keeps-last-committed-view-after-render-error ()
"Rollback a failed candidate without losing the last committed buffer."
(let ((buffer-name " *etaf-rollback-test*")
(fail-p (etaf-ref nil)))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-rollback :fail (etaf-value fail-p))))
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string))))
(should-error (setf (etaf-value fail-p) t)
:type 'etaf-runtime-error)
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string))))
(setf (etaf-value fail-p) nil)
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-keeps-published-state-when-lifecycle-fails ()
"Keep retained state aligned with the published tree after hook failure."
(let ((buffer-name " *etaf-lifecycle-error-test*")
(label (etaf-ref "A")))
(setq etaf-test-lifecycle-failure-p nil)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-lifecycle-failure :label (etaf-value label))))
(setq etaf-test-lifecycle-failure-p t)
(should-error (setf (etaf-value label) "B") :type 'error)
(should (etaf-runtime-mounted-p
(etaf-runtime-for-buffer buffer-name)))
(with-current-buffer buffer-name
(should (equal "B" (buffer-string))))
(setq etaf-test-lifecycle-failure-p nil)
(setf (etaf-value label) "C")
(with-current-buffer buffer-name
(should (equal "C" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-events-support-payload-and-cyclic-focus ()
"Dispatch a payload and cycle focus through visible tab-index Hosts."
(let ((buffer-name " *etaf-focus-test*")
payload)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(column
(text :ref 'first :tab-index 0 "First")
(text :ref 'second :tab-index 1
:on-input (lambda (value) (setq payload value))
"Second"))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(should (eq 'first (etaf-focus-next runtime)))
(should (eq 'second (etaf-focus-next runtime)))
(should (eq 'first (etaf-focus-next runtime)))
(etaf-dispatch-event runtime 'second 'input "value" t)
(should (equal "value" payload))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-mount-publishes-through-ebox ()
"Mount a View into a buffer using Ebox's buffer publication API."
(let ((buffer-name " *etaf-test-mount*"))

146
tests/etaf-ui-tests.el Normal file
View File

@ -0,0 +1,146 @@
;;; etaf-ui-tests.el --- Official ETAF Component tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'etaf-ui)
(defun etaf-ui-test--buffer-text (buffer-name)
"Return plain text currently published in BUFFER-NAME."
(with-current-buffer buffer-name
(string-trim-right (substring-no-properties (buffer-string)))))
(ert-deftest etaf-ui-button-dispatches-controlled-press ()
"Render a button and dispatch its public Host callback."
(let ((buffer-name " *etaf-ui-button-test*")
(presses 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-button
:label "Save"
:ref 'save
:on-press (lambda () (cl-incf presses)))))
(should (string-match-p "Save" (etaf-ui-test--buffer-text buffer-name)))
(etaf-dispatch-event
(etaf-runtime-for-buffer buffer-name) 'save 'press)
(should (= 1 presses)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-checkbox-emits-next-value ()
"Render a controlled checkbox and emit its next checked value."
(let ((buffer-name " *etaf-ui-checkbox-test*")
next)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-checkbox
:checked nil
:label "Done"
:ref 'done
:on-change (lambda (value) (setq next value)))))
(should (string-match-p "☐ Done"
(etaf-ui-test--buffer-text buffer-name)))
(etaf-dispatch-event
(etaf-runtime-for-buffer buffer-name)
'done
'press)
(should (eq t next)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-panel-projects-named-and-default-slots ()
"Project panel header and body slots through the common slot model."
(let ((rendered
(string-trim-right
(substring-no-properties
(ebox-render
(etaf-render
(etaf-view
(etaf-panel :title "Account"
(slot :name 'header (text "Settings"))
(text "Body")))))))))
(dolist (label '("Account" "Settings" "Body"))
(should (string-match-p (regexp-quote label) rendered)))))
(ert-deftest etaf-ui-data-grid-projects-reactive-controller ()
"Render DataGrid rows and update them through the Data Controller."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada") (:id 2 :name "Grace"))
:id-key :id))
(controller (etaf-data-controller source :page-size 10 :auto-load t))
(buffer-name " *etaf-ui-grid-test*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID")
(:key :name :label "Name"))
:row-key (lambda (row) (plist-get row :id)))))
(should (string-match-p "Ada" (etaf-ui-test--buffer-text buffer-name)))
(etaf-data-mutate controller 'insert '(:id 3 :name "Alan"))
(should (string-match-p "Alan" (etaf-ui-test--buffer-text buffer-name))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-requires-stable-row-key ()
"Reject a DataGrid that cannot identify retained rows."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :page-size 10 :auto-load t))
(buffer-name " *etaf-ui-grid-row-key-test*"))
(unwind-protect
(should-error
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-ui-data-grid-rejects-nil-row-key ()
"Reject a DataGrid row-key function that returns no identity."
(let* ((source (etaf-data-memory-source
'((:id 1 :name "Ada"))
:id-key :id))
(controller (etaf-data-controller source :auto-load t))
(buffer-name " *etaf-ui-grid-nil-row-key-test*"))
(unwind-protect
(should-error
(etaf-mount
buffer-name
(etaf-view
(etaf-data-grid
:controller controller
:columns '((:key :id :label "ID"))
:row-key (lambda (_row) nil)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(etaf-data-stop controller)
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
;;; etaf-ui-tests.el ends here