feat: unify component views and public render boundaries
This commit is contained in:
Kinneyzhang
parent
41b259f772
commit
805323a7f2
4
Makefile
4
Makefile
@ -2,7 +2,7 @@ EMACS ?= emacs
|
||||
LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss
|
||||
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-scheduler.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-generation.el etaf-host.el etaf-retirement.el etaf-render-port.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el scripts/benchmark-scheduler-context.el
|
||||
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el
|
||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-render-view-tests.el tests/etaf-dynamic-components-tests.el tests/etaf-event-forwarding-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el
|
||||
|
||||
.PHONY: test compile load checkdoc docs-check metadata-check scheduler-benchmark check clean
|
||||
|
||||
@ -15,7 +15,7 @@ compile: clean
|
||||
$(EMACS) -Q --batch $(LOAD_PATH) \
|
||||
--eval "(setq load-prefer-newer t byte-compile-error-on-warn t byte-compile-warnings '(not obsolete))" \
|
||||
--eval "(load-file \"etaf.el\")" \
|
||||
--eval "(dolist (file '($(foreach file,$(SOURCES) $(EXAMPLES),\"$(file)\"))) (byte-compile-file file))"
|
||||
--eval "(dolist (file '($(foreach file,$(SOURCES) $(EXAMPLES),\"$(file)\"))) (unless (byte-compile-file file) (error \"Compilation failed: %s\" file)))"
|
||||
|
||||
load: compile
|
||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" --eval "(require 'etaf)" --eval "(princ \"ETAF load OK\\n\")"
|
||||
|
||||
89
README.md
89
README.md
@ -1,44 +1,85 @@
|
||||
# ETAF
|
||||
|
||||
ETAF is a small text-application framework built above the independent [Ebox](../ebox) layout and rendering engine.
|
||||
ETAF builds text applications from reusable Components above the independent
|
||||
[Ebox](../ebox) layout and rendering engine.
|
||||
|
||||
Its complete public model is:
|
||||
|
||||
```text
|
||||
Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
|
||||
```
|
||||
|
||||
Every visible structure uses one form:
|
||||
Start with `etaf-view` and `etaf-mount`. Properties precede children in
|
||||
`(name :property value ... child ...)`; property values are ordinary Elisp.
|
||||
Evaluate the complete example, switch to `*etaf-hello*`, and activate “Say hello”:
|
||||
|
||||
<!-- etaf-example: hello -->
|
||||
```elisp
|
||||
(name :property value ... child ...)
|
||||
```
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
The only child computation bridge is `expr :value`; attribute values are ordinary Elisp expressions.
|
||||
|
||||
```elisp
|
||||
(etaf-mount
|
||||
"*etaf-hello*"
|
||||
(etaf-view
|
||||
(column
|
||||
(text :font-weight 'bold "Hello")
|
||||
(text
|
||||
:color "#687386"
|
||||
(expr :value (if ready "Ready" "Waiting")))))
|
||||
(box :ref 'hello :role 'button :tab-index 0
|
||||
:on-press (lambda () (message "Hello ETAF"))
|
||||
"Say hello"))))
|
||||
```
|
||||
|
||||
Define a Component:
|
||||
A Component receives declared props and optional content through slots. Use the
|
||||
exact name passed to `etaf-define-component`; the registry creates no aliases.
|
||||
`(expr FORM)` evaluates one child expression. In a structural child position it
|
||||
may return nil, text, a typed Host or Component View, or a proper sequence of
|
||||
those values. Inside `text`, an expression must return a string.
|
||||
|
||||
<!-- etaf-example: card -->
|
||||
```elisp
|
||||
(etaf-define-component status-label (&key label)
|
||||
"Render a status label."
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component demo-card (&key title)
|
||||
:view
|
||||
(text :font-weight 'bold (expr :value label)))
|
||||
(column
|
||||
(text :font-weight 'bold (expr title))
|
||||
(slot)
|
||||
(slot :name 'footer)))
|
||||
|
||||
(etaf-mount
|
||||
"*etaf-demo*"
|
||||
(etaf-view (status-label :label "Connected")))
|
||||
"*etaf-card*"
|
||||
(etaf-view
|
||||
(demo-card :title "Account"
|
||||
(text "Connected")
|
||||
(slot :name 'footer (text "Footer")))))
|
||||
```
|
||||
|
||||
`etaf-view` is the single public View constructor. Structural forms do not use quote; quote remains ordinary Elisp data syntax, such as `'bold`. A View returned from ordinary Elisp is explicitly constructed with `(etaf-view ...)` inside `expr`.
|
||||
Add `:setup` when a Component owns state. It runs once per retained instance;
|
||||
`:render` uses ordinary Elisp to capture handles before returning `etaf-view`.
|
||||
The shorter `:view` form compiles the same View model.
|
||||
|
||||
<!-- etaf-example: counter -->
|
||||
```elisp
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component demo-counter ()
|
||||
:setup (etaf-ref 0)
|
||||
:render
|
||||
(let ((count (etaf-state)))
|
||||
(etaf-view
|
||||
(column
|
||||
(text (expr (format "Count: %d" (etaf-value count))))
|
||||
(box :ref 'increment :role 'button :tab-index 0
|
||||
:on-press (lambda () (cl-incf (etaf-value count)))
|
||||
"Increment")))))
|
||||
|
||||
(etaf-mount "*etaf-counter*" (etaf-view (demo-counter)))
|
||||
```
|
||||
|
||||
Keep `etaf-value` reads inside the property or `expr` that should update. Event
|
||||
callbacks capture ordinary lexical locals; call `etaf-state` during rendering.
|
||||
Use a lexical-binding `.el` file for reusable application code. `etaf-node` is
|
||||
available for programmatic View builders. Context, Data, Behavior, and named
|
||||
Actions are optional capabilities; simple callbacks need no Action registration.
|
||||
|
||||
Use exact catalog names such as `etaf-button` after `(require 'etaf-ui)`.
|
||||
Core does not load `.etaf` files: Playground treats them as inert structure,
|
||||
with its explicit companion registration handling executable Elisp.
|
||||
|
||||
## Performance records
|
||||
|
||||
@ -125,6 +166,8 @@ through the retired v1 capability.
|
||||
During development, load the sibling Ebox checkout before ETAF:
|
||||
|
||||
```elisp
|
||||
(add-to-list 'load-path "/path/to/github/ecss")
|
||||
(add-to-list 'load-path "/path/to/github/tp")
|
||||
(add-to-list 'load-path "/path/to/github/ebox")
|
||||
(add-to-list 'load-path "/path/to/github/etaf")
|
||||
(require 'etaf)
|
||||
|
||||
@ -1,44 +1,82 @@
|
||||
# ETAF
|
||||
|
||||
ETAF 是构建在独立 [Ebox](../ebox) 布局与渲染引擎之上的小型文本应用框架。
|
||||
ETAF 在独立的 [Ebox](../ebox) 布局与渲染引擎上，使用可复用的 Component 构建文本应用。
|
||||
|
||||
完整的公共模型是：
|
||||
|
||||
```text
|
||||
Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
|
||||
```
|
||||
|
||||
所有可见结构都使用一种形式：
|
||||
从 `etaf-view` 和 `etaf-mount` 开始。`(name :property value ... child ...)`
|
||||
中属性在前、子节点在后，属性值是普通 Elisp。求值下面完整例子，切换到
|
||||
`*etaf-hello*`，即可激活 “Say hello”：
|
||||
|
||||
<!-- etaf-example: hello -->
|
||||
```elisp
|
||||
(name :property value ... child ...)
|
||||
```
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
子节点中唯一的计算桥接是 `expr :value`；属性值则是普通 Elisp 表达式。
|
||||
|
||||
```elisp
|
||||
(etaf-mount
|
||||
"*etaf-hello*"
|
||||
(etaf-view
|
||||
(column
|
||||
(text :font-weight 'bold "Hello")
|
||||
(text
|
||||
:color "#687386"
|
||||
(expr :value (if ready "Ready" "Waiting")))))
|
||||
(box :ref 'hello :role 'button :tab-index 0
|
||||
:on-press (lambda () (message "Hello ETAF"))
|
||||
"Say hello"))))
|
||||
```
|
||||
|
||||
定义 Component：
|
||||
Component 通过声明的 props 接收业务输入，通过 slot 接收内容。调用时使用
|
||||
`etaf-define-component` 中的准确名称，注册表不会自动生成 alias。
|
||||
`(expr FORM)` 执行一个子节点表达式：结构位置可以返回 nil、字符串、typed
|
||||
Host 或 Component View，或这些值组成的 proper sequence；`text` 内的表达式必须返回字符串。
|
||||
|
||||
<!-- etaf-example: card -->
|
||||
```elisp
|
||||
(etaf-define-component status-label (&key label)
|
||||
"Render a status label."
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component demo-card (&key title)
|
||||
:view
|
||||
(text :font-weight 'bold (expr :value label)))
|
||||
(column
|
||||
(text :font-weight 'bold (expr title))
|
||||
(slot)
|
||||
(slot :name 'footer)))
|
||||
|
||||
(etaf-mount
|
||||
"*etaf-demo*"
|
||||
(etaf-view (status-label :label "Connected")))
|
||||
"*etaf-card*"
|
||||
(etaf-view
|
||||
(demo-card :title "Account"
|
||||
(text "Connected")
|
||||
(slot :name 'footer (text "Footer")))))
|
||||
```
|
||||
|
||||
`etaf-view` 是唯一的公共 View 构造入口。结构 form 不使用 quote；quote 仍然是普通 Elisp 数据语法，例如 `'bold`。普通 Elisp 返回 View 时，必须在 `expr` 中显式使用 `(etaf-view ...)` 构造它。
|
||||
组件拥有状态时才增加 `:setup`，它对每个保留的实例执行一次。
|
||||
`:render` 使用普通 Elisp 捕获句柄，再返回 `etaf-view`；更短的 `:view`
|
||||
形式编译为同一种 View 模型。
|
||||
|
||||
<!-- etaf-example: counter -->
|
||||
```elisp
|
||||
;;; -*- lexical-binding: t; -*-
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component demo-counter ()
|
||||
:setup (etaf-ref 0)
|
||||
:render
|
||||
(let ((count (etaf-state)))
|
||||
(etaf-view
|
||||
(column
|
||||
(text (expr (format "Count: %d" (etaf-value count))))
|
||||
(box :ref 'increment :role 'button :tab-index 0
|
||||
:on-press (lambda () (cl-incf (etaf-value count)))
|
||||
"Increment")))))
|
||||
|
||||
(etaf-mount "*etaf-counter*" (etaf-view (demo-counter)))
|
||||
```
|
||||
|
||||
把 `etaf-value` 放在需要更新的属性或 `expr` 内，保留局部更新边界。
|
||||
事件回调捕获普通词法变量，`etaf-state` 在 render 时读取。可复用应用代码放进
|
||||
启用 lexical-binding 的 `.el` 文件。程序化构造 View 时也可使用 `etaf-node`。
|
||||
Context、Data、Behavior 和命名 Action 按需学习，简单回调不需要注册 Action。
|
||||
|
||||
加载 `(require 'etaf-ui)` 后，使用 `etaf-button` 等准确目录名称。
|
||||
Core 不加载 `.etaf` 文件；Playground 将它们作为 inert 结构，由其显式的 companion
|
||||
注册入口管理可执行 Elisp。
|
||||
|
||||
## 性能记录面板
|
||||
|
||||
@ -118,6 +156,8 @@ ETAF 为当前 Emacs 进程 snapshot 一个不可变的 v2 render port。按依
|
||||
开发时先把同级 Ebox 检出目录加入 `load-path`：
|
||||
|
||||
```elisp
|
||||
(add-to-list 'load-path "/path/to/github/ecss")
|
||||
(add-to-list 'load-path "/path/to/github/tp")
|
||||
(add-to-list 'load-path "/path/to/github/ebox")
|
||||
(add-to-list 'load-path "/path/to/github/etaf")
|
||||
(require 'etaf)
|
||||
|
||||
@ -132,6 +132,9 @@ the other two clauses are optional:
|
||||
```
|
||||
|
||||
`:view` and `:render` are mutually exclusive and exactly one is required.
|
||||
`:render` is ordinary Elisp and may return `etaf-view` or a programmatically
|
||||
built `etaf-node`. Both share View compilation, prop validation, and slot
|
||||
projection; `:render` adds no second representation or state model.
|
||||
`:setup` and `:styles` are optional and may each appear once. Props are the only declared business inputs; ordinary trailing children and named slots are normalized separately into the Component's slot collection.
|
||||
|
||||
The Component definition is the current structure/style/behavior boundary. Keep dynamic state, Action callbacks, and lifecycle work in `:setup`; keep static presentation in `:styles`. A future `.etaf` SFC compiler may produce these definitions, but the Runtime does not load `.etaf` files directly.
|
||||
@ -175,7 +178,7 @@ registration; it never returns a render function.
|
||||
|
||||
`:key` is stable identity metadata, not a business prop. On a Component call it selects the retained Component instance within the sibling scope; on a Host it is forwarded as the Ebox node key. If a render candidate fails, the Runtime restores the previous instance, handlers, behaviors, and buffer.
|
||||
|
||||
In View syntax, canonical Component names may omit the `etaf-` prefix. If the short name would collide with an Elisp function, special form, or Host, the registry assigns a semantic `-view` alias. Ordinary Elisp APIs such as `etaf-value`, `etaf-ref`, and `etaf-mount` always keep their prefix.
|
||||
Component calls use the exact registered definition name. The registry creates no automatic prefix or `-view` aliases. Official catalog Components use names such as `etaf-button`; an application may explicitly define its own Component under any valid unoccupied name.
|
||||
|
||||
## 5. Children and slots
|
||||
|
||||
@ -222,6 +225,13 @@ Named slot names are stable non-keyword symbols. Strings, numbers, variables, an
|
||||
|
||||
Inside a Component, `slot` projects content. In a Component call's child region, `slot :name` contributes content. The compiler uses the same normalized slot representation for both roles.
|
||||
|
||||
Authored slot expressions retain their author's props, state, and Context across
|
||||
the entire projected subtree. A Component created in that subtree owns its own
|
||||
props, state, styles, and Scope, inheriting Context from the slot author. The
|
||||
receiver's own fallback, ordinary children, and View-producing callbacks use
|
||||
the receiver environment instead. Table/Grid cell callbacks keep the same
|
||||
ordinary rule: their Context is the consuming Table/Grid location.
|
||||
|
||||
## 6. Core Hosts and Ebox
|
||||
|
||||
ETAF core intentionally provides only minimal, unstyled Hosts:
|
||||
@ -326,32 +336,50 @@ Runtime events are dispatched through `etaf-dispatch-event`, and focus/hit testi
|
||||
|
||||
Context is an inherited Component Scope environment:
|
||||
|
||||
<!-- etaf-example: context -->
|
||||
```elisp
|
||||
(etaf-define-component service-provider ()
|
||||
"Provide a reactive service to descendants."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (slot))
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component service-consumer ()
|
||||
"Read the inherited service."
|
||||
:setup (etaf-inject 'service nil t)
|
||||
:view (text (expr (etaf-value (etaf-state)))))
|
||||
:view (text (expr (format "Service: %s" (etaf-value (etaf-state))))))
|
||||
|
||||
(etaf-view (service-provider (service-consumer)))
|
||||
(etaf-define-component service-provider ()
|
||||
"Provide a reactive service to its own child Component."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (service-consumer))
|
||||
|
||||
(etaf-mount "*etaf-context*" (etaf-view (service-provider)))
|
||||
```
|
||||
|
||||
Keys are stable ordinary symbols. The nearest ancestor wins; a missing required key signals `etaf-context-error`. Theme is a Context value containing a property plist:
|
||||
Keys are stable ordinary symbols. The nearest ancestor wins; a missing required
|
||||
key signals `etaf-context-error`. Root-authored slots retain the root's empty
|
||||
Context throughout their subtree. Migration from the former accidental receiver
|
||||
inheritance requires declaring consumers in the provider's own View or calling
|
||||
an ordinary View-producing callback there. Projected slots continue to use their
|
||||
author's environment. Theme follows this same Context ancestry and contains a
|
||||
property plist:
|
||||
|
||||
<!-- etaf-example: theme -->
|
||||
```elisp
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component themed-shell ()
|
||||
"Provide default text colors to a subtree."
|
||||
"Provide semantic colors to its own View."
|
||||
:setup
|
||||
(etaf-theme-provide
|
||||
'(:color "#F4F6FB" :bgcolor "#202634"))
|
||||
:view (slot))
|
||||
'(:text-color "#F4F6FB" :surface-color "#202634"))
|
||||
:view
|
||||
(text :ref 'themed-content
|
||||
:color (etaf-theme-token :text-color)
|
||||
:background-color (etaf-theme-token :surface-color)
|
||||
"Themed content"))
|
||||
|
||||
(etaf-mount "*etaf-theme*" (etaf-view (themed-shell)))
|
||||
```
|
||||
|
||||
Palette resolution remains a Theme concern, not a UI catalog concern. Core
|
||||
|
||||
@ -128,7 +128,9 @@ ATTRIBUTE = :KEY VALUE
|
||||
:styles (styles RULE...))
|
||||
```
|
||||
|
||||
`:view` 和 `:render` 互斥且必须恰好出现一个；`:setup` 与 `:styles` 可选且各最多出现一次。Props 是唯一需要声明的业务输入；普通尾部子节点和命名 slot 会被规范化为 Component 的 slot 集合。
|
||||
`:view` 和 `:render` 互斥且必须恰好出现一个。`:render` 是普通 Elisp，可以返回
|
||||
`etaf-view` 或程序化构造的 `etaf-node`；两者共用 View 编译、prop 校验与 slot
|
||||
投影，不增加另一套表示或状态模型。`:setup` 与 `:styles` 可选且各最多出现一次。Props 是唯一需要声明的业务输入；普通尾部子节点和命名 slot 会被规范化为 Component 的 slot 集合。
|
||||
|
||||
Component definition 是当前结构/样式/行为边界：动态状态、Action callback 和生命周期工作放进 `:setup`，静态 presentation 放进 `:styles`。未来 `.etaf` SFC compiler 可以生成这些 definition，但 Runtime 不会直接加载 `.etaf` 文件。
|
||||
|
||||
@ -170,7 +172,7 @@ state，不重新运行 setup。setup 负责局部 ref、computed、watch、Effe
|
||||
|
||||
`:key` 是稳定的 identity metadata，不是业务 prop。放在 Component 调用上时，它选择同级作用域内要保留的 Component instance；放在 Host 上时，它会作为 Ebox node key 向下传递。候选渲染失败时，Runtime 恢复旧 instance、handlers、Behaviors 和 buffer。
|
||||
|
||||
在 View 语法中，Component 的规范名称可以省略 `etaf-` 前缀。如果短名称会与 Elisp 函数、special form 或 Host 冲突，注册表会分配语义明确的 `-view` alias。普通 Elisp API，例如 `etaf-value`、`etaf-ref` 和 `etaf-mount`，始终保留前缀。
|
||||
Component 调用使用定义时准确注册的名称，注册表不会自动生成省略前缀或 `-view` alias。官方目录组件使用 `etaf-button` 等名称；应用可以显式使用任何合法且尚未占用的名称定义自己的组件。
|
||||
|
||||
## 5. children 与 slot
|
||||
|
||||
@ -217,6 +219,12 @@ children 只是匿名/默认 slot 的便捷写法，不是第二套内容模型
|
||||
|
||||
在 Component 内，`slot` 表示投影；在 Component 调用的子节点区，带 `:name` 的 `slot` 表示贡献内容。编译器对两种位置使用同一个规范化 slot 表示。
|
||||
|
||||
Slot 中作者写下的表达式在整个投影子树中保留作者的 props、state 和 Context。
|
||||
其中创建的 Component 拥有自己的 props、state、styles 和 Scope，但其 Context
|
||||
从 slot 作者环境继承。接收方自己定义的 fallback、普通子节点和产生 View 的
|
||||
callback 使用接收方环境。Table/Grid 的 cell callback 遵循相同的普通规则：
|
||||
Context 来自消费它的 Table/Grid 所在位置。
|
||||
|
||||
## 6. Core Host 与 Ebox
|
||||
|
||||
ETAF core 只提供最小且无样式的 Host：
|
||||
@ -318,32 +326,48 @@ Runtime 事件通过 `etaf-dispatch-event` 进入；命中测试和 focus 通过
|
||||
|
||||
Context 是继承的 Component Scope 环境：
|
||||
|
||||
<!-- etaf-example: context -->
|
||||
```elisp
|
||||
(etaf-define-component service-provider ()
|
||||
"Provide a reactive service to descendants."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (slot))
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component service-consumer ()
|
||||
"Read the inherited service."
|
||||
:setup (etaf-inject 'service nil t)
|
||||
:view (text (expr (etaf-value (etaf-state)))))
|
||||
:view (text (expr (format "Service: %s" (etaf-value (etaf-state))))))
|
||||
|
||||
(etaf-view (service-provider (service-consumer)))
|
||||
(etaf-define-component service-provider ()
|
||||
"Provide a reactive service to its own child Component."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (service-consumer))
|
||||
|
||||
(etaf-mount "*etaf-context*" (etaf-view (service-provider)))
|
||||
```
|
||||
|
||||
key 使用稳定的普通 symbol。最近的祖先优先，缺失的 required key 触发 `etaf-context-error`。Theme 是一个 Context value，内容是属性 plist：
|
||||
key 使用稳定的普通 symbol。最近的祖先优先，缺失的 required key 触发
|
||||
`etaf-context-error`。在根位置编写的 slot 内容及其子树保留根的空 Context。
|
||||
迁移旧版本中意外继承接收方 Context 的用法时，应把消费者写进 provider 自己的
|
||||
View，或在那里调用普通的 View-producing callback。投影的 slot 继续使用作者
|
||||
环境。Theme 遵循同一套 Context 继承关系，内容是属性 plist：
|
||||
|
||||
<!-- etaf-example: theme -->
|
||||
```elisp
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component themed-shell ()
|
||||
"Provide default text colors to a subtree."
|
||||
"Provide semantic colors to its own View."
|
||||
:setup
|
||||
(etaf-theme-provide
|
||||
'(:color "#F4F6FB" :bgcolor "#202634"))
|
||||
:view (slot))
|
||||
'(:text-color "#F4F6FB" :surface-color "#202634"))
|
||||
:view
|
||||
(text :ref 'themed-content
|
||||
:color (etaf-theme-token :text-color)
|
||||
:background-color (etaf-theme-token :surface-color)
|
||||
"Themed content"))
|
||||
|
||||
(etaf-mount "*etaf-theme*" (etaf-view (themed-shell)))
|
||||
```
|
||||
|
||||
Palette 解析属于 Theme，而不是 UI 目录。core 提供
|
||||
|
||||
@ -18,7 +18,7 @@ The repository is complete for the agreed unified architecture when the mandator
|
||||
|
||||
| Milestone | Delivered responsibility | Evidence |
|
||||
| --- | --- | --- |
|
||||
| P0 grammar | Unified View shape, property-first parsing, `etaf-view`, `(expr FORM)`, core Hosts, aliases | `tests/etaf-tests.el` structural and syntax tests |
|
||||
| P0 grammar | Unified View shape, property-first parsing, `etaf-view`, `(expr FORM)`, core Hosts, exact registered Component names | `tests/etaf-tests.el` structural and syntax tests |
|
||||
| P1 Components | `:view`, `:setup`, props, default/named slots, retained instances, lifecycle, `:key`, raw Ebox escape | Component, slot, mount, prop-update, raw-node, and rollback tests |
|
||||
| P2 Runtime | refs, computed, effects, watches, Scope cleanup, Context, Theme, Behaviors, events, focus, Actions | Mounted event/focus tests, reactive failure rollback, cleanup tests |
|
||||
| P3 presentation | scoped styles, selector matching, Theme precedence, inline text runs, Resource and error boundary | Style, Theme, text-surface, Resource, and error tests |
|
||||
@ -65,7 +65,9 @@ Do not split a file merely to create a shorter name. Split only when a stable re
|
||||
|
||||
- `etaf-define-component` chooses exactly one of `:view` or `:render`; `:setup`
|
||||
and `:styles` are optional.
|
||||
- `:view` and `:render` are mutually exclusive frontends.
|
||||
- `:view` and `:render` are mutually exclusive frontends for one View model;
|
||||
ordinary `:render` may return `etaf-view`, preserving lexical scope and the
|
||||
same compiler prop/slot rules.
|
||||
- `:setup` runs once per retained identity and returns opaque state read with
|
||||
`etaf-state` during either frontend.
|
||||
- Props update render without rerunning setup.
|
||||
|
||||
@ -18,7 +18,7 @@
|
||||
|
||||
| 里程碑 | 已交付职责 | 证据 |
|
||||
| --- | --- | --- |
|
||||
| P0 grammar | 统一 View 形状、属性优先解析、`etaf-view`、`(expr FORM)`、核心 Host、alias | `tests/etaf-tests.el` 结构和语法测试 |
|
||||
| P0 grammar | 统一 View 形状、属性优先解析、`etaf-view`、`(expr FORM)`、核心 Host、准确注册的 Component 名称 | `tests/etaf-tests.el` 结构和语法测试 |
|
||||
| P1 Component | `:view`、`:setup`、props、默认/命名 slot、retained instance、生命周期、`:key`、raw Ebox 出口 | Component、slot、mount、prop 更新、raw node、rollback 测试 |
|
||||
| P2 Runtime | ref、computed、effect、watch、Scope cleanup、Context、Theme、Behavior、事件、focus、Action | 挂载事件/focus、响应式失败回滚和 cleanup 测试 |
|
||||
| P3 presentation | 作用域样式、selector、Theme 优先级、inline text runs、Resource 和 error boundary | 样式、Theme、文本 surface、Resource、error 测试 |
|
||||
@ -65,7 +65,8 @@
|
||||
|
||||
- `etaf-define-component` 必须在 `:view` 与 `:render` 中恰好选择一个；`:setup` 与
|
||||
`:styles` 可选。
|
||||
- `:view` 与 `:render` 是互斥 frontend。
|
||||
- `:view` 与 `:render` 是同一 View 模型的互斥 frontend；普通 `:render` 可返回
|
||||
`etaf-view`，保留词法作用域与相同的 compiler prop/slot 规则。
|
||||
- `:setup` 对每个 retained identity 只运行一次，返回 opaque 状态，并由两个 frontend
|
||||
中的 `etaf-state` 读取。
|
||||
- Props 更新只重新 render，不重新运行 setup。
|
||||
|
||||
@ -7,6 +7,8 @@ ETAF builds text applications from one small vocabulary: `View`, `Component`, pr
|
||||
ETAF depends on the independent Ebox package. During development, put the core checkouts on `load-path` and load the one public ETAF entry:
|
||||
|
||||
```elisp
|
||||
(add-to-list 'load-path "/path/to/github/ecss")
|
||||
(add-to-list 'load-path "/path/to/github/tp")
|
||||
(add-to-list 'load-path "/path/to/github/ebox")
|
||||
(add-to-list 'load-path "/path/to/github/etaf")
|
||||
(require 'etaf)
|
||||
@ -67,6 +69,38 @@ that viewport directly instead of immediately rerendering:
|
||||
|
||||
Use `etaf-mount` whenever a View contains a stateful Component, reactive data, events, or lifecycle.
|
||||
|
||||
To request pending work explicitly, call `(etaf-runtime-flush runtime)`.
|
||||
Its return value is now the **integer committed Ebox revision**, replacing the
|
||||
previous Ebox-node return type. Busy or batched work may remain pending; the
|
||||
returned revision identifies the publication currently visible to readers.
|
||||
Calls inside an active Ebox/TP transaction fail before requesting work, since
|
||||
that transaction's revision may still be provisional. Ordinary flushes do not
|
||||
export a tree or force a Root rebuild.
|
||||
|
||||
For a current tree and its matching source facts, request an explicit snapshot:
|
||||
|
||||
```elisp
|
||||
(let* ((runtime (etaf-runtime-for-buffer "*etaf-hello*"))
|
||||
(snapshot (etaf-runtime-snapshot runtime)))
|
||||
(list (plist-get snapshot :revision)
|
||||
(plist-get snapshot :mount-id)
|
||||
(ebox-render (plist-get snapshot :input))))
|
||||
```
|
||||
|
||||
The snapshot contains `:input` (a canonical Ebox input), `:revision`, and
|
||||
`:mount-id` (the identity of this mount). Exporting costs O(N) and detaches
|
||||
ordinary mutable node payload; it does not drain pending work, evaluate
|
||||
Components, publish, or increment the revision. The input remains usable after
|
||||
later commits or unmount. Opaque capabilities such as callbacks keep their
|
||||
identity; the query does not freeze external capabilities or the display
|
||||
environment. Unmounted Runtime and active Ebox/TP transaction queries fail.
|
||||
|
||||
The obsolete `etaf-runtime-root-node` getter remains read-compatible through
|
||||
this O(N) query and returns the current single root. Runtime no longer stores a
|
||||
root mirror. Migrate consumers to `etaf-runtime-snapshot` so the canonical input
|
||||
retains the root's matching source facts; do not treat the obsolete getter as a
|
||||
cheap field read or use it as a mutation target.
|
||||
|
||||
The current core has no direct `.etaf` loader. `etaf-define-component` is the structure/style/behavior unit: use its View for structure, `:styles` for static presentation, and `:setup` for retained state, Actions, and lifecycle. A future `.etaf` SFC belongs to a compiler layer that emits this same Component contract; it is not a second Runtime entry point.
|
||||
|
||||
## 3. Properties and children
|
||||
@ -95,7 +129,9 @@ The child region is structural. `expr` is the one explicit bridge for ordinary E
|
||||
```
|
||||
|
||||
`expr` accepts exactly one ordinary Elisp form and no structural children. Its
|
||||
result can be a string, typed View, proper typed View sequence, or `nil`.
|
||||
result in structural child positions can be a string, typed Host or Component
|
||||
View, a proper sequence of these values, or `nil`. Inside a `text` Host an
|
||||
expression must return a string.
|
||||
`if`, `when`, `cond`, `let`, `mapcar`, and `cl-loop` remain normal Elisp.
|
||||
|
||||
Quote has one ordinary Elisp meaning:
|
||||
@ -106,6 +142,11 @@ Quote has one ordinary Elisp meaning:
|
||||
|
||||
For example, `'bold` is the `:font-weight` symbol, while `'(text "data")` is only data and will not render. A dynamic View must be written as `(etaf-view (text "data"))`.
|
||||
|
||||
Spacing follows the layout Host: `row` and `column` use `:item-gap`, for
|
||||
example `(row :item-gap 1 ...)`; `flex` and `grid` use `:gap`. Changing the Host
|
||||
also changes which spacing property to use; these are not interchangeable
|
||||
aliases. For example, migrate `(row :gap 1 ...)` to `(row :item-gap 1 ...)`.
|
||||
|
||||
The core `grid` Host is the two-dimensional layout choice:
|
||||
|
||||
```elisp
|
||||
@ -143,20 +184,20 @@ The beginner form is a stateless `:view` Component:
|
||||
(status-label :label "Connected")))
|
||||
```
|
||||
|
||||
The canonical Component name may include the `etaf-` prefix:
|
||||
Use the exact name supplied to `etaf-define-component`:
|
||||
|
||||
```elisp
|
||||
(etaf-view (etaf-status-label :label "Connected"))
|
||||
(etaf-view (status-label :label "Connected"))
|
||||
```
|
||||
|
||||
In a View position, ETAF also registers the short alias `status-label`. If a short name conflicts with Elisp, the registry uses a semantic alias ending in `-view`. This alias rule applies only to View names; ordinary functions remain prefixed.
|
||||
The registry creates no automatic aliases. A Component defined as `etaf-status-label` must be called by that exact name; the `status-label` above is the name explicitly defined in this guide. Official catalog names are `etaf-button`, `etaf-checkbox`, and so on, after requiring `etaf-ui`.
|
||||
|
||||
The definition macro accepts only these keywords:
|
||||
|
||||
| Keyword | Meaning |
|
||||
| --- | --- |
|
||||
| `:view` | Declarative View frontend; mutually exclusive with `:render` |
|
||||
| `:render` | Ordinary-Elisp frontend returning one typed View through `etaf-node` |
|
||||
| `:render` | Ordinary Elisp returning one typed View, usually with `etaf-view`; programmatic builders may use `etaf-node` |
|
||||
| `:setup` | Optional one-time initialization returning opaque state read with `etaf-state` |
|
||||
| `:styles` | Optional static scoped style declaration |
|
||||
|
||||
@ -170,22 +211,23 @@ Use `:setup` when the Component owns local state:
|
||||
(etaf-define-component counter (&key title)
|
||||
"Render a retained counter."
|
||||
:setup
|
||||
(let ((count (etaf-ref 0)))
|
||||
(let ((count (etaf-ref 0))
|
||||
(initial-title title))
|
||||
(etaf-on-mounted
|
||||
(lambda () (message "%s mounted" title)))
|
||||
(lambda () (message "%s mounted" initial-title)))
|
||||
(etaf-on-unmounted
|
||||
(lambda () (message "%s unmounted" title)))
|
||||
(lambda () (message "%s unmounted" initial-title)))
|
||||
count)
|
||||
:view
|
||||
:render
|
||||
(let ((count (etaf-state))
|
||||
(caption title))
|
||||
(etaf-view
|
||||
(column
|
||||
(text :font-weight 'bold (expr title))
|
||||
(text (expr (format "Count: %d" (etaf-value (etaf-state)))))
|
||||
(text
|
||||
:role 'button
|
||||
:on-press
|
||||
(let ((count (etaf-state)))
|
||||
(lambda () (cl-incf (etaf-value count))))
|
||||
"Increment")))
|
||||
(text :font-weight 'bold (expr caption))
|
||||
(text (expr (format "Count: %d" (etaf-value count))))
|
||||
(text :role 'button :tab-index 0
|
||||
:on-press (lambda () (cl-incf (etaf-value count)))
|
||||
"Increment")))))
|
||||
```
|
||||
|
||||
Setup runs once for the retained instance and returns one opaque state value.
|
||||
@ -194,6 +236,14 @@ exact value with `etaf-state`. `etaf-on-mounted`, `etaf-on-updated`, and
|
||||
`etaf-on-unmounted` register lifecycle callbacks for that Component instance.
|
||||
Scope disposal automatically stops reactive effects and cleanup.
|
||||
|
||||
`:view` and `:render` share compilation, slot projection, and prop validation.
|
||||
Use ordinary `let`/`let*` to capture state handles or current prop values for
|
||||
callbacks. `etaf-state` is a render-time accessor, not an event-time accessor.
|
||||
Keep reactive `etaf-value` reads inside the property or `expr` that needs the
|
||||
update; extracting a handle does not require reading its value early. Component
|
||||
code with retained closures belongs in an `.el` file with lexical binding.
|
||||
Simple local callbacks need no Action definition.
|
||||
|
||||
The small reactive API is:
|
||||
|
||||
```elisp
|
||||
@ -256,6 +306,14 @@ Named slots use `:name` and must use a stable non-keyword symbol:
|
||||
|
||||
The two default-slot shorthands are `(slot)` and `(slot FALLBACK...)`. The normalized spelling is `(slot :name 'default FALLBACK...)`. At a call site, ordinary children fill `default`; a named input uses `(slot :name 'header CHILD...)`. An explicit empty `(slot :name 'header)` suppresses the fallback. Strings, numbers, variables, and runtime expressions are not valid slot names.
|
||||
|
||||
Slot expressions keep their author's props, state, and Context throughout the
|
||||
projected subtree. Components created inside that subtree still own their own
|
||||
props, state, styles, and Scope; they inherit Context from the slot author's
|
||||
environment. A receiving Component does not inject its own Context into caller
|
||||
content. Its fallback, ordinary children, and View-producing callbacks use its
|
||||
own environment. A Table/Grid cell callback likewise runs in the consuming
|
||||
Table/Grid's Context.
|
||||
|
||||
`expr` may return a typed View or a proper sequence of typed Views at a
|
||||
structural boundary. It never exposes or accepts ETAF's private structs. The
|
||||
same Component can combine a keyed `:for`, a structural expression, and a
|
||||
@ -311,13 +369,22 @@ Styles are scoped to the Component that authored a View node. A parent rule does
|
||||
|
||||
Theme is a Context convenience, not another runtime object:
|
||||
|
||||
<!-- etaf-example: theme -->
|
||||
```elisp
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component themed-shell ()
|
||||
"Provide default text colors to a subtree."
|
||||
"Provide semantic colors to its own View."
|
||||
:setup
|
||||
(etaf-theme-provide
|
||||
'(:color "#F4F6FB" :bgcolor "#202634"))
|
||||
:view (slot))
|
||||
'(:text-color "#F4F6FB" :surface-color "#202634"))
|
||||
:view
|
||||
(text :ref 'themed-content
|
||||
:color (etaf-theme-token :text-color)
|
||||
:background-color (etaf-theme-token :surface-color)
|
||||
"Themed content"))
|
||||
|
||||
(etaf-mount "*etaf-theme*" (etaf-view (themed-shell)))
|
||||
```
|
||||
|
||||
For a light/dark application palette, keep the semantic roles in one palette
|
||||
@ -395,12 +462,36 @@ For a reusable installer, reserve `:install` for the cleanup-producing part of t
|
||||
|
||||
The installer can call `etaf-current-behavior-context` when it needs the current Runtime or Host path. Replacing the Behavior runs the old cleanup before the new state becomes current. Behavior equality keeps function and reactive-value identity with `eq`; a newly-created installer closure is therefore a deliberate replacement, not an accidental reuse. The replacement is staged under the mounted resource registry and becomes authoritative only when its generation commits.
|
||||
|
||||
Composition rules are fixed: the Host callback runs before Behavior callbacks,
|
||||
Behaviors follow declaration order, and a callback error short-circuits the
|
||||
rest. For non-event attributes the Host wins, then the first Behavior wins.
|
||||
Duplicate Behavior names fail before installation. Stable installers are reused
|
||||
and each installed cleanup runs exactly once. Dispatch targets one exact Host;
|
||||
there is no capture or bubble phase.
|
||||
<a id="interaction-migration"></a>
|
||||
|
||||
Root event forwarding is additive: the internal business handler runs first,
|
||||
then extra wrapper callbacks from inner to outer, then Behaviors in declaration
|
||||
order. Each declaration runs once. For a Checkbox, `:on-change` still receives
|
||||
the next boolean before an added `:on-press` observer. A callback error
|
||||
short-circuits the remaining callbacks; UI rollback does not undo external
|
||||
business writes. Dispatch targets one exact Host, with no capture or bubble.
|
||||
|
||||
Wrapper `:use` lists concatenate; duplicate Behavior names fail before any
|
||||
installer runs. Non-event Behavior defaults retain first-wins order after Host
|
||||
attributes, except `:disabled`, which combines with OR. Inner and outer disabled
|
||||
inputs are recomputed on every update: callers can further disable a control,
|
||||
and clearing the outer input enables it only when its inner input is also nil.
|
||||
Disabled Hosts reject `etaf-dispatch-event` and `etaf-focus` with
|
||||
`etaf-event-error`. Their input Behaviors are not installed; a committed disable
|
||||
cleans up installed resources, and re-enabling installs them again.
|
||||
|
||||
Hit testing selects the deepest interaction boundary before checking whether
|
||||
it is enabled. Clicking a disabled cell button does not activate its parent
|
||||
row, including when their bounds coincide. Ordinary non-interactive row text
|
||||
can still select the row; explicitly focusing the row can activate its action.
|
||||
|
||||
Migration: an extra root `:on-*` callback now appends instead of replacing the
|
||||
existing action. To define a different business action, use the Component's
|
||||
explicit business callback prop or define a Component with that behavior.
|
||||
Fallthrough cannot change an existing `:role` or owned aria state such as
|
||||
`:aria-checked` to a conflicting value; that signals a Component input error.
|
||||
Expose an intentional semantic variation as a business prop. Caller-provided
|
||||
`:aria-label` and `:aria-description` can still override accessible text.
|
||||
|
||||
Use application- or feature-prefixed Action names. Duplicate Action
|
||||
registration is an error. During deliberate reload, wrap the replacement in
|
||||
@ -423,14 +514,9 @@ Mounted buffers enable `etaf-input-mode` automatically. `TAB` focuses the next H
|
||||
|
||||
Use Context for a dependency shared across component depth, not for ordinary props:
|
||||
|
||||
<!-- etaf-example: context -->
|
||||
```elisp
|
||||
(etaf-define-component application-shell ()
|
||||
"Provide a service to descendants."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (slot))
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component service-label ()
|
||||
"Read the inherited service."
|
||||
@ -438,13 +524,28 @@ Use Context for a dependency shared across component depth, not for ordinary pro
|
||||
:view
|
||||
(text (expr (format "Service: %s" (etaf-value (etaf-state))))))
|
||||
|
||||
(etaf-define-component application-shell ()
|
||||
"Provide a service to its own child Component."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (service-label))
|
||||
|
||||
(etaf-mount
|
||||
"*etaf-context*"
|
||||
(etaf-view (application-shell (service-label))))
|
||||
(etaf-view (application-shell)))
|
||||
```
|
||||
|
||||
Context keys are ordinary stable symbols. The nearest ancestor wins. `etaf-inject` returns its default for an optional dependency and signals `etaf-context-error` for a required missing dependency. A provided ref or computed value keeps its reactive identity.
|
||||
|
||||
Migration: root-authored slot content retains the root's empty Context, including
|
||||
nested Components. It no longer accidentally receives the slot receiver's
|
||||
providers or Theme. Put a consumer in the provider's own View, as above, or
|
||||
accept an ordinary View-producing callback and call it there when the consumer
|
||||
must use the provider's Context. Use slots when content should retain its
|
||||
author's Context.
|
||||
|
||||
## 10. Data Controllers and DataGrid
|
||||
|
||||
Data is included in ETAF core. A source implements the small source contract:
|
||||
@ -675,7 +776,7 @@ rewrite any function.
|
||||
|
||||
| API family | Main entry points | Use it when |
|
||||
| --- | --- | --- |
|
||||
| View and Runtime | `etaf-view`, `etaf-render`, `etaf-mount`, `etaf-unmount`, `etaf-runtime-flush` | Build, render, mount, or explicitly flush an application |
|
||||
| View and Runtime | `etaf-view`, `etaf-render`, `etaf-mount`, `etaf-unmount`, `etaf-runtime-flush`, `etaf-runtime-snapshot` | Build, render, mount, flush, or explicitly export the committed application |
|
||||
| Components | `etaf-define-component`, `etaf-current-prop`, `etaf-current-slots`, `etaf-component-set-styles`, `etaf-component-redefine-run` | Share a View, retain local state, style an authoring surface, or deliberately reload code |
|
||||
| Reactive state | `etaf-ref`, `etaf-value`, `etaf-set-value`, `etaf-computed` | Store or derive state |
|
||||
| Reactive effects | `etaf-watch`, `etaf-watch-effect`, `etaf-effect-scope`, `etaf-scope-run` | Observe state or synchronize external resources |
|
||||
@ -703,8 +804,8 @@ Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`,
|
||||
- Use `etaf-ui` Components for product controls; core Hosts are the structural foundation.
|
||||
- Stop a Data Controller and unmount a Runtime when their owner is no longer needed.
|
||||
|
||||
For retained updates, keep the application pair declarative: `.etaf` contains
|
||||
the static shell and the same-basename `.el` companion owns state, Components,
|
||||
and actions. Reactive writes are batched into one generation publication;
|
||||
failed publication is retryable, and a non-converging effect is reported rather
|
||||
than allowed to keep the UI busy.
|
||||
Ordinary applications define and mount Components from lexical-binding `.el`
|
||||
files. The optional Playground uses inert `.etaf` structure plus an explicitly
|
||||
registered `.el` companion; core does not discover or execute that pair.
|
||||
Reactive writes within a batch publish one generation. Failed publication is
|
||||
retryable, and a non-converging effect is reported instead of keeping the UI busy.
|
||||
|
||||
@ -7,6 +7,8 @@ ETAF 使用一套很小的词汇构建文本应用：`View`、`Component`、prop
|
||||
ETAF 依赖独立的 Ebox 包。开发时把核心检出目录放入 `load-path`，然后只加载 ETAF 的公共入口：
|
||||
|
||||
```elisp
|
||||
(add-to-list 'load-path "/path/to/github/ecss")
|
||||
(add-to-list 'load-path "/path/to/github/tp")
|
||||
(add-to-list 'load-path "/path/to/github/ebox")
|
||||
(add-to-list 'load-path "/path/to/github/etaf")
|
||||
(require 'etaf)
|
||||
@ -67,6 +69,33 @@ Headless host 或已经知道最终布局上下文的调用方，可以通过可
|
||||
|
||||
View 含有状态型 Component、响应式数据、事件或生命周期时，使用 `etaf-mount`。
|
||||
|
||||
需要显式请求处理待办更新时，调用 `(etaf-runtime-flush runtime)`。
|
||||
它现在返回 **Ebox 已提交 revision 整数**，不再返回旧版的 Ebox 节点。
|
||||
Runtime 忙碌或仍处于批处理时，更新可能继续等待；返回值标识此刻读者可见的
|
||||
发布版本。活动 Ebox/TP 事务内的调用会在请求更新之前报错，因为事务中的
|
||||
revision 可能尚未提交。普通 flush 不导出整棵树，也不强制重建 Root。
|
||||
|
||||
需要当前树及其配套 source facts 时，显式获取快照：
|
||||
|
||||
```elisp
|
||||
(let* ((runtime (etaf-runtime-for-buffer "*etaf-hello*"))
|
||||
(snapshot (etaf-runtime-snapshot runtime)))
|
||||
(list (plist-get snapshot :revision)
|
||||
(plist-get snapshot :mount-id)
|
||||
(ebox-render (plist-get snapshot :input))))
|
||||
```
|
||||
|
||||
快照包含 `:input`（canonical Ebox input）、`:revision` 和 `:mount-id`
|
||||
（本次挂载的身份）。导出成本为 O(N)，会分离节点的普通可变数据；它不处理
|
||||
待办更新，不求值 Component，不发布，也不增加 revision。input 在后续提交或
|
||||
卸载后仍可使用。callback 等不透明能力保持身份，查询不会冻结这些外部能力或
|
||||
显示环境。对未挂载 Runtime 或在活动 Ebox/TP 事务内查询会报错。
|
||||
|
||||
已废弃的 `etaf-runtime-root-node` getter 通过上述 O(N) 查询保留读取兼容性，
|
||||
返回当前唯一根节点；Runtime 不再保存根节点镜像。请迁移到
|
||||
`etaf-runtime-snapshot`，保留 canonical input 中与根节点配套的 source facts；
|
||||
不要再把旧 getter 当作低成本字段读取或写入目标。
|
||||
|
||||
当前 core 不直接加载 `.etaf`。`etaf-define-component` 是结构/样式/行为单元：用 View 定义结构，用 `:styles` 放静态 presentation，用 `:setup` 管理 retained state、Action 和生命周期。未来 `.etaf` SFC 属于把结果编译成同一套 Component 契约的 compiler layer，而不是第二个 Runtime 入口。
|
||||
|
||||
## 3. 属性与子节点
|
||||
@ -94,8 +123,9 @@ View 含有状态型 Component、响应式数据、事件或生命周期时，
|
||||
(etaf-view (text :font-style 'italic "Details"))))))
|
||||
```
|
||||
|
||||
`expr` 只接受一个普通 Elisp form，不能有结构子节点。返回值可以是字符串、typed
|
||||
View、typed View proper sequence 或 `nil`。`if`、`when`、`cond`、`let`、`mapcar` 和
|
||||
`expr` 只接受一个普通 Elisp form，不能有结构子节点。在结构子节点位置，返回值
|
||||
可以是字符串、typed Host 或 Component View、这些值组成的 proper sequence 或 `nil`。
|
||||
在 `text` Host 内，表达式必须返回字符串。`if`、`when`、`cond`、`let`、`mapcar` 和
|
||||
`cl-loop` 仍是普通 Elisp。
|
||||
|
||||
quote 只有普通 Elisp 的含义：
|
||||
@ -106,6 +136,11 @@ quote 只有普通 Elisp 的含义：
|
||||
|
||||
例如 `'bold` 是 `:font-weight` 的 symbol 值，而 `'(text "data")` 只是数据，不会渲染。动态 View 必须写成 `(etaf-view (text "data"))`。
|
||||
|
||||
间距由布局 Host 决定：`row` 与 `column` 使用 `:item-gap`，例如
|
||||
`(row :item-gap 1 ...)`；`flex` 与 `grid` 使用 `:gap`。切换 Host 时也要选择
|
||||
对应的间距属性，两者不是可互换的 alias。例如将 `(row :gap 1 ...)` 改为
|
||||
`(row :item-gap 1 ...)`。
|
||||
|
||||
核心 `grid` Host 用于二维布局：
|
||||
|
||||
```elisp
|
||||
@ -143,20 +178,20 @@ quote 只有普通 Elisp 的含义：
|
||||
(status-label :label "Connected")))
|
||||
```
|
||||
|
||||
Component 的规范名称可以带 `etaf-` 前缀：
|
||||
调用时使用传给 `etaf-define-component` 的准确名称：
|
||||
|
||||
```elisp
|
||||
(etaf-view (etaf-status-label :label "Connected"))
|
||||
(etaf-view (status-label :label "Connected"))
|
||||
```
|
||||
|
||||
在 View 位置，ETAF 也会注册短 alias `status-label`。如果短名称会与 Elisp 冲突，注册表会使用以 `-view` 结尾的语义 alias。这个规则只作用于 View 名称；普通函数仍然保留前缀。
|
||||
注册表不会自动生成 alias。定义为 `etaf-status-label` 的组件必须使用这个准确名称；上面的 `status-label` 是本节自己显式定义的名称。加载 `etaf-ui` 后，官方目录使用 `etaf-button`、`etaf-checkbox` 等准确名称。
|
||||
|
||||
定义宏只接受这些关键字：
|
||||
|
||||
| 关键字 | 作用 |
|
||||
| --- | --- |
|
||||
| `:view` | 声明式 View frontend，与 `:render` 互斥 |
|
||||
| `:render` | 普通 Elisp frontend，通过 `etaf-node` 返回一个 typed View |
|
||||
| `:render` | 普通 Elisp 返回一个 typed View，通常使用 `etaf-view`；程序化构造也可使用 `etaf-node` |
|
||||
| `:setup` | 可选的一次性初始化，返回由 `etaf-state` 读取的 opaque 状态 |
|
||||
| `:styles` | 可选的静态作用域样式声明 |
|
||||
|
||||
@ -170,22 +205,23 @@ Component 自己拥有状态时使用 `:setup`：
|
||||
(etaf-define-component counter (&key title)
|
||||
"Render a retained counter."
|
||||
:setup
|
||||
(let ((count (etaf-ref 0)))
|
||||
(let ((count (etaf-ref 0))
|
||||
(initial-title title))
|
||||
(etaf-on-mounted
|
||||
(lambda () (message "%s mounted" title)))
|
||||
(lambda () (message "%s mounted" initial-title)))
|
||||
(etaf-on-unmounted
|
||||
(lambda () (message "%s unmounted" title)))
|
||||
(lambda () (message "%s unmounted" initial-title)))
|
||||
count)
|
||||
:view
|
||||
:render
|
||||
(let ((count (etaf-state))
|
||||
(caption title))
|
||||
(etaf-view
|
||||
(column
|
||||
(text :font-weight 'bold (expr title))
|
||||
(text (expr (format "Count: %d" (etaf-value (etaf-state)))))
|
||||
(text
|
||||
:role 'button
|
||||
:on-press
|
||||
(let ((count (etaf-state)))
|
||||
(lambda () (cl-incf (etaf-value count))))
|
||||
"Increment")))
|
||||
(text :font-weight 'bold (expr caption))
|
||||
(text (expr (format "Count: %d" (etaf-value count))))
|
||||
(text :role 'button :tab-index 0
|
||||
:on-press (lambda () (cl-incf (etaf-value count)))
|
||||
"Increment")))))
|
||||
```
|
||||
|
||||
Setup 对 retained instance 只执行一次，返回一个 opaque 状态值。选定的 `:view` 或
|
||||
@ -193,6 +229,12 @@ Setup 对 retained instance 只执行一次，返回一个 opaque 状态值。
|
||||
`etaf-on-mounted`、`etaf-on-updated` 和 `etaf-on-unmounted` 注册该 Component 的生命周期
|
||||
callback。Scope 释放时会自动停止响应式 effect 并运行 cleanup。
|
||||
|
||||
`:view` 和 `:render` 共用编译、slot 投影与 prop 校验。用普通 `let`/`let*`
|
||||
为回调捕获 state 句柄或当前 prop 值；`etaf-state` 只在 render 时读取，不留到
|
||||
事件触发时调用。把 `etaf-value` 保留在需要更新的属性或 `expr` 内；提取句柄
|
||||
不需要提前读取它的值。含有持久闭包的组件代码放在启用 lexical-binding 的 `.el`
|
||||
文件中。简单本地回调不需要定义 Action。
|
||||
|
||||
响应式 API 只有一套模型：
|
||||
|
||||
```elisp
|
||||
@ -255,6 +297,12 @@ callback。Scope 释放时会自动停止响应式 effect 并运行 cleanup。
|
||||
|
||||
默认 slot 的两个用户简写是 `(slot)` 和 `(slot FALLBACK...)`。内部统一形式是 `(slot :name 'default FALLBACK...)`。调用处的普通子节点填充 `default`；命名内容写成 `(slot :name 'header CHILD...)`。显式空的 `(slot :name 'header)` 会抑制 fallback。字符串、数字、变量和运行时表达式都不是合法 slot name。
|
||||
|
||||
Slot 中作者写下的表达式在整个投影子树中保留作者的 props、state 和 Context。
|
||||
其中创建的 Component 仍有自己的 props、state、styles 和 Scope，其 Context 从
|
||||
slot 作者环境继承。接收 slot 的 Component 不会把自己的 Context 注入调用者内容。
|
||||
它自己定义的 fallback、普通子节点，以及产生 View 的 callback 使用接收方环境。
|
||||
Table/Grid 的 cell callback 同样使用消费它的 Table/Grid 所在位置的 Context。
|
||||
|
||||
在结构边界，`expr` 可以返回 typed View 或 typed View 的 proper sequence，但它不暴露、
|
||||
也不接受 ETAF 私有 struct。同一个 Component 可以组合 keyed `:for`、结构表达式和
|
||||
命名 footer slot：
|
||||
@ -308,13 +356,22 @@ variant 需要明确覆盖，应使用显式 Host 属性或不同的属性键。
|
||||
|
||||
Theme 是 Context 的便捷形式，不是另一个 Runtime 对象：
|
||||
|
||||
<!-- etaf-example: theme -->
|
||||
```elisp
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component themed-shell ()
|
||||
"Provide default text colors to a subtree."
|
||||
"Provide semantic colors to its own View."
|
||||
:setup
|
||||
(etaf-theme-provide
|
||||
'(:color "#F4F6FB" :bgcolor "#202634"))
|
||||
:view (slot))
|
||||
'(:text-color "#F4F6FB" :surface-color "#202634"))
|
||||
:view
|
||||
(text :ref 'themed-content
|
||||
:color (etaf-theme-token :text-color)
|
||||
:background-color (etaf-theme-token :surface-color)
|
||||
"Themed content"))
|
||||
|
||||
(etaf-mount "*etaf-theme*" (etaf-view (themed-shell)))
|
||||
```
|
||||
|
||||
如果应用有亮/暗两套 palette，应把语义 role 集中放在一份 palette plist 中，
|
||||
@ -390,10 +447,30 @@ Behavior 用来打包可复用的非视觉属性和 cleanup：
|
||||
|
||||
Installer 需要 Runtime 或 Host path 时，可以调用 `etaf-current-behavior-context`。Behavior 被替换时，旧 cleanup 会在新状态成为当前状态前运行。Behavior equality 对 function 和 reactive value 使用 `eq`；因此新建的 installer closure 会被视为有意替换，而不是错误复用。替换状态先以 mounted resource registry 的 staged resource 保存，generation commit 后才成为 authority。
|
||||
|
||||
组合规则固定：Host callback 先于 Behavior callback，Behavior 按声明顺序运行，callback
|
||||
error 会 short-circuit 剩余 callback。非事件属性先由 Host 获胜，否则由第一个
|
||||
Behavior 获胜（first-wins）。重复 Behavior name 在 installer 前失败；稳定 installer 会复用，每个
|
||||
已安装 cleanup exactly-once。dispatch 只命中准确 Host，不存在 capture 或 bubble。
|
||||
<a id="interaction-migration"></a>
|
||||
|
||||
根事件透传采用追加规则：内部业务 handler 最先运行（first），然后是由内到外
|
||||
wrapper 附加的 callback，最后是按声明顺序运行的 Behavior。每个声明位置执行
|
||||
一次。Checkbox 的 `:on-change` 仍先收到下一个布尔值，附加的 `:on-press`
|
||||
观察回调随后运行。callback 报错会 short-circuit 剩余回调；UI 回滚不会撤销外部
|
||||
业务写入。dispatch 只命中准确 Host，不存在 capture 或 bubble。
|
||||
|
||||
wrapper 的 `:use` 列表顺序连接，重复 Behavior name 在任何 installer 运行前报错。
|
||||
非事件 Behavior 默认值仍由 Host 优先、其余 first-wins；`:disabled` 则取 OR。
|
||||
每次更新都重新计算内外禁用输入：调用方可进一步禁用控件；解除外层禁用时，只有
|
||||
内部也为 nil 才能启用。禁用 Host 的 `etaf-dispatch-event` 和 `etaf-focus` 会抛出
|
||||
`etaf-event-error`。禁用时不安装输入 Behavior；提交禁用时清理已安装资源，重新启用
|
||||
时再安装。
|
||||
|
||||
命中测试先选择最深的交互边界，再检查是否启用。点击禁用 cell 按钮不会激活父行，
|
||||
即使按钮与行的 bounds 相同。普通非交互行文本仍可选择该行；显式聚焦行后也可触发
|
||||
行动作。
|
||||
|
||||
迁移时注意：附加的根 `:on-*` 现在追加执行，不再覆盖原动作。需要不同业务动作时，
|
||||
使用组件显式公开的业务 callback prop，或定义具有该行为的组件。透传属性不能把
|
||||
已有的 `:role` 或 `:aria-checked` 等归组件所有的 aria 状态改成冲突值，否则报
|
||||
Component 输入错误；有意提供语义变体时应公开业务 prop。调用方仍可覆盖
|
||||
`:aria-label` 与 `:aria-description` 的可访问性文字。
|
||||
|
||||
Action name 使用 application/feature-prefixed symbol；重复 Action 注册默认报错。显式
|
||||
reload 用 `etaf-action-redefine-run` 包住替换，它只改变未来按 name 的 dispatch，不会
|
||||
@ -415,14 +492,9 @@ Focus 和 hit testing 是 Runtime 操作：
|
||||
|
||||
Context 适合跨多层共享依赖，不适合普通 label：
|
||||
|
||||
<!-- etaf-example: context -->
|
||||
```elisp
|
||||
(etaf-define-component application-shell ()
|
||||
"Provide a service to descendants."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (slot))
|
||||
(require 'etaf)
|
||||
|
||||
(etaf-define-component service-label ()
|
||||
"Read the inherited service."
|
||||
@ -430,13 +502,27 @@ Context 适合跨多层共享依赖，不适合普通 label：
|
||||
:view
|
||||
(text (expr (format "Service: %s" (etaf-value (etaf-state))))))
|
||||
|
||||
(etaf-define-component application-shell ()
|
||||
"Provide a service to its own child Component."
|
||||
:setup
|
||||
(let ((service (etaf-ref "demo-service")))
|
||||
(etaf-provide 'service service)
|
||||
service)
|
||||
:view (service-label))
|
||||
|
||||
(etaf-mount
|
||||
"*etaf-context*"
|
||||
(etaf-view (application-shell (service-label))))
|
||||
(etaf-view (application-shell)))
|
||||
```
|
||||
|
||||
Context key 是稳定的普通 symbol，最近的祖先优先。`etaf-inject` 对可选依赖返回 default，对必需但缺失的依赖触发 `etaf-context-error`。注入的 ref 或 computed 保留自身响应式 identity。
|
||||
|
||||
迁移：在根位置编写的 slot 内容保留根的空 Context，其中的嵌套 Component 也
|
||||
不会意外接收 slot 接收方的 provider 或 Theme。若消费者需要 provider 的
|
||||
Context，应像上例一样写在 provider 自己的 View 中；需要外部定制时，可接收
|
||||
普通的 View-producing callback 并在该位置调用。内容需要保留作者 Context 时
|
||||
使用 slot。
|
||||
|
||||
## 10. Data Controller 与 DataGrid
|
||||
|
||||
Data 已经是 ETAF core 能力。Data Source 实现一个小的 source 契约：
|
||||
@ -657,7 +743,7 @@ observer，不修改任何函数。
|
||||
|
||||
| API 家族 | 主要入口 | 何时使用 |
|
||||
| --- | --- | --- |
|
||||
| View 与 Runtime | `etaf-view`、`etaf-render`、`etaf-mount`、`etaf-unmount`、`etaf-runtime-flush` | 构建、渲染、挂载或显式 flush 应用 |
|
||||
| View 与 Runtime | `etaf-view`、`etaf-render`、`etaf-mount`、`etaf-unmount`、`etaf-runtime-flush`、`etaf-runtime-snapshot` | 构建、渲染、挂载、flush 或显式导出已提交应用 |
|
||||
| Component | `etaf-define-component`、`etaf-current-prop`、`etaf-current-slots`、`etaf-component-set-styles`、`etaf-component-redefine-run` | 复用 View、保留局部状态、设置 authoring 样式或显式重载代码 |
|
||||
| 响应式状态 | `etaf-ref`、`etaf-value`、`etaf-set-value`、`etaf-computed` | 保存或派生状态 |
|
||||
| 响应式 effect | `etaf-watch`、`etaf-watch-effect`、`etaf-effect-scope`、`etaf-scope-run` | 观察状态或同步外部资源 |
|
||||
@ -685,7 +771,7 @@ observer，不修改任何函数。
|
||||
- 产品级控件使用 `etaf-ui` Component；core Host 只是结构基础。
|
||||
- owner 不再需要时，停止 Data Controller 并卸载 Runtime。
|
||||
|
||||
对于保留式更新，建议保持 pair 结构：`.etaf` 只放静态 shell，同名 `.el` companion
|
||||
负责 state、Component 和 action。响应式写入会合并为一次 generation publication；
|
||||
发布失败可以在同一旧状态上重试，non-converging effect 会报告错误，不会让界面
|
||||
持续占用事件循环。
|
||||
普通应用在启用 lexical-binding 的 `.el` 文件中定义并挂载 Component。可选的
|
||||
Playground 使用 inert `.etaf` 结构与显式注册的 `.el` companion；core 不会自动
|
||||
发现或执行这组文件。同一 batch 内的响应式写入合并为一次 generation publication；
|
||||
发布失败可以重试，non-converging effect 会报告错误，不会持续占用事件循环。
|
||||
|
||||
@ -4,13 +4,14 @@
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; Components have one public definition boundary with two strict authoring
|
||||
;; Components have one public definition boundary with two authoring
|
||||
;; frontends: compiled `:view' DSL and ordinary Elisp `:render'. Optional
|
||||
;; `:setup' runs once and returns opaque state read through `etaf-state'.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'cl-lib)
|
||||
(require 'macroexp)
|
||||
(require 'etaf-view)
|
||||
(require 'etaf-compiler)
|
||||
|
||||
@ -229,8 +230,11 @@ or:
|
||||
:styles (styles (SELECTOR ATTR ...)))
|
||||
|
||||
`:setup' runs once per retained identity and returns opaque state. `:view'
|
||||
is unquoted DSL; `:render' is ordinary Elisp and constructs nodes with
|
||||
`etaf-node'."
|
||||
is unquoted DSL; `:render' is ordinary Elisp returning the same typed View,
|
||||
usually through `etaf-view'. `etaf-node' also constructs Views
|
||||
programmatically. Both frontends use the same prop and slot rules. Bind state
|
||||
handles and prop snapshots to lexical locals for later event callbacks; keep
|
||||
reactive value reads inside the View properties or expressions they update."
|
||||
(declare (indent 2) (debug defun))
|
||||
(unless (symbolp name)
|
||||
(etaf--component-definition-error
|
||||
@ -292,10 +296,6 @@ is unquoted DSL; `:render' is ordinary Elisp and constructs nodes with
|
||||
(memq (car setup-form) '(lambda function)))
|
||||
(etaf--component-definition-error
|
||||
"Component %S :setup cannot return a render function" name))
|
||||
(when (and saw-render
|
||||
(etaf--component-form-contains-head-p render-form '(etaf-view)))
|
||||
(etaf--component-definition-error
|
||||
"Component %S :render cannot embed the DSL frontend" name))
|
||||
(let* ((props (etaf--parse-component-props arguments))
|
||||
(styles-form (etaf--validate-styles-form styles-form name))
|
||||
(definition-symbol
|
||||
@ -305,13 +305,18 @@ is unquoted DSL; `:render' is ordinary Elisp and constructs nodes with
|
||||
(let ((etaf--current-component-props etaf--component-props)
|
||||
(etaf--current-component-slots etaf--component-slots)
|
||||
(etaf--component-phase 'render))
|
||||
(cl-symbol-macrolet
|
||||
,(let ((etaf--compiling-component-props props))
|
||||
;; Expand every embedded View inside its Component prop
|
||||
;; grammar, including Views produced by lexical macros.
|
||||
;; Include the prop bindings so they shadow outer symbol
|
||||
;; macros while ordinary let/lambda shadowing is preserved.
|
||||
(macroexpand-all
|
||||
`(cl-symbol-macrolet
|
||||
,(etaf--component-prop-symbol-macros props)
|
||||
,(if saw-view
|
||||
(let ((etaf--compiling-component-props props))
|
||||
(etaf-compiler-expand-view
|
||||
view-form :projection))
|
||||
render-form)))))
|
||||
(etaf-compiler-expand-view view-form :projection)
|
||||
render-form))
|
||||
macroexpand-all-environment)))))
|
||||
(setup-lambda
|
||||
(when saw-setup
|
||||
`(lambda (etaf--component-props _etaf--component-slots)
|
||||
|
||||
109
etaf-events.el
109
etaf-events.el
@ -27,6 +27,7 @@
|
||||
(declare-function etaf-runtime-handler-entries "etaf-runtime" (runtime))
|
||||
(declare-function etaf-runtime-host-props-for "etaf-runtime" (runtime host-ref))
|
||||
(declare-function etaf-runtime-host-props-entries "etaf-runtime" (runtime))
|
||||
(declare-function etaf-runtime-host-ancestries "etaf-runtime" (runtime host-refs))
|
||||
(declare-function etaf-runtime-focus-ref "etaf-runtime" (runtime))
|
||||
(declare-function etaf-runtime-set-focus-ref "etaf-runtime" (runtime host-ref))
|
||||
(declare-function etaf-runtime-event-begin "etaf-runtime" (runtime))
|
||||
@ -71,6 +72,11 @@ otherwise call the local callback with no arguments."
|
||||
(setq runtime (etaf-runtime-require-mounted runtime))
|
||||
(let* ((dispatch
|
||||
(lambda ()
|
||||
(when (plist-get (etaf-runtime-host-props-for runtime host-ref)
|
||||
:disabled)
|
||||
(signal 'etaf-event-error
|
||||
(list (format "Cannot dispatch to disabled Host reference: %S"
|
||||
host-ref))))
|
||||
(let ((callback (etaf--event-handler runtime host-ref kind)))
|
||||
(unless callback
|
||||
(signal 'etaf-event-error
|
||||
@ -119,51 +125,81 @@ otherwise call the local callback with no arguments."
|
||||
(t nil)))
|
||||
|
||||
(defun etaf--activation-candidate-before-p (left right)
|
||||
"Return non-nil when activation candidate LEFT precedes RIGHT."
|
||||
"Return non-nil when hit candidate LEFT is inside or smaller than RIGHT."
|
||||
(let ((left-length (nth 2 left))
|
||||
(right-length (nth 2 right))
|
||||
(left-start (nth 1 left))
|
||||
(right-start (nth 1 right)))
|
||||
(or (< left-length right-length)
|
||||
(right-start (nth 1 right))
|
||||
(left-lineage (nth 3 left))
|
||||
(right-lineage (nth 3 right)))
|
||||
(cond
|
||||
((and right-lineage (memq (car right-lineage) left-lineage)) t)
|
||||
((and left-lineage (memq (car left-lineage) right-lineage)) nil)
|
||||
(t (or (< left-length right-length)
|
||||
(and (= left-length right-length)
|
||||
(or (< left-start right-start)
|
||||
(and (= left-start right-start)
|
||||
(string< (prin1-to-string (car left))
|
||||
(prin1-to-string (car right)))))))))
|
||||
(< left-start right-start)))))))
|
||||
|
||||
(defun etaf--interaction-boundary-p (props)
|
||||
"Return non-nil when committed PROPS describe an interaction boundary.
|
||||
Disabled and callbackless controls still own their hit area. Ordinary text
|
||||
with only a reference or accessibility label remains part of its parent."
|
||||
(or (functionp (plist-get props :on-press))
|
||||
(plist-get props :disabled)
|
||||
(numberp (plist-get props :tab-index))
|
||||
(member (let ((role (plist-get props :role)))
|
||||
(if (symbolp role) (symbol-name role) role))
|
||||
'("button" "checkbox" "combobox" "link" "menuitem" "option"
|
||||
"radio" "slider" "spinbutton" "switch" "tab" "textbox"
|
||||
"treeitem"))))
|
||||
|
||||
(defun etaf--activation-at-position (runtime position &optional quiet)
|
||||
"Activate the smallest enabled Host at POSITION in RUNTIME.
|
||||
"Activate the deepest interaction boundary at POSITION in RUNTIME.
|
||||
|
||||
When QUIET is non-nil, return nil instead of signaling when no callback owns
|
||||
the position."
|
||||
(let (candidates)
|
||||
(dolist (entry (etaf-runtime-handler-entries runtime))
|
||||
(let ((host-ref (car entry)) (handlers (cdr entry)))
|
||||
(let* ((press (assq 'press handlers))
|
||||
(props (etaf-runtime-host-props-for runtime host-ref))
|
||||
(bounds (ebox-host-ref-bounds
|
||||
(dolist (entry (etaf-runtime-host-props-entries runtime))
|
||||
(let ((host-ref (car entry)) (props (cdr entry)))
|
||||
(when (etaf--interaction-boundary-p props)
|
||||
(let* ((bounds (ebox-host-ref-bounds
|
||||
(etaf-runtime-buffer runtime) host-ref))
|
||||
(start (and bounds (car bounds)))
|
||||
(end (and bounds (cdr bounds))))
|
||||
(when (and press (not (plist-get props :disabled))
|
||||
start end (<= start position) (< position end))
|
||||
(push (list host-ref start (- end start)) candidates)))))
|
||||
(setq candidates (sort candidates #'etaf--activation-candidate-before-p))
|
||||
(if-let* ((candidate (car candidates)))
|
||||
(etaf-dispatch-event runtime (car candidate) 'press)
|
||||
(when (and start end (<= start position) (< position end))
|
||||
(push (list host-ref start (- end start)) candidates))))))
|
||||
(when (cdr candidates)
|
||||
(let ((ancestries
|
||||
(etaf-runtime-host-ancestries runtime (mapcar #'car candidates))))
|
||||
(dolist (candidate candidates)
|
||||
(setcdr (last candidate) (list (gethash (car candidate) ancestries)))))
|
||||
(setq candidates (cl-stable-sort
|
||||
candidates #'etaf--activation-candidate-before-p)))
|
||||
(if-let* ((candidate (car candidates))
|
||||
(ref (car candidate))
|
||||
((not (plist-get (etaf-runtime-host-props-for runtime ref)
|
||||
:disabled)))
|
||||
((etaf--event-handler runtime ref 'press)))
|
||||
(etaf-dispatch-event runtime ref 'press)
|
||||
(unless quiet
|
||||
(user-error "No interactive ETAF Host at point")))))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-activate (&optional runtime)
|
||||
"Dispatch `press' for the smallest enabled Host containing point.
|
||||
"Dispatch `press' for the focused Host, or the interaction boundary at point.
|
||||
|
||||
RUNTIME is the mounted Runtime to activate, or nil for the current buffer."
|
||||
(interactive)
|
||||
(setq runtime (etaf-runtime-require-mounted runtime))
|
||||
(let ((position (with-current-buffer (etaf-runtime-buffer runtime)
|
||||
(point))))
|
||||
(etaf--activation-at-position runtime position)))
|
||||
(let ((position (with-current-buffer (etaf-runtime-buffer runtime) (point)))
|
||||
(focus-ref (etaf-runtime-focus-ref runtime)))
|
||||
(if (and focus-ref
|
||||
(equal position (etaf-host-ref-position runtime focus-ref)))
|
||||
(if (and (not (plist-get
|
||||
(etaf-runtime-host-props-for runtime focus-ref) :disabled))
|
||||
(etaf--event-handler runtime focus-ref 'press))
|
||||
(etaf-dispatch-event runtime focus-ref 'press)
|
||||
(user-error "No interactive ETAF Host at point"))
|
||||
(etaf--activation-at-position runtime position))))
|
||||
|
||||
(defun etaf--focus-candidate-before-p (left right)
|
||||
"Return non-nil when focus candidate LEFT precedes RIGHT."
|
||||
@ -191,6 +227,30 @@ RUNTIME is the mounted Runtime to activate, or nil for the current buffer."
|
||||
candidates))))))
|
||||
(sort candidates #'etaf--focus-candidate-before-p)))
|
||||
|
||||
(defun etaf-events-call-with-preserved-focus (runtime function)
|
||||
"Call FUNCTION while retaining RUNTIME's active focus through publication.
|
||||
Follow a Host's new position only when point started at that focused Host,
|
||||
the same focus survives, and a new generation actually committed. Manual
|
||||
point movement and failed candidate publication keep their existing behavior."
|
||||
(let* ((buffer (etaf-runtime-buffer runtime))
|
||||
(focus-ref (etaf-runtime-focus-ref runtime))
|
||||
(follow-p
|
||||
(and focus-ref (buffer-live-p buffer)
|
||||
(equal (with-current-buffer buffer (point))
|
||||
(ebox-host-ref-position buffer focus-ref)))))
|
||||
(if (not follow-p)
|
||||
(funcall function)
|
||||
(let ((generation (etaf-runtime-current-generation runtime)))
|
||||
(unwind-protect
|
||||
(funcall function)
|
||||
(when (and (etaf-runtime-mounted-p runtime)
|
||||
(buffer-live-p buffer)
|
||||
(equal focus-ref (etaf-runtime-focus-ref runtime))
|
||||
(not (eq generation
|
||||
(etaf-runtime-current-generation runtime))))
|
||||
(when-let* ((position (ebox-host-ref-position buffer focus-ref)))
|
||||
(with-current-buffer buffer (goto-char position)))))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun etaf-focus (&optional runtime host-ref)
|
||||
"Move focus to HOST-REF in mounted RUNTIME and move point to its position.
|
||||
@ -202,6 +262,9 @@ When called interactively without arguments, focus the first visible Host."
|
||||
(setq host-ref (nth 3 (car (etaf--focus-candidates runtime))))
|
||||
(unless host-ref
|
||||
(user-error "No focusable ETAF Host")))
|
||||
(when (plist-get (etaf-runtime-host-props-for runtime host-ref) :disabled)
|
||||
(signal 'etaf-event-error
|
||||
(list (format "Cannot focus disabled Host reference: %S" host-ref))))
|
||||
(let ((position (etaf-host-ref-position runtime host-ref)))
|
||||
(unless position
|
||||
(signal 'etaf-event-error
|
||||
|
||||
@ -63,7 +63,8 @@ because it contains v2; ETAF never dispatches through its v1 capability.")
|
||||
(update-function nil :read-only t)
|
||||
(revision-function nil :read-only t)
|
||||
(bootstrap-outcome nil :read-only t)
|
||||
(provider nil :read-only t))
|
||||
(provider nil :read-only t)
|
||||
(snapshot-function nil :read-only t))
|
||||
|
||||
(defun etaf-render-port-route (port)
|
||||
"Return selected PORT route, always `v2'."
|
||||
@ -94,9 +95,13 @@ because it contains v2; ETAF never dispatches through its v1 capability.")
|
||||
(etaf-render-port--update-function port))
|
||||
|
||||
(defun etaf-render-port-revision-function (port)
|
||||
"Return PORT's committed-revision query function symbol."
|
||||
"Return PORT's current-revision query function symbol."
|
||||
(etaf-render-port--revision-function port))
|
||||
|
||||
(defun etaf-render-port-snapshot-function (port)
|
||||
"Return PORT's explicit committed-snapshot query function symbol."
|
||||
(etaf-render-port--snapshot-function port))
|
||||
|
||||
(defun etaf-render-port-bootstrap-outcome (port)
|
||||
"Return PORT's immutable bootstrap outcome tag."
|
||||
(etaf-render-port--bootstrap-outcome port))
|
||||
@ -107,7 +112,7 @@ because it contains v2; ETAF never dispatches through its v1 capability.")
|
||||
(list :reason reason :detail detail)))
|
||||
|
||||
(defun etaf-render-port--ensure-accessors ()
|
||||
"Require every public Ebox v2 record accessor before reading a provider."
|
||||
"Require Ebox's public v2 accessors and explicit snapshot query."
|
||||
(dolist
|
||||
(function
|
||||
'(ebox-framework-spi-provider-p
|
||||
@ -126,7 +131,8 @@ because it contains v2; ETAF never dispatches through its v1 capability.")
|
||||
ebox-framework-spi-operation-argument-schema
|
||||
ebox-framework-spi-operation-result-schema
|
||||
ebox-framework-spi-operation-paired-stage-rollback-p
|
||||
ebox-framework-spi-initial-observation-reports))
|
||||
ebox-framework-spi-initial-observation-reports
|
||||
ebox-surface-buffer-snapshot))
|
||||
(unless (fboundp function)
|
||||
(etaf-render-port--bootstrap-error
|
||||
'missing-provider-accessor function))))
|
||||
@ -272,6 +278,7 @@ because it contains v2; ETAF never dispatches through its v1 capability.")
|
||||
:update-function
|
||||
(plist-get (plist-get snapshot :update) :function)
|
||||
:revision-function 'ebox-surface-buffer-revision
|
||||
:snapshot-function 'ebox-surface-buffer-snapshot
|
||||
:bootstrap-outcome 'valid-v2-selected
|
||||
:provider (plist-get snapshot :provider))))
|
||||
|
||||
@ -338,7 +345,9 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair."
|
||||
(ebox-surface-buffer-mounted-p buffer))
|
||||
|
||||
(defun etaf-render-port-revision (buffer)
|
||||
"Return BUFFER's committed Ebox revision, or zero when it is unmounted."
|
||||
"Return BUFFER's current Ebox revision, or zero when it is unmounted.
|
||||
During an active TP transaction this can be a provisional revision for the
|
||||
paired publication stage. Public committed queries must exclude that extent."
|
||||
(let ((buffer (get-buffer buffer)))
|
||||
(if (not (and (buffer-live-p buffer)
|
||||
(ebox-surface-buffer-mounted-p buffer)))
|
||||
@ -353,6 +362,23 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair."
|
||||
revision))
|
||||
revision))))
|
||||
|
||||
(defun etaf-render-port-snapshot (buffer)
|
||||
"Export BUFFER's committed canonical input, revision, and mount identity.
|
||||
Ebox owns this explicit O(N) detached export and rejects unavailable or
|
||||
transactional reads. The port validates only its envelope and never copies,
|
||||
publishes, or queries private renderer state."
|
||||
(let ((snapshot
|
||||
(funcall
|
||||
(etaf-render-port-snapshot-function etaf-render-port--selected-port)
|
||||
buffer)))
|
||||
(unless (and (proper-list-p snapshot)
|
||||
(ebox-canonical-input-p (plist-get snapshot :input))
|
||||
(integerp (plist-get snapshot :revision))
|
||||
(> (plist-get snapshot :revision) 0)
|
||||
(integerp (plist-get snapshot :mount-id)))
|
||||
(error "Malformed Ebox committed snapshot"))
|
||||
snapshot))
|
||||
|
||||
(provide 'etaf-render-port)
|
||||
|
||||
;;; etaf-render-port.el ends here
|
||||
|
||||
@ -117,6 +117,21 @@
|
||||
(defvar etaf--rendering-range-p nil
|
||||
"Non-nil while eagerly lowering descendants of one Range item Host.")
|
||||
|
||||
(defvar etaf--render-parent-path nil
|
||||
"Structural path of the current retained semantic parent.")
|
||||
|
||||
(defvar etaf--render-site-counts nil
|
||||
"Occurrence counts distinguishing reused compiled sites under each parent.")
|
||||
|
||||
(defun etaf--render-site-token (token)
|
||||
"Qualify repeated TOKEN occurrences within their mounted semantic parent."
|
||||
(if (or (null token) (null etaf--render-site-counts))
|
||||
token
|
||||
(let* ((key (list etaf--current-semantic-parent-id token))
|
||||
(index (gethash key etaf--render-site-counts 0)))
|
||||
(puthash key (1+ index) etaf--render-site-counts)
|
||||
(if (zerop index) token (list :site token :occurrence index)))))
|
||||
|
||||
(defvar etaf--ebox-source-builder nil
|
||||
"Source builder owned by the current ETAF lowering boundary.")
|
||||
|
||||
@ -125,10 +140,8 @@
|
||||
(unless etaf--ebox-source-builder
|
||||
(signal 'etaf-renderer-error
|
||||
(list "Canonical Ebox input escaped its lowering boundary")))
|
||||
(ebox-source-builder-import
|
||||
etaf--ebox-source-builder
|
||||
(ebox-canonical-input--source-index input))
|
||||
(copy-sequence (ebox-canonical-input--nodes input)))
|
||||
(ebox-canonical-input-import-roots
|
||||
input (ebox-canonical-input-roots input) etaf--ebox-source-builder))
|
||||
|
||||
(defun etaf--ebox-input-for-nodes (nodes)
|
||||
"Snapshot current source facts for canonical forest NODES."
|
||||
@ -143,12 +156,11 @@
|
||||
"Return PROPS' explicit Host reference or one generated for PATH.
|
||||
SITE-TOKEN replaces PATH as the generated call-site identity when non-nil."
|
||||
(or (plist-get props :ref)
|
||||
(let ((site (or site-token (copy-sequence path))))
|
||||
(let ((site (or (and (plist-get props :key)
|
||||
(list :key (plist-get props :key)))
|
||||
site-token (copy-sequence path))))
|
||||
(list 'etaf-host
|
||||
(cond
|
||||
(etaf--rendering-range-p
|
||||
(list :range etaf--current-semantic-parent-id
|
||||
:site site))
|
||||
(etaf--render-runtime
|
||||
(list :parent etaf--current-semantic-parent-id :site site))
|
||||
(t
|
||||
@ -267,12 +279,18 @@ tokens, not Ebox Host properties, and therefore are not materialized here."
|
||||
(props (copy-sequence
|
||||
(etaf--resolve-property-plist
|
||||
(etaf--view-node-props node))))
|
||||
(template (etaf--theme-host-defaults defaults name)))
|
||||
(template (etaf--theme-host-defaults defaults name))
|
||||
(present (make-hash-table :test #'eq)))
|
||||
(cl-loop for (key value) on props by #'cddr
|
||||
when value do
|
||||
(puthash (etaf--property-domain-key key) t present))
|
||||
(while template
|
||||
(let ((key (pop template))
|
||||
(value (pop template)))
|
||||
(unless (plist-get props key)
|
||||
(setq props (etaf--merge-property props key value)))))
|
||||
(unless (gethash (etaf--property-domain-key key) present)
|
||||
(setq props (etaf--merge-property props key value))
|
||||
(when value
|
||||
(puthash (etaf--property-domain-key key) t present)))))
|
||||
(etaf--view-node-create
|
||||
:name name
|
||||
:token (etaf--view-node-token node)
|
||||
@ -494,11 +512,11 @@ SITE-TOKEN supplies the stable generated Host identity when non-nil."
|
||||
:class (plist-get props :class)
|
||||
:declarations declarations
|
||||
:provenance (list :adapter 'etaf-renderer :tag tag))))
|
||||
(let ((ebox-canonical--source-builder etaf--ebox-source-builder))
|
||||
(ebox-box-create
|
||||
:layout layout :outer outer :children children
|
||||
:source-builder etaf--ebox-source-builder
|
||||
:owned-facts (ebox-canonical-facts-from-declarations tag declarations)
|
||||
:source-handle source-handle))))
|
||||
:source-handle source-handle)))
|
||||
|
||||
(defun etaf--ebox-forest-root (nodes source-identity)
|
||||
"Return one canonical backend root for ordered forest NODES.
|
||||
@ -624,12 +642,27 @@ multi-root forest; a single material root is returned unchanged."
|
||||
(defun etaf--render-value-list (value path)
|
||||
"Render VALUE at structural PATH into a list of Ebox nodes."
|
||||
(let* ((items (etaf--flatten-view-value value))
|
||||
(multiple-p (> (length items) 1)))
|
||||
(multiple-p (or (proper-list-p value) (> (length items) 1)))
|
||||
(etaf--render-site-counts
|
||||
(or etaf--render-site-counts (make-hash-table :test #'equal)))
|
||||
(keys (make-hash-table :test #'equal)))
|
||||
;; Validate the entire sibling set before any Component setup runs.
|
||||
(dolist (item items)
|
||||
(let* ((props (cond ((etaf--view-node-p item)
|
||||
(etaf--view-node-props item))
|
||||
((etaf--component-call-p item)
|
||||
(etaf--component-call-props item))))
|
||||
(key (etaf--resolve-property-value (plist-get props :key))))
|
||||
(when key
|
||||
(when (gethash key keys)
|
||||
(signal (if etaf--render-runtime
|
||||
'etaf-runtime-error 'etaf-renderer-error)
|
||||
(list (format "View at %S has duplicate sibling key: %S"
|
||||
path key))))
|
||||
(puthash key t keys))))
|
||||
(cl-loop for item in items
|
||||
for index from 0
|
||||
for item-path = (if multiple-p
|
||||
(append path (list index))
|
||||
path)
|
||||
for item-path = (if multiple-p (append path (list index)) path)
|
||||
append
|
||||
(cond
|
||||
((stringp item)
|
||||
@ -670,7 +703,11 @@ multi-root forest; a single material root is returned unchanged."
|
||||
|
||||
(defun etaf--render-node (node path)
|
||||
"Render normalized Host NODE at structural PATH."
|
||||
(let* ((node (if (and etaf--render-runtime
|
||||
(let* ((node (let ((copy (copy-sequence node)))
|
||||
(setf (etaf--view-node-token copy)
|
||||
(etaf--render-site-token (etaf--view-node-token node)))
|
||||
copy))
|
||||
(node (if (and etaf--render-runtime
|
||||
(fboundp 'etaf--runtime-behavior-node))
|
||||
(etaf--runtime-behavior-node
|
||||
etaf--render-runtime node path)
|
||||
@ -736,6 +773,7 @@ multi-root forest; a single material root is returned unchanged."
|
||||
(etaf--render-value-list children (append path (list :fragment))))
|
||||
((or 'box 'row 'column 'flex 'grid)
|
||||
(let ((nodes nil)
|
||||
(etaf--render-parent-path path)
|
||||
(index 0)
|
||||
(range-child-p nil)
|
||||
(semantic-id
|
||||
@ -819,7 +857,7 @@ RANGE-CHILD-P preserves the direct material Range parent."
|
||||
((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"
|
||||
(list (format "Expected text, box, row, column, flex, or grid Host; received %S"
|
||||
name))))))
|
||||
|
||||
;;;###autoload
|
||||
|
||||
828
etaf-runtime.el
828
etaf-runtime.el
File diff suppressed because it is too large
Load Diff
74
etaf-view.el
74
etaf-view.el
@ -260,11 +260,41 @@ disposing the old Runtime.")
|
||||
(etaf--resolve-property-value root-value)
|
||||
(etaf--resolve-property-value caller-value)))
|
||||
|
||||
(defun etaf--compose-event-callbacks (primary secondary)
|
||||
"Compose PRIMARY then SECONDARY, preserving the primary return value.
|
||||
An error stops the chain. This shared value operation lives with View
|
||||
composition so pure render and Runtime Behavior use the same contract."
|
||||
(dolist (callback (list primary secondary))
|
||||
(unless (or (null callback) (functionp callback))
|
||||
(etaf--component-error "Event callback must be a function or nil: %S"
|
||||
callback)))
|
||||
(cond
|
||||
((null primary) secondary)
|
||||
((null secondary) primary)
|
||||
(t
|
||||
(lambda (&rest arguments)
|
||||
(prog1 (apply primary arguments)
|
||||
(apply secondary arguments))))))
|
||||
|
||||
(defun etaf--owned-semantic-property-p (property)
|
||||
"Return non-nil when fallthrough PROPERTY must preserve root semantics."
|
||||
(or (eq property :role)
|
||||
(and (etaf--aria-property-p property)
|
||||
(not (memq property '(:aria-label :aria-description))))))
|
||||
|
||||
(defun etaf--merge-use-input (root-value caller-value)
|
||||
"Concatenate possibly lazy ROOT-VALUE and CALLER-VALUE Behavior sources.
|
||||
Runtime validates all names before installing any resources."
|
||||
(let ((root (etaf--resolve-property-value root-value))
|
||||
(caller (etaf--resolve-property-value caller-value)))
|
||||
(append (if (proper-list-p root) root (list root))
|
||||
(if (proper-list-p caller) caller (list caller)))))
|
||||
|
||||
(defun etaf--merge-host-attrs (props attrs &optional tag component-name)
|
||||
"Merge caller ATTRS into root Host PROPS for TAG.
|
||||
Visual Ebox attributes override Component defaults. Class tokens merge.
|
||||
Conflicting Runtime metadata is rejected so fallthrough cannot silently alter
|
||||
Component semantics. COMPONENT-NAME labels diagnostics."
|
||||
Non-nil visual attributes override defaults; class and Behavior sources merge.
|
||||
Callbacks append, disabled combines with OR, and owned semantic conflicts
|
||||
are rejected. COMPONENT-NAME labels diagnostics."
|
||||
(let ((result (copy-sequence props))
|
||||
(tail attrs))
|
||||
(while tail
|
||||
@ -282,10 +312,36 @@ Component semantics. COMPONENT-NAME labels diagnostics."
|
||||
(etaf--plist-set
|
||||
result :class
|
||||
(etaf--merge-class-input (plist-get result :class) value))))
|
||||
((etaf--event-property-p key)
|
||||
(setq result
|
||||
(etaf--plist-set
|
||||
result key
|
||||
(etaf--compose-event-callbacks
|
||||
(etaf--resolve-property-value (plist-get result key))
|
||||
(etaf--resolve-property-value value)))))
|
||||
((eq key :use)
|
||||
(setq result
|
||||
(etaf--plist-set
|
||||
result key (etaf--merge-use-input (plist-get result key) value))))
|
||||
((eq key :disabled)
|
||||
(let ((inner (etaf--resolve-property-value (plist-get result key)))
|
||||
(outer (etaf--resolve-property-value value)))
|
||||
(unless (and (memq inner '(nil t)) (memq outer '(nil t)))
|
||||
(etaf--component-error "Component %S :disabled must be boolean"
|
||||
component-name))
|
||||
(setq result (etaf--plist-set result key (or inner outer)))))
|
||||
(style-p
|
||||
(when (etaf--resolve-property-value value)
|
||||
(setq result
|
||||
(append (etaf--plist-remove-domain result key)
|
||||
(list key value))))
|
||||
(list key value)))))
|
||||
((and (etaf--owned-semantic-property-p key)
|
||||
(plist-member result key)
|
||||
(not (equal (etaf--resolve-property-value (plist-get result key))
|
||||
(etaf--resolve-property-value value))))
|
||||
(etaf--component-error
|
||||
"Component %S root Host %S owns %S; conflicting fallthrough value %S"
|
||||
component-name tag key value))
|
||||
((plist-member result key)
|
||||
(setq result (etaf--plist-set result key value)))
|
||||
(t
|
||||
@ -306,7 +362,11 @@ COMPONENT-NAME identifies the forwarding owner for diagnostics."
|
||||
(let ((key (pop tail))
|
||||
(value (pop tail)))
|
||||
(if (memq key declared)
|
||||
(setq props (etaf--plist-set props key value))
|
||||
;; Consuming a declared prop must retain the inner declaration
|
||||
;; and the outer subscription, and must not forward either twice.
|
||||
(setq props
|
||||
(etaf--merge-host-attrs props (list key value)
|
||||
nil component-name))
|
||||
(setq forwarded
|
||||
(etaf--merge-host-attrs
|
||||
forwarded (list key value) nil component-name)))))
|
||||
@ -745,7 +805,9 @@ FORM uses one grammar for Hosts and Component calls:
|
||||
(NAME :PROPERTY VALUE ... CHILD ...)
|
||||
|
||||
Properties must come first and children must come last. Property values are
|
||||
ordinary Elisp expressions. `(expr FORM)' is text interpolation only."
|
||||
ordinary Elisp expressions. In structural child positions, `(expr FORM)'
|
||||
returns nil, strings, typed Views, or proper sequences of those values.
|
||||
Inside a `text' Host, an expression must return one string."
|
||||
(declare (indent 1) (debug (form)))
|
||||
(if (fboundp 'etaf-compiler-expand-view)
|
||||
(etaf-compiler-expand-view form :projection)
|
||||
|
||||
@ -112,13 +112,13 @@
|
||||
nil)
|
||||
:view (text (expr label)))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-provider ()
|
||||
(etaf-define-component etaf-test-g6b-provider (&key count on-press)
|
||||
:setup
|
||||
(progn
|
||||
(etaf-provide 'g6b-message "Context")
|
||||
(etaf-theme-provide '(:color "#34D399"))
|
||||
nil)
|
||||
:view (column (slot)))
|
||||
:view (column (etaf-test-g6b-context-action :count count :on-press on-press)))
|
||||
|
||||
(etaf-define-component etaf-test-g6b-context-action (&key count on-press)
|
||||
:render
|
||||
@ -219,9 +219,7 @@
|
||||
(etaf-define-component invalid-neither () :setup nil)
|
||||
(etaf-define-component invalid-reserved (&key key) :view (box))
|
||||
(etaf-define-component invalid-setup-view ()
|
||||
:setup (etaf-node 'box nil nil) :view (box))
|
||||
(etaf-define-component invalid-render-dsl ()
|
||||
:render (etaf-view (box)))))
|
||||
:setup (etaf-node 'box nil nil) :view (box))))
|
||||
(should-error (macroexpand definition)
|
||||
:type 'etaf-component-definition-error)))
|
||||
|
||||
@ -558,7 +556,7 @@
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
|
||||
(ert-deftest etaf-component-frontends-compose-context-theme-style-and-behavior ()
|
||||
"A DSL provider and code Component share Context, Theme, style, and events."
|
||||
"Test child inheritance and composition; separate tests cover slot authors."
|
||||
(let ((buffer " *etaf-g6b-composition*")
|
||||
(count (etaf-ref 0)))
|
||||
(unwind-protect
|
||||
@ -568,13 +566,12 @@
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(etaf-test-g6b-provider
|
||||
(etaf-test-g6b-context-action
|
||||
:count (etaf-value count)
|
||||
:on-press
|
||||
(let ((source count))
|
||||
(lambda ()
|
||||
(setf (etaf-value source)
|
||||
(1+ (etaf-value source))))))))))
|
||||
(1+ (etaf-value source)))))))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(face (etaf-test-g6b--face-at buffer "Context 0"))
|
||||
(props
|
||||
@ -661,18 +658,13 @@
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
(let ((buffer " *etaf-g6b-attrs-role*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(should-error
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(etaf-test-g6b-attr-role
|
||||
:role 'navigation :ref 'g6b-attrs-role)))
|
||||
(should
|
||||
(eq 'navigation
|
||||
(plist-get
|
||||
(etaf-runtime-host-props-for
|
||||
(etaf-runtime-for-buffer buffer) 'g6b-attrs-role)
|
||||
:role))))
|
||||
:type 'etaf-component-call-error)
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))))
|
||||
|
||||
@ -63,6 +63,123 @@
|
||||
(while t (push (read (current-buffer)) forms))
|
||||
(end-of-file (nreverse forms))))))
|
||||
|
||||
(defun etaf-docs-test--marked-examples (contents)
|
||||
"Extract named executable documentation examples from CONTENTS."
|
||||
(with-temp-buffer
|
||||
(insert contents)
|
||||
(goto-char (point-min))
|
||||
(let (examples)
|
||||
(while (re-search-forward
|
||||
"^<!-- etaf-example: \\([^ ]+\\) -->\n```elisp\n" nil t)
|
||||
(let ((name (match-string 1))
|
||||
(start (point)))
|
||||
(unless (re-search-forward "^```$" nil t)
|
||||
(error "Unclosed executable example %s" name))
|
||||
(push (cons name (buffer-substring-no-properties
|
||||
start (match-beginning 0)))
|
||||
examples)))
|
||||
(nreverse examples))))
|
||||
|
||||
(defun etaf-docs-test--run-fresh (source assertions)
|
||||
"Run exact example SOURCE and ASSERTIONS in a fresh core-only Emacs."
|
||||
(let ((script (make-temp-file "etaf-readme-" nil ".el")))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(with-temp-file script
|
||||
(insert source "\n")
|
||||
(prin1 assertions (current-buffer))
|
||||
(insert "\n(should-not (featurep 'etaf-ui))\n"
|
||||
"(should-not (featurep 'etaf-playground))\n"))
|
||||
(with-temp-buffer
|
||||
(let ((status
|
||||
(apply #'call-process
|
||||
(expand-file-name invocation-name invocation-directory)
|
||||
nil (current-buffer) nil "-Q" "--batch"
|
||||
(append
|
||||
(cl-loop for directory in '("." "../ebox" "../tp"
|
||||
"../ecss")
|
||||
append (list "-L" (expand-file-name
|
||||
directory
|
||||
etaf-docs-test--root)))
|
||||
(list "--eval"
|
||||
(prin1-to-string
|
||||
'(progn
|
||||
(require 'ert)
|
||||
(require 'jka-compr)
|
||||
(setq load-suffixes '(".el" ".elc")
|
||||
load-prefer-newer t)))
|
||||
"-l" script)))))
|
||||
(unless (equal status 0)
|
||||
(ert-fail (format "Documentation child exited %S:\n%s"
|
||||
status (buffer-string)))))))
|
||||
(delete-file script))))
|
||||
|
||||
(ert-deftest etaf-docs-readme-examples-mount-and-dispatch-in-fresh-emacs ()
|
||||
"Both READMEs must work from their exact requires in isolated processes."
|
||||
(dolist (file '("README.md" "README.zh-CN.md"))
|
||||
(let ((examples (etaf-docs-test--marked-examples
|
||||
(etaf-docs-test--read file))))
|
||||
(should (equal '("hello" "card" "counter") (mapcar #'car examples)))
|
||||
(dolist (example examples)
|
||||
(etaf-docs-test--run-fresh
|
||||
(cdr example)
|
||||
(pcase (car example)
|
||||
("hello"
|
||||
'(let ((runtime (etaf-runtime-for-buffer "*etaf-hello*")))
|
||||
(should runtime)
|
||||
(should (equal "Hello ETAF"
|
||||
(etaf-dispatch-event runtime 'hello 'press)))
|
||||
(etaf-unmount runtime)))
|
||||
("card"
|
||||
'(let ((runtime (etaf-runtime-for-buffer "*etaf-card*")))
|
||||
(should runtime)
|
||||
(with-current-buffer "*etaf-card*"
|
||||
(should (string-match-p
|
||||
"Account[[:space:]]+Connected[[:space:]]+Footer"
|
||||
(buffer-string))))
|
||||
(etaf-unmount runtime)))
|
||||
("counter"
|
||||
'(let ((runtime (etaf-runtime-for-buffer "*etaf-counter*")))
|
||||
(should runtime)
|
||||
(etaf-dispatch-event runtime 'increment 'press)
|
||||
(with-current-buffer "*etaf-counter*"
|
||||
(should (string-match-p "Count: 1" (buffer-string))))
|
||||
(etaf-unmount runtime)))))))))
|
||||
|
||||
(ert-deftest etaf-docs-context-and-theme-examples-mount-in-fresh-emacs ()
|
||||
"Run exact Context and Theme examples without prior definitions or imports."
|
||||
(dolist (file '("docs/user-guide.en.md" "docs/user-guide.zh.md"
|
||||
"docs/architecture.en.md" "docs/architecture.zh.md"))
|
||||
(let ((examples (etaf-docs-test--marked-examples
|
||||
(etaf-docs-test--read file))))
|
||||
(should (equal '("context" "theme")
|
||||
(sort (mapcar #'car examples) #'string<)))
|
||||
(dolist (example examples)
|
||||
(etaf-docs-test--run-fresh
|
||||
(cdr example)
|
||||
(pcase (car example)
|
||||
("context"
|
||||
'(let ((runtime (etaf-runtime-for-buffer "*etaf-context*")))
|
||||
(should runtime)
|
||||
(with-current-buffer "*etaf-context*"
|
||||
(should (string-match-p "Service: demo-service"
|
||||
(buffer-string))))
|
||||
(etaf-unmount runtime)))
|
||||
("theme"
|
||||
'(let* ((runtime (etaf-runtime-for-buffer "*etaf-theme*"))
|
||||
(props (gethash 'themed-content
|
||||
(etaf-runtime-host-props runtime))))
|
||||
(should runtime)
|
||||
(should (equal "#F4F6FB" (plist-get props :color)))
|
||||
(should (equal "#202634" (plist-get props :background-color)))
|
||||
(with-current-buffer "*etaf-theme*"
|
||||
(goto-char (point-min))
|
||||
(should (search-forward "Themed content" nil t))
|
||||
(let ((face (get-text-property (1- (point)) 'face)))
|
||||
(should (string-match-p "#F4F6FB" (format "%S" face)))
|
||||
(should (string-match-p "#202634" (format "%S" face)))))
|
||||
(etaf-unmount runtime)))))))))
|
||||
|
||||
(defun etaf-docs-test--mounted-collection-probe (forms)
|
||||
"Load exact documentation FORMS and mount the collection composition."
|
||||
(etaf-component-redefine-run
|
||||
@ -120,7 +237,12 @@
|
||||
(let ((contents (etaf-docs-test--read file)))
|
||||
(should-not
|
||||
(string-match-p
|
||||
(regexp-opt '("etaf-template" "etaf-create-app")) contents))
|
||||
(regexp-opt '("etaf-template" "etaf-create-app" "expr :value"
|
||||
"ETAF also registers the short alias"
|
||||
"registry assigns a semantic"
|
||||
"ETAF 也会注册短 alias"
|
||||
"注册表会分配语义明确的"))
|
||||
contents))
|
||||
(should-not (string-match-p "(text \"[^\"]+\" :" contents))))
|
||||
(let ((guide (etaf-docs-test--read "docs/user-guide.en.md")))
|
||||
(dolist (token '("etaf-view" "etaf-mount" "etaf-define-component"
|
||||
@ -216,6 +338,25 @@
|
||||
(should (alist-get 'root-shape-forwarding-guarantee entry))
|
||||
(should (eq t (alist-get 'mounted-validation entry))))))
|
||||
|
||||
(defun etaf-docs-test--snapshot-probe (forms)
|
||||
"Run exact snapshot FORMS after one local publication in the documented app."
|
||||
(let ((label (etaf-ref "Before"))
|
||||
(buffer-name "*etaf-hello*"))
|
||||
(should-not (get-buffer buffer-name))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name (etaf-view (text (expr (etaf-value label)))))
|
||||
(setf (etaf-value label) "Current")
|
||||
(let ((result (eval (cons 'progn forms) t)))
|
||||
(should (= 3 (length result)))
|
||||
(should (and (integerp (nth 0 result)) (> (nth 0 result) 0)))
|
||||
(should (integerp (nth 1 result)))
|
||||
(should (equal "Current" (substring-no-properties (nth 2 result))))))
|
||||
(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-docs-executable-suite-is-fail-closed ()
|
||||
"Classify exact blocks before macroexpansion, loading, or mounted smoke."
|
||||
(let ((fixture (expand-file-name
|
||||
@ -249,11 +390,13 @@
|
||||
(pcase (plist-get record :probe)
|
||||
('collection-composition
|
||||
(etaf-docs-test--mounted-collection-probe forms))
|
||||
('runtime-snapshot
|
||||
(etaf-docs-test--snapshot-probe forms))
|
||||
('nil (dolist (form forms) (eval form t)))
|
||||
(_ (ert-fail "Unknown safe documentation probe")))))))))))
|
||||
|
||||
(ert-deftest etaf-source-uses-only-public-ebox-names ()
|
||||
"Keep the ETAF implementation independent of Ebox private functions."
|
||||
"Reject Ebox private functions, fields and dynamic construction context."
|
||||
(dolist (file
|
||||
(append
|
||||
(directory-files etaf-docs-test--root t "\\.el\\'")
|
||||
@ -262,7 +405,9 @@
|
||||
t "\\.el\\'")))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(should-not (re-search-forward "ebox--" nil t)))))
|
||||
;; Include module-qualified names such as canonical input accessors;
|
||||
;; checking only the facade prefix misses those boundary violations.
|
||||
(should-not (re-search-forward "\\_<ebox[-[:alnum:]]*--" nil t)))))
|
||||
|
||||
(ert-deftest etaf-examples-use-only-public-etaf-names ()
|
||||
"Keep executable examples on the public ETAF contract."
|
||||
|
||||
1182
tests/etaf-dynamic-components-tests.el
Normal file
1182
tests/etaf-dynamic-components-tests.el
Normal file
File diff suppressed because it is too large
Load Diff
789
tests/etaf-event-forwarding-tests.el
Normal file
789
tests/etaf-event-forwarding-tests.el
Normal file
@ -0,0 +1,789 @@
|
||||
;;; etaf-event-forwarding-tests.el --- Composable Host interaction tests -*- lexical-binding: t; -*-
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;;; Commentary:
|
||||
;; Exercise fallthrough, committed disabled state, and interaction boundaries.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'etaf)
|
||||
|
||||
(defvar etaf-forward-test--trace nil)
|
||||
(defvar etaf-forward-test--inner-use nil)
|
||||
(defvar etaf-forward-test--middle-use nil)
|
||||
(defvar etaf-forward-test--inner-disabled nil)
|
||||
|
||||
(defun etaf-forward-test--record (item)
|
||||
"Append ITEM to the current interaction trace."
|
||||
(setq etaf-forward-test--trace (append etaf-forward-test--trace (list item))))
|
||||
|
||||
(defun etaf-forward-test--dispose (buffer)
|
||||
"Unmount and kill test BUFFER."
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-unmount runtime))
|
||||
(when-let* ((live (get-buffer buffer))) (kill-buffer live)))
|
||||
|
||||
(etaf-define-component etaf-forward-test-leaf (&key on-press use disabled ref)
|
||||
:view (text :ref ref :role 'button :tab-index 0 :disabled disabled
|
||||
:on-press on-press :use use "Press"))
|
||||
|
||||
(etaf-define-component etaf-forward-test-middle ()
|
||||
:view (etaf-forward-test-leaf
|
||||
:ref 'internal
|
||||
:disabled (if (etaf-ref-p etaf-forward-test--inner-disabled)
|
||||
(etaf-value etaf-forward-test--inner-disabled)
|
||||
etaf-forward-test--inner-disabled)
|
||||
:use etaf-forward-test--inner-use
|
||||
:on-press (lambda () (etaf-forward-test--record 'inner))))
|
||||
|
||||
(etaf-define-component etaf-forward-test-outer ()
|
||||
:view (etaf-forward-test-middle
|
||||
:use etaf-forward-test--middle-use
|
||||
:on-press (lambda () (etaf-forward-test--record 'middle))))
|
||||
|
||||
(etaf-define-component etaf-forward-test-business (&key on-change)
|
||||
:view (text :role 'checkbox :aria-checked nil
|
||||
:on-press (let ((change on-change))
|
||||
(lambda ()
|
||||
(etaf-forward-test--record 'business)
|
||||
(funcall change t)))
|
||||
"Toggle"))
|
||||
|
||||
(etaf-define-component etaf-forward-test-layout (&key width classes use renders)
|
||||
:render
|
||||
(progn
|
||||
(cl-incf (aref renders 0))
|
||||
(if (eq use 'absent)
|
||||
(etaf-view (box :ref 'layout :width (etaf-value width)
|
||||
:class (etaf-value classes) (text "Text")))
|
||||
(etaf-view (box :ref 'layout :width (etaf-value width)
|
||||
:class (etaf-value classes) :use use (text "Text"))))))
|
||||
|
||||
(ert-deftest etaf-forward-behavior-keeps-host-property-dependencies-local ()
|
||||
"Omitted, empty, and active `:use' preserve the same Host update boundary."
|
||||
(let ((installs 0) (cleanups 0) installed-props)
|
||||
(dolist (use (list 'absent nil (etaf-focusable)
|
||||
(etaf-behavior-create
|
||||
'layout-probe
|
||||
:install
|
||||
(lambda ()
|
||||
(cl-incf installs)
|
||||
(setq installed-props
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)))
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(let ((buffer (generate-new-buffer " *etaf-behavior-layout*"))
|
||||
(width (etaf-ref 10))
|
||||
(classes (etaf-ref '(first)))
|
||||
(renders (vector 0)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer (etaf-node 'etaf-forward-test-layout
|
||||
(list :width width :classes classes
|
||||
:use use :renders renders) nil))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(should (equal renders [1]))
|
||||
(setf (etaf-value width) 12)
|
||||
(should (= 12 (plist-get (etaf-runtime-host-props-for runtime 'layout)
|
||||
:width)))
|
||||
(should (equal renders [1]))
|
||||
(setf (etaf-value classes) '(second))
|
||||
(should (equal '(second)
|
||||
(plist-get (etaf-runtime-host-props-for runtime 'layout)
|
||||
:class)))
|
||||
(should (equal renders [1]))
|
||||
(let ((generation (etaf-runtime-current-generation runtime)))
|
||||
(cl-letf (((symbol-function 'etaf--runtime-swap-generation)
|
||||
(lambda (&rest _) (error "Reject layout candidate"))))
|
||||
(should-error (setf (etaf-value width) 14)))
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(should (= 12 (plist-get (etaf-runtime-host-props-for runtime 'layout)
|
||||
:width)))
|
||||
(should (equal renders [1])))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
(should (= installs 1))
|
||||
(should (= cleanups 1))
|
||||
(should (= 10 (plist-get installed-props :width)))
|
||||
(should (equal '(first) (plist-get installed-props :class)))
|
||||
(should (eq 'layout (plist-get installed-props :ref)))))
|
||||
|
||||
(ert-deftest etaf-forward-declared-events-and-use-compose-once ()
|
||||
"Consume declared callback/use props once through two root wrappers."
|
||||
(let ((buffer " *etaf-forward-events*")
|
||||
(etaf-forward-test--trace nil)
|
||||
(etaf-forward-test--inner-use
|
||||
(etaf-behavior-create
|
||||
'inner :on-press (lambda () (etaf-forward-test--record 'behavior-inner))))
|
||||
(etaf-forward-test--middle-use
|
||||
(etaf-behavior-create
|
||||
'middle :on-press (lambda () (etaf-forward-test--record 'behavior-middle)))))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(etaf-forward-test-outer
|
||||
:ref 'target
|
||||
:on-press (lambda () (etaf-forward-test--record 'outer))
|
||||
:use (etaf-behavior-create
|
||||
'outer :on-press
|
||||
(lambda () (etaf-forward-test--record 'behavior-outer))))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(should (equal etaf-forward-test--trace
|
||||
'(inner middle outer behavior-inner
|
||||
behavior-middle behavior-outer)))
|
||||
(should-not (etaf-runtime-handler-for runtime 'internal))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-disabled-or-recomputes-and-guards-public-input ()
|
||||
"Outer nil never enables an internally disabled Host; later inputs recover."
|
||||
(let* ((buffer " *etaf-forward-disabled*")
|
||||
(outer-disabled (etaf-ref nil))
|
||||
(inner-disabled (etaf-ref t))
|
||||
(etaf-forward-test--inner-disabled inner-disabled)
|
||||
(etaf-forward-test--trace nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-view (etaf-forward-test-middle
|
||||
:ref 'target :disabled (etaf-value outer-disabled)))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(should (plist-get (etaf-runtime-host-props-for runtime 'target)
|
||||
:disabled))
|
||||
(should-error (etaf-dispatch-event runtime 'target 'press)
|
||||
:type 'etaf-event-error)
|
||||
(should-error (etaf-focus runtime 'target) :type 'etaf-event-error)
|
||||
(setf (etaf-value inner-disabled) nil)
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(should (equal etaf-forward-test--trace '(inner)))
|
||||
(setf (etaf-value outer-disabled) t)
|
||||
(should-error (etaf-dispatch-event runtime 'target 'press)
|
||||
:type 'etaf-event-error)
|
||||
(setf (etaf-value outer-disabled) nil)
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(should (equal etaf-forward-test--trace '(inner inner)))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-host-attribute-ownership ()
|
||||
"Presentation defaults and caller labels coexist with owned role/state."
|
||||
(let* ((root '(:color "red" :class "base" :role button :aria-checked nil
|
||||
:tab-index 0 :aria-label "Default" :ref fallback))
|
||||
(merged (etaf--merge-host-attrs
|
||||
root '(:color nil :class (caller base) :tab-index 2
|
||||
:aria-label "Caller" :ref target) 'text 'example)))
|
||||
(should (equal "red" (plist-get merged :color)))
|
||||
(should (equal '("base" "caller") (plist-get merged :class)))
|
||||
(should (= 2 (plist-get merged :tab-index)))
|
||||
(should (equal "Caller" (plist-get merged :aria-label)))
|
||||
(should (eq 'target (plist-get merged :ref)))
|
||||
(should-error (etaf--merge-host-attrs root '(:role navigation) 'text 'example)
|
||||
:type 'etaf-component-call-error)
|
||||
(should-error (etaf--merge-host-attrs root '(:aria-checked t) 'text 'example)
|
||||
:type 'etaf-component-call-error)))
|
||||
|
||||
(ert-deftest etaf-forward-business-conversion-precedes-subscriptions ()
|
||||
"A consumed change prop remains the business conversion for one press."
|
||||
(let ((buffer " *etaf-forward-conversion*")
|
||||
(etaf-forward-test--trace nil) (value nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(etaf-forward-test-business
|
||||
:ref 'target
|
||||
:on-change (lambda (next)
|
||||
(setq value next)
|
||||
(etaf-forward-test--record 'change))
|
||||
:on-press (lambda () (etaf-forward-test--record 'outer))
|
||||
:use (etaf-behavior-create
|
||||
'observer :on-press
|
||||
(lambda () (etaf-forward-test--record 'behavior))))))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer) 'target 'press)
|
||||
(should value)
|
||||
(should (equal etaf-forward-test--trace
|
||||
'(business change outer behavior))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-wrapper-duplicate-behaviors-fail-before-install ()
|
||||
"Do not lose duplicate names when declared use props consume fallthrough."
|
||||
(let* ((buffer " *etaf-forward-duplicate-use*")
|
||||
(installs 0)
|
||||
(behavior (etaf-behavior-create
|
||||
'duplicate :install (lambda () (cl-incf installs) nil)))
|
||||
(etaf-forward-test--inner-use behavior))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(should-error
|
||||
(etaf-mount buffer (etaf-view (etaf-forward-test-middle :use behavior)))
|
||||
:type 'etaf-behavior-error)
|
||||
(should (zerop installs)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-failed-callback-stops-outer-subscriptions ()
|
||||
"An inner callback error stops outer subscriptions and Behaviors."
|
||||
(let ((buffer " *etaf-forward-callback-failure*")
|
||||
(etaf-forward-test--trace nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(etaf-forward-test-business
|
||||
:ref 'target :on-change (lambda (_) (error "change failed"))
|
||||
:on-press (lambda () (etaf-forward-test--record 'outer))
|
||||
:use (etaf-behavior-create
|
||||
'observer :on-press
|
||||
(lambda () (etaf-forward-test--record 'behavior))))))
|
||||
(should-error
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer buffer) 'target 'press))
|
||||
(should (equal etaf-forward-test--trace '(business))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-behavior-final-props-precede-any-installer ()
|
||||
"Installers receive final merged semantic props, after validation."
|
||||
(let ((buffer " *etaf-forward-behavior-props*") (installs 0) (observed nil))
|
||||
(unwind-protect
|
||||
(let ((first
|
||||
(etaf-behavior-create
|
||||
'first :install
|
||||
(lambda ()
|
||||
(cl-incf installs)
|
||||
(setq observed
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)))
|
||||
nil))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(text :ref 'target
|
||||
:use (list first
|
||||
(etaf-behavior-create 'label :aria-label "Final"))
|
||||
"Target")))
|
||||
(should (= installs 1))
|
||||
(should (equal "Final" (plist-get observed :aria-label)))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(setq installs 0)
|
||||
(should-error
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(text :ref 'target
|
||||
:use (list first
|
||||
(etaf-behavior-create 'invalid :disabled 'wrong))
|
||||
"Target")))
|
||||
:type 'etaf-renderer-error)
|
||||
(should (zerop installs)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-disabled-behavior-never-installs ()
|
||||
"Final disabled state, including Behavior defaults, precedes installation."
|
||||
(let ((buffer " *etaf-forward-behavior-disabled*") (installs 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(text :ref 'target :disabled nil
|
||||
:use (list
|
||||
(etaf-behavior-create
|
||||
'first :install (lambda () (cl-incf installs) nil))
|
||||
(etaf-behavior-create 'disabled :disabled t))
|
||||
"Disabled")))
|
||||
(should (zerop installs))
|
||||
(should (plist-get (etaf-runtime-host-props-for
|
||||
(etaf-runtime-for-buffer buffer) 'target)
|
||||
:disabled)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-behavior-disabled-transitions-and-rollback ()
|
||||
"Commit disables clean up once; failed disables preserve the old resource."
|
||||
(let ((buffer " *etaf-forward-behavior-transition*")
|
||||
(mode (etaf-ref 'enabled))
|
||||
(installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let ((behavior (etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(column
|
||||
(text :ref 'target :use behavior
|
||||
:disabled (not (eq (etaf-value mode) 'enabled)) "Target")
|
||||
(text (expr (if (eq (etaf-value mode) 'failed)
|
||||
(error "later sibling failed") "OK")))))))
|
||||
(should (= installs 1))
|
||||
(should-error (setf (etaf-value mode) 'failed))
|
||||
(should (= cleanups 0))
|
||||
(should-not (plist-get (etaf-runtime-host-props-for
|
||||
(etaf-runtime-for-buffer buffer) 'target)
|
||||
:disabled))
|
||||
(setf (etaf-value mode) 'disabled)
|
||||
(should (= cleanups 1))
|
||||
(setf (etaf-value mode) 'enabled)
|
||||
(should (= installs 2))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-failed-enable-disposes-only-candidate-behavior ()
|
||||
"A failed enable cleans its new resource while committed Host stays disabled."
|
||||
(let ((buffer " *etaf-forward-enable-rollback*")
|
||||
(mode (etaf-ref 'disabled)) (installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(column
|
||||
(text :ref 'target :use behavior
|
||||
:disabled (eq (etaf-value mode) 'disabled) "Target")
|
||||
(text (expr (if (eq (etaf-value mode) 'failed)
|
||||
(error "later sibling failed") "OK"))))))
|
||||
(should (zerop installs))
|
||||
(should-error (setf (etaf-value mode) 'failed))
|
||||
(should (= installs 1))
|
||||
(should (= cleanups 1))
|
||||
(should (plist-get (etaf-runtime-host-props-for
|
||||
(etaf-runtime-for-buffer buffer) 'target)
|
||||
:disabled))
|
||||
(setf (etaf-value mode) 'enabled)
|
||||
(should (= installs 2))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-component-overlay-promotes-behavior-lifetime ()
|
||||
"A locally enabled Component owns its installed Behavior through teardown."
|
||||
(let ((buffer " *etaf-forward-overlay-behavior*")
|
||||
(disabled (etaf-ref t)) (installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
;; Passing a View value keeps dependency ownership on the Component
|
||||
;; input effect, exercising local overlay instead of Root rebuild.
|
||||
(etaf-mount buffer
|
||||
(etaf-view (etaf-forward-test-leaf
|
||||
:ref 'target :use behavior
|
||||
:disabled (etaf-value disabled))))
|
||||
(should (zerop installs))
|
||||
(setf (etaf-value disabled) nil)
|
||||
(should (= installs 1))
|
||||
(should (zerop cleanups))
|
||||
(setf (etaf-value disabled) t)
|
||||
(should (= cleanups 1))
|
||||
(setf (etaf-value disabled) nil)
|
||||
(should (= installs 2))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-root-fallback-releases-abandoned-behavior ()
|
||||
"A local anchor proof miss releases candidate resources before Root retry."
|
||||
(let ((buffer " *etaf-forward-fallback-behavior*")
|
||||
(disabled (etaf-ref t)) (installs 0) (cleanups 0)
|
||||
(miss-next t))
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(column
|
||||
(etaf-forward-test-leaf :ref 'target :use behavior
|
||||
:disabled (etaf-value disabled))
|
||||
;; Read here to change this structural Range. A text child's
|
||||
;; deferred Expr correctly owns its own independent update.
|
||||
(expr (etaf-node
|
||||
'text nil
|
||||
(list (if (etaf-value disabled) "Disabled" "Enabled")))))))
|
||||
(let ((original
|
||||
(symbol-function 'etaf--runtime-range-change-has-backend-anchor-p)))
|
||||
(cl-letf (((symbol-function 'etaf--runtime-range-change-has-backend-anchor-p)
|
||||
(lambda (runtime change)
|
||||
(if miss-next
|
||||
(progn (setq miss-next nil) nil)
|
||||
(funcall original runtime change)))))
|
||||
(setf (etaf-value disabled) nil)))
|
||||
(should-not miss-next)
|
||||
(should (= installs 2))
|
||||
(should (= cleanups 1))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-removed-component-retires-behavior-immediately ()
|
||||
"A removed dynamic child releases its Behavior without waiting for unmount."
|
||||
(let ((buffer " *etaf-forward-removed-behavior*")
|
||||
(visible (etaf-ref t)) (installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view (column
|
||||
(etaf-forward-test-leaf :if (etaf-value visible)
|
||||
:ref 'target :use behavior))))
|
||||
(should (= installs 1))
|
||||
(setf (etaf-value visible) nil)
|
||||
(should (= cleanups 1))
|
||||
(should-not
|
||||
(etaf--generation-index-entries
|
||||
(etaf-runtime-current-generation (etaf-runtime-for-buffer buffer))
|
||||
'behaviors))
|
||||
(setf (etaf-value visible) t)
|
||||
(should (= installs 2))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-component-overlay-removes-use-resources ()
|
||||
"Changing or removing use retires obsolete names on a retained Host."
|
||||
(let ((buffer " *etaf-forward-overlay-use*")
|
||||
(use (etaf-ref nil)) (installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let* ((install (lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))
|
||||
(first (etaf-behavior-create 'first :install install))
|
||||
(second (etaf-behavior-create 'second :install install)))
|
||||
(setf (etaf-value use) first)
|
||||
(etaf-mount
|
||||
buffer (etaf-view (etaf-forward-test-leaf
|
||||
:ref 'target :use (etaf-value use))))
|
||||
(should (= installs 1))
|
||||
(setf (etaf-value use) second)
|
||||
(should (= installs 2))
|
||||
(should (= cleanups 1))
|
||||
(setf (etaf-value use) nil)
|
||||
(should (= cleanups 2))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 2)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-keyed-host-behaviors-follow-owner-through-reorder ()
|
||||
"Keyed Host resources follow semantic owners through reorder and removal."
|
||||
(let ((buffer " *etaf-forward-keyed-behavior*") active events)
|
||||
(unwind-protect
|
||||
(let* ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda ()
|
||||
(let ((ref (plist-get
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)) :ref)))
|
||||
(push ref active)
|
||||
(push (list 'install ref) events)
|
||||
(lambda ()
|
||||
(setq active (delq ref active))
|
||||
(push (list 'cleanup ref) events))))))
|
||||
(a (etaf-node 'box (list :key 'a :ref 'a :use behavior) '("A")))
|
||||
(b (etaf-node 'box (list :key 'b :ref 'b :use behavior) '("B")))
|
||||
(items (etaf-ref (list a b))))
|
||||
(etaf-mount buffer (etaf-view (column (expr (etaf-value items)))))
|
||||
(setf (etaf-value items) (list b a))
|
||||
(should (equal events '((install b) (install a))))
|
||||
(setf (etaf-value items) (list b))
|
||||
(should (equal active '(b)))
|
||||
(should (equal events '((cleanup a) (install b) (install a))))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should-not active)
|
||||
(should (= 1 (cl-count '(cleanup a) events :test #'equal)))
|
||||
(should (= 1 (cl-count '(cleanup b) events :test #'equal))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-keyed-behavior-failure-retains-committed-owners ()
|
||||
"Failed reorder/removal keeps committed resources and cleans only new ones."
|
||||
(let ((buffer " *etaf-forward-keyed-behavior-rollback*") active events)
|
||||
(unwind-protect
|
||||
(let* ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda ()
|
||||
(let ((ref (plist-get
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)) :ref)))
|
||||
(push ref active)
|
||||
(push (list 'install ref) events)
|
||||
(lambda ()
|
||||
(setq active (delq ref active))
|
||||
(push (list 'cleanup ref) events))))))
|
||||
(a (etaf-node 'box (list :key 'a :ref 'a :use behavior) '("A")))
|
||||
(b (etaf-node 'box (list :key 'b :ref 'b :use behavior) '("B")))
|
||||
(c (etaf-node 'box (list :key 'c :ref 'c :use behavior) '("C")))
|
||||
(mode (etaf-ref 'initial)))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(column
|
||||
(expr (pcase (etaf-value mode)
|
||||
('initial (list a b))
|
||||
('failed (list b c))
|
||||
(_ (list b))))
|
||||
(text (expr (if (eq (etaf-value mode) 'failed)
|
||||
(error "later sibling failed") "OK"))))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(generation (etaf-runtime-current-generation runtime)))
|
||||
(should-error (setf (etaf-value mode) 'failed))
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(should (equal active '(b a)))
|
||||
(should (equal events
|
||||
'((cleanup c) (install c) (install b) (install a))))
|
||||
(setf (etaf-value mode) 'removed)
|
||||
(should (equal active '(b)))
|
||||
(should (equal (car events) '(cleanup a)))
|
||||
(etaf-unmount runtime)
|
||||
(should-not active)
|
||||
(dolist (ref '(a b c))
|
||||
(should (= 1 (cl-count (list 'install ref) events :test #'equal)))
|
||||
(should (= 1 (cl-count (list 'cleanup ref) events :test #'equal))))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-behavior-installer-receives-effective-host-ref ()
|
||||
"An installer receives the effective address of an automatically referenced Host."
|
||||
(let ((buffer " *etaf-forward-behavior-generated-ref*") installed-ref)
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(text :role 'button :on-press #'ignore
|
||||
:use (etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda ()
|
||||
(setq installed-ref
|
||||
(plist-get
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)) :ref))
|
||||
nil))
|
||||
"Control")))
|
||||
(should installed-ref)
|
||||
(should (etaf-runtime-handler-for
|
||||
(etaf-runtime-for-buffer buffer) installed-ref)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-behavior-address-change-reinstalls-after-commit ()
|
||||
"A retained Host changing its ref replaces the resource bound to that address."
|
||||
(let ((buffer " *etaf-forward-behavior-ref-change*")
|
||||
(ref (etaf-ref 'a)) active events)
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda ()
|
||||
(let ((address (plist-get
|
||||
(etaf-behavior-context-host-props
|
||||
(etaf-current-behavior-context)) :ref)))
|
||||
(push address active)
|
||||
(push (list 'install address) events)
|
||||
(lambda ()
|
||||
(setq active (delq address active))
|
||||
(push (list 'cleanup address) events)))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view (box :key 'stable :ref (etaf-value ref) :use behavior "Host")))
|
||||
(setf (etaf-value ref) 'b)
|
||||
(should (equal active '(b)))
|
||||
(should (equal events '((cleanup a) (install b) (install a))))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should-not active)
|
||||
(should (equal (car events) '(cleanup b))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-carried-component-keeps-behavior-resource ()
|
||||
"A Root update carrying an unchanged Component retains its Host resource."
|
||||
(let ((buffer " *etaf-forward-carried-behavior*")
|
||||
(version (etaf-ref 0)) (installs 0) (cleanups 0))
|
||||
(unwind-protect
|
||||
(let ((behavior
|
||||
(etaf-behavior-create
|
||||
'resource :install
|
||||
(lambda () (cl-incf installs)
|
||||
(lambda () (cl-incf cleanups))))))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-value version)
|
||||
(etaf-view
|
||||
(column
|
||||
(etaf-forward-test-leaf :ref 'target :use behavior)))))
|
||||
(should (= installs 1))
|
||||
(setf (etaf-value version) 1)
|
||||
(should (= installs 1))
|
||||
(should (zerop cleanups))
|
||||
(etaf-unmount (etaf-runtime-for-buffer buffer))
|
||||
(should (= cleanups 1)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-callback-snapshot-changes-only-after-commit ()
|
||||
"Composed subscriptions preserve committed scalar props after render fails."
|
||||
(let ((buffer " *etaf-forward-callback-commit*")
|
||||
(version (etaf-ref 'a)) (seen nil)
|
||||
(etaf-forward-test--trace nil))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(column
|
||||
(etaf-forward-test-middle
|
||||
:ref 'target
|
||||
:on-press (let ((snapshot (etaf-value version)))
|
||||
(lambda () (push snapshot seen))))
|
||||
(text (expr (if (eq (etaf-value version) 'failed)
|
||||
(error "later sibling failed") "OK"))))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(should-error (setf (etaf-value version) 'failed))
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(setf (etaf-value version) 'b)
|
||||
(etaf-dispatch-event runtime 'target 'press)
|
||||
(should (equal seen '(b a a)))
|
||||
(should (equal etaf-forward-test--trace '(inner inner inner)))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-child-boundary-blocks-parent-activation ()
|
||||
"A disabled or callbackless child owns its hit area, including equal bounds."
|
||||
(let ((buffer " *etaf-forward-hit-boundary*") (trace nil))
|
||||
(unwind-protect
|
||||
(dolist (child-props '((:disabled t :on-press ignore) nil))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-node
|
||||
'box (list :ref 'aaa-parent :role 'row :tab-index 0
|
||||
:on-press (lambda () (push 'parent trace)))
|
||||
(list (etaf-node
|
||||
'text (append '(:ref zzz-child :role button) child-props)
|
||||
'("Child"))))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(position (etaf-host-ref-position runtime 'zzz-child)))
|
||||
(should (equal (etaf-host-ref-bounds runtime 'aaa-parent)
|
||||
(etaf-host-ref-bounds runtime 'zzz-child)))
|
||||
(should-error (etaf--activation-at-position runtime position)
|
||||
:type 'user-error)
|
||||
(should-not trace)
|
||||
(etaf-focus runtime 'aaa-parent)
|
||||
(etaf-activate runtime)
|
||||
(should (equal trace '(parent)))
|
||||
(setq trace nil)
|
||||
(etaf-unmount runtime)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-child-wins-and-ordinary-text-belongs-to-parent ()
|
||||
"Semantic descendants beat equal bounds; passive text keeps row activation."
|
||||
(let ((buffer " *etaf-forward-hit-order*") (trace nil))
|
||||
(unwind-protect
|
||||
(dolist (interactive '(t nil))
|
||||
(etaf-mount
|
||||
buffer
|
||||
(lambda ()
|
||||
(etaf-node
|
||||
'box (list :ref 'aaa-parent
|
||||
:on-press (lambda () (push 'parent trace)))
|
||||
(list (etaf-node
|
||||
'text (append '(:ref zzz-child)
|
||||
(when interactive
|
||||
(list :role 'button :on-press
|
||||
(lambda () (push 'child trace)))))
|
||||
'("Child"))))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf--activation-at-position
|
||||
runtime (etaf-host-ref-position runtime 'zzz-child))
|
||||
(should (equal trace (if interactive '(child) '(parent))))
|
||||
(setq trace nil)
|
||||
(etaf-unmount runtime)))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-focused-control-follows-changing-layout ()
|
||||
"Repeated keyboard activation follows a retained control after width changes."
|
||||
(let ((buffer " *etaf-forward-focus-layout*") (page (etaf-ref 9)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(row
|
||||
(text (expr (format "Page %s" (etaf-value page))))
|
||||
(text :ref 'next :role 'button :tab-index 0
|
||||
:on-press (lambda () (cl-incf (etaf-value page))) "Next"))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-focus runtime 'next)
|
||||
(etaf-activate runtime)
|
||||
(should (= (etaf-value page) 10))
|
||||
(should (eq (etaf-focused-host-ref runtime) 'next))
|
||||
(with-current-buffer buffer
|
||||
(should (= (point) (etaf-host-ref-position runtime 'next))))
|
||||
(etaf-activate runtime)
|
||||
(should (= (etaf-value page) 11))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-layout-update-respects-manually-moved-point ()
|
||||
"A layout commit must not pull point back after the user leaves a control."
|
||||
(let ((buffer " *etaf-forward-focus-manual*") (page (etaf-ref 9)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(row
|
||||
(text (expr (format "Page %s" (etaf-value page))))
|
||||
(text :ref 'next :role 'button :tab-index 0 "Next"))))
|
||||
(let ((runtime (etaf-runtime-for-buffer buffer)))
|
||||
(etaf-focus runtime 'next)
|
||||
(with-current-buffer buffer (goto-char (point-min)))
|
||||
(setf (etaf-value page) 10)
|
||||
(with-current-buffer buffer
|
||||
(should (= (point) (point-min)))
|
||||
(should-not (= (point) (etaf-host-ref-position runtime 'next))))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(ert-deftest etaf-forward-focused-point-survives-failed-publication ()
|
||||
"A failed candidate retains the old focus and point; the next commit follows."
|
||||
(let ((buffer " *etaf-forward-focus-rollback*") (page (etaf-ref 9)))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount
|
||||
buffer
|
||||
(etaf-view
|
||||
(row
|
||||
(text (expr (format "Page %s" (etaf-value page))))
|
||||
(text :ref 'next :role 'button :tab-index 0 "Next")
|
||||
(text (expr (if (= (etaf-value page) 10)
|
||||
(error "later rendering failed") "OK"))))))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer))
|
||||
(generation (etaf-runtime-current-generation runtime))
|
||||
(position (etaf-host-ref-position runtime 'next)))
|
||||
(etaf-focus runtime 'next)
|
||||
(should-error (setf (etaf-value page) 10))
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(should (eq (etaf-focused-host-ref runtime) 'next))
|
||||
(with-current-buffer buffer (should (= (point) position)))
|
||||
(setf (etaf-value page) 11)
|
||||
(with-current-buffer buffer
|
||||
(should (= (point) (etaf-host-ref-position runtime 'next))))))
|
||||
(etaf-forward-test--dispose buffer))))
|
||||
|
||||
(provide 'etaf-event-forwarding-tests)
|
||||
;;; etaf-event-forwarding-tests.el ends here
|
||||
@ -184,11 +184,12 @@
|
||||
(skip-chars-forward " \t\r\n")
|
||||
(should (eobp)))
|
||||
(should (equal golden (etaf-m0a-document-example-signatures)))
|
||||
(should (= 122 (length blocks)))
|
||||
(should (= 124 (length blocks)))
|
||||
(should (= 0 (cl-count 'read-error blocks
|
||||
:key (lambda (entry)
|
||||
(plist-get entry :drift)))))
|
||||
(should (= 4 (cl-count 'macroexpand-error blocks
|
||||
;; Canonical README expressions no longer carry the four baseline errors.
|
||||
(should (= 0 (cl-count 'macroexpand-error blocks
|
||||
:key (lambda (entry)
|
||||
(plist-get entry :drift)))))
|
||||
(should (cl-every
|
||||
|
||||
@ -41,6 +41,8 @@
|
||||
'ebox-framework-spi-update))
|
||||
(should (eq (etaf-render-port-revision-function port)
|
||||
'ebox-surface-buffer-revision))
|
||||
(should (eq (etaf-render-port-snapshot-function port)
|
||||
'ebox-surface-buffer-snapshot))
|
||||
(should (eq (etaf-render-port-bootstrap-outcome port)
|
||||
'valid-v2-selected))
|
||||
(setcar capabilities 'mutated)
|
||||
@ -49,6 +51,108 @@
|
||||
(should-error
|
||||
(eval `(setf (etaf-render-port--route ',port) 'broken)))))
|
||||
|
||||
(ert-deftest etaf-render-port-requires-public-snapshot-query ()
|
||||
"An otherwise valid v2 provider cannot omit the public snapshot query."
|
||||
(cl-letf (((symbol-function 'ebox-surface-buffer-snapshot) nil))
|
||||
(should-error (etaf-render-port--bootstrap)
|
||||
:type 'etaf-spi-bootstrap-error)))
|
||||
|
||||
(ert-deftest etaf-render-port-snapshot-forwards-owned-export-once ()
|
||||
"The port forwards one Ebox-owned export without copying or publishing it."
|
||||
(let* ((snapshot (list :input (ebox-build '(box "snapshot"))
|
||||
:revision 7 :mount-id 23))
|
||||
(calls 0))
|
||||
(with-temp-buffer
|
||||
(let ((buffer (current-buffer)))
|
||||
(cl-letf (((symbol-function 'ebox-surface-buffer-snapshot)
|
||||
(lambda (target)
|
||||
(should (eq target buffer))
|
||||
(cl-incf calls)
|
||||
snapshot))
|
||||
((symbol-function 'etaf-render-port-update)
|
||||
(lambda (&rest _) (error "Snapshot published"))))
|
||||
(should (eq snapshot (etaf-render-port-snapshot buffer)))
|
||||
(should (= calls 1)))))))
|
||||
|
||||
(ert-deftest etaf-render-port-snapshot-rejects-malformed-export ()
|
||||
"The adapter checks the public envelope without probing private state."
|
||||
(dolist (snapshot (list nil '(:input wrong :revision 7 :mount-id 23)
|
||||
(list :input (ebox-build '(box "snapshot"))
|
||||
:revision "7" :mount-id 23)
|
||||
(list :input (ebox-build '(box "snapshot"))
|
||||
:revision 7 :mount-id nil)))
|
||||
(cl-letf (((symbol-function 'ebox-surface-buffer-snapshot)
|
||||
(lambda (_buffer) snapshot)))
|
||||
(should-error (etaf-render-port-snapshot (current-buffer)) :type 'error))))
|
||||
|
||||
(ert-deftest etaf-render-port-snapshot-preserves-query-errors ()
|
||||
"An Ebox rejection remains visible and never triggers a render fallback."
|
||||
(let ((condition '(user-error "snapshot is unavailable in this transaction")))
|
||||
(cl-letf (((symbol-function 'ebox-surface-buffer-snapshot)
|
||||
(lambda (_buffer) (signal (car condition) (cdr condition)))))
|
||||
(should (equal condition
|
||||
(should-error (etaf-render-port-snapshot (current-buffer))
|
||||
:type 'user-error))))))
|
||||
|
||||
(ert-deftest etaf-runtime-flush-returns-revision-without-export ()
|
||||
"Explicit flush requests a drain and returns a cheap committed revision."
|
||||
(require 'etaf)
|
||||
(let* ((runtime (etaf--runtime-create :buffer (current-buffer)))
|
||||
trace)
|
||||
(cl-letf (((symbol-function 'etaf-runtime-require-mounted)
|
||||
(lambda (target) (should (eq target runtime)) runtime))
|
||||
((symbol-function 'etaf--runtime-request-flush)
|
||||
(lambda (target) (should (eq target runtime)) (push 'drain trace)))
|
||||
((symbol-function 'etaf-render-port-revision)
|
||||
(lambda (buffer)
|
||||
(should (eq buffer (current-buffer)))
|
||||
(push 'revision trace)
|
||||
13))
|
||||
((symbol-function 'etaf-runtime-snapshot)
|
||||
(lambda (&rest _) (error "Flush exported a whole tree")))
|
||||
((symbol-function 'etaf--runtime-render-root-turn)
|
||||
(lambda (&rest _) (error "Flush forced a Root rebuild"))))
|
||||
(should (= 13 (etaf-runtime-flush runtime)))
|
||||
(should (equal '(drain revision) (nreverse trace))))))
|
||||
|
||||
(ert-deftest etaf-runtime-flush-rejects-transaction-before-drain ()
|
||||
"Public flush never drains work or exposes a provisional TP revision."
|
||||
(require 'etaf)
|
||||
(let ((runtime (etaf--runtime-create :buffer (current-buffer))) trace)
|
||||
(cl-letf (((symbol-function 'etaf-runtime-require-mounted)
|
||||
(lambda (_target) runtime))
|
||||
((symbol-function 'etaf--runtime-request-flush)
|
||||
(lambda (&rest _) (push 'drain trace)))
|
||||
((symbol-function 'etaf-render-port-revision)
|
||||
(lambda (&rest _) (push 'revision trace) 99)))
|
||||
(tp-with-transaction
|
||||
(should-error (etaf-runtime-flush runtime) :type 'etaf-runtime-error))
|
||||
(should-not trace))))
|
||||
|
||||
(ert-deftest etaf-runtime-obsolete-root-getter-compiles-as-snapshot-query ()
|
||||
"Compiled compatibility reads query current input, not the reserved slot."
|
||||
(require 'etaf)
|
||||
(require 'bytecomp)
|
||||
(let* ((runtime (etaf--runtime-create :reserved-root-node 'stale-root))
|
||||
(snapshot (list :input (ebox-build '(box "Current"))
|
||||
:revision 7 :mount-id 23))
|
||||
(getter (let ((byte-compile-warnings '(not obsolete)))
|
||||
(byte-compile '(lambda (runtime)
|
||||
(etaf-runtime-root-node runtime)))))
|
||||
(calls 0))
|
||||
(should (= 3 (cl-struct-slot-offset 'etaf-runtime 'reserved-root-node)))
|
||||
(should (= 4 (cl-struct-slot-offset 'etaf-runtime 'scope)))
|
||||
(should-not (get 'etaf-runtime-root-node 'compiler-macro))
|
||||
(should-not (get 'etaf-runtime-root-node 'side-effect-free))
|
||||
(cl-letf (((symbol-function 'etaf-runtime-snapshot)
|
||||
(lambda (target)
|
||||
(should (eq target runtime))
|
||||
(cl-incf calls)
|
||||
snapshot)))
|
||||
(should (eq (car (ebox-canonical-input-roots (plist-get snapshot :input)))
|
||||
(funcall getter runtime)))
|
||||
(should (= 1 calls)))))
|
||||
|
||||
(ert-deftest etaf-render-port-requires-v2-provider ()
|
||||
"Complete provider absence fails closed instead of selecting a legacy port."
|
||||
(let ((original-featurep (symbol-function 'featurep)))
|
||||
|
||||
293
tests/etaf-render-view-tests.el
Normal file
293
tests/etaf-render-view-tests.el
Normal file
@ -0,0 +1,293 @@
|
||||
;;; etaf-render-view-tests.el --- Ordinary Elisp View frontend -*- lexical-binding: t; -*-
|
||||
|
||||
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||
|
||||
;;; Commentary:
|
||||
|
||||
;; The render frontend shares View compilation and retained runtime semantics.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'ert)
|
||||
(require 'bytecomp)
|
||||
(require 'etaf)
|
||||
|
||||
(defvar etaf-rv--renders 0)
|
||||
(defvar etaf-rv--left-reads 0)
|
||||
(defvar etaf-rv--right-reads 0)
|
||||
(defvar etaf-rv--events nil)
|
||||
|
||||
(defun etaf-rv--define (name arguments &rest clauses)
|
||||
"Define test Component NAME with ARGUMENTS and CLAUSES lexically."
|
||||
(etaf-component-redefine-run
|
||||
(lambda ()
|
||||
(eval `(etaf-define-component ,name ,arguments ,@clauses) t))))
|
||||
|
||||
(defmacro etaf-rv--with-buffer (&rest body)
|
||||
"Run BODY in a temporary buffer and always dispose its Runtime."
|
||||
(declare (indent 0) (debug t))
|
||||
`(with-temp-buffer
|
||||
(unwind-protect
|
||||
(progn ,@body)
|
||||
(when-let* ((runtime (etaf-runtime-for-buffer (current-buffer))))
|
||||
(etaf-unmount runtime)))))
|
||||
|
||||
(ert-deftest etaf-render-view-equivalent-to-view-and-node ()
|
||||
"All frontends produce the same visible structure and Host properties."
|
||||
(etaf-rv--define 'etaf-rv-view '(&key label)
|
||||
:view '(column :padding-inline 1
|
||||
(text :font-weight 'bold (expr label))
|
||||
(text "Body")))
|
||||
(etaf-rv--define 'etaf-rv-render '(&key label)
|
||||
:render '(let ((caption label))
|
||||
(etaf-view
|
||||
(column :padding-inline 1
|
||||
(text :font-weight 'bold (expr caption))
|
||||
(text "Body")))))
|
||||
(etaf-rv--define 'etaf-rv-node '(&key label)
|
||||
:render '(etaf-node
|
||||
'column '(:padding-inline 1)
|
||||
(list (etaf-node 'text '(:font-weight bold)
|
||||
(list label))
|
||||
(etaf-node 'text nil '("Body")))))
|
||||
(let ((outputs
|
||||
(mapcar
|
||||
(lambda (name)
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node name '(:label "Title") nil))
|
||||
(list (buffer-substring-no-properties (point-min) (point-max))
|
||||
(progn
|
||||
(goto-char (point-min))
|
||||
(search-forward "Title")
|
||||
(get-text-property (match-beginning 0) 'face)))))
|
||||
'(etaf-rv-view etaf-rv-render etaf-rv-node))))
|
||||
(should (equal (car outputs) (cadr outputs)))
|
||||
(should (equal (car outputs) (caddr outputs)))))
|
||||
|
||||
(ert-deftest etaf-render-view-prop-loop-conflicts-match-view ()
|
||||
"Nested Views use Component prop validation during definition expansion."
|
||||
(dolist (body '((etaf-view
|
||||
(column (text :for (item '("A")) :key item (expr item))))
|
||||
(let ((prefix "item"))
|
||||
(etaf-view
|
||||
(column (text :for (item '("A")) :key item
|
||||
(expr (concat prefix item))))))
|
||||
(funcall
|
||||
(lambda ()
|
||||
(etaf-view
|
||||
(column (text :for (item '("A")) :key item
|
||||
(expr item))))))))
|
||||
(let ((failure
|
||||
(should-error
|
||||
(macroexpand
|
||||
`(etaf-define-component etaf-rv-conflict (&key item)
|
||||
:render ,body))
|
||||
:type 'etaf-view-syntax-error)))
|
||||
(should (string-match-p "conflicts with a Component prop"
|
||||
(error-message-string failure)))))
|
||||
(should-error
|
||||
(macroexpand
|
||||
'(etaf-define-component etaf-rv-conflict (&key item)
|
||||
:view (column (text :for (item '("A")) :key item (expr item)))))
|
||||
:type 'etaf-view-syntax-error))
|
||||
|
||||
(ert-deftest etaf-render-view-preserves-ordinary-lexical-shadowing ()
|
||||
"Let and lambda bindings shadow prop shorthand using normal Elisp scope."
|
||||
(etaf-rv--define
|
||||
'etaf-rv-shadow '(&key label)
|
||||
:render
|
||||
'(let* ((original label)
|
||||
(label "local")
|
||||
(caption (funcall (lambda (label) (concat original "/" label))
|
||||
label)))
|
||||
(etaf-view
|
||||
(box :ref 'etaf-rv-shadow-button
|
||||
:on-press (lambda () (push caption etaf-rv--events))
|
||||
(text (expr caption))))))
|
||||
(let ((etaf-rv--events nil))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-shadow '(:label "prop") nil))
|
||||
(should (equal "prop/local" (buffer-string)))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer (current-buffer))
|
||||
'etaf-rv-shadow-button 'press)
|
||||
(should (equal '("prop/local") etaf-rv--events)))))
|
||||
|
||||
(ert-deftest etaf-render-view-retains-surrounding-macro-environment ()
|
||||
"A lexically scoped macro cannot hide a View from prop grammar checks."
|
||||
(should-error
|
||||
(macroexpand-all
|
||||
'(cl-macrolet
|
||||
((local-view ()
|
||||
'(etaf-view
|
||||
(column (text :for (item '("A")) :key item (expr item))))))
|
||||
(etaf-define-component etaf-rv-macro-conflict (&key item)
|
||||
:render (local-view))))
|
||||
:type 'etaf-view-syntax-error))
|
||||
|
||||
(ert-deftest etaf-render-view-props-shadow-surrounding-symbol-macros ()
|
||||
"A Component's prop scope overrides same-named outer symbol macros."
|
||||
(etaf-component-redefine-run
|
||||
(lambda ()
|
||||
(eval
|
||||
'(cl-symbol-macrolet ((label "Outer"))
|
||||
(etaf-define-component etaf-rv-outer-shadow (&key label)
|
||||
:render (etaf-view (text (expr label)))))
|
||||
t)))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-outer-shadow '(:label "Prop") nil))
|
||||
(should (equal "Prop" (buffer-string)))))
|
||||
|
||||
(ert-deftest etaf-render-view-byte-compiled-callback-retains-lexical-props ()
|
||||
"Compiled Component definitions preserve the same delayed callback scope."
|
||||
(let ((byte-compile-error-on-warn t)
|
||||
(etaf-rv--events nil))
|
||||
(etaf-component-redefine-run
|
||||
(lambda ()
|
||||
(funcall
|
||||
(byte-compile
|
||||
'(lambda ()
|
||||
(etaf-define-component etaf-rv-compiled (&key label)
|
||||
:render
|
||||
(let ((caption label))
|
||||
(etaf-view
|
||||
(box :ref 'etaf-rv-compiled-button
|
||||
:on-press (lambda () (push caption etaf-rv--events))
|
||||
(text (expr caption)))))))))))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-compiled '(:label "Compiled") nil))
|
||||
(should (equal "Compiled" (buffer-string)))
|
||||
(etaf-dispatch-event (etaf-runtime-for-buffer (current-buffer))
|
||||
'etaf-rv-compiled-button 'press)
|
||||
(should (equal '("Compiled") etaf-rv--events)))))
|
||||
|
||||
(ert-deftest etaf-render-view-keeps-deferred-dependencies-local ()
|
||||
"Capturing stable handles does not pull reactive reads into Component render."
|
||||
(etaf-rv--define
|
||||
'etaf-rv-deferred '(&key left right)
|
||||
:setup '(list left right)
|
||||
:render
|
||||
'(progn
|
||||
(cl-incf etaf-rv--renders)
|
||||
(let* ((state (etaf-state))
|
||||
(left-ref (car state))
|
||||
(right-ref (cadr state)))
|
||||
(etaf-view
|
||||
(column
|
||||
(text (expr (progn (cl-incf etaf-rv--left-reads)
|
||||
(etaf-value left-ref))))
|
||||
(text (expr (progn (cl-incf etaf-rv--right-reads)
|
||||
(etaf-value right-ref)))))))))
|
||||
(let ((left (etaf-ref "Left A"))
|
||||
(right (etaf-ref "Right A"))
|
||||
(etaf-rv--renders 0)
|
||||
(etaf-rv--left-reads 0)
|
||||
(etaf-rv--right-reads 0))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-deferred (list :left left :right right)
|
||||
nil))
|
||||
(let ((renders etaf-rv--renders)
|
||||
(left-reads etaf-rv--left-reads)
|
||||
(right-reads etaf-rv--right-reads))
|
||||
(setf (etaf-value left) "Left B")
|
||||
(should (string-match-p "Left B" (buffer-string)))
|
||||
(should (= renders etaf-rv--renders))
|
||||
(should (> etaf-rv--left-reads left-reads))
|
||||
(should (= right-reads etaf-rv--right-reads))))))
|
||||
|
||||
(ert-deftest etaf-render-view-projects-caller-owned-slots ()
|
||||
"Embedded Views distinguish projections from named inputs and caller props."
|
||||
(etaf-rv--define
|
||||
'etaf-rv-panel '(&key label)
|
||||
:render '(let ((heading label))
|
||||
(etaf-view
|
||||
(column
|
||||
(text (expr heading))
|
||||
(slot)
|
||||
(slot :name 'footer (text "Fallback"))))))
|
||||
(etaf-rv--define
|
||||
'etaf-rv-slot-owner '(&key label)
|
||||
:render '(let ((caption label))
|
||||
(etaf-view
|
||||
(etaf-rv-panel :label "Panel"
|
||||
(text (expr label))
|
||||
(slot :name 'footer (text (expr (concat caption " footer"))))))))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-slot-owner '(:label "Caller") nil))
|
||||
(should (string-match-p "Panel[[:space:]]+Caller[[:space:]]+Caller footer"
|
||||
(buffer-string)))
|
||||
(should-not (string-match-p "Fallback" (buffer-string))))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount (current-buffer)
|
||||
(etaf-node 'etaf-rv-panel '(:label "Panel") nil))
|
||||
(should (string-match-p "Fallback" (buffer-string)))))
|
||||
|
||||
(ert-deftest etaf-render-view-callback-captures-committed-prop-snapshot ()
|
||||
"A normal lexical callback uses new committed props and survives rollback."
|
||||
(etaf-rv--define
|
||||
'etaf-rv-snapshot '(&key label)
|
||||
:render '(let ((caption label))
|
||||
(etaf-view
|
||||
(box :ref 'etaf-rv-snapshot-button
|
||||
:on-press (lambda () (push caption etaf-rv--events))
|
||||
(text (expr caption))))))
|
||||
(let ((label (etaf-ref "A"))
|
||||
(etaf-rv--events nil))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount
|
||||
(current-buffer)
|
||||
(lambda ()
|
||||
(etaf-node
|
||||
'column nil
|
||||
(list (etaf-node 'etaf-rv-snapshot
|
||||
(list :label (etaf-value label)) nil)
|
||||
(etaf-view
|
||||
(text (expr (if (equal (etaf-value label) "Failed")
|
||||
(error "Rejected sibling")
|
||||
"Sibling"))))))))
|
||||
(let ((runtime (etaf-runtime-for-buffer (current-buffer))))
|
||||
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
||||
(setf (etaf-value label) "B")
|
||||
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
||||
(let ((published (buffer-string)))
|
||||
(should-error (setf (etaf-value label) "Failed"))
|
||||
(should (equal-including-properties published (buffer-string))))
|
||||
(etaf-dispatch-event runtime 'etaf-rv-snapshot-button 'press)
|
||||
(should (equal '("B" "B" "A") etaf-rv--events))))))
|
||||
|
||||
(ert-deftest etaf-render-view-callback-live-ref-is-not-a-ui-snapshot ()
|
||||
"An explicit shared ref remains live even when a sibling rejects its UI."
|
||||
(etaf-rv--define
|
||||
'etaf-rv-live '(&key model)
|
||||
:render '(let ((shared model))
|
||||
(etaf-view
|
||||
(box :ref 'etaf-rv-live-button
|
||||
:on-press (lambda ()
|
||||
(push (etaf-value shared) etaf-rv--events))
|
||||
(text "Read live")))))
|
||||
(let ((model (etaf-ref "A"))
|
||||
(etaf-rv--events nil))
|
||||
(etaf-rv--with-buffer
|
||||
(etaf-mount
|
||||
(current-buffer)
|
||||
(etaf-node
|
||||
'column nil
|
||||
(list (etaf-node 'etaf-rv-live (list :model model) nil)
|
||||
(etaf-view
|
||||
(text (expr (if (equal (etaf-value model) "B")
|
||||
(error "Rejected live value")
|
||||
"Sibling")))))))
|
||||
(let ((runtime (etaf-runtime-for-buffer (current-buffer)))
|
||||
(published (buffer-string)))
|
||||
(should-error (setf (etaf-value model) "B"))
|
||||
(should (equal-including-properties published (buffer-string)))
|
||||
(etaf-dispatch-event runtime 'etaf-rv-live-button 'press)
|
||||
(should (equal '("B") etaf-rv--events))))))
|
||||
|
||||
(provide 'etaf-render-view-tests)
|
||||
;;; etaf-render-view-tests.el ends here
|
||||
@ -55,6 +55,7 @@
|
||||
(defvar etaf-test-nested-range-present nil)
|
||||
(defvar etaf-test-nested-range-source nil)
|
||||
(defvar etaf-test-nested-range-evals 0)
|
||||
(defvar etaf-test-nested-inner-range-evals 0)
|
||||
(defvar etaf-test-nested-outer-source nil)
|
||||
(defvar etaf-test-nested-inner-source nil)
|
||||
(defvar etaf-test-inline-shared nil)
|
||||
@ -151,6 +152,7 @@
|
||||
|
||||
(defun etaf-test--nested-range-children ()
|
||||
"Return keyed nested Hosts from the nested Range source."
|
||||
(cl-incf etaf-test-nested-inner-range-evals)
|
||||
(let ((state (etaf-value etaf-test-nested-range-source)))
|
||||
(append
|
||||
(and (cdr state)
|
||||
@ -351,7 +353,7 @@
|
||||
(etaf-node 'column nil (list "prefix" (etaf-state) "suffix")))
|
||||
|
||||
(etaf-define-component etaf-test-unsupported-direct-range ()
|
||||
"Start with a Host Range whose later unsupported output must fail."
|
||||
"Start with a Host Range and then produce nested dynamic Components."
|
||||
:setup
|
||||
(let ((range (etaf--expr-create
|
||||
:token 'etaf-test-unsupported-range-site
|
||||
@ -884,7 +886,7 @@
|
||||
(setq etaf-test-theme-cell theme)
|
||||
(etaf-provide 'theme theme)
|
||||
theme)
|
||||
:view (column (slot)))
|
||||
:view (column (etaf-test-consumer)))
|
||||
|
||||
(etaf-define-component etaf-test-consumer ()
|
||||
"Render the nearest Context theme."
|
||||
@ -1938,14 +1940,13 @@
|
||||
(should (equal theme left-value))))
|
||||
|
||||
(ert-deftest etaf-context-provide-inject-follows-component-tree ()
|
||||
"Resolve the nearest Context and react to its provided ref."
|
||||
"Test Component inheritance; separate slot tests cover author environments."
|
||||
(let ((buffer-name " *etaf-context-test*"))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name
|
||||
(etaf-view
|
||||
(etaf-test-provider
|
||||
(etaf-test-consumer))))
|
||||
(etaf-test-provider)))
|
||||
(with-current-buffer buffer-name
|
||||
(should (equal "dark" (buffer-string))))
|
||||
(setf (etaf-value etaf-test-theme-cell) 'light)
|
||||
@ -2371,17 +2372,21 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(should (plist-get condition :path))
|
||||
(should (= 3 (length (plist-get condition :path))))))))
|
||||
|
||||
(ert-deftest etaf-runtime-skips-descendant-range-under-rendered-component ()
|
||||
"A freshly rendered Component absorbs its old descendant Range effect."
|
||||
(ert-deftest etaf-runtime-skips-reevaluated-descendant-range-effects ()
|
||||
"Only actual candidate evaluation absorbs a queued descendant Range effect."
|
||||
(let* ((component
|
||||
(etaf--semantic-component-create
|
||||
:semantic-id 7 :identity '(parent-component)))
|
||||
(range
|
||||
(etaf--semantic-range-create
|
||||
:semantic-id 8 :effect-id 8 :component-id 7 :parent-id 7))
|
||||
(effect
|
||||
(etaf--generation-effect-create
|
||||
:effect-id 8 :kind 'range :semantic-id 8))
|
||||
(generation
|
||||
(etaf--generation-create
|
||||
:generation-id 1
|
||||
:effect-map (etaf--pvec-put nil 8 effect)
|
||||
:semantic-nodes (etaf--pvec-put
|
||||
(etaf--pvec-put nil 7 component) 8 range)))
|
||||
(runtime
|
||||
@ -2389,16 +2394,19 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
:candidate-rendered-identities '((parent-component))
|
||||
:candidate-effects (make-hash-table :test #'eql)
|
||||
:candidate-graph-nodes (make-hash-table :test #'eql))))
|
||||
(puthash 8
|
||||
(etaf--generation-effect-create
|
||||
:effect-id 8 :kind 'range :semantic-id 8)
|
||||
(etaf-runtime-candidate-effects runtime))
|
||||
(puthash 8 effect (etaf-runtime-candidate-effects runtime))
|
||||
(puthash 8 range (etaf-runtime-candidate-graph-nodes runtime))
|
||||
(should (etaf--runtime-range-owned-by-rendered-component-p
|
||||
runtime generation range))
|
||||
(should-not (etaf--runtime-range-effect-staged-p runtime generation effect))
|
||||
;; Reparenting or invalidating a semantic record is not effect evaluation.
|
||||
(puthash 8 (copy-sequence range) (etaf-runtime-candidate-graph-nodes runtime))
|
||||
(should-not (etaf--runtime-range-effect-staged-p runtime generation effect))
|
||||
(puthash 8 (copy-sequence effect) (etaf-runtime-candidate-effects runtime))
|
||||
(should (etaf--runtime-range-effect-staged-p runtime generation effect))
|
||||
;; Root-owned Range ancestors have the same completed-work certificate.
|
||||
(setf (etaf-runtime-candidate-rendered-identities runtime) nil)
|
||||
(should-not (etaf--runtime-range-owned-by-rendered-component-p
|
||||
runtime generation range))))
|
||||
(should (etaf--runtime-range-effect-staged-p runtime generation effect))
|
||||
(remhash 8 (etaf-runtime-candidate-graph-nodes runtime))
|
||||
(should-not (etaf--runtime-range-effect-staged-p runtime generation effect))))
|
||||
|
||||
|
||||
(ert-deftest etaf-stateful-props-update-without-rerunning-setup ()
|
||||
@ -3004,8 +3012,11 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||
(generation (etaf-runtime-current-generation runtime))
|
||||
(effects (etaf--generation-source-effects generation source))
|
||||
(parent (etaf--generation-semantic
|
||||
generation '(etaf-test-local-style-parent (root)))))
|
||||
(parent
|
||||
(cl-loop for identity being the hash-keys of
|
||||
(etaf-generation-identity-index generation)
|
||||
when (eq (car-safe identity) 'etaf-test-local-style-parent)
|
||||
return (etaf--generation-semantic generation identity))))
|
||||
(should-not (memq (etaf--semantic-component-effect-id parent)
|
||||
effects))
|
||||
(setf (etaf-value source) "B")
|
||||
@ -3628,6 +3639,32 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(should (equal '(20 30)
|
||||
(etaf-runtime-candidate-removed-semantic-ids runtime)))))
|
||||
|
||||
(ert-deftest etaf-runtime-range-closure-preserves-removals-and-rejects-unknown ()
|
||||
"Completing a reused graph cannot revive tombstones or invent owners."
|
||||
(let* ((retained (etaf--semantic-host-create :semantic-id 1 :name 'text))
|
||||
(generation
|
||||
(etaf--generation-create
|
||||
:semantic-nodes (etaf--pvec-put nil 1 retained)))
|
||||
(runtime
|
||||
(etaf--runtime-create
|
||||
:generation-authority (etaf-generation-authority-create generation)
|
||||
:candidate-graph-nodes (make-hash-table :test #'eql)
|
||||
:candidate-graph-children (make-hash-table :test #'eql)
|
||||
:candidate-removed-semantic-ids '(1))))
|
||||
(cl-letf (((symbol-function 'etaf--runtime-carry-committed-subtree)
|
||||
(lambda (&rest _) (error "A removed owner was resurrected"))))
|
||||
(dolist (id '(1 99))
|
||||
(let ((ids (etaf--runtime-candidate-descendant-ids runtime (list id))))
|
||||
(should (equal ids (list id)))
|
||||
(should-error
|
||||
(etaf--runtime-index-range-item-identities
|
||||
runtime ids (make-hash-table :test #'equal))
|
||||
:type 'etaf-runtime-error))))
|
||||
(should (zerop (hash-table-count
|
||||
(etaf-runtime-candidate-graph-nodes runtime))))
|
||||
(should (eq retained (etaf--pvec-get
|
||||
(etaf-generation-semantic-nodes generation) 1)))))
|
||||
|
||||
(ert-deftest etaf-runtime-two-direct-ranges-batch-one-publication ()
|
||||
"Evaluate and splice two disjoint Ranges once in one logical commit."
|
||||
(let ((buffer-name " *etaf-two-range-test*")
|
||||
@ -3833,8 +3870,8 @@ 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-direct-range-rejects-step4b-output-without-reownership ()
|
||||
"Reject direct Component output while retaining Range-only dependency."
|
||||
(ert-deftest etaf-runtime-direct-range-accepts-nested-components-without-reownership ()
|
||||
"Retain ordinary and nested Components under one Range-only dependency."
|
||||
(dolist (unsupported '(component deep-component
|
||||
deep-expr-component))
|
||||
(let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported))
|
||||
@ -3845,11 +3882,11 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(etaf-view (etaf-test-unsupported-direct-range)))
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||
(generation (etaf-runtime-current-generation runtime)))
|
||||
(should-error
|
||||
(setf (etaf-value etaf-test-unsupported-range-source)
|
||||
unsupported)
|
||||
:type 'etaf-runtime-error)
|
||||
(should (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(setf (etaf-value etaf-test-unsupported-range-source) unsupported)
|
||||
(should-not (eq generation (etaf-runtime-current-generation runtime)))
|
||||
(setq generation (etaf-runtime-current-generation runtime))
|
||||
(should (string-match-p "component\\|deep"
|
||||
(etaf-test--buffer-text buffer-name)))
|
||||
(should
|
||||
(equal '(range)
|
||||
(mapcar
|
||||
@ -3892,7 +3929,8 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(let ((buffer-name " *etaf-nested-range-hosts-test*")
|
||||
(etaf-test-nested-range-present (etaf-ref t))
|
||||
(etaf-test-nested-range-source (etaf-ref (cons "A" nil)))
|
||||
(etaf-test-nested-range-evals 0))
|
||||
(etaf-test-nested-range-evals 0)
|
||||
(etaf-test-nested-inner-range-evals 0))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(etaf-mount buffer-name (etaf-view (etaf-test-nested-host-range)))
|
||||
@ -3904,19 +3942,29 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(range-id (etaf--generation-effect-semantic-id effect))
|
||||
(range (etaf--pvec-get
|
||||
(etaf-generation-semantic-nodes generation) range-id))
|
||||
(outer-effect-id
|
||||
(car (etaf--generation-source-effects
|
||||
generation etaf-test-nested-range-present)))
|
||||
(nested-id
|
||||
(cl-loop for identity being the hash-keys of
|
||||
(etaf--semantic-range-item-identity-index range)
|
||||
using (hash-values semantic-id)
|
||||
when (equal (plist-get (cddr identity) :key) 'nested)
|
||||
return semantic-id)))
|
||||
(setq etaf-test-nested-range-evals 0)
|
||||
(should (= 1 etaf-test-nested-range-evals))
|
||||
(should (= 1 etaf-test-nested-inner-range-evals))
|
||||
(should-not (= effect-id outer-effect-id))
|
||||
(setq etaf-test-nested-range-evals 0
|
||||
etaf-test-nested-inner-range-evals 0)
|
||||
(cl-letf (((symbol-function 'etaf--runtime-render-dirty-component)
|
||||
(lambda (&rest _)
|
||||
(error "Nested Range entered Component owner"))))
|
||||
(setf (etaf-value etaf-test-nested-range-source)
|
||||
(cons "B" t)))
|
||||
(should (= 1 etaf-test-nested-range-evals))
|
||||
;; The Host boundary gives this source to the inner Range alone.
|
||||
(should (= 0 etaf-test-nested-range-evals))
|
||||
(should (= 1 etaf-test-nested-inner-range-evals))
|
||||
(should (equal "S sibling B" (etaf-test--buffer-text buffer-name)))
|
||||
(should (= 1 (plist-get
|
||||
(plist-get (ebox-buffer-update-report buffer-name)
|
||||
:range-metrics)
|
||||
@ -3940,12 +3988,17 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(etaf--generation-source-effects
|
||||
generation etaf-test-nested-range-source))))
|
||||
(let* ((old-generation generation)
|
||||
(old-range range)
|
||||
(old-range
|
||||
(etaf--generation-effect-semantic
|
||||
old-generation outer-effect-id))
|
||||
(removed-ids
|
||||
(etaf--runtime-generation-descendant-ids
|
||||
old-generation
|
||||
(etaf--semantic-range-item-root-ids old-range))))
|
||||
(setf (etaf-value etaf-test-nested-range-present) nil)
|
||||
(should (= 1 etaf-test-nested-range-evals))
|
||||
(should (= 1 etaf-test-nested-inner-range-evals))
|
||||
(should (equal "S" (etaf-test--buffer-text buffer-name)))
|
||||
(let ((new-generation
|
||||
(etaf-runtime-current-generation runtime)))
|
||||
(dolist (semantic-id removed-ids)
|
||||
@ -4010,6 +4063,7 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(setf (etaf-value etaf-test-nested-inner-source)
|
||||
'((row-a . "two"))))
|
||||
(should (equal (list inner-ref) (nreverse replacements)))
|
||||
(should (equal "A two" (etaf-test--buffer-text buffer-name)))
|
||||
(setq generation (etaf-runtime-current-generation runtime))
|
||||
(let ((new-outer (etaf--pvec-get
|
||||
(etaf-generation-semantic-nodes generation)
|
||||
@ -4724,8 +4778,10 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
|
||||
(generation (etaf-runtime-current-generation runtime))
|
||||
(parent
|
||||
(etaf--generation-semantic
|
||||
generation '(etaf-test-ancestor-artifact-parent (root)))))
|
||||
(cl-loop for identity being the hash-keys of
|
||||
(etaf-generation-identity-index generation)
|
||||
when (eq (car-safe identity) 'etaf-test-ancestor-artifact-parent)
|
||||
return (etaf--generation-semantic generation identity))))
|
||||
(should (etaf--semantic-component-p parent))
|
||||
(should-not (etaf--semantic-component-artifact-key parent))
|
||||
(setf (etaf-value etaf-test-ancestor-parent-source) "dark")
|
||||
@ -4842,6 +4898,7 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(let ((runtime
|
||||
(etaf--runtime-create
|
||||
:candidate-removed-host-refs '(stable other)
|
||||
:behaviors (make-hash-table :test #'equal)
|
||||
:candidate-host-props (make-hash-table :test #'equal)
|
||||
:candidate-handlers (make-hash-table :test #'equal)
|
||||
:candidate-semantic-nodes (make-hash-table :test #'equal)
|
||||
@ -4902,6 +4959,7 @@ Event composition is a Runtime contract, not a UI-library helper contract."
|
||||
(let ((etaf-generation-index-max-depth 4)
|
||||
(runtime
|
||||
(etaf--runtime-create
|
||||
:behaviors (make-hash-table :test #'equal)
|
||||
:candidate-handlers (make-hash-table :test #'equal)
|
||||
:candidate-host-props (make-hash-table :test #'equal)
|
||||
:candidate-semantic-nodes (make-hash-table :test #'equal)
|
||||
|
||||
File diff suppressed because one or more lines are too long
14
tests/fixtures/etaf-m0b-doc-examples.sexp
vendored
14
tests/fixtures/etaf-m0b-doc-examples.sexp
vendored
@ -1,5 +1,15 @@
|
||||
((:file "docs/user-guide.en.md"
|
||||
:block 18
|
||||
:block 19
|
||||
:sha256 "79390863a3fdf604969cc4f424b36a9a466e569bd0ac740e61c580b2518cb2da"
|
||||
:classification mounted-smoke
|
||||
:probe collection-composition))
|
||||
:probe collection-composition)
|
||||
(:file "docs/user-guide.en.md"
|
||||
:block 8
|
||||
:sha256 "5e7b4088abd90a8ff9a5676d8ac98a2534ef43b79e927f14b4a67fe1189a9c11"
|
||||
:classification mounted-smoke
|
||||
:probe runtime-snapshot)
|
||||
(:file "docs/user-guide.zh.md"
|
||||
:block 8
|
||||
:sha256 "5e7b4088abd90a8ff9a5676d8ac98a2534ef43b79e927f14b4a67fe1189a9c11"
|
||||
:classification mounted-smoke
|
||||
:probe runtime-snapshot))
|
||||
|
||||
Loading…
Reference in New Issue
Block a user