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

refactor: lower Views into canonical Ebox nodes

Browse Source
This commit is contained in:
Kinneyzhang 2026-08-27 12:14:51 +08:00
parent 4ba86642d6
commit 1f29a73a88
11 changed files with 664 additions and 797 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

107
docs/proposals/module-boundaries.en.md
View File

@ -70,7 +70,11 @@ AuthorView
↓ parse / desugar / string normalization ↓ parse / desugar / string normalization
NormalizedView = Text | Box | Fragment | ComponentCall NormalizedView = Text | Box | Fragment | ComponentCall
↓ ETAF Runtime resolves ComponentCall ↓ ETAF Runtime resolves ComponentCall
Resolved candidate + computed properties Resolved candidate + source facts
↓ exactly one style adapter is selected for the current surface
ETAF Style Adapter | Ebox Standalone Style Adapter
↓ ECSS selector / cascade / inheritance (exactly once)
Computed property facts + impact sets
├─ structure/geometry impact ├─ structure/geometry impact
│ ↓ Fragment projection preserves RangeAnchors │ ↓ Fragment projection preserves RangeAnchors
│ CanonicalEboxInput = Forest<TextNode | BoxNode> + RangeAnchors │ CanonicalEboxInput = Forest<TextNode | BoxNode> + RangeAnchors
@ -78,8 +82,7 @@ Resolved candidate + computed properties
│ LayoutPlan → GeometryPatch │ LayoutPlan → GeometryPatch
│ │
└─ paint impact └─ paint impact
↓ source-specific contribution adapter ↓ shared property projector
(ETAF: etaf-theme-tp; standalone Ebox: ebox-surface-tp)
TP ContributionPlan → PaintPatch TP ContributionPlan → PaintPatch
GeometryPatch and PaintPatch join the existing TP transaction GeometryPatch and PaintPatch join the existing TP transaction
@ -315,6 +318,21 @@ TextNode, while `ebox-box-create` accepts a typed Layout variant and constructs
BoxNode. Constructors accept neither author forms nor a flat bag of properties spanning BoxNode. Constructors accept neither author forms nor a flat bag of properties spanning
multiple layouts. The ETAF Renderer calls them directly; it does not reconstruct DSL. multiple layouts. The ETAF Renderer calls them directly; it does not reconstruct DSL.
`:class`, `:id`, and author `:key` all belong to the source layer, but `:key` is an
identity fact and never enters visual source. Standalone Ebox DSL and ETAF View produce
isomorphic StyleSourceFact values; each surface selects exactly one adapter to invoke
ECSS. ETAF Style Adapter owns Component-scope assembly and stylesheet lifetime on an
ETAF surface, while Ebox Standalone Style Adapter owns them on a standalone surface.
Both reuse the same ECSS implementation and Ebox property registry/projector, so one
surface never runs cascade twice. The same parsed `:id` fact may also project to ETAF
semantic metadata, but it is not reparsed or recascaded.
Typed Text/Box constructors accept only an opaque `sourceHandle` plus already-computed
owned facts. They neither accept nor retain `:class/:id/:key`, and Ebox
measurement/layout core never reads source metadata. StyleEnvironment belongs to the
current surface/runtime and must not be implemented as a process-global stylesheet or
metadata table.
The target public port does not retain untyped `(ebox-create :content ...)`. If the The target public port does not retain untyped `(ebox-create :content ...)`. If the
runtime fuses a Text payload into adjacent Box storage for performance, that optimization runtime fuses a Text payload into adjacent Box storage for performance, that optimization
may occur only after canonical Text identity, range, and impact have been established, may occur only after canonical Text identity, range, and impact have been established,
@ -486,7 +504,6 @@ TextStyle =
:font-family :font-size :font-weight :font-style :font-family :font-size :font-weight :font-style
:color :background-color :color :background-color
:text-decoration-line :text-decoration-color :text-decoration-style :text-decoration-line :text-decoration-color :text-decoration-style
:wrap-mode (word | grapheme | none)
BoxFrame = BoxFrame =
:outer :outer
@ -495,6 +512,7 @@ BoxFrame =
:box-sizing :box-sizing
margin/padding shorthands and logical/physical longhands margin/padding shorthands and logical/physical longhands
border shorthands and width/style/color longhands border shorthands and width/style/color longhands
:wrap-mode (word | char | kp | none)
:overflow :visibility :overflow :visibility
inherited standard text style source such as font/color inherited standard text style source such as font/color
non-inherited surface source such as :background-color non-inherited surface source such as :background-color
@ -571,10 +589,19 @@ The target public API classifies historical and backend names as follows:
`:wrap-mode` is not equivalent to CSS `white-space`, `overflow-wrap`, `word-break`, or `:wrap-mode` is not equivalent to CSS `white-space`, `overflow-wrap`, `word-break`, or
`line-break`. It therefore remains the sole public name in the Ebox namespace, with its `line-break`. It therefore remains the sole public name in the Ebox namespace, with its
value restricted to `word`, `grapheme`, or `none`. If complete, semantically equivalent value restricted to `word`, `char`, `kp`, or `none`. `char` breaks only at complete
grapheme-cluster boundaries, while `kp` selects Knuth–Plass paragraph layout. If complete, semantically equivalent
CSS properties are implemented in the future, one explicit migration must replace it; CSS properties are implemented in the future, one explicit migration must replace it;
the two naming systems must not be retained indefinitely. the two naming systems must not be retained indefinitely.
Only Box author forms accept `:wrap-mode`; it specifies the soft-wrapping policy for
that Box's content. Text forms do not expose a second author path. During computation,
the Box policy is inherited as Text measurement input: Text executes line breaking but
does not own the declaration. `none` disables only automatic soft breaks and preserves
explicit newlines. The independent `:overflow` property decides what happens after
layout when unbroken content exceeds the Box; wrapping never implies clipping or
scrolling.
Standard CSS shorthands have exactly one expansion rule, including `:margin`, Standard CSS shorthands have exactly one expansion rule, including `:margin`,
`:padding`, `:border`, `:gap`, `:flex`, `:flex-flow`, `:grid-column`, and `:grid-row`. `:padding`, `:border`, `:gap`, `:flex`, `:flex-flow`, `:grid-column`, and `:grid-row`.
The canonical registry uses namespaced IDs such as `ebox/font-size` and The canonical registry uses namespaced IDs such as `ebox/font-size` and
@ -677,7 +704,22 @@ CanonicalDeclaration {
SelectorSubjectFact { SelectorSubjectFact {
classList classList
id id
semanticSourceHandle sourceHandle
}
StyleSourceFact {
sourceHandle
selectorSubjectFact
declarations
scopeHandle
provenance
}
StyleEnvironment {
stylesheet
schemaSet
scopeIndex
computedCache
} }
RuntimeMetadataFact { RuntimeMetadataFact {
@ -706,8 +748,10 @@ Normalization parses author input once and simultaneously produces immutable
CanonicalDeclaration, SelectorSubjectFact, and RuntimeMetadataFact artifacts. CanonicalDeclaration, SelectorSubjectFact, and RuntimeMetadataFact artifacts.
`:class/:id` do not enter CSS declarations; SelectorSubjectFact constructs the ECSS subject `:class/:id` do not enter CSS declarations; SelectorSubjectFact constructs the ECSS subject
directly before cascade. Selector and semantic projection share the same parsed source directly before cascade. Selector and semantic projection share the same parsed source
value for `:id` rather than rereading the plist independently. ECSS cascade/inheritance value for `:id` rather than rereading the plist independently. ETAF Style Adapter and
receives SelectorSubjectFact + declarations and produces immutable Ebox Standalone Style Adapter produce isomorphic StyleSourceFact values, but exactly one
adapter assembles StyleEnvironment for a surface. ECSS cascade/inheritance then receives
SelectorSubjectFact + declarations and produces immutable
ComputedPropertyFact artifacts. `:key`, `:ref`, `:on-*`, and similar properties do not ComputedPropertyFact artifacts. `:key`, `:ref`, `:on-*`, and similar properties do not
enter ECSS and appear only in RuntimeMetadataFact. “Materialize once” means that each enter ECSS and appear only in RuntimeMetadataFact. “Materialize once” means that each
stage produces its own immutable artifact once, not that one object mutates across stage produces its own immutable artifact once, not that one object mutates across
@ -787,16 +831,25 @@ complete chain, for example:
`etaf-renderer`: `etaf-renderer`:
- is the only ETAF → Ebox lowering adapter; - is the only ETAF → Ebox lowering adapter;
- converts the structure/geometry projection of ResolvedView into a - consumes computed/projection facts already produced by ETAF Style Adapter and turns
CanonicalEboxInput forest, RangeAnchors, and typed measurement/geometry properties; the structure/geometry projection into CanonicalEboxInput forest, RangeAnchors, and
typed Ebox facts;
- does not rerun selector/cascade or copy a second computed visual representation;
- does not execute Component lifecycle or access Ebox private state. - does not execute Component lifecycle or access Ebox private state.
`etaf-style` (a logical module that may remain in the same distribution):
- owns Component-style scope assembly and one independent StyleEnvironment per
Runtime/Surface, including its lifetime;
- uses Ebox's public property registry/projector and invokes ECSS directly for the one
cascade on an ETAF surface;
- does not measure, lay out, write buffers, or own Runtime commit authority.
`etaf-theme-tp`: `etaf-theme-tp`:
- is the only adapter from ETAF/ECSS computed paint contributions to TP; - is only the optional TP-palette to ETAF semantic Theme token/value adapter;
- produces ContributionPlan without measuring, laying out, or owning TP priority/commit - does not produce ContributionPlan, participate in selector/cascade, or own paint
authority; commit authority.
- does not call `etaf-renderer` geometry lowering for a paint-only candidate.
Theme semantic tokens and inheritance belong to ETAF Context. TP does not own business Theme semantic tokens and inheritance belong to ETAF Context. TP does not own business
meaning such as “dark theme.” meaning such as “dark theme.”
@ -806,6 +859,10 @@ meaning such as “dark theme.”
Ebox owns: Ebox owns:
- normalization of String/Text/Box and layout-sugar expansion in the Ebox DSL; - normalization of String/Text/Box and layout-sugar expansion in the Ebox DSL;
- the canonical Ebox property registry and pure computed-fact to geometry/paint-fact
projector;
- a Standalone Style Adapter used only by standalone Ebox surfaces; it invokes ECSS
directly, while the ETAF typed path bypasses it and never runs a second cascade;
- contextual validation, parent-layout consumption, and dirty propagation of child Box - contextual validation, parent-layout consumption, and dirty propagation of child Box
participation; participation;
- typed TextNode/BoxNode constructors and canonical property schemas; - typed TextNode/BoxNode constructors and canonical property schemas;
@ -817,11 +874,11 @@ Ebox owns:
Ebox does not understand Component, slot, Context, Action, Behavior, Data, or Resource, Ebox does not understand Component, slot, Context, Action, Behavior, Data, or Resource,
and does not determine paint-contribution priority. and does not determine paint-contribution priority.
Author paint from the standalone Ebox DSL is projected by the `ebox-surface` TP adapter ETAF Style Adapter and Ebox Standalone Style Adapter share the same pure property
into an inline ContributionPlan. It and ETAF's `etaf-theme-tp` are two source adapters projector. The former handles ETAF Theme/Component/state/inline provenance; the latter
that consume the same public TP contribution contract. Neither puts paint-only handles standalone Ebox inline/stylesheet provenance. They never coexist on one surface,
properties back into CanonicalEboxInput, nor owns TP priority, journal, or commit never put paint-only properties back into CanonicalEboxInput, and never own TP priority,
authority. journal, or commit authority.
`ebox-build` exclusively owns parsing/desugaring author forms. `ebox-text-create` and `ebox-build` exclusively owns parsing/desugaring author forms. `ebox-text-create` and
`ebox-box-create` accept already evaluated canonical parameters and validate only typed `ebox-box-create` accept already evaluated canonical parameters and validate only typed
@ -908,7 +965,8 @@ second Runtime.
through `ebox-build`; they do not own Component, slot, expr, or lifecycle. through `ebox-build`; they do not own Component, slot, expr, or lifecycle.
- Framework integrators use `ebox-text-create`, `ebox-box-create`, typed LayoutConfig, - Framework integrators use `ebox-text-create`, `ebox-box-create`, typed LayoutConfig,
RangeAnchor, and the TP contribution contract; they do not reconstruct DSL, pass RangeAnchor, and the TP contribution contract; they do not reconstruct DSL, pass
shorthands, or run a second cascade. shorthands, or run a second cascade. Typed constructors accept only an opaque
`sourceHandle`, not source-layer `:class/:id/:key`.
- The optional Emacs adapter is an explicit opt-in, independent schema namespace. Only - The optional Emacs adapter is an explicit opt-in, independent schema namespace. Only
a surface that loads the adapter accepts `:emacs-face`; otherwise normalization a surface that loads the adapter accepts `:emacs-face`; otherwise normalization
reports the unknown namespace/property precisely. reports the unknown namespace/property precisely.
@ -928,11 +986,12 @@ etaf-playground ─────▶ ETAF + optional UI/SQLite
ebox-playground ─────▶ Ebox only ebox-playground ─────▶ Ebox only
etaf-performance ────▶ public observation boundaries only etaf-performance ────▶ public observation boundaries only
ETAF Renderer ───────▶ ECSS computed properties ETAF Style Adapter ──▶ ECSS + Ebox property registry/projector
Ebox style pipeline ─▶ ECSS computed-properties port Ebox Standalone Style Adapter ─▶ ECSS + same registry/projector
ETAF Renderer ───────▶ Ebox typed core port
ETAF Runtime ───────▶ Ebox/TP transaction participants ETAF Runtime ───────▶ Ebox/TP transaction participants
etaf-theme-tp ───────▶ TP contribution contract etaf-theme-tp ───────▶ ETAF semantic Theme values only
Ebox surface ────────▶ TP inline contribution + transaction participant Ebox surface ────────▶ TP contribution + transaction participant
``` ```
Reverse dependencies are forbidden: Ebox does not depend on ETAF; TP does not parse Reverse dependencies are forbidden: Ebox does not depend on ETAF; TP does not parse

94
docs/proposals/module-boundaries.zh.md
View File

@ -63,7 +63,11 @@ AuthorView
↓ parse / desugar / string normalization ↓ parse / desugar / string normalization
NormalizedView = Text | Box | Fragment | ComponentCall NormalizedView = Text | Box | Fragment | ComponentCall
↓ ETAF Runtime resolves ComponentCall ↓ ETAF Runtime resolves ComponentCall
Resolved candidate + computed properties Resolved candidate + source facts
↓ 当前 surface 只选择一个 style adapter
ETAF Style Adapter | Ebox Standalone Style Adapter
↓ ECSS selector / cascade / inheritance（恰好一次）
Computed property facts + impact sets
├─ structure/geometry impact ├─ structure/geometry impact
│ ↓ Fragment projection preserves RangeAnchors │ ↓ Fragment projection preserves RangeAnchors
│ CanonicalEboxInput = Forest<TextNode | BoxNode> + RangeAnchors │ CanonicalEboxInput = Forest<TextNode | BoxNode> + RangeAnchors
@ -71,8 +75,7 @@ Resolved candidate + computed properties
│ LayoutPlan → GeometryPatch │ LayoutPlan → GeometryPatch
│ │
└─ paint impact └─ paint impact
↓ source-specific contribution adapter ↓ shared property projector
(ETAF: etaf-theme-tp; standalone Ebox: ebox-surface-tp)
TP ContributionPlan → PaintPatch TP ContributionPlan → PaintPatch
GeometryPatch and PaintPatch join the existing TP transaction GeometryPatch and PaintPatch join the existing TP transaction
@ -289,6 +292,19 @@ constructor：`ebox-text-create` 构造 TextNode，`ebox-box-create` 接收一
Layout variant 并构造 BoxNode。constructor 不接受作者 form 或扁平的跨 layout Layout variant 并构造 BoxNode。constructor 不接受作者 form 或扁平的跨 layout
属性袋；ETAF Renderer 直接调用它们，不重新拼 DSL。 属性袋；ETAF Renderer 直接调用它们，不重新拼 DSL。
`:class`、`:id` 和作者 `:key` 都属于来源层，但 `:key` 是 identity fact，不能进入
visual source。独立 Ebox DSL 与 ETAF View 都产生同构的 StyleSourceFact；每个 surface
只能选择一个 adapter 调用 ECSS。ETAF surface 由 ETAF Style Adapter 拥有 Component
scope 的装配和 stylesheet 生命周期，独立 Ebox surface 由 Ebox Standalone Style
Adapter 拥有；两者复用同一个 ECSS 实现、同一个 Ebox property registry/projector，
不会在同一 surface 上运行两次 cascade。`:id` 的同一 parsed fact 可以并行投影到
ETAF semantic metadata，但不能因此重新解析或重新 cascade。
typed Text/Box constructor 只接收 opaque `sourceHandle` 与已经计算完成的 owned facts，
不接收或保存 `:class/:id/:key`；Ebox measurement/layout core 也不读取 source metadata。
StyleEnvironment 属于当前 surface/runtime，不能实现为 process-global stylesheet 或
metadata table。
目标公共端口不保留无 kind 的 `(ebox-create :content ...)`。若运行时为了性能把 目标公共端口不保留无 kind 的 `(ebox-create :content ...)`。若运行时为了性能把
Text payload 融合进相邻 Box 存储，该优化只能发生在 canonical Text identity、 Text payload 融合进相邻 Box 存储，该优化只能发生在 canonical Text identity、
range 和 impact 已建立之后，并且必须可逆地保留这些事实；私有存储编码不能成为 range 和 impact 已建立之后，并且必须可逆地保留这些事实；私有存储编码不能成为
@ -439,7 +455,6 @@ TextStyle =
:font-family :font-size :font-weight :font-style :font-family :font-size :font-weight :font-style
:color :background-color :color :background-color
:text-decoration-line :text-decoration-color :text-decoration-style :text-decoration-line :text-decoration-color :text-decoration-style
:wrap-mode (word | grapheme | none)
BoxFrame = BoxFrame =
:outer :outer
@ -448,6 +463,7 @@ BoxFrame =
:box-sizing :box-sizing
margin/padding shorthands and logical/physical longhands margin/padding shorthands and logical/physical longhands
border shorthands and width/style/color longhands border shorthands and width/style/color longhands
:wrap-mode (word | char | kp | none)
:overflow :visibility :overflow :visibility
inherited standard text style source such as font/color inherited standard text style source such as font/color
non-inherited surface source such as :background-color non-inherited surface source such as :background-color
@ -519,10 +535,16 @@ Box。Ebox DSL 不接受 ETAFOnlyMetadata。
``` ```
`:wrap-mode` 不与 CSS `white-space`、`overflow-wrap`、`word-break` 或 `line-break` `:wrap-mode` 不与 CSS `white-space`、`overflow-wrap`、`word-break` 或 `line-break`
等价，因此保留为 Ebox namespace 的唯一公共名称，值限定为 `word`、`grapheme`、 等价，因此保留为 Ebox namespace 的唯一公共名称，值限定为 `word`、`char`、`kp`、
`none`。如果未来实现完整且语义一致的 CSS 属性，应以一次明确迁移替换它，而不是 `none`。`char` 在实现中按完整字素簇断行，避免拆开组合字符；`kp` 使用
Knuth–Plass 段落排版。如果未来实现完整且语义一致的 CSS 属性，应以一次明确迁移替换它，而不是
长期同时保留两套名称。 长期同时保留两套名称。
`:wrap-mode` 只由 Box 作者声明，表示该 Box 内容的软换行策略；Text form 不接受
它。计算阶段把 Box 的策略继承为 Text 测量输入，Text 负责执行断行，但不拥有第二
条作者配置路径。`none` 只禁止自动软换行，显式换行仍保留；排版后的越界由独立的
`:overflow` 决定，不能用 wrap 语义暗示裁剪或滚动。
标准 CSS shorthand 只有一套展开规则，例如 `:margin`、`:padding`、`:border`、 标准 CSS shorthand 只有一套展开规则，例如 `:margin`、`:padding`、`:border`、
`:gap`、`:flex`、`:flex-flow`、`:grid-column` 和 `:grid-row`。canonical registry 使用 `:gap`、`:flex`、`:flex-flow`、`:grid-column` 和 `:grid-row`。canonical registry 使用
namespaced ID（例如 `ebox/font-size`、`ebox/background-color`）；作者只写 keyword， namespaced ID（例如 `ebox/font-size`、`ebox/background-color`）；作者只写 keyword，
@ -620,6 +642,21 @@ SelectorSubjectFact {
sourceProvenance sourceProvenance
} }
StyleSourceFact {
sourceHandle
selectorSubjectFact
declarations
scopeHandle
provenance
}
StyleEnvironment {
stylesheet
schemaSet
scopeIndex
computedCache
}
RuntimeMetadataFact { RuntimeMetadataFact {
propertyId propertyId
value value
@ -646,7 +683,9 @@ normalization 对 author input 只解析一次，并同时产生 immutable
CanonicalDeclaration、SelectorSubjectFact 和 RuntimeMetadataFact。`:class/:id` 不 CanonicalDeclaration、SelectorSubjectFact 和 RuntimeMetadataFact。`:class/:id` 不
进入 CSS declarations；SelectorSubjectFact 在 cascade 前直接构造 ECSS subject。 进入 CSS declarations；SelectorSubjectFact 在 cascade 前直接构造 ECSS subject。
`:id` 的同一个 parsed source value 由 selector 与 semantic projection 共享，不各自 `:id` 的同一个 parsed source value 由 selector 与 semantic projection 共享，不各自
重读 plist。ECSS cascade/inheritance 接收 SelectorSubjectFact + declarations，产生 重读 plist。ETAF Style Adapter 与 Ebox Standalone Style Adapter 产生同构
StyleSourceFact，但一个 surface 只由其中一个 adapter 组装 StyleEnvironment；ECSS
cascade/inheritance 接收 SelectorSubjectFact + declarations，产生
immutable ComputedPropertyFact。`:key`、`:ref`、`:on-*` 等不进入 ECSS，只进入 immutable ComputedPropertyFact。`:key`、`:ref`、`:on-*` 等不进入 ECSS，只进入
RuntimeMetadataFact。这里的“一次 materialize”指每个阶段只生成一次自己的 RuntimeMetadataFact。这里的“一次 materialize”指每个阶段只生成一次自己的
immutable artifact，不是让同一对象跨阶段变异。 immutable artifact，不是让同一对象跨阶段变异。
@ -720,15 +759,23 @@ Elisp plist。调试与性能工具必须能显示完整链路，例如：
`etaf-renderer`： `etaf-renderer`：
- 是唯一 ETAF → Ebox 的 lowering adapter； - 是唯一 ETAF → Ebox 的 lowering adapter；
- 把 ResolvedView 的 structure/geometry projection 转换为 CanonicalEboxInput forest、 - 消费 ETAF Style Adapter 已产生的 computed/projection facts，把 structure/geometry
RangeAnchors 和 typed measurement/geometry props； projection 转换为 CanonicalEboxInput forest、RangeAnchors 与 typed Ebox facts；
- 不重新运行 selector/cascade，也不复制第二份 computed visual properties；
- 不执行 Component lifecycle，不访问 Ebox 私有状态。 - 不执行 Component lifecycle，不访问 Ebox 私有状态。
`etaf-style`（逻辑模块，可与发行包同仓）：
- 拥有 Component style scope 的装配、每个 Runtime/Surface 独立的 StyleEnvironment
及其生命周期；
- 使用 Ebox 公开的 property registry/projector，直接调用 ECSS 完成 ETAF surface
唯一一次 cascade；
- 不测量、不布局、不写 buffer，也不拥有 Runtime commit authority。
`etaf-theme-tp`： `etaf-theme-tp`：
- 是 ETAF/ECSS computed paint contribution → TP 的唯一 adapter； - 只是可选的 TP palette → ETAF semantic Theme token/value adapter；
- 产生 ContributionPlan，不测量、不布局、不拥有 TP priority/commit authority； - 不生成 ContributionPlan，不参与 selector/cascade，也不拥有 paint 提交权限。
- paint-only candidate 不调用 `etaf-renderer` 的 geometry lowering。
Theme 的语义 token 和继承属于 ETAF Context。TP 不拥有“暗色主题”等业务意义。 Theme 的语义 token 和继承属于 ETAF Context。TP 不拥有“暗色主题”等业务意义。
@ -737,6 +784,9 @@ Theme 的语义 token 和继承属于 ETAF Context。TP 不拥有“暗色主题
Ebox 拥有： Ebox 拥有：
- Ebox DSL 的 String/Text/Box 规范化和布局糖展开； - Ebox DSL 的 String/Text/Box 规范化和布局糖展开；
- Ebox canonical property registry 及 computed fact → geometry/paint fact 的纯 projector；
- 仅供独立 Ebox surface 使用的 Standalone Style Adapter；该 adapter 直接调用 ECSS，
但 ETAF typed path 必须绕过它，不能运行第二次 cascade；
- child Box participation 的上下文验证、父布局消费和 dirty propagation； - child Box participation 的上下文验证、父布局消费和 dirty propagation；
- typed TextNode/BoxNode constructor 及 canonical 属性 schema； - typed TextNode/BoxNode constructor 及 canonical 属性 schema；
- Text 测量、换行和行布局； - Text 测量、换行和行布局；
@ -747,10 +797,10 @@ Ebox 拥有：
Ebox 不理解 Component、slot、Context、Action、Behavior、Data 或 Resource，也不 Ebox 不理解 Component、slot、Context、Action、Behavior、Data 或 Resource，也不
决定 paint contribution 的优先级。 决定 paint contribution 的优先级。
独立 Ebox DSL 的 author paint 由 `ebox-surface` 的 TP adapter 投影为 inline ETAF Style Adapter 与 Ebox Standalone Style Adapter 共用同一个纯 property projector；
ContributionPlan；它与 ETAF 的 `etaf-theme-tp` 是两条来源 adapter，共同消费 TP 前者处理 ETAF Theme/Component/state/inline provenance，后者处理独立 Ebox inline/
公开 contribution contract。两者都不把 paint-only 属性塞回 CanonicalEboxInput， stylesheet provenance。两者不在同一 surface 并存，不把 paint-only 属性塞回
也不拥有 TP priority、journal 或 commit authority。 CanonicalEboxInput，也不拥有 TP priority、journal 或 commit authority。
`ebox-build` 独占作者 form 的 parse/desugar；`ebox-text-create` 与 `ebox-build` 独占作者 form 的 parse/desugar；`ebox-text-create` 与
`ebox-box-create` 接收已经求值的 canonical 参数，只验证 typed node invariant。 `ebox-box-create` 接收已经求值的 canonical 参数，只验证 typed node invariant。
@ -828,7 +878,8 @@ Playground 的 `.etaf` manifest 属于 Playground。未来通用 compiler 若存
Component、slot、expr 或 lifecycle。 Component、slot、expr 或 lifecycle。
- 框架集成者使用 `ebox-text-create`、`ebox-box-create`、typed LayoutConfig、 - 框架集成者使用 `ebox-text-create`、`ebox-box-create`、typed LayoutConfig、
RangeAnchor 和 TP contribution contract；不重新拼 DSL、不传 shorthand、不运行 RangeAnchor 和 TP contribution contract；不重新拼 DSL、不传 shorthand、不运行
第二次 cascade。 第二次 cascade。typed constructor 只接收 opaque `sourceHandle`，不接收来源层
`:class/:id/:key`。
- optional Emacs adapter 是显式 opt-in 的独立 schema namespace；只有加载 adapter - optional Emacs adapter 是显式 opt-in 的独立 schema namespace；只有加载 adapter
的 surface 才接受 `:emacs-face`，否则 normalization 精确报未知 namespace/property。 的 surface 才接受 `:emacs-face`，否则 normalization 精确报未知 namespace/property。
- `ebox--*`、`etaf--*`、`tp--*`、`:ebox-type`、`:node-id`、`:region-id`、Emacs - `ebox--*`、`etaf--*`、`tp--*`、`:ebox-type`、`:node-id`、`:region-id`、Emacs
@ -846,11 +897,12 @@ etaf-playground ─────▶ ETAF + optional UI/SQLite
ebox-playground ─────▶ Ebox only ebox-playground ─────▶ Ebox only
etaf-performance ────▶ public observation boundaries only etaf-performance ────▶ public observation boundaries only
ETAF Renderer ───────▶ ECSS computed properties ETAF Style Adapter ──▶ ECSS + Ebox property registry/projector
Ebox style pipeline ─▶ ECSS computed-properties port Ebox Standalone Style Adapter ─▶ ECSS + same registry/projector
ETAF Renderer ───────▶ Ebox typed core port
ETAF Runtime ───────▶ Ebox/TP transaction participants ETAF Runtime ───────▶ Ebox/TP transaction participants
etaf-theme-tp ───────▶ TP contribution contract etaf-theme-tp ───────▶ ETAF semantic Theme values only
Ebox surface ────────▶ TP inline contribution + transaction participant Ebox surface ────────▶ TP contribution + transaction participant
``` ```
禁止反向依赖：Ebox 不依赖 ETAF；TP 不解析 View；ECSS 不写 buffer；UI 不调用 禁止反向依赖：Ebox 不依赖 ETAF；TP 不解析 View；ECSS 不写 buffer；UI 不调用

2
etaf-compiler.el
View File

@ -79,7 +79,7 @@
(list (list :kind 'expr :path path :hole index :static-p nil) (list (list :kind 'expr :path path :hole index :static-p nil)
(append programs (append programs
(list `(lambda () ,(etaf--parse-expr-form (cdr form)))))))) (list `(lambda () ,(etaf--parse-expr-form (cdr form))))))))
((memq (car form) '(slot raw-ebox)) nil) ((eq (car form) 'slot) nil)
((etaf--ordinary-expression-head-p (car form)) nil) ((etaf--ordinary-expression-head-p (car form)) nil)
(t (t
(let* ((parts (etaf--parse-attributes-and-children (cdr form))) (let* ((parts (etaf--parse-attributes-and-children (cdr form)))

15
etaf-events.el
View File

@ -163,13 +163,14 @@ RUNTIME is the mounted Runtime to activate, or nil for the current buffer."
(let (candidates) (let (candidates)
(dolist (entry (etaf-runtime-host-props-entries runtime)) (dolist (entry (etaf-runtime-host-props-entries runtime))
(let ((host-ref (car entry)) (props (cdr entry))) (let ((host-ref (car entry)) (props (cdr entry)))
(let ((tab-index (plist-get props :tab-index)) (let ((tab-index (plist-get props :tab-index)))
(bounds (ebox-host-ref-bounds (when (and (numberp tab-index) (>= tab-index 0)
(etaf-runtime-buffer runtime) host-ref))) (not (plist-get props :disabled)))
(when (and (numberp tab-index) (>= tab-index 0) (when-let* ((bounds
(not (plist-get props :disabled)) bounds) (ebox-host-ref-bounds
(push (list tab-index (car bounds) (cdr bounds) host-ref) (etaf-runtime-buffer runtime) host-ref)))
candidates))))) (push (list tab-index (car bounds) (cdr bounds) host-ref)
candidates))))))
(sort candidates #'etaf--focus-candidate-before-p))) (sort candidates #'etaf--focus-candidate-before-p)))
;;;###autoload ;;;###autoload

316
etaf-renderer.el
View File

@ -24,8 +24,6 @@
(declare-function etaf--runtime-render-child-range "etaf-runtime" (runtime expr path)) (declare-function etaf--runtime-render-child-range "etaf-runtime" (runtime expr path))
(declare-function etaf--runtime-render-fragment-range (declare-function etaf--runtime-render-fragment-range
"etaf-runtime" (runtime fragment path)) "etaf-runtime" (runtime fragment path))
(declare-function etaf--runtime-render-raw-range
"etaf-runtime" (runtime raw path))
(declare-function etaf--runtime-render-slot-range (declare-function etaf--runtime-render-slot-range
"etaf-runtime" (runtime projection path)) "etaf-runtime" (runtime projection path))
(declare-function etaf--runtime-register-semantic-host (declare-function etaf--runtime-register-semantic-host
@ -158,6 +156,33 @@ not create another visual node category."
:props props :props props
:children (etaf--view-node-children node))))) :children (etaf--view-node-children node)))))
(defvar etaf--theme-host-default-cache
(make-hash-table :test #'eq :weakness 'key)
"Theme-value keyed accepted Host default templates.")
(defun etaf--theme-host-defaults (defaults name)
"Return immutable DEFAULTS accepted by View node NAME."
(let* ((by-name
(or (gethash defaults etaf--theme-host-default-cache)
(let ((table (make-hash-table :test #'eq)))
(puthash defaults table etaf--theme-host-default-cache)
table)))
(missing (make-symbol "etaf-theme-host-defaults-missing"))
(cached (gethash name by-name missing)))
(if (not (eq cached missing))
cached
(let ((tail defaults) result)
(while tail
(let ((key (pop tail))
(value (pop tail)))
(when (and (etaf--theme-ebox-property-p key)
(ebox-style-property-accepted-p name key))
(setq result
(append result
(list key (etaf-theme-token key value)))))))
(puthash name result by-name)
result))))
(defun etaf--apply-theme-defaults (node) (defun etaf--apply-theme-defaults (node)
"Apply known inherited Theme defaults to NODE without overriding props. "Apply known inherited Theme defaults to NODE without overriding props.
Unknown Theme keys remain readable through `etaf-theme-value' but are design Unknown Theme keys remain readable through `etaf-theme-value' but are design
@ -166,19 +191,18 @@ tokens, not Ebox Host properties, and therefore are not materialized here."
(defaults (etaf--theme-source-value source nil nil))) (defaults (etaf--theme-source-value source nil nil)))
(if (null defaults) (if (null defaults)
node node
(let ((props (copy-sequence (let* ((name (etaf--view-node-name node))
(etaf--resolve-property-plist (props (copy-sequence
(etaf--view-node-props node))))) (etaf--resolve-property-plist
(while defaults (etaf--view-node-props node))))
(let ((key (pop defaults)) (template (etaf--theme-host-defaults defaults name)))
(value (pop defaults))) (while template
(when (and (etaf--theme-ebox-property-p key) (let ((key (pop template))
(not (plist-get props key))) (value (pop template)))
(setq props (unless (plist-get props key)
(etaf--merge-property (setq props (etaf--merge-property props key value)))))
props key (etaf-theme-token key value))))))
(etaf--view-node-create (etaf--view-node-create
:name (etaf--view-node-name node) :name name
:token (etaf--view-node-token node) :token (etaf--view-node-token node)
:props props :props props
:children (etaf--view-node-children node)))))) :children (etaf--view-node-children node))))))
@ -286,56 +310,168 @@ the ordinary layout lowering path instead."
(and (eq (etaf--view-node-name value) 'text) (and (eq (etaf--view-node-name value) 'text)
(cl-every #'etaf--inline-text-structural-p (cl-every #'etaf--inline-text-structural-p
(etaf--view-node-children value)))) (etaf--view-node-children value))))
((proper-list-p value)
(cl-every #'etaf--inline-text-structural-p value))
(t nil)))
(defun etaf--inline-text-dynamic-p (value)
"Return non-nil when VALUE contains an inline `expr' update site."
(cond
((etaf--expr-p value) t)
((etaf--view-node-p value)
(cl-some #'etaf--inline-text-dynamic-p
(etaf--view-node-children value)))
((proper-list-p value) ((proper-list-p value)
(cl-every #'etaf--inline-text-structural-p value)) (cl-some #'etaf--inline-text-dynamic-p value))
(t nil))) (t nil)))
(defun etaf--ebox-properties (props path &optional site-token) (defun etaf--ebox-properties (props path &optional site-token)
"Translate ETAF PROPS at PATH into Ebox's public property list." "Project ETAF PROPS at PATH to canonical Ebox author facts."
(let* ((source-props (etaf--resolve-property-plist props)) (let* ((source-props (etaf--resolve-property-plist props))
(props (copy-sequence source-props)) (props (copy-sequence source-props))
ebox-props surface-properties) ebox-props)
(while props (while props
(let ((key (pop props)) (let ((key (pop props))
(value (pop props))) (value (pop props)))
(cond (cond
((eq key :face) ((memq key '(:face :surface-properties))
(push 'face surface-properties) (signal 'etaf-renderer-error
(push value surface-properties)) (list (format
((eq key :surface-properties) "%S is not a canonical ETAF property" key))))
(let ((tail value))
(while tail
(push (pop tail) surface-properties)
(push (pop tail) surface-properties))))
((eq key :content) ((eq key :content)
(signal 'etaf-renderer-error (signal 'etaf-renderer-error
(list "Use View children for content, not :content"))) (list "Use View children for content, not :content")))
((or (memq key etaf--semantic-props) ((or (and (memq key etaf--semantic-props)
(not (memq key '(:class :id))))
(etaf--event-property-p key) (etaf--event-property-p key)
(eq key :styles)) (eq key :styles))
nil) nil)
(t (t
(push key ebox-props) ;; Component APIs pass optional properties as nil. At the resolved
(push value ebox-props))))) ;; author boundary nil means "unspecified"; canonical Ebox defaults
(setq ebox-props (nreverse ebox-props) ;; own the initial value and never receive a synthetic declaration.
surface-properties (nreverse surface-properties)) (when value
(push key ebox-props)
(push value ebox-props))))))
(setq ebox-props (nreverse ebox-props))
(setq ebox-props (setq ebox-props
(etaf--merge-property (etaf--merge-property
ebox-props :host-ref ebox-props :source-handle
(etaf--generated-host-ref source-props path site-token))) (etaf--generated-host-ref source-props path site-token)))
(when surface-properties
(setq ebox-props
(append ebox-props
(list :surface-properties surface-properties))))
ebox-props)) ebox-props))
(defconst etaf--ebox-source-fields
'(:source-handle :key :class :id)
"Canonical Ebox source metadata forwarded by ETAF Renderer.")
(defvar etaf--ebox-declaration-cache (make-hash-table :test #'equal)
"Bounded canonical declaration cache for normalized ETAF author props.")
(defconst etaf--ebox-declaration-cache-limit 512
"Maximum canonical ETAF declaration entries retained across renders.")
(defvar etaf--ebox-layout-config-cache (make-hash-table :test #'equal)
"Bounded typed LayoutConfig cache for normalized ETAF Box forms.")
(defconst etaf--ebox-layout-config-cache-limit 128
"Maximum typed LayoutConfig entries retained across renders.")
(defun etaf--ebox-keep-properties (props names)
"Return PROPS whose keys occur in NAMES."
(cl-loop for (key value) on props by #'cddr
when (memq key names)
append (list key value)))
(defun etaf--ebox-remove-properties (props names)
"Return PROPS without keys in NAMES."
(cl-loop for (key value) on props by #'cddr
unless (memq key names)
append (list key value)))
(defun etaf--ebox-declarations (tag props)
"Compile TAG style declarations from canonical ETAF PROPS once."
(let* ((style-props
(etaf--ebox-remove-properties
props
(append etaf--ebox-source-fields
(unless (eq tag 'text) '(:outer))
(when (memq tag '(row column))
'(:item-gap :cross-align)))))
(key (cons tag style-props))
(missing (make-symbol "etaf-ebox-declarations-missing"))
(cached (gethash key etaf--ebox-declaration-cache missing)))
(if (not (eq cached missing))
cached
(let ((compiled (ebox-style-compile-form tag style-props)))
(when (>= (hash-table-count etaf--ebox-declaration-cache)
etaf--ebox-declaration-cache-limit)
(clrhash etaf--ebox-declaration-cache))
(puthash (copy-tree key) compiled etaf--ebox-declaration-cache)
compiled))))
(defun etaf--ebox-layout-config (tag props declarations)
"Return TAG LayoutConfig from PROPS and normalized DECLARATIONS."
(let* ((layout-props
(if (memq tag '(row column))
(etaf--ebox-keep-properties props '(:item-gap :cross-align))
(ebox-style-declaration-properties
declarations
(lambda (property)
(memq (plist-get property :name)
(ebox-layout-config-property-names tag))))))
(key (cons tag layout-props))
(config (gethash key etaf--ebox-layout-config-cache)))
(or config
(let ((created (ebox-layout-config-for-form tag layout-props)))
(when (>= (hash-table-count etaf--ebox-layout-config-cache)
etaf--ebox-layout-config-cache-limit)
(clrhash etaf--ebox-layout-config-cache))
(puthash (copy-tree key) created etaf--ebox-layout-config-cache)
created))))
(defun etaf--ebox-text-node (value props)
"Return one typed Ebox TextNode for string VALUE and canonical PROPS."
(unless (stringp value)
(signal 'etaf-renderer-error
(list (format "Text payload must resolve to a string: %S" value))))
(let ((declarations (etaf--ebox-declarations 'text props)))
(apply #'ebox-text-create
(append (list :value value :declarations declarations)
(etaf--ebox-keep-properties
props etaf--ebox-source-fields)))))
(defun etaf--ebox-box-node (tag props children)
"Return one typed Ebox BoxNode TAG over canonical CHILDREN."
(let* ((declarations (etaf--ebox-declarations tag props))
(layout (etaf--ebox-layout-config tag props declarations))
(outer (if (plist-member props :outer)
(plist-get props :outer)
'block)))
(apply #'ebox-box-create
(append
(list :layout layout :outer outer :children children
:declarations declarations)
(etaf--ebox-keep-properties props etaf--ebox-source-fields)))))
(defun etaf--ebox-forest-root (nodes source-handle)
"Return one canonical backend root for ordered forest NODES.
SOURCE-HANDLE identifies only a backend root introduced for an empty or
multi-root forest; a single material root is returned unchanged."
(cond
((null nodes)
(etaf--ebox-box-node
'box (list :source-handle source-handle) nil))
((null (cdr nodes)) (car nodes))
(t
(etaf--ebox-box-node
'column (list :source-handle source-handle) nodes))))
(defun etaf--flatten-view-value (value) (defun etaf--flatten-view-value (value)
"Flatten VALUE through transparent `expr' and sequence values." "Flatten VALUE through transparent `expr' and sequence values."
(cond (cond
((null value) nil) ((null value) nil)
((or (stringp value) (etaf--view-node-p value) ((or (stringp value) (etaf--view-node-p value)
(etaf--component-call-p value) (etaf--slot-projection-p value) (etaf--component-call-p value) (etaf--slot-projection-p value))
(etaf--raw-ebox-p value))
(list value)) (list value))
((etaf--expr-p value) ((etaf--expr-p value)
(etaf--flatten-view-value (funcall (etaf--expr-thunk value)))) (etaf--flatten-view-value (funcall (etaf--expr-thunk value))))
@ -432,7 +568,9 @@ the ordinary layout lowering path instead."
etaf--render-runtime 'text nil nil item-path))) etaf--render-runtime 'text nil nil item-path)))
(etaf--runtime-finish-semantic-host (etaf--runtime-finish-semantic-host
etaf--render-runtime semantic-id item))) etaf--render-runtime semantic-id item)))
(list (ebox-create :content item))) (list
(etaf--ebox-text-node
item (etaf--ebox-properties nil item-path))))
((etaf--view-node-p item) ((etaf--view-node-p item)
(etaf--render-node item item-path)) (etaf--render-node item item-path))
((etaf--component-call-p item) ((etaf--component-call-p item)
@ -446,21 +584,6 @@ the ordinary layout lowering path instead."
(etaf--render-component-call-pure item item-path))) (etaf--render-component-call-pure item item-path)))
((etaf--slot-projection-p item) ((etaf--slot-projection-p item)
(etaf--render-slot-projection item item-path)) (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 (t
(signal 'etaf-renderer-error (signal 'etaf-renderer-error
(list (format "Unresolved View item: %S" item)))))))) (list (format "Unresolved View item: %S" item))))))))
@ -489,7 +612,7 @@ the ordinary layout lowering path instead."
(node (if (fboundp 'etaf--runtime-style-node) (node (if (fboundp 'etaf--runtime-style-node)
(etaf--runtime-style-node node path) (etaf--runtime-style-node node path)
node)) node))
(node (etaf--apply-theme-defaults node)) (node (etaf--apply-theme-defaults node))
(name (etaf--view-node-name node)) (name (etaf--view-node-name node))
(theme-result (theme-result
(etaf--resolve-theme-property-plist (etaf--resolve-theme-property-plist
@ -500,10 +623,6 @@ the ordinary layout lowering path instead."
(props (etaf--ebox-properties (props (etaf--ebox-properties
raw-props path (etaf--view-node-token node))) raw-props path (etaf--view-node-token node)))
(children (etaf--view-node-children node))) (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 (etaf--view-node-token node)))
(pcase name (pcase name
('text ('text
(let* ((semantic-id (let* ((semantic-id
@ -516,6 +635,7 @@ the ordinary layout lowering path instead."
(child-path (append path (list :text))) (child-path (append path (list :text)))
(runtime-inline (runtime-inline
(and semantic-id (and semantic-id
(etaf--inline-text-dynamic-p children)
(etaf--inline-text-structural-p children) (etaf--inline-text-structural-p children)
(etaf--runtime-render-inline-content (etaf--runtime-render-inline-content
etaf--render-runtime semantic-id children child-path))) etaf--render-runtime semantic-id children child-path)))
@ -523,36 +643,19 @@ the ordinary layout lowering path instead."
(cl-mapcan #'etaf--flatten-view-value children))) (cl-mapcan #'etaf--flatten-view-value children)))
(inline (if runtime-inline (inline (if runtime-inline
(cons t (car runtime-inline)) (cons t (car runtime-inline))
(etaf--inline-text-content flat))) (etaf--inline-text-content flat))))
(rendered (unless (car inline)
(let ((etaf--current-semantic-parent-id
(or semantic-id
etaf--current-semantic-parent-id)))
(etaf--render-value-list flat child-path)))))
(when semantic-id (when semantic-id
(etaf--runtime-finish-semantic-host (etaf--runtime-finish-semantic-host
etaf--render-runtime semantic-id etaf--render-runtime semantic-id
(and (car inline) (cdr inline)) (and (car inline) (cdr inline))
(and runtime-inline (cadr runtime-inline)))) (and runtime-inline (cadr runtime-inline))))
(if (car inline) (if (car inline)
(list (apply #'ebox-create :content (cdr inline) props)) (list (etaf--ebox-text-node (cdr inline) props))
(list (ebox-build (append (list 'row) props rendered)))))) (signal 'etaf-renderer-error
('spacer (list "Text payload must resolve to one string")))))
(when children
(signal 'etaf-renderer-error
(list "spacer cannot have children")))
(when etaf--render-runtime
(let ((semantic-id (etaf--runtime-register-semantic-host
etaf--render-runtime name raw-props props path
theme-bindings theme-deps property-bindings
property-deps property-context-deps base-props
(etaf--view-node-token node))))
(etaf--runtime-finish-semantic-host
etaf--render-runtime semantic-id)))
(list (apply #'ebox-spacer props)))
('fragment ('fragment
(etaf--render-value-list children (append path (list :fragment)))) (etaf--render-value-list children (append path (list :fragment))))
((or 'box 'row 'column 'container 'stack 'flex 'grid) ((or 'box 'row 'column 'flex 'grid)
(let ((nodes nil) (let ((nodes nil)
(index 0) (index 0)
(range-child-p nil) (range-child-p nil)
@ -589,15 +692,6 @@ the ordinary layout lowering path instead."
(setq range-child-p t) (setq range-child-p t)
(cdr result)) (cdr result))
(if (and semantic-id (if (and semantic-id
(etaf--raw-ebox-p child)
(not etaf--rendering-range-p))
(let ((result
(etaf--runtime-render-raw-range
etaf--render-runtime child
(append path (list index)))))
(setq range-child-p t)
(cdr result))
(if (and semantic-id
(etaf--slot-projection-p child) (etaf--slot-projection-p child)
(etaf--slot-projection-range-compatible-p (etaf--slot-projection-range-compatible-p
child) child)
@ -609,7 +703,7 @@ the ordinary layout lowering path instead."
(setq range-child-p t) (setq range-child-p t)
(cdr result)) (cdr result))
(etaf--render-value-list (etaf--render-value-list
child (append path (list index)))))))))) child (append path (list index)))))))))
(cl-incf index)) (cl-incf index))
(when semantic-id (when semantic-id
(etaf--runtime-finish-semantic-host (etaf--runtime-finish-semantic-host
@ -622,25 +716,10 @@ the ordinary layout lowering path instead."
(defun etaf--layout-node (name props nodes &optional range-child-p) (defun etaf--layout-node (name props nodes &optional range-child-p)
"Build layout NAME with Ebox PROPS around child NODES. "Build layout NAME with Ebox PROPS around child NODES.
RANGE-CHILD-P records that NODES include nonvisual Range segments." RANGE-CHILD-P records that NODES include nonvisual Range segments."
(let ((node (unless (memq name '(box row column flex grid))
(cond (signal 'etaf-renderer-error
((eq name 'box) (list (format "Not a Box form: %S" name))))
(ebox-build (append (list 'box) props nodes))) (let ((node (etaf--ebox-box-node name props nodes)))
((eq name 'row)
(if (null props)
(apply #'ebox-row nodes)
(ebox-build (append (list 'row) props nodes))))
((memq name '(column container stack))
(if (null props)
(apply #'ebox-column nodes)
(ebox-build (append (list 'column) props nodes))))
((eq name 'flex)
(apply #'ebox-flex (append props nodes)))
((eq name 'grid)
(apply #'ebox-grid (append props nodes)))
(t
(signal 'etaf-renderer-error
(list (format "Not a layout Host: %S" name)))))))
(when range-child-p (when range-child-p
(push node etaf--rendered-range-container-nodes)) (push node etaf--rendered-range-container-nodes))
node)) node))
@ -651,11 +730,11 @@ RANGE-CHILD-P records that NODES include nonvisual Range segments."
RANGE-CHILD-P preserves the direct material Range parent." RANGE-CHILD-P preserves the direct material Range parent."
(pcase name (pcase name
('text ('text
(if children (when children
(etaf--layout-node 'row props children range-child-p) (signal 'etaf-renderer-error
(apply #'ebox-create :content content props))) (list "Text cannot contain material child nodes")))
('spacer (apply #'ebox-spacer props)) (etaf--ebox-text-node content props))
((or 'box 'row 'column 'container 'stack 'flex 'grid) ((or 'box 'row 'column 'flex 'grid)
(etaf--layout-node name props children range-child-p)) (etaf--layout-node name props children range-child-p))
(_ (signal 'etaf-renderer-error (_ (signal 'etaf-renderer-error
(list (format "Semantic Host requires Step4b lowering: %S" (list (format "Semantic Host requires Step4b lowering: %S"
@ -666,12 +745,9 @@ RANGE-CHILD-P preserves the direct material Range parent."
"Lower normalized VIEW to one Ebox node. "Lower normalized VIEW to one Ebox node.
This pure entry supports stateless Components. Stateful Components require a This pure entry supports stateless Components. Stateful Components require a
Runtime because their setup Scope must have a lifecycle owner." Runtime because their setup Scope must have a lifecycle owner."
(let ((nodes (etaf--render-value-list view '(root)))) (etaf--ebox-forest-root
(cond (etaf--render-value-list view '(root)) '(etaf-root pure)))
((null nodes) (ebox-spacer))
((null (cdr nodes)) (car nodes))
(t (apply #'ebox-column nodes)))))
;;;###autoload ;;;###autoload
(defun etaf-mount (buffer-or-name view &optional options) (defun etaf-mount (buffer-or-name view &optional options)

372
etaf-runtime.el
View File

@ -27,6 +27,8 @@
"etaf-renderer" (props path &optional site-token)) "etaf-renderer" (props path &optional site-token))
(declare-function etaf--lower-resolved-semantic-host (declare-function etaf--lower-resolved-semantic-host
"etaf-renderer" (name props content children range-child-p)) "etaf-renderer" (name props content children range-child-p))
(declare-function etaf--ebox-forest-root
"etaf-renderer" (nodes source-handle))
(declare-function etaf--inline-text-surface-properties (declare-function etaf--inline-text-surface-properties
"etaf-renderer" (props)) "etaf-renderer" (props))
(declare-function etaf--apply-inline-surface-properties (declare-function etaf--apply-inline-surface-properties
@ -106,7 +108,7 @@
(cl-defstruct (etaf--semantic-root (:constructor etaf--semantic-root-create)) (cl-defstruct (etaf--semantic-root (:constructor etaf--semantic-root-create))
"Immutable semantic Root owner stored at generation node zero." "Immutable semantic Root owner stored at generation node zero."
semantic-id effect-id input-signature deps) semantic-id effect-id input-signature deps child-ids)
(cl-defstruct (etaf--generation-effect (cl-defstruct (etaf--generation-effect
(:constructor etaf--generation-effect-create)) (:constructor etaf--generation-effect-create))
@ -138,6 +140,44 @@ the operation preserves committed values and removal semantics."
source-effects effect-sources parent-table children-table source-effects effect-sources parent-table children-table
resource-membership identity-index indexes) resource-membership identity-index indexes)
(defun etaf--semantic-parent-id (semantic)
"Return SEMANTIC's retained parent id, or nil for Root."
(cond
((etaf--semantic-component-p semantic)
(etaf--semantic-component-parent-id semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-parent-id semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-parent-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-parent-id semantic))
((etaf--semantic-inline-range-p semantic)
(etaf--semantic-inline-range-parent-id semantic))))
(defun etaf--semantic-child-ids (semantic)
"Return SEMANTIC's immutable direct child ids."
(cond
((etaf--semantic-root-p semantic)
(etaf--semantic-root-child-ids semantic))
((etaf--semantic-component-p semantic)
(etaf--semantic-component-child-ids semantic))
((etaf--semantic-host-p semantic)
(etaf--semantic-host-child-ids semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-item-host-ids semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-item-host-ids semantic))))
(defun etaf--generation-parent-id (generation semantic-id)
"Return SEMANTIC-ID's parent directly from GENERATION's semantic node."
(etaf--semantic-parent-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation) semantic-id)))
(defun etaf--generation-child-ids (generation semantic-id)
"Return SEMANTIC-ID's children directly from GENERATION's semantic node."
(etaf--semantic-child-ids
(etaf--pvec-get (etaf-generation-semantic-nodes generation) semantic-id)))
(cl-defstruct (etaf--pvec-node (:constructor etaf--pvec-node-create)) (cl-defstruct (etaf--pvec-node (:constructor etaf--pvec-node-create))
"One sparse immutable 32-way generation index node." "One sparse immutable 32-way generation index node."
children value) children value)
@ -840,7 +880,7 @@ Component owner to absorb them."
(pcase (etaf--generation-effect-kind effect) (pcase (etaf--generation-effect-kind effect)
('root 0) ('root 0)
('component-input 1) ('component-input 1)
((or 'range 'fragment 'raw 'slot 'inline) 2) ((or 'range 'fragment 'slot 'inline) 2)
(_ 3))) (_ 3)))
(defun etaf--runtime-sort-dirty-effects (generation effect-ids) (defun etaf--runtime-sort-dirty-effects (generation effect-ids)
@ -1201,35 +1241,54 @@ when the requested boundary is no longer mounted."
"Return event symbol represented by callback PROPERTY." "Return event symbol represented by callback PROPERTY."
(intern (substring (symbol-name property) 4))) (intern (substring (symbol-name property) 4)))
(defun etaf--runtime-register-host (runtime props path &optional site-token) (defun etaf--runtime-register-host
"Register callback PROPS for the opaque Host reference in RUNTIME at PATH." (runtime props path &optional site-token old-semantic)
"Register PROPS contributions for one semantic Host at PATH.
OLD-SEMANTIC supplies the already-read committed Host, when any."
(let ((host-ref (etaf--generated-host-ref props path site-token)) (let ((host-ref (etaf--generated-host-ref props path site-token))
handlers) (tail props)
;; A local Component rerender can remove and recreate the same stable semantic-p
;; Host reference. Re-registration cancels the candidate tombstone; handlers
;; otherwise the generation contribution index would hide the new old-semantic-p
;; handler/property entry behind the old removal. old-handlers-p)
(setf (etaf-runtime-candidate-removed-host-refs runtime) (while tail
(delete host-ref (let ((key (pop tail))
(etaf-runtime-candidate-removed-host-refs runtime))) (value (pop tail)))
(puthash host-ref props (etaf-runtime-candidate-host-props runtime)) (when (and value (memq key etaf--semantic-props))
(while props (setq semantic-p t))
(let ((key (pop props))
(value (pop props)))
(when (and (keywordp key) (when (and (keywordp key)
(string-prefix-p ":on-" (symbol-name key)) (string-prefix-p ":on-" (symbol-name key))
(functionp value)) (functionp value))
(push (cons (etaf--runtime-event-kind key) value) handlers)))) (push (cons (etaf--runtime-event-kind key) value) handlers))))
(if handlers (when (etaf--semantic-host-p old-semantic)
(puthash host-ref handlers (etaf-runtime-candidate-handlers runtime)) (let ((old-props (etaf--semantic-host-base-props old-semantic)))
;; A retained Host can keep its identity while losing its callback (while old-props
;; (for example a pagination button at the first/last page). Preserve (let ((key (pop old-props))
;; a nil handler delta only when the committed generation had one; this (value (pop old-props)))
;; shadows the old contribution without manufacturing entries for every (when (and value (memq key etaf--semantic-props))
;; non-interactive Host. (setq old-semantic-p t))
(when (etaf--generation-index-lookup (when (and (keywordp key)
(etaf-runtime-current-generation runtime) 'handlers host-ref) (string-prefix-p ":on-" (symbol-name key))
(puthash host-ref nil (etaf-runtime-candidate-handlers runtime)))))) (functionp value))
(setq old-handlers-p t))))))
(when (or semantic-p old-semantic-p handlers old-handlers-p)
;; A local Component rerender can remove and recreate the same stable
;; Host reference. Re-registration cancels the candidate tombstone;
;; otherwise the generation contribution index would hide the new
;; handler/property entry behind the old removal.
(setf (etaf-runtime-candidate-removed-host-refs runtime)
(delete host-ref
(etaf-runtime-candidate-removed-host-refs runtime)))
(puthash host-ref (and semantic-p props)
(etaf-runtime-candidate-host-props runtime))
(cond
(handlers
(puthash host-ref handlers
(etaf-runtime-candidate-handlers runtime)))
(old-handlers-p
;; A retained Host can keep its identity while losing its callback.
(puthash host-ref nil
(etaf-runtime-candidate-handlers runtime)))))))
(defun etaf--runtime-candidate-add-child (runtime parent-id child-id) (defun etaf--runtime-candidate-add-child (runtime parent-id child-id)
"Append CHILD-ID to PARENT-ID's candidate semantic order in RUNTIME." "Append CHILD-ID to PARENT-ID's candidate semantic order in RUNTIME."
@ -1313,7 +1372,7 @@ receive an independent Host effect."
(list 'host etaf--current-semantic-parent-id (list 'host etaf--current-semantic-parent-id
:site site-token) :site site-token)
(list 'host etaf--current-semantic-parent-id (list 'host etaf--current-semantic-parent-id
:position (copy-tree path))))) :position path))))
(semantic-id (etaf--runtime-semantic-id-for-identity runtime identity)) (semantic-id (etaf--runtime-semantic-id-for-identity runtime identity))
(old (old
(and (etaf-runtime-current-generation runtime) (and (etaf-runtime-current-generation runtime)
@ -1321,6 +1380,9 @@ receive an independent Host effect."
(etaf-generation-semantic-nodes (etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime)) (etaf-runtime-current-generation runtime))
semantic-id))) semantic-id)))
(_host-contributions
(etaf--runtime-register-host
runtime props path site-token old))
(effect-id (effect-id
(and (or theme-bindings property-bindings) (and (or theme-bindings property-bindings)
(or (and (etaf--semantic-host-p old) (or (and (etaf--semantic-host-p old)
@ -1332,17 +1394,16 @@ receive an independent Host effect."
:component-id etaf--current-component-semantic-id :component-id etaf--current-component-semantic-id
:host-ref (etaf--generated-host-ref props path site-token) :host-ref (etaf--generated-host-ref props path site-token)
:key key :name name :effect-id effect-id :key key :name name :effect-id effect-id
:property-bindings (copy-sequence property-bindings) :property-bindings property-bindings
:theme-bindings (copy-sequence theme-bindings) :theme-bindings theme-bindings
:deps (delete-dups :deps (delete-dups
(append (copy-sequence property-deps) (append property-deps theme-deps))
(copy-sequence theme-deps))) :context-deps property-context-deps
:context-deps (copy-tree property-context-deps) :base-props base-props
:base-props (copy-tree base-props)
:site-token site-token :site-token site-token
:props-signature (copy-tree backend-props) :props-signature backend-props
:path (copy-tree path) :path path
:style-identity (copy-tree etaf--render-style-stack)))) :style-identity etaf--render-style-stack)))
(unless etaf--rendering-range-p (unless etaf--rendering-range-p
(puthash identity semantic-id (puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))) (etaf-runtime-candidate-identity-entries runtime)))
@ -1825,10 +1886,11 @@ need to know how Behavior attributes are merged."
(etaf-runtime-candidate-graph-nodes runtime))))))) (etaf-runtime-candidate-graph-nodes runtime)))))))
(let ((node (let ((node
(unless transparent-p (unless transparent-p
(cond (etaf--ebox-forest-root
((null nodes) (ebox-spacer)) nodes
((null (cdr nodes)) (car nodes)) (list 'etaf-component-root
(t (apply #'ebox-column nodes)))))) (copy-tree
(etaf--component-instance-identity instance)))))))
(when node (when node
(let ((range-container-p (let ((range-container-p
(memq node etaf--rendered-range-container-nodes))) (memq node etaf--rendered-range-container-nodes)))
@ -2160,9 +2222,11 @@ need to know how Behavior attributes are merged."
runtime generation child-id)) runtime generation child-id))
(etaf--semantic-component-child-ids semantic)))) (etaf--semantic-component-child-ids semantic))))
(let ((node (let ((node
(cond ((null nodes) (ebox-spacer)) (etaf--ebox-forest-root
((null (cdr nodes)) (car nodes)) nodes
(t (apply #'ebox-column nodes))))) (list 'etaf-component-root
(copy-tree
(etaf--semantic-component-identity semantic))))))
(if (eq (etaf--semantic-component-publication-kind semantic) (if (eq (etaf--semantic-component-publication-kind semantic)
'transparent) 'transparent)
node node
@ -2532,82 +2596,6 @@ need to know how Behavior attributes are merged."
:thunk (lambda () (etaf--view-node-children fragment))))) :thunk (lambda () (etaf--view-node-children fragment)))))
(etaf--runtime-render-child-range runtime expr path 'fragment))) (etaf--runtime-render-child-range runtime expr path 'fragment)))
(defun etaf--runtime-evaluate-raw-range (raw)
"Return RAW's resolved public Ebox node and collected dependencies."
(let (deps node)
(let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--active-effect nil)
(etaf--render-phase-p t))
(setq node (funcall (etaf--raw-ebox-thunk raw)))
(unless (listp node)
(signal 'etaf-runtime-error
(list "raw-ebox :value must return one public Ebox node")))
(setq node (copy-tree node))
(when-let* ((key-thunk (etaf--raw-ebox-key-thunk raw)))
(let ((key (funcall key-thunk)))
(etaf--validate-key key)
(setq node (plist-put node :key key)))))
(cl-values node (nreverse deps))))
(defun etaf--runtime-render-raw-range (runtime raw path)
"Lower material-child RAW at PATH in RUNTIME as an opaque retained Range."
(let* ((token (etaf--raw-ebox-token raw))
(identity (list 'raw-range etaf--current-semantic-parent-id
(or token (copy-tree path))))
(generation (etaf-runtime-current-generation runtime))
(old-id (and generation
(gethash identity
(etaf-generation-identity-index generation))))
(old (and old-id
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
old-id)))
(semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime))))
(effect-id (or (and old (etaf--semantic-range-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))
(range-ref (or (and old (etaf--semantic-range-range-ref old))
(list 'etaf-raw-range
(etaf-runtime-mount-epoch runtime) semantic-id))))
(puthash identity semantic-id
(etaf-runtime-candidate-identity-entries runtime))
(etaf--runtime-candidate-add-child
runtime etaf--current-semantic-parent-id semantic-id)
(if (and old
(not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime))))
(progn
(when (etaf-runtime-candidate-full-rebuild-p runtime)
(etaf--runtime-carry-committed-subtree runtime generation old))
(cons 'range
(list (apply #'ebox-child-range range-ref
(copy-sequence
(gethash (etaf--semantic-range-artifact-key old)
(etaf-runtime-range-artifact-registry
runtime)))))))
(cl-multiple-value-bind (node deps)
(etaf--runtime-evaluate-raw-range raw)
(let ((record
(etaf--semantic-range-create
:semantic-id semantic-id :identity identity :effect-id effect-id
:kind 'raw :parent-id etaf--current-semantic-parent-id
:component-id etaf--current-component-semantic-id
:token token :range-ref range-ref :path (copy-tree path)
:caller-style-stack nil :output-signature (copy-tree node)
:deps deps
:artifact-key (cons (1+ (etaf-runtime-generation runtime))
effect-id)
:item-host-ids nil
:item-identity-index (make-hash-table :test #'equal))))
(puthash semantic-id record
(etaf-runtime-candidate-graph-nodes runtime))
(puthash effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'raw :semantic-id semantic-id
:deps deps :target raw)
(etaf-runtime-candidate-effects runtime))
(puthash effect-id (list node)
(etaf-runtime-candidate-range-artifacts runtime))
(cons 'range (list (ebox-child-range range-ref node))))))))
(defun etaf--runtime-render-slot-range (runtime projection path) (defun etaf--runtime-render-slot-range (runtime projection path)
"Lower material-child PROJECTION at PATH in RUNTIME as a retained slot Range." "Lower material-child PROJECTION at PATH in RUNTIME as a retained slot Range."
(let* ((name (etaf--slot-projection-name projection)) (let* ((name (etaf--slot-projection-name projection))
@ -2895,9 +2883,8 @@ The candidate uses resolved VALUE, DEPS, and NODES."
(setq queue (setq queue
(nconc queue (nconc queue
(copy-sequence (copy-sequence
(etaf--pvec-get (etaf--generation-child-ids
(etaf-generation-children-table generation) generation semantic-id))))))
semantic-id))))))
(nreverse result))) (nreverse result)))
(defun etaf--runtime-inline-value-string (value surface) (defun etaf--runtime-inline-value-string (value surface)
@ -2943,7 +2930,8 @@ The candidate uses resolved VALUE, DEPS, and NODES."
(candidate (and old-id (candidate (and old-id
(gethash old-id (gethash old-id
(etaf-runtime-candidate-graph-nodes runtime)))) (etaf-runtime-candidate-graph-nodes runtime))))
(semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime)))) (semantic-id (or old-id
(cl-incf (etaf-runtime-next-semantic-id runtime))))
(effect-id (or (and old (etaf--semantic-inline-range-effect-id old)) (effect-id (or (and old (etaf--semantic-inline-range-effect-id old))
(cl-incf (etaf-runtime-next-effect-id runtime))))) (cl-incf (etaf-runtime-next-effect-id runtime)))))
(puthash identity semantic-id (puthash identity semantic-id
@ -2952,12 +2940,13 @@ The candidate uses resolved VALUE, DEPS, and NODES."
(if candidate (if candidate
(cons semantic-id (etaf--semantic-inline-range-output candidate)) (cons semantic-id (etaf--semantic-inline-range-output candidate))
(if (and old (not etaf--rendering-component-effect-p) (if (and old (not etaf--rendering-component-effect-p)
(not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) (not (gethash effect-id
(progn (etaf-runtime-dirty-effect-ids runtime))))
(when (etaf-runtime-candidate-full-rebuild-p runtime) (progn
(etaf--runtime-carry-committed-subtree runtime generation old)) (when (etaf-runtime-candidate-full-rebuild-p runtime)
(cons semantic-id (etaf--semantic-inline-range-output old))) (etaf--runtime-carry-committed-subtree runtime generation old))
(let (deps context-deps output) (cons semantic-id (etaf--semantic-inline-range-output old)))
(let (deps context-deps output)
(let ((etaf--runtime-dependency-collector (let ((etaf--runtime-dependency-collector
(lambda (source) (cl-pushnew source deps :test #'eq))) (lambda (source) (cl-pushnew source deps :test #'eq)))
(etaf--context-inject-recorder (etaf--context-inject-recorder
@ -2995,9 +2984,9 @@ The candidate uses resolved VALUE, DEPS, and NODES."
(when-let* ((component-id (when-let* ((component-id
(etaf--semantic-inline-range-component-id old)) (etaf--semantic-inline-range-component-id old))
(component (component
(etaf--pvec-get (etaf--pvec-get
(etaf-generation-semantic-nodes generation) (etaf-generation-semantic-nodes generation)
component-id))) component-id)))
(cl-pushnew (etaf--semantic-component-identity component) (cl-pushnew (etaf--semantic-component-identity component)
(etaf-runtime-candidate-updated-component-identities (etaf-runtime-candidate-updated-component-identities
runtime) runtime)
@ -3242,7 +3231,6 @@ Generation, including its effects and Host contributions."
(let ((candidate-children (let ((candidate-children
(etaf-runtime-candidate-graph-children runtime)) (etaf-runtime-candidate-graph-children runtime))
(candidate-nodes (etaf-runtime-candidate-graph-nodes runtime)) (candidate-nodes (etaf-runtime-candidate-graph-nodes runtime))
(base-children (etaf-generation-children-table base))
(candidate-attached (make-hash-table :test #'eql))) (candidate-attached (make-hash-table :test #'eql)))
(maphash (maphash
(lambda (_parent-id children) (lambda (_parent-id children)
@ -3260,11 +3248,13 @@ Generation, including its effects and Host contributions."
semantic-id semantic-id
(etaf-runtime-candidate-removed-semantic-ids runtime) (etaf-runtime-candidate-removed-semantic-ids runtime)
:test #'eql) :test #'eql)
(dolist (child-id (etaf--pvec-get base-children semantic-id)) (dolist (child-id
(etaf--generation-child-ids base semantic-id))
(record-detached child-id))))) (record-detached child-id)))))
(maphash (maphash
(lambda (parent-id children) (lambda (parent-id children)
(dolist (old-child-id (etaf--pvec-get base-children parent-id)) (dolist (old-child-id
(etaf--generation-child-ids base parent-id))
(unless (memq old-child-id children) (unless (memq old-child-id children)
(record-detached old-child-id)))) (record-detached old-child-id))))
candidate-children)) candidate-children))
@ -3297,15 +3287,13 @@ Generation, including its effects and Host contributions."
(source-effects (and (not full-p) (etaf-generation-source-effects base))) (source-effects (and (not full-p) (etaf-generation-source-effects base)))
(effect-sources (and (not full-p) (etaf-generation-effect-sources base))) (effect-sources (and (not full-p) (etaf-generation-effect-sources base)))
(resources (and (not full-p) (etaf-generation-resource-membership base))) (resources (and (not full-p) (etaf-generation-resource-membership base)))
(parent-index (and (not full-p) (etaf-generation-parent-table base)))
(children-index (and (not full-p) (etaf-generation-children-table base)))
(identity-index (if (not full-p) (identity-index (if (not full-p)
(etaf-generation-identity-index base) (etaf-generation-identity-index base)
(make-hash-table :test #'equal))) (make-hash-table :test #'equal)))
(identity-copy nil) (identity-copy nil)
(affected-sources (make-hash-table :test #'eq)) (affected-sources (make-hash-table :test #'eq))
deltas deltas
node-updates parent-updates children-updates resource-updates) node-updates resource-updates)
(cl-labels (cl-labels
((install-effect ((install-effect
(effect old-deps new-deps) (effect old-deps new-deps)
@ -3386,18 +3374,11 @@ Generation, including its effects and Host contributions."
(setf (etaf--semantic-component-artifact-key semantic) (setf (etaf--semantic-component-artifact-key semantic)
(cons generation-id effect-id))) (cons generation-id effect-id)))
(push (cons semantic-id semantic) node-updates) (push (cons semantic-id semantic) node-updates)
(push (cons semantic-id
(etaf--semantic-component-parent-id semantic))
parent-updates)
(push (cons semantic-id
(copy-sequence
(etaf--semantic-component-child-ids semantic)))
children-updates)
(unless (gethash identity identity-index) (unless (gethash identity identity-index)
(unless identity-copy (unless identity-copy
(setq identity-index (copy-hash-table identity-index) (setq identity-index (copy-hash-table identity-index)
identity-copy t)) identity-copy t))
(puthash (copy-tree identity) semantic-id identity-index)) (puthash identity semantic-id identity-index))
(unless (and (not full-p) (unless (and (not full-p)
(etaf--pvec-get resources resource-id)) (etaf--pvec-get resources resource-id))
(push (cons resource-id (push (cons resource-id
@ -3405,28 +3386,9 @@ Generation, including its effects and Host contributions."
resource-updates)))) resource-updates))))
(etaf-runtime-candidate-semantic-nodes runtime)) (etaf-runtime-candidate-semantic-nodes runtime))
(maphash (maphash
(lambda (semantic-id semantic) (lambda (semantic-id semantic)
(unless (etaf--semantic-component-p semantic) (unless (etaf--semantic-component-p semantic)
(push (cons semantic-id semantic) node-updates) (push (cons semantic-id semantic) node-updates)))
(let ((parent-id
(cond ((etaf--semantic-host-p semantic)
(etaf--semantic-host-parent-id semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-parent-id semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-parent-id semantic))
(t (etaf--semantic-inline-range-parent-id semantic))))
(child-ids
(cond ((etaf--semantic-host-p semantic)
(etaf--semantic-host-child-ids semantic))
((etaf--semantic-range-p semantic)
(etaf--semantic-range-item-host-ids semantic))
((etaf--semantic-slot-range-p semantic)
(etaf--semantic-slot-range-item-host-ids semantic))
(t nil))))
(push (cons semantic-id parent-id) parent-updates)
(push (cons semantic-id (copy-sequence child-ids))
children-updates))))
(etaf-runtime-candidate-graph-nodes runtime)) (etaf-runtime-candidate-graph-nodes runtime))
(maphash (maphash
(lambda (identity _state) (lambda (identity _state)
@ -3467,16 +3429,14 @@ Generation, including its effects and Host contributions."
(cl-pushnew host-ref (cl-pushnew host-ref
(etaf-runtime-candidate-removed-host-refs runtime) (etaf-runtime-candidate-removed-host-refs runtime)
:test #'equal))))) :test #'equal)))))
(push (cons semantic-id nil) node-updates) (push (cons semantic-id nil) node-updates))
(push (cons semantic-id nil) parent-updates)
(push (cons semantic-id nil) children-updates))
(maphash (maphash
(lambda (identity semantic-id) (lambda (identity semantic-id)
(unless (gethash identity identity-index) (unless (gethash identity identity-index)
(unless identity-copy (unless identity-copy
(setq identity-index (copy-hash-table identity-index) (setq identity-index (copy-hash-table identity-index)
identity-copy t)) identity-copy t))
(puthash (copy-tree identity) semantic-id identity-index))) (puthash identity semantic-id identity-index)))
(etaf-runtime-candidate-identity-entries runtime)) (etaf-runtime-candidate-identity-entries runtime))
(maphash (maphash
(lambda (effect-id effect) (lambda (effect-id effect)
@ -3494,17 +3454,17 @@ Generation, including its effects and Host contributions."
(etaf--pvec-get (etaf--pvec-get
(etaf-generation-effect-sources base) effect-id))) (etaf-generation-effect-sources base) effect-id)))
(new-deps (etaf-runtime-candidate-root-deps runtime)) (new-deps (etaf-runtime-candidate-root-deps runtime))
(root-children
(copy-sequence
(gethash 0
(etaf-runtime-candidate-graph-children runtime))))
(root (etaf--semantic-root-create (root (etaf--semantic-root-create
:semantic-id 0 :effect-id effect-id :semantic-id 0 :effect-id effect-id
:input-signature :input-signature
(copy-tree (etaf-runtime-root-view-cache runtime)) (copy-tree (etaf-runtime-root-view-cache runtime))
:deps (copy-sequence new-deps)))) :deps (copy-sequence new-deps)
:child-ids root-children)))
(push (cons 0 root) node-updates) (push (cons 0 root) node-updates)
(push (cons 0
(copy-sequence
(gethash 0
(etaf-runtime-candidate-graph-children runtime))))
children-updates)
(install-effect (install-effect
(etaf--generation-effect-create (etaf--generation-effect-create
:effect-id effect-id :kind 'root :effect-id effect-id :kind 'root
@ -3515,10 +3475,6 @@ Generation, including its effects and Host contributions."
;; vector spines changes. ;; vector spines changes.
(setq nodes (setq nodes
(etaf--pvec-put-many nodes node-updates metrics) (etaf--pvec-put-many nodes node-updates metrics)
parent-index
(etaf--pvec-put-many parent-index parent-updates metrics)
children-index
(etaf--pvec-put-many children-index children-updates metrics)
resources resources
(etaf--pvec-put-many resources resource-updates metrics)) (etaf--pvec-put-many resources resource-updates metrics))
(maphash (maphash
@ -3543,8 +3499,8 @@ Generation, including its effects and Host contributions."
:effect-map effect-map :effect-map effect-map
:source-effects source-effects :source-effects source-effects
:effect-sources effect-sources :effect-sources effect-sources
:parent-table parent-index :parent-table nil
:children-table children-index :children-table nil
:resource-membership resources :resource-membership resources
:identity-index identity-index :identity-index identity-index
:indexes (etaf--runtime-build-contribution-indexes :indexes (etaf--runtime-build-contribution-indexes
@ -4412,39 +4368,6 @@ Generation, including its effects and Host contributions."
nodes nodes
(plist-get keyed :reuse-map))))) (plist-get keyed :reuse-map)))))
(defun etaf--runtime-render-dirty-raw-range (runtime effect range)
"Evaluate opaque raw RANGE for EFFECT in RUNTIME."
(cl-multiple-value-bind (node deps)
(etaf--runtime-evaluate-raw-range
(etaf--generation-effect-target effect))
(let ((candidate (copy-sequence range)))
(setf (etaf--semantic-range-output-signature candidate) (copy-tree node)
(etaf--semantic-range-deps candidate) deps
(etaf--semantic-range-artifact-key candidate)
(cons (1+ (etaf-runtime-generation runtime))
(etaf--semantic-range-effect-id range))
(etaf--semantic-range-composition-version candidate)
(1+ (etaf--semantic-range-composition-version range)))
(puthash (etaf--semantic-range-semantic-id range) candidate
(etaf-runtime-candidate-graph-nodes runtime))
(puthash (etaf--semantic-range-effect-id range)
(etaf--generation-effect-create
:effect-id (etaf--semantic-range-effect-id range)
:kind 'raw :semantic-id (etaf--semantic-range-semantic-id range)
:deps deps :target (etaf--generation-effect-target effect))
(etaf-runtime-candidate-effects runtime))
(puthash (etaf--semantic-range-effect-id range) (list node)
(etaf-runtime-candidate-range-artifacts runtime))
(unless (equal-including-properties
(etaf--semantic-range-output-signature range) node)
(etaf--runtime-invalidate-range-ancestors runtime range)
(etaf--runtime-record-range-owner-update runtime range))
(list range candidate
(copy-sequence
(gethash (etaf--semantic-range-artifact-key range)
(etaf-runtime-range-artifact-registry runtime)))
(list node)))))
(defun etaf--runtime-record-range-owner-update (runtime range) (defun etaf--runtime-record-range-owner-update (runtime range)
"Record RANGE's lexical Component lifecycle participation in RUNTIME." "Record RANGE's lexical Component lifecycle participation in RUNTIME."
(when-let* ((component-id (etaf--semantic-range-component-id range)) (when-let* ((component-id (etaf--semantic-range-component-id range))
@ -4676,8 +4599,7 @@ RENDERED-IDENTITIES names the Component render participants."
(let ((semantic-id (etaf--semantic-host-semantic-id host)) owner) (let ((semantic-id (etaf--semantic-host-semantic-id host)) owner)
(while (and semantic-id (not owner)) (while (and semantic-id (not owner))
(setq semantic-id (setq semantic-id
(etaf--pvec-get (etaf-generation-parent-table generation) (etaf--generation-parent-id generation semantic-id))
semantic-id))
(when semantic-id (when semantic-id
(let ((semantic (let ((semantic
(etaf--pvec-get (etaf-generation-semantic-nodes generation) (etaf--pvec-get (etaf-generation-semantic-nodes generation)
@ -4734,7 +4656,7 @@ RENDERED-IDENTITIES names the Component render participants."
(etaf--runtime-record-effect-input-version (etaf--runtime-record-effect-input-version
runtime old effect-id) runtime old effect-id)
(unless (and (memq (etaf--generation-effect-kind effect) (unless (and (memq (etaf--generation-effect-kind effect)
'(range fragment raw slot inline)) '(range fragment slot inline))
(etaf--runtime-range-owned-by-rendered-component-p (etaf--runtime-range-owned-by-rendered-component-p
runtime old base-semantic)) runtime old base-semantic))
(pcase (etaf--generation-effect-kind effect) (pcase (etaf--generation-effect-kind effect)
@ -4754,10 +4676,6 @@ RENDERED-IDENTITIES names the Component render participants."
(push (etaf--runtime-render-dirty-range (push (etaf--runtime-render-dirty-range
runtime effect semantic) runtime effect semantic)
range-changes)) range-changes))
('raw
(push (etaf--runtime-render-dirty-raw-range
runtime effect semantic)
range-changes))
('slot ('slot
(push (etaf--runtime-render-dirty-slot-range (push (etaf--runtime-render-dirty-slot-range
runtime effect semantic) runtime effect semantic)
@ -5001,10 +4919,10 @@ RENDERED-IDENTITIES names the Component render participants."
(etaf--runtime-stage-root-range (etaf--runtime-stage-root-range
runtime (etaf-runtime-candidate-root-deps runtime)) runtime (etaf-runtime-candidate-root-deps runtime))
(setq next-root (setq next-root
(cond (etaf--ebox-forest-root
((null nodes) (ebox-spacer)) nodes
((null (cdr nodes)) (car nodes)) (list 'etaf-runtime-root
(t (apply #'ebox-column nodes)))) (etaf-runtime-mount-epoch runtime))))
(setq candidate-generation (setq candidate-generation
(etaf--runtime-build-generation runtime old-generation) (etaf--runtime-build-generation runtime old-generation)
resource-journal (etaf--runtime-preinstall-resources resource-journal (etaf--runtime-preinstall-resources

32
etaf-view.el
View File

@ -65,15 +65,8 @@
token token
fallback) fallback)
(cl-defstruct (etaf--raw-ebox
(:constructor etaf--raw-ebox-create))
"Explicit escape carrying an already-built public Ebox node."
token
thunk
key-thunk)
(defconst etaf--host-names (defconst etaf--host-names
'(text box fragment container row column stack flex grid spacer) '(text box fragment row column flex grid)
"Minimal unstyled Hosts implemented by ETAF core. "Minimal unstyled Hosts implemented by ETAF core.
Product Components such as Button belong to `etaf-ui'; they are not added to Product Components such as Button belong to `etaf-ui'; they are not added to
@ -364,8 +357,6 @@ SLOT-MODE distinguishes Component-owned projections from call-site inputs."
(etaf--compile-expr-form (cdr form))) (etaf--compile-expr-form (cdr form)))
((and (consp form) (eq (car form) 'slot)) ((and (consp form) (eq (car form) 'slot))
(etaf--compile-slot-form (cdr form) slot-mode)) (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))) ((and (consp form) (symbolp (car form)))
(when (etaf--ordinary-expression-head-p (car form)) (when (etaf--ordinary-expression-head-p (car form))
(etaf--syntax-error (etaf--syntax-error
@ -394,24 +385,6 @@ SLOT-MODE distinguishes Component-owned projections from call-site inputs."
;; the Component definition macro, so the public macro defaults to ;; the Component definition macro, so the public macro defaults to
;; projection mode. An unowned projection simply uses its fallback. ;; projection mode. An unowned projection simply uses its fallback.
(etaf--compile-slot-form (cdr form) slot-mode)) (etaf--compile-slot-form (cdr form) slot-mode))
((eq (car form) 'raw-ebox)
(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))
(token (gensym "etaf-raw-site-")))
(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
:token ',token
:thunk (lambda () ,(plist-get props :value))
:key-thunk ,(when (plist-member props :key)
`(lambda () ,(plist-get props :key))))))))
(t (t
(let* ((parts (etaf--parse-attributes-and-children (cdr form))) (let* ((parts (etaf--parse-attributes-and-children (cdr form)))
(props (car parts)) (props (car parts))
@ -496,6 +469,9 @@ ordinary Elisp expressions. `expr' is the only computation bridge in the
(mapcar #'etaf--normalize-structural-child children)))) (mapcar #'etaf--normalize-structural-child children))))
(cond (cond
((eq entry etaf--host-marker) ((eq entry etaf--host-marker)
(when (and (eq host-name 'text) (/= (length children) 1))
(etaf--syntax-error
"Text requires exactly one string or expr payload"))
(when (plist-member props :key) (when (plist-member props :key)
(etaf--validate-key (etaf--validate-key
(etaf--resolve-property-value (plist-get props :key)))) (etaf--resolve-property-value (plist-get props :key))))

35
examples/etaf-counter-example.el
View File

@ -28,37 +28,37 @@
(defun etaf-counter-example--header (title) (defun etaf-counter-example--header (title)
"Return the counter header for TITLE." "Return the counter header for TITLE."
(etaf-view (etaf-view
(box :layout 'column :class "hero" (column :class "hero"
(text :class "eyebrow" "BEST PRACTICE / RETAINED STATE") (text :class "eyebrow" "BEST PRACTICE / RETAINED STATE")
(text :face 'bold (expr :value title)) (text :font-weight 'bold (expr :value title))
(text :color "#66706A" (text :color "#66706A"
"State belongs to setup; rendering only reads it.")))) "State belongs to setup; rendering only reads it."))))
(defun etaf-counter-example--metrics (count double status) (defun etaf-counter-example--metrics (count double status)
"Return metric cards for COUNT, DOUBLE, and STATUS." "Return metric cards for COUNT, DOUBLE, and STATUS."
(etaf-view (etaf-view
(box :layout 'flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(text :class "metric" (box :class "metric"
(expr :value (format "COUNT %d" (etaf-value count)))) (text (expr :value (format "COUNT %d" (etaf-value count)))))
(text :class "metric" (box :class "metric"
(expr :value (format "DOUBLE %d" (etaf-value double)))) (text (expr :value (format "DOUBLE %d" (etaf-value double)))))
(text :class "metric" (box :class "metric"
(expr :value (format "STATE %s" (etaf-value status))))))) (text (expr :value (format "STATE %s" (etaf-value status))))))))
(defun etaf-counter-example--action (count label host-ref operation) (defun etaf-counter-example--action (count label host-ref operation)
"Return one COUNT action named LABEL using HOST-REF and OPERATION." "Return one COUNT action named LABEL using HOST-REF and OPERATION."
(etaf-view (etaf-view
(text :class "action" :ref host-ref :role 'button (box :class "action" :ref host-ref :role 'button
:use (list (etaf-focusable)) :use (list (etaf-focusable))
:on-press (lambda () :on-press (lambda ()
(etaf-dispatch 'etaf-counter-example-update (etaf-dispatch 'etaf-counter-example-update
count operation)) count operation))
(expr :value label)))) (text (expr :value label)))))
(defun etaf-counter-example--actions (count) (defun etaf-counter-example--actions (count)
"Return the action group for COUNT." "Return the action group for COUNT."
(etaf-view (etaf-view
(box :layout 'flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(expr :value (expr :value
(etaf-counter-example--action (etaf-counter-example--action
count "− DECREMENT" 'counter-decrement 'decrement)) count "− DECREMENT" 'counter-decrement 'decrement))
@ -76,13 +76,13 @@
("&" :width (680) :color "#252A2E" :bgcolor "#F8F5EE") ("&" :width (680) :color "#252A2E" :bgcolor "#F8F5EE")
(".hero" :width (680) :padding (1 (18)) :border "#8F432F" (".hero" :width (680) :padding (1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align center) :bgcolor "#FFFDF8" :text-align center)
(".eyebrow" :color "#8F432F" :face bold) (".eyebrow" :color "#8F432F" :font-weight bold)
(".metric" :flex-grow 1 :flex-shrink 1 :flex-basis (200) (".metric" :flex-grow 1 :flex-shrink 1 :flex-basis (200)
:min-width (180) :padding (1 (14)) :border "#6D8A73" :min-width (180) :padding (1 (14)) :border "#6D8A73"
:bgcolor "#DCEBDD" :text-align center) :bgcolor "#DCEBDD" :text-align center)
(".action" :flex-grow 1 :flex-shrink 1 :flex-basis (160) (".action" :flex-grow 1 :flex-shrink 1 :flex-basis (160)
:min-width (140) :padding (1 (12)) :border "#4E7890" :min-width (140) :padding (1 (12)) :border "#4E7890"
:bgcolor "#D9EAF2" :text-align center :face bold) :bgcolor "#D9EAF2" :text-align center :font-weight bold)
(".note" :width (680) :padding (1 (16)) :border "#8D887F" (".note" :width (680) :padding (1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2")) :color "#4D5651" :bgcolor "#EEEAE2"))
:setup :setup
@ -96,7 +96,7 @@
:name 'counter-status))) :name 'counter-status)))
(lambda () (lambda ()
(etaf-view (etaf-view
(box :layout 'column (column
(expr :value (etaf-counter-example--header title)) (expr :value (etaf-counter-example--header title))
(box :height 1) (box :height 1)
(expr :value (expr :value
@ -104,8 +104,9 @@
(box :height 1) (box :height 1)
(expr :value (etaf-counter-example--actions count)) (expr :value (etaf-counter-example--actions count))
(box :height 1) (box :height 1)
(text :class "note" (box :class "note"
"Public path: Event → Action → Ref → Computed → Runtime commit")))))) (text
"Public path: Event → Action → Ref → Computed → Runtime commit")))))))
;;;###autoload ;;;###autoload
(defun etaf-counter-example-view () (defun etaf-counter-example-view ()

76
examples/etaf-data-example.el
View File

@ -52,35 +52,35 @@
(status (plist-get task :status)) (status (plist-get task :status))
(host-ref (intern (format "data-task-%d" identity)))) (host-ref (intern (format "data-task-%d" identity))))
(etaf-view (etaf-view
(box :layout 'flex :width '(718) :flex-flow '(row nowrap) :gap '(0 (10)) (flex :width '(718) :flex-flow '(row nowrap) :gap '(0 (10))
:padding '(1 (12)) :border "#6D8A73" :padding '(1 (12)) :border "#6D8A73"
:bgcolor (if selected "#DCEBDD" "#FFFDF8") :bgcolor (if selected "#DCEBDD" "#FFFDF8")
:ref host-ref :role 'button :use (list (etaf-focusable)) :ref host-ref :role 'button :use (list (etaf-focusable))
:on-press (lambda () :on-press (lambda ()
(etaf-dispatch 'etaf-data-example-toggle (etaf-dispatch 'etaf-data-example-toggle
controller identity)) controller identity))
(text :width '(36) :face 'bold (box :width '(36) :font-weight 'bold
:color (if selected "#2F6B43" "#8D887F") :color (if selected "#2F6B43" "#8D887F")
(expr :value (if selected "●" "○"))) (text (expr :value (if selected "●" "○"))))
(text :flex-grow 1 :flex-shrink 1 :flex-basis '(390) (box :flex-grow 1 :flex-shrink 1 :flex-basis '(390)
:min-width '(280) :min-width '(280)
(expr :value (plist-get task :title))) (text (expr :value (plist-get task :title))))
(text :width '(96) :color "#66706A" (box :width '(96) :color "#66706A"
(expr :value (plist-get task :owner))) (text (expr :value (plist-get task :owner))))
(text :width '(84) :face 'bold :text-align 'right (box :width '(84) :font-weight 'bold :text-align 'right
:color (if (eq status 'done) "#2F6B43" "#9B4A34") :color (if (eq status 'done) "#2F6B43" "#9B4A34")
(expr :value (upcase (symbol-name status)))))))) (text (expr :value (upcase (symbol-name status)))))))))
(defun etaf-data-example--header (controller) (defun etaf-data-example--header (controller)
"Return the summary header for CONTROLLER." "Return the summary header for CONTROLLER."
(let ((total (etaf-value (etaf-data-total controller))) (let ((total (etaf-value (etaf-data-total controller)))
(selection (etaf-value (etaf-data-selection controller)))) (selection (etaf-value (etaf-data-selection controller))))
(etaf-view (etaf-view
(box :layout 'column :width '(720) :padding '(1 (18)) :border "#8F432F" (column :width '(720) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center :bgcolor "#FFFDF8" :text-align 'center
(text :color "#8F432F" :face 'bold (text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / DATA OWNERSHIP") "BEST PRACTICE / DATA OWNERSHIP")
(text :face 'bold "Task controller") (text :font-weight 'bold "Task controller")
(text :color "#66706A" (text :color "#66706A"
(expr :value (expr :value
(format "%d records · %d selected" total (format "%d records · %d selected" total
@ -91,17 +91,17 @@
"Return a filter LABEL for CONTROLLER using HOST-REF and QUERY. "Return a filter LABEL for CONTROLLER using HOST-REF and QUERY.
Use BORDER and BACKGROUND for its semantic color family." Use BORDER and BACKGROUND for its semantic color family."
(etaf-view (etaf-view
(text :padding '(1 (12)) :border border :bgcolor background (box :padding '(1 (12)) :border border :bgcolor background
:face 'bold :ref host-ref :role 'button :font-weight 'bold :ref host-ref :role 'button
:use (list (etaf-focusable)) :use (list (etaf-focusable))
:on-press (lambda () :on-press (lambda ()
(etaf-data-example--filter controller query)) (etaf-data-example--filter controller query))
(expr :value label)))) (text (expr :value label)))))
(defun etaf-data-example--toolbar (controller next-id) (defun etaf-data-example--toolbar (controller next-id)
"Return the action toolbar for CONTROLLER and NEXT-ID." "Return the action toolbar for CONTROLLER and NEXT-ID."
(etaf-view (etaf-view
(box :layout 'flex :width '(720) :flex-flow '(row wrap) :gap '(1 (10)) (flex :width '(720) :flex-flow '(row wrap) :gap '(1 (10))
(expr :value (etaf-data-example--filter-control (expr :value (etaf-data-example--filter-control
controller "ALL" 'data-filter-all nil controller "ALL" 'data-filter-all nil
"#4E7890" "#D9EAF2")) "#4E7890" "#D9EAF2"))
@ -111,13 +111,13 @@ Use BORDER and BACKGROUND for its semantic color family."
(expr :value (etaf-data-example--filter-control (expr :value (etaf-data-example--filter-control
controller "DONE" 'data-filter-done '(:status done) controller "DONE" 'data-filter-done '(:status done)
"#6D8A73" "#DCEBDD")) "#6D8A73" "#DCEBDD"))
(text :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1" (box :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1"
:face 'bold :ref 'data-add :role 'button :font-weight 'bold :ref 'data-add :role 'button
:use (list (etaf-focusable)) :use (list (etaf-focusable))
:on-press (lambda () :on-press (lambda ()
(etaf-dispatch 'etaf-data-example-add (etaf-dispatch 'etaf-data-example-add
controller next-id)) controller next-id))
"+ ADD TASK")))) (text "+ ADD TASK")))))
(defun etaf-data-example--rows (controller) (defun etaf-data-example--rows (controller)
"Return the loaded task rows for CONTROLLER." "Return the loaded task rows for CONTROLLER."
@ -127,24 +127,26 @@ Use BORDER and BACKGROUND for its semantic color family."
(etaf-data-example--row controller task)) (etaf-data-example--row controller task))
items) items)
(etaf-view (etaf-view
(text :width '(720) :padding '(2 (16)) (box :width '(720) :padding '(2 (16))
:border "#8D887F" :bgcolor "#EEEAE2" :border "#8D887F" :bgcolor "#EEEAE2"
:text-align 'center "No matching tasks."))))) :text-align 'center
(text "No matching tasks."))))))
(defun etaf-data-example--view (controller next-id) (defun etaf-data-example--view (controller next-id)
"Return the Data example View for CONTROLLER and NEXT-ID." "Return the Data example View for CONTROLLER and NEXT-ID."
(etaf-view (etaf-view
(box :layout 'column :width '(720) :color "#252A2E" :bgcolor "#F8F5EE" (column :width '(720) :color "#252A2E" :bgcolor "#F8F5EE"
(expr :value (etaf-data-example--header controller)) (expr :value (etaf-data-example--header controller))
(box :height 1) (box :height 1)
(expr :value (etaf-data-example--toolbar controller next-id)) (expr :value (etaf-data-example--toolbar controller next-id))
(box :height 1) (box :height 1)
(box :layout 'column :width '(720) (column :width '(720)
(expr :value (etaf-data-example--rows controller))) (expr :value (etaf-data-example--rows controller)))
(box :height 1) (box :height 1)
(text :width '(720) :padding '(1 (16)) :border "#8D887F" (box :width '(720) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2" :color "#4D5651" :bgcolor "#EEEAE2"
"Owner rule: create in setup, mutate through Data, stop on unmount")))) (text
"Owner rule: create in setup, mutate through Data, stop on unmount")))))
(etaf-define-component etaf-data-example-app () (etaf-define-component etaf-data-example-app ()
"Render a memory-backed task application with owned cleanup." "Render a memory-backed task application with owned cleanup."

53
examples/etaf-resource-example.el
View File

@ -25,11 +25,11 @@
(defun etaf-resource-example--header () (defun etaf-resource-example--header ()
"Return the Resource example header." "Return the Resource example header."
(etaf-view (etaf-view
(box :layout 'column :width '(680) :padding '(1 (18)) :border "#8F432F" (column :width '(680) :padding '(1 (18)) :border "#8F432F"
:bgcolor "#FFFDF8" :text-align 'center :bgcolor "#FFFDF8" :text-align 'center
(text :color "#8F432F" :face 'bold (text :color "#8F432F" :font-weight 'bold
"BEST PRACTICE / RESOURCE LIFECYCLE") "BEST PRACTICE / RESOURCE LIFECYCLE")
(text :face 'bold "Service health") (text :font-weight 'bold "Service health")
(text :color "#66706A" (text :color "#66706A"
"Loader errors become explicit state; cleanup stays scoped.")))) "Loader errors become explicit state; cleanup stays scoped."))))
@ -41,9 +41,9 @@
(border (if success "#6D8A73" "#C97252")) (border (if success "#6D8A73" "#C97252"))
(ink (if success "#24422D" "#6B3020"))) (ink (if success "#24422D" "#6B3020")))
(etaf-view (etaf-view
(box :layout 'column :width '(680) :padding '(2 (18)) :border border (column :width '(680) :padding '(2 (18)) :border border
:bgcolor surface :color ink :text-align 'center :bgcolor surface :color ink :text-align 'center
(text :face 'bold (text :font-weight 'bold
(expr :value (upcase (symbol-name status)))) (expr :value (upcase (symbol-name status))))
(text (expr :value (etaf-resource-example--message resource))) (text (expr :value (etaf-resource-example--message resource)))
(text :color "#66706A" (text :color "#66706A"
@ -53,28 +53,28 @@
(defun etaf-resource-example--actions (resource fail-next) (defun etaf-resource-example--actions (resource fail-next)
"Return action controls for RESOURCE and FAIL-NEXT." "Return action controls for RESOURCE and FAIL-NEXT."
(etaf-view (etaf-view
(box :layout 'flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12))
(text :flex-grow 1 :flex-shrink 1 :flex-basis '(200) (box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12)) :min-width '(180) :padding '(1 (12))
:border "#4E7890" :bgcolor "#D9EAF2" :face 'bold :border "#4E7890" :bgcolor "#D9EAF2" :font-weight 'bold
:text-align 'center :ref 'resource-reload :role 'button :text-align 'center :ref 'resource-reload :role 'button
:use (list (etaf-focusable)) :use (list (etaf-focusable))
:on-press (lambda () (etaf-resource-load resource)) :on-press (lambda () (etaf-resource-load resource))
"RELOAD") (text "RELOAD"))
(text :flex-grow 1 :flex-shrink 1 :flex-basis '(200) (box :flex-grow 1 :flex-shrink 1 :flex-basis '(200)
:min-width '(180) :padding '(1 (12)) :min-width '(180) :padding '(1 (12))
:border "#C97252" :bgcolor "#F1D4C9" :face 'bold :border "#C97252" :bgcolor "#F1D4C9" :font-weight 'bold
:text-align 'center :ref 'resource-fail :role 'button :text-align 'center :ref 'resource-fail :role 'button
:use (list (etaf-focusable)) :use (list (etaf-focusable))
:on-press (lambda () :on-press (lambda ()
(etaf-set-value fail-next t) (etaf-set-value fail-next t)
(etaf-resource-load resource)) (etaf-resource-load resource))
"SIMULATE FAILURE")))) (text "SIMULATE FAILURE")))))
(defun etaf-resource-example--view (resource fail-next cleanup-count) (defun etaf-resource-example--view (resource fail-next cleanup-count)
"Return the example View for RESOURCE, FAIL-NEXT, and CLEANUP-COUNT." "Return the example View for RESOURCE, FAIL-NEXT, and CLEANUP-COUNT."
(etaf-view (etaf-view
(box :layout 'column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE" (column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE"
(expr :value (etaf-resource-example--header)) (expr :value (etaf-resource-example--header))
(box :height 1) (box :height 1)
(expr :value (expr :value
@ -82,9 +82,10 @@
(box :height 1) (box :height 1)
(expr :value (etaf-resource-example--actions resource fail-next)) (expr :value (etaf-resource-example--actions resource fail-next))
(box :height 1) (box :height 1)
(text :width '(680) :padding '(1 (16)) :border "#8D887F" (box :width '(680) :padding '(1 (16)) :border "#8D887F"
:color "#4D5651" :bgcolor "#EEEAE2" :color "#4D5651" :bgcolor "#EEEAE2"
"Scope rule: reload releases the old value; unmount releases the last one")))) (text
"Scope rule: reload releases the old value; unmount releases the last one")))))
(etaf-define-component etaf-resource-example-app () (etaf-define-component etaf-resource-example-app ()
"Render a reloadable Resource with visible cleanup and error state." "Render a reloadable Resource with visible cleanup and error state."

359
tests/etaf-tests.el
View File

@ -55,12 +55,6 @@
(defvar etaf-test-nested-range-present nil) (defvar etaf-test-nested-range-present nil)
(defvar etaf-test-nested-range-source nil) (defvar etaf-test-nested-range-source nil)
(defvar etaf-test-nested-range-evals 0) (defvar etaf-test-nested-range-evals 0)
(defvar etaf-test-inline-a nil)
(defvar etaf-test-inline-b nil)
(defvar etaf-test-inline-a-evals 0)
(defvar etaf-test-inline-b-evals 0)
(defvar etaf-test-inline-component-renders 0)
(defvar etaf-test-inline-updated-count 0)
(defvar etaf-test-inline-shared nil) (defvar etaf-test-inline-shared nil)
(defvar etaf-test-inline-shared-evals 0) (defvar etaf-test-inline-shared-evals 0)
(defvar etaf-test-inline-branch-mode nil) (defvar etaf-test-inline-branch-mode nil)
@ -83,10 +77,6 @@
(defvar etaf-test-fragment-range-evals 0) (defvar etaf-test-fragment-range-evals 0)
(defvar etaf-test-fragment-owner-renders 0) (defvar etaf-test-fragment-owner-renders 0)
(defvar etaf-test-fragment-source nil) (defvar etaf-test-fragment-source nil)
(defvar etaf-test-raw-source nil)
(defvar etaf-test-raw-key-source nil)
(defvar etaf-test-raw-evals 0)
(defvar etaf-test-raw-owner-renders 0)
(defvar etaf-test-transparent-source nil) (defvar etaf-test-transparent-source nil)
(defvar etaf-test-transparent-renders 0) (defvar etaf-test-transparent-renders 0)
(defvar etaf-test-transparent-parent-renders 0) (defvar etaf-test-transparent-parent-renders 0)
@ -128,19 +118,12 @@
(pcase (etaf-value etaf-test-unsupported-range-source) (pcase (etaf-value etaf-test-unsupported-range-source)
('component ('component
(etaf--view-call 'etaf-test-badge (list :label "component") nil)) (etaf--view-call 'etaf-test-badge (list :label "component") nil))
('raw (etaf--raw-ebox-create
:thunk (lambda () (ebox-create :content "raw"))))
('deep-component ('deep-component
(etaf--view-call (etaf--view-call
'column (list :key 'outer) 'column (list :key 'outer)
(list (etaf--component-call-create (list (etaf--component-call-create
:spec etaf-test-badge--etaf-component-definition :spec etaf-test-badge--etaf-component-definition
:props (list :label "deep") :slots nil)))) :props (list :label "deep") :slots nil))))
('deep-raw
(etaf--view-call
'column (list :key 'outer)
(list (etaf--raw-ebox-create
:thunk (lambda () (ebox-create :content "deep-raw"))))))
('deep-expr-component ('deep-expr-component
(etaf--view-call (etaf--view-call
'column (list :key 'outer) 'column (list :key 'outer)
@ -383,23 +366,6 @@
:children (list (etaf--view-call 'text (list :key 'static) (list "S")) :children (list (etaf--view-call 'text (list :key 'static) (list "S"))
range))))) range)))))
(etaf-define-component etaf-test-inline-owner ()
"Render two independently reactive inline expression sites."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-inline-updated-count)))
(lambda ()
(cl-incf etaf-test-inline-component-renders)
(etaf-view
(text "A"
(expr :value
(progn (cl-incf etaf-test-inline-a-evals)
(etaf-value etaf-test-inline-a)))
"B"
(expr :value
(progn (cl-incf etaf-test-inline-b-evals)
(etaf-value etaf-test-inline-b))))))))
(etaf-define-component etaf-test-inline-shared-hosts () (etaf-define-component etaf-test-inline-shared-hosts ()
"Render one shared source in two distinct text Hosts." "Render one shared source in two distinct text Hosts."
:view :view
@ -544,18 +510,6 @@
(fragment (fragment
(expr :value (etaf-test--fragment-range-items))))))) (expr :value (etaf-test--fragment-range-items)))))))
(etaf-define-component etaf-test-raw-range-owner ()
"Own one material raw Ebox Range."
:setup
(lambda ()
(cl-incf etaf-test-raw-owner-renders)
(etaf-view
(column
(raw-ebox
:value (progn
(cl-incf etaf-test-raw-evals)
(ebox-create :content (etaf-value etaf-test-raw-source)))
:key (etaf-value etaf-test-raw-key-source))))))
(etaf-define-component etaf-test-transparent-owner () (etaf-define-component etaf-test-transparent-owner ()
"Render a transparent fragment sequence." "Render a transparent fragment sequence."
@ -698,15 +652,13 @@
(etaf-define-component etaf-test-inline-styled-owner () (etaf-define-component etaf-test-inline-styled-owner ()
"Render a styled inline expression beside a side-effecting Host prop." "Render a styled inline expression beside a side-effecting Host prop."
:view :view
(text :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red") (box :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red")
"P" "P"
(expr :value (text :font-weight 'bold
(progn (expr :value
(cl-incf etaf-test-inline-styled-evals) (progn
(etaf-view (cl-incf etaf-test-inline-styled-evals)
(text :face 'bold (etaf-value etaf-test-inline-styled-source))))))
(expr :value
(etaf-value etaf-test-inline-styled-source))))))))
(etaf-define-component etaf-test-range-input-priority (&key marker) (etaf-define-component etaf-test-range-input-priority (&key marker)
"Render fixed Range structure whose item reads MARKER and a reactive source." "Render fixed Range structure whose item reads MARKER and a reactive source."
@ -762,7 +714,7 @@
(etaf-define-component etaf-test-badge (&key label) (etaf-define-component etaf-test-badge (&key label)
"Render LABEL as a small semantic test Component." "Render LABEL as a small semantic test Component."
:view :view
(text :face 'bold (expr :value label))) (text :font-weight 'bold (expr :value label)))
(etaf-define-component etaf-list (&key label) (etaf-define-component etaf-list (&key label)
"Render LABEL using the collision-safe `list-view' alias." "Render LABEL using the collision-safe `list-view' alias."
@ -774,8 +726,8 @@
:view :view
(column (column
(text (expr :value title)) (text (expr :value title))
(slot :name 'header (text :face 'shadow "Default header")) (slot :name 'header (text :font-weight 'shadow "Default header"))
(slot (text :face 'shadow "Default body")))) (slot (text :font-weight 'shadow "Default body"))))
(etaf-define-component etaf-test-named-slot-consumer () (etaf-define-component etaf-test-named-slot-consumer ()
"Render the named header slot for forwarding tests." "Render the named header slot for forwarding tests."
@ -1218,7 +1170,7 @@
(ert-deftest etaf-view-property-region-precedes-children () (ert-deftest etaf-view-property-region-precedes-children ()
"Reject a property that appears after a structural child." "Reject a property that appears after a structural child."
(should-error (should-error
(macroexpand '(etaf-view (text "Hello" :face 'bold))) (macroexpand '(etaf-view (text "Hello" :font-weight 'bold)))
:type 'etaf-view-syntax-error)) :type 'etaf-view-syntax-error))
(ert-deftest etaf-view-ordinary-control-flow-belongs-in-expr () (ert-deftest etaf-view-ordinary-control-flow-belongs-in-expr ()
@ -1229,16 +1181,16 @@
(ert-deftest etaf-view-quote-is-not-needed-for-structure () (ert-deftest etaf-view-quote-is-not-needed-for-structure ()
"Construct an unquoted structural View and preserve quoted data values." "Construct an unquoted structural View and preserve quoted data values."
(let ((view (etaf-view (text :face 'bold "Hello")))) (let ((view (etaf-view (text :font-weight 'bold "Hello"))))
(should (etaf--view-node-p view)) (should (etaf--view-node-p view))
(should (equal 'bold (plist-get (etaf--view-node-props view) :face))) (should (equal 'bold (plist-get (etaf--view-node-props view) :font-weight)))
(should (equal "Hello" (etaf-test--render-text view))))) (should (equal "Hello" (etaf-test--render-text view)))))
(ert-deftest etaf-view-attribute-values-are-ordinary-elisp () (ert-deftest etaf-view-attribute-values-are-ordinary-elisp ()
"Evaluate an attribute expression without an extra evaluation wrapper." "Evaluate an attribute expression without an extra evaluation wrapper."
(let ((face 'bold) (let ((face 'bold)
(label "Ready")) (label "Ready"))
(let ((view (etaf-view (text :face face (expr :value label))))) (let ((view (etaf-view (text :font-weight face (expr :value label)))))
(should (equal "Ready" (etaf-test--render-text view)))))) (should (equal "Ready" (etaf-test--render-text view))))))
(ert-deftest etaf-view-expr-evaluates-control-flow () (ert-deftest etaf-view-expr-evaluates-control-flow ()
@ -1318,18 +1270,18 @@
(etaf-test--render-text (etaf-test--render-text
(etaf-view (column (text "A") (text "B"))))))) (etaf-view (column (text "A") (text "B")))))))
(ert-deftest etaf-view-box-lowers-outer-and-layout-to-ebox () (ert-deftest etaf-view-box-forms-lower-outer-and-layout-to-ebox ()
"Lower canonical Box axes through Ebox's public Box DSL." "Lower each Box form to one typed Box with its selected Layout."
(let ((row (let ((row
(etaf-render (etaf-render
(etaf-view (etaf-view
(box :outer 'inline :layout 'row (row :outer 'inline
(text "A") (text "A")
(text "B"))))) (text "B")))))
(column (column
(etaf-render (etaf-render
(etaf-view (etaf-view
(box :outer 'block :layout 'column (column :outer 'block
(text "A") (text "A")
(text "B")))))) (text "B"))))))
(should (equal (ebox--computed-display row) '(inline row))) (should (equal (ebox--computed-display row) '(inline row)))
@ -1352,7 +1304,7 @@
(etaf-mount (etaf-mount
buffer-name buffer-name
(etaf-view (etaf-view
(box :layout 'row (row
(text (expr :value (etaf-value source))) (text (expr :value (etaf-value source)))
(text "B")))) (text "B"))))
(should (string-match-p "AB" (etaf-test--buffer-text buffer-name))) (should (string-match-p "AB" (etaf-test--buffer-text buffer-name)))
@ -1371,7 +1323,9 @@
:grid-template-columns '((20) (20)) :grid-template-columns '((20) (20))
(text "A") (text "A")
(text "B")))))) (text "B"))))))
(should (eq (plist-get node :ebox-type) 'grid)) (should (ebox-box-node-p node))
(should (eq (ebox-layout-config-kind (ebox-box-node-layout node))
'grid))
(should (string-match-p "A" (substring-no-properties (ebox-render node)))) (should (string-match-p "A" (substring-no-properties (ebox-render node))))
(should (string-match-p "B" (substring-no-properties (ebox-render node)))))) (should (string-match-p "B" (substring-no-properties (ebox-render node))))))
@ -1475,43 +1429,50 @@
(ert-deftest etaf-styles-have-root-class-and-inline-precedence () (ert-deftest etaf-styles-have-root-class-and-inline-precedence ()
"Apply component styles only at matching scope and preserve inline props." "Apply component styles only at matching scope and preserve inline props."
(let* ((node (etaf-render (etaf-view (etaf-test-styled-card)))) (let* ((node (etaf-render (etaf-view (etaf-test-styled-card))))
(content-node (plist-get node :ebox-content-node)) (children (ebox-box-node-children node))
(children (plist-get content-node :children))
(title (car children)) (title (car children))
(body (cadr children))) (body (cadr children)))
(should (equal "inline-title" (ebox-get title :color))) (should (equal "inline-title"
(should (equal "title-bg" (ebox-get title :bgcolor))) (ebox-style-node-specified-value title :color)))
(should (equal "style-root" (ebox-get node :color))) (should (equal "title-bg"
(should-not (ebox-get body :color)))) (ebox-style-node-specified-value title :bgcolor)))
(should (equal "style-root"
(ebox-style-node-specified-value node :color)))
(should-not (ebox-style-node-specified-value body :color))))
(ert-deftest etaf-nil-host-props-allow-component-styles () (ert-deftest etaf-nil-host-props-allow-component-styles ()
"Treat an explicit nil Host style property as unspecified." "Treat an explicit nil Host style property as unspecified."
(let ((node (etaf-render (etaf-view (etaf-test-nil-style-host))))) (let ((node (etaf-render (etaf-view (etaf-test-nil-style-host)))))
(should (equal "style-color" (ebox-get node :color))))) (should (equal "style-color"
(ebox-style-node-specified-value node :color)))))
(ert-deftest etaf-style-rules-preserve-first-default-with-inline-protection () (ert-deftest etaf-style-rules-preserve-first-default-with-inline-protection ()
"Keep the first matching Component default without overriding inline props." "Keep the first matching Component default without overriding inline props."
(let ((node (etaf-render (etaf-view (etaf-test-style-rule-order))))) (let ((node (etaf-render (etaf-view (etaf-test-style-rule-order)))))
(should (equal "base-color" (ebox-get node :color)))) (should (equal "base-color"
(ebox-style-node-specified-value node :color))))
(let ((node (etaf-render (let ((node (etaf-render
(etaf-view (etaf-view
(etaf-test-style-rule-order :color "inline-color"))))) (etaf-test-style-rule-order :color "inline-color")))))
(should (equal "inline-color" (ebox-get node :color))))) (should (equal "inline-color"
(ebox-style-node-specified-value node :color)))))
(ert-deftest etaf-styles-stop-at-nested-component-boundaries () (ert-deftest etaf-styles-stop-at-nested-component-boundaries ()
"Keep a parent Component selector outside nested Component internals." "Keep a parent Component selector outside nested Component internals."
(let ((node (etaf-render (etaf-view (etaf-test-styled-parent))))) (let ((node (etaf-render (etaf-view (etaf-test-styled-parent)))))
(should-not (ebox-get node :color)))) (should-not (ebox-style-node-specified-value node :color))))
(ert-deftest etaf-styles-follow-caller-owned-slot-content () (ert-deftest etaf-styles-follow-caller-owned-slot-content ()
"Keep caller styles on slot content projected by a child Component." "Keep caller styles on slot content projected by a child Component."
(let ((node (etaf-render (etaf-view (etaf-test-styled-slot-parent))))) (let ((node (etaf-render (etaf-view (etaf-test-styled-slot-parent)))))
(should (equal "parent-color" (ebox-get node :color))))) (should (equal "parent-color"
(ebox-style-node-specified-value node :color)))))
(ert-deftest etaf-styles-keep-child-owned-slot-fallback-pure () (ert-deftest etaf-styles-keep-child-owned-slot-fallback-pure ()
"Keep child styles on fallback content authored by that Component." "Keep child styles on fallback content authored by that Component."
(let ((node (etaf-render (etaf-view (etaf-test-styled-fallback-child))))) (let ((node (etaf-render (etaf-view (etaf-test-styled-fallback-child)))))
(should (equal "child-color" (ebox-get node :color))))) (should (equal "child-color"
(ebox-style-node-specified-value node :color)))))
(ert-deftest etaf-mounted-styles-keep-child-owned-slot-fallback () (ert-deftest etaf-mounted-styles-keep-child-owned-slot-fallback ()
"Keep child styles on fallback content through the Runtime path." "Keep child styles on fallback content through the Runtime path."
@ -1521,7 +1482,7 @@
(etaf-mount buffer-name (etaf-view (etaf-test-styled-fallback-child))) (etaf-mount buffer-name (etaf-view (etaf-test-styled-fallback-child)))
(should (should
(equal "child-color" (equal "child-color"
(ebox-get (ebox-style-node-specified-value
(etaf-runtime-root-node (etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name)) (etaf-runtime-for-buffer buffer-name))
:color)))) :color))))
@ -1538,7 +1499,7 @@
(etaf-mount buffer-name (etaf-view (etaf-test-styled-parent))) (etaf-mount buffer-name (etaf-view (etaf-test-styled-parent)))
(should (should
(null (null
(ebox-get (ebox-style-node-specified-value
(etaf-runtime-root-node (etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name)) (etaf-runtime-for-buffer buffer-name))
:color)))) :color))))
@ -1555,8 +1516,11 @@
(etaf-mount buffer-name (etaf-view (etaf-test-themed-text))) (etaf-mount buffer-name (etaf-view (etaf-test-themed-text)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name)) (let* ((runtime (etaf-runtime-for-buffer buffer-name))
(node (etaf-runtime-root-node runtime))) (node (etaf-runtime-root-node runtime)))
(should (equal "theme-color" (ebox-get node :color))) (should (equal "theme-color"
(should (equal "theme-bg" (ebox-get node :bgcolor))))) (ebox-style-node-specified-value node :color)))
(should (equal "theme-bg"
(ebox-style-node-specified-value
node :bgcolor)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime)) (etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name))) (when-let* ((buffer (get-buffer buffer-name)))
@ -1570,7 +1534,7 @@
(etaf-mount buffer-name (etaf-mount buffer-name
(etaf-view (etaf-test-themed-style-token))) (etaf-view (etaf-test-themed-style-token)))
(should (equal "token-color" (should (equal "token-color"
(ebox-get (ebox-style-node-specified-value
(etaf-runtime-root-node (etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name)) (etaf-runtime-for-buffer buffer-name))
:color)))) :color))))
@ -1679,21 +1643,23 @@
(plist-get (tp-paint-slot-spec value) :background) (plist-get (tp-paint-slot-spec value) :background)
value))) value)))
(let ((slot (let ((slot
(plist-get (ebox-host-node 'theme-atomic-panel) (ebox-style-node-specified-value
:bgcolor))) (ebox-host-node 'theme-atomic-panel) :bgcolor)))
(should (equal "#FFFFFF" (background slot))) (should (equal "#FFFFFF" (background slot)))
(etaf-dispatch-event runtime 'theme-atomic-toggle 'press) (etaf-dispatch-event runtime 'theme-atomic-toggle 'press)
(let ((semantic (let ((semantic
(plist-get (plist-get
(etaf-runtime-host-props-for (etaf-runtime-host-props-for
runtime 'theme-atomic-panel) runtime 'theme-atomic-panel)
:bgcolor)) :bgcolor)))
(backend (should (equal "#111111" (background semantic))))
(plist-get (ebox-host-node 'theme-atomic-panel) (with-current-buffer buffer-name
:bgcolor))) (should
(should (eq slot semantic)) (cl-some
(should (eq slot backend)) (lambda (entry)
(should (equal "#111111" (background slot)))) (equal "#111111"
(plist-get (cadr entry) :background)))
face-remapping-alist)))
(should (string-match-p (should (string-match-p
"Dark" (etaf-test--buffer-text buffer-name))))))) "Dark" (etaf-test--buffer-text buffer-name)))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
@ -1756,14 +1722,15 @@
(etaf-theme-resolve-palette '(:ink "red") 'sepia) (etaf-theme-resolve-palette '(:ink "red") 'sepia)
:type 'etaf-context-error)) :type 'etaf-context-error))
(ert-deftest etaf-text-supports-inline-propertized-runs () (ert-deftest etaf-box-composes-adjacent-styled-text-runs ()
"Lower nested text Hosts to one Ebox content surface with text properties." "Represent styled runs as sibling Text nodes, never a nested Text tree."
(let* ((node (etaf-render (let* ((node (etaf-render
(etaf-view (etaf-view
(text "Hello " (text :face 'bold "world") "!")))) (box "Hello " (text :font-weight 'bold "world") "!"))))
(content (ebox-get node :content))) (content (ebox-render node)))
(should (equal "Hello world!" (substring-no-properties content))) (should (equal "Hello world!" (substring-no-properties content)))
(should (eq 'bold (get-text-property 6 'face content))) (should (equal '(:weight bold)
(get-text-property 6 'face content)))
(should-not (get-text-property 0 'face content)))) (should-not (get-text-property 0 'face content))))
(ert-deftest etaf-runtime-retains-setup-and-reactively-commits () (ert-deftest etaf-runtime-retains-setup-and-reactively-commits ()
@ -2326,16 +2293,6 @@ Event composition is a Runtime contract, not a UI-library helper contract."
(should-not (etaf--runtime-range-owned-by-rendered-component-p (should-not (etaf--runtime-range-owned-by-rendered-component-p
runtime generation range)))) runtime generation range))))
(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 () (ert-deftest etaf-stateful-props-update-without-rerunning-setup ()
"Track a reactive root prop while retaining one Component setup Scope." "Track a reactive root prop while retaining one Component setup Scope."
@ -3474,8 +3431,8 @@ Event composition is a Runtime contract, not a UI-library helper contract."
(when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-direct-range-rejects-step4b-output-without-reownership () (ert-deftest etaf-runtime-direct-range-rejects-step4b-output-without-reownership ()
"Reject direct Component/raw output while retaining Range-only dependency." "Reject direct Component output while retaining Range-only dependency."
(dolist (unsupported '(component raw deep-component deep-raw (dolist (unsupported '(component deep-component
deep-expr-component)) deep-expr-component))
(let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported)) (let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported))
(etaf-test-unsupported-range-source (etaf-ref 'host))) (etaf-test-unsupported-range-source (etaf-ref 'host)))
@ -3605,120 +3562,9 @@ Event composition is a Runtime contract, not a UI-library helper contract."
(etaf-unmount runtime)) (etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-inline-effect-replaces-only-containing-host ()
"Update one inline site beside 500 unrelated Components with one Host commit."
(let* ((buffer-name " *etaf-inline-host-update-test*")
(etaf-test-inline-a (etaf-ref "0"))
(etaf-test-inline-b (etaf-ref "0"))
(etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0)
(etaf-test-inline-component-renders 0)
(etaf-test-inline-updated-count 0)
(etaf-test-retained-render-counts (make-hash-table :test #'eql))
(cells (cl-loop repeat 500 collect (etaf-ref 0)))
(host-replaces 0) (range-replaces 0) (commits 0)
(view
(etaf--view-call
'column nil
(cons (etaf--view-call 'etaf-test-inline-owner
(list :key 'owner) nil)
(cl-loop for cell in cells for index from 0
collect
(etaf--view-call
'etaf-test-retained-leaf
(list :key index :label index :cell cell) nil))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0
etaf-test-inline-component-renders 0
etaf-test-inline-updated-count 0)
(clrhash etaf-test-retained-render-counts)
(let ((old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-inline-a) "1")
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 etaf-test-inline-a-evals))
(should (zerop etaf-test-inline-b-evals))
(should (zerop etaf-test-inline-component-renders))
(should (zerop (hash-table-count etaf-test-retained-render-counts)))
(should (= 1 host-replaces))
(should (zerop range-replaces))
(should (= 1 commits))
(should (= 1 etaf-test-inline-updated-count))
(should (string-match-p "A1B0"
(etaf-test--buffer-text buffer-name)))
(let* ((generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-inline-a)))
(inline (etaf--generation-effect-semantic
generation effect-id))
(host-id (etaf--semantic-inline-range-parent-id inline))
(component-id
(etaf--pvec-get (etaf-generation-parent-table generation)
host-id))
(component
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
component-id)))
(should (eq 'inline
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))
(should (integerp host-id))
(should (etaf--semantic-component-p component))
(should (integerp (etaf--semantic-component-parent-id component)))
(should (= host-id
(etaf--pvec-get
(etaf-generation-parent-table generation)
(etaf--semantic-inline-range-semantic-id inline)))))))
(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-inline-effects-coalesce-per-host () (ert-deftest etaf-runtime-shared-inline-source-updates-distinct-text-hosts ()
"Coalesce two inline effects in one Host and split two distinct Hosts." "Publish two distinct Text hosts that read one shared source in one commit."
(let ((buffer-name " *etaf-inline-coalesce-test*")
(etaf-test-inline-a (etaf-ref "0"))
(etaf-test-inline-b (etaf-ref "0"))
(etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0)
(etaf-test-inline-updated-count 0)
(host-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-inline-owner)))
(setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0
etaf-test-inline-updated-count 0)
(let ((old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(etaf-runtime-event-begin runtime)
(setf (etaf-value etaf-test-inline-a) "1")
(setf (etaf-value etaf-test-inline-b) "2")
(etaf-runtime-event-end runtime))
(should (= 1 etaf-test-inline-a-evals))
(should (= 1 etaf-test-inline-b-evals))
(should (= 1 host-replaces))
(should (= 1 commits))
(should (= 1 etaf-test-inline-updated-count))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))
(let ((buffer-name " *etaf-inline-two-host-test*") (let ((buffer-name " *etaf-inline-two-host-test*")
(etaf-test-inline-shared (etaf-ref "0")) (etaf-test-inline-shared (etaf-ref "0"))
(etaf-test-inline-shared-evals 0) (etaf-test-inline-shared-evals 0)
@ -4110,71 +3956,6 @@ Event composition is a Runtime contract, not a UI-library helper contract."
(etaf-unmount runtime)) (etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-material-raw-ebox-is-one-opaque-range-owner ()
"Update raw value and key through one opaque Range effect."
(let ((buffer-name " *etaf-raw-range-test*")
(etaf-test-raw-source (etaf-ref "A"))
(etaf-test-raw-key-source (etaf-ref 'a))
(root-source (etaf-ref 0))
(range-replaces 0) (commits 0))
(setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(lambda ()
(etaf-value root-source)
(etaf--view-call 'etaf-test-raw-range-owner
(list :key 'owner) nil)))
(setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(etaf-runtime-event-begin runtime)
(setf (etaf-value etaf-test-raw-source) "B")
(setf (etaf-value etaf-test-raw-key-source) 'b)
(etaf-runtime-event-end runtime)))
(should (= 1 etaf-test-raw-evals))
(should (zerop etaf-test-raw-owner-renders))
(should (= 1 range-replaces))
(should (= 1 commits))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(setf (etaf-value root-source) 1)
(should (= 1 etaf-test-raw-evals))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-raw-source)))
(semantic (etaf--generation-effect-semantic
generation effect-id)))
(should (eq 'raw
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))
(should-not (etaf--semantic-host-p semantic))
(should (eq 'b
(plist-get (etaf--semantic-range-output-signature semantic)
:key)))
(let ((committed generation)
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected raw Range final accept failure"))))
(should-error
(setf (etaf-value etaf-test-raw-source) "C") :type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(should (string-match-p "C" (etaf-test--buffer-text buffer-name)))))
(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-root-effect-owns-one-semantic-root-range () (ert-deftest etaf-runtime-root-effect-owns-one-semantic-root-range ()
"Publish Root changes through one semantic Root Range and root replacement." "Publish Root changes through one semantic Root Range and root replacement."