diff --git a/Makefile b/Makefile index 91ac9e6..bbe6446 100644 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ EMACS ?= emacs -LOAD_PATH = -L . -L examples -L ../ebox +LOAD_PATH = -L . -L examples -L ../ebox -L ../tp -L ../ecss SOURCES = etaf-view.el etaf-component.el etaf-reactive.el etaf-context.el etaf-resource.el etaf-data.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf.el EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el TESTS = tests/etaf-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-examples-tests.el diff --git a/docs/architecture.en.md b/docs/architecture.en.md index 0106799..2750eec 100644 --- a/docs/architecture.en.md +++ b/docs/architecture.en.md @@ -109,6 +109,8 @@ Attribute values do not need an `expr` wrapper. `expr` exists only because the c It evaluates the expression, then accepts a string, View, sequence, or `nil`. It creates no Ebox wrapper, identity, lifecycle, watcher, or effect. `if`, `when`, `cond`, `let`, `mapcar`, `cl-loop`, and other Elisp forms remain ordinary Elisp inside `:value`. +The current core has no file-facing `.etaf` pair loader. `etaf-define-component` is the structure/style/behavior unit: its View defines structure, `:styles` owns presentation rules, and `:setup` owns retained state, events, and lifecycle behavior. A future `.etaf` single-file component format belongs in a compiler layer that lowers into this same public View and Component contract; it is not a second runtime grammar. + ## 4. Components The public definition macro has exactly three keywords: @@ -127,6 +129,8 @@ The public definition macro has exactly three keywords: `:view` and `:setup` are mutually exclusive. `:styles` is optional and may appear once. Props are the only declared business inputs; ordinary trailing children and named slots are normalized separately into the Component's slot collection. +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. + ### 4.1 Stateless and stateful forms ```elisp @@ -342,6 +346,8 @@ Keys are stable ordinary symbols. The nearest ancestor wins; a missing required Explicit Host props override Component styles, and Component styles override Theme defaults. +Style ownership follows the Component that authored each View node. A nested Component is a style boundary: parent rules do not penetrate its internals. Caller-provided slot content is rendered with the caller scope, while a child's own fallback content remains in the child scope. + ### 9.2 Data Data is a core ETAF capability, not a second framework package. A Data Source is a small capability plist: @@ -417,7 +423,30 @@ etaf-playground → etaf Optional storage integrations should use explicit package names such as a concrete SQLite or PostgreSQL source. A generic adapter package would add a name without owning a stable behavior, so it is not part of the public model. -## 11. Extension rule +## 11. Retained publication and fixed-point safety + +Mounted Component, expr, slot, fragment, raw, inline, and Root owners publish +through one outer reactive dispatch. A local owner evaluates into a candidate +generation and Ebox logical replacement; disjoint owners are coalesced into +one TP/Ebox publication. The Root owner is the only complete-root adapter. + +Each Runtime flush records a candidate-aware effect tuple containing the +generation id, effect-to-source edges and source versions, plus an immutable +semantic-node stamp for candidate input/context/output facts. A repeated tuple +reports the ordered effect/edge path of the non-converging graph. The flush +bound is derived from candidate nodes, dependency edges, and source entries; +it is not a fixed multiplier of an arbitrary threshold. Rollback discards the +flush-local stamps, so the same failed state can be retried as a new +transaction. + +Behavior installers use target-specific identity: reactive values and +functions are compared with `eq`, while scalar attributes use value equality. +Each installed Behavior also receives a stable `(mount-epoch resource-id)` +address. Generation membership and the Runtime resource registry determine +which installer is authoritative; a failed candidate removes only its staged +Behavior resource and runs its contained cleanup. + +## 12. Extension rule Before adding a new concept, choose the smallest existing owner: diff --git a/docs/architecture.zh.md b/docs/architecture.zh.md index bdd7570..feff467 100644 --- a/docs/architecture.zh.md +++ b/docs/architecture.zh.md @@ -108,6 +108,8 @@ ATTRIBUTE = :KEY VALUE 它执行表达式，然后接受字符串、View、View 序列或 `nil`。它不创建 Ebox wrapper、identity、生命周期、watch 或 effect。`if`、`when`、`cond`、`let`、`mapcar`、`cl-loop` 等 Elisp 形式仍然只是 `:value` 中的普通 Elisp。 +当前 core 没有面向文件的 `.etaf` pair loader。`etaf-define-component` 才是结构/样式/行为单元：View 定义结构，`:styles` 负责 presentation，`:setup` 负责 retained state、事件和生命周期行为。未来的 `.etaf` SFC 属于把结果 lowering 到同一套公共 View/Component 契约的 compiler layer，而不是第二套 Runtime 语法。 + ## 4. Component 公共定义宏只有三个关键字： @@ -126,6 +128,8 @@ ATTRIBUTE = :KEY VALUE `:view` 和 `:setup` 互斥；`:styles` 可选且最多出现一次。Props 是唯一需要声明的业务输入；普通尾部子节点和命名 slot 会被规范化为 Component 的 slot 集合。 +Component definition 是当前结构/样式/行为边界：动态状态、Action callback 和生命周期工作放进 `:setup`，静态 presentation 放进 `:styles`。未来 `.etaf` SFC compiler 可以生成这些 definition，但 Runtime 不会直接加载 `.etaf` 文件。 + ### 4.1 无状态与状态型形式 ```elisp @@ -341,6 +345,8 @@ key 使用稳定的普通 symbol。最近的祖先优先，缺失的 required ke 显式 Host props 覆盖 Component styles，Component styles 覆盖 Theme defaults。 +样式所有权跟随创建每个 View node 的 Component。嵌套 Component 是样式边界：父规则不会穿透其内部。调用者提供的 slot 内容使用 caller scope，子组件自有的 fallback 内容保留在 child scope。 + ### 9.2 Data Data 是 ETAF core 能力，不是需要用户额外学习的第二套框架。Data Source 是一个小的 capability plist： @@ -416,7 +422,27 @@ etaf-playground → etaf 可选存储集成应使用具体名称，例如 SQLite 或 PostgreSQL source。通用 adapter 包无法拥有稳定的行为，只会增加用户需要记忆的名称，因此不属于公共模型。 -## 11. 拓展规则 +## 11. 保留式发布与 fixed-point 安全 + +mounted Component、expr、slot、fragment、raw、inline 和 Root owner 都经过同一 +个外层 reactive dispatch。局部 owner 先生成 candidate generation 和 Ebox logical +replacement；不相交 owner 会合并为一次 TP/Ebox publication。只有 Root owner +可以进入 complete-root adapter。 + +每次 Runtime flush 都记录 candidate-aware effect tuple：其中包含 generation id、 +effect→source 边和 source version，以及 candidate input/context/output facts 的 +immutable semantic-node stamp。重复 tuple 会报告有序的 effect/edge path；step +bound 从 candidate nodes、dependency edges 和 source entries 推导，不再是任意 +固定倍率阈值。rollback 会丢弃本次 flush 的 stamp，因此同一个失败状态可以作为 +新的 transaction 重试。 + +Behavior installer 使用 target-specific identity：reactive value 和 function 用 +`eq`，普通 scalar attribute 才使用 value equality。每个已安装 Behavior 都获得 +稳定的 `(mount-epoch resource-id)` 地址；generation membership 与 Runtime resource +registry 决定当前 authority。失败 candidate 只移除 staged Behavior resource，并 +执行受 containment 保护的 cleanup。 + +## 12. 拓展规则 增加新能力前，优先选择最小的既有 owner： diff --git a/docs/user-guide.en.md b/docs/user-guide.en.md index 797aa9a..500e706 100644 --- a/docs/user-guide.en.md +++ b/docs/user-guide.en.md @@ -58,6 +58,8 @@ Mount it into an Emacs buffer: Use `etaf-mount` whenever a View contains a stateful Component, reactive data, events, or lifecycle. +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 Attribute values are ordinary Elisp expressions. They do not need an extra `expr` wrapper: @@ -266,6 +268,14 @@ Precedence is fixed: explicit Host properties > Component :styles > inherited Theme defaults ``` +Within one Component style scope, the first matching declaration fills an +unspecified Host property; later rules do not overwrite that resolved default. +A non-nil Host property remains protected, and a nil Host property is treated +as omitted and may receive the Component or Theme default. Use explicit Host +props or distinct properties when a variant needs a deliberate override. + +Styles are scoped to the Component that authored a View node. A parent rule does not enter a nested Component's internals; content supplied through a caller slot keeps the caller scope, while a Component's own slot fallback keeps the child scope. + Theme is a Context convenience, not another runtime object: ```elisp @@ -339,7 +349,7 @@ For a reusable installer, reserve `:install` for the cleanup-producing part of t (message "Behavior removed"))))))) ``` -The installer can call `etaf-current-behavior-context` when it needs the current Runtime or Host path. Replacing the Behavior runs the old cleanup before the new state becomes current. +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. Focus and hit testing are Runtime operations: @@ -351,6 +361,8 @@ Focus and hit testing are Runtime operations: `etaf-host-ref-bounds` and `etaf-host-ref-position` expose the public Ebox hit-test boundary. `etaf-dispatch-event` accepts an optional payload flag when the callback needs one argument. +Mounted buffers enable `etaf-input-mode` automatically. `TAB` focuses the next Host, `Shift-TAB`/backtab focuses the previous Host, `RET` activates the focused Host, and `mouse-1` activates the Host at the click position. Focus ordering sorts numeric `:tab-index` first and uses live buffer position as the stable tie-breaker; moving focus also moves point to that Host. Unmounting disables the input mode. + ## 9. Context / Provide / Inject Use Context for a dependency shared across component depth, not for ordinary props: @@ -563,7 +575,7 @@ It depends only on Ebox. Use it when inspecting Ebox boxes and Grid layout; use | Reactive effects | `etaf-watch`, `etaf-watch-effect`, `etaf-effect-scope`, `etaf-scope-run` | Observe state or synchronize external resources | | Lifecycle | `etaf-on-mounted`, `etaf-on-updated`, `etaf-on-unmounted` | Attach Component lifecycle work | | Context | `etaf-provide`, `etaf-inject`, `etaf-theme-provide` | Share ambient dependencies through depth | -| Events and focus | `etaf-dispatch-event`, `etaf-activate`, `etaf-focus`, `etaf-focus-next` | Enter interactive Runtime behavior | +| Events and focus | `etaf-dispatch-event`, `etaf-activate`, `etaf-focus`, `etaf-focus-next`, `etaf-focus-previous`, `etaf-input-mode` | Enter interactive Runtime behavior | | Actions | `etaf-action-define`, `etaf-dispatch` | Name and reuse business mutations | | Behaviors | `etaf-behavior-create`, `etaf-define-behavior`, `etaf-current-behavior-context`, `etaf-focusable`, `etaf-toggleable` | Reuse non-visual interaction bundles | | Data | `etaf-data-source`, `etaf-data-controller`, `etaf-data-memory-source`, `etaf-data-*` | Query, paginate, mutate, select, and stop data | @@ -583,3 +595,9 @@ Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`, - Keep writes out of rendering; use an event, Action, watch callback, or Effect. - Use `etaf-ui` Components for product controls; core Hosts are the structural foundation. - Stop a Data Controller and unmount a Runtime when their owner is no longer needed. + +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. diff --git a/docs/user-guide.zh.md b/docs/user-guide.zh.md index 0f1e979..085c731 100644 --- a/docs/user-guide.zh.md +++ b/docs/user-guide.zh.md @@ -58,6 +58,8 @@ ETAF 依赖独立的 Ebox 包。开发时把核心检出目录放入 `load-path` View 含有状态型 Component、响应式数据、事件或生命周期时，使用 `etaf-mount`。 +当前 core 不直接加载 `.etaf`。`etaf-define-component` 是结构/样式/行为单元：用 View 定义结构，用 `:styles` 放静态 presentation，用 `:setup` 管理 retained state、Action 和生命周期。未来 `.etaf` SFC 属于把结果编译成同一套 Component 契约的 compiler layer，而不是第二个 Runtime 入口。 + ## 3. 属性与子节点 属性值就是普通 Elisp 表达式，不需要额外的 `expr`： @@ -266,6 +268,13 @@ Setup 对 retained instance 只执行一次，返回的 render 函数在更新 显式 Host 属性 > Component :styles > 继承的 Theme 默认值 ``` +在同一个 Component 样式作用域内，第一条匹配声明会填充尚未指定的 Host +属性；后续规则不会覆盖已经解析出的默认值。非 nil 的 Host 属性始终受 +保护，nil Host 属性按省略处理，可以接收 Component 或 Theme 默认值。若 +variant 需要明确覆盖，应使用显式 Host 属性或不同的属性键。 + +样式作用域归属于创建 View node 的 Component。父组件规则不会进入嵌套 Component 的内部；调用者通过 slot 提供的内容保留 caller scope，Component 自己定义的 slot fallback 保留 child scope。 + Theme 是 Context 的便捷形式，不是另一个 Runtime 对象： ```elisp @@ -339,7 +348,7 @@ Behavior 用来打包可复用的非视觉属性和 cleanup： (message "Behavior removed"))))))) ``` -Installer 需要 Runtime 或 Host path 时，可以调用 `etaf-current-behavior-context`。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。 Focus 和 hit testing 是 Runtime 操作： @@ -351,6 +360,8 @@ Focus 和 hit testing 是 Runtime 操作： `etaf-host-ref-bounds` 和 `etaf-host-ref-position` 暴露公共的 Ebox hit-test 边界。`etaf-dispatch-event` 支持可选 payload 标记，用于给 callback 传入一个参数。 +挂载后的 buffer 会自动启用 `etaf-input-mode`：`TAB` 聚焦下一个 Host，`Shift-TAB`/backtab 聚焦上一个 Host，`RET` 激活当前焦点 Host，`mouse-1` 在点击位置激活 Host。焦点顺序先按数字 `:tab-index`，相同 index 再按 live buffer position 稳定排序；移动焦点也会移动 point。卸载时会禁用该输入 mode。 + ## 9. Context / Provide / Inject Context 适合跨多层共享依赖，不适合普通 label： @@ -563,7 +574,7 @@ Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可 | 响应式 effect | `etaf-watch`、`etaf-watch-effect`、`etaf-effect-scope`、`etaf-scope-run` | 观察状态或同步外部资源 | | 生命周期 | `etaf-on-mounted`、`etaf-on-updated`、`etaf-on-unmounted` | 绑定 Component 生命周期工作 | | Context | `etaf-provide`、`etaf-inject`、`etaf-theme-provide` | 跨层级共享依赖 | -| 事件与 focus | `etaf-dispatch-event`、`etaf-activate`、`etaf-focus`、`etaf-focus-next` | 进入交互 Runtime | +| 事件与 focus | `etaf-dispatch-event`、`etaf-activate`、`etaf-focus`、`etaf-focus-next`、`etaf-focus-previous`、`etaf-input-mode` | 进入交互 Runtime | | Action | `etaf-action-define`、`etaf-dispatch` | 命名和复用业务变更 | | Behavior | `etaf-behavior-create`、`etaf-define-behavior`、`etaf-current-behavior-context`、`etaf-focusable`、`etaf-toggleable` | 复用非视觉交互 bundle | | Data | `etaf-data-source`、`etaf-data-controller`、`etaf-data-memory-source`、`etaf-data-*` | 查询、分页、变更、选择和停止数据 | @@ -583,3 +594,8 @@ Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可 - 不要在 render 中写状态；使用事件、Action、watch callback 或 Effect。 - 产品级控件使用 `etaf-ui` Component；core Host 只是结构基础。 - owner 不再需要时，停止 Data Controller 并卸载 Runtime。 + +对于保留式更新，建议保持 pair 结构：`.etaf` 只放静态 shell，同名 `.el` companion +负责 state、Component 和 action。响应式写入会合并为一次 generation publication； +发布失败可以在同一旧状态上重试，non-converging effect 会报告错误，不会让界面 +持续占用事件循环。 diff --git a/etaf-component.el b/etaf-component.el index 516ef91..b888f2b 100644 --- a/etaf-component.el +++ b/etaf-component.el @@ -18,6 +18,13 @@ "Invalid ETAF Component definition" 'etaf-view-error) +(cl-defstruct (etaf--slot-content (:constructor etaf--slot-content-create)) + "Internal caller ownership metadata for one slot entry." + owner-component-id children) + +(defvar etaf--raw-slot-read-p nil + "Set while a Component render uses public raw slot accessors.") + (defun etaf--component-definition-error (format-string &rest arguments) "Signal a Component definition error from FORMAT-STRING and ARGUMENTS." (signal 'etaf-component-definition-error @@ -63,21 +70,23 @@ The function is also useful to code that deliberately avoids that shorthand." (defun etaf-current-slots () "Return the current Component's normalized slot alist." - etaf--current-component-slots) + (setq etaf--raw-slot-read-p t) + (mapcar (lambda (entry) + (cons (car entry) + (if (etaf--slot-content-p (cdr entry)) + (etaf--slot-content-children (cdr entry)) + (cdr entry)))) + etaf--current-component-slots)) (defun etaf-current-slot (name &optional fallback) "Return the child list for slot NAME, or FALLBACK when it is absent." + (setq etaf--raw-slot-read-p t) (let ((entry (assq name etaf--current-component-slots))) - (if entry (cdr entry) fallback))) - -(defun etaf--component-prop-bindings (props) - "Return lexical bindings for stateless Component PROPS." - (mapcar (lambda (prop) - `(,prop - (etaf--resolve-property-value - (plist-get etaf--component-props - ,(etaf--component-prop-key prop))))) - props)) + (if entry + (if (etaf--slot-content-p (cdr entry)) + (etaf--slot-content-children (cdr entry)) + (cdr entry)) + fallback))) (defun etaf--component-prop-symbol-macros (props) "Return symbol macros that read current Component PROPS." @@ -183,7 +192,8 @@ forms do not use quote; ordinary Elisp belongs in `expr :value'." (etaf--current-component-slots etaf--component-slots) (etaf--current-component-instance etaf--current-component-instance)) - (let ,(etaf--component-prop-bindings props) + (cl-symbol-macrolet + ,(etaf--component-prop-symbol-macros props) ,(etaf--compile-view-form view-form :projection)))))) (setup-lambda (when saw-setup diff --git a/etaf-context.el b/etaf-context.el index f95ec82..df644fd 100644 --- a/etaf-context.el +++ b/etaf-context.el @@ -18,14 +18,28 @@ (:constructor etaf--context-create)) "One inherited Context frame owned by a Component instance." parent + owner-id (values (make-hash-table :test #'eq))) (defvar etaf--current-context nil "Context table of the Component currently being evaluated.") +(defvar etaf--context-inject-recorder nil + "Candidate-local function recording Context provider reads.") + (defconst etaf--context-missing (make-symbol "etaf-context-missing") "Unique sentinel used to distinguish an absent Context value.") +(defun etaf-context-copy (context) + "Return an immutable candidate copy of CONTEXT's local frame." + (when context + (let ((values (make-hash-table :test #'eq))) + (maphash (lambda (key value) (puthash key value values)) + (etaf-context-values context)) + (etaf--context-create :parent (etaf-context-parent context) + :owner-id (etaf-context-owner-id context) + :values values)))) + (defun etaf--context-key (key) "Validate and normalize Context KEY." (unless (and (symbolp key) (not (keywordp key)) (not (memq key '(nil t)))) @@ -52,16 +66,21 @@ can be distinguished from a missing dependency." (let ((key (etaf--context-key key)) (context etaf--current-context) found + provider value) (while (and context (not found)) (let ((candidate (gethash key (etaf-context-values context) etaf--context-missing))) (unless (eq candidate etaf--context-missing) (setq value candidate - found t))) + found t + provider context))) (setq context (etaf-context-parent context))) (if found - value + (progn + (when etaf--context-inject-recorder + (funcall etaf--context-inject-recorder provider key)) + value) (if (and required-p-supplied-p required-p) (signal 'etaf-context-error (list (format "Missing ETAF Context dependency: %S" key))) diff --git a/etaf-events.el b/etaf-events.el index b74f272..8f78049 100644 --- a/etaf-events.el +++ b/etaf-events.el @@ -4,9 +4,9 @@ ;;; Commentary: -;; Events are Runtime-owned entry points into local `:on-*' callbacks. Ebox -;; supplies live Host reference bounds; ETAF decides which callback to invoke -;; and keeps focus state separate from the visual tree. +;; Events are Runtime-owned entry points into local `:on-*' callbacks. The +;; input minor mode is deliberately small: Runtime only toggles it at mount +;; boundaries, while this module owns key and mouse command definitions. ;;; Code: @@ -20,10 +20,14 @@ (declare-function etaf-runtime-p "etaf-runtime" (value)) (declare-function etaf-runtime-mounted-p "etaf-runtime" (runtime)) (declare-function etaf-runtime-buffer "etaf-runtime" (runtime)) -(declare-function etaf-runtime-handlers "etaf-runtime" (runtime)) -(declare-function etaf-runtime-host-props "etaf-runtime" (runtime)) +(declare-function etaf-runtime-handler-for "etaf-runtime" (runtime host-ref)) +(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-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)) +(declare-function etaf-runtime-event-end "etaf-runtime" (runtime)) (define-error 'etaf-event-error "Invalid ETAF Event") @@ -37,7 +41,7 @@ ((symbolp kind) (symbol-name kind)) ((stringp kind) kind) (t (signal 'etaf-event-error - (list (format "Invalid event kind: %S" kind))))))) + (list (format "Invalid event kind: %S" kind))))))) (setq name (if (string-prefix-p "on-" name) (substring name 3) name)) @@ -46,7 +50,7 @@ (defun etaf--event-handler (runtime host-ref kind) "Return callback for HOST-REF and KIND in RUNTIME, or nil." (cdr (assq (etaf-event-kind kind) - (gethash host-ref (etaf-runtime-handlers runtime))))) + (etaf-runtime-handler-for runtime host-ref)))) ;;;###autoload (cl-defun etaf-dispatch-event @@ -65,9 +69,12 @@ otherwise call the local callback with no arguments." (etaf--current-event (list :runtime runtime :host-ref host-ref :kind (etaf-event-kind kind) :payload payload))) - (if payload-p - (funcall callback payload) - (funcall callback))))) + (etaf-runtime-event-begin runtime) + (unwind-protect + (if payload-p + (funcall callback payload) + (funcall callback)) + (etaf-runtime-event-end runtime))))) ;;;###autoload (defun etaf-host-ref-bounds (runtime host-ref) @@ -81,71 +88,184 @@ otherwise call the local callback with no arguments." (setq runtime (etaf-runtime-require-mounted runtime)) (ebox-host-ref-position (etaf-runtime-buffer runtime) host-ref)) +(defun etaf--position-number (position) + "Return integer POSITION, or nil when POSITION is not buffer-local." + (cond + ((markerp position) (marker-position position)) + ((integerp position) position) + (t nil))) + +(defun etaf--activation-candidate-before-p (left right) + "Return non-nil when activation candidate LEFT precedes 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) + (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))))))))) + +(defun etaf--activation-at-position (runtime position &optional quiet) + "Activate the smallest enabled Host 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 + (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) + (unless quiet + (user-error "No interactive ETAF Host at point"))))) + ;;;###autoload (defun etaf-activate (&optional runtime) - "Dispatch `press' for the smallest active Host containing point. + "Dispatch `press' for the smallest enabled Host containing point. -RUNTIME is the mounted Runtime to activate, or nil for the current Runtime. -Return the callback result. This command is intentionally a thin adapter; -hit testing remains Ebox's public Host-reference bounds operation." +RUNTIME is the mounted Runtime to activate, or nil for the current buffer." + (interactive) (setq runtime (etaf-runtime-require-mounted runtime)) - (let ((position (point)) candidates) - (maphash - (lambda (host-ref _handlers) - (when-let ((bounds (ebox-host-ref-bounds - (etaf-runtime-buffer runtime) host-ref))) - (when (and (<= (car bounds) position) (< position (cdr bounds))) - (push (cons host-ref (- (cdr bounds) (car bounds))) candidates)))) - (etaf-runtime-handlers runtime)) - (unless candidates - (user-error "No interactive ETAF Host at point")) - (let* ((ordered (sort candidates - (lambda (left right) (< (cdr left) (cdr right))))) - (host-ref (car (car ordered)))) - (etaf-dispatch-event runtime host-ref 'press)))) + (let ((position (with-current-buffer (etaf-runtime-buffer runtime) + (point)))) + (etaf--activation-at-position runtime position))) + +(defun etaf--focus-candidate-before-p (left right) + "Return non-nil when focus candidate LEFT precedes RIGHT." + (or (< (nth 0 left) (nth 0 right)) + (and (= (nth 0 left) (nth 0 right)) + (or (< (nth 1 left) (nth 1 right)) + (and (= (nth 1 left) (nth 1 right)) + (or (< (nth 2 left) (nth 2 right)) + (and (= (nth 2 left) (nth 2 right)) + (string< (prin1-to-string (nth 3 left)) + (prin1-to-string (nth 3 right)))))))))) + +(defun etaf--focus-candidates (runtime) + "Return RUNTIME's visible focus candidates in stable buffer order." + (let (candidates) + (dolist (entry (etaf-runtime-host-props-entries runtime)) + (let ((host-ref (car entry)) (props (cdr entry))) + (let ((tab-index (plist-get props :tab-index)) + (bounds (ebox-host-ref-bounds + (etaf-runtime-buffer runtime) host-ref))) + (when (and (numberp tab-index) (>= tab-index 0) + (not (plist-get props :disabled)) bounds) + (push (list tab-index (car bounds) (cdr bounds) host-ref) + candidates))))) + (sort candidates #'etaf--focus-candidate-before-p))) ;;;###autoload -(defun etaf-focus (runtime host-ref) - "Move focus to HOST-REF in mounted RUNTIME and return HOST-REF." +(defun etaf-focus (&optional runtime host-ref) + "Move focus to HOST-REF in mounted RUNTIME and move point to its position. + +When called interactively without arguments, focus the first visible Host." + (interactive) (setq runtime (etaf-runtime-require-mounted runtime)) - (unless (etaf-host-ref-bounds runtime host-ref) - (signal 'etaf-event-error - (list (format "Cannot focus an invisible Host reference: %S" - host-ref)))) - (etaf-runtime-set-focus-ref runtime host-ref)) + (unless host-ref + (setq host-ref (nth 3 (car (etaf--focus-candidates runtime)))) + (unless host-ref + (user-error "No focusable ETAF Host"))) + (let ((position (etaf-host-ref-position runtime host-ref))) + (unless position + (signal 'etaf-event-error + (list (format "Cannot focus an invisible Host reference: %S" + host-ref)))) + (etaf-runtime-set-focus-ref runtime host-ref) + (with-current-buffer (etaf-runtime-buffer runtime) + (goto-char position)) + host-ref)) ;;;###autoload (defun etaf-focused-host-ref (&optional runtime) "Return the currently focused Host reference in mounted RUNTIME." (etaf-runtime-focus-ref (etaf-runtime-require-mounted runtime))) +(defun etaf--focus-cycle (runtime step) + "Move focus by STEP positions through RUNTIME's ordered candidates." + (setq runtime (etaf-runtime-require-mounted runtime)) + (let* ((candidates (etaf--focus-candidates runtime)) + (ordered (mapcar (lambda (entry) (nth 3 entry)) candidates)) + (current (etaf-runtime-focus-ref runtime)) + (position (cl-position current ordered :test #'equal))) + (unless ordered + (user-error "No focusable ETAF Host")) + (etaf-focus runtime + (if position + (nth (mod (+ position step) (length ordered)) ordered) + (if (> step 0) (car ordered) (car (last ordered))))))) + ;;;###autoload (defun etaf-focus-next (&optional runtime) - "Focus the next visible Host in mounted RUNTIME. + "Focus the next visible Host in mounted RUNTIME." + (interactive) + (etaf--focus-cycle runtime 1)) -RUNTIME may be nil to use the current Runtime. Hosts need a numeric, -non-negative `:tab-index'." - (setq runtime (etaf-runtime-require-mounted runtime)) - (let (candidates) - (maphash - (lambda (host-ref props) - (let ((tab-index (plist-get props :tab-index))) - (when (and (numberp tab-index) (>= tab-index 0) - (etaf-host-ref-bounds runtime host-ref)) - (push (cons tab-index host-ref) candidates)))) - (etaf-runtime-host-props runtime)) - (setq candidates (sort candidates - (lambda (left right) - (< (car left) (car right))))) - (unless candidates - (user-error "No focusable ETAF Host")) - (let* ((current (etaf-runtime-focus-ref runtime)) - (ordered (mapcar #'cdr candidates)) - (position (cl-position current ordered :test #'equal)) - (next (if position - (or (nth (1+ position) ordered) (car ordered)) - (car ordered)))) - (etaf-focus runtime next)))) +;;;###autoload +(defun etaf-focus-previous (&optional runtime) + "Focus the previous visible Host in mounted RUNTIME." + (interactive) + (etaf--focus-cycle runtime -1)) + +(defun etaf-activate-mouse (event) + "Activate the enabled Host at the real mouse EVENT position." + (interactive "e") + (let* ((start (event-start event)) + (window (posn-window start)) + (position (etaf--position-number (posn-point start)))) + (when (and (windowp window) position) + (let ((buffer (window-buffer window))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when-let ((runtime (etaf-runtime-for-buffer buffer))) + (goto-char position) + (etaf--activation-at-position runtime position t)))))))) + +(defvar etaf-input-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "TAB") #'etaf-focus-next) + (define-key map [tab] #'etaf-focus-next) + (define-key map (kbd "") #'etaf-focus-previous) + (define-key map [backtab] #'etaf-focus-previous) + (define-key map (kbd "S-TAB") #'etaf-focus-previous) + (define-key map (kbd "RET") #'etaf-activate) + (define-key map (kbd "") #'etaf-activate) + (define-key map [mouse-1] #'etaf-activate-mouse) + map) + "Keymap for mounted ETAF Runtime input.") + +;;;###autoload +(define-minor-mode etaf-input-mode + "Enable keyboard and mouse input for a mounted ETAF Runtime." + :init-value nil + :lighter " ETAF" + :keymap etaf-input-mode-map) + +;;;###autoload +(defun etaf-events-enable-input (buffer) + "Enable `etaf-input-mode' in mounted BUFFER." + (with-current-buffer buffer + (etaf-input-mode 1))) + +;;;###autoload +(defun etaf-events-disable-input (buffer) + "Disable `etaf-input-mode' in BUFFER after Runtime unmount." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (when (bound-and-true-p etaf-input-mode) + (etaf-input-mode -1))))) (provide 'etaf-events) diff --git a/etaf-reactive.el b/etaf-reactive.el index 8779d36..1f84fec 100644 --- a/etaf-reactive.el +++ b/etaf-reactive.el @@ -25,6 +25,7 @@ test (version 0) subscribers + source-id name) (cl-defstruct (etaf-computed @@ -35,6 +36,7 @@ test (version 0) subscribers + source-id effect (dirty-p t) evaluated-p @@ -63,15 +65,31 @@ name (active-p t)) +(cl-defstruct (etaf-runtime-route + (:constructor etaf-runtime-route-create)) + "Opaque Runtime route stored by reactive sources." + runtime-id mount-epoch scheduler) + (defvar etaf--active-effect nil "The effect currently collecting dependencies.") +(defvar etaf--source-id-counter 0) + +(defun etaf-reactive-source-id (source) + "Return stable integer id of reactive SOURCE." + (cond ((etaf-ref-p source) (etaf-ref-source-id source)) + ((etaf-computed-p source) (etaf-computed-source-id source)) + (t (signal 'wrong-type-argument (list 'etaf-reactive-source-p source))))) + (defvar etaf--active-scope nil "The Scope that owns newly created effects and cleanups.") (defvar etaf--tracking-enabled-p t "Whether reactive reads may collect dependencies.") +(defvar etaf--runtime-dependency-collector nil + "Runtime-local collector called for each reactive source read.") + (defvar etaf--render-phase-p nil "Whether the current call is producing a View tree.") @@ -81,6 +99,53 @@ The function receives a zero-argument job and a phase symbol. Outside a Runtime, watchers run synchronously.") +(defvar etaf--dispatch-depth 0) +(defvar etaf--dispatch-source-queue nil) +(defvar etaf--dispatch-source-set (make-hash-table :test #'eq)) +(defvar etaf--dispatch-runtime-queue nil) +(defvar etaf--dispatch-runtime-set (make-hash-table :test #'eq)) +(defvar etaf--dispatch-effect-set (make-hash-table :test #'eq)) + +(defun etaf-reactive-enqueue-runtime-flush (runtime function) + "Queue FUNCTION once for RUNTIME after the outer reactive dispatch settles." + (unless (gethash runtime etaf--dispatch-runtime-set) + (puthash runtime function etaf--dispatch-runtime-set) + (setq etaf--dispatch-runtime-queue + (nconc etaf--dispatch-runtime-queue (list runtime))))) + +(defun etaf--dispatch-source-now (source) + "Notify SOURCE subscribers without opening another dispatch boundary." + (let ((subscribers (copy-hash-table (etaf--source-subscribers source)))) + (maphash + (lambda (subscriber _) + (cond + ((etaf-runtime-route-p subscriber) + (funcall (etaf-runtime-route-scheduler subscriber) + subscriber source)) + ((etaf-effect-active-p subscriber) + (unless (gethash subscriber etaf--dispatch-effect-set) + (puthash subscriber t etaf--dispatch-effect-set) + (if-let ((scheduler (etaf-effect-scheduler subscriber))) + (funcall scheduler subscriber) + (etaf-reactive-effect-run subscriber)))))) + subscribers))) + +(defun etaf--drain-dispatch () + "Drain reactive sources and Runtime work to a stable outer fixed point." + (while (or etaf--dispatch-source-queue etaf--dispatch-runtime-queue) + (while etaf--dispatch-source-queue + (let ((source (pop etaf--dispatch-source-queue))) + (remhash source etaf--dispatch-source-set) + (etaf--dispatch-source-now source))) + ;; Detach this turn. A lifecycle write may enqueue a source and the same + ;; Runtime again for the following turn without merging it into this one. + (let ((turn etaf--dispatch-runtime-queue)) + (setq etaf--dispatch-runtime-queue nil) + (dolist (runtime turn) + (let ((function (gethash runtime etaf--dispatch-runtime-set))) + (remhash runtime etaf--dispatch-runtime-set) + (funcall function)))))) + (defun etaf--reactive-same-p (left right) "Return whether LEFT and RIGHT are equal under ETAF's shallow rule." (if (or (consp left) (vectorp left) (hash-table-p left) @@ -104,6 +169,9 @@ Runtime, watchers run synchronously.") (defun etaf--track-source (source) "Record SOURCE as a dependency of the active effect." + (when (and etaf--tracking-enabled-p etaf--runtime-dependency-collector + (null etaf--active-effect)) + (funcall etaf--runtime-dependency-collector source)) (when (and etaf--tracking-enabled-p etaf--active-effect (etaf-effect-active-p etaf--active-effect)) (let ((subscribers (etaf--source-subscribers source))) @@ -169,6 +237,7 @@ of the run." (etaf--clear-effect-deps effect) (let ((etaf--active-effect effect) (etaf--active-scope (etaf-effect-owner-scope effect)) + (etaf--runtime-dependency-collector nil) (etaf--tracking-enabled-p t) (etaf--render-phase-p (or rendering etaf--render-phase-p))) (setf (etaf-effect-running-p effect) t) @@ -186,14 +255,18 @@ of the run." (defun etaf--dispatch-source (source) "Notify every current subscriber of SOURCE once." - (let ((subscribers (copy-hash-table (etaf--source-subscribers source)))) - (maphash - (lambda (effect _) - (when (etaf-effect-active-p effect) - (if-let ((scheduler (etaf-effect-scheduler effect))) - (funcall scheduler effect) - (etaf-reactive-effect-run effect)))) - subscribers))) + (unless (gethash source etaf--dispatch-source-set) + (puthash source t etaf--dispatch-source-set) + (setq etaf--dispatch-source-queue + (nconc etaf--dispatch-source-queue (list source)))) + (when (zerop etaf--dispatch-depth) + (let ((etaf--dispatch-depth 1)) + (unwind-protect (etaf--drain-dispatch) + (setq etaf--dispatch-source-queue nil + etaf--dispatch-runtime-queue nil) + (clrhash etaf--dispatch-source-set) + (clrhash etaf--dispatch-runtime-set) + (clrhash etaf--dispatch-effect-set))))) ;;;###autoload (cl-defun etaf-ref (initial-value &key test name) @@ -205,6 +278,7 @@ TEST optionally compares old and new values. NAME is used in diagnostics." (etaf--ref-create :value initial-value :test test :subscribers (make-hash-table :test #'eq) + :source-id (cl-incf etaf--source-id-counter) :name name)) (defun etaf--computed-value (computed) @@ -241,7 +315,8 @@ computed value." (signal 'wrong-type-argument (list 'functionp test))) (let ((computed (etaf--computed-create :getter getter :test test :name name - :subscribers (make-hash-table :test #'eq)))) + :subscribers (make-hash-table :test #'eq) + :source-id (cl-incf etaf--source-id-counter)))) (setf (etaf-computed-effect computed) (etaf-reactive-effect-create getter diff --git a/etaf-renderer.el b/etaf-renderer.el index 5018261..0045ecd 100644 --- a/etaf-renderer.el +++ b/etaf-renderer.el @@ -14,9 +14,23 @@ (require 'cl-lib) (require 'ebox) (require 'etaf-view) +(require 'etaf-component) (require 'etaf-context) (declare-function etaf--runtime-render-component "etaf-runtime" (runtime call path)) + +(defvar etaf--rendered-range-container-nodes nil + "Candidate-local Ebox nodes whose layout directly contains a Range.") +(declare-function etaf--runtime-render-child-range "etaf-runtime" (runtime expr path)) +(declare-function etaf--runtime-render-slot-range + "etaf-runtime" (runtime projection path)) +(declare-function etaf--runtime-register-semantic-host "etaf-runtime" (runtime name props backend-props path)) +(declare-function etaf--runtime-finish-semantic-host + "etaf-runtime" (runtime semantic-id &optional content content-parts)) +(declare-function etaf--runtime-render-inline-content + "etaf-runtime" (runtime host-id values path &optional surface)) +(declare-function etaf--runtime-call-with-component-env + "etaf-runtime" (runtime component-id function)) (declare-function etaf--runtime-behavior-node "etaf-runtime" (runtime node path)) (declare-function etaf--runtime-register-host "etaf-runtime" (runtime props path)) (declare-function etaf-theme-defaults "etaf-context" (&optional default)) @@ -35,6 +49,15 @@ (defvar etaf--render-style-stack nil "Component style scopes active during View lowering.") +(defvar etaf--render-parent-style-stack nil + "Style scopes belonging to the caller of the current Component.") + +(defvar etaf--current-semantic-parent-id 0 + "Semantic parent receiving Hosts during mounted lowering.") + +(defvar etaf--rendering-range-p nil + "Non-nil while eagerly lowering descendants of one Range item Host.") + (defun etaf--event-property-p (property) "Return non-nil when PROPERTY is an ETAF event callback property." (and (keywordp property) @@ -94,7 +117,9 @@ represented as ordinary static data until this final lowering step; they do not create another visual node category." (if (null styles) node - (let ((props (copy-sequence (etaf--view-node-props node)))) + (let ((props (copy-sequence + (etaf--resolve-property-plist + (etaf--view-node-props node))))) (dolist (rule (cdr styles)) (when (and (consp rule) (stringp (car rule)) (etaf--style-selector-match-p (car rule) node root-p)) @@ -109,29 +134,44 @@ not create another visual node category." (setq value (if (and (consp value) (eq (car value) 'quote)) (cadr value) value)) - (unless (plist-member props key) - (setq props (append props (list key value))))))))) + (unless (plist-get props key) + (setq props (etaf--merge-property props key value)))))))) (etaf--view-node-create :name (etaf--view-node-name node) + :token (etaf--view-node-token node) :props props :children (etaf--view-node-children node))))) (defun etaf--apply-theme-defaults (node) - "Apply inherited Theme defaults to NODE without overriding props." + "Apply known inherited Theme defaults to NODE without overriding props. +Unknown Theme keys remain readable through `etaf-theme-value' but are design +tokens, not Ebox Host properties, and therefore are not materialized here." (let ((defaults (etaf-theme-defaults))) (if (null defaults) node - (let ((props (copy-sequence (etaf--view-node-props node)))) + (let ((props (copy-sequence + (etaf--resolve-property-plist + (etaf--view-node-props node))))) (while defaults (let ((key (pop defaults)) (value (pop defaults))) - (unless (plist-member props key) - (setq props (append props (list key value)))))) + (when (and (etaf--theme-ebox-property-p key) + (not (plist-get props key))) + (setq props (etaf--merge-property props key value))))) (etaf--view-node-create :name (etaf--view-node-name node) + :token (etaf--view-node-token node) :props props :children (etaf--view-node-children node)))))) +(defun etaf--theme-ebox-property-p (key) + "Return non-nil when Theme KEY is a known Ebox property. +The public `ebox-property-rules' table is the shared property vocabulary; +custom Theme tokens remain Context data and are never copied onto Hosts." + (and (keywordp key) + (boundp 'ebox-property-rules) + (assq key ebox-property-rules))) + (defun etaf--inline-text-surface-properties (props) "Return text properties represented by inline text PROPS." (let ((surface (copy-sequence (or (plist-get props :surface-properties) nil)))) @@ -145,6 +185,13 @@ not create another visual node category." (list 'background (plist-get props :bgcolor))))) surface)) +(defun etaf--apply-inline-surface-properties (content surface) + "Return CONTENT with resolved inline SURFACE properties applied." + (let ((result (copy-sequence content))) + (when (and surface (not (zerop (length result)))) + (add-text-properties 0 (length result) surface result)) + result)) + (defun etaf--inline-text-content (value) "Return `(SUCCESS . STRING)' for inline-compatible text VALUE. @@ -186,6 +233,18 @@ the ordinary layout lowering path instead." (cons valid-p (and valid-p result)))) (t (cons nil nil)))) +(defun etaf--inline-text-structural-p (value) + "Return non-nil when VALUE can be owned by mounted inline effects." + (cond + ((or (null value) (stringp value) (etaf--expr-p value)) t) + ((etaf--view-node-p value) + (and (eq (etaf--view-node-name value) 'text) + (cl-every #'etaf--inline-text-structural-p + (etaf--view-node-children value)))) + ((proper-list-p value) + (cl-every #'etaf--inline-text-structural-p value)) + (t nil))) + (defun etaf--ebox-properties (props path) "Translate ETAF PROPS at PATH into Ebox's public property list." (let* ((source-props (etaf--resolve-property-plist props)) @@ -237,13 +296,50 @@ the ordinary layout lowering path instead." (defun etaf--render-slot-projection (projection path) "Render PROJECTION at PATH using the active Component slot collection." + (setq etaf--raw-slot-read-p t) (let* ((name (etaf--slot-projection-name projection)) (slots etaf--current-component-slots) (entry (assq name slots)) + (content (and entry (cdr entry))) + (children (if (etaf--slot-content-p content) + (etaf--slot-content-children content) + content)) + (owner-id (and (etaf--slot-content-p content) + (etaf--slot-content-owner-component-id content))) (fallback (etaf--slot-projection-fallback projection))) - (etaf--render-value-list - (if entry (cdr entry) fallback) - (append path (list :slot name))))) + (let ((etaf--render-style-stack + (if entry + etaf--render-parent-style-stack + etaf--render-style-stack))) + (let ((render (lambda () + (etaf--render-value-list + (if entry children fallback) + (append path (list :slot name)))))) + (if (and entry etaf--render-runtime) + (etaf--runtime-call-with-component-env + etaf--render-runtime owner-id render) + (funcall render)))))) + +(defun etaf--slot-projection-range-compatible-p (projection) + "Return whether mounted PROJECTION can use the current slot Range slice." + (let* ((entry (assq (etaf--slot-projection-name projection) + etaf--current-component-slots)) + (content (and entry (cdr entry))) + (values (if entry + (if (etaf--slot-content-p content) + (etaf--slot-content-children content) + content) + (etaf--slot-projection-fallback projection)))) + (cl-labels + ((valid + (value) + (cond ((or (null value) (stringp value) (etaf--expr-p value)) t) + ((etaf--view-node-p value) + (and (not (eq (etaf--view-node-name value) 'fragment)) + (cl-every #'valid (etaf--view-node-children value)))) + ((proper-list-p value) (cl-every #'valid value)) + (t nil)))) + (valid values)))) (defun etaf--render-component-call-pure (call path) "Render stateless CALL at PATH without a retained Runtime." @@ -256,11 +352,11 @@ the ordinary layout lowering path instead." (etaf--component-call-props call)) (etaf--current-component-slots (etaf--component-call-slots call))) - (let ((etaf--render-style-stack - (cons (cons (etaf--component-spec-styles spec) + (let ((etaf--render-parent-style-stack etaf--render-style-stack) + (etaf--render-style-stack + (list (cons (etaf--component-spec-styles spec) (append path (list :component - (etaf--component-spec-name spec)))) - etaf--render-style-stack))) + (etaf--component-spec-name spec))))))) (etaf--render-value-list (funcall render (etaf--component-call-props call) @@ -278,13 +374,24 @@ the ordinary layout lowering path instead." path) append (cond - ((stringp item) (list (ebox-create :content item))) + ((stringp item) + (when etaf--render-runtime + (let ((semantic-id + (etaf--runtime-register-semantic-host + etaf--render-runtime 'text nil nil item-path))) + (etaf--runtime-finish-semantic-host + etaf--render-runtime semantic-id item))) + (list (ebox-create :content item))) ((etaf--view-node-p item) (etaf--render-node item item-path)) ((etaf--component-call-p item) (if etaf--render-runtime - (list (etaf--runtime-render-component - etaf--render-runtime item item-path)) + (let ((result (etaf--runtime-render-component + etaf--render-runtime item item-path))) + (if (and (consp result) + (eq (car result) 'component-output-range)) + (cdr result) + (list result))) (etaf--render-component-call-pure item item-path))) ((etaf--slot-projection-p item) (etaf--render-slot-projection item item-path)) @@ -328,41 +435,115 @@ the ordinary layout lowering path instead." (etaf--runtime-register-host etaf--render-runtime raw-props path)) (pcase name ('text - (let* ((flat (cl-mapcan #'etaf--flatten-view-value children)) + (let* ((semantic-id + (and etaf--render-runtime + (etaf--runtime-register-semantic-host + etaf--render-runtime name raw-props props path))) (child-path (append path (list :text))) - (inline (etaf--inline-text-content flat)) + (runtime-inline + (and semantic-id + (etaf--inline-text-structural-p children) + (etaf--runtime-render-inline-content + etaf--render-runtime semantic-id children child-path))) + (flat (unless runtime-inline + (cl-mapcan #'etaf--flatten-view-value children))) + (inline (if runtime-inline + (cons t (car runtime-inline)) + (etaf--inline-text-content flat))) (rendered (unless (car inline) - (etaf--render-value-list flat child-path)))) + (let ((etaf--current-semantic-parent-id + (or semantic-id + etaf--current-semantic-parent-id))) + (etaf--render-value-list flat child-path))))) + (when semantic-id + (etaf--runtime-finish-semantic-host + etaf--render-runtime semantic-id + (and (car inline) (cdr inline)) + (and runtime-inline (cadr runtime-inline)))) (if (car inline) - (list (apply #'ebox-create - :content (cdr inline) - props)) - (list (ebox-build - (append (list 'row) props rendered)))))) + (list (apply #'ebox-create :content (cdr inline) props)) + (list (ebox-build (append (list 'row) props rendered)))))) ('spacer (when children (signal 'etaf-renderer-error (list "spacer cannot have children"))) + (when etaf--render-runtime + (let ((semantic-id (etaf--runtime-register-semantic-host + etaf--render-runtime name raw-props props path))) + (etaf--runtime-finish-semantic-host + etaf--render-runtime semantic-id))) (list (apply #'ebox-spacer props))) ('fragment (etaf--render-value-list children (append path (list :fragment)))) ((or 'row 'column 'container 'stack 'flex 'grid) (let ((nodes nil) - (index 0)) + (index 0) + (range-child-p nil) + (semantic-id + (and etaf--render-runtime + (etaf--runtime-register-semantic-host + etaf--render-runtime name raw-props props path)))) (dolist (child children) (setq nodes (nconc nodes - (etaf--render-value-list - child (append path (list index))))) + (let ((etaf--current-semantic-parent-id + (or semantic-id + etaf--current-semantic-parent-id))) + (if (and semantic-id (etaf--expr-p child) + (not etaf--rendering-range-p)) + (let ((result + (etaf--runtime-render-child-range + etaf--render-runtime child + (append path (list index))))) + (when (eq (car result) 'range) + (setq range-child-p t)) + (cdr result)) + (if (and semantic-id + (etaf--view-node-p child) + (eq (etaf--view-node-name child) 'fragment) + (not etaf--rendering-range-p)) + (let ((result + (etaf--runtime-render-fragment-range + etaf--render-runtime child + (append path (list index))))) + (setq range-child-p t) + (cdr result)) + (if (and semantic-id + (etaf--raw-ebox-p child) + (not etaf--rendering-range-p)) + (let ((result + (etaf--runtime-render-raw-range + etaf--render-runtime child + (append path (list index))))) + (setq range-child-p t) + (cdr result)) + (if (and semantic-id + (etaf--slot-projection-p child) + (etaf--slot-projection-range-compatible-p + child) + (not etaf--rendering-range-p)) + (let ((result + (etaf--runtime-render-slot-range + etaf--render-runtime child + (append path (list index))))) + (setq range-child-p t) + (cdr result)) + (etaf--render-value-list + child (append path (list index)))))))))) (cl-incf index)) - (list (etaf--layout-node name props nodes)))) + (when semantic-id + (etaf--runtime-finish-semantic-host + etaf--render-runtime semantic-id)) + (list (etaf--layout-node name props nodes range-child-p)))) (_ (signal 'etaf-renderer-error (list (format "Unknown Host reached renderer: %S" name))))))) -(defun etaf--layout-node (name props nodes) - "Build layout NAME with Ebox PROPS around child NODES." - (cond +(defun etaf--layout-node (name props nodes &optional range-child-p) + "Build layout NAME with Ebox PROPS around child NODES. +RANGE-CHILD-P records that NODES include nonvisual Range segments." + (let ((node + (cond ((eq name 'row) (if (null props) (apply #'ebox-row nodes) @@ -376,8 +557,27 @@ the ordinary layout lowering path instead." ((eq name 'grid) (apply #'ebox-grid (append props nodes))) (t - (signal 'etaf-renderer-error - (list (format "Not a layout Host: %S" name)))))) + (signal 'etaf-renderer-error + (list (format "Not a layout Host: %S" name))))))) + (when range-child-p + (push node etaf--rendered-range-container-nodes)) + node)) + +(defun etaf--lower-resolved-semantic-host + (name props content children range-child-p) + "Lower resolved NAME, PROPS, CONTENT, and CHILDREN through Renderer. +RANGE-CHILD-P preserves the direct material Range parent." + (pcase name + ('text + (if children + (etaf--layout-node 'row props children range-child-p) + (apply #'ebox-create :content content props))) + ('spacer (apply #'ebox-spacer props)) + ((or 'row 'column 'container 'stack 'flex 'grid) + (etaf--layout-node name props children range-child-p)) + (_ (signal 'etaf-renderer-error + (list (format "Semantic Host requires Step4b lowering: %S" + name)))))) ;;;###autoload (defun etaf-render (view) diff --git a/etaf-runtime.el b/etaf-runtime.el index 9ae444f..c83b6f2 100644 --- a/etaf-runtime.el +++ b/etaf-runtime.el @@ -22,8 +22,18 @@ (declare-function etaf--render-value-list "etaf-renderer" (value path)) (declare-function etaf--apply-inline-style-rules "etaf-renderer" (node styles &optional root-p)) (declare-function etaf--generated-host-ref "etaf-renderer" (props path)) +(declare-function etaf--lower-resolved-semantic-host + "etaf-renderer" (name props content children range-child-p)) +(declare-function etaf--inline-text-surface-properties + "etaf-renderer" (props)) +(declare-function etaf--apply-inline-surface-properties + "etaf-renderer" (content surface)) +(declare-function etaf-events-enable-input "etaf-events" (buffer)) +(declare-function etaf-events-disable-input "etaf-events" (buffer)) +(declare-function ebox-range-ref-present-p "ebox" (buffer-or-name range-ref)) (defvar etaf--render-runtime) (defvar etaf--render-style-stack) +(defvar etaf--render-parent-style-stack) (defvar etaf--current-context) (define-error 'etaf-runtime-error "ETAF runtime error") @@ -35,14 +45,155 @@ identity scope render-function - props - slots context mounted-hooks updated-hooks unmounted-hooks + resource-key (mounted-p nil)) +(cl-defstruct (etaf--semantic-component + (:constructor etaf--semantic-component-create)) + semantic-id identity input-effect-id effect-id resource-key props slots + input-props input-slots output-signature artifact-key + path caller-style-stack input-deps deps + parent-id caller-component-id child-ids raw-slot-reader-p + publication-kind output-range-id output-range-ref + context-frame context-deps + (composition-version 0)) + +(cl-defstruct (etaf--semantic-host (:constructor etaf--semantic-host-create)) + semantic-id identity parent-id child-ids host-ref key name props-signature + content content-parts path style-identity (composition-version 0)) + +(cl-defstruct (etaf--semantic-range (:constructor etaf--semantic-range-create)) + semantic-id identity effect-id kind parent-id component-id token range-ref + path caller-style-stack output-signature deps artifact-key item-host-ids + item-identity-index context-deps (composition-version 0)) + +(cl-defstruct (etaf--semantic-inline-range + (:constructor etaf--semantic-inline-range-create)) + semantic-id identity effect-id parent-id component-id token path + surface-properties output deps context-deps (composition-version 0)) + +(cl-defstruct (etaf--semantic-slot-range + (:constructor etaf--semantic-slot-range-create)) + semantic-id identity effect-id parent-id owner-component-id + consumer-component-id token name range-ref path style-stack + output-signature deps artifact-key item-host-ids item-identity-index + context-deps + (composition-version 0)) + +(cl-defstruct (etaf--semantic-root (:constructor etaf--semantic-root-create)) + "Immutable semantic Root owner stored at generation node zero." + semantic-id effect-id input-signature deps) + +(cl-defstruct (etaf--generation-effect + (:constructor etaf--generation-effect-create)) + "Immutable generation scheduling target." + effect-id kind semantic-id deps target) + +(cl-defstruct (etaf--contribution-index + (:constructor etaf--contribution-index-create)) + "Persistent generation contribution delta rooted at BASE." + base handlers host-props contexts themes behaviors context-consumers lifecycle + host-removals semantic-removals) + +(cl-defstruct (etaf--generation-participant + (:constructor etaf--generation-participant-create)) + runtime old candidate (state 'unpublished)) + +(cl-defstruct (etaf-generation + (:constructor etaf--generation-create)) + generation-id root-semantic-id semantic-nodes effect-map + source-effects effect-sources parent-table children-table + resource-membership identity-index indexes) + +(cl-defstruct (etaf--pvec-node (:constructor etaf--pvec-node-create)) + "One sparse immutable 32-way generation index node." + children value) + +(cl-defstruct (etaf--generation-metrics + (:constructor etaf--generation-metrics-create)) + (node-visits 0) (node-copies 0) (effect-visits 0) (source-visits 0)) + +(defun etaf--pvec-get (root id &optional metrics kind) + "Return integer ID value from sparse ROOT, recording METRICS KIND visits." + (let ((node root) (level 6)) + (while (and node (>= level 0)) + (when metrics + (cl-incf (etaf--generation-metrics-node-visits metrics)) + (pcase kind + ('effect (cl-incf (etaf--generation-metrics-effect-visits metrics))) + ('source (cl-incf (etaf--generation-metrics-source-visits metrics))))) + (setq node (and (etaf--pvec-node-children node) + (aref (etaf--pvec-node-children node) + (logand 31 (ash id (* -5 level))))) + level (1- level))) + (and node (etaf--pvec-node-value node)))) + +(defun etaf--pvec-put (root id value &optional metrics) + "Return sparse ROOT with ID set to VALUE, recording copies in METRICS." + (cl-labels + ((put (node level) + (when metrics + (cl-incf (etaf--generation-metrics-node-visits metrics)) + (cl-incf (etaf--generation-metrics-node-copies metrics))) + (if (< level 0) + (etaf--pvec-node-create :value value) + (let* ((children (copy-sequence + (or (and node (etaf--pvec-node-children node)) + (make-vector 32 nil)))) + (slot (logand 31 (ash id (* -5 level))))) + (aset children slot (put (aref children slot) (1- level))) + (etaf--pvec-node-create :children children))))) + (put root 6))) + +(defun etaf--pvec-put-many (root entries &optional metrics) + "Return sparse ROOT after applying ENTRIES in one persistent batch. +ENTRIES is a list of cons cells `(ID . VALUE)'. METRICS, when non-nil, records +physical trie node visits/copies. Updates sharing a trie path +are grouped before copying, so each touched vector node is copied once per +batch rather than once per entry. Later entries for the same ID win, matching +the sequential `etaf--pvec-put' contract." + (if (null entries) + root + (let ((values (make-hash-table :test #'eql)) + (ids nil) + (missing (make-symbol "etaf-pvec-missing"))) + (dolist (entry entries) + (let ((id (car entry))) + (when (eq (gethash id values missing) missing) + (push id ids)) + (puthash id (cdr entry) values))) + (setq ids (nreverse ids)) + (cl-labels + ((put-batch (node level batch) + (when metrics + (cl-incf (etaf--generation-metrics-node-visits metrics)) + (cl-incf (etaf--generation-metrics-node-copies metrics))) + (if (< level 0) + (etaf--pvec-node-create + :value (gethash (car batch) values)) + (let ((children + (copy-sequence + (or (and node (etaf--pvec-node-children node)) + (make-vector 32 nil)))) + (groups (make-hash-table :test #'eql))) + (dolist (id batch) + (let ((slot (logand 31 (ash id (* -5 level))))) + (puthash slot (cons id (gethash slot groups)) groups))) + (maphash + (lambda (slot group) + (aset children slot + (put-batch + (aref children slot) + (1- level) + group))) + groups) + (etaf--pvec-node-create :children children))))) + (put-batch root 6 ids))))) + (cl-defstruct (etaf-runtime (:constructor etaf--runtime-create)) "Mounted ETAF application runtime." @@ -50,27 +201,568 @@ root-view root-node scope - render-effect + root-effect-id + root-range-id + candidate-root-deps + root-view-cache + root-dirty-p instances + resource-registry + mount-epoch + next-resource-id + next-effect-id + next-semantic-id + current-generation + artifact-registry + candidate-artifacts + candidate-effects + candidate-source-deltas + route-token + route-sources + dirty-effect-ids + dirty-effect-queue handlers host-props focus-ref behaviors - seen + candidate-live + candidate-semantic-nodes + candidate-component-envs + candidate-graph-nodes + candidate-identity-entries + candidate-graph-children + candidate-removed-semantic-ids + candidate-removed-effect-ids + candidate-removed-host-refs + candidate-rendered-identities + candidate-updated-component-identities + candidate-generation-metrics + candidate-full-rebuild-p + range-artifact-registry + candidate-range-artifacts + candidate-invalidated-artifact-keys + candidate-inline-host-ids + candidate-eager-range-changes candidate-handlers candidate-host-props candidate-behaviors + behavior-resource-keys + candidate-behavior-resource-keys candidate-created - candidate-snapshots candidate-old-instances - generation (mounted-p t) flushing-p - pending-p) + pending-p + diagnostics + (event-depth 0)) + +(defvar etaf--mount-epoch-counter 0) + +(defvar etaf--current-component-identity nil) +(defvar etaf--current-component-semantic-id nil) +(defvar etaf--current-semantic-parent-id 0) +(defvar etaf--current-range-item-index nil) +(defvar etaf--rendering-range-p nil) +(defvar etaf--rendering-component-effect-p nil) +(defvar etaf--rendered-range-container-nodes nil) +(defvar etaf--runtime-force-full-component-render-p nil + "Non-nil only while a failed local anchor proof rebuilds all Components.") +(defvar etaf--runtime-fixed-point-stamps nil + "Dynamic Runtime flush table of evaluated effect input/version tuples.") +(defvar etaf--runtime-fixed-point-steps 0 + "Number of effect evaluations recorded in the current Runtime flush.") +(defvar etaf--runtime-fixed-point-step-bound nil + "Graph-derived safety bound for one Runtime fixed-point flush.") +(defvar etaf--runtime-fixed-point-history nil + "Ordered fixed-point effect/edge trace for the current Runtime flush.") + +(defun etaf--contribution-index-values (index slot) + "Return INDEX delta values for SLOT." + (pcase slot + ('handlers (etaf--contribution-index-handlers index)) + ('host-props (etaf--contribution-index-host-props index)) + ('contexts (etaf--contribution-index-contexts index)) + ('themes (etaf--contribution-index-themes index)) + ('behaviors (etaf--contribution-index-behaviors index)) + ('context-consumers (etaf--contribution-index-context-consumers index)) + ('lifecycle (etaf--contribution-index-lifecycle index)))) + +(defun etaf--generation-index-lookup (generation slot key) + "Return committed KEY contribution in GENERATION SLOT." + (let ((index (and generation (etaf-generation-indexes generation))) found) + (while (and index (not found)) + (if (member key (if (memq slot '(handlers host-props)) + (etaf--contribution-index-host-removals index) + (etaf--contribution-index-semantic-removals index))) + (setq index nil) + (if-let ((entry (assoc key + (etaf--contribution-index-values index slot)))) + (setq found entry) + (setq index (etaf--contribution-index-base index))))) + (cdr found))) + +(defun etaf--generation-index-entries (generation slot) + "Return effective committed entries for GENERATION SLOT." + (let ((index (and generation (etaf-generation-indexes generation))) + (seen (make-hash-table :test #'equal)) result) + (while index + (dolist (key (if (memq slot '(handlers host-props)) + (etaf--contribution-index-host-removals index) + (etaf--contribution-index-semantic-removals index))) + (puthash key t seen)) + (dolist (entry (etaf--contribution-index-values index slot)) + (unless (gethash (car entry) seen) + (puthash (car entry) t seen) + (push entry result))) + (setq index (unless (eq slot 'lifecycle) + (etaf--contribution-index-base index)))) + (nreverse result))) + +(defun etaf--generation-validate-context-acyclic (generation) + "Reject Context provider/consumer cycles in GENERATION." + (let ((edges (make-hash-table :test #'eql)) + (visiting (make-hash-table :test #'eql)) + (visited (make-hash-table :test #'eql))) + (dolist (entry (etaf--generation-index-entries + generation 'context-consumers)) + (let ((provider-id (caar entry))) + (dolist (effect-id (cdr entry)) + (when-let ((effect (etaf--generation-effect generation effect-id))) + (let ((consumer-id (etaf--generation-effect-semantic-id effect))) + (unless (= provider-id consumer-id) + (cl-pushnew consumer-id + (gethash provider-id edges) :test #'eql))))))) + (cl-labels + ((visit + (node path) + (when (gethash node visiting) + (signal 'etaf-context-error + (list "Context provider/consumer cycle" + (nreverse (cons node path))))) + (unless (gethash node visited) + (puthash node t visiting) + (dolist (next (gethash node edges)) + (visit next (cons node path))) + (remhash node visiting) + (puthash node t visited)))) + (maphash (lambda (node _) (visit node nil)) edges))) + generation) + +(defun etaf-runtime-handler-for (runtime host-ref) + "Return committed handler entries for HOST-REF in RUNTIME." + (etaf--generation-index-lookup + (etaf-runtime-current-generation runtime) 'handlers host-ref)) + +(defun etaf-runtime-handler-entries (runtime) + "Return committed handler contribution entries for RUNTIME." + (copy-tree (etaf--generation-index-entries + (etaf-runtime-current-generation runtime) 'handlers))) + +(defun etaf-runtime-host-props-for (runtime host-ref) + "Return committed semantic Host props for HOST-REF in RUNTIME." + (etaf--generation-index-lookup + (etaf-runtime-current-generation runtime) 'host-props host-ref)) + +(defun etaf-runtime-host-props-entries (runtime) + "Return committed Host contribution entries for RUNTIME." + (copy-tree (etaf--generation-index-entries + (etaf-runtime-current-generation runtime) 'host-props))) + +(defun etaf--runtime-build-contribution-indexes (runtime base full-p) + "Build RUNTIME immutable generation contributions over BASE. +FULL-P means candidate tables describe the complete mounted tree." + (let (handler-additions prop-additions context-additions theme-additions + behavior-membership context-consumer-additions lifecycle-membership + changed-component-ids) + (maphash (lambda (key value) + (push (cons (copy-tree key) (copy-tree value)) + handler-additions)) + (etaf-runtime-candidate-handlers runtime)) + (maphash (lambda (key value) + (push (cons (copy-tree key) (copy-tree value)) prop-additions)) + (etaf-runtime-candidate-host-props runtime)) + (maphash + (lambda (_identity semantic) + (let* ((semantic-id (etaf--semantic-component-semantic-id semantic)) + (effect-id (etaf--semantic-component-effect-id semantic)) + (old-semantic + (and base + (etaf--pvec-get (etaf-generation-semantic-nodes base) + semantic-id))) + (frame (etaf--semantic-component-context-frame semantic)) + (theme (and frame + (gethash 'theme (etaf-context-values frame) + etaf--context-missing)))) + (push semantic-id changed-component-ids) + (push (cons semantic-id frame) context-additions) + (dolist (dependency + (cl-delete-duplicates + (append (copy-sequence + (and old-semantic + (etaf--semantic-component-context-deps + old-semantic))) + (copy-sequence + (etaf--semantic-component-context-deps semantic))) + :test #'equal)) + (let ((consumers + (delq effect-id + (copy-sequence + (etaf--generation-index-lookup + base 'context-consumers dependency))))) + (when (member dependency + (etaf--semantic-component-context-deps semantic)) + (push effect-id consumers)) + (push (cons (copy-tree dependency) + (sort consumers #'<)) + context-consumer-additions))) + (unless (eq theme etaf--context-missing) + (push (cons semantic-id theme) theme-additions)))) + (etaf-runtime-candidate-semantic-nodes runtime)) + (maphash + (lambda (semantic-id semantic) + (let* ((effect-id + (cond ((etaf--semantic-range-p semantic) + (etaf--semantic-range-effect-id semantic)) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-effect-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-effect-id semantic)))) + (new-deps + (cond ((etaf--semantic-range-p semantic) + (etaf--semantic-range-context-deps semantic)) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-context-deps semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-context-deps semantic)))) + (old (and base effect-id + (etaf--pvec-get (etaf-generation-semantic-nodes base) + semantic-id))) + (old-deps + (cond ((etaf--semantic-range-p old) + (etaf--semantic-range-context-deps old)) + ((etaf--semantic-inline-range-p old) + (etaf--semantic-inline-range-context-deps old)) + ((etaf--semantic-slot-range-p old) + (etaf--semantic-slot-range-context-deps old))))) + (when effect-id + (dolist (dependency + (cl-delete-duplicates + (append (copy-sequence old-deps) + (copy-sequence new-deps)) + :test #'equal)) + (let ((consumers + (delq effect-id + (copy-sequence + (etaf--generation-index-lookup + base 'context-consumers dependency))))) + (when (member dependency new-deps) + (push effect-id consumers)) + (push (cons (copy-tree dependency) (sort consumers #'<)) + context-consumer-additions)))))) + (etaf-runtime-candidate-graph-nodes runtime)) + (maphash + (lambda (identity state) + (push + (cons (copy-tree identity) + (copy-tree + (or (gethash identity + (etaf-runtime-candidate-behavior-resource-keys + runtime)) + (etaf-behavior-spec-name (car state))))) + behavior-membership)) + (etaf-runtime-candidate-behaviors runtime)) + (dolist (identity + (cl-delete-duplicates + (append (copy-sequence + (etaf-runtime-candidate-rendered-identities runtime)) + (copy-sequence + (etaf-runtime-candidate-updated-component-identities + runtime))) + :test #'equal)) + (push (cons (copy-tree identity) 'updated) lifecycle-membership)) + (etaf--contribution-index-create + :base (and (not full-p) base (etaf-generation-indexes base)) + :handlers (nreverse handler-additions) + :host-props (nreverse prop-additions) + :contexts (nreverse context-additions) + :themes (nreverse theme-additions) + :behaviors (nreverse behavior-membership) + :context-consumers (nreverse context-consumer-additions) + :lifecycle (nreverse lifecycle-membership) + :host-removals + (cl-remove-if + (lambda (host-ref) + (gethash host-ref (etaf-runtime-candidate-host-props runtime))) + (copy-sequence (etaf-runtime-candidate-removed-host-refs runtime))) + :semantic-removals + (append changed-component-ids + (copy-sequence + (etaf-runtime-candidate-removed-semantic-ids runtime)))))) + +(defun etaf-runtime-generation (runtime) + "Return RUNTIME's committed generation id." + (if-let ((generation (etaf-runtime-current-generation runtime))) + (etaf-generation-generation-id generation) + 0)) + +(defun etaf--semantic-backend-range-artifact-key (semantic) + "Return external artifact key for direct or slot Range SEMANTIC." + (if (etaf--semantic-range-p semantic) + (etaf--semantic-range-artifact-key semantic) + (etaf--semantic-slot-range-artifact-key semantic))) + +(defun etaf--semantic-backend-range-ref (semantic) + "Return Ebox range ref for direct or slot Range SEMANTIC." + (if (etaf--semantic-range-p semantic) + (etaf--semantic-range-range-ref semantic) + (etaf--semantic-slot-range-range-ref semantic))) + +(defun etaf--semantic-backend-range-container-component-id (semantic) + "Return the Component containing backend Range SEMANTIC's artifact." + (if (etaf--semantic-range-p semantic) + (etaf--semantic-range-component-id semantic) + (etaf--semantic-slot-range-consumer-component-id semantic))) + +(defun etaf--generation-semantic (generation identity) + "Return IDENTITY semantic node from GENERATION." + (when-let ((id (gethash identity (etaf-generation-identity-index generation)))) + (etaf--pvec-get (etaf-generation-semantic-nodes generation) id))) + +(defun etaf--generation-effect-semantic (generation effect-id) + "Return EFFECT-ID semantic node from GENERATION." + (when-let ((effect (etaf--pvec-get + (etaf-generation-effect-map generation) effect-id))) + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + (etaf--generation-effect-semantic-id effect)))) + +(defun etaf--generation-effect (generation effect-id) + "Return immutable EFFECT-ID scheduling record from GENERATION." + (etaf--pvec-get (etaf-generation-effect-map generation) effect-id)) + +(defun etaf--runtime-scheduled-semantic-live-p (generation effect semantic) + "Return whether scheduled EFFECT still has a live owner in GENERATION. + +The source index is persistent across local generations, so a removed +semantic node must not be allowed to run merely because an old effect record +is still present during the current overlay. Root-level ranges/inline ranges +may legitimately have no Component owner; non-root ranges must retain their +owning Component node." + (and effect semantic + (let ((nodes (etaf-generation-semantic-nodes generation))) + (cond + ((etaf--semantic-component-p semantic) + (etaf--pvec-get nodes + (etaf--semantic-component-semantic-id semantic))) + ((etaf--semantic-range-p semantic) + (or (null (etaf--semantic-range-component-id semantic)) + (etaf--pvec-get nodes + (etaf--semantic-range-component-id semantic)))) + ((etaf--semantic-slot-range-p semantic) + (or (null (etaf--semantic-slot-range-consumer-component-id semantic)) + (etaf--pvec-get + nodes + (etaf--semantic-slot-range-consumer-component-id semantic)))) + ((etaf--semantic-inline-range-p semantic) + (or (null (etaf--semantic-inline-range-component-id semantic)) + (etaf--pvec-get + nodes + (etaf--semantic-inline-range-component-id semantic)))) + (t nil))))) + +(defun etaf--generation-source-effects (generation source) + "Return current effect ids for SOURCE in GENERATION." + (etaf--pvec-get (etaf-generation-source-effects generation) + (etaf-reactive-source-id source))) (defvar etaf--runtime-table (make-hash-table :test #'eq) "Buffer -> mounted ETAF Runtime table.") +(defvar etaf--runtime-route-registry + (make-hash-table :test #'eql :weakness 'value) + "Mount epoch -> live Runtime weak-value registry.") + +(defun etaf--runtime-enqueue-effect (runtime effect-id) + "Append EFFECT-ID once to RUNTIME's stable FIFO work queue." + (unless (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)) + (puthash effect-id t (etaf-runtime-dirty-effect-ids runtime)) + (setf (etaf-runtime-dirty-effect-queue runtime) + (nconc (etaf-runtime-dirty-effect-queue runtime) + (list effect-id))))) + +(defun etaf--runtime-fixed-point-safe-hash (value) + "Return a stable hash for immutable fixed-point VALUE, or nil. +Candidate semantic output is diagnostic evidence, not authority; malformed or +cyclic diagnostic payloads therefore fail closed without preventing the normal +transaction from deciding whether the value changed." + (condition-case _err + (sxhash-equal value) + (error nil))) + +(defun etaf--runtime-candidate-effect (runtime effect-id) + "Return candidate EFFECT-ID staged in RUNTIME's overlay." + (let ((table (etaf-runtime-candidate-effects runtime))) + (and (hash-table-p table) (gethash effect-id table)))) + +(defun etaf--runtime-effect-semantic-stamp (runtime generation effect) + "Return candidate-aware semantic facts for EFFECT in GENERATION/RUNTIME." + (let* ((effect-id (and effect (etaf--generation-effect-effect-id effect))) + (semantic-id (and effect + (etaf--generation-effect-semantic-id effect))) + (candidate (and semantic-id + (hash-table-p + (etaf-runtime-candidate-graph-nodes runtime)) + (gethash semantic-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (semantic (or candidate + (and generation semantic-id + (etaf--generation-effect-semantic + generation effect-id)))) + (facts + (cond + ((etaf--semantic-component-p semantic) + (list (etaf--semantic-component-composition-version semantic) + (etaf--semantic-component-input-props semantic) + (etaf--semantic-component-input-slots semantic) + (etaf--semantic-component-context-deps semantic) + (etaf--semantic-component-output-signature semantic))) + ((etaf--semantic-range-p semantic) + (list (etaf--semantic-range-composition-version semantic) + (etaf--semantic-range-output-signature semantic) + (etaf--semantic-range-context-deps semantic))) + ((etaf--semantic-slot-range-p semantic) + (list (etaf--semantic-slot-range-composition-version semantic) + (etaf--semantic-slot-range-output-signature semantic) + (etaf--semantic-slot-range-context-deps semantic))) + ((etaf--semantic-inline-range-p semantic) + (list (etaf--semantic-inline-range-composition-version semantic) + (etaf--semantic-inline-range-output semantic) + (etaf--semantic-inline-range-context-deps semantic))) + (t nil)))) + (list :effect-id effect-id + :kind (and effect (etaf--generation-effect-kind effect)) + :semantic-id semantic-id + :candidate-p (and candidate t) + :facts-hash (etaf--runtime-fixed-point-safe-hash facts)))) + +(defun etaf--runtime-effect-input-version-tuple (runtime generation effect-id) + "Return candidate-aware tuple for EFFECT-ID in RUNTIME GENERATION. +The tuple includes source versions, candidate semantic facts, and the exact +effect-to-source edges. It is intentionally immutable and suitable as an +`equal' hash key for one flush." + (let* ((effect (or (etaf--runtime-candidate-effect runtime effect-id) + (and generation + (etaf--generation-effect generation effect-id)))) + (deps (and effect (etaf--generation-effect-deps effect))) + (edges + (sort + (mapcar (lambda (source) + (list (etaf-reactive-source-id source) + (cond ((etaf-ref-p source) + (etaf-ref-version source)) + ((etaf-computed-p source) + (etaf-computed-version source)) + (t 0)))) + deps) + (lambda (left right) (< (car left) (car right)))))) + (list :mount-epoch (etaf-runtime-mount-epoch runtime) + :generation-id (and generation + (etaf-generation-generation-id generation)) + :effect (etaf--runtime-effect-semantic-stamp + runtime generation effect) + :edges edges))) + +(defun etaf--runtime-fixed-point-graph-size (runtime generation) + "Return graph-derived counts and a finite flush bound for RUNTIME GENERATION." + (let ((nodes (or (and (hash-table-p + (etaf-runtime-candidate-graph-nodes runtime)) + (hash-table-count + (etaf-runtime-candidate-graph-nodes runtime))) + 0)) + (edges 0) + (sources 0) + (effect-count (max 1 (etaf-runtime-next-effect-id runtime)))) + (when (hash-table-p (etaf-runtime-candidate-effects runtime)) + (maphash + (lambda (_id effect) + (cl-incf edges (length (etaf--generation-effect-deps effect)))) + (etaf-runtime-candidate-effects runtime))) + (when generation + (let ((root (etaf-generation-effect-sources generation))) + (cl-labels + ((walk (node) + (when node + (when (etaf--pvec-node-value node) + (cl-incf sources)) + (let ((children (etaf--pvec-node-children node))) + (when children + (dotimes (index (length children)) + (walk (aref children index)))))))) + (walk root)))) + (setq nodes (max nodes effect-count) + ;; The committed source index may contain effects not staged in the + ;; candidate. Count their source edges conservatively from the + ;; monotonic effect allocator, while retaining the explicit edge + ;; count for diagnostics and the bound itself. + edges (max edges effect-count) + sources (max sources (hash-table-count + (etaf-runtime-route-sources runtime)))) + (list :nodes nodes :edges edges :sources sources + :bound (max 16 (* 2 (+ 1 nodes edges sources)))))) + +(defun etaf--runtime-record-effect-input-version (runtime generation effect-id) + "Record one EFFECT-ID tuple for RUNTIME GENERATION, or signal non-convergence." + (when etaf--runtime-fixed-point-stamps + (cl-incf etaf--runtime-fixed-point-steps) + (when (and etaf--runtime-fixed-point-step-bound + (> etaf--runtime-fixed-point-steps + etaf--runtime-fixed-point-step-bound)) + (signal 'etaf-runtime-error + (list :non-converging-effect-steps + :bound etaf--runtime-fixed-point-step-bound + :steps etaf--runtime-fixed-point-steps + :effect-id effect-id))) + (let* ((tuple (etaf--runtime-effect-input-version-tuple + runtime generation effect-id)) + (entry (list :effect-id effect-id + :tuple tuple + :edges (plist-get tuple :edges)))) + (when (gethash tuple etaf--runtime-fixed-point-stamps) + (signal 'etaf-runtime-error + (list :non-converging-effect-tuple tuple + :path (nreverse (cons entry + etaf--runtime-fixed-point-history))))) + (puthash tuple t etaf--runtime-fixed-point-stamps) + (push entry etaf--runtime-fixed-point-history)))) + +(defun etaf--runtime-route-scheduler (route source) + "Route dirty SOURCE through opaque ROUTE to its current generation." + (when-let ((runtime + (gethash (etaf-runtime-route-mount-epoch route) + etaf--runtime-route-registry))) + (when (etaf-runtime-mounted-p runtime) + (dolist (effect-id + (etaf--generation-source-effects + (etaf-runtime-current-generation runtime) source)) + (when (etaf--generation-effect + (etaf-runtime-current-generation runtime) effect-id) + (etaf--runtime-enqueue-effect runtime effect-id) + (when (equal effect-id (etaf-runtime-root-effect-id runtime)) + (setf (etaf-runtime-root-dirty-p runtime) t)))) + (etaf-reactive-enqueue-runtime-flush + (etaf-runtime-mount-epoch runtime) + (lambda () (etaf--runtime-request-flush runtime)))))) + +(defun etaf--runtime-evaluate-root-candidate (runtime) + "Evaluate RUNTIME root while privately collecting dependencies." + (let (deps value) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq value (etaf--runtime-evaluate-root runtime))) + (setf (etaf-runtime-candidate-root-deps runtime) (nreverse deps)) + value)) + (defvar etaf--current-runtime nil "Runtime owning the current setup, lifecycle, or event operation.") @@ -83,6 +775,24 @@ (setf (etaf-runtime-focus-ref runtime) host-ref) host-ref) +(defun etaf-runtime-event-begin (runtime) + "Enter one logical event batch for mounted RUNTIME." + (setq runtime (etaf-runtime-require-mounted runtime)) + (cl-incf (etaf-runtime-event-depth runtime)) + runtime) + +(defun etaf-runtime-event-end (runtime) + "Leave RUNTIME's logical event batch and publish pending state once." + (when (and (etaf-runtime-p runtime) + (etaf-runtime-mounted-p runtime)) + (setf (etaf-runtime-event-depth runtime) + (max 0 (1- (etaf-runtime-event-depth runtime)))) + (when (and (zerop (etaf-runtime-event-depth runtime)) + (etaf-runtime-pending-p runtime)) + (setf (etaf-runtime-pending-p runtime) nil) + (etaf--runtime-request-flush runtime))) + runtime) + (defun etaf-runtime-for-buffer (buffer-or-name) "Return the live Runtime mounted in BUFFER-OR-NAME, or nil." (let ((buffer (get-buffer buffer-or-name))) @@ -94,7 +804,7 @@ Signal an ETAF runtime error before any downstream action or renderer lookup when the requested boundary is no longer mounted." (let ((runtime (or runtime etaf--current-runtime - (and (derived-mode-p 'special-mode) + (and (buffer-live-p (current-buffer)) (gethash (current-buffer) etaf--runtime-table))))) (unless (and (etaf-runtime-p runtime) (etaf-runtime-mounted-p runtime)) @@ -107,6 +817,108 @@ when the requested boundary is no longer mounted." (when (etaf-runtime-mounted-p runtime) (funcall job))) +(defun etaf--runtime-call-with-component-env (runtime component-id function) + "Call FUNCTION in RUNTIME candidate/committed COMPONENT-ID environment." + (let* ((generation (etaf-runtime-current-generation runtime)) + (env (and component-id + (gethash component-id + (etaf-runtime-candidate-component-envs runtime)))) + (base (and component-id generation + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + component-id))) + (component + (and base + (or (gethash (etaf--semantic-component-identity base) + (etaf-runtime-candidate-semantic-nodes runtime)) + base))) + (instance + (or (plist-get env :instance) + (and component + (gethash (etaf--semantic-component-resource-key component) + (etaf-runtime-resource-registry runtime))))) + (identity + (or (plist-get env :identity) + (and component (etaf--semantic-component-identity component)))) + (props + (or (plist-get env :props) + (and component (etaf--semantic-component-props component)))) + (slots + (or (plist-get env :slots) + (and component (etaf--semantic-component-slots component))))) + (if (null component-id) + (let ((etaf--current-component-instance nil) + (etaf--current-component-identity nil) + (etaf--current-component-semantic-id nil) + (etaf--current-component-props nil) + (etaf--current-component-slots nil)) + (funcall function)) + (let ((etaf--current-runtime runtime) + (etaf--current-component-instance instance) + (etaf--current-component-identity identity) + (etaf--current-component-semantic-id component-id) + (etaf--current-component-props props) + (etaf--current-component-slots slots) + (etaf--current-context + (or (and component + (etaf--semantic-component-context-frame component)) + (etaf--component-instance-context instance)))) + (funcall function))))) + +(defun etaf--runtime-component-env-signature (runtime component-id) + "Return COMPONENT-ID's candidate or committed input signature in RUNTIME." + (when component-id + (or (when-let ((env (gethash component-id + (etaf-runtime-candidate-component-envs runtime)))) + (list (copy-tree (plist-get env :props)) + (copy-tree (plist-get env :slots)))) + (when-let* ((generation (etaf-runtime-current-generation runtime)) + (component + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + component-id))) + (list (copy-tree (etaf--semantic-component-props component)) + (copy-tree (etaf--semantic-component-slots component))))))) + +(defun etaf--context-frame-changed-keys (old new) + "Return stable keys whose values differ between OLD and NEW frames." + (let ((seen (make-hash-table :test #'eq)) result) + (dolist (frame (list old new)) + (when frame + (maphash (lambda (key _value) (puthash key t seen)) + (etaf-context-values frame)))) + (maphash + (lambda (key _) + (unless (equal (and old (gethash key (etaf-context-values old) + etaf--context-missing)) + (and new (gethash key (etaf-context-values new) + etaf--context-missing))) + (push key result))) + seen) + (sort result (lambda (left right) + (string< (symbol-name left) (symbol-name right)))))) + +(defun etaf--runtime-enqueue-context-consumers (runtime provider-id old new) + "Enqueue RUNTIME consumers affected by PROVIDER-ID changing OLD to NEW." + (dolist (key (etaf--context-frame-changed-keys old new)) + (dolist (effect-id + (etaf--generation-index-lookup + (etaf-runtime-current-generation runtime) 'context-consumers + (cons provider-id key))) + (etaf--runtime-enqueue-effect runtime effect-id)))) + +(defun etaf--runtime-context-frame-for-candidate (runtime semantic) + "Return SEMANTIC Context frame rebased onto RUNTIME candidate provider." + (let* ((frame (etaf-context-copy + (etaf--semantic-component-context-frame semantic))) + (parent (and frame (etaf-context-parent frame))) + (provider-id (and parent (etaf-context-owner-id parent))) + (provider (and provider-id + (gethash provider-id + (etaf-runtime-candidate-graph-nodes runtime))))) + (when (and frame (etaf--semantic-component-p provider)) + (setf (etaf-context-parent frame) + (etaf--semantic-component-context-frame provider))) + frame)) + (defun etaf--runtime-event-kind (property) "Return event symbol represented by callback PROPERTY." (intern (substring (symbol-name property) 4))) @@ -115,6 +927,13 @@ when the requested boundary is no longer mounted." "Register callback PROPS for the opaque Host reference in RUNTIME at PATH." (let ((host-ref (etaf--generated-host-ref props path)) handlers) + ;; A local Component rerender can remove and recreate the same stable + ;; Host reference. Re-registration cancels the candidate tombstone; + ;; otherwise the generation contribution index would hide the new + ;; handler/property entry behind the old removal. + (setf (etaf-runtime-candidate-removed-host-refs runtime) + (delete host-ref + (etaf-runtime-candidate-removed-host-refs runtime))) (puthash host-ref props (etaf-runtime-candidate-host-props runtime)) (while props (let ((key (pop props)) @@ -123,8 +942,73 @@ when the requested boundary is no longer mounted." (string-prefix-p ":on-" (symbol-name key)) (functionp value)) (push (cons (etaf--runtime-event-kind key) value) handlers)))) - (when handlers - (puthash host-ref handlers (etaf-runtime-candidate-handlers runtime))))) + (if handlers + (puthash host-ref handlers (etaf-runtime-candidate-handlers runtime)) + ;; A retained Host can keep its identity while losing its callback + ;; (for example a pagination button at the first/last page). Preserve + ;; a nil handler delta only when the committed generation had one; this + ;; shadows the old contribution without manufacturing entries for every + ;; non-interactive Host. + (when (etaf--generation-index-lookup + (etaf-runtime-current-generation runtime) 'handlers host-ref) + (puthash host-ref nil (etaf-runtime-candidate-handlers runtime)))))) + +(defun etaf--runtime-candidate-add-child (runtime parent-id child-id) + "Append CHILD-ID to PARENT-ID's candidate semantic order in RUNTIME." + (puthash parent-id + (append (gethash parent-id + (etaf-runtime-candidate-graph-children runtime)) + (list child-id)) + (etaf-runtime-candidate-graph-children runtime))) + +(defun etaf--runtime-semantic-id-for-identity (runtime identity) + "Return stable semantic id for IDENTITY in RUNTIME's current candidate." + (or (gethash identity (etaf-runtime-candidate-identity-entries runtime)) + (and etaf--current-range-item-index + (gethash identity etaf--current-range-item-index)) + (and (etaf-runtime-current-generation runtime) + (gethash identity + (etaf-generation-identity-index + (etaf-runtime-current-generation runtime)))) + (cl-incf (etaf-runtime-next-semantic-id runtime)))) + +(defun etaf--runtime-register-semantic-host (runtime name props backend-props path) + "Register visual Host NAME at PATH in RUNTIME and return its semantic id." + (let* ((key (plist-get props :key)) + (identity (if key + (list 'host etaf--current-semantic-parent-id :key key) + (list 'host etaf--current-semantic-parent-id + :position (copy-tree path)))) + (semantic-id (etaf--runtime-semantic-id-for-identity runtime identity)) + (record (etaf--semantic-host-create + :semantic-id semantic-id :identity identity + :parent-id etaf--current-semantic-parent-id + :host-ref (etaf--generated-host-ref props path) + :key key :name name + :props-signature (copy-tree backend-props) + :path (copy-tree path) + :style-identity (copy-tree etaf--render-style-stack)))) + (unless etaf--rendering-range-p + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime))) + (puthash semantic-id record (etaf-runtime-candidate-graph-nodes runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + semantic-id)) + +(defun etaf--runtime-finish-semantic-host + (runtime semantic-id &optional content content-parts) + "Seal SEMANTIC-ID Host child order from RUNTIME candidate graph." + (when-let ((record (gethash semantic-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (setf (etaf--semantic-host-child-ids record) + (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime))) + (etaf--semantic-host-content record) (copy-tree content)) + (setf (etaf--semantic-host-content-parts record) + (copy-tree content-parts))) + semantic-id) (defun etaf--runtime-behavior-specs (value) "Normalize `:use' VALUE to a list of Behavior specs." @@ -141,6 +1025,46 @@ when the requested boundary is no longer mounted." (signal 'etaf-behavior-error (list ":use must evaluate to a Behavior spec or list"))))) +(defun etaf--runtime-target-value-equal-p (left right) + "Compare LEFT and RIGHT with reactive/function identity rules." + (cond + ((or (etaf-ref-p left) (etaf-computed-p left) + (etaf-ref-p right) (etaf-computed-p right)) + (eq left right)) + ((or (functionp left) (functionp right)) + (eq left right)) + ((and (consp left) (consp right)) + (and (etaf--runtime-target-value-equal-p (car left) (car right)) + (etaf--runtime-target-value-equal-p (cdr left) (cdr right)))) + ((or (consp left) (consp right)) nil) + (t (equal left right)))) + +(defun etaf--runtime-behavior-spec-equal-p (left right) + "Return whether Behavior specs LEFT and RIGHT may share installer state." + (and (etaf-behavior-spec-p left) + (etaf-behavior-spec-p right) + (eq (etaf-behavior-spec-name left) + (etaf-behavior-spec-name right)) + (eq (etaf-behavior-spec-install left) + (etaf-behavior-spec-install right)) + (etaf--runtime-target-value-equal-p + (etaf-behavior-spec-attributes left) + (etaf-behavior-spec-attributes right)))) + +(defun etaf--compose-event-callbacks (primary secondary) + "Compose two event callbacks in declaration order. +PRIMARY is the explicit Host callback and SECONDARY comes from a Behavior. +The composition belongs to the Runtime event layer, so UI Components do not +need to know how Behavior attributes are merged." + (cond + ((not (functionp primary)) secondary) + ((not (functionp secondary)) primary) + (t + (lambda (&rest arguments) + (prog1 + (apply primary arguments) + (apply secondary arguments)))))) + (defun etaf--runtime-install-behavior (runtime spec path props) "Install Behavior SPEC for RUNTIME at PATH and return its state." (let ((install (etaf-behavior-spec-install spec)) @@ -165,19 +1089,37 @@ when the requested boundary is no longer mounted." (dolist (spec specs) (let* ((identity (list path (etaf-behavior-spec-name spec))) (old (gethash identity (etaf-runtime-behaviors runtime))) - (state (if (and old - (equal (etaf-behavior-spec-attributes - (car old)) - (etaf-behavior-spec-attributes spec))) + (same-p (and old + (etaf--runtime-behavior-spec-equal-p + (car old) spec))) + (state (if same-p old - (etaf--runtime-install-behavior runtime spec path props)))) + (etaf--runtime-install-behavior runtime spec path props))) + (resource-key + (if same-p + (and (hash-table-p + (etaf-runtime-behavior-resource-keys runtime)) + (gethash identity + (etaf-runtime-behavior-resource-keys runtime))) + (cons (etaf-runtime-mount-epoch runtime) + (cl-incf (etaf-runtime-next-resource-id runtime)))))) (puthash identity state (etaf-runtime-candidate-behaviors runtime)) + (puthash identity resource-key + (etaf-runtime-candidate-behavior-resource-keys runtime)) (let ((attributes (etaf-behavior-spec-attributes (car state)))) (while attributes (let ((key (pop attributes)) (value (pop attributes))) - (unless (plist-member merged key) - (setq merged (append merged (list key value))))))))) + (if (and (keywordp key) + (string-prefix-p ":on-" (symbol-name key)) + (plist-member merged key)) + (setq merged + (plist-put + merged key + (etaf--compose-event-callbacks + (plist-get merged key) value))) + (unless (plist-member merged key) + (setq merged (append merged (list key value)))))))))) (etaf--view-node-create :name (etaf--view-node-name node) :props merged @@ -185,60 +1127,133 @@ when the requested boundary is no longer mounted." (defun etaf--runtime-promote-behaviors (runtime) "Publish candidate Behavior state for RUNTIME and dispose old state." - (maphash - (lambda (identity old) - (let ((candidate (gethash identity - (etaf-runtime-candidate-behaviors runtime)))) - (unless (and candidate (eq candidate old)) - (when-let ((cleanup (cdr old))) - (funcall cleanup))))) - (etaf-runtime-behaviors runtime)) - (setf (etaf-runtime-behaviors runtime) - (etaf-runtime-candidate-behaviors runtime) - (etaf-runtime-candidate-behaviors runtime) nil)) + (let ((old-resources (or (etaf-runtime-behavior-resource-keys runtime) + (make-hash-table :test #'equal))) + (candidate-resources + (or (etaf-runtime-candidate-behavior-resource-keys runtime) + (make-hash-table :test #'equal)))) + (dolist (entry (sort (let (entries) + (maphash (lambda (key value) + (push (cons key value) entries)) + (etaf-runtime-behaviors runtime)) + entries) + (lambda (left right) + (string< (prin1-to-string (car left)) + (prin1-to-string (car right)))))) + (let* ((identity (car entry)) (old (cdr entry)) + (candidate (gethash identity + (etaf-runtime-candidate-behaviors runtime))) + (old-key (gethash identity old-resources)) + (candidate-key (gethash identity candidate-resources))) + (unless (and candidate (eq candidate old)) + (when-let ((cleanup (cdr old))) + (etaf--runtime-run-contained-cleanup + runtime 'behavior-remove identity cleanup)) + (when old-key + (remhash old-key (etaf-runtime-resource-registry runtime)))) + (when (and candidate candidate-key) + (puthash candidate-key candidate + (etaf-runtime-resource-registry runtime))))) + ;; Candidate resource membership becomes the only generation-visible + ;; address set after publication; the state map remains a local disposal + ;; index and is never consulted by generation dispatch. + (setf (etaf-runtime-behaviors runtime) + (etaf-runtime-candidate-behaviors runtime) + (etaf-runtime-behavior-resource-keys runtime) candidate-resources + (etaf-runtime-candidate-behaviors runtime) nil + (etaf-runtime-candidate-behavior-resource-keys runtime) nil))) (defun etaf--runtime-rollback-behaviors (runtime) "Dispose Behavior installers created by a failed RUNTIME candidate." (when-let ((candidate (etaf-runtime-candidate-behaviors runtime))) - (maphash - (lambda (identity state) - (unless (eq state (gethash identity (etaf-runtime-behaviors runtime))) + (dolist (entry (reverse + (sort (let (entries) + (maphash (lambda (key value) + (push (cons key value) entries)) + candidate) + entries) + (lambda (left right) + (string< (prin1-to-string (car left)) + (prin1-to-string (car right))))))) + (let* ((identity (car entry)) (state (cdr entry)) + (old-state (gethash identity (etaf-runtime-behaviors runtime))) + (candidate-key + (and (hash-table-p + (etaf-runtime-candidate-behavior-resource-keys runtime)) + (gethash identity + (etaf-runtime-candidate-behavior-resource-keys + runtime)))) + (old-key + (and (hash-table-p (etaf-runtime-behavior-resource-keys runtime)) + (gethash identity + (etaf-runtime-behavior-resource-keys runtime)))) + (same-state (eq state old-state))) + (unless same-state (when-let ((cleanup (cdr state))) - (funcall cleanup)))) - candidate))) + (etaf--runtime-run-contained-cleanup + runtime 'behavior-rollback identity cleanup)) + (when (and candidate-key (not (equal candidate-key old-key))) + (remhash candidate-key (etaf-runtime-resource-registry runtime)))))))) + +(defun etaf--runtime-run-contained-cleanup (runtime phase identity function) + "Run cleanup FUNCTION for IDENTITY and record PHASE failures in RUNTIME." + (let ((inhibit-quit t) (quit-flag nil)) + (condition-case condition + (funcall function) + ((error quit) + (push (list :phase phase :identity (copy-tree identity) + :condition condition) + (etaf-runtime-diagnostics runtime))))) + nil) (defun etaf--runtime-call-key (call path) "Return retained identity for CALL at PATH, honoring an optional `:key'." - (let* ((props (etaf--resolve-property-plist - (etaf--component-call-props call))) - (key (plist-get props :key))) + (let* ((props (etaf--component-call-props call)) + (key (and (plist-member props :key) + (etaf--resolve-property-value (plist-get props :key))))) (when key (etaf--validate-key key)) (if key (append (butlast path) (list :key key)) path))) -(defun etaf--runtime-snapshot-instance (runtime identity instance) - "Record INSTANCE's pre-candidate fields once for RUNTIME and IDENTITY." - (unless (assoc identity (etaf-runtime-candidate-snapshots runtime)) - (push (list identity instance - (etaf--component-instance-props instance) - (etaf--component-instance-slots instance) - (etaf--component-instance-render-function instance)) - (etaf-runtime-candidate-snapshots runtime)))) +(defun etaf--runtime-owned-slots (slots) + "Attach current caller ownership to unowned normalized SLOTS." + (mapcar + (lambda (entry) + (let ((name (car entry)) (value (cdr entry))) + (cond + ((etaf--slot-content-p value) entry) + ((and (= (length value) 1) + (etaf--slot-projection-p (car value))) + (let* ((projection (car value)) + (forwarded (assq (etaf--slot-projection-name projection) + etaf--current-component-slots))) + (if (and forwarded (etaf--slot-content-p (cdr forwarded))) + (cons name (cdr forwarded)) + (cons name + (etaf--slot-content-create + :owner-component-id etaf--current-component-semantic-id + :children value))))) + (t + (cons name + (etaf--slot-content-create + :owner-component-id etaf--current-component-semantic-id + :children value)))))) + slots)) -(defun etaf--runtime-new-instance (runtime spec identity props slots) +(defun etaf--runtime-new-instance (runtime spec identity) "Create and register IDENTITY's Component instance for RUNTIME from SPEC." - (let ((instance + (let* ((resource-id (cl-incf (etaf-runtime-next-resource-id runtime))) + (resource-key (cons (etaf-runtime-mount-epoch runtime) resource-id)) + (instance (etaf--component-instance-create :spec spec :identity identity :scope (etaf-effect-scope :name identity) :context (etaf--context-create :parent etaf--current-context) - :props props - :slots slots))) + :resource-key resource-key))) (push instance (etaf-runtime-candidate-created runtime)) - (puthash identity instance (etaf-runtime-instances runtime)) instance)) (defun etaf--runtime-instance-for-call (runtime call path) @@ -246,23 +1261,24 @@ when the requested boundary is no longer mounted." (let* ((spec (etaf--component-call-spec call)) (identity (list (etaf--component-spec-name spec) (etaf--runtime-call-key call path))) - (props (etaf--resolve-property-plist - (etaf--component-call-props call))) - (slots (etaf--component-call-slots call)) - (old (gethash identity (etaf-runtime-instances runtime))) + (old-semantic + (and (etaf-runtime-current-generation runtime) + (etaf--generation-semantic + (etaf-runtime-current-generation runtime) identity))) + (old (and old-semantic + (gethash (etaf--semantic-component-resource-key old-semantic) + (etaf-runtime-resource-registry runtime)))) + (staged (gethash identity (etaf-runtime-candidate-live runtime))) (instance (cond - ((and old (eq (etaf--component-instance-spec old) spec)) - (etaf--runtime-snapshot-instance runtime identity old) - old) + ((etaf--component-instance-p staged) staged) + ((and old (eq (etaf--component-instance-spec old) spec)) old) (old (push (list identity old) (etaf-runtime-candidate-old-instances runtime)) - (etaf--runtime-new-instance runtime spec identity props slots)) + (etaf--runtime-new-instance runtime spec identity)) (t - (etaf--runtime-new-instance runtime spec identity props slots))))) - (setf (etaf--component-instance-props instance) props - (etaf--component-instance-slots instance) slots) - (puthash identity t (etaf-runtime-seen runtime)) + (etaf--runtime-new-instance runtime spec identity))))) + (puthash identity instance (etaf-runtime-candidate-live runtime)) instance)) (defun etaf--run-hooks (hooks) @@ -270,31 +1286,39 @@ when the requested boundary is no longer mounted." (dolist (hook (reverse hooks)) (funcall hook))) -(defun etaf--runtime-render-component (runtime call path) - "Render CALL through retained RUNTIME at PATH to one Ebox node." - (let* ((instance (etaf--runtime-instance-for-call runtime call path)) - (spec (etaf--component-instance-spec instance)) - (props (etaf--component-instance-props instance)) - (slots (etaf--component-instance-slots instance)) +(defun etaf--runtime-render-component-resource + (runtime instance identity props slots path + &optional old-output-range-id old-publication-kind old-context-frame) + "Render RUNTIME candidate IDENTITY from resource INSTANCE without mutation." + (let* ((spec (etaf--component-instance-spec instance)) (setup (etaf--component-spec-setup spec))) - (let ((etaf--current-runtime runtime) + (let ((candidate-context + (if old-context-frame + (etaf-context-copy old-context-frame) + (etaf--component-instance-context instance)))) + (let ((etaf--current-runtime runtime) (etaf--current-component-instance instance) + (etaf--current-component-identity identity) (etaf--current-component-props props) (etaf--current-component-slots slots) - (etaf--current-context - (etaf--component-instance-context instance)) + (etaf--raw-slot-read-p nil) + (etaf--current-context candidate-context) (etaf--render-runtime runtime) + (etaf--render-parent-style-stack etaf--render-style-stack) (etaf--render-style-stack - (cons + (list (cons (etaf--component-spec-styles spec) - (append path (list :view))) - etaf--render-style-stack))) + (append path (list :view)))))) (when (and setup (null (etaf--component-instance-render-function instance))) (let ((render-function (etaf-scope-run (etaf--component-instance-scope instance) - (lambda () (funcall setup props slots)) + (lambda () + (let ((etaf--runtime-dependency-collector nil) + (etaf--tracking-enabled-p nil) + (etaf--active-effect nil)) + (funcall setup props slots))) :watch-scheduler (lambda (job phase) (etaf--runtime-watch-scheduler runtime job phase))))) @@ -311,13 +1335,1250 @@ when the requested boundary is no longer mounted." (rendered (if setup (funcall render-function) (funcall render-function props slots))) - (nodes (etaf--render-value-list - rendered - (append path (list :view))))) - (cond - ((null nodes) (ebox-spacer)) - ((null (cdr nodes)) (car nodes)) - (t (apply #'ebox-column nodes))))))) + (transparent-p + (and (not (eq old-publication-kind 'material)) + (etaf--runtime-transparent-output-p rendered))) + (component-id etaf--current-semantic-parent-id) + (range-id (and transparent-p + (or old-output-range-id + (cl-incf (etaf-runtime-next-semantic-id runtime))))) + (old-range (and old-output-range-id + (etaf-runtime-current-generation runtime) + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + old-output-range-id))) + (nodes + (let ((etaf--current-semantic-parent-id + (or range-id etaf--current-semantic-parent-id)) + (etaf--current-range-item-index + (and old-range + (etaf--semantic-range-item-identity-index old-range))) + ;; Material Components nested below an existing semantic + ;; Range flatten their child Range sites into that outer + ;; owner; Ebox must never receive nested descriptors. + (etaf--rendering-range-p + (or transparent-p etaf--rendering-range-p))) + (etaf--render-value-list rendered + (append path (list :view)))))) + (let ((child-ids + (copy-sequence + (gethash range-id + (etaf-runtime-candidate-graph-children runtime))))) + (when (= (length child-ids) (length nodes)) + (setq nodes + (cl-mapcan + (lambda (child-id node) + (let ((child + (gethash child-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (cond + ((etaf--semantic-range-p child) + (copy-sequence + (gethash (etaf--semantic-range-effect-id child) + (etaf-runtime-candidate-range-artifacts + runtime)))) + ((etaf--semantic-slot-range-p child) + (copy-sequence + (gethash (etaf--semantic-slot-range-effect-id child) + (etaf-runtime-candidate-range-artifacts + runtime)))) + (t (list node))))) + child-ids nodes)))) + (when (cl-some (lambda (node) + (memq node etaf--rendered-range-container-nodes)) + nodes) + (setq transparent-p nil)) + ;; An unretained/raw slot projection still owns its structure through + ;; the Component render target. Keep that existing material boundary + ;; until every projection is represented by a semantic slot Range. + (when etaf--raw-slot-read-p + (setq transparent-p nil)) + (when (and transparent-p + (cl-some + (lambda (child-id) + (let ((child + (gethash child-id + (etaf-runtime-candidate-graph-nodes + runtime)))) + (or + (and (etaf--semantic-component-p child) + (eq + (etaf--semantic-component-publication-kind child) + 'material)) + (and (cl-every #'listp nodes) + (or (etaf--semantic-slot-range-p child) + (and (etaf--semantic-range-p child) + (not (eq + (etaf--semantic-range-kind child) + 'component-output)))))))) + (etaf--runtime-candidate-descendant-ids + runtime + (gethash range-id + (etaf-runtime-candidate-graph-children runtime)))) + ;; A single explicit Host anchor is the reviewed escape + ;; for a retained page/slot Range: material Components may + ;; live below that Host without collapsing the Range back + ;; into its parent Component. The Host remains the sole + ;; visual item and the normal backend identity proof still + ;; validates its subtree. + (not (and (= (length nodes) 1) + (etaf--semantic-host-p + (gethash + (car (gethash range-id + (etaf-runtime-candidate-graph-children + runtime))) + (etaf-runtime-candidate-graph-nodes + runtime)))))) + (unless (null (cdr nodes)) + (signal 'etaf-runtime-error + (list "Transparent sequence containing a material Component requires an explicit Host"))) + (setq transparent-p nil) + (let ((children + (copy-sequence + (gethash range-id + (etaf-runtime-candidate-graph-children runtime))))) + (puthash component-id children + (etaf-runtime-candidate-graph-children runtime)) + (remhash range-id (etaf-runtime-candidate-graph-children runtime)) + (dolist (child-id children) + (when-let ((child + (gethash child-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (let ((copy (copy-sequence child))) + (cond ((etaf--semantic-component-p copy) + (setf (etaf--semantic-component-parent-id copy) + component-id)) + ((etaf--semantic-host-p copy) + (setf (etaf--semantic-host-parent-id copy) component-id))) + (puthash child-id copy + (etaf-runtime-candidate-graph-nodes runtime))))))) + (let ((node + (unless transparent-p + (cond + ((null nodes) (ebox-spacer)) + ((null (cdr nodes)) (car nodes)) + (t (apply #'ebox-column nodes)))))) + (when node + (let ((range-container-p + (memq node etaf--rendered-range-container-nodes))) + (setq node (copy-sequence node)) + (when range-container-p + (push node etaf--rendered-range-container-nodes)))) + (let ((host-ref (and node (or (plist-get node :host-ref) + (list 'etaf-component + (copy-tree + (etaf--component-instance-identity + instance))))))) + (when node (setq node (plist-put node :host-ref host-ref))) + (list node host-ref rendered etaf--raw-slot-read-p + nodes (if transparent-p 'transparent 'material) + range-id candidate-context)))))))) + +(defun etaf--runtime-transparent-output-p (value) + "Return whether VALUE has a transparent Component output boundary." + (or (null value) + (and (proper-list-p value) (not (etaf--view-node-p value))) + (and (etaf--view-node-p value) + (eq (etaf--view-node-name value) 'fragment)))) + +(defun etaf--runtime-stage-component-output-range + (runtime old component-id _component-effect-id semantic-id rendered nodes path) + "Stage transparent COMPONENT-ID output NODES in RUNTIME from OLD state." + (let* ((range-ref (or (and old + (etaf--semantic-component-output-range-ref old)) + (list 'etaf-component-output + (etaf-runtime-mount-epoch runtime) semantic-id))) + (old-range (and old + (etaf--semantic-component-output-range-id old) + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + (etaf--semantic-component-output-range-id old)))) + (effect-id (or (and old-range + (etaf--semantic-range-effect-id old-range)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (identity (list 'component-output-range component-id)) + (child-ids (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime)))) + (all-item-ids + (etaf--runtime-candidate-descendant-ids runtime child-ids)) + (item-index (make-hash-table :test #'equal)) + (record + (etaf--semantic-range-create + :semantic-id semantic-id :identity identity :effect-id effect-id + :kind 'component-output :parent-id component-id + :component-id component-id :token 'component-output + :range-ref range-ref :path (copy-tree path) + :caller-style-stack (copy-tree etaf--render-style-stack) + :output-signature (copy-tree rendered) :deps nil + :artifact-key (list (1+ (etaf-runtime-generation runtime)) + 'component-output effect-id) + :item-host-ids child-ids :item-identity-index item-index))) + (dolist (child-id child-ids) + (when-let ((child (gethash child-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (let ((copy (copy-sequence child))) + (cond ((etaf--semantic-host-p copy) + (setf (etaf--semantic-host-parent-id copy) semantic-id) + (puthash (etaf--semantic-host-identity copy) child-id item-index)) + ((etaf--semantic-component-p copy) + (setf (etaf--semantic-component-parent-id copy) semantic-id)) + ((etaf--semantic-range-p copy) + (setf (etaf--semantic-range-parent-id copy) semantic-id)) + ((etaf--semantic-slot-range-p copy) + (setf (etaf--semantic-slot-range-parent-id copy) semantic-id))) + (puthash child-id copy + (etaf-runtime-candidate-graph-nodes runtime))))) + (dolist (item-id all-item-ids) + (when-let ((item (gethash item-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (when (etaf--semantic-host-p item) + (puthash (etaf--semantic-host-identity item) item-id item-index)))) + (when old-range + (let ((new-set (make-hash-table :test #'eql))) + (dolist (item-id all-item-ids) (puthash item-id t new-set)) + (dolist (old-id + (etaf--runtime-generation-descendant-ids + (etaf-runtime-current-generation runtime) + (etaf--semantic-range-item-host-ids old-range))) + (unless (gethash old-id new-set) + (push old-id + (etaf-runtime-candidate-removed-semantic-ids runtime)))))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (puthash semantic-id record + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash semantic-id child-ids + (etaf-runtime-candidate-graph-children runtime)) + (puthash component-id (list semantic-id) + (etaf-runtime-candidate-graph-children runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'component-output + :semantic-id semantic-id :deps nil) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id nodes + (etaf-runtime-candidate-range-artifacts runtime)) + (dolist (child-id child-ids) + (when-let ((child (gethash child-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (let ((nested + (cond + ((etaf--semantic-component-p child) + (and (etaf--semantic-component-output-range-id child) + (gethash (etaf--semantic-component-output-range-id child) + (etaf-runtime-candidate-graph-nodes runtime)))) + ((or (etaf--semantic-range-p child) + (etaf--semantic-slot-range-p child)) + child)))) + (when nested + (let ((copy (copy-sequence nested))) + (if (etaf--semantic-slot-range-p copy) + (setf (etaf--semantic-slot-range-range-ref copy) range-ref) + (setf (etaf--semantic-range-range-ref copy) range-ref)) + (puthash (if (etaf--semantic-slot-range-p copy) + (etaf--semantic-slot-range-semantic-id copy) + (etaf--semantic-range-semantic-id copy)) + copy (etaf-runtime-candidate-graph-nodes runtime))))))) + (list record (apply #'ebox-child-range range-ref nodes)))) + +(defun etaf--runtime-render-component (runtime call path) + "Render CALL through retained RUNTIME at PATH to one Ebox node." + (let* ((parent etaf--current-component-identity) + (parent-semantic + (and parent (etaf-runtime-current-generation runtime) + (etaf--generation-semantic + (etaf-runtime-current-generation runtime) parent))) + (parent-resource + (and parent-semantic + (gethash (etaf--semantic-component-resource-key parent-semantic) + (etaf-runtime-resource-registry runtime)))) + (instance + (let ((etaf--active-scope + (and parent-resource + (etaf--component-instance-scope parent-resource)))) + (etaf--runtime-instance-for-call runtime call path))) + (identity (etaf--component-instance-identity instance)) + (slots (etaf--runtime-owned-slots (etaf--component-call-slots call))) + (old-generation (etaf-runtime-current-generation runtime)) + (old (and old-generation + (etaf--generation-semantic old-generation identity))) + (input-effect-id + (or (and old (etaf--semantic-component-input-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (effect-id (or (and old (etaf--semantic-component-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (semantic-id (or (and old (etaf--semantic-component-semantic-id old)) + (cl-incf (etaf-runtime-next-semantic-id runtime)))) + props input-deps render-deps context-deps slot-retargeted-p) + (unless (etaf-context-owner-id (etaf--component-instance-context instance)) + (setf (etaf-context-owner-id (etaf--component-instance-context instance)) + semantic-id)) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source input-deps :test #'eq))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq props + (etaf--resolve-property-plist (etaf--component-call-props call)))) + (puthash semantic-id + (list :identity identity :instance instance :props props :slots slots) + (etaf-runtime-candidate-component-envs runtime)) + (when (and old + (or etaf--rendering-component-effect-p + (not (equal-including-properties + slots (etaf--semantic-component-slots old)))) + (not (etaf--semantic-component-raw-slot-reader-p old))) + (setq slot-retargeted-p + (etaf--runtime-retarget-component-slot-ranges runtime old slots))) + (if (not (or (null old) + etaf--runtime-force-full-component-render-p + (gethash input-effect-id + (etaf-runtime-dirty-effect-ids runtime)) + (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)) + (and slots etaf--rendering-component-effect-p + (not slot-retargeted-p)) + (not (equal-including-properties + props (etaf--semantic-component-props old))) + (and (not slot-retargeted-p) + (not (equal-including-properties + slots (etaf--semantic-component-slots old)))))) + (progn + (when (etaf-runtime-candidate-full-rebuild-p runtime) + (etaf--runtime-carry-committed-subtree runtime old-generation old)) + (let ((artifact + (and (etaf--semantic-component-artifact-key old) + (gethash (etaf--semantic-component-artifact-key old) + (etaf-runtime-artifact-registry runtime))))) + (unless artifact + (setq artifact + (etaf--runtime-rebuild-component-artifact + runtime old)) + (puthash identity old + (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash semantic-id old + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id artifact + (etaf-runtime-candidate-artifacts runtime))) + ;; Local overlays do not copy a whole unchanged descendant + ;; subtree. Preserve the artifact root's contribution entry so + ;; a stable interactive child (for example a Button Component) + ;; remains dispatchable without traversing unrelated descendants. + (when-let ((host-ref (plist-get artifact :host-ref))) + (when-let ((handlers + (etaf--generation-index-lookup + old-generation 'handlers host-ref))) + (puthash host-ref (copy-tree handlers) + (etaf-runtime-candidate-handlers runtime))) + (when-let ((host-props + (etaf--generation-index-lookup + old-generation 'host-props host-ref))) + (puthash host-ref (copy-tree host-props) + (etaf-runtime-candidate-host-props runtime)))) + (plist-get artifact :node))) + (let (result) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source render-deps :test #'eq))) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--current-component-semantic-id semantic-id) + (etaf--current-semantic-parent-id semantic-id) + (etaf--rendering-component-effect-p t) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq result + (etaf--runtime-render-component-resource + runtime instance identity props slots path + (and old (etaf--semantic-component-output-range-id old)) + (and old (etaf--semantic-component-publication-kind old)) + (and old (etaf--semantic-component-context-frame old))))) + (let* ((transparent-p (eq (nth 5 result) 'transparent)) + (output-range + (and transparent-p + (etaf--runtime-stage-component-output-range + runtime old semantic-id effect-id (nth 6 result) + (nth 2 result) + (nth 4 result) path))) + (publication-node (if transparent-p (cadr output-range) + (car result))) + (semantic + (etaf--semantic-component-create + :semantic-id semantic-id + :identity (copy-tree identity) + :input-effect-id input-effect-id :effect-id effect-id + :resource-key (copy-tree + (etaf--component-instance-resource-key instance)) + :props (copy-tree props) :slots (copy-tree slots) + :input-props (copy-tree (etaf--component-call-props call)) + :input-slots (copy-tree slots) + :output-signature (copy-tree (nth 2 result)) + :artifact-key effect-id + :path (copy-tree path) + :caller-style-stack (copy-tree etaf--render-style-stack) + :input-deps (nreverse input-deps) + :deps (nreverse render-deps) + :parent-id etaf--current-semantic-parent-id + :caller-component-id etaf--current-component-semantic-id + :raw-slot-reader-p (nth 3 result) + :publication-kind (if transparent-p 'transparent 'material) + :output-range-id (and transparent-p + (etaf--semantic-range-semantic-id + (car output-range))) + :output-range-ref (and transparent-p + (etaf--semantic-range-range-ref + (car output-range))) + :context-frame + (etaf-context-copy (nth 7 result)) + :context-deps (nreverse context-deps) + :child-ids (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children + runtime)))))) + (puthash identity semantic + (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash semantic-id semantic + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash input-effect-id + (etaf--generation-effect-create + :effect-id input-effect-id :kind 'component-input + :semantic-id semantic-id + :deps (etaf--semantic-component-input-deps semantic)) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'component-render + :semantic-id semantic-id + :deps (etaf--semantic-component-deps semantic)) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id (list :node publication-node + :host-ref (copy-tree (cadr result)) + :nodes (copy-sequence (nth 4 result)) + :range-id (and transparent-p + (etaf--semantic-range-semantic-id + (car output-range)))) + (etaf-runtime-candidate-artifacts runtime)) + (push identity (etaf-runtime-candidate-rendered-identities runtime)) + (if (and transparent-p + (or etaf--rendering-range-p + (= etaf--current-semantic-parent-id + (etaf-runtime-root-range-id runtime)))) + (cons 'component-output-range (copy-sequence (nth 4 result))) + publication-node)))))) + +(defun etaf--runtime-lower-semantic-artifact (runtime generation semantic-id) + "Purely lower SEMANTIC-ID from GENERATION and RUNTIME Range artifacts." + (let ((semantic (etaf--pvec-get + (etaf-generation-semantic-nodes generation) semantic-id))) + (cond + ((or (etaf--semantic-range-p semantic) + (etaf--semantic-slot-range-p semantic)) + (apply #'ebox-child-range + (etaf--semantic-backend-range-ref semantic) + (copy-sequence + (gethash (etaf--semantic-backend-range-artifact-key semantic) + (etaf-runtime-range-artifact-registry runtime))))) + ((etaf--semantic-component-p semantic) + (let ((nodes (mapcar + (lambda (child-id) + (etaf--runtime-lower-semantic-artifact + runtime generation child-id)) + (etaf--semantic-component-child-ids semantic)))) + (cond ((null nodes) (ebox-spacer)) + ((null (cdr nodes)) (car nodes)) + (t (apply #'ebox-column nodes))))) + ((etaf--semantic-inline-range-p semantic) + (etaf--semantic-inline-range-output semantic)) + ((etaf--semantic-host-p semantic) + (let* ((name (etaf--semantic-host-name semantic)) + (props (copy-tree (etaf--semantic-host-props-signature semantic))) + (child-ids (etaf--semantic-host-child-ids semantic)) + (parent-semantic + (and (etaf--semantic-host-parent-id semantic) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--semantic-host-parent-id semantic)))) + ;; A semantic Range may contain one material Host anchor whose + ;; descendants include another Range. Flatten that nested + ;; semantic Range at the Renderer boundary so Ebox receives only + ;; declarative children; the outer Range remains the publication + ;; identity and ancestor invalidation still follows the graph. + (flatten-range-children-p + (or (etaf--semantic-range-p parent-semantic) + (etaf--semantic-slot-range-p parent-semantic))) + (content + (if (eq name 'text) + (if (etaf--semantic-host-content-parts semantic) + (apply #'concat + (mapcar + (lambda (part) + (if (integerp part) + (etaf--semantic-inline-range-output + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + part)) + part)) + (etaf--semantic-host-content-parts semantic))) + (etaf--semantic-host-content semantic)) + (etaf--semantic-host-content semantic))) + (children + (unless (eq name 'text) + (cl-mapcan + (lambda (child-id) + (let ((child (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + child-id))) + (if (and flatten-range-children-p + (or (etaf--semantic-range-p child) + (etaf--semantic-slot-range-p child))) + (copy-sequence + (gethash + (etaf--semantic-backend-range-artifact-key child) + (etaf-runtime-range-artifact-registry runtime))) + (list + (etaf--runtime-lower-semantic-artifact + runtime generation child-id))))) + child-ids))) + (range-child-p + (and (not flatten-range-children-p) + (cl-some + (lambda (child-id) + (let ((child (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + child-id))) + (or (etaf--semantic-range-p child) + (etaf--semantic-slot-range-p child)))) + child-ids)))) + (etaf--lower-resolved-semantic-host + name props content + children range-child-p))) + (t (signal 'etaf-runtime-error + (list "Missing semantic artifact node" semantic-id)))))) + +(defun etaf--runtime-rebuild-component-artifact (runtime semantic) + "Rebuild RUNTIME SEMANTIC Ebox artifact without application code." + (let* ((generation (etaf-runtime-current-generation runtime)) + (node (etaf--runtime-lower-semantic-artifact + runtime generation + (etaf--semantic-component-semantic-id semantic))) + (host-ref (or (plist-get node :host-ref) + (list 'etaf-component + (copy-tree + (etaf--semantic-component-identity semantic)))))) + (setq node (copy-sequence node)) + (plist-put node :host-ref host-ref) + (list :node node :host-ref host-ref))) + +(defun etaf--runtime-carry-committed-subtree (runtime generation semantic) + "Carry RUNTIME SEMANTIC and its GENERATION children during Root traversal." + (let* ((semantic-id + (cond ((etaf--semantic-component-p semantic) + (etaf--semantic-component-semantic-id semantic)) + ((etaf--semantic-host-p semantic) + (etaf--semantic-host-semantic-id semantic)) + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-semantic-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-semantic-id semantic)) + (t (etaf--semantic-inline-range-semantic-id semantic)))) + (identity + (cond ((etaf--semantic-component-p semantic) + (etaf--semantic-component-identity semantic)) + ((etaf--semantic-host-p semantic) + (etaf--semantic-host-identity semantic)) + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-identity semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-identity semantic)) + (t (etaf--semantic-inline-range-identity semantic)))) + (children + (cond ((etaf--semantic-component-p semantic) + (etaf--semantic-component-child-ids semantic)) + ((etaf--semantic-host-p semantic) + (etaf--semantic-host-child-ids semantic)) + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-item-host-ids semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-item-host-ids semantic)) + (t nil)))) + (unless (and (etaf--semantic-host-p semantic) + (etaf--semantic-range-p + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--semantic-host-parent-id semantic)))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime))) + (puthash semantic-id semantic (etaf-runtime-candidate-graph-nodes runtime)) + (when (and (etaf--semantic-host-p semantic) + (etaf--semantic-host-host-ref semantic)) + (let ((host-ref (etaf--semantic-host-host-ref semantic))) + (when-let ((handlers + (etaf--generation-index-lookup + generation 'handlers host-ref))) + (puthash host-ref (copy-tree handlers) + (etaf-runtime-candidate-handlers runtime))) + (when-let ((props + (etaf--generation-index-lookup + generation 'host-props host-ref))) + (puthash host-ref (copy-tree props) + (etaf-runtime-candidate-host-props runtime))))) + (when (etaf--semantic-component-p semantic) + (puthash identity semantic (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash identity + (gethash (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime)) + (etaf-runtime-candidate-live runtime)) + (dolist (entry + (list + (etaf--generation-effect-create + :effect-id (etaf--semantic-component-input-effect-id semantic) + :kind 'component-input :semantic-id semantic-id + :deps (etaf--semantic-component-input-deps semantic)) + (etaf--generation-effect-create + :effect-id (etaf--semantic-component-effect-id semantic) + :kind 'component-render :semantic-id semantic-id + :deps (etaf--semantic-component-deps semantic)))) + (puthash (etaf--generation-effect-effect-id entry) entry + (etaf-runtime-candidate-effects runtime)))) + (when (etaf--semantic-range-p semantic) + (let ((effect + (or (etaf--pvec-get + (etaf-generation-effect-map generation) + (etaf--semantic-range-effect-id semantic)) + (etaf--generation-effect-create + :effect-id (etaf--semantic-range-effect-id semantic) + :kind 'range :semantic-id semantic-id + :deps (etaf--semantic-range-deps semantic))))) + (puthash (etaf--generation-effect-effect-id effect) effect + (etaf-runtime-candidate-effects runtime)))) + (when (etaf--semantic-inline-range-p semantic) + (let ((effect + (etaf--pvec-get + (etaf-generation-effect-map generation) + (etaf--semantic-inline-range-effect-id semantic)))) + (puthash (etaf--generation-effect-effect-id effect) effect + (etaf-runtime-candidate-effects runtime)))) + (when (etaf--semantic-slot-range-p semantic) + (let ((effect + (etaf--pvec-get + (etaf-generation-effect-map generation) + (etaf--semantic-slot-range-effect-id semantic)))) + (puthash (etaf--generation-effect-effect-id effect) effect + (etaf-runtime-candidate-effects runtime)))) + (puthash semantic-id (copy-sequence children) + (etaf-runtime-candidate-graph-children runtime)) + (dolist (child-id children) + (when-let ((child (etaf--pvec-get + (etaf-generation-semantic-nodes generation) child-id))) + (etaf--runtime-carry-committed-subtree runtime generation child))))) + +(defun etaf--runtime-render-child-range (runtime expr path &optional kind) + "Lower RUNTIME direct material-child EXPR at PATH as retained Range KIND." + (let* ((token (etaf--expr-token expr)) + (identity (list 'range etaf--current-semantic-parent-id + (or token (copy-tree path)))) + (old-generation (etaf-runtime-current-generation runtime)) + (old-id (and old-generation + (gethash identity + (etaf-generation-identity-index old-generation)))) + (old (and old-id + (etaf--pvec-get (etaf-generation-semantic-nodes old-generation) + old-id))) + (candidate (and old-id + (gethash old-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime)))) + (effect-id (or (and old (etaf--semantic-range-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (range-ref (or (and old (etaf--semantic-range-range-ref old)) + (list 'etaf-range (etaf-runtime-mount-epoch runtime) + semantic-id)))) + (if candidate + (progn + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (cons 'range + (list + (apply #'ebox-child-range range-ref + (copy-sequence + (gethash effect-id + (etaf-runtime-candidate-range-artifacts + runtime))))))) + (if (and old + (not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) + (progn + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (when (etaf-runtime-candidate-full-rebuild-p runtime) + (etaf--runtime-carry-committed-subtree runtime old-generation old)) + (cons 'range + (list + (apply #'ebox-child-range range-ref + (copy-sequence + (gethash (etaf--semantic-range-artifact-key old) + (etaf-runtime-range-artifact-registry + runtime))))))) + (let (deps context-deps value nodes) + (let ((collector + (lambda (source) (cl-pushnew source deps :test #'eq)))) + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq value + (etaf--runtime-normalize-range-value + (funcall (etaf--expr-thunk expr))))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--current-semantic-parent-id semantic-id) + (etaf--current-range-item-index + (and old (etaf--semantic-range-item-identity-index old))) + (etaf--rendering-range-p t) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq nodes (etaf--render-value-list value path)))) + (let* ((item-host-ids + (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime)))) + (all-item-ids + (etaf--runtime-candidate-descendant-ids runtime item-host-ids)) + (item-index (make-hash-table :test #'equal)) + (record + (etaf--semantic-range-create + :semantic-id semantic-id :identity identity :effect-id effect-id + :kind (or kind 'range) + :parent-id etaf--current-semantic-parent-id + :component-id etaf--current-component-semantic-id + :token token :range-ref range-ref :path (copy-tree path) + :caller-style-stack (copy-tree etaf--render-style-stack) + :output-signature (copy-tree value) :deps (nreverse deps) + :context-deps (nreverse context-deps) + :artifact-key (cons (1+ (etaf-runtime-generation runtime)) + effect-id) + :item-host-ids item-host-ids + :item-identity-index item-index))) + (unless (= (length nodes) (length item-host-ids)) + (signal 'etaf-runtime-error + (list "Direct child Range items must be Host Views" + (length nodes) (length item-host-ids)))) + (dolist (item-id all-item-ids) + (let ((item (gethash item-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (unless (etaf--semantic-host-p item) + (signal 'etaf-runtime-error + (list "Direct child Range items must be Host Views"))) + (puthash (etaf--semantic-host-identity item) item-id item-index))) + (when old + (let ((new-set (make-hash-table :test #'eql))) + (dolist (item-id all-item-ids) (puthash item-id t new-set)) + (dolist (old-id + (etaf--runtime-generation-descendant-ids + old-generation + (etaf--semantic-range-item-host-ids old))) + (unless (gethash old-id new-set) + (push old-id + (etaf-runtime-candidate-removed-semantic-ids runtime)))))) + (puthash semantic-id record + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind (or kind 'range) + :semantic-id semantic-id + :deps (etaf--semantic-range-deps record) :target expr) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id nodes + (etaf-runtime-candidate-range-artifacts runtime)) + (cons 'range + (list (apply #'ebox-child-range range-ref nodes))))))))) + +(defun etaf--runtime-render-fragment-range (runtime fragment path) + "Lower material-child FRAGMENT at PATH in RUNTIME as one retained Range." + (let* ((expr (etaf--expr-create + :token (etaf--view-node-token fragment) + :thunk (lambda () (etaf--view-node-children fragment))))) + (etaf--runtime-render-child-range runtime expr path 'fragment))) + +(defun etaf--runtime-evaluate-raw-range (raw) + "Return RAW's resolved public Ebox node and collected dependencies." + (let (deps node) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq node (funcall (etaf--raw-ebox-thunk raw))) + (unless (listp node) + (signal 'etaf-runtime-error + (list "raw-ebox :value must return one public Ebox node"))) + (setq node (copy-tree node)) + (when-let ((key-thunk (etaf--raw-ebox-key-thunk raw))) + (let ((key (funcall key-thunk))) + (etaf--validate-key key) + (setq node (plist-put node :key key))))) + (cl-values node (nreverse deps)))) + +(defun etaf--runtime-render-raw-range (runtime raw path) + "Lower material-child RAW at PATH in RUNTIME as an opaque retained Range." + (let* ((token (etaf--raw-ebox-token raw)) + (identity (list 'raw-range etaf--current-semantic-parent-id + (or token (copy-tree path)))) + (generation (etaf-runtime-current-generation runtime)) + (old-id (and generation + (gethash identity + (etaf-generation-identity-index generation)))) + (old (and old-id + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + old-id))) + (semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime)))) + (effect-id (or (and old (etaf--semantic-range-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (range-ref (or (and old (etaf--semantic-range-range-ref old)) + (list 'etaf-raw-range + (etaf-runtime-mount-epoch runtime) semantic-id)))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (if (and old + (not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) + (progn + (when (etaf-runtime-candidate-full-rebuild-p runtime) + (etaf--runtime-carry-committed-subtree runtime generation old)) + (cons 'range + (list (apply #'ebox-child-range range-ref + (copy-sequence + (gethash (etaf--semantic-range-artifact-key old) + (etaf-runtime-range-artifact-registry + runtime))))))) + (cl-multiple-value-bind (node deps) + (etaf--runtime-evaluate-raw-range raw) + (let ((record + (etaf--semantic-range-create + :semantic-id semantic-id :identity identity :effect-id effect-id + :kind 'raw :parent-id etaf--current-semantic-parent-id + :component-id etaf--current-component-semantic-id + :token token :range-ref range-ref :path (copy-tree path) + :caller-style-stack nil :output-signature (copy-tree node) + :deps deps + :artifact-key (cons (1+ (etaf-runtime-generation runtime)) + effect-id) + :item-host-ids nil + :item-identity-index (make-hash-table :test #'equal)))) + (puthash semantic-id record + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'raw :semantic-id semantic-id + :deps deps :target raw) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id (list node) + (etaf-runtime-candidate-range-artifacts runtime)) + (cons 'range (list (ebox-child-range range-ref node)))))))) + +(defun etaf--runtime-render-slot-range (runtime projection path) + "Lower material-child PROJECTION at PATH in RUNTIME as a retained slot Range." + (let* ((name (etaf--slot-projection-name projection)) + (entry (assq name etaf--current-component-slots)) + (content (and entry (cdr entry))) + (provided-p (and entry t)) + (children (if (etaf--slot-content-p content) + (etaf--slot-content-children content) + (or content (etaf--slot-projection-fallback projection)))) + (owner-id (if provided-p + (and (etaf--slot-content-p content) + (etaf--slot-content-owner-component-id content)) + etaf--current-component-semantic-id)) + (consumer-id etaf--current-component-semantic-id) + (style-stack (copy-tree (if provided-p + etaf--render-parent-style-stack + etaf--render-style-stack))) + (token (etaf--slot-projection-token projection)) + (identity (list 'slot-range etaf--current-semantic-parent-id + (or token (copy-tree path)) name)) + (generation (etaf-runtime-current-generation runtime)) + (old-id (and generation + (gethash identity (etaf-generation-identity-index generation)))) + (old (and old-id + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + old-id))) + (old-effect + (and old + (etaf--pvec-get (etaf-generation-effect-map generation) + (etaf--semantic-slot-range-effect-id old)))) + (candidate (and old-id + (gethash old-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime)))) + (effect-id (or (and old (etaf--semantic-slot-range-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime)))) + (range-ref (or (and old (etaf--semantic-slot-range-range-ref old)) + (list 'etaf-slot-range (etaf-runtime-mount-epoch runtime) + semantic-id))) + (target (list :children children :owner-id owner-id + :owner-input + (etaf--runtime-component-env-signature runtime owner-id) + :consumer-id consumer-id :style-stack style-stack))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child + runtime etaf--current-semantic-parent-id semantic-id) + (cond + (candidate + (cons 'range + (list (apply #'ebox-child-range range-ref + (copy-sequence + (gethash effect-id + (etaf-runtime-candidate-range-artifacts runtime))))))) + ((and old + (equal-including-properties + target (etaf--generation-effect-target old-effect)) + (not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) + (when (etaf-runtime-candidate-full-rebuild-p runtime) + (etaf--runtime-carry-committed-subtree runtime generation old)) + (cons 'range + (list (apply #'ebox-child-range range-ref + (copy-sequence + (gethash (etaf--semantic-slot-range-artifact-key old) + (etaf-runtime-range-artifact-registry runtime))))))) + (t + (cl-multiple-value-bind (value deps nodes context-deps) + (etaf--runtime-evaluate-slot-target + runtime target semantic-id + (and old (etaf--semantic-slot-range-item-identity-index old)) path) + (let ((result + (etaf--runtime-finish-slot-range-candidate + runtime generation old identity semantic-id effect-id range-ref + name token owner-id consumer-id style-stack path target + value deps nodes context-deps))) + (when old + (let ((candidate-range + (gethash semantic-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (unless (equal-including-properties + (etaf--semantic-slot-range-output-signature old) + (etaf--semantic-slot-range-output-signature + candidate-range)) + (push (list old candidate-range + (copy-sequence + (gethash + (etaf--semantic-slot-range-artifact-key old) + (etaf-runtime-range-artifact-registry runtime))) + nodes) + (etaf-runtime-candidate-eager-range-changes runtime)) + (etaf--runtime-invalidate-semantic-ancestors + runtime (etaf--semantic-slot-range-parent-id old)) + (etaf--runtime-record-slot-owner-update runtime old)))) + result)))))) + +(defun etaf--runtime-finish-slot-range-candidate + (runtime generation old identity semantic-id effect-id range-ref + name token owner-id consumer-id style-stack path target + value deps nodes context-deps) + "Finish GENERATION slot Range candidate in RUNTIME. +The candidate uses resolved VALUE, DEPS, and NODES." + (let* ((item-host-ids + (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime)))) + (all-item-ids + (etaf--runtime-candidate-descendant-ids runtime item-host-ids)) + (item-index (make-hash-table :test #'equal)) + (record + (etaf--semantic-slot-range-create + :semantic-id semantic-id :identity identity :effect-id effect-id + :parent-id etaf--current-semantic-parent-id + :owner-component-id owner-id :consumer-component-id consumer-id + :token token :name name :range-ref range-ref :path (copy-tree path) + :style-stack (copy-tree style-stack) + :output-signature (copy-tree value) :deps deps + :context-deps context-deps + :artifact-key (cons (1+ (etaf-runtime-generation runtime)) effect-id) + :item-host-ids item-host-ids :item-identity-index item-index))) + (dolist (item-id all-item-ids) + (let ((item (gethash item-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (unless (etaf--semantic-host-p item) + (signal 'etaf-runtime-error + (list "Slot Range items require Step4b Host/string output"))) + (puthash (etaf--semantic-host-identity item) item-id item-index))) + (when old + (let ((new-set (make-hash-table :test #'eql))) + (dolist (item-id all-item-ids) (puthash item-id t new-set)) + (dolist (old-item-id + (etaf--runtime-generation-descendant-ids + generation (etaf--semantic-slot-range-item-host-ids old))) + (unless (gethash old-item-id new-set) + (push old-item-id + (etaf-runtime-candidate-removed-semantic-ids runtime)))))) + (puthash semantic-id record (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'slot :semantic-id semantic-id + :deps deps :target target) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id nodes (etaf-runtime-candidate-range-artifacts runtime)) + (cons 'range (list (apply #'ebox-child-range range-ref nodes))))) + +(defun etaf--runtime-evaluate-slot-target + (runtime target semantic-id old-item-index path) + "Evaluate slot TARGET for RUNTIME SEMANTIC-ID and return its candidate data." + (let (deps context-deps value nodes) + (let ((collector (lambda (source) (cl-pushnew source deps :test #'eq))) + (owner-id (plist-get target :owner-id))) + (etaf--runtime-call-with-component-env + runtime owner-id + (lambda () + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq value + (etaf--runtime-normalize-range-value + (plist-get target :children))) + (let ((etaf--render-style-stack + (copy-tree (plist-get target :style-stack)))) + (setq value (etaf--runtime-style-range-value value path)))) + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--render-runtime runtime) + (etaf--current-semantic-parent-id semantic-id) + (etaf--current-range-item-index old-item-index) + (etaf--rendering-range-p t) + (etaf--render-style-stack + (copy-tree (plist-get target :style-stack))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq nodes (etaf--render-value-list value path)))))) + (cl-values value (nreverse deps) nodes (nreverse context-deps)))) + +(defun etaf--runtime-style-range-value (value path) + "Apply active Component style scopes to normalized Range VALUE at PATH." + (cl-loop for item in value for index from 0 collect + (if (etaf--view-node-p item) + (let ((styled + (etaf--runtime-style-node + item (append path (list index))))) + (setf (etaf--view-node-children styled) + (etaf--runtime-style-range-value + (etaf--view-node-children styled) + (append path (list index)))) + styled) + item))) + +(defun etaf--runtime-normalize-range-value (value) + "Return Host/string RANGE VALUE with nested expr sites eagerly resolved." + (cond + ((null value) nil) + ((stringp value) (list value)) + ((etaf--expr-p value) + (etaf--runtime-normalize-range-value (funcall (etaf--expr-thunk value)))) + ((etaf--view-node-p value) + (if (eq (etaf--view-node-name value) 'fragment) + (cl-mapcan #'etaf--runtime-normalize-range-value + (etaf--view-node-children value)) + (let ((copy (copy-sequence value))) + (setf (etaf--view-node-children copy) + (cl-mapcan #'etaf--runtime-normalize-range-value + (etaf--view-node-children value))) + (list copy)))) + ((proper-list-p value) + (cl-mapcan #'etaf--runtime-normalize-range-value value)) + (t + (signal 'etaf-runtime-error + (list "Direct material expr requires Step4b output"))))) + +(defun etaf--runtime-candidate-descendant-ids (runtime roots) + "Return ROOTS and all candidate semantic descendants in RUNTIME." + (let ((queue (copy-sequence roots)) result) + (while queue + (let ((semantic-id (pop queue))) + (push semantic-id result) + (setq queue + (nconc queue + (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime))))))) + (nreverse result))) + +(defun etaf--runtime-generation-descendant-ids (generation roots) + "Return ROOTS and all committed semantic descendants in GENERATION." + (let ((queue (copy-sequence roots)) result) + (while queue + (let ((semantic-id (pop queue))) + (push semantic-id result) + (setq queue + (nconc queue + (copy-sequence + (etaf--pvec-get + (etaf-generation-children-table generation) + semantic-id)))))) + (nreverse result))) + +(defun etaf--runtime-inline-value-string (value surface) + "Resolve inline VALUE to one string under inherited SURFACE properties." + (cond + ((null value) "") + ((stringp value) + (etaf--apply-inline-surface-properties value surface)) + ((etaf--expr-p value) + (etaf--runtime-inline-value-string + (funcall (etaf--expr-thunk value)) surface)) + ((etaf--view-node-p value) + (unless (eq (etaf--view-node-name value) 'text) + (signal 'etaf-runtime-error + (list "Inline expr requires Step4b non-text output"))) + (let* ((props (etaf--resolve-property-plist + (etaf--view-node-props value))) + (inner (etaf--inline-text-surface-properties props)) + (content + (mapconcat + (lambda (child) + (etaf--runtime-inline-value-string child inner)) + (etaf--view-node-children value) ""))) + (etaf--apply-inline-surface-properties content surface))) + ((proper-list-p value) + (mapconcat (lambda (item) + (etaf--runtime-inline-value-string item surface)) + value "")) + (t (signal 'etaf-runtime-error + (list "Inline expr requires Step4b output"))))) + +(defun etaf--runtime-render-inline-range + (runtime host-id expr path surface) + "Create or reuse one inline EXPR Range owned by HOST-ID in RUNTIME." + (let* ((token (etaf--expr-token expr)) + (identity (list 'inline-range host-id (or token (copy-tree path)))) + (generation (etaf-runtime-current-generation runtime)) + (old-id (and generation + (gethash identity (etaf-generation-identity-index generation)))) + (old (and old-id + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + old-id))) + (candidate (and old-id + (gethash old-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (semantic-id (or old-id (cl-incf (etaf-runtime-next-semantic-id runtime)))) + (effect-id (or (and old (etaf--semantic-inline-range-effect-id old)) + (cl-incf (etaf-runtime-next-effect-id runtime))))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (etaf--runtime-candidate-add-child runtime host-id semantic-id) + (if candidate + (cons semantic-id (etaf--semantic-inline-range-output candidate)) + (if (and old (not etaf--rendering-component-effect-p) + (not (gethash effect-id (etaf-runtime-dirty-effect-ids runtime)))) + (progn + (when (etaf-runtime-candidate-full-rebuild-p runtime) + (etaf--runtime-carry-committed-subtree runtime generation old)) + (cons semantic-id (etaf--semantic-inline-range-output old))) + (let (deps context-deps output) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq output + (etaf--runtime-inline-value-string + (funcall (etaf--expr-thunk expr)) surface))) + (let ((record + (etaf--semantic-inline-range-create + :semantic-id semantic-id :identity identity :effect-id effect-id + :parent-id host-id :component-id etaf--current-component-semantic-id + :token token :path (copy-tree path) + :surface-properties (copy-tree surface) + :output (copy-sequence output) :deps (nreverse deps) + :context-deps (nreverse context-deps)))) + (puthash semantic-id record + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'inline + :semantic-id semantic-id :deps (etaf--semantic-inline-range-deps record) + :target expr) + (etaf-runtime-candidate-effects runtime)) + (when (and old + (not (equal-including-properties + (etaf--semantic-inline-range-output old) output))) + (cl-pushnew host-id + (etaf-runtime-candidate-inline-host-ids runtime) + :test #'eql) + (etaf--runtime-invalidate-semantic-ancestors runtime host-id) + (when-let ((component + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--semantic-inline-range-component-id old)))) + (cl-pushnew (etaf--semantic-component-identity component) + (etaf-runtime-candidate-updated-component-identities + runtime) + :test #'equal))) + (cons semantic-id output))))))) + +(defun etaf--runtime-render-inline-content + (runtime host-id values path &optional surface) + "Return resolved inline content and semantic parts for HOST-ID in RUNTIME." + (let (parts strings) + (cl-labels + ((walk + (value current-path inherited) + (cond + ((null value) nil) + ((stringp value) + (let ((text (etaf--apply-inline-surface-properties value inherited))) + (push text parts) (push text strings))) + ((etaf--expr-p value) + (let ((entry (etaf--runtime-render-inline-range + runtime host-id value current-path inherited))) + (push (car entry) parts) (push (cdr entry) strings))) + ((etaf--view-node-p value) + (unless (eq (etaf--view-node-name value) 'text) + (signal 'etaf-runtime-error + (list "Inline text requires Step4b Host output"))) + (let* ((props (etaf--resolve-property-plist + (etaf--view-node-props value))) + (inner (append (etaf--inline-text-surface-properties props) + inherited)) + (index 0)) + (dolist (child (etaf--view-node-children value)) + (walk child (append current-path (list index)) inner) + (cl-incf index)))) + ((proper-list-p value) + (let ((index 0)) + (dolist (item value) + (walk item (append current-path (list index)) inherited) + (cl-incf index)))) + (t (signal 'etaf-runtime-error + (list "Inline text requires Step4b output")))))) + (walk values path surface)) + (list (apply #'concat (nreverse strings)) (nreverse parts)))) (defun etaf--runtime-style-node (node path) "Apply active Component style scopes to NODE at structural PATH." @@ -344,33 +2605,49 @@ when the requested boundary is no longer mounted." (dolist (instance (etaf-runtime-candidate-created runtime)) (remhash (etaf--component-instance-identity instance) (etaf-runtime-instances runtime)) + (remhash (etaf--component-instance-resource-key instance) + (etaf-runtime-resource-registry runtime)) (etaf--runtime-dispose-instance instance nil)) (dolist (entry (etaf-runtime-candidate-old-instances runtime)) (puthash (car entry) (cadr entry) (etaf-runtime-instances runtime))) - (dolist (snapshot (etaf-runtime-candidate-snapshots runtime)) - (let ((instance (cadr snapshot))) - (setf (etaf--component-instance-props instance) (nth 2 snapshot) - (etaf--component-instance-slots instance) (nth 3 snapshot) - (etaf--component-instance-render-function instance) - (nth 4 snapshot)))) runtime) (defun etaf--runtime-clear-candidate (runtime) "Clear transient candidate bookkeeping in RUNTIME." (setf (etaf-runtime-candidate-created runtime) nil - (etaf-runtime-candidate-snapshots runtime) nil (etaf-runtime-candidate-old-instances runtime) nil - (etaf-runtime-seen runtime) nil + (etaf-runtime-candidate-live runtime) nil + (etaf-runtime-candidate-semantic-nodes runtime) nil + (etaf-runtime-candidate-component-envs runtime) nil + (etaf-runtime-candidate-graph-nodes runtime) nil + (etaf-runtime-candidate-identity-entries runtime) nil + (etaf-runtime-candidate-graph-children runtime) nil + (etaf-runtime-candidate-removed-semantic-ids runtime) nil + (etaf-runtime-candidate-removed-effect-ids runtime) nil + (etaf-runtime-candidate-removed-host-refs runtime) nil + (etaf-runtime-candidate-rendered-identities runtime) nil + (etaf-runtime-candidate-updated-component-identities runtime) nil + (etaf-runtime-candidate-artifacts runtime) + (make-hash-table :test #'equal) + (etaf-runtime-candidate-range-artifacts runtime) + (make-hash-table :test #'eql) + (etaf-runtime-candidate-invalidated-artifact-keys runtime) nil + (etaf-runtime-candidate-inline-host-ids runtime) nil + (etaf-runtime-candidate-eager-range-changes runtime) nil + (etaf-runtime-candidate-effects runtime) + (make-hash-table :test #'eql) + (etaf-runtime-candidate-source-deltas runtime) nil (etaf-runtime-candidate-handlers runtime) nil (etaf-runtime-candidate-host-props runtime) nil - (etaf-runtime-candidate-behaviors runtime) nil)) + (etaf-runtime-candidate-behaviors runtime) nil + (etaf-runtime-candidate-behavior-resource-keys runtime) nil)) (defun etaf--runtime-promote (runtime) "Promote RUNTIME's successful candidate and return its lifecycle groups." (let (removed added existing) (maphash (lambda (identity instance) - (if (gethash identity (etaf-runtime-seen runtime)) + (if (gethash identity (etaf-runtime-candidate-live runtime)) (if (etaf--component-instance-mounted-p instance) (push instance existing) (push instance added)) @@ -383,6 +2660,8 @@ when the requested boundary is no longer mounted." (length (etaf--component-instance-identity right)))))) (remhash (etaf--component-instance-identity instance) (etaf-runtime-instances runtime)) + (remhash (etaf--component-instance-resource-key instance) + (etaf-runtime-resource-registry runtime)) (etaf--runtime-dispose-instance instance t)) (dolist (entry (etaf-runtime-candidate-old-instances runtime)) (etaf--runtime-dispose-instance (cadr entry) t)) @@ -406,47 +2685,1494 @@ when the requested boundary is no longer mounted." (defun etaf--runtime-begin-candidate (runtime) "Reset candidate bookkeeping before a RUNTIME render." - (setf (etaf-runtime-seen runtime) (make-hash-table :test #'equal) + (setq etaf--rendered-range-container-nodes nil) + (setf (etaf-runtime-candidate-live runtime) (make-hash-table :test #'equal) + (etaf-runtime-candidate-semantic-nodes runtime) + (make-hash-table :test #'equal) + (etaf-runtime-candidate-component-envs runtime) + (make-hash-table :test #'eql) + (etaf-runtime-candidate-graph-nodes runtime) + (make-hash-table :test #'eql) + (etaf-runtime-candidate-identity-entries runtime) + (make-hash-table :test #'equal) + (etaf-runtime-candidate-graph-children runtime) + (make-hash-table :test #'eql) + (etaf-runtime-candidate-removed-semantic-ids runtime) nil + (etaf-runtime-candidate-removed-effect-ids runtime) nil + (etaf-runtime-candidate-removed-host-refs runtime) nil + (etaf-runtime-candidate-rendered-identities runtime) nil + (etaf-runtime-candidate-updated-component-identities runtime) nil + (etaf-runtime-candidate-effects runtime) (make-hash-table :test #'eql) + (etaf-runtime-candidate-generation-metrics runtime) + (etaf--generation-metrics-create) + (etaf-runtime-candidate-full-rebuild-p runtime) nil + (etaf-runtime-candidate-invalidated-artifact-keys runtime) nil + (etaf-runtime-candidate-inline-host-ids runtime) nil + (etaf-runtime-candidate-eager-range-changes runtime) nil + (etaf-runtime-candidate-root-deps runtime) + (and (etaf-runtime-current-generation runtime) + (copy-sequence + (etaf--pvec-get + (etaf-generation-effect-sources + (etaf-runtime-current-generation runtime)) + (etaf-runtime-root-effect-id runtime)))) (etaf-runtime-candidate-created runtime) nil - (etaf-runtime-candidate-snapshots runtime) nil (etaf-runtime-candidate-old-instances runtime) nil (etaf-runtime-candidate-handlers runtime) (make-hash-table :test #'equal) (etaf-runtime-candidate-host-props runtime) (make-hash-table :test #'equal) (etaf-runtime-candidate-behaviors runtime) + (make-hash-table :test #'equal) + (etaf-runtime-candidate-behavior-resource-keys runtime) (make-hash-table :test #'equal))) -(defun etaf--runtime-render-root (runtime) - "Evaluate and lower RUNTIME's root View." +(defun etaf--runtime-evaluate-root (runtime) + "Evaluate RUNTIME's root View without lowering Components." (let ((root-view (etaf-runtime-root-view runtime))) + (if (functionp root-view) (funcall root-view) root-view))) + +(defun etaf--runtime-render-root (runtime) + "Lower RUNTIME's cached root View." + (let ((etaf--current-semantic-parent-id + (etaf-runtime-root-range-id runtime))) (etaf--render-value-list - (if (functionp root-view) (funcall root-view) root-view) - '(root)))) + (etaf-runtime-root-view-cache runtime) '(root)))) + +(defun etaf--runtime-stage-root-range (runtime deps) + "Stage RUNTIME's nonvisual semantic Root Range with DEPS." + (let* ((semantic-id (etaf-runtime-root-range-id runtime)) + (identity (list 'root-range (etaf-runtime-mount-epoch runtime))) + (children (copy-sequence + (gethash semantic-id + (etaf-runtime-candidate-graph-children runtime)))) + (record + (etaf--semantic-range-create + :semantic-id semantic-id :identity identity + :effect-id (etaf-runtime-root-effect-id runtime) :kind 'root + :parent-id 0 :component-id nil :token 'root :range-ref nil + :path '(root) :caller-style-stack nil + :output-signature (copy-tree (etaf-runtime-root-view-cache runtime)) + :deps (copy-sequence deps) :artifact-key nil + :item-host-ids children + :item-identity-index (make-hash-table :test #'equal)))) + (puthash identity semantic-id + (etaf-runtime-candidate-identity-entries runtime)) + (puthash semantic-id record + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash 0 (list semantic-id) + (etaf-runtime-candidate-graph-children runtime)))) + +(defun etaf--runtime-build-generation (runtime &optional base) + "Build RUNTIME generation, point-copying candidate owners from BASE." + (let* ((full-p (or (null base) (etaf-runtime-root-dirty-p runtime))) + (generation-id (1+ (etaf-runtime-generation runtime))) + (metrics (or (etaf-runtime-candidate-generation-metrics runtime) + (etaf--generation-metrics-create))) + (nodes (and (not full-p) (etaf-generation-semantic-nodes base))) + (effect-map (and (not full-p) (etaf-generation-effect-map base))) + (source-effects (and (not full-p) (etaf-generation-source-effects base))) + (effect-sources (and (not full-p) (etaf-generation-effect-sources base))) + (resources (and (not full-p) (etaf-generation-resource-membership base))) + (parent-index (and (not full-p) (etaf-generation-parent-table base))) + (children-index (and (not full-p) (etaf-generation-children-table base))) + (identity-index (if (not full-p) + (etaf-generation-identity-index base) + (make-hash-table :test #'equal))) + (identity-copy nil) + (affected-sources (make-hash-table :test #'eq)) + deltas + node-updates parent-updates children-updates resource-updates) + (cl-labels + ((install-effect + (effect old-deps new-deps) + (let ((effect-id (etaf--generation-effect-effect-id effect))) + (setq effect-map + (etaf--pvec-put effect-map effect-id effect metrics) + effect-sources + (etaf--pvec-put effect-sources effect-id + (copy-sequence new-deps) metrics)) + (dolist (source (cl-delete-duplicates + (append (copy-sequence old-deps) + (copy-sequence new-deps)) + :test #'eq)) + (puthash source t affected-sources) + (let* ((source-id (etaf-reactive-source-id source)) + (current-effects + (copy-sequence + (etaf--pvec-get source-effects source-id + metrics 'source))) + (new-effects (delq effect-id current-effects))) + (when (memq source new-deps) + (setq new-effects + (sort (cons effect-id new-effects) #'<))) + (unless (equal current-effects new-effects) + (setq source-effects + (etaf--pvec-put source-effects source-id + new-effects metrics))))))) + (remove-effect + (effect-id) + (when-let ((old-effect + (and effect-map + (etaf--pvec-get effect-map effect-id metrics + 'effect)))) + (let ((deps (etaf--generation-effect-deps old-effect))) + (setq effect-map + (etaf--pvec-put effect-map effect-id nil metrics) + effect-sources + (etaf--pvec-put effect-sources effect-id nil metrics)) + (dolist (source deps) + (puthash source t affected-sources) + (let* ((source-id (etaf-reactive-source-id source)) + (current-effects + (copy-sequence + (etaf--pvec-get source-effects source-id metrics + 'source))) + (new-effects (delq effect-id current-effects))) + (unless (equal current-effects new-effects) + (setq source-effects + (etaf--pvec-put source-effects source-id + new-effects metrics)))))))) + (semantic-effect-ids + (semantic) + (cond + ((etaf--semantic-component-p semantic) + (delq nil + (list (etaf--semantic-component-input-effect-id semantic) + (etaf--semantic-component-effect-id semantic)))) + ((etaf--semantic-range-p semantic) + (list (etaf--semantic-range-effect-id semantic))) + ((etaf--semantic-slot-range-p semantic) + (list (etaf--semantic-slot-range-effect-id semantic))) + ((etaf--semantic-inline-range-p semantic) + (list (etaf--semantic-inline-range-effect-id semantic))) + (t nil)))) + (when full-p + (maphash (lambda (source _) (puthash source t affected-sources)) + (etaf-runtime-route-sources runtime))) + (maphash + (lambda (identity candidate) + (let* ((semantic (copy-sequence candidate)) + (semantic-id (etaf--semantic-component-semantic-id semantic)) + (effect-id (etaf--semantic-component-effect-id semantic)) + (resource-id + (cdr (etaf--semantic-component-resource-key semantic)))) + (when (gethash effect-id (etaf-runtime-candidate-artifacts runtime)) + (setf (etaf--semantic-component-artifact-key semantic) + (cons generation-id effect-id))) + (push (cons semantic-id semantic) node-updates) + (push (cons semantic-id + (etaf--semantic-component-parent-id semantic)) + parent-updates) + (push (cons semantic-id + (copy-sequence + (etaf--semantic-component-child-ids semantic))) + children-updates) + (unless (gethash identity identity-index) + (unless identity-copy + (setq identity-index (copy-hash-table identity-index) + identity-copy t)) + (puthash (copy-tree identity) semantic-id identity-index)) + (unless (and (not full-p) + (etaf--pvec-get resources resource-id)) + (push (cons resource-id + (etaf--semantic-component-resource-key semantic)) + resource-updates)))) + (etaf-runtime-candidate-semantic-nodes runtime)) + (maphash + (lambda (semantic-id semantic) + (unless (etaf--semantic-component-p semantic) + (push (cons semantic-id semantic) node-updates) + (let ((parent-id + (cond ((etaf--semantic-host-p semantic) + (etaf--semantic-host-parent-id semantic)) + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-parent-id semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-parent-id semantic)) + (t (etaf--semantic-inline-range-parent-id semantic)))) + (child-ids + (cond ((etaf--semantic-host-p semantic) + (etaf--semantic-host-child-ids semantic)) + ((etaf--semantic-range-p semantic) + (etaf--semantic-range-item-host-ids semantic)) + ((etaf--semantic-slot-range-p semantic) + (etaf--semantic-slot-range-item-host-ids semantic)) + (t nil)))) + (push (cons semantic-id parent-id) parent-updates) + (push (cons semantic-id (copy-sequence child-ids)) + children-updates)))) + (etaf-runtime-candidate-graph-nodes runtime)) + (maphash + (lambda (identity _state) + (let ((resource-key + (and (hash-table-p + (etaf-runtime-candidate-behavior-resource-keys runtime)) + (gethash identity + (etaf-runtime-candidate-behavior-resource-keys + runtime))))) + (when resource-key + (push (cons (cdr resource-key) resource-key) + resource-updates)))) + (etaf-runtime-candidate-behaviors runtime)) + (dolist (effect-id (etaf-runtime-candidate-removed-effect-ids runtime)) + (remove-effect effect-id)) + (dolist (semantic-id (etaf-runtime-candidate-removed-semantic-ids runtime)) + (when-let ((old-node (and base + (etaf--pvec-get + (etaf-generation-semantic-nodes base) + semantic-id)))) + ;; A stable identity may be reintroduced in this candidate. In that + ;; case its new effect is installed below; only remove effects for a + ;; semantic node that is absent from the candidate graph. + (unless (gethash semantic-id + (etaf-runtime-candidate-graph-nodes runtime)) + (dolist (effect-id (semantic-effect-ids old-node)) + (remove-effect effect-id))) + (when (and (etaf--semantic-host-p old-node) + (etaf--semantic-host-host-ref old-node)) + (let ((host-ref (etaf--semantic-host-host-ref old-node))) + ;; A dirty Component may remove and recreate the same stable + ;; Host address in one candidate. The new contribution wins; + ;; do not leave a removal tombstone that shadows it. + (unless (or (gethash host-ref + (etaf-runtime-candidate-host-props runtime)) + (gethash host-ref + (etaf-runtime-candidate-handlers runtime))) + (cl-pushnew host-ref + (etaf-runtime-candidate-removed-host-refs runtime) + :test #'equal))))) + (push (cons semantic-id nil) node-updates) + (push (cons semantic-id nil) parent-updates) + (push (cons semantic-id nil) children-updates)) + (maphash + (lambda (identity semantic-id) + (unless (gethash identity identity-index) + (unless identity-copy + (setq identity-index (copy-hash-table identity-index) + identity-copy t)) + (puthash (copy-tree identity) semantic-id identity-index))) + (etaf-runtime-candidate-identity-entries runtime)) + (maphash + (lambda (effect-id effect) + (let ((old (and base + (etaf--pvec-get + (etaf-generation-effect-map base) + effect-id metrics 'effect)))) + (install-effect effect + (and old (etaf--generation-effect-deps old)) + (etaf--generation-effect-deps effect)))) + (etaf-runtime-candidate-effects runtime)) + (when full-p + (let* ((effect-id (etaf-runtime-root-effect-id runtime)) + (old-deps (and base + (etaf--pvec-get + (etaf-generation-effect-sources base) effect-id))) + (new-deps (etaf-runtime-candidate-root-deps runtime)) + (root (etaf--semantic-root-create + :semantic-id 0 :effect-id effect-id + :input-signature + (copy-tree (etaf-runtime-root-view-cache runtime)) + :deps (copy-sequence new-deps)))) + (push (cons 0 root) node-updates) + (push (cons 0 + (copy-sequence + (gethash 0 + (etaf-runtime-candidate-graph-children runtime)))) + children-updates) + (install-effect + (etaf--generation-effect-create + :effect-id effect-id :kind 'root + :semantic-id (etaf-runtime-root-range-id runtime) :deps new-deps) + old-deps new-deps))) + ;; Apply all semantic/index membership edits in one trie batch. The + ;; candidate remains immutable; only the number of copied persistent + ;; vector spines changes. + (setq nodes + (etaf--pvec-put-many nodes node-updates metrics) + parent-index + (etaf--pvec-put-many parent-index parent-updates metrics) + children-index + (etaf--pvec-put-many children-index children-updates metrics) + resources + (etaf--pvec-put-many resources resource-updates metrics)) + (maphash + (lambda (source _) + (let ((old-effects + (and base + (etaf--pvec-get (etaf-generation-source-effects base) + (etaf-reactive-source-id source)))) + (new-effects + (etaf--pvec-get source-effects + (etaf-reactive-source-id source)))) + (unless (equal old-effects new-effects) + (push (list source old-effects new-effects) deltas)))) + affected-sources) + (setf (etaf-runtime-candidate-source-deltas runtime) (nreverse deltas) + (etaf-runtime-candidate-generation-metrics runtime) metrics) + (let ((generation + (etaf--generation-create + :generation-id generation-id + :root-semantic-id 0 + :semantic-nodes nodes + :effect-map effect-map + :source-effects source-effects + :effect-sources effect-sources + :parent-table parent-index + :children-table children-index + :resource-membership resources + :identity-index identity-index + :indexes (etaf--runtime-build-contribution-indexes + runtime base full-p)))) + (etaf--generation-validate-context-acyclic generation))))) + +(defun etaf--runtime-prearm-generation (runtime generation) + "Prearm RUNTIME GENERATION sources and return the new-source journal." + (ignore generation) + (let ((route (etaf-runtime-route-token runtime)) journal completed) + (unwind-protect + (progn + (dolist (delta (etaf-runtime-candidate-source-deltas runtime)) + (let ((source (car delta)) (new-effects (nth 2 delta))) + (when (and new-effects + (not (gethash route + (etaf--source-subscribers source)))) + (push source journal) + (puthash route t (etaf--source-subscribers source)) + (puthash source t (etaf-runtime-route-sources runtime))))) + (setq completed t) + journal) + (unless completed + (etaf--runtime-rollback-prearm runtime journal))))) + +(defun etaf--runtime-rollback-prearm (runtime journal) + "Remove RUNTIME route from every newly prearmed source in JOURNAL." + (dolist (source journal) + (remhash (etaf-runtime-route-token runtime) + (etaf--source-subscribers source)) + (remhash source (etaf-runtime-route-sources runtime)))) + +(defun etaf--runtime-complete-generation (runtime old generation) + "Complete RUNTIME from OLD through GENERATION and prune obsolete routes." + (when-let ((focus-ref (etaf-runtime-focus-ref runtime))) + (let ((props (etaf--generation-index-lookup + generation 'host-props focus-ref))) + (unless (and (numberp (plist-get props :tab-index)) + (>= (plist-get props :tab-index) 0) + (not (plist-get props :disabled))) + (setf (etaf-runtime-focus-ref runtime) nil)))) + (maphash + (lambda (_identity semantic) + (when-let ((instance + (gethash (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime)))) + (setf (etaf--component-instance-context instance) + (etaf--semantic-component-context-frame semantic)))) + (etaf-runtime-candidate-semantic-nodes runtime)) + (dolist (instance (etaf-runtime-candidate-created runtime)) + (puthash (etaf--component-instance-identity instance) instance + (etaf-runtime-instances runtime))) + (maphash + (lambda (effect-id _artifact) + (when-let* ((old-semantic (and old + (etaf--generation-effect-semantic + old effect-id))) + (new-semantic + (etaf--generation-effect-semantic generation effect-id)) + (old-key (etaf--semantic-component-artifact-key old-semantic))) + (unless (equal old-key + (etaf--semantic-component-artifact-key new-semantic)) + (let ((inhibit-quit t) (quit-flag nil)) + (condition-case nil + (remhash old-key (etaf-runtime-artifact-registry runtime)) + ((error quit) nil)))))) + (etaf-runtime-candidate-artifacts runtime)) + (maphash + (lambda (effect-id _artifact) + (when-let* ((old-range (and old + (etaf--generation-effect-semantic + old effect-id))) + (new-range + (etaf--generation-effect-semantic generation effect-id)) + (old-key (and old-range + (etaf--semantic-backend-range-artifact-key + old-range)))) + (unless (equal old-key + (etaf--semantic-backend-range-artifact-key new-range)) + (remhash old-key (etaf-runtime-range-artifact-registry runtime))))) + (etaf-runtime-candidate-range-artifacts runtime)) + (dolist (key (etaf-runtime-candidate-invalidated-artifact-keys runtime)) + (remhash key (etaf-runtime-artifact-registry runtime))) + (dolist (delta (etaf-runtime-candidate-source-deltas runtime)) + (let ((source (car delta)) (effects (nth 2 delta))) + (when (null effects) + (remhash (etaf-runtime-route-token runtime) + (etaf--source-subscribers source)) + (remhash source (etaf-runtime-route-sources runtime)))))) + +(defun etaf--runtime-swap-generation (runtime old candidate) + "Swap RUNTIME from OLD to CANDIDATE with an exact authority guard." + (unless (eq (etaf-runtime-current-generation runtime) old) + (error "ETAF generation authority changed during publication")) + (setf (etaf-runtime-current-generation runtime) candidate)) + +(defun etaf--runtime-rollback-generation (runtime old candidate) + "Idempotently restore OLD when RUNTIME still points at CANDIDATE." + (when (eq (etaf-runtime-current-generation runtime) candidate) + (setf (etaf-runtime-current-generation runtime) old))) + +(defun etaf--runtime-preinstall-resources (runtime generation) + "Install RUNTIME resources/artifacts for GENERATION and return journal." + (let (journal completed) + (unwind-protect + (progn + (dolist (instance (etaf-runtime-candidate-created runtime)) + (let ((key (etaf--component-instance-resource-key instance))) + (push (list 'resource key instance) journal) + (puthash key instance (etaf-runtime-resource-registry runtime)))) + (when (and (hash-table-p + (etaf-runtime-candidate-behavior-resource-keys runtime)) + (hash-table-p + (etaf-runtime-candidate-behaviors runtime))) + (maphash + (lambda (identity resource-key) + (let ((state (gethash identity + (etaf-runtime-candidate-behaviors runtime)))) + (when (and resource-key state + (not (eq state + (gethash resource-key + (etaf-runtime-resource-registry + runtime))))) + (push (list 'behavior-resource resource-key state) journal) + (puthash resource-key state + (etaf-runtime-resource-registry runtime))))) + (etaf-runtime-candidate-behavior-resource-keys runtime))) + (maphash + (lambda (effect-id artifact) + (when-let ((semantic + (etaf--generation-effect-semantic + generation effect-id))) + (let ((key (etaf--semantic-component-artifact-key semantic))) + (push (list 'artifact key artifact) journal) + (puthash key artifact + (etaf-runtime-artifact-registry runtime))))) + (etaf-runtime-candidate-artifacts runtime)) + (maphash + (lambda (effect-id artifact) + (when-let ((range + (etaf--generation-effect-semantic + generation effect-id))) + (let ((key (etaf--semantic-backend-range-artifact-key range))) + (push (list 'range-artifact key artifact) journal) + (puthash key artifact + (etaf-runtime-range-artifact-registry runtime))))) + (etaf-runtime-candidate-range-artifacts runtime)) + (setq completed t) + journal) + (unless completed + (etaf--runtime-rollback-resource-journal runtime journal))))) + +(defun etaf--runtime-rollback-resource-journal (runtime journal) + "Remove RUNTIME resources still owned by failed JOURNAL entries." + (dolist (entry journal) + (pcase (car entry) + ('resource + (when (eq (gethash (nth 1 entry) + (etaf-runtime-resource-registry runtime)) + (nth 2 entry)) + (remhash (nth 1 entry) (etaf-runtime-resource-registry runtime)))) + ('behavior-resource + (when (eq (gethash (nth 1 entry) + (etaf-runtime-resource-registry runtime)) + (nth 2 entry)) + (remhash (nth 1 entry) (etaf-runtime-resource-registry runtime)))) + ('artifact + (when (eq (gethash (nth 1 entry) + (etaf-runtime-artifact-registry runtime)) + (nth 2 entry)) + (remhash (nth 1 entry) (etaf-runtime-artifact-registry runtime)))) + ('range-artifact + (when (eq (gethash (nth 1 entry) + (etaf-runtime-range-artifact-registry runtime)) + (nth 2 entry)) + (remhash (nth 1 entry) + (etaf-runtime-range-artifact-registry runtime)))))) + nil) + +(defun etaf--runtime-participant-publish (participant) + "Publish PARTICIPANT generation, restoring old authority on any failure." + (let ((success nil) + (runtime (etaf--generation-participant-runtime participant)) + (old (etaf--generation-participant-old participant)) + (candidate (etaf--generation-participant-candidate participant))) + (unwind-protect + (progn + (etaf--runtime-swap-generation runtime old candidate) + (setf (etaf--generation-participant-state participant) 'published + success t)) + (unless success + (etaf--runtime-rollback-generation runtime old candidate))) + participant)) + +(defun etaf--runtime-participant-rollback (participant) + "Rollback PARTICIPANT generation exactly and idempotently." + (etaf--runtime-rollback-generation + (etaf--generation-participant-runtime participant) + (etaf--generation-participant-old participant) + (etaf--generation-participant-candidate participant)) + (setf (etaf--generation-participant-state participant) 'rolled-back) + participant) + +(defun etaf--runtime-begin-component-overlay (runtime generation) + "Seed RUNTIME candidate tables from committed GENERATION without traversal." + (etaf--runtime-begin-candidate runtime) + (ignore generation) + (setf (etaf-runtime-candidate-behaviors runtime) + (copy-hash-table (etaf-runtime-behaviors runtime)) + (etaf-runtime-candidate-behavior-resource-keys runtime) + (copy-hash-table + (or (etaf-runtime-behavior-resource-keys runtime) + (make-hash-table :test #'equal))))) + +(defun etaf--runtime-evaluate-component-input (runtime semantic) + "Recompute RUNTIME SEMANTIC input and enqueue render only when it differs." + (let* ((generation (etaf-runtime-current-generation runtime)) + (caller-id (etaf--semantic-component-caller-component-id semantic)) + (base-caller + (and caller-id + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + caller-id))) + (caller + (and base-caller + (or (gethash (etaf--semantic-component-identity base-caller) + (etaf-runtime-candidate-semantic-nodes runtime)) + base-caller))) + (instance + (and caller + (gethash (etaf--semantic-component-resource-key caller) + (etaf-runtime-resource-registry runtime)))) + deps) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--current-runtime runtime) + (etaf--current-component-instance instance) + (etaf--current-component-identity + (and caller (etaf--semantic-component-identity caller))) + (etaf--current-component-semantic-id caller-id) + (etaf--current-component-props + (and caller (etaf--semantic-component-props caller))) + (etaf--current-component-slots + (and caller (etaf--semantic-component-slots caller))) + (etaf--current-context + (and caller (etaf--semantic-component-context-frame caller))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (let* ((props (etaf--resolve-property-plist + (etaf--semantic-component-input-props semantic))) + (slots (etaf--semantic-component-input-slots semantic)) + (candidate (copy-sequence semantic)) + (effect-id (etaf--semantic-component-input-effect-id semantic))) + (setf (etaf--semantic-component-props candidate) (copy-tree props) + (etaf--semantic-component-slots candidate) (copy-tree slots) + (etaf--semantic-component-input-deps candidate) (nreverse deps)) + (puthash (etaf--semantic-component-identity semantic) candidate + (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'component-input + :semantic-id (etaf--semantic-component-semantic-id semantic) + :deps (etaf--semantic-component-input-deps candidate)) + (etaf-runtime-candidate-effects runtime)) + (unless (and (etaf--runtime-target-value-equal-p + props (etaf--semantic-component-props semantic)) + (etaf--runtime-target-value-equal-p + slots (etaf--semantic-component-slots semantic))) + (etaf--runtime-enqueue-effect + runtime (etaf--semantic-component-effect-id semantic))))))) + +(defun etaf--runtime-retarget-component-slot-ranges (runtime semantic slots) + "Retarget SEMANTIC projection slot effects to candidate SLOTS in RUNTIME." + (let* ((generation (etaf-runtime-current-generation runtime)) + (descendants + (etaf--runtime-generation-descendant-ids + generation (etaf--semantic-component-child-ids semantic))) + found) + (dolist (semantic-id descendants) + (when-let ((slot-range + (let ((node (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + semantic-id))) + (and (etaf--semantic-slot-range-p node) node)))) + (setq found t) + (let* ((name (etaf--semantic-slot-range-name slot-range)) + (entry (assq name slots)) + (content (and entry (cdr entry))) + (old-effect + (etaf--generation-effect + generation (etaf--semantic-slot-range-effect-id slot-range))) + (old-target (etaf--generation-effect-target old-effect)) + (owner-id + (if entry + (and (etaf--slot-content-p content) + (etaf--slot-content-owner-component-id content)) + (etaf--semantic-slot-range-consumer-component-id slot-range))) + (children + (if entry + (if (etaf--slot-content-p content) + (etaf--slot-content-children content) + content) + (plist-get old-target :children))) + (target + (list :children children :owner-id owner-id + :owner-input + (etaf--runtime-component-env-signature runtime owner-id) + :consumer-id + (etaf--semantic-slot-range-consumer-component-id slot-range) + :style-stack (plist-get old-target :style-stack)))) + (unless (etaf--runtime-target-value-equal-p target old-target) + (let ((effect (copy-sequence old-effect))) + (setf (etaf--generation-effect-target effect) target) + (push (etaf--runtime-render-dirty-slot-range + runtime effect slot-range) + (etaf-runtime-candidate-eager-range-changes runtime))))))) + (when found + (let ((candidate (copy-sequence semantic))) + (setf (etaf--semantic-component-slots candidate) (copy-tree slots) + (etaf--semantic-component-input-slots candidate) (copy-tree slots)) + (puthash (etaf--semantic-component-identity semantic) candidate + (etaf-runtime-candidate-semantic-nodes runtime)))) + found)) + +(defun etaf--runtime-render-dirty-component (runtime semantic) + "Render one input-ready SEMANTIC into RUNTIME candidate." + (let* ((identity (etaf--semantic-component-identity semantic)) + (effect-id (etaf--semantic-component-effect-id semantic)) + (committed + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + (etaf--semantic-component-semantic-id semantic))) + (instance (gethash (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime))) + (parent-id (etaf--semantic-component-parent-id semantic)) + (parent-record + (and parent-id + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + parent-id))) + (parent (and (etaf--semantic-component-p parent-record) + (etaf--semantic-component-identity parent-record))) + (props (etaf--semantic-component-props semantic)) + (slots (etaf--semantic-component-slots semantic)) + deps context-deps result) + (puthash (etaf--semantic-component-semantic-id semantic) + (list :identity identity :instance instance :props props :slots slots) + (etaf-runtime-candidate-component-envs runtime)) + (let ((etaf--current-component-identity parent) + (etaf--current-component-semantic-id + (etaf--semantic-component-semantic-id semantic)) + (etaf--current-semantic-parent-id + (etaf--semantic-component-semantic-id semantic)) + (etaf--render-style-stack + (copy-tree (etaf--semantic-component-caller-style-stack semantic))) + (etaf--render-parent-style-stack nil) + (etaf--rendering-component-effect-p t) + (etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq result + (etaf--runtime-render-component-resource + runtime instance identity + props slots + (etaf--semantic-component-path semantic) + (etaf--semantic-component-output-range-id committed) + (etaf--semantic-component-publication-kind committed) + (etaf--runtime-context-frame-for-candidate runtime committed)))) + (let* ((transparent-p (eq (nth 5 result) 'transparent)) + (output-range + (and transparent-p + (etaf--runtime-stage-component-output-range + runtime committed + (etaf--semantic-component-semantic-id semantic) + effect-id (nth 6 result) (nth 2 result) (nth 4 result) + (etaf--semantic-component-path semantic)))) + (publication-node (if transparent-p (cadr output-range) + (car result))) + (candidate (copy-sequence semantic))) + (setf (etaf--semantic-component-output-signature candidate) + (copy-tree (nth 2 result)) + (etaf--semantic-component-props candidate) (copy-tree props) + (etaf--semantic-component-slots candidate) (copy-tree slots) + (etaf--semantic-component-deps candidate) (nreverse deps) + (etaf--semantic-component-raw-slot-reader-p candidate) (nth 3 result) + (etaf--semantic-component-publication-kind candidate) + (if transparent-p 'transparent 'material) + (etaf--semantic-component-output-range-id candidate) + (and transparent-p + (etaf--semantic-range-semantic-id (car output-range))) + (etaf--semantic-component-output-range-ref candidate) + (and transparent-p + (etaf--semantic-range-range-ref (car output-range))) + (etaf--semantic-component-context-frame candidate) + (etaf-context-copy (nth 7 result)) + (etaf--semantic-component-context-deps candidate) + (nreverse context-deps) + (etaf--semantic-component-child-ids candidate) + (copy-sequence + (gethash (etaf--semantic-component-semantic-id semantic) + (etaf-runtime-candidate-graph-children runtime)))) + (etaf--runtime-enqueue-context-consumers + runtime (etaf--semantic-component-semantic-id semantic) + (etaf--semantic-component-context-frame committed) + (etaf--semantic-component-context-frame candidate)) + (let ((new-direct (make-hash-table :test #'eql))) + (dolist (id (etaf--semantic-component-child-ids candidate)) + (puthash id t new-direct)) + (dolist (old-root (etaf--semantic-component-child-ids committed)) + (unless (gethash old-root new-direct) + (dolist (old-id + (etaf--runtime-generation-descendant-ids + (etaf-runtime-current-generation runtime) + (list old-root))) + (cl-pushnew old-id + (etaf-runtime-candidate-removed-semantic-ids runtime) + :test #'eql))))) + (puthash identity candidate + (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash (etaf--semantic-component-semantic-id candidate) candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'component-render + :semantic-id (etaf--semantic-component-semantic-id semantic) + :deps (etaf--semantic-component-deps candidate)) + (etaf-runtime-candidate-effects runtime)) + (puthash effect-id (list :node publication-node :host-ref (cadr result) + :nodes (copy-sequence (nth 4 result)) + :range-id (and transparent-p + (etaf--semantic-range-semantic-id + (car output-range)))) + (etaf-runtime-candidate-artifacts runtime)) + (push identity (etaf-runtime-candidate-rendered-identities runtime)) + (list candidate + (gethash (etaf--semantic-component-artifact-key committed) + (etaf-runtime-artifact-registry runtime)) + (gethash effect-id (etaf-runtime-candidate-artifacts runtime)))))) + +(defun etaf--runtime-render-dirty-range (runtime effect range) + "Evaluate RUNTIME dirty RANGE EFFECT without running its Component owner." + (let* ((generation (etaf-runtime-current-generation runtime)) + (base-component + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + (etaf--semantic-range-component-id range))) + (component + (or (gethash (etaf--semantic-component-identity base-component) + (etaf-runtime-candidate-semantic-nodes runtime)) + base-component)) + (instance + (gethash (etaf--semantic-component-resource-key component) + (etaf-runtime-resource-registry runtime))) + deps context-deps value nodes) + (let ((collector + (lambda (source) (cl-pushnew source deps :test #'eq)))) + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--current-runtime runtime) + (etaf--current-component-instance instance) + (etaf--current-component-identity + (etaf--semantic-component-identity component)) + (etaf--current-component-props + (etaf--semantic-component-props component)) + (etaf--current-component-slots + (etaf--semantic-component-slots component)) + (etaf--current-context + (etaf--semantic-component-context-frame component)) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq value + (etaf--runtime-normalize-range-value + (funcall (etaf--expr-thunk + (etaf--generation-effect-target effect)))))) + (let ((etaf--runtime-dependency-collector collector) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--render-runtime runtime) + (etaf--current-component-semantic-id + (etaf--semantic-range-component-id range)) + (etaf--current-semantic-parent-id + (etaf--semantic-range-semantic-id range)) + (etaf--current-range-item-index + (etaf--semantic-range-item-identity-index range)) + (etaf--rendering-range-p t) + (etaf--active-effect nil) + (etaf--render-phase-p t) + (etaf--render-style-stack + (copy-tree (etaf--semantic-range-caller-style-stack range)))) + (setq nodes (etaf--render-value-list + value (etaf--semantic-range-path range))))) + (let* ((item-host-ids + (copy-sequence + (gethash (etaf--semantic-range-semantic-id range) + (etaf-runtime-candidate-graph-children runtime)))) + (all-item-ids + (etaf--runtime-candidate-descendant-ids runtime item-host-ids)) + (item-index (make-hash-table :test #'equal)) + (candidate (copy-sequence range))) + (unless (= (length nodes) (length item-host-ids)) + (signal 'etaf-runtime-error + (list "Direct child Range items must be Host Views" + (length nodes) (length item-host-ids)))) + (dolist (item-id all-item-ids) + (let ((item (gethash item-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (unless (etaf--semantic-host-p item) + (signal 'etaf-runtime-error + (list "Direct child Range items must be Host Views"))) + (puthash (etaf--semantic-host-identity item) item-id item-index))) + (let ((new-set (make-hash-table :test #'eql))) + (dolist (item-id all-item-ids) (puthash item-id t new-set)) + (dolist (old-id + (etaf--runtime-generation-descendant-ids + (etaf-runtime-current-generation runtime) + (etaf--semantic-range-item-host-ids range))) + (unless (gethash old-id new-set) + (push old-id + (etaf-runtime-candidate-removed-semantic-ids runtime))))) + (setf (etaf--semantic-range-output-signature candidate) (copy-tree value) + (etaf--semantic-range-deps candidate) (nreverse deps) + (etaf--semantic-range-context-deps candidate) (nreverse context-deps) + (etaf--semantic-range-artifact-key candidate) + (cons (1+ (etaf-runtime-generation runtime)) + (etaf--semantic-range-effect-id range)) + (etaf--semantic-range-item-host-ids candidate) item-host-ids + (etaf--semantic-range-item-identity-index candidate) item-index + (etaf--semantic-range-composition-version candidate) + (1+ (etaf--semantic-range-composition-version range))) + (puthash (etaf--semantic-range-semantic-id range) candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash (etaf--semantic-range-effect-id range) + (etaf--generation-effect-create + :effect-id (etaf--semantic-range-effect-id range) + :kind (or (etaf--semantic-range-kind range) 'range) + :semantic-id (etaf--semantic-range-semantic-id range) + :deps (etaf--semantic-range-deps candidate) + :target (etaf--generation-effect-target effect)) + (etaf-runtime-candidate-effects runtime)) + (puthash (etaf--semantic-range-effect-id range) nodes + (etaf-runtime-candidate-range-artifacts runtime)) + (etaf--runtime-invalidate-range-ancestors runtime range) + (unless (equal-including-properties + (etaf--semantic-range-output-signature range) value) + (etaf--runtime-record-range-owner-update runtime range)) + (list range candidate + (copy-sequence + (gethash (etaf--semantic-range-artifact-key range) + (etaf-runtime-range-artifact-registry runtime))) + nodes)))) + +(defun etaf--runtime-render-dirty-raw-range (runtime effect range) + "Evaluate opaque raw RANGE for EFFECT in RUNTIME." + (cl-multiple-value-bind (node deps) + (etaf--runtime-evaluate-raw-range + (etaf--generation-effect-target effect)) + (let ((candidate (copy-sequence range))) + (setf (etaf--semantic-range-output-signature candidate) (copy-tree node) + (etaf--semantic-range-deps candidate) deps + (etaf--semantic-range-artifact-key candidate) + (cons (1+ (etaf-runtime-generation runtime)) + (etaf--semantic-range-effect-id range)) + (etaf--semantic-range-composition-version candidate) + (1+ (etaf--semantic-range-composition-version range))) + (puthash (etaf--semantic-range-semantic-id range) candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash (etaf--semantic-range-effect-id range) + (etaf--generation-effect-create + :effect-id (etaf--semantic-range-effect-id range) + :kind 'raw :semantic-id (etaf--semantic-range-semantic-id range) + :deps deps :target (etaf--generation-effect-target effect)) + (etaf-runtime-candidate-effects runtime)) + (puthash (etaf--semantic-range-effect-id range) (list node) + (etaf-runtime-candidate-range-artifacts runtime)) + (unless (equal-including-properties + (etaf--semantic-range-output-signature range) node) + (etaf--runtime-invalidate-range-ancestors runtime range) + (etaf--runtime-record-range-owner-update runtime range)) + (list range candidate + (copy-sequence + (gethash (etaf--semantic-range-artifact-key range) + (etaf-runtime-range-artifact-registry runtime))) + (list node))))) + +(defun etaf--runtime-record-range-owner-update (runtime range) + "Record RANGE's lexical Component lifecycle participation in RUNTIME." + (when-let* ((component-id (etaf--semantic-range-component-id range)) + (component + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + component-id))) + (cl-pushnew (etaf--semantic-component-identity component) + (etaf-runtime-candidate-updated-component-identities runtime) + :test #'equal))) + +(defun etaf--runtime-render-dirty-inline-range (runtime effect inline) + "Evaluate RUNTIME dirty INLINE EFFECT and stage its semantic output." + (let* ((generation (etaf-runtime-current-generation runtime)) + (base-component + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + (etaf--semantic-inline-range-component-id inline))) + (component + (or (gethash (etaf--semantic-component-identity base-component) + (etaf-runtime-candidate-semantic-nodes runtime)) + base-component)) + (instance + (gethash (etaf--semantic-component-resource-key component) + (etaf-runtime-resource-registry runtime))) + deps context-deps output) + (let ((etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source deps :test #'eq))) + (etaf--context-inject-recorder + (lambda (frame key) + (cl-pushnew (cons (etaf-context-owner-id frame) key) + context-deps :test #'equal))) + (etaf--current-runtime runtime) + (etaf--current-component-instance instance) + (etaf--current-component-identity + (etaf--semantic-component-identity component)) + (etaf--current-component-semantic-id + (etaf--semantic-component-semantic-id component)) + (etaf--current-component-props + (etaf--semantic-component-props component)) + (etaf--current-component-slots + (etaf--semantic-component-slots component)) + (etaf--current-context + (etaf--semantic-component-context-frame component)) + (etaf--active-effect nil) + (etaf--render-phase-p t)) + (setq output + (etaf--runtime-inline-value-string + (funcall + (etaf--expr-thunk (etaf--generation-effect-target effect))) + (etaf--semantic-inline-range-surface-properties inline)))) + (let ((candidate (copy-sequence inline))) + (setf (etaf--semantic-inline-range-output candidate) + (copy-sequence output) + (etaf--semantic-inline-range-deps candidate) (nreverse deps) + (etaf--semantic-inline-range-context-deps candidate) + (nreverse context-deps) + (etaf--semantic-inline-range-composition-version candidate) + (1+ (etaf--semantic-inline-range-composition-version inline))) + (puthash (etaf--semantic-inline-range-semantic-id inline) candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (puthash (etaf--semantic-inline-range-effect-id inline) + (etaf--generation-effect-create + :effect-id (etaf--semantic-inline-range-effect-id inline) + :kind 'inline + :semantic-id (etaf--semantic-inline-range-semantic-id inline) + :deps (etaf--semantic-inline-range-deps candidate) + :target (etaf--generation-effect-target effect)) + (etaf-runtime-candidate-effects runtime)) + (unless (equal-including-properties + (etaf--semantic-inline-range-output inline) output) + (cl-pushnew (etaf--semantic-inline-range-parent-id inline) + (etaf-runtime-candidate-inline-host-ids runtime) + :test #'eql) + (etaf--runtime-invalidate-semantic-ancestors + runtime (etaf--semantic-inline-range-parent-id inline)) + (when-let ((component + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + (etaf--semantic-inline-range-component-id inline)))) + (cl-pushnew (etaf--semantic-component-identity component) + (etaf-runtime-candidate-updated-component-identities runtime) + :test #'equal))) + candidate))) + +(defun etaf--runtime-render-dirty-slot-range (runtime effect slot-range) + "Evaluate dirty SLOT-RANGE for EFFECT in RUNTIME and stage its backend change." + (let* ((target (etaf--generation-effect-target effect)) + (semantic-id (etaf--semantic-slot-range-semantic-id slot-range)) + (effect-id (etaf--semantic-slot-range-effect-id slot-range))) + (cl-multiple-value-bind (value deps nodes context-deps) + (etaf--runtime-evaluate-slot-target + runtime target semantic-id + (etaf--semantic-slot-range-item-identity-index slot-range) + (etaf--semantic-slot-range-path slot-range)) + (etaf--runtime-finish-slot-range-candidate + runtime (etaf-runtime-current-generation runtime) slot-range + (etaf--semantic-slot-range-identity slot-range) semantic-id effect-id + (etaf--semantic-slot-range-range-ref slot-range) + (etaf--semantic-slot-range-name slot-range) + (etaf--semantic-slot-range-token slot-range) + (plist-get target :owner-id) (plist-get target :consumer-id) + (plist-get target :style-stack) + (etaf--semantic-slot-range-path slot-range) + target value deps nodes context-deps) + (let ((candidate + (gethash semantic-id + (etaf-runtime-candidate-graph-nodes runtime)))) + (unless (equal-including-properties + (etaf--semantic-slot-range-output-signature slot-range) + (etaf--semantic-slot-range-output-signature candidate)) + (etaf--runtime-invalidate-semantic-ancestors + runtime (etaf--semantic-slot-range-parent-id slot-range)) + (etaf--runtime-record-slot-owner-update runtime slot-range)) + (list slot-range candidate + (copy-sequence + (gethash (etaf--semantic-slot-range-artifact-key slot-range) + (etaf-runtime-range-artifact-registry runtime))) + nodes))))) + +(defun etaf--runtime-record-slot-owner-update (runtime slot-range) + "Record SLOT-RANGE author lifecycle participation in RUNTIME." + (when-let* ((owner-id + (etaf--semantic-slot-range-owner-component-id slot-range)) + (owner + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + owner-id))) + (cl-pushnew (etaf--semantic-component-identity owner) + (etaf-runtime-candidate-updated-component-identities runtime) + :test #'equal))) + +(defun etaf--runtime-invalidate-range-ancestors (runtime range) + "Invalidate RUNTIME artifacts above changed RANGE without running effects." + (etaf--runtime-invalidate-semantic-ancestors + runtime (etaf--semantic-range-parent-id range))) + +(defun etaf--runtime-range-change-has-backend-anchor-p (runtime change) + "Return whether CHANGE has a live Ebox publication anchor in RUNTIME." + (let* ((range (car change)) + (ref (and range (etaf--semantic-backend-range-ref range)))) + (and ref + (ebox-range-ref-present-p (etaf-runtime-buffer runtime) ref)))) + +(defun etaf--runtime-invalidate-semantic-ancestors (runtime parent-id) + "Invalidate RUNTIME artifacts from PARENT-ID through semantic ancestors." + (let* ((generation (etaf-runtime-current-generation runtime)) + (nodes (etaf-generation-semantic-nodes generation))) + (while (and parent-id (> parent-id 0)) + (let ((record (etaf--pvec-get nodes parent-id))) + (cond + ((etaf--semantic-host-p record) + (let ((candidate (copy-sequence record))) + (cl-incf (etaf--semantic-host-composition-version candidate)) + (puthash parent-id candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (setq parent-id (etaf--semantic-host-parent-id record)))) + ((etaf--semantic-component-p record) + (let ((candidate + (copy-sequence + (or (gethash (etaf--semantic-component-identity record) + (etaf-runtime-candidate-semantic-nodes runtime)) + record)))) + (when-let ((key (etaf--semantic-component-artifact-key record))) + (push key + (etaf-runtime-candidate-invalidated-artifact-keys runtime))) + (setf (etaf--semantic-component-artifact-key candidate) nil) + (cl-incf (etaf--semantic-component-composition-version candidate)) + (puthash (etaf--semantic-component-identity record) candidate + (etaf-runtime-candidate-semantic-nodes runtime)) + (puthash parent-id candidate + (etaf-runtime-candidate-graph-nodes runtime)) + (setq parent-id (etaf--semantic-component-parent-id record)))) + (t (setq parent-id nil))))))) + +(defun etaf--runtime-compose-inline-parts + (runtime generation parts &optional candidate-p) + "Compose inline PARTS from GENERATION and optional RUNTIME candidate nodes." + (apply + #'concat + (mapcar + (lambda (part) + (if (integerp part) + (let ((inline + (or (and candidate-p + (gethash part + (etaf-runtime-candidate-graph-nodes runtime))) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) part)))) + (etaf--semantic-inline-range-output inline)) + part)) + parts))) + +(defun etaf--runtime-stage-inline-host (runtime generation host-id) + "Stage RUNTIME HOST-ID content after inline effects using GENERATION." + (let* ((old-host (etaf--pvec-get + (etaf-generation-semantic-nodes generation) host-id)) + (host (or (gethash host-id + (etaf-runtime-candidate-graph-nodes runtime)) + (copy-sequence old-host))) + (parts (etaf--semantic-host-content-parts old-host)) + (old-content + (etaf--runtime-compose-inline-parts runtime generation parts nil)) + (new-content + (etaf--runtime-compose-inline-parts runtime generation parts t))) + (setf (etaf--semantic-host-content host) (copy-sequence new-content)) + (puthash host-id host (etaf-runtime-candidate-graph-nodes runtime)) + (list host + (etaf--lower-resolved-semantic-host + 'text (copy-tree (etaf--semantic-host-props-signature old-host)) + old-content nil nil) + (etaf--lower-resolved-semantic-host + 'text (copy-tree (etaf--semantic-host-props-signature host)) + new-content nil nil)))) + +(defun etaf--runtime-inline-host-owner-rendered-p + (runtime generation host-id rendered-identities) + "Return whether RUNTIME HOST-ID owner rendered in GENERATION. +RENDERED-IDENTITIES names the Component render participants." + (let* ((host (or (gethash host-id + (etaf-runtime-candidate-graph-nodes runtime)) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) host-id))) + (inline-id (cl-find-if #'integerp + (etaf--semantic-host-content-parts host))) + (inline (and inline-id + (or (gethash inline-id + (etaf-runtime-candidate-graph-nodes runtime)) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + inline-id)))) + (component + (and inline + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--semantic-inline-range-component-id inline))))) + (and component + (member (etaf--semantic-component-identity component) + rendered-identities)))) + +(defun etaf--runtime-component-overlay (runtime) + "Publish RUNTIME dirty Component effects without traversing Root." + (cl-block etaf--runtime-component-overlay + (let* ((old (etaf-runtime-current-generation runtime)) + (queued-effect-ids + (copy-sequence (etaf-runtime-dirty-effect-queue runtime))) + (retry-effect-ids + (cl-remove-if-not + (lambda (effect-id) + (etaf--generation-effect old effect-id)) + queued-effect-ids)) + changes range-changes inline-changes backend-component-identities + journal resource-journal candidate-generation participant) + (etaf--runtime-begin-component-overlay runtime old) + ;; A source notification can race a generation promotion and leave an old + ;; effect id in the FIFO. Keep the dirty-id set and FIFO coherent before + ;; sorting; stale ids are retired by the candidate generation cleanup. + (dolist (effect-id queued-effect-ids) + (unless (etaf--generation-effect old effect-id) + (remhash effect-id (etaf-runtime-dirty-effect-ids runtime)))) + (setf (etaf-runtime-dirty-effect-queue runtime) + (sort retry-effect-ids + (lambda (left right) + (let* ((left-effect (etaf--generation-effect old left)) + (right-effect (etaf--generation-effect old right)) + (left-priority + (pcase (etaf--generation-effect-kind left-effect) + ('root 0) ('component-input 1) + ((or 'range 'fragment 'raw 'slot 'inline) 2) (_ 3))) + (right-priority + (pcase (etaf--generation-effect-kind right-effect) + ('root 0) ('component-input 1) + ((or 'range 'fragment 'raw 'slot 'inline) 2) (_ 3)))) + (if (= left-priority right-priority) + (< left right) + (< left-priority right-priority)))))) + (while (etaf-runtime-dirty-effect-queue runtime) + (let* ((effect-id (pop (etaf-runtime-dirty-effect-queue runtime))) + (effect (etaf--generation-effect old effect-id)) + (base-semantic + (and effect (etaf--generation-effect-semantic old effect-id))) + (semantic + (and base-semantic + (if (etaf--semantic-component-p base-semantic) + (or (gethash + (etaf--semantic-component-identity base-semantic) + (etaf-runtime-candidate-semantic-nodes runtime)) + base-semantic) + (or (gethash + (etaf--generation-effect-semantic-id effect) + (etaf-runtime-candidate-graph-nodes runtime)) + base-semantic))))) + (if (and effect semantic + (etaf--runtime-scheduled-semantic-live-p + old effect base-semantic)) + (progn + (etaf--runtime-record-effect-input-version + runtime old effect-id) + (pcase (etaf--generation-effect-kind effect) + ('component-input + (etaf--runtime-evaluate-component-input runtime semantic)) + ('component-render + (unless (member (etaf--semantic-component-identity semantic) + (etaf-runtime-candidate-rendered-identities + runtime)) + (push (etaf--runtime-render-dirty-component runtime semantic) + changes))) + ((or 'range 'fragment) + (push (etaf--runtime-render-dirty-range runtime effect semantic) + range-changes)) + ('raw + (push (etaf--runtime-render-dirty-raw-range + runtime effect semantic) + range-changes)) + ('slot + (push (etaf--runtime-render-dirty-slot-range + runtime effect semantic) + range-changes)) + ('inline + (etaf--runtime-render-dirty-inline-range + runtime effect semantic)))) + ;; A route can deliver an effect queued by the previous generation + ;; after that semantic subtree has already been removed. Retire the + ;; effect from the next generation instead of evaluating a nil owner. + (cl-pushnew effect-id + (etaf-runtime-candidate-removed-effect-ids runtime) + :test #'eql)))) + (setq range-changes + (append (nreverse + (etaf-runtime-candidate-eager-range-changes runtime)) + range-changes)) + ;; A semantic Range may be nested below a material Component whose + ;; backend publication exposes only the ancestor component-output anchor. + ;; Never submit an address that Ebox cannot resolve against this base; + ;; discard the local candidate and let the next branch publish one exact + ;; root candidate. This is a proof miss, not an exception path. + (let (fallback-component-effect-ids fallback-p) + (dolist (change range-changes) + (unless (etaf--runtime-range-change-has-backend-anchor-p + runtime change) + (setq fallback-p t) + (when-let* ((range (car change)) + (component-id + (etaf--semantic-backend-range-container-component-id + range)) + (component + (etaf--pvec-get + (etaf-generation-semantic-nodes old) component-id))) + (cl-pushnew + (etaf--semantic-component-effect-id component) + fallback-component-effect-ids :test #'eql)))) + (when fallback-p + ;; Re-render the material owner during the root fallback. A root + ;; rebuild may otherwise carry its old artifact and leave the source + ;; value visually stale even though the invalid Range was discarded. + (setf (etaf-runtime-root-dirty-p runtime) t + (etaf-runtime-dirty-effect-queue runtime) nil) + (clrhash (etaf-runtime-dirty-effect-ids runtime)) + (dolist (effect-id fallback-component-effect-ids) + (puthash effect-id t (etaf-runtime-dirty-effect-ids runtime))) + (etaf--runtime-dispose-created-candidate runtime) + (etaf--runtime-clear-candidate runtime) + (cl-return-from etaf--runtime-component-overlay :root-fallback))) + (let (material-changes) + (dolist (change changes) + (let ((candidate (car change))) + (if (eq (etaf--semantic-component-publication-kind candidate) + 'transparent) + (let* ((committed + (etaf--pvec-get + (etaf-generation-semantic-nodes old) + (etaf--semantic-component-semantic-id candidate))) + (old-range + (etaf--pvec-get + (etaf-generation-semantic-nodes old) + (etaf--semantic-component-output-range-id committed))) + (new-range + (gethash (etaf--semantic-component-output-range-id candidate) + (etaf-runtime-candidate-graph-nodes runtime)))) + (push (list old-range new-range + (copy-sequence (plist-get (nth 1 change) :nodes)) + (copy-sequence (plist-get (nth 2 change) :nodes))) + range-changes)) + (push change material-changes)))) + (setq changes (nreverse material-changes))) + (setq changes + (cl-remove-if + (lambda (change) + (equal-including-properties + (plist-get (nth 1 change) :node) + (plist-get (nth 2 change) :node))) + changes) + changes + (let ((seen (make-hash-table :test #'equal)) result) + (dolist (change changes (nreverse result)) + (let ((host-ref (plist-get (nth 2 change) :host-ref))) + (unless (gethash host-ref seen) + (puthash host-ref t seen) + (push change result))))) + backend-component-identities + (mapcar (lambda (change) + (etaf--semantic-component-identity (car change))) + changes)) + (dolist (host-id (etaf-runtime-candidate-inline-host-ids runtime)) + (unless (etaf--runtime-inline-host-owner-rendered-p + runtime old host-id backend-component-identities) + (push (etaf--runtime-stage-inline-host runtime old host-id) + inline-changes))) + (setq range-changes + (cl-remove-if + (lambda (change) + (let* ((range (car change)) + (component + (etaf--pvec-get + (etaf-generation-semantic-nodes old) + (etaf--semantic-backend-range-container-component-id + range)))) + (member (etaf--semantic-component-identity component) + backend-component-identities))) + range-changes)) + (setq candidate-generation (etaf--runtime-build-generation runtime old) + resource-journal (etaf--runtime-preinstall-resources + runtime candidate-generation) + participant (etaf--generation-participant-create + :runtime runtime :old old :candidate candidate-generation) + journal (etaf--runtime-prearm-generation runtime candidate-generation)) + (condition-case err + (if (and + (cl-every + (lambda (change) + (equal-including-properties + (plist-get (nth 1 change) :node) + (plist-get (nth 2 change) :node))) + changes) + (cl-every + (lambda (change) + (equal-including-properties (nth 2 change) (nth 3 change))) + range-changes) + (cl-every + (lambda (change) + (equal-including-properties (nth 1 change) (nth 2 change))) + inline-changes)) + (etaf--runtime-participant-publish participant) + (let ((candidate (ebox-candidate-begin (etaf-runtime-buffer runtime)))) + (dolist (change changes) + (ebox-candidate-replace-host-ref + candidate (plist-get (nth 1 change) :host-ref) + (plist-get (nth 2 change) :node))) + (dolist (change range-changes) + (unless (equal-including-properties (nth 2 change) (nth 3 change)) + (ebox-candidate-replace-range-ref + candidate (etaf--semantic-backend-range-ref (car change)) + (nth 3 change)))) + (dolist (change inline-changes) + (ebox-candidate-replace-host-ref + candidate (etaf--semantic-host-host-ref (car change)) + (nth 2 change))) + (ebox-commit + (etaf-runtime-buffer runtime) candidate + (lambda (_report) + (etaf--runtime-participant-publish participant)) + (lambda (_report) + (etaf--runtime-participant-rollback participant))))) + ((error quit) + (etaf--runtime-rollback-prearm runtime journal) + (etaf--runtime-rollback-resource-journal runtime resource-journal) + (clrhash (etaf-runtime-dirty-effect-ids runtime)) + (setf (etaf-runtime-dirty-effect-queue runtime) nil) + (dolist (effect-id retry-effect-ids) + (etaf--runtime-enqueue-effect runtime effect-id)) + (etaf--runtime-dispose-created-candidate runtime) + (etaf--runtime-clear-candidate runtime) + (signal (car err) (cdr err)))) + (etaf--runtime-complete-generation runtime old candidate-generation) + (maphash (lambda (host-ref handlers) + (puthash host-ref handlers (etaf-runtime-handlers runtime))) + (etaf-runtime-candidate-handlers runtime)) + (maphash (lambda (host-ref props) + (puthash host-ref props (etaf-runtime-host-props runtime))) + (etaf-runtime-candidate-host-props runtime)) + (clrhash (etaf-runtime-dirty-effect-ids runtime)) + (setf (etaf-runtime-dirty-effect-queue runtime) nil) + (unwind-protect + (progn + (dolist (instance (etaf-runtime-candidate-created runtime)) + (setf (etaf--component-instance-mounted-p instance) t) + (etaf--run-hooks (etaf--component-instance-mounted-hooks instance))) + (dolist (entry (etaf--generation-index-entries + candidate-generation 'lifecycle)) + (let ((identity (car entry))) + (when-let* ((semantic (etaf--generation-semantic old identity)) + (instance + (gethash + (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime)))) + (etaf--run-hooks + (etaf--component-instance-updated-hooks instance)))))) + (etaf--runtime-clear-candidate runtime))))) (defun etaf--runtime-render-effect (runtime) - "Build and publish one candidate for RUNTIME." - (etaf--runtime-begin-candidate runtime) - (let (next-root) + "Build and publish one Root-owned candidate for RUNTIME." + (setf (etaf-runtime-candidate-full-rebuild-p runtime) t) + (let ((old-generation (etaf-runtime-current-generation runtime)) + next-root candidate-generation journal resource-journal participant) (condition-case err (let* ((etaf--render-runtime runtime) + (root-deps (copy-sequence + (etaf-runtime-candidate-root-deps runtime))) + (etaf--runtime-dependency-collector + (lambda (source) (cl-pushnew source root-deps :test #'eq))) + (etaf--active-effect nil) (nodes (etaf--runtime-render-root runtime))) + (setf (etaf-runtime-candidate-root-deps runtime) + (nreverse root-deps)) + (etaf--runtime-stage-root-range + runtime (etaf-runtime-candidate-root-deps runtime)) (setq next-root (cond ((null nodes) (ebox-spacer)) ((null (cdr nodes)) (car nodes)) (t (apply #'ebox-column nodes)))) - (if (etaf-runtime-root-node runtime) - (ebox-commit (etaf-runtime-buffer runtime) next-root) - (ebox-render-to-buffer (etaf-runtime-buffer runtime) next-root)) + (setq candidate-generation + (etaf--runtime-build-generation runtime old-generation) + resource-journal (etaf--runtime-preinstall-resources + runtime candidate-generation) + participant (etaf--generation-participant-create + :runtime runtime :old old-generation + :candidate candidate-generation) + journal + (etaf--runtime-prearm-generation runtime candidate-generation)) + (if old-generation + (let ((candidate (ebox-candidate-begin + (etaf-runtime-buffer runtime)))) + (ebox-candidate-replace-root candidate next-root) + (ebox-commit + (etaf-runtime-buffer runtime) candidate + (lambda (_report) + (etaf--runtime-participant-publish participant)) + (lambda (_report) + (etaf--runtime-participant-rollback participant)))) + (ebox-render-to-buffer (etaf-runtime-buffer runtime) next-root) + (etaf--runtime-participant-publish participant)) + (etaf--runtime-complete-generation + runtime old-generation candidate-generation) (setf (etaf-runtime-root-node runtime) next-root (etaf-runtime-handlers runtime) (etaf-runtime-candidate-handlers runtime) (etaf-runtime-host-props runtime) (etaf-runtime-candidate-host-props runtime) - (etaf-runtime-generation runtime) - (1+ (etaf-runtime-generation runtime)))) + (etaf-runtime-root-dirty-p runtime) nil) + (clrhash (etaf-runtime-dirty-effect-ids runtime)) + (setf (etaf-runtime-dirty-effect-queue runtime) nil)) ((error quit) + (etaf--runtime-rollback-prearm runtime journal) + (etaf--runtime-rollback-resource-journal runtime resource-journal) + (clrhash (etaf-runtime-dirty-effect-ids runtime)) + (setf (etaf-runtime-dirty-effect-queue runtime) nil) (etaf--runtime-dispose-created-candidate runtime) (etaf--runtime-rollback-behaviors runtime) (etaf--runtime-clear-candidate runtime) @@ -462,19 +4188,50 @@ when the requested boundary is no longer mounted." (etaf--runtime-clear-candidate runtime)) next-root)) +(defun etaf--runtime-render-root-turn (runtime &optional force-components-p) + "Evaluate and publish one full root turn for RUNTIME. +When FORCE-COMPONENTS-P is non-nil, re-evaluate retained Components whose +backend anchor proof failed; ordinary root turns keep their artifact reuse." + (let ((etaf--runtime-force-full-component-render-p force-components-p)) + (etaf--runtime-record-effect-input-version + runtime (etaf-runtime-current-generation runtime) + (etaf-runtime-root-effect-id runtime)) + (etaf--runtime-begin-candidate runtime) + (setf (etaf-runtime-root-view-cache runtime) + (etaf--runtime-evaluate-root-candidate runtime)) + (etaf--runtime-render-effect runtime))) + (defun etaf--runtime-request-flush (runtime) "Synchronously flush RUNTIME, or mark one follow-up flush while busy." (when (etaf-runtime-mounted-p runtime) - (if (etaf-runtime-flushing-p runtime) + (if (or (> (etaf-runtime-event-depth runtime) 0) + (etaf-runtime-flushing-p runtime)) (setf (etaf-runtime-pending-p runtime) t) (setf (etaf-runtime-flushing-p runtime) t) - (unwind-protect - (progn - (etaf--runtime-render-effect runtime) - (while (etaf-runtime-pending-p runtime) - (setf (etaf-runtime-pending-p runtime) nil) - (etaf--runtime-render-effect runtime))) - (setf (etaf-runtime-flushing-p runtime) nil))))) + (let* ((etaf--runtime-fixed-point-stamps + (make-hash-table :test #'equal)) + (etaf--runtime-fixed-point-steps 0) + (etaf--runtime-fixed-point-history nil) + (etaf--runtime-fixed-point-step-bound + (plist-get + (etaf--runtime-fixed-point-graph-size + runtime (etaf-runtime-current-generation runtime)) + :bound))) + (unwind-protect + (progn + (if (etaf-runtime-root-dirty-p runtime) + (etaf--runtime-render-root-turn runtime) + (when (eq (etaf--runtime-component-overlay runtime) + :root-fallback) + (etaf--runtime-render-root-turn runtime t))) + (while (etaf-runtime-pending-p runtime) + (setf (etaf-runtime-pending-p runtime) nil) + (if (etaf-runtime-root-dirty-p runtime) + (etaf--runtime-render-root-turn runtime) + (when (eq (etaf--runtime-component-overlay runtime) + :root-fallback) + (etaf--runtime-render-root-turn runtime t))))) + (setf (etaf-runtime-flushing-p runtime) nil)))))) ;;;###autoload (defun etaf-runtime-flush (&optional runtime) @@ -496,30 +4253,52 @@ when the requested boundary is no longer mounted." :root-view view :scope scope :instances (make-hash-table :test #'equal) + :resource-registry (make-hash-table :test #'equal) + :mount-epoch (cl-incf etaf--mount-epoch-counter) + :next-resource-id 0 + :next-effect-id 0 + :next-semantic-id 1 + :root-effect-id 0 + :root-range-id 1 + :artifact-registry (make-hash-table :test #'equal) + :range-artifact-registry (make-hash-table :test #'equal) + :candidate-artifacts (make-hash-table :test #'equal) + :candidate-range-artifacts (make-hash-table :test #'eql) + :route-sources (make-hash-table :test #'eq) + :dirty-effect-ids (make-hash-table :test #'eql) :handlers (make-hash-table :test #'equal) :host-props (make-hash-table :test #'equal) :behaviors (make-hash-table :test #'equal) - :generation 0))) + :behavior-resource-keys (make-hash-table :test #'equal) + :root-dirty-p t))) (puthash buffer runtime etaf--runtime-table) - (setf (etaf-runtime-render-effect runtime) - (etaf-scope-run - scope - (lambda () - (etaf-reactive-effect-create - (lambda () - (let ((etaf--current-runtime runtime)) - (etaf--runtime-render-effect runtime))) - :name 'render - :scheduler - (lambda (_effect) - (etaf--runtime-request-flush runtime)))))) + (let ((route (etaf-runtime-route-create + :runtime-id (etaf-runtime-mount-epoch runtime) + :mount-epoch (etaf-runtime-mount-epoch runtime) + :scheduler 'etaf--runtime-route-scheduler))) + (setf (etaf-runtime-route-token runtime) route) + (puthash (etaf-runtime-mount-epoch runtime) runtime + etaf--runtime-route-registry)) (condition-case err - (etaf-reactive-effect-run - (etaf-runtime-render-effect runtime) :rendering t) + (progn + (etaf--runtime-begin-candidate runtime) + (setf (etaf-runtime-flushing-p runtime) t + (etaf-runtime-root-view-cache runtime) + (etaf--runtime-evaluate-root-candidate runtime)) + (unwind-protect + (etaf--runtime-render-effect runtime) + (setf (etaf-runtime-flushing-p runtime) nil))) ((error quit) (remhash buffer etaf--runtime-table) + (remhash (etaf-runtime-mount-epoch runtime) + etaf--runtime-route-registry) (etaf-scope-stop scope) (signal (car err) (cdr err)))) + (when (etaf-runtime-pending-p runtime) + (setf (etaf-runtime-pending-p runtime) nil) + (etaf--runtime-request-flush runtime)) + (when (fboundp 'etaf-events-enable-input) + (etaf-events-enable-input buffer)) buffer))) ;;;###autoload @@ -527,7 +4306,16 @@ when the requested boundary is no longer mounted." "Unmount RUNTIME and dispose its Component scopes." (let ((runtime (etaf-runtime-require-mounted runtime))) (setf (etaf-runtime-mounted-p runtime) nil) + (when (fboundp 'etaf-events-disable-input) + (etaf-events-disable-input (etaf-runtime-buffer runtime))) (remhash (etaf-runtime-buffer runtime) etaf--runtime-table) + (remhash (etaf-runtime-mount-epoch runtime) etaf--runtime-route-registry) + (maphash + (lambda (source _) + (remhash (etaf-runtime-route-token runtime) + (etaf--source-subscribers source))) + (etaf-runtime-route-sources runtime)) + (clrhash (etaf-runtime-route-sources runtime)) (let (instances) (maphash (lambda (_identity instance) (push instance instances)) (etaf-runtime-instances runtime)) @@ -538,11 +4326,13 @@ when the requested boundary is no longer mounted." (etaf--runtime-dispose-instance instance t))) (etaf-scope-stop (etaf-runtime-scope runtime)) (maphash - (lambda (_identity state) + (lambda (identity state) (when-let ((cleanup (cdr state))) - (funcall cleanup))) + (etaf--runtime-run-contained-cleanup + runtime 'behavior-unmount identity cleanup))) (etaf-runtime-behaviors runtime)) (clrhash (etaf-runtime-instances runtime)) + (clrhash (etaf-runtime-resource-registry runtime)) runtime)) ;;;###autoload diff --git a/etaf-view.el b/etaf-view.el index bcbb03e..6230eb9 100644 --- a/etaf-view.el +++ b/etaf-view.el @@ -23,12 +23,14 @@ (:constructor etaf--view-node-create)) "Internal normalized description of one Host View." name + token props children) (cl-defstruct (etaf--expr (:constructor etaf--expr-create)) "Internal executable child expression." + token thunk) (cl-defstruct (etaf--component-spec @@ -57,11 +59,13 @@ (:constructor etaf--slot-projection-create)) "A Component View request for one slot and its fallback children." name + token fallback) (cl-defstruct (etaf--raw-ebox (:constructor etaf--raw-ebox-create)) "Explicit escape carrying an already-built public Ebox node." + token thunk key-thunk) @@ -313,9 +317,11 @@ belong to the anonymous `default' slot." (etaf--compile-child-form child slot-mode)) children))) (if (eq slot-mode :projection) - `(etaf--slot-projection-create - :name ',name - :fallback (list ,@compiled)) + (let ((token (gensym "etaf-slot-site-"))) + `(etaf--slot-projection-create + :name ',name + :token ',token + :fallback (list ,@compiled))) `(etaf--slot-input-create :name ',name :children (list ,@compiled)))))) @@ -328,8 +334,10 @@ belong to the anonymous `default' slot." (defun etaf--compile-expr-form (items) "Compile an `expr' form with ITEMS into an executable View value." - `(etaf--expr-create - :thunk (lambda () ,(etaf--parse-expr-form items)))) + (let ((token (gensym "etaf-expr-site-"))) + `(etaf--expr-create + :token ',token + :thunk (lambda () ,(etaf--parse-expr-form items))))) (defun etaf--compile-child-form (form &optional slot-mode) "Compile structural child FORM into code returning a View value. @@ -380,11 +388,13 @@ SLOT-MODE distinguishes Component-owned projections from call-site inputs." (unless (and (plist-member props :value) (cl-every #'keywordp (cl-loop for (key _value) on props by #'cddr collect key))) (etaf--syntax-error "Raw-ebox requires :value")) - (let ((allowed '(:value :key))) + (let ((allowed '(:value :key)) + (token (gensym "etaf-raw-site-"))) (dolist (key (cl-loop for (key _value) on props by #'cddr collect key)) (unless (memq key allowed) (etaf--syntax-error "Raw-ebox does not accept %S" key))) `(etaf--raw-ebox-create + :token ',token :thunk (lambda () ,(plist-get props :value)) :key-thunk ,(when (plist-member props :key) `(lambda () ,(plist-get props :key)))))))) @@ -395,12 +405,15 @@ SLOT-MODE distinguishes Component-owned projections from call-site inputs." (host-view-p (eq (gethash (car form) etaf--view-registry) etaf--host-marker)) (child-slot-mode (if host-view-p slot-mode :input))) - `(etaf--view-call ',(car form) - (list ,@(etaf--compile-property-plist props)) - (list ,@(mapcar (lambda (child) - (etaf--compile-child-form - child child-slot-mode)) - children))))))) + (let ((token (and (memq (car form) '(fragment etaf-fragment)) + (gensym "etaf-fragment-site-")))) + `(etaf--view-call ',(car form) + (list ,@(etaf--compile-property-plist props)) + (list ,@(mapcar (lambda (child) + (etaf--compile-child-form + child child-slot-mode)) + children)) + ,(and token `',token))))))) ;;;###autoload (defmacro etaf-view (form) @@ -437,8 +450,8 @@ child region and accepts only `:value'." key (etaf--component-spec-name spec))))) props)) -(defun etaf--view-call (name props children) - "Construct a Host or Component named NAME from PROPS and CHILDREN." +(defun etaf--view-call (name props children &optional token) + "Construct NAME from PROPS and CHILDREN, retaining optional site TOKEN." (unless (symbolp name) (etaf--syntax-error "View name must be a symbol: %S" name)) (setq props (etaf--validate-property-plist props)) @@ -450,6 +463,7 @@ child region and accepts only `:value'." (etaf--resolve-property-value (plist-get props :key)))) (etaf--view-node-create :name (etaf--canonical-host-name name) + :token token :props props :children children)) ((etaf--component-spec-p entry) diff --git a/postmortem/2026-08-19-core-boundaries.en.md b/postmortem/2026-08-19-core-boundaries.en.md new file mode 100644 index 0000000..f3b8a78 --- /dev/null +++ b/postmortem/2026-08-19-core-boundaries.en.md @@ -0,0 +1,7 @@ +# Core boundaries after the `.etaf` pair experiment + +The safe data-only `.etaf` pair path was removed from current core. It added a second file grammar, companion execution boundary, and registry validation surface before a compiler contract existed. The archived `emacs-box` DSL cannot be reused as a shortcut: it has different ownership and executable semantics. A future `.etaf` SFC belongs in a compiler layer that emits the existing `etaf-view` and `etaf-define-component` contracts. + +The current Component definition remains the single structure/style/behavior unit. Its `:view` owns structure, `:styles` owns presentation, and `:setup` owns retained state, Actions, and lifecycle. Style scopes now stop at nested Component internals; caller-owned slot content keeps the caller scope, while child-authored slot fallbacks keep the child scope. + +Mounted input stays in the small Runtime lifecycle path: the input minor mode is enabled after a successful mount and disabled before unmount. TAB/backtab, RET, and mouse-1 use the public focus and hit-test operations rather than a second event layer. diff --git a/postmortem/2026-08-19-core-boundaries.zh.md b/postmortem/2026-08-19-core-boundaries.zh.md new file mode 100644 index 0000000..bc36b6e --- /dev/null +++ b/postmortem/2026-08-19-core-boundaries.zh.md @@ -0,0 +1,7 @@ +# 移除 `.etaf` pair 后的 core 边界 + +当前 core 移除了只读 data `.etaf`、同名 `.el` companion 的 pair 主路径。它在 compiler 契约尚未存在时增加了第二套文件语法、companion 执行边界和 registry 校验面。不能把 `emacs-box` 的归档 DSL 当捷径复用：它的所有权和可执行语义不同。未来 `.etaf` SFC 应属于 compiler layer，并输出既有的 `etaf-view` 与 `etaf-define-component` 契约。 + +当前 Component definition 仍是唯一的结构/样式/行为单元：`:view` 负责结构，`:styles` 负责 presentation，`:setup` 负责 retained state、Action 和生命周期。样式 scope 现在在嵌套 Component 内部边界停止；调用者提供的 slot 内容保留 caller scope，子组件自有的 slot fallback 保留 child scope。 + +挂载后的输入仍走窄的 Runtime 生命周期路径：成功 mount 后启用 input minor mode，unmount 前禁用。TAB/backtab、RET 和 mouse-1 复用公共 focus/hit-test 操作，不建立第二套事件层。 diff --git a/tests/etaf-tests.el b/tests/etaf-tests.el index 6a86d13..f6d7045 100644 --- a/tests/etaf-tests.el +++ b/tests/etaf-tests.el @@ -5,6 +5,7 @@ ;;; Code: (require 'ert) +(require 'subr-x) (require 'etaf) (defvar etaf-test-state-cell nil) @@ -14,10 +15,711 @@ (defvar etaf-test-theme-cell nil) (defvar etaf-test-event-count 0) (defvar etaf-test-behavior-cleanups 0) +(defvar etaf-test-behavior-installs 0) (defvar etaf-test-behavior-runtime nil) (defvar etaf-test-prop-cell nil) (defvar etaf-test-updated-count 0) (defvar etaf-test-lifecycle-failure-p nil) +(defvar etaf-test-branch-page-cell nil) +(defvar etaf-test-branch-late-cell nil) +(defvar etaf-test-branch-mode-cell nil) +(defvar etaf-test-event-batch-source nil) +(defvar etaf-test-event-resource-fail nil) +(defvar etaf-test-retained-render-counts nil) +(defvar etaf-test-next-turn-target nil) +(defvar etaf-test-next-turn-source nil) +(defvar etaf-test-next-turn-sink nil) +(defvar etaf-test-input-render-count 0) +(defvar etaf-test-priority-render-source nil) +(defvar etaf-test-priority-render-count 0) +(defvar etaf-test-local-style-source nil) +(defvar etaf-test-lazy-computed-base nil) +(defvar etaf-test-lazy-computed-value nil) +(defvar etaf-test-wide-parent-source nil) +(defvar etaf-test-wide-parent-cells nil) +(defvar etaf-test-range-source nil) +(defvar etaf-test-range-static-count 10) +(defvar etaf-test-range-evals 0) +(defvar etaf-test-range-component-renders 0) +(defvar etaf-test-range-left-evals 0) +(defvar etaf-test-range-right-evals 0) +(defvar etaf-test-range-host-prop-calls 0) +(defvar etaf-test-unsupported-range-source nil) +(defvar etaf-test-string-range-source nil) +(defvar etaf-test-nested-range-present nil) +(defvar etaf-test-nested-range-source nil) +(defvar etaf-test-nested-range-evals 0) +(defvar etaf-test-inline-a nil) +(defvar etaf-test-inline-b nil) +(defvar etaf-test-inline-a-evals 0) +(defvar etaf-test-inline-b-evals 0) +(defvar etaf-test-inline-component-renders 0) +(defvar etaf-test-inline-updated-count 0) +(defvar etaf-test-inline-shared nil) +(defvar etaf-test-inline-shared-evals 0) +(defvar etaf-test-inline-branch-mode nil) +(defvar etaf-test-inline-branch-left nil) +(defvar etaf-test-inline-branch-right nil) +(defvar etaf-test-inline-branch-evals 0) +(defvar etaf-test-inline-branch-updated 0) +(defvar etaf-test-inline-priority-source nil) +(defvar etaf-test-inline-priority-evals 0) +(defvar etaf-test-inline-priority-renders 0) +(defvar etaf-test-inline-priority-updated 0) +(defvar etaf-test-inline-styled-source nil) +(defvar etaf-test-inline-styled-evals 0) +(defvar etaf-test-inline-host-prop-calls 0) +(defvar etaf-test-slot-parent-renders 0) +(defvar etaf-test-slot-forwarder-renders 0) +(defvar etaf-test-slot-consumer-renders 0) +(defvar etaf-test-slot-source nil) +(defvar etaf-test-slot-range-evals 0) +(defvar etaf-test-fragment-range-evals 0) +(defvar etaf-test-fragment-owner-renders 0) +(defvar etaf-test-fragment-source nil) +(defvar etaf-test-raw-source nil) +(defvar etaf-test-raw-key-source nil) +(defvar etaf-test-raw-evals 0) +(defvar etaf-test-raw-owner-renders 0) +(defvar etaf-test-transparent-source nil) +(defvar etaf-test-transparent-renders 0) +(defvar etaf-test-transparent-parent-renders 0) +(defvar etaf-test-transparent-inner-renders 0) +(defvar etaf-test-transparent-outer-renders 0) +(defvar etaf-test-context-provider-source nil) +(defvar etaf-test-context-provider-renders 0) +(defvar etaf-test-context-consumer-renders 0) +(defvar etaf-test-context-range-evals 0) +(defvar etaf-test-slot-author-updated 0) +(defvar etaf-test-slot-consumer-updated 0) +(defvar etaf-test-slot-branch-left nil) +(defvar etaf-test-slot-branch-right nil) + +(defun etaf-test--range-items () + "Return keyed text Views from `etaf-test-range-source'." + (cl-incf etaf-test-range-evals) + (mapcar (lambda (entry) + (etaf--view-call 'text + (list :key (car entry) :class "slot-item") + (list (cdr entry)))) + (etaf-value etaf-test-range-source))) + +(defun etaf-test--prefixed-range-items (prefix) + "Return current Range items with key and content PREFIX." + (mapcar (lambda (entry) + (let ((key (intern (format "%s-%s" prefix (car entry))))) + (etaf--view-call 'text (list :key key :ref key) + (list (format "%s%s" prefix (cdr entry)))))) + (etaf-value etaf-test-range-source))) + +(defun etaf-test--unsupported-range-value () + "Return a Host, Component, or raw value for direct Range rejection tests." + (pcase (etaf-value etaf-test-unsupported-range-source) + ('component + (etaf--view-call 'etaf-test-badge (list :label "component") nil)) + ('raw (etaf--raw-ebox-create + :thunk (lambda () (ebox-create :content "raw")))) + ('deep-component + (etaf--view-call + 'column (list :key 'outer) + (list (etaf--component-call-create + :spec etaf-test-badge--etaf-component-definition + :props (list :label "deep") :slots nil)))) + ('deep-raw + (etaf--view-call + 'column (list :key 'outer) + (list (etaf--raw-ebox-create + :thunk (lambda () (ebox-create :content "deep-raw")))))) + ('deep-expr-component + (etaf--view-call + 'column (list :key 'outer) + (list (etaf--expr-create + :token 'etaf-test-deep-unsupported-site + :thunk + (lambda () + (etaf--component-call-create + :spec etaf-test-badge--etaf-component-definition + :props (list :label "deep-expr") :slots nil)))))) + (_ (etaf--view-call 'text (list :key 'safe) (list "safe"))))) + +(defun etaf-test--nested-range-children () + "Return keyed nested Hosts from the nested Range source." + (let ((state (etaf-value etaf-test-nested-range-source))) + (append + (and (cdr state) + (list (etaf--view-call 'text (list :key 'sibling) + (list "sibling")))) + (list (etaf--view-call 'text (list :key 'nested) + (list (car state))))))) + +(defun etaf-test--nested-range-value () + "Return one nested Host item or nil for recursive identity tests." + (cl-incf etaf-test-nested-range-evals) + (when (etaf-value etaf-test-nested-range-present) + (etaf--view-call + 'column (list :key 'item) + (list (etaf--expr-create + :token 'etaf-test-nested-inner-site + :thunk #'etaf-test--nested-range-children))))) + +(defun etaf-test--slot-range-items () + "Return keyed Host items from the current slot source." + (cl-incf etaf-test-slot-range-evals) + (mapcar (lambda (entry) + (etaf--view-call 'text + (list :key (car entry) :class "slot-item") + (list (cdr entry)))) + (etaf-value etaf-test-slot-source))) + +(defun etaf-test--fragment-range-items () + "Return keyed Host items from the current fragment source." + (cl-incf etaf-test-fragment-range-evals) + (mapcar (lambda (entry) + (etaf--view-call 'text (list :key (car entry)) + (list (cdr entry)))) + (etaf-value etaf-test-fragment-source))) + +(defun etaf-test--retained-leaf-value (label cell) + "Record LABEL render and return CELL's current text." + (puthash label (1+ (gethash label etaf-test-retained-render-counts 0)) + etaf-test-retained-render-counts) + (format "%s=%s" label (etaf-value cell))) + +(etaf-define-component etaf-test-retained-leaf (&key label cell) + "Render one independently reactive retained leaf." + :view + (text (expr :value (etaf-test--retained-leaf-value label cell)))) + +(etaf-define-component etaf-test-setup-read-owner + (&key setup-source render-source) + "Read SETUP-SOURCE only during setup and render RENDER-SOURCE." + :setup + (progn + (etaf-value setup-source) + (lambda () + (etaf-view (text (expr :value (etaf-value render-source))))))) + +(etaf-define-component etaf-test-dependency-only (&key source) + "Track SOURCE while returning semantically equal output." + :view + (text (expr :value (progn (etaf-value source) "same")))) + +(etaf-define-component etaf-test-input-equal (&key label) + "Count renders of a caller-owned semantic input." + :view + (text (expr :value + (progn (cl-incf etaf-test-input-render-count) label)))) + +(etaf-define-component etaf-test-target-priority (&key label) + "Render LABEL with an independently dirty render dependency." + :view + (text (expr :value + (progn + (cl-incf etaf-test-priority-render-count) + (format "%s/%s" label + (etaf-value etaf-test-priority-render-source)))))) + +(etaf-define-component etaf-test-local-style-parent () + "Project a locally reactive caller-owned slot through a styled child." + :styles + (styles (".live" :color "retained-color")) + :view + (etaf-test-styled-slot-child + (text :class "live" + (expr :value (etaf-value etaf-test-local-style-source))))) + +(etaf-define-component etaf-test-lazy-computed-owner () + "Create a lazy computed first evaluated by the render target." + :setup + (let* ((base (etaf-ref 1)) + (computed (etaf-computed (lambda () (* 2 (etaf-value base)))))) + (setq etaf-test-lazy-computed-base base + etaf-test-lazy-computed-value computed) + (lambda () + (etaf-view (text (expr :value (number-to-string + (etaf-value computed)))))))) + +(etaf-define-component etaf-test-wide-parent () + "Render a wide stable child list around one parent-owned value." + :setup + (lambda () + (etaf--view-call + 'column nil + (cons + (etaf--view-call + 'text nil (list (format "parent=%s" + (etaf-value etaf-test-wide-parent-source)))) + (cl-loop for cell in etaf-test-wide-parent-cells for index from 0 + collect + (etaf--view-call 'etaf-test-retained-leaf + (list :key index :label index :cell cell) + nil)))))) + +(etaf-define-component etaf-test-direct-range () + "Render static siblings and one direct retained material-child Range." + :setup + (let ((range (etaf--expr-create + :token 'etaf-test-direct-range-site + :thunk #'etaf-test--range-items)) + (color (etaf--expr-create + :token 'etaf-test-range-color-site + :thunk (lambda () + (cl-incf etaf-test-range-host-prop-calls) + "red")))) + (lambda () + (cl-incf etaf-test-range-component-renders) + (etaf--view-node-create + :name 'column :props nil + :children + (append + (cl-loop for index below etaf-test-range-static-count + collect (etaf--view-call + 'text (append + (list :key (intern (format "static-%s" index))) + (and (zerop index) (list :color color))) + (list (format "S%s" index)))) + (list range)))))) + +(etaf-define-component etaf-test-two-direct-ranges () + "Render two disjoint direct material Ranges from one source." + :setup + (let ((left (etaf--expr-create + :token 'etaf-test-left-range-site + :thunk (lambda () + (cl-incf etaf-test-range-left-evals) + (etaf-test--prefixed-range-items "L")))) + (right (etaf--expr-create + :token 'etaf-test-right-range-site + :thunk (lambda () + (cl-incf etaf-test-range-right-evals) + (etaf-test--prefixed-range-items "R"))))) + (lambda () + (etaf--view-node-create :name 'column :props nil + :children + (list (etaf--view-call 'text + (list :key 'static) + (list "S")) + left right))))) + +(etaf-define-component etaf-test-macro-range-token () + "Expose one macro-compiled direct expr callsite." + :view + (column (expr :value nil))) + +(etaf-define-component etaf-test-public-direct-range () + "Exercise a public macro-compiled direct material-child expr." + :view + (column + (text :key 'public-static "S") + (expr :value (etaf-test--range-items)))) + +(etaf-define-component etaf-test-counted-direct-range (&key count) + "Render COUNT static siblings before one stable direct Range callsite." + :setup + (let ((range (etaf--expr-create + :token 'etaf-test-counted-range-site + :thunk #'etaf-test--range-items))) + (lambda () + (cl-incf etaf-test-range-component-renders) + (etaf--view-node-create + :name 'column :props nil + :children + (append + (cl-loop for index below count + collect (etaf--view-call + 'text (list :key (intern (format "counted-%s" index))) + (list (format "C%s" index)))) + (list range)))))) + +(etaf-define-component etaf-test-string-sibling-range () + "Render bare string siblings around one direct Range." + :setup + (let ((range (etaf--expr-create + :token 'etaf-test-string-sibling-range-site + :thunk #'etaf-test--range-items))) + (lambda () + (etaf--view-node-create :name 'column :props nil + :children (list "prefix" range "suffix"))))) + +(etaf-define-component etaf-test-unsupported-direct-range () + "Start with a Host Range whose later unsupported output must fail." + :setup + (let ((range (etaf--expr-create + :token 'etaf-test-unsupported-range-site + :thunk #'etaf-test--unsupported-range-value))) + (lambda () + (etaf--view-node-create + :name 'column :props nil + :children (list (etaf--view-call 'text (list :key 'static) (list "S")) + range))))) + +(etaf-define-component etaf-test-public-string-range () + "Render one public direct expr whose Range item is a bare string." + :view + (column + (text :key 'static "S") + (expr :value (etaf-value etaf-test-string-range-source)))) + +(etaf-define-component etaf-test-nested-host-range () + "Render one Range whose keyed item owns keyed nested Hosts." + :setup + (let ((range (etaf--expr-create + :token 'etaf-test-nested-range-site + :thunk #'etaf-test--nested-range-value))) + (lambda () + (etaf--view-node-create + :name 'column :props nil + :children (list (etaf--view-call 'text (list :key 'static) (list "S")) + range))))) + +(etaf-define-component etaf-test-inline-owner () + "Render two independently reactive inline expression sites." + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-inline-updated-count))) + (lambda () + (cl-incf etaf-test-inline-component-renders) + (etaf-view + (text "A" + (expr :value + (progn (cl-incf etaf-test-inline-a-evals) + (etaf-value etaf-test-inline-a))) + "B" + (expr :value + (progn (cl-incf etaf-test-inline-b-evals) + (etaf-value etaf-test-inline-b)))))))) + +(etaf-define-component etaf-test-inline-shared-hosts () + "Render one shared source in two distinct text Hosts." + :view + (column + (text :key 'left + (expr :value + (progn (cl-incf etaf-test-inline-shared-evals) + (etaf-value etaf-test-inline-shared)))) + (text :key 'right + (expr :value + (progn (cl-incf etaf-test-inline-shared-evals) + (etaf-value etaf-test-inline-shared)))))) + +(etaf-define-component etaf-test-inline-dependency-branch () + "Return equal inline output while switching its source dependency." + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-inline-branch-updated))) + (lambda () + (etaf-view + (text + (expr :value + (progn + (cl-incf etaf-test-inline-branch-evals) + (if (etaf-value etaf-test-inline-branch-mode) + (etaf-value etaf-test-inline-branch-right) + (etaf-value etaf-test-inline-branch-left)) + "same"))))))) + +(etaf-define-component etaf-test-slot-env-child () + "Project the caller-owned default slot." + :setup + (lambda () + (cl-incf etaf-test-slot-consumer-renders) + (etaf-view (column (slot))))) + +(etaf-define-component etaf-test-slot-env-parent (&key label) + "Author an inline slot expression from parent LABEL." + :setup + (lambda () + (cl-incf etaf-test-slot-parent-renders) + (etaf-view + (etaf-test-slot-env-child + (text (expr :value label)))))) + +(etaf-define-component etaf-test-slot-env-consumer () + "Project a forwarded named header slot." + :setup + (lambda () + (cl-incf etaf-test-slot-consumer-renders) + (etaf-view (column (slot :name 'header))))) + +(etaf-define-component etaf-test-slot-env-forwarder () + "Forward the caller-owned named header slot." + :setup + (lambda () + (cl-incf etaf-test-slot-forwarder-renders) + (etaf--component-call-create + :spec etaf-test-slot-env-consumer--etaf-component-definition + :props nil + :slots (list (assq 'header etaf--current-component-slots))))) + +(etaf-define-component etaf-test-slot-env-named-parent (&key label) + "Author a named slot expression from parent LABEL." + :setup + (lambda () + (cl-incf etaf-test-slot-parent-renders) + (etaf-view + (etaf-test-slot-env-forwarder + (slot :name 'header + (text (expr :value label))))))) + +(etaf-define-component etaf-test-slot-range-parent () + "Author one reactive default slot Range." + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-slot-author-updated))) + (lambda () + (cl-incf etaf-test-slot-parent-renders) + (etaf-view + (etaf-test-slot-env-child + (expr :value (etaf-test--slot-range-items))))))) + +(etaf-define-component etaf-test-slot-range-named-parent () + "Author one reactive named slot through the Forwarder." + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-slot-author-updated))) + (lambda () + (cl-incf etaf-test-slot-parent-renders) + (etaf-view + (etaf-test-slot-env-forwarder + (slot :name 'header + (expr :value (etaf-test--slot-range-items)))))))) + +(etaf-define-component etaf-test-slot-range-fallback () + "Own one reactive fallback slot Range." + :styles (styles (".slot-item" :color "fallback-color")) + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-slot-consumer-updated))) + (lambda () + (cl-incf etaf-test-slot-consumer-renders) + (etaf-view + (column + (slot (expr :value (etaf-test--slot-range-items)))))))) + +(etaf-define-component etaf-test-slot-range-two-sites () + "Project the same default slot at two material sites." + :view + (column + (column :key 'left-site (slot)) + (column :key 'right-site (slot)))) + +(etaf-define-component etaf-test-slot-range-two-site-parent () + "Author one reactive slot consumed at two projection sites." + :view + (etaf-test-slot-range-two-sites + (expr :value (etaf-test--slot-range-items)))) + +(etaf-define-component etaf-test-slot-range-branch-parent (&key mode) + "Retarget slot dependencies from MODE while preserving equal output." + :setup + (lambda () + (cl-incf etaf-test-slot-parent-renders) + (etaf-view + (etaf-test-slot-env-child + (expr :value + (progn + (if mode + (etaf-value etaf-test-slot-branch-right) + (etaf-value etaf-test-slot-branch-left)) + (list (etaf-view (text :key 'same "same"))))))))) + +(etaf-define-component etaf-test-fragment-range-owner () + "Own one material fragment Range." + :setup + (lambda () + (cl-incf etaf-test-fragment-owner-renders) + (etaf-view + (column + (fragment + (expr :value (etaf-test--fragment-range-items))))))) + +(etaf-define-component etaf-test-raw-range-owner () + "Own one material raw Ebox Range." + :setup + (lambda () + (cl-incf etaf-test-raw-owner-renders) + (etaf-view + (column + (raw-ebox + :value (progn + (cl-incf etaf-test-raw-evals) + (ebox-create :content (etaf-value etaf-test-raw-source))) + :key (etaf-value etaf-test-raw-key-source)))))) + +(etaf-define-component etaf-test-transparent-owner () + "Render a transparent fragment sequence." + :setup + (lambda () + (cl-incf etaf-test-transparent-renders) + (etaf-view + (fragment + (expr :value + (mapcar (lambda (entry) + (etaf--view-call 'text (list :key (car entry)) + (list (cdr entry)))) + (etaf-value etaf-test-transparent-source))))))) + +(etaf-define-component etaf-test-transparent-parent () + "Own one transparent child beside static material Hosts." + :setup + (lambda () + (cl-incf etaf-test-transparent-parent-renders) + (etaf-view + (column + (text :key 'before "before") + (etaf-test-transparent-owner) + (text :key 'after "after"))))) + +(etaf-define-component etaf-test-transparent-inner () + "Render the inner transparent chain payload." + :setup + (lambda () + (cl-incf etaf-test-transparent-inner-renders) + (etaf-view + (fragment + (expr :value + (mapcar (lambda (entry) + (etaf--view-call 'text (list :key (car entry)) + (list (cdr entry)))) + (etaf-value etaf-test-transparent-source))))))) + +(etaf-define-component etaf-test-transparent-outer () + "Forward one transparent Component without a visual adapter." + :setup + (lambda () + (cl-incf etaf-test-transparent-outer-renders) + (etaf-view (fragment (etaf-test-transparent-inner))))) + +(etaf-define-component etaf-test-transparent-chain-parent () + "Place a transparent Component chain in one material parent." + :view (column (etaf-test-transparent-outer))) + +(etaf-define-component etaf-test-generation-context-consumer () + "Render one generation-owned Context dependency." + :setup + (lambda () + (cl-incf etaf-test-context-consumer-renders) + (etaf-view (text :color (etaf-inject 'generation-label) "context")))) + +(etaf-define-component etaf-test-generation-context-provider () + "Provide a candidate Context value to one retained consumer." + :setup + (lambda () + (cl-incf etaf-test-context-provider-renders) + (etaf-provide 'generation-label + (etaf-value etaf-test-context-provider-source)) + (etaf-view (etaf-test-generation-context-consumer)))) + +(etaf-define-component etaf-test-generation-context-range-provider () + "Provide Context directly to a retained child Range effect." + :setup + (lambda () + (etaf-provide 'generation-label + (etaf-value etaf-test-context-provider-source)) + (etaf-view + (column + (expr :value + (progn + (cl-incf etaf-test-context-range-evals) + (list (etaf--view-call + 'text (list :key 'context-range) + (list (etaf-inject 'generation-label)))))))))) + +(etaf-define-component etaf-test-generation-context-slot-consumer () + "Project one material slot Range for Context ownership tests." + :setup + (lambda () + (cl-incf etaf-test-slot-consumer-renders) + (etaf-view (column (slot))))) + +(etaf-define-component etaf-test-generation-context-slot-provider () + "Provide Context to an authored slot Range expression." + :setup + (lambda () + (cl-incf etaf-test-context-provider-renders) + (etaf-provide 'generation-label + (etaf-value etaf-test-context-provider-source)) + (etaf-view + (etaf-test-generation-context-slot-consumer + (expr :value + (progn + (cl-incf etaf-test-slot-range-evals) + (list (etaf--view-call + 'text (list :key 'context-slot) + (list (etaf-inject 'generation-label)))))))))) + +(etaf-define-component etaf-test-prop-env-child (&key value) + "Render VALUE received from a parent Component." + :view (text (expr :value value))) + +(etaf-define-component etaf-test-prop-env-parent (&key label) + "Forward dynamic parent LABEL into a nested Component prop." + :view (etaf-test-prop-env-child :value label)) + +(etaf-define-component etaf-test-inline-input-priority (&key label) + "Render candidate LABEL with one independently dirty inline source." + :setup + (progn + (etaf-on-updated (lambda () (cl-incf etaf-test-inline-priority-updated))) + (lambda () + (cl-incf etaf-test-inline-priority-renders) + (etaf-view + (text + (expr :value + (progn + (cl-incf etaf-test-inline-priority-evals) + (format "%s/%s" label + (etaf-value etaf-test-inline-priority-source))))))))) + +(etaf-define-component etaf-test-inline-styled-owner () + "Render a styled inline expression beside a side-effecting Host prop." + :view + (text :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red") + "P" + (expr :value + (progn + (cl-incf etaf-test-inline-styled-evals) + (etaf-view + (text :face 'bold + (expr :value + (etaf-value etaf-test-inline-styled-source)))))))) + +(etaf-define-component etaf-test-range-input-priority (&key marker) + "Render fixed Range structure whose item reads MARKER and a reactive source." + :setup + (let ((range + (etaf--expr-create + :token 'etaf-test-range-input-priority-site + :thunk + (lambda () + (cl-incf etaf-test-range-evals) + (list + (etaf--view-call + 'text (list :key 'item :ref 'item) + (list (format "%s/%s" marker + (etaf-value etaf-test-range-source))))))))) + (lambda () + (cl-incf etaf-test-range-component-renders) + (etaf--view-node-create + :name 'column :props nil + :children (list (etaf--view-call 'text (list :key 'static) (list "S")) + range))))) + +(etaf-define-component etaf-test-next-turn () + "Write TARGET after publishing a SOURCE update." + :setup + (let ((source-cell etaf-test-next-turn-source) + (target-cell etaf-test-next-turn-sink)) + (etaf-on-updated + (lambda () + (when (and etaf-test-next-turn-target + (zerop (etaf-value target-cell))) + (setf (etaf-value target-cell) 1)))) + (lambda () + (etaf-view + (text (expr :value + (format "%s/%s" (etaf-value source-cell) + (etaf-value target-cell)))))))) (defun etaf-test--render-text (view) "Return plain rendered text for VIEW." @@ -26,6 +728,13 @@ (substring-no-properties (ebox-render (etaf-render view))) nil t)) +(defun etaf-test--buffer-text (buffer-name) + "Return normalized plain text from mounted BUFFER-NAME." + (with-current-buffer buffer-name + (string-trim + (replace-regexp-in-string + "[[:space:]]+" " " (substring-no-properties (buffer-string)))))) + (etaf-define-component etaf-test-badge (&key label) "Render LABEL as a small semantic test Component." :view @@ -66,6 +775,23 @@ (text :class "title" :color "inline-title" "Title") (text "Body"))) +(etaf-define-component etaf-test-nil-style-host () + "Allow a Component style to fill an explicit nil Host property." + :styles + (styles + (".fill" :color "style-color")) + :view + (text :class "fill" :color nil "Nil")) + +(etaf-define-component etaf-test-style-rule-order (&key color) + "Allow a later matching Component rule to refine an earlier rule." + :styles + (styles + ("&" :color "base-color") + ("&.accent" :color "accent-color")) + :view + (text :class "accent" :color color "Accent")) + (etaf-define-component etaf-test-styled-child () "Render a child Host for nested style scope tests." :view @@ -79,12 +805,35 @@ :view (etaf-test-styled-child)) +(etaf-define-component etaf-test-styled-slot-child () + "Project caller-owned slot content without adding a style scope." + :view + (slot)) + +(etaf-define-component etaf-test-styled-slot-parent () + "Style caller-owned slot content while containing child internals." + :styles + (styles + (".slot-content" :color "parent-color")) + :view + (etaf-test-styled-slot-child + (text :class "slot-content" "Slot"))) + +(etaf-define-component etaf-test-styled-fallback-child () + "Style fallback content authored by the child Component." + :styles + (styles + (".fallback-content" :color "child-color")) + :view + (slot + (text :class "fallback-content" "Fallback"))) + (etaf-define-component etaf-test-themed-text () "Provide Theme defaults to one text Host." :setup (progn (etaf-theme-provide '(:color "theme-color" :bgcolor "theme-bg")) - (lambda () (etaf-view (text "Themed"))))) + (lambda () (etaf-view (text :color nil "Themed"))))) (etaf-define-component etaf-test-stateful (&key label) "Render a retained counter for Runtime tests." @@ -145,7 +894,159 @@ (signal 'etaf-runtime-error (list "test candidate failed"))) (etaf-view (text - (expr :value (format "stable:%d" (etaf-value cell)))))))) + (expr :value (format "stable:%d" (etaf-value cell)))))))) + +(etaf-define-component etaf-test-late-branch () + "Read a late reactive ref only after switching render branches." + :setup + (let ((page (etaf-ref "page")) + (late (etaf-ref "late")) + (late-branch (etaf-ref nil))) + (setq etaf-test-branch-page-cell page + etaf-test-branch-late-cell late + etaf-test-branch-mode-cell late-branch) + (lambda () + (etaf-view + (text + (expr :value + (if (etaf-value late-branch) + (etaf-value late) + (etaf-value page)))))))) + +(etaf-define-component etaf-test-event-batch-stateful () + "Render a callback with computed, watch, and effect dependents." + :setup + (let* ((source (etaf-ref 0)) + (computed (etaf-computed + (lambda () (* 2 (etaf-value source))))) + (watch-value (etaf-ref "watch:0")) + (effect-value (etaf-ref "effect:0")) + (last-effect "effect:0")) + (setq etaf-test-event-batch-source source) + (etaf-watch + source + (lambda (new _old) + (setf (etaf-value watch-value) (format "watch:%d" new))) + :immediate nil) + (etaf-watch-effect + (lambda () + (let ((next (format "effect:%d" (etaf-value computed)))) + (unless (equal next last-effect) + (setq last-effect next) + (setf (etaf-value effect-value) next))))) + (lambda () + (etaf-view + (column + (text :ref 'event-batch-trigger + :on-press (lambda () (setf (etaf-value source) 2)) + "Update") + (text + (expr :value + (format "source=%d computed=%d %s %s" + (etaf-value source) + (etaf-value computed) + (etaf-value watch-value) + (etaf-value effect-value))))))))) + +(etaf-define-component etaf-test-event-batch-noop () + "Render an event callback that performs no state write." + :view + (text :ref 'event-batch-noop + :on-press (lambda () nil) + "No-op")) + +(etaf-define-component etaf-test-event-batch-nested () + "Render an outer callback that dispatches one nested public event." + :setup + (let ((state (etaf-ref "idle"))) + (lambda () + (etaf-view + (column + (text :ref 'event-batch-nested-outer + :on-press + (lambda () + (etaf-dispatch-event + (etaf-current-runtime) + 'event-batch-nested-inner 'press)) + "Outer") + (text :ref 'event-batch-nested-inner + :on-press (lambda () (setf (etaf-value state) "nested")) + "Inner") + (text (expr :value (etaf-value state)))))))) + +(etaf-define-component etaf-test-event-batch-behavior () + "Render a toggleable Behavior whose callback writes two refs." + :setup + (let ((left (etaf-ref nil)) + (right (etaf-ref nil))) + (lambda () + (etaf-view + (column + (text :ref 'event-batch-behavior + :use + (list + (etaf-toggleable + :value left + :on-change + (lambda (value) + (setf (etaf-value left) value + (etaf-value right) value)))) + "Toggle") + (text + (expr :value + (format "left=%s right=%s" + (if (etaf-value left) "on" "off") + (if (etaf-value right) "on" "off"))))))))) + +(etaf-define-component etaf-test-event-batch-theme () + "Render a computed Theme changed by a public event callback." + :setup + (let* ((dark (etaf-ref nil)) + (theme (etaf-computed + (lambda () + (if (etaf-value dark) + '(:color "dark") + '(:color "light")))))) + (etaf-theme-provide theme) + (lambda () + (etaf-view + (column + (text :ref 'event-batch-theme-toggle + :on-press + (lambda () + (setf (etaf-value dark) (not (etaf-value dark)))) + "Theme") + (text (expr :value + (format "theme=%s" (etaf-theme-value :color))))))))) + +(etaf-define-component etaf-test-event-batch-resource (&key resource fail) + "Render synchronous Resource success and error state transitions." + :setup + (let ((instance-resource resource) + (instance-fail fail)) + (lambda () + (etaf-view + (column + (text :ref 'event-batch-resource-success + :on-press + (lambda () + (setf (etaf-value instance-fail) nil) + (etaf-resource-load instance-resource)) + "Load success") + (text :ref 'event-batch-resource-error + :on-press + (lambda () + (setf (etaf-value instance-fail) t) + (etaf-resource-load instance-resource)) + "Load error") + (text + (expr :value + (format "status=%s value=%s error=%s" + (etaf-resource-status instance-resource) + (or (etaf-resource-value instance-resource) "none") + (if (etaf-resource-error instance-resource) + "yes" + "no"))))))))) (etaf-define-behavior etaf-test-cleanup-behavior (&rest attributes) "Construct a Behavior whose disposal is visible to tests." @@ -154,6 +1055,7 @@ (append attributes (list :install (lambda () + (cl-incf etaf-test-behavior-installs) (setq etaf-test-behavior-runtime (etaf-behavior-context-runtime (etaf-current-behavior-context))) @@ -364,23 +1266,64 @@ (should (equal "style-root" (ebox-get node :color))) (should-not (ebox-get body :color)))) -(ert-deftest etaf-styles-continue-through-nested-components () - "Apply a parent Component selector to a nested Component Host." +(ert-deftest etaf-nil-host-props-allow-component-styles () + "Treat an explicit nil Host style property as unspecified." + (let ((node (etaf-render (etaf-view (etaf-test-nil-style-host))))) + (should (equal "style-color" (ebox-get node :color))))) + +(ert-deftest etaf-style-rules-preserve-first-default-with-inline-protection () + "Keep the first matching Component default without overriding inline props." + (let ((node (etaf-render (etaf-view (etaf-test-style-rule-order))))) + (should (equal "base-color" (ebox-get node :color)))) + (let ((node (etaf-render + (etaf-view + (etaf-test-style-rule-order :color "inline-color"))))) + (should (equal "inline-color" (ebox-get node :color))))) + +(ert-deftest etaf-styles-stop-at-nested-component-boundaries () + "Keep a parent Component selector outside nested Component internals." (let ((node (etaf-render (etaf-view (etaf-test-styled-parent))))) + (should-not (ebox-get node :color)))) + +(ert-deftest etaf-styles-follow-caller-owned-slot-content () + "Keep caller styles on slot content projected by a child Component." + (let ((node (etaf-render (etaf-view (etaf-test-styled-slot-parent))))) (should (equal "parent-color" (ebox-get node :color))))) -(ert-deftest etaf-mounted-styles-continue-through-nested-components () - "Apply a parent Component selector through the mounted Runtime." +(ert-deftest etaf-styles-keep-child-owned-slot-fallback-pure () + "Keep child styles on fallback content authored by that Component." + (let ((node (etaf-render (etaf-view (etaf-test-styled-fallback-child))))) + (should (equal "child-color" (ebox-get node :color))))) + +(ert-deftest etaf-mounted-styles-keep-child-owned-slot-fallback () + "Keep child styles on fallback content through the Runtime path." + (let ((buffer-name " *etaf-mounted-style-fallback-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-styled-fallback-child))) + (should + (equal "child-color" + (ebox-get + (etaf-runtime-root-node + (etaf-runtime-for-buffer buffer-name)) + :color)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + +(ert-deftest etaf-mounted-styles-stop-at-nested-component-boundaries () + "Keep a parent Component selector outside mounted child internals." (let ((buffer-name " *etaf-mounted-style-test*")) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (etaf-test-styled-parent))) (should - (equal "parent-color" - (ebox-get - (etaf-runtime-root-node - (etaf-runtime-for-buffer buffer-name)) - :color)))) + (null + (ebox-get + (etaf-runtime-root-node + (etaf-runtime-for-buffer buffer-name)) + :color)))) (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) (when-let ((buffer (get-buffer buffer-name))) @@ -429,6 +1372,13 @@ (should (equal "Count:0" (buffer-string)))) (should (= etaf-test-setup-count 1)) (should (= etaf-test-mounted-count 1)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-state-cell)))) + (should (eq 'inline + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id))))) (setf (etaf-value etaf-test-state-cell) 1) (with-current-buffer buffer-name (should (equal "Count:1" (buffer-string)))) @@ -441,6 +1391,50 @@ (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-runtime-recollects-late-branch-dependencies () + "Recollect refs introduced by a branch after the initial mount." + (let ((buffer-name " *etaf-runtime-late-branch-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-late-branch))) + (with-current-buffer buffer-name + (should (equal "page" (buffer-string)))) + (setf (etaf-value etaf-test-branch-mode-cell) t) + (with-current-buffer buffer-name + (should (equal "late" (buffer-string)))) + (setf (etaf-value etaf-test-branch-late-cell) "late-updated") + (with-current-buffer buffer-name + (should (equal "late-updated" (buffer-string))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-branch-switch-keeps-equal-sources-distinct () + "Index equal-valued reactive sources by identity across a branch switch." + (let ((buffer-name " *etaf-runtime-equal-source-branch-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-late-branch))) + (setf (etaf-value etaf-test-branch-page-cell) "same") + (setf (etaf-value etaf-test-branch-late-cell) "same") + (setf (etaf-value etaf-test-branch-mode-cell) t) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (before (etaf-runtime-generation runtime))) + (should-not (etaf--generation-source-effects + generation etaf-test-branch-page-cell)) + (should (etaf--generation-source-effects + generation etaf-test-branch-late-cell)) + (setf (etaf-value etaf-test-branch-page-cell) "old-only") + (should (= before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-branch-late-cell) "new-only") + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (equal "new-only" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + (ert-deftest etaf-context-provide-inject-follows-component-tree () "Resolve the nearest Context and react to its provided ref." (let ((buffer-name " *etaf-context-test*")) @@ -476,6 +1470,14 @@ :on-press (lambda () (etaf-dispatch 'etaf-test-action)) "Press"))) (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (let* ((generation (etaf-runtime-current-generation runtime)) + (entry (car (etaf--generation-index-entries + generation 'behaviors))) + (resource-key (cdr entry))) + (should entry) + (should (consp resource-key)) + (should (gethash resource-key + (etaf-runtime-resource-registry runtime)))) (etaf-dispatch-event runtime 'interactive 'press) (should (= etaf-test-event-count 1)) (should (equal '(press) @@ -489,11 +1491,39 @@ (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-runtime-composes-host-and-behavior-events-in-order () + "Run an explicit Host callback before its Behavior callback. + +Event composition is a Runtime contract, not a UI-library helper contract." + (let ((buffer-name " *etaf-event-composition-test*") + (order nil)) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (text + :ref 'composed + :use (list + (etaf-test-cleanup-behavior + :on-press (lambda () (setq order (append order '(behavior)))))) + :on-press (lambda () (setq order (append order '(host)))) + "Press"))) + (etaf-dispatch-event (etaf-runtime-for-buffer buffer-name) + 'composed 'press) + (should (equal order '(host behavior)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + (ert-deftest etaf-behavior-replacement-disposes-previous-installer () "Dispose a replaced Behavior while retaining the public installer path." (let ((buffer-name " *etaf-behavior-replace-test*") - (marker (etaf-ref 0))) + (marker (etaf-ref 0)) + (trigger (etaf-ref 0))) (setq etaf-test-behavior-cleanups 0 + etaf-test-behavior-installs 0 etaf-test-behavior-runtime nil) (unwind-protect (progn @@ -502,17 +1532,69 @@ (etaf-view (text :ref 'behavior-host + :aria-label (progn (etaf-value trigger) "behavior") :use (list (etaf-test-cleanup-behavior :class (format "mode-%d" (etaf-value marker)))) "Behavior"))) (should (etaf-runtime-p etaf-test-behavior-runtime)) + (should (= 1 etaf-test-behavior-installs)) + (setf (etaf-value trigger) 1) + ;; The render creates a fresh installer closure. Function identity + ;; is part of Behavior equality, so the old installer is disposed + ;; before the new one is staged. + (should (= 2 etaf-test-behavior-installs)) + (should (= 1 etaf-test-behavior-cleanups)) + (should (etaf--generation-index-entries + (etaf-runtime-current-generation + (etaf-runtime-for-buffer buffer-name)) + 'behaviors)) (setf (etaf-value marker) 1) - (should (= 1 etaf-test-behavior-cleanups))) + (should (= 3 etaf-test-behavior-installs)) + (should (= 2 etaf-test-behavior-cleanups))) (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-unmount runtime)) (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-behavior-rollback-cleanups-continue-and-diagnose () + "Run candidate Behavior cleanup in reverse order despite error and quit." + (let* ((runtime (etaf--runtime-create + :behaviors (make-hash-table :test #'equal) + :candidate-behaviors (make-hash-table :test #'equal))) + (trace nil) + (first (etaf-behavior-create 'first)) + (second (etaf-behavior-create 'second))) + (puthash '(a first) + (cons first (lambda () (push 'first trace) (error "first"))) + (etaf-runtime-candidate-behaviors runtime)) + (puthash '(b second) + (cons second (lambda () (push 'second trace) (signal 'quit nil))) + (etaf-runtime-candidate-behaviors runtime)) + (etaf--runtime-rollback-behaviors runtime) + (should (equal '(first second) trace)) + (should (= 2 (length (etaf-runtime-diagnostics runtime)))) + (should (equal '(behavior-rollback behavior-rollback) + (mapcar (lambda (entry) (plist-get entry :phase)) + (reverse (etaf-runtime-diagnostics runtime))))))) + +(ert-deftest etaf-runtime-target-equality-keeps-function-and-reactive-identity () + "Use EQ for function/reactive leaves while comparing scalar structure." + (let* ((source (etaf-ref 1)) + (callback (lambda () 1)) + (left (list :value source :callback callback :count 1)) + (same (list :value source :callback callback :count 1)) + (new (list :value source :callback (lambda () 1) :count 1))) + (should (etaf--runtime-target-value-equal-p left same)) + (should-not (etaf--runtime-target-value-equal-p left new)) + (should (etaf--runtime-behavior-spec-equal-p + (etaf-behavior-create 'stable :value source :install callback) + (etaf-behavior-create 'stable :value source :install callback))) + (should-not (etaf--runtime-behavior-spec-equal-p + (etaf-behavior-create 'stable :value source + :install (lambda () nil)) + (etaf-behavior-create 'stable :value source + :install (lambda () nil)))))) + (ert-deftest etaf-toggleable-reads-reactive-value-at-event-time () "Use the current reactive value when a toggleable Behavior is pressed." (let ((value (etaf-ref nil)) received) @@ -590,6 +1672,140 @@ (should (= 3 runs)) (etaf--stop-effect effect))) +(ert-deftest etaf-runtime-root-owner-is-only-full-rebuild-entry () + "Keep complete-root publication isolated to Root-owner control flow." + (let ((file (expand-file-name + "etaf-runtime.el" + (file-name-directory (or (locate-library "etaf") + default-directory)))) + source) + (with-temp-buffer + (insert-file-contents file) + (setq source (buffer-string))) + ;; Mounted non-root invalidations set only their effect queue. The sole + ;; setter is the Root effect route; mount construction's initial t is not + ;; a mounted invalidation. + (should (= 1 (let ((start 0) count) + (while (string-match + "(setf (etaf-runtime-root-dirty-p runtime) t)" + source start) + (setq count (1+ (or count 0)) + start (match-end 0))) + count))) + (let* ((start (string-match + "(defun etaf--runtime-component-overlay" + source)) + (end (string-match + "(defun etaf--runtime-render-effect" + source start)) + (overlay (substring source start end))) + (should-not (string-match-p "etaf--runtime-render-effect" overlay)) + (should-not (string-match-p "etaf--runtime-evaluate-root-candidate" + overlay))) + ;; Flush has one mutually exclusive Root branch and one local overlay + ;; branch; this guards against accidentally routing all mounted effects + ;; through the Root adapter again. + (should (string-match-p + "(if (etaf-runtime-root-dirty-p runtime)" + source)))) + +(ert-deftest etaf-runtime-fixed-point-tuple-detects-repeated-input () + "Reject a repeated Runtime effect tuple only within one flush." + (let* ((runtime (etaf--runtime-create :mount-epoch 77)) + (source (etaf-ref nil)) + (effect (etaf--generation-effect-create + :effect-id 3 :kind 'range :deps (list source))) + (generation (etaf--generation-create + :generation-id 1 + :effect-map (etaf--pvec-put nil 3 effect))) + (etaf--runtime-fixed-point-stamps + (make-hash-table :test #'equal))) + (should (etaf--runtime-record-effect-input-version + runtime generation 3)) + (should-error + (etaf--runtime-record-effect-input-version runtime generation 3) + :type 'etaf-runtime-error) + (setf (etaf-ref-version source) 1) + (should (etaf--runtime-record-effect-input-version + runtime generation 3)))) + +(ert-deftest etaf-runtime-fixed-point-step-bound-stops-monotonic-cycle () + "Stop a cycle whose source version changes on every evaluation." + (let* ((runtime (etaf--runtime-create :mount-epoch 78)) + (source (etaf-ref nil)) + (effect (etaf--generation-effect-create + :effect-id 4 :kind 'range :deps (list source))) + (generation (etaf--generation-create + :generation-id 1 + :effect-map (etaf--pvec-put nil 4 effect))) + (etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal)) + (etaf--runtime-fixed-point-steps 0) + (etaf--runtime-fixed-point-step-bound 2)) + (etaf--runtime-record-effect-input-version runtime generation 4) + (setf (etaf-ref-version source) 1) + (etaf--runtime-record-effect-input-version runtime generation 4) + (setf (etaf-ref-version source) 2) + (should-error + (etaf--runtime-record-effect-input-version runtime generation 4) + :type 'etaf-runtime-error))) + +(ert-deftest etaf-runtime-fixed-point-long-acyclic-chain-fits-bound () + "Allow a long chain of distinct effect tuples within the graph bound." + (let ((runtime (etaf--runtime-create :mount-epoch 79)) + (etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal)) + (etaf--runtime-fixed-point-steps 0) + (etaf--runtime-fixed-point-step-bound 164) + (generation (etaf--generation-create :generation-id 1 + :effect-map nil))) + (dotimes (index 40) + (let* ((source (etaf-ref nil)) + (effect-id (1+ index)) + (effect (etaf--generation-effect-create + :effect-id effect-id :kind 'range :deps (list source)))) + (setf (etaf-generation-effect-map generation) + (etaf--pvec-put (etaf-generation-effect-map generation) + effect-id effect)) + (etaf--runtime-record-effect-input-version runtime generation effect-id))) + (should (= 40 etaf--runtime-fixed-point-steps)))) + +(ert-deftest etaf-runtime-fixed-point-tuple-includes-candidate-facts-and-path () + "Detect candidate semantic cycles and retain an effect/edge path." + (let* ((source (etaf-ref nil)) + (runtime + (etaf--runtime-create + :mount-epoch 80 :next-effect-id 2 + :candidate-effects (make-hash-table :test #'eql) + :candidate-graph-nodes (make-hash-table :test #'eql) + :route-sources (make-hash-table :test #'eq))) + (effect + (etaf--generation-effect-create + :effect-id 1 :kind 'range :semantic-id 11 :deps (list source))) + (generation + (etaf--generation-create + :generation-id 1 + :effect-map (etaf--pvec-put nil 1 effect))) + (semantic + (etaf--semantic-range-create + :semantic-id 11 :identity '(candidate-range) + :effect-id 1 :kind 'range :composition-version 1 + :output-signature '("A") :context-deps nil))) + (puthash 1 effect (etaf-runtime-candidate-effects runtime)) + (puthash 11 semantic (etaf-runtime-candidate-graph-nodes runtime)) + (let ((etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal)) + (etaf--runtime-fixed-point-history nil) + (etaf--runtime-fixed-point-steps 0) + (etaf--runtime-fixed-point-step-bound 8)) + (etaf--runtime-record-effect-input-version runtime generation 1) + (setf (etaf--semantic-range-composition-version semantic) 2) + (etaf--runtime-record-effect-input-version runtime generation 1) + (let (condition) + (condition-case err + (etaf--runtime-record-effect-input-version runtime generation 1) + (etaf-runtime-error (setq condition (cdr err)))) + (should condition) + (should (plist-get condition :path)) + (should (= 3 (length (plist-get condition :path)))))))) + (ert-deftest etaf-view-raw-ebox-is-an-explicit-backend-escape () "Lower a public Ebox node only through the explicit raw escape." (let ((node @@ -697,6 +1913,2336 @@ (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) +(ert-deftest etaf-event-dispatch-batches-reactive-publication () + "Publish one final tree for a callback's reactive dependency chain." + (let ((buffer-name " *etaf-event-batch-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-event-batch-stateful))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-trigger 'press) + (with-current-buffer buffer-name + (should (string-match-p + "source=2 computed=4 watch:2 effect:4" + (buffer-string)))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (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-pvec-put-many-preserves-values-and-shares-untouched-branches () + "Batch persistent-vector updates match sequential puts and share untouched paths." + (let* ((untouched-id (* 31 (expt 2 30))) + (base (etaf--pvec-put + (etaf--pvec-put nil untouched-id 'untouched) + 1 'old)) + (sequential-metrics (etaf--generation-metrics-create)) + (batch-metrics (etaf--generation-metrics-create)) + (sequential + (etaf--pvec-put + (etaf--pvec-put + (etaf--pvec-put + (etaf--pvec-put base 1 'new) 2 'two sequential-metrics) + 3 'three sequential-metrics) + 1 'final sequential-metrics)) + (batch + (etaf--pvec-put-many + base '((1 . new) (2 . two) (3 . three) (1 . final)) + batch-metrics)) + (base-children (etaf--pvec-node-children base)) + (batch-children (etaf--pvec-node-children batch)) + (untouched-slot (logand 31 (ash untouched-id (* -5 6))))) + (should (equal (etaf--pvec-get batch 1) 'final)) + (should (equal (etaf--pvec-get batch 2) 'two)) + (should (equal (etaf--pvec-get batch 3) 'three)) + (should (equal (etaf--pvec-get batch untouched-id) 'untouched)) + (should (equal (etaf--pvec-get batch 1) + (etaf--pvec-get sequential 1))) + (should (eq (aref base-children untouched-slot) + (aref batch-children untouched-slot))) + (should (< (etaf--generation-metrics-node-copies batch-metrics) + (etaf--generation-metrics-node-copies sequential-metrics))))) + +(ert-deftest etaf-runtime-component-overlay-does-zero-unrelated-work () + "Point-update one of 500 retained Components without Root or sibling work." + (let* ((buffer-name " *etaf-persistent-generation-test*") + (cells (cl-loop repeat 500 collect (etaf-ref 0))) + (etaf-test-retained-render-counts (make-hash-table :test #'eql)) + (root-calls 0) + (view + (lambda () + (cl-incf root-calls) + (etaf--view-call + 'column nil + (cl-loop for cell in cells for index from 0 + collect + (etaf--view-call + 'etaf-test-retained-leaf + (list :key index :label index :cell cell) nil)))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (clrhash etaf-test-retained-render-counts) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (old (etaf-runtime-current-generation runtime)) + (old-index (etaf-generation-identity-index old))) + (setf (etaf-value (nth 247 cells)) 1) + (let ((metrics (etaf-runtime-candidate-generation-metrics runtime)) + (new (etaf-runtime-current-generation runtime))) + (should (= 1 root-calls)) + (should (= 1 (gethash 247 etaf-test-retained-render-counts 0))) + (should (= 1 (hash-table-count etaf-test-retained-render-counts))) + (should (eq old-index (etaf-generation-identity-index new))) + (should (<= (etaf--generation-metrics-node-copies metrics) 128))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-shared-source-renders-siblings-in-one-commit () + "Render exactly two subscribing siblings and publish one candidate." + (let* ((buffer-name " *etaf-shared-source-siblings-test*") + (shared (etaf-ref 0)) (unrelated (etaf-ref 0)) + (root-calls 0) (commits 0) (replacements 0) + (etaf-test-retained-render-counts (make-hash-table :test #'equal)) + (view + (lambda () + (cl-incf root-calls) + (etaf--view-call + 'column nil + (list + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'a :label "A" :cell shared) nil) + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'b :label "B" :cell shared) nil) + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'u :label "U" :cell unrelated) nil)))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (clrhash etaf-test-retained-render-counts) + (let ((old-commit (symbol-function 'ebox-commit)) + (old-replace (symbol-function 'ebox-candidate-replace-host-ref)) + (runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args))) + ((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf replacements) (apply old-replace args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value shared) 1) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (should (= 1 commits)) + (should (= 2 replacements)) + (should (= 1 (gethash "A" etaf-test-retained-render-counts 0))) + (should (= 1 (gethash "B" etaf-test-retained-render-counts 0))) + (should (zerop (gethash "U" etaf-test-retained-render-counts 0))) + (should (= 1 root-calls)) + (should (= 1 (hash-table-count (etaf-ref-subscribers shared)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-root-rebuild-retains-unchanged-sibling-routes () + "Retain an unchanged sibling semantic subtree across a Root-owned rebuild." + (let* ((buffer-name " *etaf-root-retain-sibling-test*") + (root-source (etaf-ref "A")) + (left-cell (etaf-ref 0)) (right-cell (etaf-ref 0)) + (root-calls 0) + (etaf-test-retained-render-counts (make-hash-table :test #'equal)) + (view + (lambda () + (cl-incf root-calls) + (etaf--view-call + 'column nil + (list + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'left + :label (etaf-value root-source) + :cell left-cell) nil) + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'right :label "R" + :cell right-cell) nil)))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (clrhash etaf-test-retained-render-counts) + (setf (etaf-value root-source) "B") + (should (= 1 (gethash "B" etaf-test-retained-render-counts 0))) + (should (zerop (gethash "R" etaf-test-retained-render-counts 0))) + (clrhash etaf-test-retained-render-counts) + (let ((root-before root-calls)) + (setf (etaf-value right-cell) 1) + (should (= root-before root-calls)) + (should (= 1 (gethash "R" etaf-test-retained-render-counts 0))) + (should (zerop (gethash "B" etaf-test-retained-render-counts 0))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-setup-read-is-not-a-render-dependency () + "Do not subscribe a Component render owner to setup-only reads." + (let ((buffer-name " *etaf-setup-dependency-test*") + (setup-source (etaf-ref 0)) (render-source (etaf-ref "A"))) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf--view-call 'etaf-test-setup-read-owner + (list :setup-source setup-source + :render-source render-source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (setf (etaf-value setup-source) 1) + (should (= before (etaf-runtime-generation runtime))) + (setf (etaf-value render-source) "B") + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (equal "B" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-dependency-only-promotion-skips-ebox-publication () + "Promote changed dependencies/output inputs without an Ebox commit." + (let ((buffer-name " *etaf-dependency-only-test*") + (source (etaf-ref 0)) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-dependency-only + (list :source source) nil)) + (let ((runtime (etaf-runtime-for-buffer buffer-name)) + (before-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) + (apply before-commit args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value source) 1) + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (zerop commits)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-equal-component-input-skips-render () + "Promote an input target dependency change without running its render target." + (let ((buffer-name " *etaf-input-equal-test*") (trigger (etaf-ref 0))) + (setq etaf-test-input-render-count 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-input-equal + :label (progn (etaf-value trigger) "same")))) + (setq etaf-test-input-render-count 0) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (setf (etaf-value trigger) 1) + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (zerop etaf-test-input-render-count)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-input-target-precedes-render-target () + "Render once with final inputs regardless of batched source write order." + (dolist (order '((input render) (render input))) + (let ((buffer-name (format " *etaf-target-order-%S*" order)) + (input (etaf-ref "A")) (render (etaf-ref 0))) + (setq etaf-test-priority-render-source render + etaf-test-priority-render-count 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-target-priority :label (etaf-value input)))) + (setq etaf-test-priority-render-count 0) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-runtime-event-begin runtime) + (dolist (which order) + (if (eq which 'input) + (setf (etaf-value input) "B") + (setf (etaf-value render) 1))) + (etaf-runtime-event-end runtime) + (should (= 1 etaf-test-priority-render-count)) + (should (= 1 (- (etaf-runtime-generation runtime) before))) + (should (equal "B/1" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-local-component-retains-caller-style-environment () + "Preserve caller style/slot environment across a Component-only update." + (let ((buffer-name " *etaf-local-style-environment-test*") + (source (etaf-ref "A"))) + (setq etaf-test-local-style-source source) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-local-style-parent))) + (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))))) + (should-not (memq (etaf--semantic-component-effect-id parent) + effects)) + (setf (etaf-value source) "B") + (with-current-buffer buffer-name + (let ((text (buffer-string))) + (should (equal "B" (substring-no-properties text))) + (should (equal '(:foreground "retained-color") + (get-text-property 0 'face text))))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-lazy-computed-owns-its-underlying-dependency () + "Route Component to computed while its ordinary effect owns the base ref." + (let ((buffer-name " *etaf-lazy-computed-owner-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-lazy-computed-owner))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime))) + (should (etaf--generation-source-effects + generation etaf-test-lazy-computed-value)) + (should-not (etaf--generation-source-effects + generation etaf-test-lazy-computed-base)) + (should (= 1 (hash-table-count + (etaf-ref-subscribers + etaf-test-lazy-computed-base)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-lazy-computed-base) 3) + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (equal "6" (etaf-test--buffer-text buffer-name)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-reactive-post-publication-write-runs-next-runtime-turn () + "Drain a lifecycle source write as a distinct following Runtime turn." + (let ((buffer-name " *etaf-next-turn-test*") + (source (etaf-ref 0)) (target (etaf-ref 0)) + (etaf-test-next-turn-target t) + (etaf-test-next-turn-source nil) + (etaf-test-next-turn-sink nil)) + (unwind-protect + (progn + (setq etaf-test-next-turn-source source + etaf-test-next-turn-sink target) + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-next-turn nil nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (setf (etaf-value source) 1) + (should (= 2 (- (etaf-runtime-generation runtime) before))) + (should (equal "1/1" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-route-is-opaque-and-unmount-disarms-sources () + "Keep sources free of Runtime closures and remove route tokens on unmount." + (let ((buffer-name " *etaf-route-lifetime-test*") (source (etaf-ref 0))) + (let ((baseline (hash-table-count (etaf-ref-subscribers source)))) + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-dependency-only + (list :source source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (route (etaf-runtime-route-token runtime))) + (should (symbolp (etaf-runtime-route-scheduler route))) + (should-not (functionp (etaf-runtime-route-runtime-id route))) + (should (gethash route (etaf-ref-subscribers source))) + (etaf-unmount runtime) + (should (= baseline (hash-table-count (etaf-ref-subscribers source))))) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-participant-publish-failure-restores-generation () + "Restore generation and Ebox state when participant publish fails after swap." + (let ((buffer-name " *etaf-generation-rollback-test*") + (source (etaf-ref 0)) + (etaf-test-retained-render-counts (make-hash-table :test #'eql))) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-retained-leaf + (list :label 1 :cell source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-generation (etaf-runtime-current-generation runtime)) + (old-swap (symbol-function 'etaf--runtime-swap-generation)) + (old-rollback + (symbol-function 'etaf--runtime-participant-rollback)) + (resource-count + (hash-table-count (etaf-runtime-resource-registry runtime))) + (artifact-count + (hash-table-count (etaf-runtime-artifact-registry runtime))) + rollback-saw-old) + (cl-letf (((symbol-function 'etaf--runtime-swap-generation) + (lambda (&rest args) + (apply old-swap args) + (error "injected participant publish failure"))) + ((symbol-function 'etaf--runtime-participant-rollback) + (lambda (participant) + (setq rollback-saw-old + (eq old-generation + (etaf-runtime-current-generation runtime))) + (funcall old-rollback participant)))) + (should-error (setf (etaf-value source) 1) :type 'error)) + (should rollback-saw-old) + (should (eq old-generation + (etaf-runtime-current-generation runtime))) + (should (equal "1=0" (etaf-test--buffer-text buffer-name))) + (should (= resource-count + (hash-table-count + (etaf-runtime-resource-registry runtime)))) + (should (<= (hash-table-count + (etaf-runtime-artifact-registry runtime)) + artifact-count)) + (etaf-runtime-flush runtime) + (should (equal "1=1" (etaf-test--buffer-text buffer-name))) + (should (= (1+ (etaf-generation-generation-id old-generation)) + (etaf-runtime-generation runtime))) + (let ((committed (etaf-runtime-current-generation runtime))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected TP final accept failure")))) + (should-error (setf (etaf-value source) 2) :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal "1=1" (etaf-test--buffer-text buffer-name))) + (should (= resource-count + (hash-table-count + (etaf-runtime-resource-registry runtime)))) + (should (<= (hash-table-count + (etaf-runtime-artifact-registry runtime)) + artifact-count)) + (etaf-runtime-flush runtime) + (should (equal "1=2" (etaf-test--buffer-text buffer-name)))) + (let ((committed (etaf-runtime-current-generation runtime))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest _) + (error "injected Ebox pre-publish failure")))) + (should-error (setf (etaf-value source) 3) :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal "1=2" (etaf-test--buffer-text buffer-name))) + (etaf-runtime-flush runtime) + (should (equal "1=3" (etaf-test--buffer-text buffer-name)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-artifact-registry-stays-bounded () + "Discard superseded artifacts after repeated Component publications." + (let ((buffer-name " *etaf-artifact-bound-test*") (source (etaf-ref 0)) + (etaf-test-retained-render-counts (make-hash-table :test #'eql))) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-retained-leaf + (list :label 1 :cell source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (baseline (hash-table-count + (etaf-runtime-artifact-registry runtime)))) + (dotimes (index 100) + (setf (etaf-value source) (1+ index))) + (should (<= (hash-table-count + (etaf-runtime-artifact-registry runtime)) + baseline)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-prepublication-journals-are-exception-atomic () + "Rollback partial resource, artifact, and route installation immediately." + (dolist (phase '(resource artifact route)) + (let* ((buffer-name (format " *etaf-journal-%S-test*" phase)) + (source (etaf-ref 0)) + (baseline (hash-table-count (etaf-ref-subscribers source))) + (old-puthash (symbol-function 'puthash)) + (etaf-test-retained-render-counts (make-hash-table :test #'eql))) + (cl-letf + (((symbol-function 'puthash) + (lambda (key value table) + (let ((result (funcall old-puthash key value table))) + (when + (pcase phase + ('resource + (and (consp key) (integerp (car key)) + (integerp (cdr key)) + (etaf--component-instance-p value))) + ('artifact + (and (consp key) (integerp (car key)) + (integerp (cdr key)) (listp value) + (plist-member value :node))) + ('route (etaf-runtime-route-p key))) + (error "injected %S journal write" phase)) + result)))) + (should-error + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-retained-leaf + (list :label 1 :cell source) nil)) + :type 'error)) + (should-not (etaf-runtime-for-buffer buffer-name)) + (should (= baseline (hash-table-count (etaf-ref-subscribers source)))) + (etaf-mount buffer-name + (etaf--view-call 'etaf-test-retained-leaf + (list :label 1 :cell source) nil)) + (etaf-unmount (etaf-runtime-for-buffer buffer-name)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-route-arm-kth-failure-is-bounded-and-retryable () + "Rollback each partial route arm and keep repeated failures bounded." + (dolist (failure-index '(1 2)) + (let* ((buffer-name (format " *etaf-route-kth-%s-test*" failure-index)) + (show (etaf-ref nil)) (left (etaf-ref 0)) (right (etaf-ref 0)) + (etaf-test-retained-render-counts (make-hash-table :test #'eql)) + (view (lambda () + (if (etaf-value show) + (etaf--view-call + 'column nil + (list + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'left :label 1 :cell left) + nil) + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'right :label 2 :cell right) + nil))) + (etaf--view-call 'text nil (list "empty")))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-generation (etaf-runtime-current-generation runtime)) + (baseline-routes + (hash-table-count (etaf-runtime-route-sources runtime))) + (old-puthash (symbol-function 'puthash)) + (writes 0)) + (cl-letf + (((symbol-function 'puthash) + (lambda (key value table) + (let ((result (funcall old-puthash key value table))) + (when (and (etaf-runtime-route-p key) + (memq table (list (etaf-ref-subscribers left) + (etaf-ref-subscribers right)))) + (cl-incf writes) + (when (= writes failure-index) + (error "injected kth route arm"))) + result)))) + (should-error (setf (etaf-value show) t) :type 'error)) + (should (eq old-generation + (etaf-runtime-current-generation runtime))) + (should (zerop (hash-table-count (etaf-ref-subscribers left)))) + (should (zerop (hash-table-count (etaf-ref-subscribers right)))) + (should (= baseline-routes + (hash-table-count + (etaf-runtime-route-sources runtime)))) + (etaf-runtime-flush runtime) + (should (string-match-p "1=0" + (etaf-test--buffer-text buffer-name))) + (etaf-unmount runtime) + (should (zerop (hash-table-count (etaf-ref-subscribers left)))) + (should (zerop (hash-table-count + (etaf-ref-subscribers right)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-published-generation-resolves-new-resource () + "Make every newly published resource membership immediately resolvable." + (let* ((buffer-name " *etaf-publish-resource-visibility-test*") + (show (etaf-ref nil)) (cell (etaf-ref 0)) (checked 0) + (etaf-test-retained-render-counts (make-hash-table :test #'eql)) + (view + (lambda () + (if (etaf-value show) + (etaf--view-call 'etaf-test-retained-leaf + (list :key 'new :label 1 :cell cell) nil) + (etaf--view-call 'text nil (list "empty")))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (let ((old-publish + (symbol-function 'etaf--runtime-participant-publish))) + (cl-letf + (((symbol-function 'etaf--runtime-participant-publish) + (lambda (participant) + (prog1 (funcall old-publish participant) + (let* ((runtime + (etaf--generation-participant-runtime participant)) + (generation + (etaf-runtime-current-generation runtime))) + (maphash + (lambda (_identity semantic-id) + (let ((semantic + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + semantic-id))) + (when (etaf--semantic-component-p semantic) + (should + (gethash + (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime))) + (cl-incf checked)))) + (etaf-generation-identity-index generation))))))) + (setf (etaf-value show) t))) + (should (= 1 checked))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-local-parent-does-not-carry-unchanged-descendants () + "Avoid generation subtree carry for 500 unchanged children of a dirty parent." + (let ((buffer-name " *etaf-wide-parent-local-test*") + (etaf-test-retained-render-counts (make-hash-table :test #'eql))) + (setq etaf-test-wide-parent-source (etaf-ref 0) + etaf-test-wide-parent-cells + (cl-loop repeat 500 collect (etaf-ref 0))) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-wide-parent))) + (clrhash etaf-test-retained-render-counts) + (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'etaf--runtime-carry-committed-subtree) + (lambda (&rest _) + (error "local path attempted committed subtree carry")))) + (setf (etaf-value etaf-test-wide-parent-source) 1)) + (should (zerop (hash-table-count + etaf-test-retained-render-counts))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-direct-expr-publishes-child-range-only () + "Publish a direct material-child expr without running its Component owner." + (let ((buffer-name " *etaf-direct-range-test*") + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-static-count 10) + (etaf-test-range-evals 0) + (etaf-test-range-component-renders 0) + (range-replaces 0) (host-replaces 0) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-public-direct-range))) + (setq etaf-test-range-evals 0 + etaf-test-range-component-renders 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-commit (symbol-function 'ebox-commit)) + (runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args))) + ((symbol-function 'etaf--runtime-render-dirty-component) + (lambda (&rest _) + (error "Public Range entered Component owner"))) + ((symbol-function 'etaf--runtime-evaluate-root-candidate) + (lambda (&rest _) + (error "Public Range entered Root owner")))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-range-source) '((item . "I"))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (should (= 1 etaf-test-range-evals)) + (should (zerop etaf-test-range-component-renders)) + (should (= 1 range-replaces)) + (should (zerop host-replaces)) + (should (= 1 commits)) + (should (string-match-p "I" (etaf-test--buffer-text buffer-name))) + (let* ((generation (etaf-runtime-current-generation runtime)) + (range-id + (cl-loop for identity being the hash-keys of + (etaf-generation-identity-index generation) + using (hash-values semantic-id) + when (eq (car-safe identity) 'range) + return semantic-id)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (should (integerp range-id)) + (should (etaf--semantic-range-p range)) + (should (integerp (etaf--semantic-range-parent-id range))) + (should (= 1 (length (etaf--semantic-range-item-host-ids range)))) + (should + (equal '(range) + (mapcar + (lambda (effect-id) + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id))) + (etaf--generation-source-effects + generation etaf-test-range-source)))) + (cl-labels + ((walk (parent-id) + (dolist (child-id + (etaf--pvec-get + (etaf-generation-children-table generation) + parent-id)) + (should (integerp child-id)) + (should (= parent-id + (etaf--pvec-get + (etaf-generation-parent-table generation) + child-id))) + (walk child-id)))) + (walk 0))))) + (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-view-expr-callsite-token-is-stable () + "Give repeated values from one compiled expr site the same opaque token." + (let* ((spec etaf-test-macro-range-token--etaf-component-definition) + (render (etaf--component-spec-render spec)) + (left (funcall render nil nil)) + (right (funcall render nil nil)) + (left-expr (car (etaf--view-node-children left))) + (right-expr (car (etaf--view-node-children right)))) + (should (etaf--expr-token left-expr)) + (should (eq (etaf--expr-token left-expr) + (etaf--expr-token right-expr))))) + +(ert-deftest etaf-runtime-public-expr-token-addresses-one-range-across-mounts () + "Carry one macro-generated expr token into exactly one mounted Range site." + (let ((etaf-test-range-source (etaf-ref nil)) tokens) + (dolist (buffer-name '(" *etaf-public-range-token-a*" + " *etaf-public-range-token-b*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-public-direct-range))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + ranges) + (maphash + (lambda (identity semantic-id) + (when (eq (car-safe identity) 'range) + (push (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + semantic-id) + ranges))) + (etaf-generation-identity-index generation)) + (should (= 1 (length ranges))) + (push (etaf--semantic-range-token (car ranges)) tokens))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))) + (should (eq (car tokens) (cadr tokens))))) + +(ert-deftest etaf-runtime-does-not-encode-ebox-layout-shapes () + "Keep resolved backend layout construction in the Renderer port." + (let ((source (with-temp-buffer + (insert-file-contents "etaf-runtime.el") + (buffer-string)))) + (should-not (string-match-p ":ebox-type" source)))) + +(ert-deftest etaf-runtime-direct-range-gate-a-transitions () + "Meet direct Range bounds for 10/100/500 static siblings and keyed survival." + (dolist (fixture '((10 . 2) (100 . 3) (500 . 3))) + (let* ((static-count (car fixture)) (bound (cdr fixture)) + (buffer-name (format " *etaf-range-gate-%s*" static-count)) + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-static-count static-count) + (etaf-test-range-evals 0) + (etaf-test-range-component-renders 0) + range-id range-ref a-id b-id static-records) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-direct-range))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime))) + (setq range-id + (cl-loop for identity being the hash-keys of + (etaf-generation-identity-index generation) + using (hash-values semantic-id) + when (eq (car-safe identity) 'range) + return semantic-id)) + (setq range-ref + (etaf--semantic-range-range-ref + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (let* ((range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + range-id)) + (parent-id (etaf--semantic-range-parent-id range))) + (setq static-records + (cl-loop for child-id in + (etaf--pvec-get + (etaf-generation-children-table generation) + parent-id) + unless (= child-id range-id) + collect + (cons child-id + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + child-id))))) + (dolist (items (list '((a . "A")) + '((a . "A") (b . "B")) + '((b . "B2")) nil)) + (setq etaf-test-range-evals 0 + etaf-test-range-component-renders 0) + (let ((before (etaf-runtime-generation runtime)) + (old-identity-index + (etaf-generation-identity-index + (etaf-runtime-current-generation runtime)))) + (cl-letf + (((symbol-function 'etaf--runtime-render-dirty-component) + (lambda (&rest _) + (error "Range update entered Component owner"))) + ((symbol-function 'etaf--runtime-evaluate-root-candidate) + (lambda (&rest _) + (error "Range update entered Root owner")))) + (setf (etaf-value etaf-test-range-source) items)) + (should (= 1 (- (etaf-runtime-generation runtime) before))) + (should (eq old-identity-index + (etaf-generation-identity-index + (etaf-runtime-current-generation runtime))))) + (should (= 1 etaf-test-range-evals)) + (should (zerop etaf-test-range-component-renders)) + (let* ((generation (etaf-runtime-current-generation runtime)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + range-id)) + (metrics (car (plist-get + (plist-get (ebox-buffer-update-report + buffer-name) + :range-metrics) + :parents)))) + (should (eq range-ref (etaf--semantic-range-range-ref range))) + (should (<= (plist-get metrics :segment-visits) bound)) + (should (<= (plist-get metrics :segment-copies) bound)) + (should (= (plist-get metrics :new-payload-visits) + (length items))) + (should (zerop (plist-get metrics + :unaffected-payload-visits))) + (should (= 1 (plist-get + (plist-get (ebox-buffer-update-report buffer-name) + :range-metrics) + :replacement-count))) + (when (equal items '((b . "B2"))) + (should (zerop (plist-get (ebox-buffer-update-report + buffer-name) + :created-objects)))) + (dolist (entry static-records) + (should (eq (cdr entry) + (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (car entry))))) + (when (assoc 'a items) + (let ((id (gethash + (list 'host range-id :key 'a) + (etaf--semantic-range-item-identity-index range)))) + (if a-id (should (= a-id id)) (setq a-id id)))) + (when (assoc 'b items) + (let ((id (gethash + (list 'host range-id :key 'b) + (etaf--semantic-range-item-identity-index range)))) + (if b-id (should (= b-id id)) (setq b-id id)))))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-two-direct-ranges-batch-one-publication () + "Evaluate and splice two disjoint Ranges once in one logical commit." + (let ((buffer-name " *etaf-two-range-test*") + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-left-evals 0) (etaf-test-range-right-evals 0) + (range-replaces 0) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-two-direct-ranges))) + (setq etaf-test-range-left-evals 0 etaf-test-range-right-evals 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-commit (symbol-function 'ebox-commit)) + (runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-range-source) '((x . "X"))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (should (= 1 etaf-test-range-left-evals)) + (should (= 1 etaf-test-range-right-evals)) + (should (= 2 range-replaces)) + (should (= 1 commits)) + (should (= 1 (hash-table-count + (etaf-ref-subscribers etaf-test-range-source)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-range-artifact-survives-root-rebuild () + "Relower current Range graph after Root change without application thunks." + (let* ((buffer-name " *etaf-range-root-coherence-test*") + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-static-count 10) + (etaf-test-range-evals 0) + (etaf-test-range-component-renders 0) + (etaf-test-range-host-prop-calls 0) + (root-source (etaf-ref nil)) + (root-calls 0) + (view + (lambda () + (cl-incf root-calls) + (etaf--view-call + 'column nil + (append + (list (etaf--view-call 'text (list :key 'head) (list "H"))) + (and (etaf-value root-source) + (list (etaf--view-call 'text (list :key 'inserted) + (list "X")))) + (list (etaf--view-call 'etaf-test-direct-range + (list :key 'range-owner) nil))))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (range-id + (cl-loop for identity being the hash-keys of + (etaf-generation-identity-index generation) + using (hash-values semantic-id) + when (eq (car-safe identity) 'range) + return semantic-id)) + (range-ref + (etaf--semantic-range-range-ref + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + range-id)))) + (setf (etaf-value etaf-test-range-source) '((a . "A"))) + (setq etaf-test-range-evals 0 + etaf-test-range-component-renders 0) + (let ((prop-calls etaf-test-range-host-prop-calls)) + (setf (etaf-value root-source) t) + (should (zerop etaf-test-range-evals)) + (should (zerop etaf-test-range-component-renders)) + (should (= prop-calls etaf-test-range-host-prop-calls))) + (let* ((generation (etaf-runtime-current-generation runtime)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (should (eq range-ref (etaf--semantic-range-range-ref range))) + (should (string-match-p "A" (etaf-test--buffer-text buffer-name)))) + (setq etaf-test-range-evals 0) + (setf (etaf-value etaf-test-range-source) '((b . "B"))) + (should (= 1 etaf-test-range-evals)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-range-address-survives-preceding-static-insert () + "Keep Range id/ref when its material parent's preceding siblings change." + (let ((buffer-name " *etaf-range-static-insert-test*") + (count (etaf-ref 2)) + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-evals 0)) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-counted-direct-range :count (etaf-value count)))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (range-id + (cl-loop for identity being the hash-keys of + (etaf-generation-identity-index generation) + using (hash-values semantic-id) + when (eq (car-safe identity) 'range) + return semantic-id)) + (range-ref + (etaf--semantic-range-range-ref + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + range-id)))) + (setq etaf-test-range-evals 0) + (setf (etaf-value count) 5) + (should (zerop etaf-test-range-evals)) + (let* ((generation (etaf-runtime-current-generation runtime)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (should (eq range-ref (etaf--semantic-range-range-ref range)))) + (setf (etaf-value etaf-test-range-source) '((a . "A"))) + (should (= 1 etaf-test-range-evals)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-range-rebuild-keeps-bare-string-siblings () + "Keep mounted synthetic string Hosts through Range invalidation and rebuild." + (let* ((buffer-name " *etaf-range-string-siblings-test*") + (etaf-test-range-source (etaf-ref nil)) + (root-source (etaf-ref 0)) + (view (lambda () + (etaf-value root-source) + (etaf--view-call 'etaf-test-string-sibling-range + (list :key 'owner) nil)))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (setf (etaf-value etaf-test-range-source) '((a . "A"))) + (setf (etaf-value root-source) 1) + (let ((text (etaf-test--buffer-text buffer-name))) + (should (string-match-p "prefix" text)) + (should (string-match-p "A" text)) + (should (string-match-p "suffix" text)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-range-failure-rolls-back-and-manual-retries () + "Restore Range graph/artifacts/buffer for prepublish and final-accept failure." + (let ((buffer-name " *etaf-range-rollback-test*") + (etaf-test-range-source (etaf-ref nil)) + (etaf-test-range-static-count 10)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-direct-range))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-generation (etaf-runtime-current-generation runtime)) + (range-id + (cl-loop for identity being the hash-keys of + (etaf-generation-identity-index old-generation) + using (hash-values semantic-id) + when (eq (car-safe identity) 'range) + return semantic-id)) + (old-range + (etaf--pvec-get (etaf-generation-semantic-nodes old-generation) + range-id)) + (artifact-count + (hash-table-count (etaf-runtime-range-artifact-registry runtime)))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest _) + (error "injected Range prepublish failure")))) + (should-error + (setf (etaf-value etaf-test-range-source) '((a . "A"))) + :type 'error)) + (should (eq old-generation (etaf-runtime-current-generation runtime))) + (should (eq old-range + (etaf--pvec-get + (etaf-generation-semantic-nodes + (etaf-runtime-current-generation runtime)) + range-id))) + (should (= artifact-count + (hash-table-count + (etaf-runtime-range-artifact-registry runtime)))) + (etaf-runtime-flush runtime) + (should (string-match-p "A" (etaf-test--buffer-text buffer-name))) + (let ((committed (etaf-runtime-current-generation runtime))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected Range final accept failure")))) + (should-error + (setf (etaf-value etaf-test-range-source) + '((a . "A") (b . "B"))) + :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should-not (string-match-p "B" + (etaf-test--buffer-text buffer-name))) + (etaf-runtime-flush runtime) + (should (string-match-p "B" + (etaf-test--buffer-text buffer-name)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-direct-range-rejects-step4b-output-without-reownership () + "Reject direct Component/raw output while retaining Range-only dependency." + (dolist (unsupported '(component raw deep-component deep-raw + deep-expr-component)) + (let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported)) + (etaf-test-unsupported-range-source (etaf-ref 'host))) + (unwind-protect + (progn + (etaf-mount buffer-name + (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))) + (should + (equal '(range) + (mapcar + (lambda (effect-id) + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id))) + (etaf--generation-source-effects + generation etaf-test-unsupported-range-source)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-direct-range-normalizes-bare-string-item () + "Represent a bare direct expr string as one synthetic semantic text Host." + (let ((buffer-name " *etaf-string-range-test*") + (etaf-test-string-range-source (etaf-ref nil))) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-public-string-range))) + (setf (etaf-value etaf-test-string-range-source) "hello") + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (range-id + (car (etaf--generation-source-effects + generation etaf-test-string-range-source))) + (effect (etaf--generation-effect generation range-id)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--generation-effect-semantic-id effect)))) + (should (eq 'range (etaf--generation-effect-kind effect))) + (should (= 1 (length (etaf--semantic-range-item-host-ids range)))) + (should (string-match-p "hello" + (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-range-recursively-retains-and-removes-host-subtree () + "Retain keyed nested Hosts and tombstone their full removed subtree." + (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)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-nested-host-range))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-nested-range-source))) + (effect (etaf--generation-effect generation effect-id)) + (range-id (etaf--generation-effect-semantic-id effect)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id)) + (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) + (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)) + (should (= 1 (plist-get + (plist-get (ebox-buffer-update-report buffer-name) + :range-metrics) + :replacement-count))) + (let* ((generation (etaf-runtime-current-generation runtime)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (should (= 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))) + (should + (equal '(range) + (mapcar + (lambda (id) + (etaf--generation-effect-kind + (etaf--generation-effect generation id))) + (etaf--generation-source-effects + generation etaf-test-nested-range-source)))) + (let* ((old-generation generation) + (old-range range) + (removed-ids + (etaf--runtime-generation-descendant-ids + old-generation + (etaf--semantic-range-item-host-ids old-range)))) + (setf (etaf-value etaf-test-nested-range-present) nil) + (let ((new-generation + (etaf-runtime-current-generation runtime))) + (dolist (semantic-id removed-ids) + (should (etaf--pvec-get + (etaf-generation-semantic-nodes old-generation) + semantic-id)) + (should-not (etaf--pvec-get + (etaf-generation-semantic-nodes new-generation) + semantic-id)) + (should-not (etaf--pvec-get + (etaf-generation-parent-table new-generation) + semantic-id)) + (should-not (etaf--pvec-get + (etaf-generation-children-table new-generation) + semantic-id)))))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-inline-effect-replaces-only-containing-host () + "Update one inline site beside 500 unrelated Components with one Host commit." + (let* ((buffer-name " *etaf-inline-host-update-test*") + (etaf-test-inline-a (etaf-ref "0")) + (etaf-test-inline-b (etaf-ref "0")) + (etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0) + (etaf-test-inline-component-renders 0) + (etaf-test-inline-updated-count 0) + (etaf-test-retained-render-counts (make-hash-table :test #'eql)) + (cells (cl-loop repeat 500 collect (etaf-ref 0))) + (host-replaces 0) (range-replaces 0) (commits 0) + (view + (etaf--view-call + 'column nil + (cons (etaf--view-call 'etaf-test-inline-owner + (list :key 'owner) nil) + (cl-loop for cell in cells for index from 0 + collect + (etaf--view-call + 'etaf-test-retained-leaf + (list :key index :label index :cell cell) nil)))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0 + etaf-test-inline-component-renders 0 + etaf-test-inline-updated-count 0) + (clrhash etaf-test-retained-render-counts) + (let ((old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-commit (symbol-function 'ebox-commit)) + (runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-inline-a) "1") + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (should (= 1 etaf-test-inline-a-evals)) + (should (zerop etaf-test-inline-b-evals)) + (should (zerop etaf-test-inline-component-renders)) + (should (zerop (hash-table-count etaf-test-retained-render-counts))) + (should (= 1 host-replaces)) + (should (zerop range-replaces)) + (should (= 1 commits)) + (should (= 1 etaf-test-inline-updated-count)) + (should (string-match-p "A1B0" + (etaf-test--buffer-text buffer-name))) + (let* ((generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-inline-a))) + (inline (etaf--generation-effect-semantic + generation effect-id)) + (host-id (etaf--semantic-inline-range-parent-id inline)) + (component-id + (etaf--pvec-get (etaf-generation-parent-table generation) + host-id)) + (component + (etaf--pvec-get (etaf-generation-semantic-nodes generation) + component-id))) + (should (eq 'inline + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id)))) + (should (integerp host-id)) + (should (etaf--semantic-component-p component)) + (should (integerp (etaf--semantic-component-parent-id component))) + (should (= host-id + (etaf--pvec-get + (etaf-generation-parent-table generation) + (etaf--semantic-inline-range-semantic-id inline))))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-inline-effects-coalesce-per-host () + "Coalesce two inline effects in one Host and split two distinct Hosts." + (let ((buffer-name " *etaf-inline-coalesce-test*") + (etaf-test-inline-a (etaf-ref "0")) + (etaf-test-inline-b (etaf-ref "0")) + (etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0) + (etaf-test-inline-updated-count 0) + (host-replaces 0) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-inline-owner))) + (setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0 + etaf-test-inline-updated-count 0) + (let ((old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-commit (symbol-function 'ebox-commit)) + (runtime (etaf-runtime-for-buffer buffer-name))) + (cl-letf (((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (etaf-runtime-event-begin runtime) + (setf (etaf-value etaf-test-inline-a) "1") + (setf (etaf-value etaf-test-inline-b) "2") + (etaf-runtime-event-end runtime)) + (should (= 1 etaf-test-inline-a-evals)) + (should (= 1 etaf-test-inline-b-evals)) + (should (= 1 host-replaces)) + (should (= 1 commits)) + (should (= 1 etaf-test-inline-updated-count)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))) + (let ((buffer-name " *etaf-inline-two-host-test*") + (etaf-test-inline-shared (etaf-ref "0")) + (etaf-test-inline-shared-evals 0) + (host-replaces 0) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-inline-shared-hosts))) + (setq etaf-test-inline-shared-evals 0) + (let ((old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-inline-shared) "1"))) + (should (= 2 etaf-test-inline-shared-evals)) + (should (= 2 host-replaces)) + (should (= 1 commits))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-inline-output-equal-promotes-dependencies-only () + "Promote an inline branch dependency change without Ebox publication." + (let ((buffer-name " *etaf-inline-dependency-only-test*") + (etaf-test-inline-branch-mode (etaf-ref nil)) + (etaf-test-inline-branch-left (etaf-ref 0)) + (etaf-test-inline-branch-right (etaf-ref 0)) + (etaf-test-inline-branch-evals 0) + (etaf-test-inline-branch-updated 0) + (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-inline-dependency-branch))) + (setq etaf-test-inline-branch-evals 0) + (let ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-inline-branch-mode) t) + (should (= 1 (- (etaf-runtime-generation runtime) before)))) + (should (zerop commits)) + (should (zerop etaf-test-inline-branch-updated)) + (let* ((generation (etaf-runtime-current-generation runtime)) + (before (etaf-runtime-generation runtime))) + (should-not (etaf--generation-source-effects + generation etaf-test-inline-branch-left)) + (should (etaf--generation-source-effects + generation etaf-test-inline-branch-right)) + (setf (etaf-value etaf-test-inline-branch-left) 1) + (should (= before (etaf-runtime-generation runtime))) + (setf (etaf-value etaf-test-inline-branch-right) 1) + (should (= (1+ before) (etaf-runtime-generation runtime))) + (should (zerop commits)) + (should (zerop etaf-test-inline-branch-updated)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-slot-inline-keeps-authoring-component-environment () + "Read authoring parent props through default and forwarded named slots." + (dolist (component '(etaf-test-slot-env-parent + etaf-test-slot-env-named-parent)) + (let ((buffer-name (format " *etaf-slot-env-%S*" component)) + (label (etaf-ref "A"))) + (setq etaf-test-slot-parent-renders 0 + etaf-test-slot-forwarder-renders 0 + etaf-test-slot-consumer-renders 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf--view-call component + (list :label + (etaf--expr-create + :thunk (lambda () (etaf-value label)))) + nil)) + (should (equal "A" (etaf-test--buffer-text buffer-name))) + (setq etaf-test-slot-parent-renders 0 + etaf-test-slot-forwarder-renders 0 + etaf-test-slot-consumer-renders 0) + (setf (etaf-value label) "B") + (should (equal "B" (etaf-test--buffer-text buffer-name))) + (should (= 1 etaf-test-slot-parent-renders)) + (should (zerop etaf-test-slot-forwarder-renders)) + (should (zerop etaf-test-slot-consumer-renders))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-nested-component-input-reads-caller-candidate-props () + "Resolve child input thunks from final candidate parent props." + (let ((buffer-name " *etaf-nested-prop-env-test*") (label (etaf-ref "A"))) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view (etaf-test-prop-env-parent :label (etaf-value label)))) + (should (equal "A" (etaf-test--buffer-text buffer-name))) + (setf (etaf-value label) "B") + (should (equal "B" (etaf-test--buffer-text buffer-name)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-inline-and-input-fixed-point-uses-final-props-once () + "Run input, inline, and Component render once for either source write order." + (dolist (order '((input inline) (inline input))) + (let ((buffer-name (format " *etaf-inline-input-%S*" order)) + (label (etaf-ref "A")) + (etaf-test-inline-priority-source (etaf-ref 0)) + (etaf-test-inline-priority-evals 0) + (etaf-test-inline-priority-renders 0) + (etaf-test-inline-priority-updated 0)) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-inline-input-priority :label (etaf-value label)))) + (setq etaf-test-inline-priority-evals 0 + etaf-test-inline-priority-renders 0 + etaf-test-inline-priority-updated 0) + (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-runtime-event-begin runtime) + (dolist (which order) + (if (eq which 'input) + (setf (etaf-value label) "B") + (setf (etaf-value etaf-test-inline-priority-source) 1))) + (etaf-runtime-event-end runtime) + (should (= 1 etaf-test-inline-priority-evals)) + (should (= 1 etaf-test-inline-priority-renders)) + (should (= 1 etaf-test-inline-priority-updated)) + (should (equal "B/1" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-range-and-input-fixed-point-reuses-range-candidate () + "Evaluate direct Range once when Component input changes in the same turn." + (dolist (order '((input range) (range input))) + (let ((buffer-name (format " *etaf-range-input-%S*" order)) + (marker (etaf-ref "A")) + (etaf-test-range-source (etaf-ref 0)) + (etaf-test-range-evals 0) + (etaf-test-range-component-renders 0)) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-range-input-priority :marker (etaf-value marker)))) + (setq etaf-test-range-evals 0 etaf-test-range-component-renders 0) + (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-runtime-event-begin runtime) + (dolist (which order) + (if (eq which 'input) + (setf (etaf-value marker) "B") + (setf (etaf-value etaf-test-range-source) 1))) + (etaf-runtime-event-end runtime) + (should (= 1 etaf-test-range-evals)) + (should (= 1 etaf-test-range-component-renders)) + (should (string-match-p "B/1" + (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-slot-range-direct-source-skips-component-renders () + "Update default, forwarded named, and fallback slot Ranges directly." + (dolist (component '(etaf-test-slot-range-parent + etaf-test-slot-range-named-parent + etaf-test-slot-range-fallback)) + (let ((buffer-name (format " *etaf-slot-range-%S*" component)) + (etaf-test-slot-source (etaf-ref nil)) + (range-replaces 0) (host-replaces 0) (commits 0)) + (setq etaf-test-slot-range-evals 0 + etaf-test-slot-parent-renders 0 + etaf-test-slot-forwarder-renders 0 + etaf-test-slot-consumer-renders 0 + etaf-test-slot-author-updated 0 + etaf-test-slot-consumer-updated 0) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf--view-call component nil nil)) + (setq etaf-test-slot-range-evals 0 + etaf-test-slot-parent-renders 0 + etaf-test-slot-forwarder-renders 0 + etaf-test-slot-consumer-renders 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-slot-source) '((a . "A"))))) + (should (= 1 etaf-test-slot-range-evals)) + (should (= 1 range-replaces)) + (should (zerop host-replaces)) + (should (= 1 commits)) + (should (zerop etaf-test-slot-parent-renders)) + (should (zerop etaf-test-slot-forwarder-renders)) + (should (zerop etaf-test-slot-consumer-renders)) + (if (eq component 'etaf-test-slot-range-fallback) + (progn + (should (zerop etaf-test-slot-author-updated)) + (should (= 1 etaf-test-slot-consumer-updated)) + (with-current-buffer buffer-name + (should (equal '(:foreground "fallback-color") + (get-text-property + 0 'face (buffer-string)))))) + (should (= 1 etaf-test-slot-author-updated)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))) + +(ert-deftest etaf-runtime-slot-range-two-sites-batch-one-commit () + "Evaluate two projection sites and publish two Range replacements once." + (let ((buffer-name " *etaf-slot-range-two-sites-test*") + (etaf-test-slot-source (etaf-ref nil)) + (etaf-test-slot-range-evals 0) + (range-replaces 0) (commits 0)) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-slot-range-two-site-parent))) + (setq etaf-test-slot-range-evals 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-slot-source) '((a . "A"))))) + (should (= 2 etaf-test-slot-range-evals)) + (should (= 2 range-replaces)) + (should (= 1 commits))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-slot-retarget-equal-output-promotes-dependencies () + "Retarget caller slot deps without rendering Consumer or publishing Ebox." + (let ((buffer-name " *etaf-slot-retarget-equal-test*") + (mode (etaf-ref nil)) + (etaf-test-slot-branch-left (etaf-ref 0)) + (etaf-test-slot-branch-right (etaf-ref 0)) + (commits 0)) + (setq etaf-test-slot-parent-renders 0 + etaf-test-slot-consumer-renders 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (etaf-test-slot-range-branch-parent :mode (etaf-value mode)))) + (setq etaf-test-slot-parent-renders 0 + etaf-test-slot-consumer-renders 0) + (let ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (let ((before (etaf-runtime-generation runtime))) + (setf (etaf-value mode) t) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (should (= 1 etaf-test-slot-parent-renders)) + (should (zerop etaf-test-slot-consumer-renders)) + (should (zerop commits)) + (let ((generation (etaf-runtime-current-generation runtime))) + (should-not (etaf--generation-source-effects + generation etaf-test-slot-branch-left)) + (should (etaf--generation-source-effects + generation etaf-test-slot-branch-right))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-slot-range-rolls-back-rebuilds-and-removes-items () + "Keep slot Range state atomic across rollback, rebuild, and item removal." + (let* ((buffer-name " *etaf-slot-range-rollback-test*") + (etaf-test-slot-source (etaf-ref '((a . "A")))) + (root-source (etaf-ref 0)) + (view (lambda () + (etaf-value root-source) + (etaf--view-call 'etaf-test-slot-range-parent + (list :key 'owner) nil)))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-slot-source))) + (effect (etaf--generation-effect generation effect-id)) + (slot-id (etaf--generation-effect-semantic-id effect))) + (should (eq 'slot (etaf--generation-effect-kind effect))) + (setq etaf-test-slot-range-evals 0) + (setf (etaf-value etaf-test-slot-source) '((b . "B"))) + (should (= 1 etaf-test-slot-range-evals)) + (setq etaf-test-slot-range-evals 0) + (setf (etaf-value root-source) 1) + (should (zerop etaf-test-slot-range-evals)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))) + (let ((committed (etaf-runtime-current-generation runtime)) + (before (etaf-test--buffer-text buffer-name))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected slot Range final accept failure")))) + (should-error + (setf (etaf-value etaf-test-slot-source) '((c . "C"))) + :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal before (etaf-test--buffer-text buffer-name)))) + (etaf-runtime-flush runtime) + (let* ((generation (etaf-runtime-current-generation runtime)) + (slot (etaf--pvec-get + (etaf-generation-semantic-nodes generation) slot-id)) + (item-id (gethash (list 'host slot-id :key 'c) + (etaf--semantic-slot-range-item-identity-index + slot)))) + (should item-id) + (should (string-match-p "C" (etaf-test--buffer-text buffer-name))) + (setf (etaf-value etaf-test-slot-source) nil) + (let ((generation (etaf-runtime-current-generation runtime))) + (should-not (etaf--pvec-get + (etaf-generation-semantic-nodes generation) item-id)) + (should-not (etaf--pvec-get + (etaf-generation-parent-table generation) item-id)) + (should-not (etaf--pvec-get + (etaf-generation-children-table generation) item-id)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-material-fragment-is-one-retained-range-owner () + "Update a material fragment without rendering its Component or Root." + (let ((buffer-name " *etaf-fragment-range-test*") + (etaf-test-fragment-source (etaf-ref nil)) + (range-replaces 0) (root-replaces 0) (commits 0)) + (setq etaf-test-fragment-range-evals 0 + etaf-test-fragment-owner-renders 0) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-fragment-range-owner))) + (setq etaf-test-fragment-range-evals 0 + etaf-test-fragment-owner-renders 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-root (symbol-function 'ebox-candidate-replace-root)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-candidate-replace-root) + (lambda (&rest args) + (cl-incf root-replaces) (apply old-root args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-fragment-source) + '((a . "A") (b . "B"))))) + (should (= 1 etaf-test-fragment-range-evals)) + (should (zerop etaf-test-fragment-owner-renders)) + (should (= 1 range-replaces)) + (should (zerop root-replaces)) + (should (= 1 commits)) + (should (string-match-p "A" (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-fragment-source)))) + (should (eq 'fragment + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-material-raw-ebox-is-one-opaque-range-owner () + "Update raw value and key through one opaque Range effect." + (let ((buffer-name " *etaf-raw-range-test*") + (etaf-test-raw-source (etaf-ref "A")) + (etaf-test-raw-key-source (etaf-ref 'a)) + (root-source (etaf-ref 0)) + (range-replaces 0) (commits 0)) + (setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (lambda () + (etaf-value root-source) + (etaf--view-call 'etaf-test-raw-range-owner + (list :key 'owner) nil))) + (setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0) + (let ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (etaf-runtime-event-begin runtime) + (setf (etaf-value etaf-test-raw-source) "B") + (setf (etaf-value etaf-test-raw-key-source) 'b) + (etaf-runtime-event-end runtime))) + (should (= 1 etaf-test-raw-evals)) + (should (zerop etaf-test-raw-owner-renders)) + (should (= 1 range-replaces)) + (should (= 1 commits)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))) + (setf (etaf-value root-source) 1) + (should (= 1 etaf-test-raw-evals)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (car (etaf--generation-source-effects + generation etaf-test-raw-source))) + (semantic (etaf--generation-effect-semantic + generation effect-id))) + (should (eq 'raw + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id)))) + (should-not (etaf--semantic-host-p semantic)) + (should (eq 'b + (plist-get (etaf--semantic-range-output-signature semantic) + :key))) + (let ((committed generation) + (before (etaf-test--buffer-text buffer-name))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected raw Range final accept failure")))) + (should-error + (setf (etaf-value etaf-test-raw-source) "C") :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal before (etaf-test--buffer-text buffer-name)))) + (etaf-runtime-flush runtime) + (should (string-match-p "C" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-root-effect-owns-one-semantic-root-range () + "Publish Root changes through one semantic Root Range and root replacement." + (let* ((buffer-name " *etaf-semantic-root-range-test*") + (source (etaf-ref nil)) + (root-evals 0) (root-replaces 0) (commits 0) + (view (lambda () + (cl-incf root-evals) + (mapcar (lambda (entry) + (etaf--view-call 'text (list :key (car entry)) + (list (cdr entry)))) + (etaf-value source))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (setq root-evals 0) + (let ((old-root (symbol-function 'ebox-candidate-replace-root)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-root) + (lambda (&rest args) + (cl-incf root-replaces) (apply old-root args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value source) '((a . "A") (b . "B"))))) + (should (= 1 root-evals)) + (should (= 1 root-replaces)) + (should (= 1 commits)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (root (etaf--pvec-get + (etaf-generation-semantic-nodes generation) 0)) + (range-id (car (etaf--pvec-get + (etaf-generation-children-table generation) 0))) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) range-id))) + (should (etaf--semantic-root-p root)) + (should (eq 'root (etaf--semantic-range-kind range))) + (should (= 0 (etaf--semantic-range-parent-id range))) + (should (= range-id + (etaf--generation-effect-semantic-id + (etaf--generation-effect generation 0)))) + (let ((committed generation) + (before (etaf-test--buffer-text buffer-name))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected Root final accept failure")))) + (should-error + (setf (etaf-value source) '((c . "C"))) :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal before (etaf-test--buffer-text buffer-name)))) + (etaf-runtime-flush runtime) + (should (string-match-p "C" (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-transparent-component-publishes-output-range () + "Publish transparent Component nil/one/many output through one Range." + (let ((buffer-name " *etaf-transparent-output-range-test*") + (etaf-test-transparent-source (etaf-ref nil)) + (range-replaces 0) (host-replaces 0) (commits 0)) + (setq etaf-test-transparent-renders 0 + etaf-test-transparent-parent-renders 0) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-transparent-parent))) + (setq etaf-test-transparent-renders 0 + etaf-test-transparent-parent-renders 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-host (symbol-function 'ebox-candidate-replace-host-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-candidate-replace-host-ref) + (lambda (&rest args) + (cl-incf host-replaces) (apply old-host args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-transparent-source) + '((a . "A") (b . "B"))))) + (should (= 1 etaf-test-transparent-renders)) + (should (zerop etaf-test-transparent-parent-renders)) + (should (= 1 range-replaces)) + (should (zerop host-replaces)) + (should (= 1 commits)) + (should (string-match-p "A" (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (component + (cl-loop for id from 1 to (etaf-runtime-next-semantic-id runtime) + for node = (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + id) + when (and (etaf--semantic-component-p node) + (equal (car (etaf--semantic-component-identity node)) + 'etaf-test-transparent-owner)) + return node)) + (range (etaf--pvec-get + (etaf-generation-semantic-nodes generation) + (etaf--semantic-component-output-range-id component)))) + (should (eq 'transparent + (etaf--semantic-component-publication-kind component))) + (should (eq 'component-output (etaf--semantic-range-kind range))) + (should (eq (etaf--semantic-component-output-range-ref component) + (etaf--semantic-range-range-ref range))) + (let ((committed generation) + (before (etaf-test--buffer-text buffer-name))) + (cl-letf (((symbol-function 'accept-change-group) + (lambda (&rest _) + (error "injected transparent final accept failure")))) + (should-error + (setf (etaf-value etaf-test-transparent-source) + '((c . "C"))) + :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal before (etaf-test--buffer-text buffer-name)))) + (etaf-runtime-flush runtime) + (should (string-match-p "C" + (etaf-test--buffer-text buffer-name))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-transparent-chain-shares-nearest-backend-anchor () + "Update an inner transparent Component without rendering its ancestors." + (let ((buffer-name " *etaf-transparent-chain-test*") + (etaf-test-transparent-source (etaf-ref '((a . "A")))) + (range-replaces 0) (commits 0)) + (setq etaf-test-transparent-inner-renders 0 + etaf-test-transparent-outer-renders 0) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-transparent-chain-parent))) + (setq etaf-test-transparent-inner-renders 0 + etaf-test-transparent-outer-renders 0) + (let ((old-range (symbol-function 'ebox-candidate-replace-range-ref)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-candidate-replace-range-ref) + (lambda (&rest args) + (cl-incf range-replaces) (apply old-range args))) + ((symbol-function 'ebox-commit) + (lambda (&rest args) + (cl-incf commits) (apply old-commit args)))) + (setf (etaf-value etaf-test-transparent-source) + '((a . "B"))))) + (should (= 1 etaf-test-transparent-inner-renders)) + (should (zerop etaf-test-transparent-outer-renders)) + (should (= 1 range-replaces)) + (should (= 1 commits)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-runtime-context-provider-promotes-consumer-atomically () + "Promote Context provider/consumer frames only with their generation." + (let ((buffer-name " *etaf-generation-context-test*") + (etaf-test-context-provider-source (etaf-ref "red"))) + (setq etaf-test-context-provider-renders 0 + etaf-test-context-consumer-renders 0) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-generation-context-provider))) + (setq etaf-test-context-provider-renders 0 + etaf-test-context-consumer-renders 0) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-generation (etaf-runtime-current-generation runtime))) + (setf (etaf-value etaf-test-context-provider-source) "blue") + (should (= 1 etaf-test-context-provider-renders)) + (should (= 1 etaf-test-context-consumer-renders)) + (with-current-buffer buffer-name + (should (equal '(:foreground "blue") + (get-text-property 0 'face (buffer-string))))) + (let ((committed (etaf-runtime-current-generation runtime)) + (before (etaf-test--buffer-text buffer-name))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest _) + (error "injected Context publication failure")))) + (should-error + (setf (etaf-value etaf-test-context-provider-source) "green") + :type 'error)) + (should (eq committed (etaf-runtime-current-generation runtime))) + (should (equal before (etaf-test--buffer-text buffer-name)))) + (etaf-runtime-flush runtime) + (with-current-buffer buffer-name + (should (equal '(:foreground "green") + (get-text-property 0 'face (buffer-string))))) + (should-not (eq old-generation + (etaf-runtime-current-generation runtime))))) + (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-generation-owns-handler-ref-and-focus-contributions () + "Dispatch only committed handlers and remove stale focus membership." + (let* ((buffer-name " *etaf-generation-handler-test*") + (mode (etaf-ref 'old)) + (old-calls 0) (new-calls 0) (stable-calls 0) + (view + (lambda () + (etaf--view-call + 'column nil + (list + (pcase (etaf-value mode) + ('old (etaf--view-call + 'text + (list :ref 'target :tab-index 0 + :on-press (lambda () (cl-incf old-calls))) + (list "old"))) + ('new (etaf--view-call + 'text + (list :ref 'target :tab-index 0 + :on-press (lambda () (cl-incf new-calls))) + (list "new"))) + (_ (etaf--view-call 'text (list :ref 'target) + (list "removed")))) + (etaf--view-call + 'text (list :ref 'stable :tab-index 1 + :on-press (lambda () (cl-incf stable-calls))) + (list "stable"))))))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (let ((runtime (etaf-runtime-for-buffer buffer-name)) + (old-commit (symbol-function 'ebox-commit))) + (cl-letf (((symbol-function 'ebox-commit) + (lambda (&rest args) + (etaf-dispatch-event runtime 'target 'press) + (apply old-commit args)))) + (setf (etaf-value mode) 'new)) + (should (= 1 old-calls)) + (should (zerop new-calls)) + (etaf-dispatch-event runtime 'target 'press) + (should (= 1 new-calls)) + (etaf-dispatch-event runtime 'stable 'press) + (should (= 1 stable-calls)) + (etaf-focus runtime 'target) + (should (eq 'target (etaf-focused-host-ref runtime))) + (setf (etaf-value mode) 'removed) + (should-error (etaf-dispatch-event runtime 'target 'press) + :type 'etaf-event-error) + (should-not (etaf-focused-host-ref runtime)))) + (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-candidate-reintroduced-host-cancels-contribution-removal () + "Cancel a Host tombstone when the same stable ref is re-registered." + (let ((runtime + (etaf--runtime-create + :candidate-removed-host-refs '(stable other) + :candidate-host-props (make-hash-table :test #'equal) + :candidate-handlers (make-hash-table :test #'equal) + :candidate-semantic-nodes (make-hash-table :test #'equal) + :candidate-graph-nodes (make-hash-table :test #'eql) + :candidate-behaviors (make-hash-table :test #'equal)))) + (etaf--runtime-register-host + runtime '(:ref stable :on-press ignore) '(test)) + (should (equal '(other) + (etaf-runtime-candidate-removed-host-refs runtime))) + (should (etaf-runtime-handler-for + (let ((generation + (etaf--generation-create + :indexes + (etaf--runtime-build-contribution-indexes + runtime nil t)))) + (setf (etaf-runtime-current-generation runtime) generation) + runtime) + 'stable)))) + +(ert-deftest etaf-context-edge-belongs-to-direct-range-effect () + "Invalidate the injecting Range effect, not its lexical Component effect." + (let ((buffer-name " *etaf-context-range-owner-test*") + (etaf-test-context-provider-source (etaf-ref "A"))) + (setq etaf-test-context-range-evals 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view (etaf-test-generation-context-range-provider))) + (setq etaf-test-context-range-evals 0) + (setf (etaf-value etaf-test-context-provider-source) "B") + (should (= 1 etaf-test-context-range-evals)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (edges (etaf--generation-index-entries + generation 'context-consumers))) + (should (= 1 (length (cdar edges)))) + (should (eq 'range + (etaf--generation-effect-kind + (etaf--generation-effect generation + (cadar edges))))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-context-edge-belongs-to-slot-range-effect () + "Invalidate the authored slot Range without rendering its consumer." + (let ((buffer-name " *etaf-context-slot-owner-test*") + (etaf-test-context-provider-source (etaf-ref "A"))) + (setq etaf-test-slot-range-evals 0 + etaf-test-slot-consumer-renders 0 + etaf-test-context-provider-renders 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view (etaf-test-generation-context-slot-provider))) + (setq etaf-test-slot-range-evals 0 + etaf-test-slot-consumer-renders 0 + etaf-test-context-provider-renders 0) + (setf (etaf-value etaf-test-context-provider-source) "B") + (should (= 1 etaf-test-context-provider-renders)) + (should (= 1 etaf-test-slot-range-evals)) + (should (zerop etaf-test-slot-consumer-renders)) + (should (string-match-p "B" (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (generation (etaf-runtime-current-generation runtime)) + (effect-id (cadar (etaf--generation-index-entries + generation 'context-consumers)))) + (should (eq 'slot + (etaf--generation-effect-kind + (etaf--generation-effect generation effect-id)))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) + +(ert-deftest etaf-context-cycle-validator-allows-long-chain-and-rejects-cycle () + "Settle a long Context graph and reject one deterministic cross-edge cycle." + (let ((effect-map nil) chain) + (dotimes (index 40) + (let ((effect-id (1+ index)) + (consumer-id (+ 2 index))) + (setq effect-map + (etaf--pvec-put + effect-map effect-id + (etaf--generation-effect-create + :effect-id effect-id :kind 'component-render + :semantic-id consumer-id :deps nil))) + (push (cons (cons (1+ index) 'chain-key) (list effect-id)) chain))) + (let ((generation + (etaf--generation-create + :effect-map effect-map + :indexes (etaf--contribution-index-create + :context-consumers (nreverse chain))))) + (should (eq generation + (etaf--generation-validate-context-acyclic generation)))) + (let* ((cycle-effects + (etaf--pvec-put + (etaf--pvec-put + nil 1 (etaf--generation-effect-create + :effect-id 1 :kind 'component-render + :semantic-id 2 :deps nil)) + 2 (etaf--generation-effect-create + :effect-id 2 :kind 'component-render + :semantic-id 1 :deps nil))) + (cycle + (etaf--generation-create + :effect-map cycle-effects + :indexes + (etaf--contribution-index-create + :context-consumers + (list (cons (cons 1 'left) (list 1)) + (cons (cons 2 'right) (list 2))))))) + (should-error (etaf--generation-validate-context-acyclic cycle) + :type 'etaf-context-error)))) + +(ert-deftest etaf-runtime-inline-styled-output-survives-pure-root-rebuild () + "Keep current propertized inline output without replaying application thunks." + (let* ((buffer-name " *etaf-inline-styled-rebuild-test*") + (etaf-test-inline-styled-source (etaf-ref "A")) + (etaf-test-inline-styled-evals 0) + (etaf-test-inline-host-prop-calls 0) + (root-source (etaf-ref 0)) + (view (lambda () + (etaf-value root-source) + (etaf--view-call 'etaf-test-inline-styled-owner + (list :key 'styled) nil)))) + (unwind-protect + (progn + (etaf-mount buffer-name view) + (should (= 1 etaf-test-inline-host-prop-calls)) + (setq etaf-test-inline-styled-evals 0) + (setf (etaf-value etaf-test-inline-styled-source) "B") + (should (= 1 etaf-test-inline-styled-evals)) + (setq etaf-test-inline-styled-evals 0) + (setf (etaf-value root-source) 1) + (should (zerop etaf-test-inline-styled-evals)) + (should (= 1 etaf-test-inline-host-prop-calls)) + (with-current-buffer buffer-name + (let ((text (buffer-string))) + (should (equal "PB" (substring-no-properties text))) + (should (get-text-property 1 'face text))))) + (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-event-dispatch-noop-does-not-publish () + "Do not publish when an event callback changes no reactive state." + (let ((buffer-name " *etaf-event-noop-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-event-batch-noop))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-noop 'press) + (should (= before (etaf-runtime-generation runtime))))) + (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-event-dispatch-nested-batches-once () + "Batch nested public dispatches into one final publication." + (let ((buffer-name " *etaf-event-nested-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-event-batch-nested))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-nested-outer 'press) + (should (equal "Outer Inner nested" + (etaf-test--buffer-text buffer-name))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (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-event-dispatch-batches-behavior-two-ref-write () + "Batch a Behavior callback that writes two reactive refs." + (let ((buffer-name " *etaf-event-behavior-batch-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view (etaf-test-event-batch-behavior))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-behavior 'press) + (should (equal "Toggle left=on right=on" + (etaf-test--buffer-text buffer-name))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (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-event-dispatch-batches-computed-theme () + "Batch a callback that invalidates a computed Theme value." + (let ((buffer-name " *etaf-event-theme-batch-test*")) + (unwind-protect + (progn + (etaf-mount buffer-name (etaf-view (etaf-test-event-batch-theme))) + (should (equal "Theme theme=light" + (etaf-test--buffer-text buffer-name))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-theme-toggle 'press) + (should (equal "Theme theme=dark" + (etaf-test--buffer-text buffer-name))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (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-event-dispatch-batches-resource-success-and-error () + "Batch synchronous Resource success and error publications per event." + (let* ((buffer-name " *etaf-event-resource-batch-test*") + (fail (etaf-ref nil :name 'etaf-test-event-resource-fail)) + (resource + (etaf-resource + (lambda () + (if (etaf-value fail) + (error "expected resource failure") + (etaf-resource-result "ok"))) + :immediate nil :name 'etaf-test-event-resource))) + (unwind-protect + (progn + (etaf-mount buffer-name + (etaf-view + (etaf-test-event-batch-resource + :resource resource :fail fail))) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (before (etaf-runtime-generation runtime))) + (etaf-dispatch-event runtime 'event-batch-resource-success 'press) + (should (equal "Load success Load error status=success value=ok error=no" + (etaf-test--buffer-text buffer-name))) + (should (= 1 (- (etaf-runtime-generation runtime) before))) + (setq before (etaf-runtime-generation runtime)) + (etaf-dispatch-event runtime 'event-batch-resource-error 'press) + (with-current-buffer buffer-name + (should (string-match-p + "status=error value=none error=yes" + (buffer-string)))) + (should (= 1 (- (etaf-runtime-generation runtime) before))))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer)) + (etaf-resource-dispose resource)))) + +(ert-deftest etaf-mounted-input-focus-order-and-lifecycle () + "Order equal tab stops by live position and toggle input with mount life." + (let ((buffer-name " *etaf-input-lifecycle-test*")) + (setq etaf-test-event-count 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (column + (text :ref 'first :tab-index 0 + :on-press (lambda () (cl-incf etaf-test-event-count)) + "First") + (text :ref 'second :tab-index 0 + :on-press (lambda () (cl-incf etaf-test-event-count)) + "Second")))) + (should (etaf-runtime-for-buffer buffer-name)) + (with-current-buffer buffer-name + (should etaf-input-mode) + (should (eq #'etaf-focus-next (key-binding (kbd "TAB")))) + (should (eq #'etaf-activate (key-binding (kbd "RET")))) + (should (eq #'etaf-focus-previous + (key-binding (kbd "")))) + (switch-to-buffer buffer-name) + (execute-kbd-macro (kbd "TAB")) + (execute-kbd-macro (kbd "RET"))) + (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (should (eq 'first (etaf-focused-host-ref runtime))) + (should (= 1 etaf-test-event-count)) + (with-current-buffer buffer-name + (should (= (point) (etaf-host-ref-position runtime 'first)))) + (should (eq 'second (etaf-focus-next runtime))) + (with-current-buffer buffer-name + (should (= (point) (etaf-host-ref-position runtime 'second)))) + (let ((window (get-buffer-window buffer-name t))) + (should (windowp window)) + (etaf-activate-mouse + (list 'mouse-1 + (list window + (etaf-host-ref-position runtime 'second))))) + (should (= 2 etaf-test-event-count)) + (etaf-unmount runtime)) + (with-current-buffer buffer-name + (should-not etaf-input-mode))) + (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-activation-skips-disabled-and-callbackless-hosts () + "Do not activate a disabled Host or a Host without a press callback." + (let ((buffer-name " *etaf-activation-filter-test*")) + (setq etaf-test-event-count 0) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf-view + (column + (text :ref 'disabled :tab-index 0 :disabled t + :on-press (lambda () (cl-incf etaf-test-event-count)) + "Disabled") + (text :ref 'passive :tab-index 1 "Passive")))) + (let ((runtime (etaf-runtime-for-buffer buffer-name))) + (with-current-buffer buffer-name + (goto-char (etaf-host-ref-position runtime 'disabled)) + (should-error (etaf-activate runtime) :type 'user-error) + (goto-char (etaf-host-ref-position runtime 'passive)) + (should-error (etaf-activate runtime) :type 'user-error) + (let ((window (get-buffer-window buffer-name t))) + (etaf-activate-mouse + (list 'mouse-1 + (list window + (etaf-host-ref-position runtime 'passive)))))) + (should (= 0 etaf-test-event-count)))) + (when-let ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let ((buffer (get-buffer buffer-name))) + (kill-buffer buffer))))) + (ert-deftest etaf-mount-publishes-through-ebox () "Mount a View into a buffer using Ebox's buffer publication API." (let ((buffer-name " *etaf-test-mount*"))