diff --git a/docs/proposals/module-boundaries.en.md b/docs/proposals/module-boundaries.en.md index caefc5f..d1507c6 100644 --- a/docs/proposals/module-boundaries.en.md +++ b/docs/proposals/module-boundaries.en.md @@ -70,7 +70,11 @@ AuthorView ↓ parse / desugar / string normalization NormalizedView = Text | Box | Fragment | 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 │ ↓ Fragment projection preserves RangeAnchors │ CanonicalEboxInput = Forest + RangeAnchors @@ -78,8 +82,7 @@ Resolved candidate + computed properties │ LayoutPlan → GeometryPatch │ └─ paint impact - ↓ source-specific contribution adapter - (ETAF: etaf-theme-tp; standalone Ebox: ebox-surface-tp) + ↓ shared property projector TP ContributionPlan → PaintPatch 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 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 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, @@ -486,7 +504,6 @@ TextStyle = :font-family :font-size :font-weight :font-style :color :background-color :text-decoration-line :text-decoration-color :text-decoration-style - :wrap-mode (word | grapheme | none) BoxFrame = :outer @@ -495,6 +512,7 @@ BoxFrame = :box-sizing margin/padding shorthands and logical/physical longhands border shorthands and width/style/color longhands + :wrap-mode (word | char | kp | none) :overflow :visibility inherited standard text style source such as font/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 `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; 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`, `:padding`, `:border`, `:gap`, `:flex`, `:flex-flow`, `:grid-column`, and `:grid-row`. The canonical registry uses namespaced IDs such as `ebox/font-size` and @@ -677,7 +704,22 @@ CanonicalDeclaration { SelectorSubjectFact { classList id - semanticSourceHandle + sourceHandle +} + +StyleSourceFact { + sourceHandle + selectorSubjectFact + declarations + scopeHandle + provenance +} + +StyleEnvironment { + stylesheet + schemaSet + scopeIndex + computedCache } RuntimeMetadataFact { @@ -706,8 +748,10 @@ Normalization parses author input once and simultaneously produces immutable CanonicalDeclaration, SelectorSubjectFact, and RuntimeMetadataFact artifacts. `:class/:id` do not enter CSS declarations; SelectorSubjectFact constructs the ECSS subject directly before cascade. Selector and semantic projection share the same parsed source -value for `:id` rather than rereading the plist independently. ECSS cascade/inheritance -receives SelectorSubjectFact + declarations and produces immutable +value for `:id` rather than rereading the plist independently. ETAF Style Adapter and +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 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 @@ -787,16 +831,25 @@ complete chain, for example: `etaf-renderer`: - is the only ETAF → Ebox lowering adapter; -- converts the structure/geometry projection of ResolvedView into a - CanonicalEboxInput forest, RangeAnchors, and typed measurement/geometry properties; +- consumes computed/projection facts already produced by ETAF Style Adapter and turns + 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. +`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`: -- is the only adapter from ETAF/ECSS computed paint contributions to TP; -- produces ContributionPlan without measuring, laying out, or owning TP priority/commit - authority; -- does not call `etaf-renderer` geometry lowering for a paint-only candidate. +- is only the optional TP-palette to ETAF semantic Theme token/value adapter; +- does not produce ContributionPlan, participate in selector/cascade, or own paint + commit authority. Theme semantic tokens and inheritance belong to ETAF Context. TP does not own business meaning such as “dark theme.” @@ -806,6 +859,10 @@ meaning such as “dark theme.” Ebox owns: - 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 participation; - 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, and does not determine paint-contribution priority. -Author paint from the standalone Ebox DSL is projected by the `ebox-surface` TP adapter -into an inline ContributionPlan. It and ETAF's `etaf-theme-tp` are two source adapters -that consume the same public TP contribution contract. Neither puts paint-only -properties back into CanonicalEboxInput, nor owns TP priority, journal, or commit -authority. +ETAF Style Adapter and Ebox Standalone Style Adapter share the same pure property +projector. The former handles ETAF Theme/Component/state/inline provenance; the latter +handles standalone Ebox inline/stylesheet provenance. They never coexist on one surface, +never put paint-only properties back into CanonicalEboxInput, and never own TP priority, +journal, or commit authority. `ebox-build` exclusively owns parsing/desugaring author forms. `ebox-text-create` and `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. - Framework integrators use `ebox-text-create`, `ebox-box-create`, typed LayoutConfig, 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 a surface that loads the adapter accepts `:emacs-face`; otherwise normalization reports the unknown namespace/property precisely. @@ -928,11 +986,12 @@ etaf-playground ─────▶ ETAF + optional UI/SQLite ebox-playground ─────▶ Ebox only etaf-performance ────▶ public observation boundaries only -ETAF Renderer ───────▶ ECSS computed properties -Ebox style pipeline ─▶ ECSS computed-properties port +ETAF Style Adapter ──▶ ECSS + Ebox property registry/projector +Ebox Standalone Style Adapter ─▶ ECSS + same registry/projector +ETAF Renderer ───────▶ Ebox typed core port ETAF Runtime ───────▶ Ebox/TP transaction participants -etaf-theme-tp ───────▶ TP contribution contract -Ebox surface ────────▶ TP inline contribution + transaction participant +etaf-theme-tp ───────▶ ETAF semantic Theme values only +Ebox surface ────────▶ TP contribution + transaction participant ``` Reverse dependencies are forbidden: Ebox does not depend on ETAF; TP does not parse diff --git a/docs/proposals/module-boundaries.zh.md b/docs/proposals/module-boundaries.zh.md index 6c601e2..842cdfc 100644 --- a/docs/proposals/module-boundaries.zh.md +++ b/docs/proposals/module-boundaries.zh.md @@ -63,7 +63,11 @@ AuthorView ↓ parse / desugar / string normalization NormalizedView = Text | Box | Fragment | 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 │ ↓ Fragment projection preserves RangeAnchors │ CanonicalEboxInput = Forest + RangeAnchors @@ -71,8 +75,7 @@ Resolved candidate + computed properties │ LayoutPlan → GeometryPatch │ └─ paint impact - ↓ source-specific contribution adapter - (ETAF: etaf-theme-tp; standalone Ebox: ebox-surface-tp) + ↓ shared property projector TP ContributionPlan → PaintPatch 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 属性袋；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 ...)`。若运行时为了性能把 Text payload 融合进相邻 Box 存储，该优化只能发生在 canonical Text identity、 range 和 impact 已建立之后，并且必须可逆地保留这些事实；私有存储编码不能成为 @@ -439,7 +455,6 @@ TextStyle = :font-family :font-size :font-weight :font-style :color :background-color :text-decoration-line :text-decoration-color :text-decoration-style - :wrap-mode (word | grapheme | none) BoxFrame = :outer @@ -448,6 +463,7 @@ BoxFrame = :box-sizing margin/padding shorthands and logical/physical longhands border shorthands and width/style/color longhands + :wrap-mode (word | char | kp | none) :overflow :visibility inherited standard text style source such as font/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` -等价，因此保留为 Ebox namespace 的唯一公共名称，值限定为 `word`、`grapheme`、 -`none`。如果未来实现完整且语义一致的 CSS 属性，应以一次明确迁移替换它，而不是 +等价，因此保留为 Ebox namespace 的唯一公共名称，值限定为 `word`、`char`、`kp`、 +`none`。`char` 在实现中按完整字素簇断行，避免拆开组合字符；`kp` 使用 +Knuth–Plass 段落排版。如果未来实现完整且语义一致的 CSS 属性，应以一次明确迁移替换它，而不是 长期同时保留两套名称。 +`:wrap-mode` 只由 Box 作者声明，表示该 Box 内容的软换行策略；Text form 不接受 +它。计算阶段把 Box 的策略继承为 Text 测量输入，Text 负责执行断行，但不拥有第二 +条作者配置路径。`none` 只禁止自动软换行，显式换行仍保留；排版后的越界由独立的 +`:overflow` 决定，不能用 wrap 语义暗示裁剪或滚动。 + 标准 CSS shorthand 只有一套展开规则，例如 `:margin`、`:padding`、`:border`、 `:gap`、`:flex`、`:flex-flow`、`:grid-column` 和 `:grid-row`。canonical registry 使用 namespaced ID（例如 `ebox/font-size`、`ebox/background-color`）；作者只写 keyword， @@ -620,6 +642,21 @@ SelectorSubjectFact { sourceProvenance } +StyleSourceFact { + sourceHandle + selectorSubjectFact + declarations + scopeHandle + provenance +} + +StyleEnvironment { + stylesheet + schemaSet + scopeIndex + computedCache +} + RuntimeMetadataFact { propertyId value @@ -646,7 +683,9 @@ normalization 对 author input 只解析一次，并同时产生 immutable CanonicalDeclaration、SelectorSubjectFact 和 RuntimeMetadataFact。`:class/:id` 不 进入 CSS declarations；SelectorSubjectFact 在 cascade 前直接构造 ECSS subject。 `: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，只进入 RuntimeMetadataFact。这里的“一次 materialize”指每个阶段只生成一次自己的 immutable artifact，不是让同一对象跨阶段变异。 @@ -720,15 +759,23 @@ Elisp plist。调试与性能工具必须能显示完整链路，例如： `etaf-renderer`： - 是唯一 ETAF → Ebox 的 lowering adapter； -- 把 ResolvedView 的 structure/geometry projection 转换为 CanonicalEboxInput forest、 - RangeAnchors 和 typed measurement/geometry props； +- 消费 ETAF Style Adapter 已产生的 computed/projection facts，把 structure/geometry + projection 转换为 CanonicalEboxInput forest、RangeAnchors 与 typed Ebox facts； +- 不重新运行 selector/cascade，也不复制第二份 computed visual properties； - 不执行 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/ECSS computed paint contribution → TP 的唯一 adapter； -- 产生 ContributionPlan，不测量、不布局、不拥有 TP priority/commit authority； -- paint-only candidate 不调用 `etaf-renderer` 的 geometry lowering。 +- 只是可选的 TP palette → ETAF semantic Theme token/value adapter； +- 不生成 ContributionPlan，不参与 selector/cascade，也不拥有 paint 提交权限。 Theme 的语义 token 和继承属于 ETAF Context。TP 不拥有“暗色主题”等业务意义。 @@ -737,6 +784,9 @@ Theme 的语义 token 和继承属于 ETAF Context。TP 不拥有“暗色主题 Ebox 拥有： - 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； - typed TextNode/BoxNode constructor 及 canonical 属性 schema； - Text 测量、换行和行布局； @@ -747,10 +797,10 @@ Ebox 拥有： Ebox 不理解 Component、slot、Context、Action、Behavior、Data 或 Resource，也不 决定 paint contribution 的优先级。 -独立 Ebox DSL 的 author paint 由 `ebox-surface` 的 TP adapter 投影为 inline -ContributionPlan；它与 ETAF 的 `etaf-theme-tp` 是两条来源 adapter，共同消费 TP -公开 contribution contract。两者都不把 paint-only 属性塞回 CanonicalEboxInput， -也不拥有 TP priority、journal 或 commit authority。 +ETAF Style Adapter 与 Ebox Standalone Style Adapter 共用同一个纯 property projector； +前者处理 ETAF Theme/Component/state/inline provenance，后者处理独立 Ebox inline/ +stylesheet provenance。两者不在同一 surface 并存，不把 paint-only 属性塞回 +CanonicalEboxInput，也不拥有 TP priority、journal 或 commit authority。 `ebox-build` 独占作者 form 的 parse/desugar；`ebox-text-create` 与 `ebox-box-create` 接收已经求值的 canonical 参数，只验证 typed node invariant。 @@ -828,7 +878,8 @@ Playground 的 `.etaf` manifest 属于 Playground。未来通用 compiler 若存 Component、slot、expr 或 lifecycle。 - 框架集成者使用 `ebox-text-create`、`ebox-box-create`、typed LayoutConfig、 RangeAnchor 和 TP contribution contract；不重新拼 DSL、不传 shorthand、不运行 - 第二次 cascade。 + 第二次 cascade。typed constructor 只接收 opaque `sourceHandle`，不接收来源层 + `:class/:id/:key`。 - optional Emacs adapter 是显式 opt-in 的独立 schema namespace；只有加载 adapter 的 surface 才接受 `:emacs-face`，否则 normalization 精确报未知 namespace/property。 - `ebox--*`、`etaf--*`、`tp--*`、`:ebox-type`、`:node-id`、`:region-id`、Emacs @@ -846,11 +897,12 @@ etaf-playground ─────▶ ETAF + optional UI/SQLite ebox-playground ─────▶ Ebox only etaf-performance ────▶ public observation boundaries only -ETAF Renderer ───────▶ ECSS computed properties -Ebox style pipeline ─▶ ECSS computed-properties port +ETAF Style Adapter ──▶ ECSS + Ebox property registry/projector +Ebox Standalone Style Adapter ─▶ ECSS + same registry/projector +ETAF Renderer ───────▶ Ebox typed core port ETAF Runtime ───────▶ Ebox/TP transaction participants -etaf-theme-tp ───────▶ TP contribution contract -Ebox surface ────────▶ TP inline contribution + transaction participant +etaf-theme-tp ───────▶ ETAF semantic Theme values only +Ebox surface ────────▶ TP contribution + transaction participant ``` 禁止反向依赖：Ebox 不依赖 ETAF；TP 不解析 View；ECSS 不写 buffer；UI 不调用 diff --git a/etaf-compiler.el b/etaf-compiler.el index 15abdf5..c0e7676 100644 --- a/etaf-compiler.el +++ b/etaf-compiler.el @@ -79,7 +79,7 @@ (list (list :kind 'expr :path path :hole index :static-p nil) (append programs (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) (t (let* ((parts (etaf--parse-attributes-and-children (cdr form))) diff --git a/etaf-events.el b/etaf-events.el index 44d021d..3607594 100644 --- a/etaf-events.el +++ b/etaf-events.el @@ -163,13 +163,14 @@ RUNTIME is the mounted Runtime to activate, or nil for the current buffer." (let (candidates) (dolist (entry (etaf-runtime-host-props-entries runtime)) (let ((host-ref (car entry)) (props (cdr entry))) - (let ((tab-index (plist-get props :tab-index)) - (bounds (ebox-host-ref-bounds - (etaf-runtime-buffer runtime) host-ref))) - (when (and (numberp tab-index) (>= tab-index 0) - (not (plist-get props :disabled)) bounds) - (push (list tab-index (car bounds) (cdr bounds) host-ref) - candidates))))) + (let ((tab-index (plist-get props :tab-index))) + (when (and (numberp tab-index) (>= tab-index 0) + (not (plist-get props :disabled))) + (when-let* ((bounds + (ebox-host-ref-bounds + (etaf-runtime-buffer runtime) host-ref))) + (push (list tab-index (car bounds) (cdr bounds) host-ref) + candidates)))))) (sort candidates #'etaf--focus-candidate-before-p))) ;;;###autoload diff --git a/etaf-renderer.el b/etaf-renderer.el index 912c110..4033607 100644 --- a/etaf-renderer.el +++ b/etaf-renderer.el @@ -24,8 +24,6 @@ (declare-function etaf--runtime-render-child-range "etaf-runtime" (runtime expr path)) (declare-function etaf--runtime-render-fragment-range "etaf-runtime" (runtime fragment path)) -(declare-function etaf--runtime-render-raw-range - "etaf-runtime" (runtime raw path)) (declare-function etaf--runtime-render-slot-range "etaf-runtime" (runtime projection path)) (declare-function etaf--runtime-register-semantic-host @@ -158,6 +156,33 @@ not create another visual node category." :props props :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) "Apply known inherited Theme defaults to NODE without overriding props. 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))) (if (null defaults) node - (let ((props (copy-sequence - (etaf--resolve-property-plist - (etaf--view-node-props node))))) - (while defaults - (let ((key (pop defaults)) - (value (pop defaults))) - (when (and (etaf--theme-ebox-property-p key) - (not (plist-get props key))) - (setq props - (etaf--merge-property - props key (etaf-theme-token key value)))))) + (let* ((name (etaf--view-node-name node)) + (props (copy-sequence + (etaf--resolve-property-plist + (etaf--view-node-props node)))) + (template (etaf--theme-host-defaults defaults name))) + (while template + (let ((key (pop template)) + (value (pop template))) + (unless (plist-get props key) + (setq props (etaf--merge-property props key value))))) (etaf--view-node-create - :name (etaf--view-node-name node) + :name name :token (etaf--view-node-token node) :props props :children (etaf--view-node-children node)))))) @@ -286,56 +310,168 @@ the ordinary layout lowering path instead." (and (eq (etaf--view-node-name value) 'text) (cl-every #'etaf--inline-text-structural-p (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) - (cl-every #'etaf--inline-text-structural-p value)) + (cl-some #'etaf--inline-text-dynamic-p value)) (t nil))) (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)) (props (copy-sequence source-props)) - ebox-props surface-properties) + ebox-props) (while props (let ((key (pop props)) (value (pop props))) (cond - ((eq key :face) - (push 'face surface-properties) - (push value surface-properties)) - ((eq key :surface-properties) - (let ((tail value)) - (while tail - (push (pop tail) surface-properties) - (push (pop tail) surface-properties)))) + ((memq key '(:face :surface-properties)) + (signal 'etaf-renderer-error + (list (format + "%S is not a canonical ETAF property" key)))) ((eq key :content) (signal 'etaf-renderer-error (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) (eq key :styles)) nil) (t - (push key ebox-props) - (push value ebox-props))))) - (setq ebox-props (nreverse ebox-props) - surface-properties (nreverse surface-properties)) + ;; Component APIs pass optional properties as nil. At the resolved + ;; author boundary nil means "unspecified"; canonical Ebox defaults + ;; own the initial value and never receive a synthetic declaration. + (when value + (push key ebox-props) + (push value ebox-props)))))) + (setq ebox-props (nreverse ebox-props)) (setq ebox-props (etaf--merge-property - ebox-props :host-ref + ebox-props :source-handle (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)) +(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) "Flatten VALUE through transparent `expr' and sequence values." (cond ((null value) nil) ((or (stringp value) (etaf--view-node-p value) - (etaf--component-call-p value) (etaf--slot-projection-p value) - (etaf--raw-ebox-p value)) + (etaf--component-call-p value) (etaf--slot-projection-p value)) (list value)) ((etaf--expr-p 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--runtime-finish-semantic-host 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--render-node item item-path)) ((etaf--component-call-p item) @@ -446,21 +584,6 @@ the ordinary layout lowering path instead." (etaf--render-component-call-pure item item-path))) ((etaf--slot-projection-p item) (etaf--render-slot-projection item item-path)) - ((etaf--raw-ebox-p item) - (let ((node (funcall (etaf--raw-ebox-thunk item))) - (key (and (etaf--raw-ebox-key-thunk item) - (funcall (etaf--raw-ebox-key-thunk item))))) - (unless node - (signal 'etaf-renderer-error - (list "raw-ebox :value returned nil"))) - (unless (listp node) - (signal 'etaf-renderer-error - (list "raw-ebox :value must return an Ebox node"))) - (when key - (etaf--validate-key key) - (setq node (copy-sequence node)) - (plist-put node :key key)) - (list node))) (t (signal 'etaf-renderer-error (list (format "Unresolved View item: %S" item)))))))) @@ -489,7 +612,7 @@ the ordinary layout lowering path instead." (node (if (fboundp 'etaf--runtime-style-node) (etaf--runtime-style-node node path) node)) - (node (etaf--apply-theme-defaults node)) + (node (etaf--apply-theme-defaults node)) (name (etaf--view-node-name node)) (theme-result (etaf--resolve-theme-property-plist @@ -500,10 +623,6 @@ the ordinary layout lowering path instead." (props (etaf--ebox-properties raw-props path (etaf--view-node-token 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 ('text (let* ((semantic-id @@ -516,6 +635,7 @@ the ordinary layout lowering path instead." (child-path (append path (list :text))) (runtime-inline (and semantic-id + (etaf--inline-text-dynamic-p children) (etaf--inline-text-structural-p children) (etaf--runtime-render-inline-content 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))) (inline (if runtime-inline (cons t (car runtime-inline)) - (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))))) + (etaf--inline-text-content flat)))) (when semantic-id (etaf--runtime-finish-semantic-host etaf--render-runtime semantic-id (and (car inline) (cdr inline)) (and runtime-inline (cadr runtime-inline)))) (if (car inline) - (list (apply #'ebox-create :content (cdr inline) props)) - (list (ebox-build (append (list 'row) props rendered)))))) - ('spacer - (when children - (signal 'etaf-renderer-error - (list "spacer cannot have children"))) - (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))) + (list (etaf--ebox-text-node (cdr inline) props)) + (signal 'etaf-renderer-error + (list "Text payload must resolve to one string"))))) ('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) (index 0) (range-child-p nil) @@ -589,15 +692,6 @@ the ordinary layout lowering path instead." (setq range-child-p t) (cdr result)) (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-range-compatible-p child) @@ -609,7 +703,7 @@ the ordinary layout lowering path instead." (setq range-child-p t) (cdr result)) (etaf--render-value-list - child (append path (list index)))))))))) + child (append path (list index))))))))) (cl-incf index)) (when semantic-id (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) "Build layout NAME with Ebox PROPS around child NODES. RANGE-CHILD-P records that NODES include nonvisual Range segments." - (let ((node - (cond - ((eq name 'box) - (ebox-build (append (list 'box) 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))))))) + (unless (memq name '(box row column flex grid)) + (signal 'etaf-renderer-error + (list (format "Not a Box form: %S" name)))) + (let ((node (etaf--ebox-box-node name props nodes))) (when range-child-p (push node etaf--rendered-range-container-nodes)) node)) @@ -651,11 +730,11 @@ RANGE-CHILD-P records that NODES include nonvisual Range segments." RANGE-CHILD-P preserves the direct material Range parent." (pcase name ('text - (if children - (etaf--layout-node 'row props children range-child-p) - (apply #'ebox-create :content content props))) - ('spacer (apply #'ebox-spacer props)) - ((or 'box 'row 'column 'container 'stack 'flex 'grid) + (when children + (signal 'etaf-renderer-error + (list "Text cannot contain material child nodes"))) + (etaf--ebox-text-node content props)) + ((or 'box 'row 'column 'flex 'grid) (etaf--layout-node name props children range-child-p)) (_ (signal 'etaf-renderer-error (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. This pure entry supports stateless Components. Stateful Components require a -Runtime because their setup Scope must have a lifecycle owner." - (let ((nodes (etaf--render-value-list view '(root)))) - (cond - ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) - (t (apply #'ebox-column nodes))))) + Runtime because their setup Scope must have a lifecycle owner." + (etaf--ebox-forest-root + (etaf--render-value-list view '(root)) '(etaf-root pure))) ;;;###autoload (defun etaf-mount (buffer-or-name view &optional options) diff --git a/etaf-runtime.el b/etaf-runtime.el index 7f63bd1..5390b2e 100644 --- a/etaf-runtime.el +++ b/etaf-runtime.el @@ -27,6 +27,8 @@ "etaf-renderer" (props path &optional site-token)) (declare-function etaf--lower-resolved-semantic-host "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 "etaf-renderer" (props)) (declare-function etaf--apply-inline-surface-properties @@ -106,7 +108,7 @@ (cl-defstruct (etaf--semantic-root (:constructor etaf--semantic-root-create)) "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 (: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 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)) "One sparse immutable 32-way generation index node." children value) @@ -840,7 +880,7 @@ Component owner to absorb them." (pcase (etaf--generation-effect-kind effect) ('root 0) ('component-input 1) - ((or 'range 'fragment 'raw 'slot 'inline) 2) + ((or 'range 'fragment 'slot 'inline) 2) (_ 3))) (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." (intern (substring (symbol-name property) 4))) -(defun etaf--runtime-register-host (runtime props path &optional site-token) - "Register callback PROPS for the opaque Host reference in RUNTIME at PATH." +(defun etaf--runtime-register-host + (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)) - handlers) - ;; 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 props (etaf-runtime-candidate-host-props runtime)) - (while props - (let ((key (pop props)) - (value (pop props))) + (tail props) + semantic-p + handlers + old-semantic-p + old-handlers-p) + (while tail + (let ((key (pop tail)) + (value (pop tail))) + (when (and value (memq key etaf--semantic-props)) + (setq semantic-p t)) (when (and (keywordp key) (string-prefix-p ":on-" (symbol-name key)) (functionp value)) (push (cons (etaf--runtime-event-kind key) value) handlers)))) - (if handlers - (puthash host-ref handlers (etaf-runtime-candidate-handlers runtime)) - ;; A retained Host can keep its identity while losing its callback - ;; (for example a pagination button at the first/last page). Preserve - ;; a nil handler delta only when the committed generation had one; this - ;; shadows the old contribution without manufacturing entries for every - ;; non-interactive Host. - (when (etaf--generation-index-lookup - (etaf-runtime-current-generation runtime) 'handlers host-ref) - (puthash host-ref nil (etaf-runtime-candidate-handlers runtime)))))) + (when (etaf--semantic-host-p old-semantic) + (let ((old-props (etaf--semantic-host-base-props old-semantic))) + (while old-props + (let ((key (pop old-props)) + (value (pop old-props))) + (when (and value (memq key etaf--semantic-props)) + (setq old-semantic-p t)) + (when (and (keywordp key) + (string-prefix-p ":on-" (symbol-name key)) + (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) "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 :site site-token) (list 'host etaf--current-semantic-parent-id - :position (copy-tree path))))) + :position path)))) (semantic-id (etaf--runtime-semantic-id-for-identity runtime identity)) (old (and (etaf-runtime-current-generation runtime) @@ -1321,6 +1380,9 @@ receive an independent Host effect." (etaf-generation-semantic-nodes (etaf-runtime-current-generation runtime)) semantic-id))) + (_host-contributions + (etaf--runtime-register-host + runtime props path site-token old)) (effect-id (and (or theme-bindings property-bindings) (or (and (etaf--semantic-host-p old) @@ -1332,17 +1394,16 @@ receive an independent Host effect." :component-id etaf--current-component-semantic-id :host-ref (etaf--generated-host-ref props path site-token) :key key :name name :effect-id effect-id - :property-bindings (copy-sequence property-bindings) - :theme-bindings (copy-sequence theme-bindings) + :property-bindings property-bindings + :theme-bindings theme-bindings :deps (delete-dups - (append (copy-sequence property-deps) - (copy-sequence theme-deps))) - :context-deps (copy-tree property-context-deps) - :base-props (copy-tree base-props) + (append property-deps theme-deps)) + :context-deps property-context-deps + :base-props base-props :site-token site-token - :props-signature (copy-tree backend-props) - :path (copy-tree path) - :style-identity (copy-tree etaf--render-style-stack)))) + :props-signature backend-props + :path path + :style-identity etaf--render-style-stack))) (unless etaf--rendering-range-p (puthash identity semantic-id (etaf-runtime-candidate-identity-entries runtime))) @@ -1825,10 +1886,11 @@ need to know how Behavior attributes are merged." (etaf-runtime-candidate-graph-nodes runtime))))))) (let ((node (unless transparent-p - (cond - ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) - (t (apply #'ebox-column nodes)))))) + (etaf--ebox-forest-root + nodes + (list 'etaf-component-root + (copy-tree + (etaf--component-instance-identity instance))))))) (when node (let ((range-container-p (memq node etaf--rendered-range-container-nodes))) @@ -2160,9 +2222,11 @@ need to know how Behavior attributes are merged." runtime generation child-id)) (etaf--semantic-component-child-ids semantic)))) (let ((node - (cond ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) - (t (apply #'ebox-column nodes))))) + (etaf--ebox-forest-root + nodes + (list 'etaf-component-root + (copy-tree + (etaf--semantic-component-identity semantic)))))) (if (eq (etaf--semantic-component-publication-kind semantic) 'transparent) node @@ -2532,82 +2596,6 @@ need to know how Behavior attributes are merged." :thunk (lambda () (etaf--view-node-children 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) "Lower material-child PROJECTION at PATH in RUNTIME as a retained slot Range." (let* ((name (etaf--slot-projection-name projection)) @@ -2895,9 +2883,8 @@ The candidate uses resolved VALUE, DEPS, and NODES." (setq queue (nconc queue (copy-sequence - (etaf--pvec-get - (etaf-generation-children-table generation) - semantic-id)))))) + (etaf--generation-child-ids + generation semantic-id)))))) (nreverse result))) (defun etaf--runtime-inline-value-string (value surface) @@ -2943,7 +2930,8 @@ The candidate uses resolved VALUE, DEPS, and NODES." (candidate (and old-id (gethash old-id (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)) (cl-incf (etaf-runtime-next-effect-id runtime))))) (puthash identity semantic-id @@ -2952,12 +2940,13 @@ The candidate uses resolved VALUE, DEPS, and NODES." (if candidate (cons semantic-id (etaf--semantic-inline-range-output candidate)) (if (and old (not etaf--rendering-component-effect-p) - (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 semantic-id (etaf--semantic-inline-range-output old))) - (let (deps context-deps output) + (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 semantic-id (etaf--semantic-inline-range-output old))) + (let (deps context-deps output) (let ((etaf--runtime-dependency-collector (lambda (source) (cl-pushnew source deps :test #'eq))) (etaf--context-inject-recorder @@ -2995,9 +2984,9 @@ The candidate uses resolved VALUE, DEPS, and NODES." (when-let* ((component-id (etaf--semantic-inline-range-component-id old)) (component - (etaf--pvec-get - (etaf-generation-semantic-nodes generation) - component-id))) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + component-id))) (cl-pushnew (etaf--semantic-component-identity component) (etaf-runtime-candidate-updated-component-identities runtime) @@ -3242,7 +3231,6 @@ Generation, including its effects and Host contributions." (let ((candidate-children (etaf-runtime-candidate-graph-children runtime)) (candidate-nodes (etaf-runtime-candidate-graph-nodes runtime)) - (base-children (etaf-generation-children-table base)) (candidate-attached (make-hash-table :test #'eql))) (maphash (lambda (_parent-id children) @@ -3260,11 +3248,13 @@ Generation, including its effects and Host contributions." semantic-id (etaf-runtime-candidate-removed-semantic-ids runtime) :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))))) (maphash (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) (record-detached old-child-id)))) candidate-children)) @@ -3297,15 +3287,13 @@ Generation, including its effects and Host contributions." (source-effects (and (not full-p) (etaf-generation-source-effects base))) (effect-sources (and (not full-p) (etaf-generation-effect-sources 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) (etaf-generation-identity-index base) (make-hash-table :test #'equal))) (identity-copy nil) (affected-sources (make-hash-table :test #'eq)) deltas - node-updates parent-updates children-updates resource-updates) + node-updates resource-updates) (cl-labels ((install-effect (effect old-deps new-deps) @@ -3386,18 +3374,11 @@ Generation, including its effects and Host contributions." (setf (etaf--semantic-component-artifact-key semantic) (cons generation-id effect-id))) (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 identity-copy (setq identity-index (copy-hash-table identity-index) identity-copy t)) - (puthash (copy-tree identity) semantic-id identity-index)) + (puthash identity semantic-id identity-index)) (unless (and (not full-p) (etaf--pvec-get resources resource-id)) (push (cons resource-id @@ -3405,28 +3386,9 @@ Generation, including its effects and Host contributions." resource-updates)))) (etaf-runtime-candidate-semantic-nodes runtime)) (maphash - (lambda (semantic-id semantic) + (lambda (semantic-id semantic) (unless (etaf--semantic-component-p semantic) - (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)))) + (push (cons semantic-id semantic) node-updates))) (etaf-runtime-candidate-graph-nodes runtime)) (maphash (lambda (identity _state) @@ -3467,16 +3429,14 @@ Generation, including its effects and Host contributions." (cl-pushnew host-ref (etaf-runtime-candidate-removed-host-refs runtime) :test #'equal))))) - (push (cons semantic-id nil) node-updates) - (push (cons semantic-id nil) parent-updates) - (push (cons semantic-id nil) children-updates)) + (push (cons semantic-id nil) node-updates)) (maphash (lambda (identity semantic-id) (unless (gethash identity identity-index) (unless identity-copy (setq identity-index (copy-hash-table identity-index) identity-copy t)) - (puthash (copy-tree identity) semantic-id identity-index))) + (puthash identity semantic-id identity-index))) (etaf-runtime-candidate-identity-entries runtime)) (maphash (lambda (effect-id effect) @@ -3494,17 +3454,17 @@ Generation, including its effects and Host contributions." (etaf--pvec-get (etaf-generation-effect-sources base) effect-id))) (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 :semantic-id 0 :effect-id effect-id :input-signature (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 - (copy-sequence - (gethash 0 - (etaf-runtime-candidate-graph-children runtime)))) - children-updates) (install-effect (etaf--generation-effect-create :effect-id effect-id :kind 'root @@ -3515,10 +3475,6 @@ Generation, including its effects and Host contributions." ;; vector spines changes. (setq nodes (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 (etaf--pvec-put-many resources resource-updates metrics)) (maphash @@ -3543,8 +3499,8 @@ Generation, including its effects and Host contributions." :effect-map effect-map :source-effects source-effects :effect-sources effect-sources - :parent-table parent-index - :children-table children-index + :parent-table nil + :children-table nil :resource-membership resources :identity-index identity-index :indexes (etaf--runtime-build-contribution-indexes @@ -4412,39 +4368,6 @@ Generation, including its effects and Host contributions." nodes (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) "Record RANGE's lexical Component lifecycle participation in RUNTIME." (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) (while (and semantic-id (not owner)) (setq semantic-id - (etaf--pvec-get (etaf-generation-parent-table generation) - semantic-id)) + (etaf--generation-parent-id generation semantic-id)) (when semantic-id (let ((semantic (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 runtime old effect-id) (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 runtime old base-semantic)) (pcase (etaf--generation-effect-kind effect) @@ -4754,10 +4676,6 @@ RENDERED-IDENTITIES names the Component render participants." (push (etaf--runtime-render-dirty-range runtime effect semantic) range-changes)) - ('raw - (push (etaf--runtime-render-dirty-raw-range - runtime effect semantic) - range-changes)) ('slot (push (etaf--runtime-render-dirty-slot-range runtime effect semantic) @@ -5001,10 +4919,10 @@ RENDERED-IDENTITIES names the Component render participants." (etaf--runtime-stage-root-range runtime (etaf-runtime-candidate-root-deps runtime)) (setq next-root - (cond - ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) - (t (apply #'ebox-column nodes)))) + (etaf--ebox-forest-root + nodes + (list 'etaf-runtime-root + (etaf-runtime-mount-epoch runtime)))) (setq candidate-generation (etaf--runtime-build-generation runtime old-generation) resource-journal (etaf--runtime-preinstall-resources diff --git a/etaf-view.el b/etaf-view.el index ae6c334..d98559c 100644 --- a/etaf-view.el +++ b/etaf-view.el @@ -65,15 +65,8 @@ token 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 - '(text box fragment container row column stack flex grid spacer) + '(text box fragment row column flex grid) "Minimal unstyled Hosts implemented by ETAF core. 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))) ((and (consp form) (eq (car form) 'slot)) (etaf--compile-slot-form (cdr form) slot-mode)) - ((and (consp form) (eq (car form) 'raw-ebox)) - (etaf--compile-view-form form slot-mode)) ((and (consp form) (symbolp (car form))) (when (etaf--ordinary-expression-head-p (car form)) (etaf--syntax-error @@ -394,24 +385,6 @@ SLOT-MODE distinguishes Component-owned projections from call-site inputs." ;; the Component definition macro, so the public macro defaults to ;; projection mode. An unowned projection simply uses its fallback. (etaf--compile-slot-form (cdr form) slot-mode)) - ((eq (car form) 'raw-ebox) - (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 (let* ((parts (etaf--parse-attributes-and-children (cdr form))) (props (car parts)) @@ -496,6 +469,9 @@ ordinary Elisp expressions. `expr' is the only computation bridge in the (mapcar #'etaf--normalize-structural-child children)))) (cond ((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) (etaf--validate-key (etaf--resolve-property-value (plist-get props :key)))) diff --git a/examples/etaf-counter-example.el b/examples/etaf-counter-example.el index b8f6608..6215d2e 100644 --- a/examples/etaf-counter-example.el +++ b/examples/etaf-counter-example.el @@ -28,37 +28,37 @@ (defun etaf-counter-example--header (title) "Return the counter header for TITLE." (etaf-view - (box :layout 'column :class "hero" + (column :class "hero" (text :class "eyebrow" "BEST PRACTICE / RETAINED STATE") - (text :face 'bold (expr :value title)) + (text :font-weight 'bold (expr :value title)) (text :color "#66706A" "State belongs to setup; rendering only reads it.")))) (defun etaf-counter-example--metrics (count double status) "Return metric cards for COUNT, DOUBLE, and STATUS." (etaf-view - (box :layout 'flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) - (text :class "metric" - (expr :value (format "COUNT %d" (etaf-value count)))) - (text :class "metric" - (expr :value (format "DOUBLE %d" (etaf-value double)))) - (text :class "metric" - (expr :value (format "STATE %s" (etaf-value status))))))) + (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) + (box :class "metric" + (text (expr :value (format "COUNT %d" (etaf-value count))))) + (box :class "metric" + (text (expr :value (format "DOUBLE %d" (etaf-value double))))) + (box :class "metric" + (text (expr :value (format "STATE %s" (etaf-value status)))))))) (defun etaf-counter-example--action (count label host-ref operation) "Return one COUNT action named LABEL using HOST-REF and OPERATION." (etaf-view - (text :class "action" :ref host-ref :role 'button + (box :class "action" :ref host-ref :role 'button :use (list (etaf-focusable)) :on-press (lambda () (etaf-dispatch 'etaf-counter-example-update count operation)) - (expr :value label)))) + (text (expr :value label))))) (defun etaf-counter-example--actions (count) "Return the action group for COUNT." (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 (etaf-counter-example--action count "− DECREMENT" 'counter-decrement 'decrement)) @@ -76,13 +76,13 @@ ("&" :width (680) :color "#252A2E" :bgcolor "#F8F5EE") (".hero" :width (680) :padding (1 (18)) :border "#8F432F" :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) :min-width (180) :padding (1 (14)) :border "#6D8A73" :bgcolor "#DCEBDD" :text-align center) (".action" :flex-grow 1 :flex-shrink 1 :flex-basis (160) :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" :color "#4D5651" :bgcolor "#EEEAE2")) :setup @@ -96,7 +96,7 @@ :name 'counter-status))) (lambda () (etaf-view - (box :layout 'column + (column (expr :value (etaf-counter-example--header title)) (box :height 1) (expr :value @@ -104,8 +104,9 @@ (box :height 1) (expr :value (etaf-counter-example--actions count)) (box :height 1) - (text :class "note" - "Public path: Event → Action → Ref → Computed → Runtime commit")))))) + (box :class "note" + (text + "Public path: Event → Action → Ref → Computed → Runtime commit"))))))) ;;;###autoload (defun etaf-counter-example-view () diff --git a/examples/etaf-data-example.el b/examples/etaf-data-example.el index 689d6c4..89f55ef 100644 --- a/examples/etaf-data-example.el +++ b/examples/etaf-data-example.el @@ -52,35 +52,35 @@ (status (plist-get task :status)) (host-ref (intern (format "data-task-%d" identity)))) (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" :bgcolor (if selected "#DCEBDD" "#FFFDF8") :ref host-ref :role 'button :use (list (etaf-focusable)) :on-press (lambda () (etaf-dispatch 'etaf-data-example-toggle controller identity)) - (text :width '(36) :face 'bold - :color (if selected "#2F6B43" "#8D887F") - (expr :value (if selected "●" "○"))) - (text :flex-grow 1 :flex-shrink 1 :flex-basis '(390) - :min-width '(280) - (expr :value (plist-get task :title))) - (text :width '(96) :color "#66706A" - (expr :value (plist-get task :owner))) - (text :width '(84) :face 'bold :text-align 'right - :color (if (eq status 'done) "#2F6B43" "#9B4A34") - (expr :value (upcase (symbol-name status)))))))) + (box :width '(36) :font-weight 'bold + :color (if selected "#2F6B43" "#8D887F") + (text (expr :value (if selected "●" "○")))) + (box :flex-grow 1 :flex-shrink 1 :flex-basis '(390) + :min-width '(280) + (text (expr :value (plist-get task :title)))) + (box :width '(96) :color "#66706A" + (text (expr :value (plist-get task :owner)))) + (box :width '(84) :font-weight 'bold :text-align 'right + :color (if (eq status 'done) "#2F6B43" "#9B4A34") + (text (expr :value (upcase (symbol-name status))))))))) (defun etaf-data-example--header (controller) "Return the summary header for CONTROLLER." (let ((total (etaf-value (etaf-data-total controller))) (selection (etaf-value (etaf-data-selection controller)))) (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 - (text :color "#8F432F" :face 'bold + (text :color "#8F432F" :font-weight 'bold "BEST PRACTICE / DATA OWNERSHIP") - (text :face 'bold "Task controller") + (text :font-weight 'bold "Task controller") (text :color "#66706A" (expr :value (format "%d records · %d selected" total @@ -91,17 +91,17 @@ "Return a filter LABEL for CONTROLLER using HOST-REF and QUERY. Use BORDER and BACKGROUND for its semantic color family." (etaf-view - (text :padding '(1 (12)) :border border :bgcolor background - :face 'bold :ref host-ref :role 'button - :use (list (etaf-focusable)) - :on-press (lambda () - (etaf-data-example--filter controller query)) - (expr :value label)))) + (box :padding '(1 (12)) :border border :bgcolor background + :font-weight 'bold :ref host-ref :role 'button + :use (list (etaf-focusable)) + :on-press (lambda () + (etaf-data-example--filter controller query)) + (text (expr :value label))))) (defun etaf-data-example--toolbar (controller next-id) "Return the action toolbar for CONTROLLER and NEXT-ID." (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 controller "ALL" 'data-filter-all nil "#4E7890" "#D9EAF2")) @@ -111,13 +111,13 @@ Use BORDER and BACKGROUND for its semantic color family." (expr :value (etaf-data-example--filter-control controller "DONE" 'data-filter-done '(:status done) "#6D8A73" "#DCEBDD")) - (text :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1" - :face 'bold :ref 'data-add :role 'button - :use (list (etaf-focusable)) - :on-press (lambda () - (etaf-dispatch 'etaf-data-example-add - controller next-id)) - "+ ADD TASK")))) + (box :padding '(1 (12)) :border "#7A6B95" :bgcolor "#E7E2F1" + :font-weight 'bold :ref 'data-add :role 'button + :use (list (etaf-focusable)) + :on-press (lambda () + (etaf-dispatch 'etaf-data-example-add + controller next-id)) + (text "+ ADD TASK"))))) (defun etaf-data-example--rows (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)) items) (etaf-view - (text :width '(720) :padding '(2 (16)) - :border "#8D887F" :bgcolor "#EEEAE2" - :text-align 'center "No matching tasks."))))) + (box :width '(720) :padding '(2 (16)) + :border "#8D887F" :bgcolor "#EEEAE2" + :text-align 'center + (text "No matching tasks.")))))) (defun etaf-data-example--view (controller next-id) "Return the Data example View for CONTROLLER and NEXT-ID." (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)) (box :height 1) (expr :value (etaf-data-example--toolbar controller next-id)) (box :height 1) - (box :layout 'column :width '(720) + (column :width '(720) (expr :value (etaf-data-example--rows controller))) (box :height 1) - (text :width '(720) :padding '(1 (16)) :border "#8D887F" - :color "#4D5651" :bgcolor "#EEEAE2" - "Owner rule: create in setup, mutate through Data, stop on unmount")))) + (box :width '(720) :padding '(1 (16)) :border "#8D887F" + :color "#4D5651" :bgcolor "#EEEAE2" + (text + "Owner rule: create in setup, mutate through Data, stop on unmount"))))) (etaf-define-component etaf-data-example-app () "Render a memory-backed task application with owned cleanup." diff --git a/examples/etaf-resource-example.el b/examples/etaf-resource-example.el index 8963b9d..f7c3ae9 100644 --- a/examples/etaf-resource-example.el +++ b/examples/etaf-resource-example.el @@ -25,11 +25,11 @@ (defun etaf-resource-example--header () "Return the Resource example header." (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 - (text :color "#8F432F" :face 'bold + (text :color "#8F432F" :font-weight 'bold "BEST PRACTICE / RESOURCE LIFECYCLE") - (text :face 'bold "Service health") + (text :font-weight 'bold "Service health") (text :color "#66706A" "Loader errors become explicit state; cleanup stays scoped.")))) @@ -41,9 +41,9 @@ (border (if success "#6D8A73" "#C97252")) (ink (if success "#24422D" "#6B3020"))) (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 - (text :face 'bold + (text :font-weight 'bold (expr :value (upcase (symbol-name status)))) (text (expr :value (etaf-resource-example--message resource))) (text :color "#66706A" @@ -53,28 +53,28 @@ (defun etaf-resource-example--actions (resource fail-next) "Return action controls for RESOURCE and FAIL-NEXT." (etaf-view - (box :layout 'flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) - (text :flex-grow 1 :flex-shrink 1 :flex-basis '(200) - :min-width '(180) :padding '(1 (12)) - :border "#4E7890" :bgcolor "#D9EAF2" :face 'bold - :text-align 'center :ref 'resource-reload :role 'button - :use (list (etaf-focusable)) - :on-press (lambda () (etaf-resource-load resource)) - "RELOAD") - (text :flex-grow 1 :flex-shrink 1 :flex-basis '(200) - :min-width '(180) :padding '(1 (12)) - :border "#C97252" :bgcolor "#F1D4C9" :face 'bold - :text-align 'center :ref 'resource-fail :role 'button - :use (list (etaf-focusable)) - :on-press (lambda () - (etaf-set-value fail-next t) - (etaf-resource-load resource)) - "SIMULATE FAILURE")))) + (flex :width '(680) :flex-flow '(row wrap) :gap '(1 (12)) + (box :flex-grow 1 :flex-shrink 1 :flex-basis '(200) + :min-width '(180) :padding '(1 (12)) + :border "#4E7890" :bgcolor "#D9EAF2" :font-weight 'bold + :text-align 'center :ref 'resource-reload :role 'button + :use (list (etaf-focusable)) + :on-press (lambda () (etaf-resource-load resource)) + (text "RELOAD")) + (box :flex-grow 1 :flex-shrink 1 :flex-basis '(200) + :min-width '(180) :padding '(1 (12)) + :border "#C97252" :bgcolor "#F1D4C9" :font-weight 'bold + :text-align 'center :ref 'resource-fail :role 'button + :use (list (etaf-focusable)) + :on-press (lambda () + (etaf-set-value fail-next t) + (etaf-resource-load resource)) + (text "SIMULATE FAILURE"))))) (defun etaf-resource-example--view (resource fail-next cleanup-count) "Return the example View for RESOURCE, FAIL-NEXT, and CLEANUP-COUNT." (etaf-view - (box :layout 'column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE" + (column :width '(680) :color "#252A2E" :bgcolor "#F8F5EE" (expr :value (etaf-resource-example--header)) (box :height 1) (expr :value @@ -82,9 +82,10 @@ (box :height 1) (expr :value (etaf-resource-example--actions resource fail-next)) (box :height 1) - (text :width '(680) :padding '(1 (16)) :border "#8D887F" - :color "#4D5651" :bgcolor "#EEEAE2" - "Scope rule: reload releases the old value; unmount releases the last one")))) + (box :width '(680) :padding '(1 (16)) :border "#8D887F" + :color "#4D5651" :bgcolor "#EEEAE2" + (text + "Scope rule: reload releases the old value; unmount releases the last one"))))) (etaf-define-component etaf-resource-example-app () "Render a reloadable Resource with visible cleanup and error state." diff --git a/tests/etaf-tests.el b/tests/etaf-tests.el index 6b5240d..914dcc9 100644 --- a/tests/etaf-tests.el +++ b/tests/etaf-tests.el @@ -55,12 +55,6 @@ (defvar etaf-test-nested-range-present nil) (defvar etaf-test-nested-range-source nil) (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-evals 0) (defvar etaf-test-inline-branch-mode nil) @@ -83,10 +77,6 @@ (defvar etaf-test-fragment-range-evals 0) (defvar etaf-test-fragment-owner-renders 0) (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-renders 0) (defvar etaf-test-transparent-parent-renders 0) @@ -128,19 +118,12 @@ (pcase (etaf-value etaf-test-unsupported-range-source) ('component (etaf--view-call 'etaf-test-badge (list :label "component") nil)) - ('raw (etaf--raw-ebox-create - :thunk (lambda () (ebox-create :content "raw")))) ('deep-component (etaf--view-call 'column (list :key 'outer) (list (etaf--component-call-create :spec etaf-test-badge--etaf-component-definition :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 (etaf--view-call 'column (list :key 'outer) @@ -383,23 +366,6 @@ :children (list (etaf--view-call 'text (list :key 'static) (list "S")) 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 () "Render one shared source in two distinct text Hosts." :view @@ -544,18 +510,6 @@ (fragment (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 () "Render a transparent fragment sequence." @@ -698,15 +652,13 @@ (etaf-define-component etaf-test-inline-styled-owner () "Render a styled inline expression beside a side-effecting Host prop." :view - (text :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red") - "P" - (expr :value - (progn - (cl-incf etaf-test-inline-styled-evals) - (etaf-view - (text :face 'bold - (expr :value - (etaf-value etaf-test-inline-styled-source)))))))) + (box :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red") + "P" + (text :font-weight 'bold + (expr :value + (progn + (cl-incf etaf-test-inline-styled-evals) + (etaf-value etaf-test-inline-styled-source)))))) (etaf-define-component etaf-test-range-input-priority (&key marker) "Render fixed Range structure whose item reads MARKER and a reactive source." @@ -762,7 +714,7 @@ (etaf-define-component etaf-test-badge (&key label) "Render LABEL as a small semantic test Component." :view - (text :face 'bold (expr :value label))) + (text :font-weight 'bold (expr :value label))) (etaf-define-component etaf-list (&key label) "Render LABEL using the collision-safe `list-view' alias." @@ -774,8 +726,8 @@ :view (column (text (expr :value title)) - (slot :name 'header (text :face 'shadow "Default header")) - (slot (text :face 'shadow "Default body")))) + (slot :name 'header (text :font-weight 'shadow "Default header")) + (slot (text :font-weight 'shadow "Default body")))) (etaf-define-component etaf-test-named-slot-consumer () "Render the named header slot for forwarding tests." @@ -1218,7 +1170,7 @@ (ert-deftest etaf-view-property-region-precedes-children () "Reject a property that appears after a structural child." (should-error - (macroexpand '(etaf-view (text "Hello" :face 'bold))) + (macroexpand '(etaf-view (text "Hello" :font-weight 'bold))) :type 'etaf-view-syntax-error)) (ert-deftest etaf-view-ordinary-control-flow-belongs-in-expr () @@ -1229,16 +1181,16 @@ (ert-deftest etaf-view-quote-is-not-needed-for-structure () "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 (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))))) (ert-deftest etaf-view-attribute-values-are-ordinary-elisp () "Evaluate an attribute expression without an extra evaluation wrapper." (let ((face 'bold) (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)))))) (ert-deftest etaf-view-expr-evaluates-control-flow () @@ -1318,18 +1270,18 @@ (etaf-test--render-text (etaf-view (column (text "A") (text "B"))))))) -(ert-deftest etaf-view-box-lowers-outer-and-layout-to-ebox () - "Lower canonical Box axes through Ebox's public Box DSL." +(ert-deftest etaf-view-box-forms-lower-outer-and-layout-to-ebox () + "Lower each Box form to one typed Box with its selected Layout." (let ((row (etaf-render (etaf-view - (box :outer 'inline :layout 'row + (row :outer 'inline (text "A") (text "B"))))) (column (etaf-render (etaf-view - (box :outer 'block :layout 'column + (column :outer 'block (text "A") (text "B")))))) (should (equal (ebox--computed-display row) '(inline row))) @@ -1352,7 +1304,7 @@ (etaf-mount buffer-name (etaf-view - (box :layout 'row + (row (text (expr :value (etaf-value source))) (text "B")))) (should (string-match-p "AB" (etaf-test--buffer-text buffer-name))) @@ -1371,7 +1323,9 @@ :grid-template-columns '((20) (20)) (text "A") (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 "B" (substring-no-properties (ebox-render node)))))) @@ -1475,43 +1429,50 @@ (ert-deftest etaf-styles-have-root-class-and-inline-precedence () "Apply component styles only at matching scope and preserve inline props." (let* ((node (etaf-render (etaf-view (etaf-test-styled-card)))) - (content-node (plist-get node :ebox-content-node)) - (children (plist-get content-node :children)) + (children (ebox-box-node-children node)) (title (car children)) (body (cadr children))) - (should (equal "inline-title" (ebox-get title :color))) - (should (equal "title-bg" (ebox-get title :bgcolor))) - (should (equal "style-root" (ebox-get node :color))) - (should-not (ebox-get body :color)))) + (should (equal "inline-title" + (ebox-style-node-specified-value title :color))) + (should (equal "title-bg" + (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 () "Treat an explicit nil Host style property as unspecified." (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 () "Keep the first matching Component default without overriding inline props." (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 (etaf-view (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 () "Keep a parent Component selector outside nested Component internals." (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 () "Keep caller styles on slot content projected by a child Component." (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 () "Keep child styles on fallback content authored by that Component." (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 () "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))) (should (equal "child-color" - (ebox-get + (ebox-style-node-specified-value (etaf-runtime-root-node (etaf-runtime-for-buffer buffer-name)) :color)))) @@ -1538,7 +1499,7 @@ (etaf-mount buffer-name (etaf-view (etaf-test-styled-parent))) (should (null - (ebox-get + (ebox-style-node-specified-value (etaf-runtime-root-node (etaf-runtime-for-buffer buffer-name)) :color)))) @@ -1555,8 +1516,11 @@ (etaf-mount buffer-name (etaf-view (etaf-test-themed-text))) (let* ((runtime (etaf-runtime-for-buffer buffer-name)) (node (etaf-runtime-root-node runtime))) - (should (equal "theme-color" (ebox-get node :color))) - (should (equal "theme-bg" (ebox-get node :bgcolor))))) + (should (equal "theme-color" + (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))) (etaf-unmount runtime)) (when-let* ((buffer (get-buffer buffer-name))) @@ -1570,7 +1534,7 @@ (etaf-mount buffer-name (etaf-view (etaf-test-themed-style-token))) (should (equal "token-color" - (ebox-get + (ebox-style-node-specified-value (etaf-runtime-root-node (etaf-runtime-for-buffer buffer-name)) :color)))) @@ -1679,21 +1643,23 @@ (plist-get (tp-paint-slot-spec value) :background) value))) (let ((slot - (plist-get (ebox-host-node 'theme-atomic-panel) - :bgcolor))) + (ebox-style-node-specified-value + (ebox-host-node 'theme-atomic-panel) :bgcolor))) (should (equal "#FFFFFF" (background slot))) (etaf-dispatch-event runtime 'theme-atomic-toggle 'press) (let ((semantic (plist-get (etaf-runtime-host-props-for runtime 'theme-atomic-panel) - :bgcolor)) - (backend - (plist-get (ebox-host-node 'theme-atomic-panel) - :bgcolor))) - (should (eq slot semantic)) - (should (eq slot backend)) - (should (equal "#111111" (background slot)))) + :bgcolor))) + (should (equal "#111111" (background semantic)))) + (with-current-buffer buffer-name + (should + (cl-some + (lambda (entry) + (equal "#111111" + (plist-get (cadr entry) :background))) + face-remapping-alist))) (should (string-match-p "Dark" (etaf-test--buffer-text buffer-name))))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) @@ -1756,14 +1722,15 @@ (etaf-theme-resolve-palette '(:ink "red") 'sepia) :type 'etaf-context-error)) -(ert-deftest etaf-text-supports-inline-propertized-runs () - "Lower nested text Hosts to one Ebox content surface with text properties." +(ert-deftest etaf-box-composes-adjacent-styled-text-runs () + "Represent styled runs as sibling Text nodes, never a nested Text tree." (let* ((node (etaf-render (etaf-view - (text "Hello " (text :face 'bold "world") "!")))) - (content (ebox-get node :content))) + (box "Hello " (text :font-weight 'bold "world") "!")))) + (content (ebox-render node))) (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)))) (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 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 () "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))))) (ert-deftest etaf-runtime-direct-range-rejects-step4b-output-without-reownership () - "Reject direct Component/raw output while retaining Range-only dependency." - (dolist (unsupported '(component raw deep-component deep-raw + "Reject direct Component output while retaining Range-only dependency." + (dolist (unsupported '(component deep-component deep-expr-component)) (let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported)) (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)) (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 () - "Coalesce two inline effects in one Host and split two distinct Hosts." - (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)))) +(ert-deftest etaf-runtime-shared-inline-source-updates-distinct-text-hosts () + "Publish two distinct Text hosts that read one shared source in one commit." (let ((buffer-name " *etaf-inline-two-host-test*") (etaf-test-inline-shared (etaf-ref "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)) (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 () "Publish Root changes through one semantic Root Range and root replacement."